Re: Need Help with Program in Perl on a Netware Server
- From: "Paul Lalli" <mritty@xxxxxxxxx>
- Date: 21 Jul 2006 07:24:00 -0700
fhadzocos@xxxxxxxxx wrote:
I have a huge folder with 44 thousand files I need to keep only the
last file for each type in that folder
ex
workstation1.001
workstation1.002
workstation2.49
workstation2.56
workstation20.560
workstation20.561
workstation20.562
In that example I need to keep workstation1.002 workstation2.56
workstation20.562 and this would continue until the end of the files.
There is only one folder to look in.
I have no idea how to go about doing this in perl. I'm very new to perl
and do not wish to make an inefficient program.
First, I strongly recommend you create a program that *works* first,
and make it efficient second.
My recommendation is that you loop through the directory, grabbing each
file name. For each file, split it to get the basename and suffix
(see: perldoc File::Basename). Check if the basename exists in your
hash. If not, add it, with a value of the suffix. If it does exist,
compare the current suffix with the one that is already stored. If the
current one is less, remove the current file (perldoc -f unlink). If
the current one is greater, remove the file represented by the basename
and stored suffix, and replace the value with the current suffix.
That English description may be a bit confusing, (and we're always
telling people to Speak Perl rather than English), so here's a short
script to get you started.
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
opendir my $dh, $ARGV[0] or die "Cannot open directory $ARGV[0]: $!\n";
my %suffix_of;
while (my $file = readdir($dh)) {
next if $file =~ /^\.\.?$/ or ! -f "$ARGV[0]/$file";
my ($base, undef, $suffix) = fileparse($file, qr/\..*/);
$suffix =~ s/^\.//;
if (! exists $suffix_of{$base} ){
$suffix_of{$base} = $suffix;
}
elsif ($suffix_of{$base} > $suffix) {
unlink "$ARGV[0]/$file" or
warn "Could not remove $ARGV[0]/$file: $!\n";
}
else {
unlink "$ARGV[0]/$base.$suffix_of{$base}" or
warn "Could not remove $ARGV[0]/$base.$suffix_of{$base}:
$!\n";
$suffix_of{$base} = $suffix;
}
}
Paul Lalli
.
- References:
- Need Help with Program in Perl on a Netware Server
- From: fhadzocos
- Need Help with Program in Perl on a Netware Server
- Prev by Date: Re: Need Help with Program in Perl on a Netware Server
- Next by Date: Re: Need Help with Program in Perl on a Netware Server
- Previous by thread: Re: Need Help with Program in Perl on a Netware Server
- Next by thread: Re: Need Help with Program in Perl on a Netware Server
- Index(es):
Relevant Pages
|
