Perl: перемещение файлов в выделенные папки

Question

У меня есть Perl-скрипт для перемещения файлов из одного каталога (/ folder /) в другой (/ folder2 /), а затем, если имя файла (File20.doc) совпадает с именем папки (folder / 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

Просто немного расшифровав ответ Уэса, чтобы учесть частичные совпадения, я думаю, что это сработает:

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: $!";
}