#!/usr/bin/perl -w

# Description: a small script to change file info based on Exif data
# Author: Lilia <nursery at s8.xrea.com>
# License: Perl License
# Revision: 1.0.0.20051114
# Date: 2005-11-14 23:00:00 +09:00

# See also:
#   Description of Exif file format - http://park2.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html

use Image::Info qw(image_info);  # see http://search.cpan.org/perldoc?Image%3A%3AInfo
use Time::Local;
use Fcntl qw(:DEFAULT :flock);

use vars qw($Win32API_loaded);
BEGIN { # for Win32; see http://search.cpan.org/perldoc?Win32API%3A%3AFile%3A%3ATime
	$Win32API_loaded = 0;
	if($^O =~ /Win32/i) {
		eval q{ use Win32API::File::Time qw(:win);  1; }
			and $Win32API_loaded++;
	}
}
local *touch = ($Win32API_loaded && defined &SetFileTime) ? \&SetFileTime : \&_touch;

use strict;
use constant TIME       => time;
use constant EXCLUDE    => 1;
use constant COMPILED   => 1;

# config
our $Cfg = {
	Dirs        => [ '.', 'bak' ],  # list of directories to be searched for image files
	Image_RE    => [ qr/.+\.jpe?g$/i, 0, COMPILED ],  # regex, EXCLUDE (-> !/pat/ ) or 0, COMPILED (<- qr/pat/ ) or 0 (<- 'pat' )
	Stat        => 0,  # get the file's status or not (to touch, rename, or do something based on the status info)
	Rename      => 0,  # rename files based on Exif data (experimental; read and edit the code)
	History     => 'log-%s.txt',  # file path (e.g., 'log-%s.txt') or false
};

# Undo-mode: file path (the log file which was generated by this script and may have been renamed manually; e.g., 'undo.txt') or false
our $UNDO = 0;
#$UNDO = 'undo.txt';

# process single-character switches
use Getopt::Std;
our $Opt = {};
getopts('d:h:ru:' => $Opt);
@{$Cfg->{Dirs}} = split(':', $Opt->{d}) if defined $Opt->{d};   # $0 -d dir_path (if more than one, separate with colon; e.g., "dir1:dir2")
$Cfg->{History} = $Opt->{h}             if defined $Opt->{h};   # $0 -h logfile_path (to write)
$Cfg->{Rename}  = $Opt->{r}             if $Opt->{r};           # $0 -r
$UNDO           = $Opt->{u}             if defined $Opt->{u};   # $0 -u logfile_path (to undo)

$|++;
&process();
print "Finished.\n";

