Perl: verschieben von Dateien in dafür vorgesehenen Ordnern

Ich habe ein perl-script zum verschieben von Dateien von einem Verzeichnis (/Ordner/) zu einem anderen (/Ordner2/) und dann, wenn der name der Datei (File20.doc) entspricht dem Namen des Ordners (Ordner/file20) genau, es wird die Datei in diesen Ordner.

Was ich brauche, ist, wenn ein Teil der Datei dem Namen des Ordners entspricht, der wird diese Datei in diesem Ordner. Zum Beispiel, wenn die Datei den Namen file24.doc es wird diese Datei in file20.

Hier ist das script habe ich so für zu entsprechen, wird extact file-Namen zu den entsprechenden Ordnern.

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

InformationsquelleAutor user731668 | 2011-04-29

  1. 1

    Bin ich auch vorschlagen meine Lösung für dieses problem. Es ist zwar bei weitem nicht perfekt, es hat, glaube ich, den Vorteil, dass Sie ausklammern der Zielort die Suche nach routine.

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

    InformationsquelleAutor Lumi

  2. 1

    Nur erweitert auf Wes ' Antwort ein wenig, um zu berücksichtigen, teilweise übereinstimmungen, denke ich, dass dies funktionieren würde:

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

    Grundsätzlich nur überprüfen Sie für Unterordner für fortschreitend kleiner und kleiner Präfixe den Namen der Datei. Die Datei wird in das Verzeichnis gehen, dem Namen, entspricht dem längsten Präfix.

    Ich habe diesen code testen, und es funktionierte. Habe ich geschrieben, die Antwort, weil ich wollte, um den Gedanken zu verdeutlichen versuchen zunehmend kleiner und kleiner directory-Namen entspricht, den besten zu finden.
    Die neue stackexchange zu sein scheint, füllen sich mehr und mehr mit downvoters...
    Haha. Ich bin neu in die ganze Sache. Ich dachte mir, da würd ich fragte ein paar Fragen, ich soll versuchen zu beantworten, teilweise zu. Aber jetzt Lebe ich in Angst vor der downvote! Ich meine, dass die Angst ist gut zu halten die Antworten, nachdenklich, aber zur gleichen Zeit, vielleicht, wenn jemand downvotes könnten Sie schreiben Sie einen Kommentar zu sagen, was falsch war, damit ich lernen kann, was nicht zu tun.

    InformationsquelleAutor Brian Rothstein

  3. -1

    Die Funktion, die Sie suchen, ist rename() das ist, was Sie anrufen sollen, statt Sie zu verschieben().

    Für den passenden Rahmen, sind Sie wahrscheinlich am besten aus, mit regulären Ausdrücken zu ziehen, der name der Datei Inhalt auseinander und dann prüfen ob das Verzeichnis existiert:

    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: $!";
}
    Nein, File::Copy's move ist ein guter Weg, um Dateien umzubenennen. rename muss nicht unbedingt arbeiten, wenn Sie eine Datei von einem Dateisystem zu einem anderen (je nach OS). move versucht rename ersten, und wenn das nicht funktioniert, Sie verarbeitet es, indem Sie eine Kopie & löschen.

    InformationsquelleAutor Wes Hardaker

Schreibe einen Kommentar