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