sub process {
	my @history;
	my($processed,$touched,$renamed,$error) = (0,0,0,0);
	my($fmt_touch_succ,$fmt_touch_fail) = (defined &SetFileTime)
		? ('Set file times for %s, %d/%d/%d', '! Unable to set file times for %s, %d/%d/%d')
		: ('Set file times for %s, %d/%d',    '! Unable to set file times for %s, %d/%d');

	if($UNDO) {
		print "Reading the history file to UNDO..\n";

		open(UNDO, '<', $UNDO)
			or die "Unable to open $UNDO: $!";
		flock(UNDO, LOCK_EX)
			or die "Unable to lock $UNDO: $!";

		print "Processing";
		while(<UNDO>) {
			next unless /^ rename \s+ (.+) \s+ => \s+ (.+) \s* $/ix;
			print '.';
			my($old_name,$new_name) = ($1,$2);
			my $old_name_orig = $old_name;
			my $i = 1;
			while(-f $old_name) {
				$old_name = $old_name_orig;
				my($base,$ext) = $old_name =~ /^(.*)\.([^\.]*)$/ ? ($1,$2) : ($_,'');
				$old_name =~ s/^\Q$base/${base}_$i/;
				$i++;
			}
			(rename $new_name => $old_name)
				? (push @history, sprintf('Rename %s => %s',                 $new_name, $old_name)     and $renamed++)
				: (push @history, sprintf('! Unable to rename %s => %s: %s', $new_name, $old_name, $!) and $error++);
			$processed++;
		}
		close(UNDO);
		print "\n";
		printf "%s %s processed%s%s\n",
			($processed ? sprintf('%d', $processed) : 'No'), ($processed != 1 ? 'files' : 'file'),
			($renamed ? sprintf('; %d %s renamed', $renamed, ($renamed > 1 ? 'files' : 'file')) : ''),
			($error   ? sprintf(', %d %s skipped', $error,   ($error   > 1 ? 'files' : 'file')) : '');
	} else {
		print "Searching files..\n";

		$Cfg->{Image_RE}->[1] ||= 0;
		$Cfg->{Image_RE}->[2] ||= 0;

		foreach my $dir (@{$Cfg->{Dirs}}) {
			my @files = dir_list($dir, @{$Cfg->{Image_RE}}, ($Cfg->{Stat} ? 0 : 1))
				or (print "No files found for specified criteria in the directory '$dir'\n" and next);  # not die
			printf "%d %s found to be processed in the directory '$dir'\n", scalar(@files), (@files > 1 ? 'files' : 'file');

			print "Processing";
			foreach my $file (@files) {
				print '.';
				my $info = image_info($file->{path});

				# rename (an example)
				if($Cfg->{Rename}) {
					if($info->{DateTimeOriginal} && $info->{DateTimeOriginal} =~ /^(\d\d\d\d)\D(\d\d?)\D(\d\d?)\D+(\d\d):(\d\d):(\d\d)/) {
						my $new_name = sprintf '%04d-%02d-%02d_%02d-%02d-%02d.%s', $1, $2, $3, $4, $5, $6, (defined $info->{file_ext} ? $info->{file_ext} : $file->{ext});
						$new_name =~ s/\.$//;
						RENAME: if($file->{name} ne $new_name) {
							my $new_name_orig = $new_name;
							my $i = 1;
							while(-f "$dir/$new_name") {
								$new_name = $new_name_orig;
								my($base,$ext) = $new_name =~ /^(.*)\.([^\.]*)$/ ? ($1,$2) : ($_,'');
								$new_name =~ s/^\Q$base/${base}_$i/;
								last RENAME if($file->{name} eq $new_name);
								$i++;
							}
							(rename $file->{path} => "$dir/$new_name")
								? (push @history, sprintf('Rename %s => %s',                 $file->{path}, "$dir/$new_name")     and $renamed++,
									# then update $file->{name} etc. too
									$file->{name} = $new_name,
									$file->{dir}  = $dir,
									$file->{path} = "$dir/$new_name",
									($file->{base},$file->{ext}) = $file->{name} =~ /^(.*)\.([^\.]*)$/ ? ($1,$2) : ($_,'')
								)
								: (push @history, sprintf('! Unable to rename %s => %s: %s', $file->{path}, "$dir/$new_name", $!) and $error++);
						}
					}
				}

				# touch -- set file times
				my $orig_time = 0;
				if($info->{DateTimeOriginal}) {
					$orig_time = date2time($info->{DateTimeOriginal});
				} elsif($file->{name} =~ /(\d\d)-(\d\d?)-(\d\d?)_(\d\d)-(\d\d)-?(\d\d)?/) { # an example (based on the file name)
					$orig_time = date2time(sprintf('%04d:%02d:%02d %02d:%02d:%02d', ($1 < 70 ? $1 +2000 : $1 +1900), $2, $3, $4, $5, ($6 ? $6 : 0)));
				}
				if($orig_time) {
					(touch($file->{path}, TIME, $orig_time, $orig_time))
						? (push @history, sprintf($fmt_touch_succ, $file->{path}, TIME, $orig_time, $orig_time) and $touched++)
						: (push @history, sprintf($fmt_touch_fail, $file->{path}, TIME, $orig_time, $orig_time) and $error++);
				}
				$processed++;
			}
			print "\n";
		}
		printf "%s %s processed%s%s\n",
			($processed ? sprintf('%d', $processed) : 'No'), ($processed != 1 ? 'files' : 'file'),
			($touched ? sprintf('; %d %s touched', $touched, ($touched > 1 ? 'files' : 'file')) : ''),
			($renamed ? sprintf(', %d %s renamed', $renamed, ($renamed > 1 ? 'files' : 'file')) : '');
		printf "%d %s occurred\n", $error, ($error > 1 ? 'errors' : 'error') if $error;
	}

	if($Cfg->{History} && @history) {
		my $datetime = datelocal(TIME);
		my $date_tag = sprintf '%04d%02d%02d_%02d%02d%02d_%s',
			($datetime =~ /^(\d\d\d\d)\D(\d\d)\D(\d\d) (\d\d):(\d\d):(\d\d)/), $$;
		my $log_file = sprintf $Cfg->{History}, $date_tag;

		sysopen(LOG, $log_file, O_WRONLY|O_APPEND|O_CREAT)
			or die "Unable to open $log_file: $!";
		flock(LOG, LOCK_EX)
			or die "Unable to lock $log_file: $!";
		seek(LOG, 0, 2);
		print LOG "# $datetime", ($UNDO ? ' *UNDO*' : ''), "\n";
		print LOG join "\n", @history;
		print LOG "\n\n";
		close(LOG);
	}
} # process end

