User Tools

Site Tools


software:fotosorting

multiple camera foto sorting using ExifTool and Perl

The script on this page helps to sort multiple pictures and movies chronologically from several cameras in different directories and sub-directories. With a very easy to use table, it is possible to set criteria which camera should have which time and date offset applied.
It uses the Perl ExifTool module to find out the camera model and Date/Time Original.

Script

#!/usr/bin/perl
BEGIN { unshift @INC, "/usr/local/bin/lib" }
# Issue following command:
#   export PERL5LIB='/usr/local/bin/lib/Image'
# or add following line:
#   use lib '/usr/local/bin/lib/Image';
use strict;
use warnings;
use Image::ExifTool;
use File::Find;
use File::Basename;
use Time::localtime;
use Time::Local;
use File::stat;
use File::Spec;
use Time::Piece;
use File::Copy;
 
# source for date reference:
# 0: file creation date (as with stat -f %SB $file)
# 1: exif:Date/Time Original
 
my @asset_data = (
 
	# files to ignore
	[ ".DS_Store", "", "", "", ""],
	[ ".app", "", "", "", ""],
	[ ".txt", "", "", "", ""],
	[ ".ods", "", "", "", ""],
	[ ".plist", "", "", "", ""],
	[ ".nib", "", "", "", ""],
	[ ".icns", "", "", "", ""],
 
	# files to process:
	# format: extension, offset ([-]HH:MM:SS), optional exif camera model, optional regex
	[ ".mov", 0, "00:01:48",  ""              , "^00004"],
	[ ".mov", 0, "00:01:08",  ""              , "^00005"],
	[ ".mov", 0, "-00:00:41",  ""              , "^00008"],
	[ ".JPG", 1, "02:00:03",  "NEX-5"         , "^DSC00009"],
	[ ".JPG", 1, "00:01:33",  "MK16i"         , ""],
	[ ".jpg", 1, "00:01:13",  "Canon EOS 70D" , ""], # IMG_xxxx.jpg
	[ ".JPG", 1, "-23:58:44",  "NEX-6"         , ""], # DSC03591.JPG
	[ ".JPG", 1, "-07:01:01",  "NEX-5R"        , ""], # From Toru
	[ ".JPG", 1, "02:00:03",  "NEX-5"         , ""], # From Sam, DSC00003.JPG has clock 
	[ ".JPG", 1,  "00:01:20",  "DMC-XS3"       , ""],
	[ ".JPG", 1, "-07:40:55",  "EX-H10"        , ""], # Was -07:43:00 - CIMG00000.JPG
	[ ".JPG", 1,  "-00:00:00",  "iPad Air"      , ""],
	[ ".jpg", 1,  "00:01:33",  "iPad Air"      , ""],
	[ ".AVI", 1, "-07:40:55",  "EX-H10"        , ""], # Was -07:36:56 - CIMG00000.JPG
    [ ".MOV", 0,  "-00:00:00",  ""              , "^IMG_[0-9]{4}"], # "iPad Air"
    [ ".mp4", 0,  "00:01:30",  ""              , "^MOV_[0-9]{4}"], # "MK16i"
    [ ".MOV", 0,  "00:01:13",  ""              , "^MVI_[0-9]{4}"], # "Canon EOS 70D"
    [ ".mp4", 0,  "00:01:33",  ""              , "^Buffet.*"], # Cam Rijn
    [ ".mp4", 0,  "00:01:33",  ""              , "^Concert.*"], # Cam Rijn
    [ ".MP4", 0,  "00:01:33",  ""              , "^Marc.*"], # Cam Sam
    [ ".mov", 0,  "00:00:23",  ""              , "^[0-9]{5}"] # Cam Okasan 00015.mov has clock
);
 
my $target = "/Volumes/targetdirectory/...etc/";
chdir($target) or die("Unable to chdir: $!");
my $dir =  "/Volumes/sourcedirectory/pictures/";
chdir($dir) or die("Unable to chdir: $!");
 
my $tool    = Image::ExifTool->new();
$tool      -> Options(FixBase => '');   # "best guess" for fixing Make +r offsets
 
# iterate through each and every file, by calling getfile as long as there is a file.
find(\&getfile, $dir);
 
sub getfile {
	analyze_file($File::Find::name);
	# filename: $_
	# full path: $File::Find::name
}
 
