sundry/ghetto/photos/sorter.pl

#!/usr/bin/perl
#
use strict;
use warnings;
use Digest::SHA qw(sha512224_hex);

use Image::ExifTool;
use POSIX qw(strftime);
use File::Copy;
use File::Basename;
use File::Path qw(make_path);
use Time::Local qw(timelocal);

my @stat;
my $ArchiveDir = '/mnt/beast/picture/Pictures';
my $exifTool = new Image::ExifTool;
$exifTool->Options(DateFormat => '%s');

if (scalar(@ARGV) != 1) {
  print "Specify image filename on commandline\n";
  exit 1;
}

my $file    = $ARGV[0];
my $info    = $exifTool->ImageInfo($file);
my $ctime   = &sane_time(&find_time($info),$file);
my @time    = localtime($ctime);

my $folder  = strftime("%Y/%m/%Y-%m-%d",@time);
my $touch   = strftime("%Y-%m-%d %H:%M:%S",@time);
my $target  = "$ArchiveDir/$folder";

my $basename = basename($file);

#print "File:   $file\n";
#print "Folder: $folder\n";
#print "UNIX:   $ctime\n";
#print "Touch:  $touch\n";
#print "\n";
#
#print join "\n", keys %$info;

if (not -d $target) {
  print "Created directory for pictures: $target\n";
  make_path($target);
  #mkdir $target;
}

my $destination = "$target/$basename";
if (&same_file($file,$destination)) {
  print "Source and destination directories are the same, giving up before I hurt something\n";
  exit 1;
}

my $dsize=0;
if (-f $destination) {
  #  print "$destination exists";
  $dsize = -s $destination;
  if ($dsize != 0) {
    my $ohex = &digest($file);
    if ($ohex eq &digest($destination)) {
      printf " d -> %s -- removing locally\n", $destination;
      unlink $file;
    } else {
      printf " w !! %s != %s, rename required\n", $destination, $file;
      # print " -- files are different, '$file' needs a rename\n";
    }
  } else {
    printf " z -> %s\n", $destination;
    # print "$file -> $destination\n";
    copy($file, $destination);
    no warnings qw(uninitialized);
    utime undef, $ctime, $destination;
  }
} else {
  printf " c -> %s\n", $destination;
  # print "$file -> $destination\n";
  copy($file, $destination);
  no warnings qw(uninitialized);
  utime undef, $ctime, $destination;
}

sub same_file() {
  my ($source,$dest) = @_;
  my ($sdev,$sino,undef) = stat($source);
  my ($ddev,$dino,undef) = stat($dest);

  if ( $ddev and ($sdev == $ddev) and ($sino == $dino)) {
    return 1;
  }
  return 0;
}
sub find_time() {
  my ($info) = @_;
  my @times =qw(CreateDate DateTimeOriginal ModifyDate FileModifyDate FileAccessDate);

  foreach my $key (@times) {
    exists $info->{$key} and return $info->{$key};
  }
  return 0;
}
sub sane_time() {
  my ($ts,$file) = @_;
  my ($year,$month,$date,$hour,$min,$sec);

  # So far, this is the only insane time I've encountered, so if we a time that isn't it, just use it.
  if ($ts !~ /0000:00:00 00:00:00/) {
    return $ts;
  }

  $file =~ s/[a-zA-Z]//g; # Remove all letters from the filename (which is becoming our timestamp
  $file =~ s/^[^\d]+|[^\d]+$//g; # Remove all non digits from the end of the string

  if ($file =~ /(\d{4})\.?(\d{2})\.?(\d{2})/) {
    $year = $1;
    $month = $2;
    $date = $3;
    $file =~ s/\d{4}\.?\d{2}\.?\d{2}//;


    $month -= 1;    # Because perl
    $year  -= 1900; # Because perl
  }
  if ($file =~ /(\d{2})\.?(\d{2})\.?(\d{2})/) {
    $hour = $1;
    $min = $2;
    $sec = $3;
    $file =~ s/\d{2}\.?\d{2}\.?\d{2}//;
  }

  print "$file -> $ts -> $year/$month/$date $hour:$min:$sec\n";
  exit(1);

  return timelocal($sec,$min,$hour,$date,$month,$year,0,0,0);
}

sub digest() {
  my ($file) = @_;
  my $sha     = Digest::SHA->new(512224);
  $sha->addfile($file);
  return $sha->hexdigest();
}