sub dir_list(;$@) {
	my $dir = shift;
	$dir = '.' unless defined $dir;
	my($re,$x,$pre_compiled,$no_stat) = @_ ? @_ : ('^\.', 1, 0, 0);
	$re = qr/$re/ unless $pre_compiled;

	opendir(DIR, $dir)
		or die "Unable to opendir $dir: $!";

	my @files;
	if($no_stat) { # maybe more efficient than doing this: foreach( .. ) { if { .. } else { .. } }
		foreach(sort { lc($a) cmp lc($b) } grep { $x ? !/$re/ : /$re/ } readdir(DIR)) {
#			next unless -f "$dir/$_";
			my($base,$ext) = /^(.*)\.([^\.]*)$/ ? ($1,$2) : ($_,'');
			push @files, {
				name    => $_,
				path    => "$dir/$_",
				base    => $base,
				ext     => $ext,
				dir     => $dir,
			};
		}
	} else {
		foreach(sort { lc($a) cmp lc($b) } grep { $x ? !/$re/ : /$re/ } readdir(DIR)) {
			next unless -f "$dir/$_";
			my($base,$ext) = /^(.*)\.([^\.]*)$/ ? ($1,$2) : ($_,'');
			my @stat_ = stat _;
			push @files, {
				name    => $_,
				path    => "$dir/$_",
				base    => $base,
				ext     => $ext,
				dir     => $dir,
				dev     => $stat_[0],
				ino     => $stat_[1],
				mode    => $stat_[2],
				nlink   => $stat_[3],
				uid     => $stat_[4],
				gid     => $stat_[5],
				rdev    => $stat_[6],
				size    => $stat_[7],
				atime   => $stat_[8],
				mtime   => $stat_[9],
				ctime   => $stat_[10],
				blksize => $stat_[11],
				blocks  => $stat_[12]
			};
		}
	}
	closedir(DIR);
	return @files;
} # dir_list end

sub _touch($;@) {
	my $file = shift or return;
	my $atime = defined $_[0] ? $_[0] : TIME;
	my $mtime = defined $_[1] ? $_[1] : TIME;
#	my $ctime = defined $_[2] ? $_[2] : TIME;

	utime $atime, $mtime, $file;
} # _touch end

sub date2time($) { # converts "YYYY:MM:DD HH:MM:SS" into a UNIX timestamp
#	require Time::Local;
	my $str = shift or return undef;
	my $time = -1;
	if($str =~ /^(\d\d\d\d)\D(\d\d?)\D(\d\d?)\D+(\d\d):(\d\d):(\d\d)/) {
		$time = Time::Local::timelocal($6, $5, $4, $3, $2 -1, $1 -1900);
		return ($time < 0) ? undef : $time;
	} else {
		return undef;
	}
} # date2time end

sub datelocal(;$) {
	my $time = shift || time;
	my @date = localtime($time);
	sprintf '%04d/%02d/%02d %02d:%02d:%02d',
		$date[5] +1900, $date[4] +1, $date[3], $date[2], $date[1], $date[0];
} # datelocal end

# End of script