CODEWITHSUNDEEP
perlfile
user731668
user731668

Reputation: 51

Perl: moving files into dedicated folders

I have a perl script to move files from one directory (/folder/) to another (/folder2/) and then if the file name (File20.doc) matches the folder name (folder/file20) exactly it will put the file into that folder.

What I need is if part of the file name matches the folder it will put that file into that folder. For example if the file is named file24.doc it will put that file into file20.

Here is the script I have so for that will match extact file names to matching folders.

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

Upvotes: 3

Views: 17543

Answers (3)

Brian Rothstein
Brian Rothstein

Reputation: 1312

Just expanding on Wes's answer a little in order to take into account partial matches, I think this would work:

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

Basically, just check for subdirectories for progressively smaller and smaller prefixes of the file name. That way the file will go to the directory name that matches the longest prefix.

Upvotes: 1

Lumi
Lumi

Reputation: 15314

I'm also proposing my solution to this problem. While it's far from perfect, it has, I think, the benefit of having factored out the destination finding 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";

Upvotes: 1

Wes Hardaker
Wes Hardaker

Reputation: 22262

The function you're looking for is rename() which is what you should call instead of move().

For the matching part, you're probably best off using regular expressions to pull the file name contents apart and then testing if the directory exists:

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

Upvotes: -1

Related Questions