我有一个perl脚本,可将文件从一个目录(/ folder /)移至另一个目录(/ folder2 /),然后,如果文件名(File20.doc)与文件夹名(folder / file20)完全匹配,它将把文件放入该文件夹。
我需要的是,如果文件名的一部分与文件夹匹配,它将把该文件放入该文件夹。例如,如果文件名为file24.doc,它将把该文件放入file20。
这是我拥有的脚本,因此可以将确切的文件名与匹配的文件夹进行匹配。
#!/usr/bin/perl
use warnings;
use File::Copy;
my $srcdir = "/folder/";
my $dest = "/folder2/";
opendir(DIR, $srcdir) or die "Can't open $srcdir: $!";
@files = grep {!/^\.+$/ } readdir(DIR);
foreach my $file (@files) {
my $old = "$srcdir/$file";
move($old, $dest) or die "Move $old -> $dest failed: $!";
}
close(DIR);
print "
-Complete";
exit;
最佳答案
我还提出了解决该问题的方法。我认为,尽管它远非完美,但它具有排除目的地查找例程的好处。
use strict;
use warnings;
use File::Copy 'move';
# Determine destination folder for file based on filename.
# All destinations are below a fallback destination provided as input.
sub make_dest_finder {
my $fallback_dest = shift;
return sub {
my $fnam = shift;
# Determine basename to start looking for a destination folder.
my $basename = substr $fnam, 0, rindex $fnam, '.';
# Shorten name while no homonymous folder exists.
chop $basename while $basename && ! -d "$fallback_dest/$basename";
return "$fallback_dest/$basename" if $basename;
return $fallback_dest;
};
}
my $srcdir = "/tmp/folder";
my $dest_finder = make_dest_finder '/tmp/folder2';
opendir my $dh, $srcdir or die "Can't open $srcdir: $!";
my @files = grep ! /^\.+$/, readdir $dh;
close $dh;
my $moved = 0;
foreach my $file (@files) {
my $old = "$srcdir/$file";
my $dest = $dest_finder->( $file );
print STDERR "moving $file to $dest\n";
if ( ! move $old, $dest ) {
warn "Move $old -> $dest failed: $!";
last;
}
$moved++;
}
print STDERR "\n\n- moved $moved files\n";
关于perl - Perl:将文件移到专用文件夹中,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/5836679/