#!/usr/bin/perl
#
use warnings;
use strict;
use Cwd qw(abs_path getcwd);
use Digest::MD5 'md5_hex';
use File::Basename;
use File::Copy;
use File::Glob qw(bsd_glob);
use File::Path qw'mkpath';
use Getopt::Long;
use Image::ExifTool q(:Public);
use Pod::Usage;
my $help = 0;
my $dryrun = 0;
my $recursive = 0;
my $clobber = 0;
my $man = 0;
my $whose = '';
GetOptions('dry-run|n' => \$dryrun,
'recursive|r' => \$recursive,
'clobber|C' => \$clobber,
'help|h' => \$help,
'man' => \$man) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitval => 0, -verbose => 2) if $man;
my $photo_dir = '/external/pictures';
die '/external not mounted?' unless -d $photo_dir;
my @m_abbr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my ($month, $year) = (localtime())[4..5];
$month += 1; $year += 1900;
my @idirs = @ARGV;
unless (@idirs) {
print "Using .\n";
push @idirs, getcwd();
}
my @files;
foreach my $dir (@idirs) {
unless (-d $dir) {
print "$dir is not a directory.\n";
next;
}
push @files, getfiles(abs_path($dir));
}
my @missing;
foreach my $file (sort(@files)) {
eval {
copy_photo($file);
};
if ($@) {
push @missing, "$file: $@";
}
}
if (@missing) {
print "Unable to copy:\n" . join("\n", map { "* $_" } sort(@missing)) . "\n"
}
exit 0;
sub getfiles {
my $top = shift;
my @dirs;
my @files;
opendir(my $dh, $top) or die "Failed to open $_: $!\n";
while (readdir($dh)) {
next if /^\.(\.)?/;
my $e = "$top/$_";
if (-d $e) {
print "Adding $e\n";
push @files, getfiles($e) if $recursive;
} elsif (-f $e and $e =~ m/\.jpe?g$/i) {
push @files, $e;
}
}
closedir($dh);
return @files;
}
sub copy_photo {
my $p = $_[0];
my ($Y, $M, $D, $h, $m, $s) = dtg($p);
my $ext = lc($p =~ m/(\.\w+)$/ ? $1 : '');
my $destdir = sprintf("%s/%04d/%02d_%s", $photo_dir, $Y, $M, $m_abbr[$M - 1]);
my $meddir = "$destdir/med";
my $base = sprintf("p%04d%02d%02d_%02d%02d%02d", $Y, $M, $D, $h, $m, $s);
my $dest = "$destdir/$base";
if ($dryrun) {
print "mkdir $destdir\n" unless -d $destdir;
print "mkdir $meddir\n" unless -d $meddir;
} else {
mkpath $destdir unless -d $destdir;
mkpath $meddir unless -d $meddir;
}
$dest = disambiguate($p, $dest, $ext) if -f "$dest$ext";
my $outfile = "$dest$ext";
my $medfile = "$meddir/${base}_med$ext";
for (my $count = 0; $count < 100; $count++) {
# Unlikely ever to need more than two extra digits
last unless -f $medfile;
$medfile = sprintf("$meddir/${base}_med_%02d$ext", $count++);
}
unless (-e $outfile) {
print "$p => $outfile\n";
copy($p, $outfile) unless $dryrun or -e $outfile;
unless ($outfile =~ m/\.avi$/ or $dryrun) {
system("/usr/bin/convert -resize '800x600' $outfile $medfile");
}
}
}
# Extract the date-time group from the EXIF data, returning it as a
# list. Return a guess if there is no EXIF.
sub dtg {
my $p = shift;
foreach my $tag (qw|CreateDate FileCreateDate FileModifyDate|) {
my $exif = ImageInfo($p, $tag);
if (defined($exif->{$tag}) &&
$exif->{$tag} =~ m/^(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)$/) {
return ($1, $2, $3, $4, $5, $6); # Y,M,D,H,M,S
}
}
return guess_dtg($p);
}
sub guess_dtg {
my $p = shift;
# # Most common filename format:
# # p[0-c]DDnnn.jpg -- month (in hex), day, serial
# #
# if ($p =~ m|/p([0-9a-c])(\d\d)([^.]+)\.?.*$|) {
# my ($M, $D, $serial) = (hex("0x$1"), $2, $3);
# my $
# }
# if ($p =~ m|/(p([0-9a-c])[^.]+)\.(.+)$|i) {
# ($basename, $m, $ext) = ($1, hex('0x' . $2), $3);
# $cp_year = ($m > $month) ? $year - 1 : $year;
# } else {
# $p =~ m|/(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)-(\d\d)\.(.+)$|;
# ($cp_year, $ext, $m) = ($3 + 2000, $7, $1);
# $basename = "p$cp_year$m$2_$4$5$6";
# }
# XXX: If all else fails, keep a one-up, checking and incrementing.
die "Can't guess DTG for $p";
}
sub disambiguate {
my ($source, $dest, $ext) = @_;
open(my $s, "<$source") or die "Can't read $source: $!";
binmode($s);
my $ctx = Digest::MD5->new;
$ctx->addfile($s);
my $smd = $ctx->hexdigest;
close($s);
my ($count, $extra) = (0, '');
unless ($clobber) {
while (open(my $f, "<$dest$extra$ext")) {
my $ctx = Digest::MD5->new;
binmode($f);
$ctx->addfile($f);
my $md = $ctx->hexdigest;
close($f);
print "S/F: ".basename($source).':'.basename("$dest$extra$ext").": $smd/$md\n";
last if $md eq $smd;
$extra = sprintf("_%02d", $count++);
}
}
return "$dest$extra";
}
##############################################################################
##############################################################################
# -- original code --
sub copydir {
print "copydir: $_[0]\n"; exit;
my $dcim = 'DCIM';
opendir(my $pd, $_[0]) or die "opendir $_[0]:$!";
foreach my $subdir (readdir($pd)) {
next if $subdir =~ m/^\.\.?$/;
my $camera = "/mnt/camera/$dcim/$subdir";
print "camera => $camera\n";
foreach my $p (bsd_glob("$camera/*")) {
my ($basename, $ext, $cp_year, $m);
my @exif_dtg = exif_dtg($p);
if (@exif_dtg) {
my ($y, $mn, $d, $h, $M, $s) = @exif_dtg;
my ($_b, $_e) = ('', '');
if ($p =~ m|/p...([^.]+)\.(.+)$|) {
($_b, $_e) = ($1, $2);
} else {
$p =~ m|/([^/]+)\.([^./]+)$|;
($_b, $_e) = ($1, $2);
}
($cp_year, $basename, $ext, $m) = ($y, "p$y$mn${d}_$h$M${s}_$_b", $_e, $mn);
} else {
if ($p =~ m|/(p([0-9a-c])[^.]+)\.(.+)$|) {
($basename, $m, $ext) = ($1, hex('0x' . $2), $3);
$cp_year = ($m > $month) ? $year - 1 : $year;
} else {
$p =~ m|/(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)-(\d\d)\.(.+)$|;
($cp_year, $ext, $m) = ($3 + 2000, $7, $1);
$basename = "p$cp_year$m$2_$4$5$6";
}
}
my $outdir = "$photo_dir/$cp_year/" . sprintf("%02d_%s", $m, $m_abbr[$m - 1]);
my $meddir = "$outdir/med";
if ($dryrun) {
print "mkdir $outdir\n" unless -d $outdir;
print "mkdir $meddir\n" unless -d $meddir;
} else {
mkpath $outdir unless -d $outdir;
mkpath $meddir unless -d $meddir;
}
my $outfile = "$outdir/${basename}_$whose.$ext";
my $old_outfile = "$outdir/${basename}.$ext";
if (-e $outfile || -e $old_outfile) {
print "Skipping $p\n";
next;
}
my $medfile = "$meddir/${basename}_${whose}_med.$ext";
print "$p => $outfile\n";
copy($p, $outfile) unless $dryrun;
unless ($outfile =~ m/\.avi$/ or $dryrun) {
system("/usr/bin/convert -resize '800x600' $outfile $medfile");
}
}
}
closedir($pd);
}
sub find_camera_dirs {
my $whose = lc substr($ARGV[0], 0, 1);
#my $camera_o = '/mnt/camera/dcim/100olymp'; # Olympus
#my $camera_p = '/mnt/camera/dcim/100_pana'; # Panasonic
#my $camera_p = '/mnt/camera/dcim/101_pana'; # Panasonic
#my $camera_lg = '/mnt/lg840g/Pictures/Camera Album'; # LG 840G
#my $camera = undef;
opendir(my $c, '/mnt/camera') or die "opendir camera: $!";
my ($dcim) = grep { /^dcim$/i } readdir($c);
closedir($c);
die "Camera not mounted" unless defined $dcim;
#$camera = $camera_o if -d $camera_o;
#$camera = $camera_p if -d $camera_p;
#$camera = $camera_lg if -d $camera_lg;
#die "Camera not mounted\n" unless defined $camera and -d $camera;
return ();
}
# -- original code --
##############################################################################
##############################################################################
__END__
=head1 CPPHOTO
cpphoto -- Copy photos into the correct directories on /external
=head1 SYNOPSIS
cpphoto [options] [directory ...]
Options:
--help help message
--man documentation
--dry-run,-n don't copy, just print what would be done
--recursive,-r copy photos from entire tree
=head1 OPTIONS
=over 8
=item B<--help>
=item B<--man>
=item B<--dry-run>
=item B<--recursive>
=back
=head1 DESCRIPTION
=cut
