I'm releasing this under the GPL, v3 which can be found at http://www.gnu.org/licenses/gpl.html
#!/usr/bin/perl -w
#movephoto.pl -- call this version 0.01
use strict;
use File::List;
use File::Copy;
use File::Path;
use Image::ExifTool;
use File::Basename;
my $basedir = "put path to source here";
my $target = "put path to target here";
my $i = 0;
my $search = new File::List("$basedir");
my $fileArrRef = $search->find("JPG\$|jpg\$|cr2\$|CR2\$");
sub pathbuild {
    my $newpath = $_[0];
    if (! -d $newpath) {
        if ( -e $newpath ) {
            File::Path::remove_tree($newpath);
        }
        File::Path::make_path($newpath);
    }
    return $!;
}
my $dtOrig;my $date;my $time;my $yr;my $mo;my $day;
foreach my $fullname (@$fileArrRef) {
    my $info = Image::ExifTool::ImageInfo($fullname);
    if ($$info{DateTimeOriginal}) {
        $dtOrig = $$info{DateTimeOriginal};
        ($date,$time) = split( / /, $dtOrig);
        ($yr,$mo,$day) = split(/:/, $date);
    } else {
        $dtOrig = '';
    } 
    my ($name,$path,$ext) = File::Basename::fileparse($fullname,qr/jpg|cr2/i);
    my $dest = "$target/undated";
    if ($dtOrig) {
        $dest = "$target/$yr/$mo/$day"
    }
    pathbuild($dest);
    my $destfile = "$dest/$name$ext";
    $i = 0;
    while (-e $destfile){
        $destfile = "$dest/$name$i.$ext";
        $i++;
    }
    if (link ($fullname,$destfile)){
        unlink ($fullname);
    } else {
        copy ($fullname,$destfile);
    }
}
 
 
No comments:
Post a Comment