sub analyze_file {
	my $i = 0;
	my $r = 0;
	my $regx = "";
	if ( (defined $_[0]) && (length $_[0] > 0) ) {
		my $file = $_[0];
		my ($ext) = basename($file) =~ /(\.[^.]+)$/;
		if (defined $ext) {			
			do
			{
				if (($ext eq $asset_data[$i][0])) {
					if ($asset_data[$i][1] eq "") {
						# file to ignore
						$r = 1;
					} else {
						if ($asset_data[$i][4] ne "") {
						$regx = $asset_data[$i][4] . "\\" . $asset_data[$i][0] . "\$";
							if ($asset_data[$i][3] ne "") {
								# test for exif and regex
								if (regex_match(basename($file), $regx) > 0) {
									if (match_exif_model($file, $asset_data[$i][3])) {
										$r = 1;
										dcopy($file,$i);
										#print "Matching device and regex found: $file\n";
									}
								}
							} else {
								# test for regex only
								if (regex_match(basename($file), $regx) > 0) {
									$r = 1;
									dcopy($file,$i);
									# print "Matching regex found: $file\n";
								}
							}
						} else {
							if ($asset_data[$i][3] ne "") {
								# test for exif only
								if (match_exif_model($file, $asset_data[$i][3])) {
									$r = 1;
									dcopy($file,$i);
								}
							}
						}
					}
				}
				$i += 1;
			} while (($i <= $#asset_data) and ($r == 0));
 
			if ($r == 0) {
				print "$file could not be processed, extension was: $ext\n";
			}
		}
	}
}
 
sub match_exif_model {
	my $file = $_[0];
	my $exdv = $_[1];
	$tool -> ExtractInfo($file);
	my $camera  = $tool -> GetValue("Model");
	if ($camera eq $exdv) {
		# file has unknown exif defined camera
		return 1;
	} else {
		return 0;
	}
}
 
sub regex_match {
	my $file = $_[0];
	my $regx = $_[1];
	if ($file =~ $regx) {
		return 1;
	}
	return 0;
}
 
sub get_time_string {
	my $file = $_[0];
	my $ttype = $_[1];
	my $toffset = $_[2]; # offset in seconds
 
	if ($ttype == 0) {
		my $mt = localtime( stat($file)->mtime );
		# Add offset
		$mt = $mt + $toffset;
		my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mt);
		my $formatted = sprintf "%4u%02u%02u_%02u%02u%02u", $year+1900, $mon+1, $mday, $hour, $min, $sec;
		return $formatted;
	}
 
	if ($ttype == 1) {
		# http://www.perlmonks.org/?node_id=767176
		$tool -> ExtractInfo($file);
		my $info = $tool->ImageInfo($file, 'DateTimeOriginal');
		if (exists $info->{'DateTimeOriginal'}) {
			my @date = reverse(split(/[: ]/, $info->{'DateTimeOriginal'}));
			# Note that the month numbers must be shifted: Jan = 0, Feb = 1
  			--$date[4];
			# Convert to epoch time format
			my $time = timelocal(@date);
			# Add offset
			$time = $time + $toffset;
			my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
			my $formatted = sprintf "%4u%02u%02u_%02u%02u%02u", $year+1900, $mon+1, $mday, $hour, $min, $sec;
			return $formatted;
		}
		return "";
	}
 
	return "";
}
 
sub time_to_seconds {
	my ($time_str) = @_;
    my ($hours, $minutes, $seconds) = split(/:/, $time_str);
    my $sign = 1;
    if ($hours < 0 || $hours eq "-00") {
    	$sign = -1;
    }
    return $sign * (abs($hours) *  60 * 60 + $minutes * 60 + $seconds);
}
 
sub dcopy {
	my $file = $_[0];
	my $i = $_[1];
 
	my $newname = "";
	my $full_path = "";
	$newname = get_time_string($file, $asset_data[$i][1], time_to_seconds($asset_data[$i][2]))
	           . "." . basename($file);
	$full_path = File::Spec->catfile($target, $newname);
	print $newname . "\n";
	copy($file,$full_path) or die "Copy failed: $!";
	# file created: $file
	# offset required (in s): time_to_seconds($asset_data[$i][2])
}
software/fotosorting.txt · Last modified: 2016/04/20 03:50 by admin