perl - Perl:将文件移到专用文件夹中

Question

我有一个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;

Answer 1

我还提出了解决该问题的方法。我认为，尽管它远非完美，但它具有排除目的地查找例程的好处。

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