Question

我有一个perl脚本将文件从一个目录（/ folder /）移动到另一个目录（/ folder2 /），然后如果文件名（File20.doc）与文件夹名称（文件夹/ file20）匹配，那么它将放置将文件放入该文件夹。

我需要的是，如果文件名的一部分与将该文件放入该文件夹的文件夹匹配。例如，如果文件名为file24.doc，则会将该文件放入file20。

这是我所拥有的脚本，它将extact文件名与匹配的文件夹相匹配。

#!/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

为了考虑部分匹配，只需扩展Wes的答案，我认为这样可行：

foreach my $file (@files) 
{
    my $old = "$srcdir/$file";
    my $new = "$dest/$file";
    my $subdir = $file;
    while (length($subdir)>0)
    {
        if (-d "$dest/$subdir")
        {
            $new = "$dest/$subdir/$file";
            last;
        }
        chop($subdir);
    }

    rename($old, $new) or die "Move $old -> $dest failed: $!";
}

基本上，只需检查子目录中文件名的前缀是否越来越小。这样，文件将转到与最长前缀匹配的目录名称。

Answer 2

我也在提出解决这个问题的方法。虽然它远非完美，但我认为，它已经考虑了目标寻找程序的好处。

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

Answer 3

您正在寻找的功能是 rename（），这是您应该调用的而不是move（）。

对于匹配部分，您最好使用正则表达式将文件名内容分开，然后测试该目录是否存在：

foreach my $file (@files) {
    my $old = "$srcdir/$file";
    my ($basename) = ($file =~ /(.*)\.[^\.]+);
    $dist = $file;
    if ($basename && -d "$basename") {
        $dest = "$basename/$file";
    }
    rename($old, $dest) or die "Move $old -> $dest failed: $!";
}

Perl：将文件移动到专用文件夹中

3 个答案: