#!/usr/bin/perl
# Filename:	exif_sort
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License/
# Description:	Output a list of files sorted by exif date/time
use strict;
use Time::Local;

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0; $PROGNAME =~ s|.*/||;
my ($BASENAME,$PROGNAME) = ($0 =~ m|(.*)/(.+)|) ? ($1?$1:'/',$2) : ('.',$0);

my $JHEAD = "jhead";
my $EXIFTOOL = 'exiftool';

##################################################
# Usage
##################################################
sub fatal {
	foreach my $msg (@_) { print STDERR "[$PROGNAME] ERROR:  $msg\n"; }
	exit(-1);
}

sub usage {
	foreach my $msg (@_) { print STDERR "ERROR:  $msg\n"; }
	print STDERR <<USAGE;

Usage:\t$PROGNAME [-a] <files ..>
  List files sorted by exif Date/Time tag
  -a                   Add to file, insert by date  (ignores '# comments')
  -d                   Set debug mode
  -offset <pat> <amt>  Offset date of files matching <pat> by <amt> seconds

Usage:\t$PROGNAME <captions.txt>
	Sort all the files in a captions.txt and rewrite it
  -missing             Add missing files

USAGE
	exit -1;
}

sub parse_args {
	my $opt = {};
	$opt->{offset} = [];
	while (my $arg=shift(@ARGV)) {
		if ($arg =~ /^-h$/) { usage(); }
		if ($arg =~ /^-d$/) { $MAIN::DEBUG=1; next; }
		if ($arg =~ /^-a$/) { $opt->{add}=shift(@ARGV); next; }
		if ($arg =~ /^-missing$/) { $opt->{missing}=1; next; }
		if ($arg =~ /^-offset$/) { push(@{$opt->{offset}},[shift(@ARGV),shift(@ARGV)]); next; }
		if ($arg =~ /^-/) { usage("Unknown option: $arg"); }
		push(@{$opt->{files}},$arg);
	}

	usage("No files defined") unless $opt->{files};
	
	$opt;
}

sub debug {
	return unless $MAIN::DEBUG;
	foreach my $msg (@_) { print STDERR "[$PROGNAME] $msg\n"; }
}

sub offset {
	my ($opt,$file) = @_;

	# Calc -offset
	my $offset = 0;
	foreach my $off ( @{$opt->{offset}} ) {
		next unless $file =~ /$off->[0]/;
		$offset += $off->[1];
	}
	$offset;
}

sub datetime {
	my ($opt,$file,$datetime) = @_;

	usage("Can't understand [$file] Date/Time: $datetime")
		unless $datetime =~ /^(\d+)[:\/](\d+)[:\/](\d+)\s+(\d+):(\d+):(\d+)$/;
	my ($year,$mon,$day,$hour,$min,$sec) = ($1,$2,$3,$4,$5,$6);
	timelocal($sec,$min,$hour,$day,$mon-1,$year-1900) + offset($opt,$file);
}

my %DCACHE = {};
sub get_date {
	my ($opt,$file) = @_;

	return $DCACHE{$file} if $DCACHE{$file};

	# If jpeg, try jhead? (faster)
	if ($file =~ /jpe?g$/i) {
		open(JHEAD,"$JHEAD \Q$file\E |") || usage("Can't run: [$JHEAD]");
		while (<JHEAD>) {
			chomp;
			next unless m|Date/Time\s*:\s*(\S.*)|;
			close JHEAD;
			return ($DCACHE{$file}=datetime($opt,$file,$1));
		}
		close JHEAD;
	}

	# ExifTool
	open(EXIFTOOL,"$EXIFTOOL \Q$file\E |") || usage("Can't run: [$EXIFTOOL]");
	while (<EXIFTOOL>) {
		next unless /(Create Date|Date.*Original)\s*:\s*(\S.*)/;
		my $exifdate = $2;
		next if $exifdate =~ /^[0\s:]+$/;
		return ($DCACHE{$file}=datetime($opt,$file,$2));
	}
	close EXIFTOOL;

	# See if we can figure out the date from the file (year is 1900+ biased)
	#	 This has a Y2.1k bug!  ;)
	my ($year,$mon,$day,$hour,$min,$sec,$time);
	($year,$mon,$day,$time) = ($1,$4,$6,$7) if $file =~ /((19|20)\d\d)(-|\.| |)(\d{2})(-|\.| |)(\d{2})(.*)/;
	($day,$mon,$year,$time) = ($1,$3,$5,$7) if $file =~ /(\d{2})(-|\.| |)(\d{2})(-|\.| |)((19|20)\d\d)(.*)/;
	(undef $year,undef $mon,undef $day,undef $time) if $mon>12 || $day>31;
	return ($DCACHE{$file}=-1) unless $year;
	# Guess that the time may be in the excess field
	($hour,$min,$sec) = ($1,$2,$3) if $time =~ /(\d\d)(\d\d)(\d\d)/;
	return ($DCACHE{$file}=-1) if $hour>24 || $min>60 || $sec>60;
	return ($DCACHE{$file}=timelocal($sec,$min,$hour,$day,$mon-1,$year-1900)+offset($opt,$file));

	return ($DCACHE{$file}=-1);
}

sub captionsFile {
	my ($opt) = @_;
	my $cap = $opt->{files}[0];
	print STDERR "Sorting $cap\n";
	open(CAP,"<$cap") || usage("Couldn't read captions.txt [$cap]");
	my @files;
	my %comm;
	my %rest;
	my $warns = 0;
	while (<CAP>) {
		unless (/\S/) {
			print STDERR "Ignoring blank lines (line $.)\n";
			$warns++;
			next;
		}
		unless (/^(#?)(\S+)(\t.*)?$/) {
			print STDERR "Unknown captions line $.:\n  $_";
			$warns++;
			next;
		}
		my ($comm,$file,$rest) = ($1,$2,$3);
		unless (-e $file || -d $file) {
			print STDERR "Unknown file or directory in captions line $.:\n  $_";
			$warns++;
			next;
		}
		$comm{$file} = $comm;
		$rest{$file} = $rest;
		push(@files,$file);
	}
	close CAP;

	# Handle -missing
	if ($opt->{missing} && opendir(my $dir, '.')) {
		foreach my $file ( grep { !/^\./ } readdir($dir) ) {
			# Ignore tn, html, .txt files
			next if $file eq 'tn';
			next if $file =~ /\.(html|txt|xy)$/;
			next if grep { $_ eq $file } @files;
			push(@files,$file);
			$comm{$file} = '';
			$rest{$file} = '';
		}
	}

	my %date;
	foreach my $file ( @files ) {
		$date{$file} = get_date($opt,$file);
	}
	@files = sort {$date{$a}<=>$date{$b} || $a cmp $b} @files;

	# Save the old if we got confused anywhere
	if ($warns>0) {
		print STDERR "Saving $cap to $cap.bak\n";
		rename($cap,"$cap.bak");
	}

	# Now output the new captions.txt
	open(CAP,">$cap") || usage("Couldn't write captions.txt [$cap]");
		foreach my $file ( @files ) {
			next unless -d $file;
			print CAP "$comm{$file}$file$rest{$file}\n";
		}
		print CAP "\n";
		foreach my $file ( @files ) {
			next if -d $file;
			print CAP "$comm{$file}$file$rest{$file}\n";
		}
	close CAP;
}

##################################################
# Main code
##################################################
sub main {
	my $opt = parse_args();

	# One file that's a captions.txt?
	return captionsFile($opt) if ($#{$opt->{files}}==0);

	# Are we appending to a file?
	my @add;
	if ($opt->{add}) {
		open(ADD,"<$opt->{add}") || usage("Couldn't read -a file: [$opt->{add}]");
		@add = <ADD>;
		close ADD;
		@add = map { chomp; $_; } @add;
	}

	# Read/sort the date info for all the files
	my %date;
	foreach my $file ( @{$opt->{files}} ) {
		$date{$file} = get_date($opt,$file);
	}
	my @files = sort {$date{$a}<=>$date{$b} || $a cmp $b} @{$opt->{files}};

	if ($opt->{add}) {
		my @new;
		foreach my $a ( @add ) {
			if ($a =~ /^([^#\t]+)/) {
				my $addfile = $1;
				my $date = get_date($opt,$addfile);
				if ($date>0) {
					# Add to @new, first inserting anything from @files that has an earlier date
					while ( @files ) {
						last if $date{$files[0]}>$date;
						#print "CHECK $date{$files[0]} vs $addfile -> $date\n";
						push(@new,shift @files);
					}
				}
			}
			push(@new,$a);
		}
		push(@new,@files);	# The rest

		@files = @new;
	}

	map { print "$_\n"; } @files;
}
main();