cpphoto: Image file copier and renamer HEADmain

2 files changed, 347 insertions, 0 deletions

diff --git a/README b/README
index 6a7f415..0bbf9be 100644
--- a/README
+++ b/README
@@ -24,6 +24,13 @@ this during my first deployment to Afghanistan way back in 2002.
 Internet access was nil and all I had was a copy of ActiveState Perl
 to keep me entertained.  This was the result.
 
+## cpphoto
+
+Utility to rename and copy photos into a date-sorted hierarchy.  I
+dump photos from my "camera" into an incoming directory and run this
+program against that, copying all the photos into a
+sorted-by-month-and-year directory tree.
+
 ## CPUID
 
 Incomplete and somewhat out of data micro-OS that boots and is
diff --git a/cpphoto/cpphoto b/cpphoto/cpphoto
new file mode 100755
index 0000000..f5b862a
--- /dev/null
+++ b/cpphoto/cpphoto
@@ -0,0 +1,340 @@
+#!/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