--- 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