the stem may contain directory parts; copyright update
authorMatthias Förste <foerste@schlittermann.de>
Thu, 23 Jul 2015 15:56:15 +0200
changeset 5 53fc675aed0e
parent 4 72de0be85df4
child 6 531e14cda4fa
the stem may contain directory parts; copyright update
purge-proe
--- a/purge-proe	Thu Jul 23 13:54:11 2015 +0200
+++ b/purge-proe	Thu Jul 23 15:56:15 2015 +0200
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 
 #    Delete old Pro/Engineer files
-#    Copyright (C) 2010  Matthias Förste
+#    Copyright (C) 2010-2015 Matthias Förste
 #
 #    This program is free software: you can redistribute it and/or modify
 #    it under the terms of the GNU General Public License as published by
@@ -24,6 +24,7 @@
 use Getopt::Long;
 use Pod::Usage;
 use File::Find;
+use File::Basename;
 
 my $files;
 my $opt = {
@@ -51,11 +52,11 @@
   my $f = $File::Find::name;
   return unless $f =~ /^(.+)\.([0-9]+)$/;
 
-  my ($stem, $suffix) = ($1, $2);
+  my ($stem, $stembase, $suffix) = ($1, basename($1), $2);
 
   eval {
 
-    for (@{$proe_stems}) { return if $stem eq $_; }
+    for (@{$proe_stems}) { return if $stembase 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