#!/usr/bin/perl
# archive_photos archives photos into a directory structure
# and is released under the terms of the GNU GPL version 3, or any
# later version, at your option. See the file README and COPYING for
# more information.
# Copyright 2013 by Don Armstrong <don@donarmstrong.com>.


use warnings;
use strict;

use Getopt::Long;
use Pod::Usage;

=head1 NAME

archive_photos - archives photos into a directory structure

=head1 SYNOPSIS

archive_photos [options] path/to/photos [additional photos]

 Options:
  --recurse, -r recurse into subdirectories (default)
  --archive-dir, -a directory to archive into (~/media/photos)
  --debug, -d debugging level (Default 0)
  --help, -h display this help
  --man, -m display manual

=head1 OPTIONS

=over

=item B<--recurse, -r>

Recurse into subdirectories (default; use --no-recurse to disable

=item B<--archive-dir, -a>

Directory to archive to (default is ~/media/photos)

=item B<--debug, -d>

Debug verbosity. (Default 0)

=item B<--help, -h>

Display brief usage information.

=item B<--man, -m>

Display this manual.

=back

=head1 EXAMPLES

archive_photos

=cut


use vars qw($DEBUG);
use User;
use File::Find;
use Image::ExifTool qw(ImageInfo);
use POSIX qw(strftime);
use File::Copy;
use File::Path qw(make_path);
use File::Basename qw(dirname basename);
use Date::Parse qw(str2time);
use IPC::System::Simple qw(capturex);
use Digest::SHA qw(sha256_hex);

my %options = (debug           => 0,
               help            => 0,
               man             => 0,
               archive_dir     => User->Home."/media/photos",
               recurse         => 1,
              );

GetOptions(\%options,
           'archive_dir|archive-dir=s',
           'recurse!',
           'debug|d+','help|h|?','man|m');

pod2usage() if $options{help};
pod2usage({verbose=>2}) if $options{man};

$DEBUG = $options{debug};

my @USAGE_ERRORS;
if (not @ARGV) {
     push @USAGE_ERRORS,"You must give at least one directory";
}

pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;

our @files;

# loads files into @files as appropriate
sub file_pusher {
    if (-d $_ and not $options{recurse}) {
        $File::Find::prune = 1;
        return;
    }
    if (-f $_ and $_ =~ /\.(?:NEF|JPG|MOV)$/i) {
        push @files,$File::Find::name;
    }
}

my @dirs;

for my $arg (@ARGV) {
    if (-d $arg) {
        push @dirs,$arg;
    } else {
        push @files,$arg;
    }
}

# search all of the directories and store the files in @files;
find(\&file_pusher,@dirs) if @dirs;

# find already existing files
my %existing_files;
find(sub { if (-f $_ or -l $_) {$existing_files{$_} = $File::Find::name;} },$options{archive_dir});

for my $file (@files) {
    my $file_basename=basename($file);
    # find out when the photo was shot
    my $info = ImageInfo($file,[qw(CreateDate Serial)]);
    if (not defined $info->{CreateDate}) {
        print STDERR "No date information for $file\n";
        next;
    }
    my $epoch = str2time($info->{CreateDate});
    my $dir = strftime('%Y/%m_%B/%Y_%m_%d/',localtime($epoch));
    if (not -d $options{archive_dir}.'/'.$dir) {
        make_path($options{archive_dir}.'/'.$dir) or
            die "Unable to make dir $!";
    }
    my $end_location = $options{archive_dir}.'/'.$dir.$file_basename;
    if (-e $end_location) {
        print STDERR "$file already exists in $end_location\n";
    } elsif (exists $existing_files{$file_basename} and
             are_the_same_files({name => $existing_files{$file_basename}},
                               {name => $file, info => $info})) {
        print STDERR "$file already exists in $existing_files{$file_basename}\n";
    } else {
        print STDERR "copying $file to $end_location\n";
        copy($file,$end_location);
    }
}

# return true if the files are close enough that we should consider it
# the same picture
sub are_the_same_files{
    my ($f1,$f2) = @_;
    # load the exif information if we can
    for my $f (@_) {
        if (-e $f->{name}) {
            $f->{exists} = 1;
            if (not exists $f->{info} or not defined $f->{info}) {
                $f->{info} = ImageInfo($f->{name},[qw(CreateDate Serial)]);
            }
        } else {
            $f->{exists} = 0;
        }
    }
    # if the files both exist, compare some exif information
    if (defined $f1->{info} and $f2->{info}) {
        if ($f1->{info}{CreateDate} eq $f2->{info}{CreateDate} and
            $f1->{info}{Serial} eq $f2->{info}{Serial}
           ) {
            return 1;
        } else {
           return 0;
        }
    }
    # ok; can't compare exif. Compare sha256 sums
    for my $f (@_) {
        if (-l $f->{name}) {
            # this is probably a git annex file
            $f->{sha256} = git_annex_sha256($f->{name});
        } elsif (-e $f->{name}) {
            $f->{sha256} = calc_sha256($f->{name})
        }
    }
    # if the sha256 are equal, they're the same. if not, or if we
    # can't compare, assume they're different.
    if (defined $f1->{sha256} and
        defined $f2->{sha256} and
        $f1->{sha256} eq $f2->{sha256}
       ) {
        return 1;
    } else {
       return 0;
    }
}

sub calc_sha256{
    my ($fn) = @_;

    my $sha = Digest::SHA->new(256);
    $sha->addfile($fn);
    return($sha->hexdigest());
}

sub git_annex_sha256 {
    my ($fn) = @_;
    my $info = capturex('git','-C',dirname($fn),'annex','info',basename($fn));
    my ($sha256) = $info =~ /key:.+SHA256E-[^-]+--([^\.]+)/;
    return $sha256;
}



__END__