also remove some files by name
authorMatthias Förste <foerste@schlittermann.de>
Thu, 23 Jul 2015 13:54:11 +0200
changeset 4 72de0be85df4
parent 3 7a91026ef690
child 5 53fc675aed0e
also remove some files by name
purge-proe
--- a/purge-proe	Wed Dec 22 12:38:28 2010 +0100
+++ b/purge-proe	Thu Jul 23 13:54:11 2015 +0200
@@ -35,6 +35,7 @@
 };
 
 my $proe_first_line = "#UGC:";
+my $proe_stems = [qw(errors.lst support.inf trail.txt test.txt global_intf.inf outdated.lst outdated.err info.trf)];
 
 die "Failed to read options" unless GetOptions(
   'directory=s' => $opt->{dirs},
@@ -52,29 +53,26 @@
 
   my ($stem, $suffix) = ($1, $2);
 
-  unless (-s $_) {
-    warn "Ignoring '$f': is empty";
-    return;
-  }
+  eval {
 
-  unless (open FILE, '<', $_) {
-    warn "Ignoring '$f': failed to open: $!";
-    return;
-  }
+    for (@{$proe_stems}) { return if $stem eq $_; }
+    die "Ignoring '$f': is empty" unless -s $f;
+    die "Ignoring '$f': failed to open: $!" unless open FILE, '<', $f;
+    # should only happen in case of a read error because we already
+    # checked the file for emptiness
+    die "Ignoring '$f': failed to read: $!" unless defined ($_ = <FILE>);
+    die "Ignoring '$f': not an Pro/Engineerfile" unless /^$proe_first_line/;
 
-  my $line = <FILE>;
-  unless ($line =~ /^$proe_first_line/) {
-    warn "Ignoring '$f': not an Pro/Engineerfile?";
-    return;
-  }
+  };
 
+  warn $@ and return if $@ ne '';
   $files->{$stem} = exists $files->{$stem} ? [ $suffix, @{$files->{$stem}} ] : [ $suffix ];
 
 }
 
 $opt->{dirs} = ['.'] unless @{$opt->{dirs}};
 
-find(\&doit, @{$opt->{dirs}});
+find( { wanted => \&doit, no_chdir => 1 }, @{$opt->{dirs}});
 my @sufs;
 for my $stem (keys %{$files}) {