-
Notifications
You must be signed in to change notification settings - Fork 0
/
exifsort
executable file
·367 lines (285 loc) · 11.3 KB
/
exifsort
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
#!/usr/bin/env perl
use 5.010; # minimum Perl version 5.010 "five-ten"
use warnings;
use strict;
# ------------------------------------------------------------
# SHARED LIBRARIES
# ------------------------------------------------------------
# You will need to install the non-core libraries yourself.
# Those are Image::ExifTool, File::Util, and Try::Tiny
use Image::ExifTool;
use File::Util;
use File::Copy 'move';
use Try::Tiny;
use Getopt::Long;
use Digest::MD5 'md5_hex';
use File::Basename 'basename';
use File::Basename 'fileparse';
# ------------------------------------------------------------
# THE SETUP
# ------------------------------------------------------------
# set default parameters, get user input, validate input
my $opts =
{
src => undef,
dest => undef,
force => 0,
test => undef,
help => undef,
};
GetOptions
(
'source|s=s' => \$opts->{src},
'destination|d=s' => \$opts->{dest},
'force|f' => \$opts->{force},
'test|t' => \$opts->{test},
'help|h|?' => \$opts->{help},
) or die usage();
print usage() and exit if $opts->{help} || ! $opts->{dest} || ! $opts->{src};
die qq("$opts->{src}" is either not a directory or not writable by you.)
if defined $opts->{src} && ( ! -w $opts->{src} || ! -d $opts->{src} );
# ------------------------------------------------------------
# PROGRAM EXECUTION (it really is this simple)
# ------------------------------------------------------------
# File::Util will let us do easy directory traversal. Configure the
# $ftl object to warn on errors instead of die in the middle of the
# program when there might still be files to process
my $ftl = File::Util->new( { onfail => 'warn', read_limit => 21474836480 } );
# clean up the destination path. We have to be careful with paths that
# are simply "." or "./" because when joined to the date-based directory
# tree they could otherwise become something quite different like:
# ".YYYY/MM" or ".//YYYY/MM" or "/YYYY/MM"
$opts->{dest} =~ s(^\./)();
$opts->{dest} =~ s(/+$)() unless $opts->{dest} eq '/';
# moving photos and movies to the root directory would almost certainly
# be a mistake. I just decided to disallow it.
die qq(Moving photos to "/" is not supported\n) if $opts->{dest} =~ /^\/+$/;
# initialize count variables to report how many files were moved/renamed/deleted
my $test_moved = 0;
my $test_renamed = 0;
my $test_deleted = 0;
my $moved = 0;
my $renamed = 0;
my $deleted = 0;
my $failed = 0;
my $duplicates = 0;
my $dup_md5_match = 0;
my $dup_md5_diff = 0;
# this kicks off the directory traversal, executing the file relocation
# callback for every subdirectory it encounters:
$ftl->list_dir( $opts->{src} => { recurse => 1, callback => \&move_files } );
# report what we did
printf qq{TEST MOVED: %s\n}, $test_moved;
printf qq{TEST DELETED: %s\n}, $test_deleted;
printf qq{TEST RENAMED: %s\n}, $test_renamed;
printf qq{MOVED: %s\n}, $moved;
printf qq{DELETED: %s\n}, $deleted;
printf qq{RENAMED: %s\n}, $renamed;
printf qq{FAILED: %s\n}, $failed;
printf qq{DUPLICATE FILES: %s\n}, $duplicates;
printf qq{ MD5 MATCHES: %s\n}, $dup_md5_match;
printf qq{ MD5 DIFFS: %s\n}, $dup_md5_diff;
# ------------------------------------------------------------
# SUBROUTINES (most of the logic is here)
# ------------------------------------------------------------
# This is just the help message:
sub usage { <<'__USAGE__' }
USAGE:
exifsort --source ./path/to/source/ --destination ./path/to/dest/ --test --force
DESCRIPTION:
exifsort organizes pictures and movies into a date-based directory hierarchy
derived from the embedded EXIF data in the actual media files themselves.
The directory hierarchy may or may not already exist. The layout is
compatible with shotwell and f-spot. It looks like this: $TARGET/YYYY/MM
ARGUMENTS AND FLAGS:
-s, --source Path to the directory that contains the images/movies that
you want to sort into an organized destination directory.
-d, --destination Path to the directory where the date-based organized
directory tree begins. Example: /home/tommy/media
-t, --test Don't actually move any files. Just show on the terminal
screen what exifsort would have done.
-f, --force Make exifsort overwrite files in destination directories
that have the same name as the source file when the md5
sum matches. If the md5 sum is different, append to the
filename and save the copy. By default, exifsort won't
overwrite files with the same name.
__USAGE__
# This is the callback used by File::Util when traversing the source
# directory tree looking for images recursively. It stitches together
# the two primary tasks of this program, which are to identify EXIF dates
# and then move files around to where they are supposed to go.
sub move_files
{
my ( $selfdir, $subdirs, $files ) = @_;
move_file_by_date( $_ => get_exif_date( $_ ) ) for @$files;
}
# This sub uses Image::ExifTool to pull relevant time stamps out of
# the image/movie files. First it tries to get the original date
# that the picture/movie was taken. Failing that it tries to get
# the last-modified date timestamp from EXIF, and then the file.
# * This method does not take into account time zones.
sub get_exif_date
{
my $file = shift;
my $exift = Image::ExifTool->new;
$exift->ExtractInfo( $file );
#printf qq{DateTimeOriginal: %s\n}, $exift->GetValue( DateTimeOriginal => $file ) || "";
#printf qq{DateAcquired: %s\n}, $exift->GetValue( DateAcquired => $file ) || "";
#printf qq{FileModifyDate: %s\n}, $exift->GetValue(FileModifyDate => $file ) || "";
my $date = $exift->GetValue( CreateDate => $file );
#$date ||= $exift->GetValue( DateAcquired => $file );
#$date ||= $exift->GetValue( FileModifyDate => $file );
# Fix bad EXIF dates.
unless ( !$date ) {
$date =~ s/\//\:/g;
}
unless ( $date )
{
$date = ( stat $file )[ 8 ];
my ( $y, $m ) = ( localtime ( $date ) )[ 3, 4 ];
$m += 1;
$y += 1900;
# this normalizes to the format we are already getting from EXIF
$date = join ':', $y, $m;
}
return $date;
}
# Based on the date of the file, move it to a YYYY/MM file heirarchy
# under the $opts->{dest} directory. If running in test mode, just
# print out what would have been done if you were not. Handles same-name
# files with care (you have to use -f or --force to overwrite)
sub move_file_by_date
{
my ( $src_file, $date ) = @_;
my $y;
my $m;
( $y, $m ) = $date =~ /^(\d+):(\d+)/;
# extra output if you want to verify exif data read vs output destination
print "\n" . 'file: ' . $src_file . ' - ' . 'Original date: ' . $date . "\n";
# quick, reformat the month like this: 01-January
$m = (
qw/ 00-Unknown 01-January 02-February 03-March
04-April 05-May 06-June
07-July 08-August 09-September
10-October 11-November 12-December /
)[$m];
if ( !length $m )
{
$m = '00ps how did that happen';
}
# use unknown_date if file didn't contain a valid exif date
my $date_tree;
if ( $y < 1995 )
{
$date_tree = "unknown_date";
}
else
{
$date_tree = sprintf '%s/%s', $y, $m;
}
my $dest_dir = $opts->{dest};
if ( $dest_dir eq '.' || $dest_dir eq '' )
{
$dest_dir = './' . $date_tree;
}
else
{
$dest_dir = $dest_dir . '/' . $date_tree;
}
try
{
my $dest_file = $dest_dir . '/' . basename $src_file;
if ( -e $dest_file )
{
$duplicates++;
if ( ! $opts->{force} )
{
printf qq{!! "%s" ALREADY EXISTS. WILL DELETE SOURCE FILE WITH --force\n},
$dest_file;
my $src_sum = md5_hex( $ftl->load_file( $src_file ) );
my $dst_sum = md5_hex( $ftl->load_file( $dest_file ) );
printf qq{ ...SOURCE: %s\n}, $src_sum;
printf qq{ .....DEST: %s\n}, $dst_sum;
print $src_sum eq $dst_sum
? " ...RESULT: SAME\n\n"
: " ...RESULT: DIFFERENT\n\n";
if ( $src_sum eq $dst_sum )
{
$dup_md5_match++;
}
else
{
$dup_md5_diff++;
}
}
else
{
# if file exists and you use -f or --force, only overwrite IF md5 sum matches, otherwise rename file and move
my $src_sum = md5_hex( $ftl->load_file( $src_file ) );
my $dst_sum = md5_hex( $ftl->load_file( $dest_file ) );
printf qq{ ...SOURCE: %s\n}, $src_sum;
printf qq{ .....DEST: %s\n}, $dst_sum;
if ( $src_sum eq $dst_sum )
{
# if the md5 sums are equal, we can safely remove the duplicate from the source
$dup_md5_match++;
if ( $opts->{test} )
{
$test_deleted++;
printf qq{%-40s => TESTING - NOT DELETING DUPLICATE %s\n}, $src_file;
return;
}
$ftl->make_dir( $dest_dir => { if_not_exists => 1, onfail => 'die' } );
# if source and destination are the same, it's NOT SAFE to delete the source, as that is the only copy
if ( $src_file eq $dest_file )
{
printf qq{%s = %s - SOURCE AND DESTINATION MATCH, WILL NOT DELETE SINGLE REMAINING COPY OF FILE\n}, $src_file, $dest_file;
}
else
{
# safe to delete duplicate from source
unlink $src_file or die $!;
printf qq{%-40s => DELETING DUPLICATE FROM SOURCE\n}, $src_file;
$deleted++;
}
}
else
{
# since the md5 sums are not equal, but we want to force move, let's rename the destination filename to prevent overwriting
$dup_md5_diff++;
my ($new_dest_file, $file_path, $file_ext) = fileparse($dest_file, '\.[^\.]*');
$new_dest_file = $dest_dir . '/' . $new_dest_file . '_1' . $file_ext;
if ( $opts->{test} )
{
$test_renamed++;
printf qq{%-40s => TESTING - NOT MOVING AND RENAMING TO %s\n}, $src_file, $new_dest_file;
return;
}
$ftl->make_dir( $dest_dir => { if_not_exists => 1, onfail => 'die' } );
move $src_file, $new_dest_file or die $!;
printf qq{%-40s => MOVED AND RENAMED TO %s\n}, $src_file, $new_dest_file;
$renamed++;
}
}
}
else
{
if ( $opts->{test} )
{
$test_moved++;
printf qq{%-40s => TESTING - NOT MOVING TO %s\n}, $src_file, $dest_dir;
return;
}
$ftl->make_dir( $dest_dir => { if_not_exists => 1, onfail => 'die' } );
move $src_file, $dest_file or die $!;
$moved++;
printf qq{%-40s => MOVED TO %s\n}, $src_file, $dest_dir;
}
}
catch
{
$failed++;
printf qq{%-40s => FAILED TO MOVE FILE!\n}, $src_file, $y, $m;
warn $_;
}
}