]> git.donarmstrong.com Git - bin.git/blob - archive_photos
switch to using myrepos instead of mr; properly handle xz archives
[bin.git] / archive_photos
1 #!/usr/bin/perl
2 # archive_photos archives photos into a directory structure
3 # and is released under the terms of the GNU GPL version 3, or any
4 # later version, at your option. See the file README and COPYING for
5 # more information.
6 # Copyright 2013 by Don Armstrong <don@donarmstrong.com>.
7
8
9 use warnings;
10 use strict;
11
12 use Getopt::Long;
13 use Pod::Usage;
14
15 =head1 NAME
16
17 archive_photos - archives photos into a directory structure
18
19 =head1 SYNOPSIS
20
21 archive_photos [options] path/to/photos [additional photos]
22
23  Options:
24   --recurse, -r recurse into subdirectories (default)
25   --archive-dir, -a directory to archive into (~/media/photos)
26   --debug, -d debugging level (Default 0)
27   --help, -h display this help
28   --man, -m display manual
29
30 =head1 OPTIONS
31
32 =over
33
34 =item B<--recurse, -r>
35
36 Recurse into subdirectories (default; use --no-recurse to disable
37
38 =item B<--archive-dir, -a>
39
40 Directory to archive to (default is ~/media/photos)
41
42 =item B<--debug, -d>
43
44 Debug verbosity. (Default 0)
45
46 =item B<--help, -h>
47
48 Display brief usage information.
49
50 =item B<--man, -m>
51
52 Display this manual.
53
54 =back
55
56 =head1 EXAMPLES
57
58 archive_photos
59
60 =cut
61
62
63 use vars qw($DEBUG);
64 use User;
65 use File::Find;
66 use Image::ExifTool qw(ImageInfo);
67 use POSIX qw(strftime);
68 use File::Copy;
69 use File::Path qw(make_path);
70 use File::Basename qw(dirname basename);
71 use Date::Parse qw(str2time);
72 use IPC::System::Simple qw(capturex);
73 use Digest::SHA qw(sha256_hex);
74
75 my %options = (debug           => 0,
76                help            => 0,
77                man             => 0,
78                archive_dir     => User->Home."/media/photos",
79                recurse         => 1,
80               );
81
82 GetOptions(\%options,
83            'archive_dir|archive-dir=s',
84            'recurse!',
85            'debug|d+','help|h|?','man|m');
86
87 pod2usage() if $options{help};
88 pod2usage({verbose=>2}) if $options{man};
89
90 $DEBUG = $options{debug};
91
92 my @USAGE_ERRORS;
93 if (not @ARGV) {
94      push @USAGE_ERRORS,"You must give at least one directory";
95 }
96
97 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
98
99 our @files;
100
101 # loads files into @files as appropriate
102 sub file_pusher {
103     if (-d $_ and not $options{recurse}) {
104         $File::Find::prune = 1;
105         return;
106     }
107     if (-f $_ and $_ =~ /\.(?:NEF|JPG|MOV)$/i) {
108         push @files,$File::Find::name;
109     }
110 }
111
112 my @dirs;
113
114 for my $arg (@ARGV) {
115     if (-d $arg) {
116         push @dirs,$arg;
117     } else {
118         push @files,$arg;
119     }
120 }
121
122 # search all of the directories and store the files in @files;
123 find(\&file_pusher,@dirs) if @dirs;
124
125 # find already existing files
126 my %existing_files;
127 find(sub { if (-f $_ or -l $_) {$existing_files{$_} = $File::Find::name;} },$options{archive_dir});
128
129 for my $file (@files) {
130     my $file_basename=basename($file);
131     # find out when the photo was shot
132     my $info = ImageInfo($file);
133     if (not defined $info->{CreateDate}) {
134         print STDERR "No date information for $file\n";
135         next;
136     }
137     my $epoch = str2time($info->{CreateDate});
138     my $dir = strftime('%Y/%m_%B/%Y_%m_%d/',localtime($epoch));
139     if (not -d $options{archive_dir}.'/'.$dir) {
140         make_path($options{archive_dir}.'/'.$dir) or
141             die "Unable to make dir $!";
142     }
143     my $end_location = $options{archive_dir}.'/'.$dir.$file_basename;
144     if (-e $end_location) {
145         print STDERR "$file already exists in $end_location\n";
146     } elsif (exists $existing_files{$file_basename} and
147              are_the_same_files({name => $existing_files{$file_basename}},
148                                {name => $file, info => $info})) {
149         print STDERR "$file already exists in $existing_files{$file_basename}\n";
150     } else {
151         print STDERR "copying $file to $end_location\n";
152         copy($file,$end_location);
153     }
154 }
155
156 # return true if the files are close enough that we should consider it
157 # the same picture
158 sub are_the_same_files{
159     my ($f1,$f2) = @_;
160     # load the exif information if we can
161     for my $f (@_) {
162         if (-e $f->{name}) {
163             $f->{exists} = 1;
164             if (not exists $f->{info} or not defined $f->{info}) {
165                 $f->{info} = ImageInfo($f->{name});
166             }
167         } else {
168             $f->{exists} = 0;
169         }
170     }
171     # if the files both exist, compare some exif information
172     if (defined $f1->{info} and $f2->{info}) {
173         if ($f1->{info}{CreateDate} eq $f2->{info}{CreateDate} and
174             $f1->{info}{Serial} eq $f2->{info}{Serial}
175            ) {
176             return 1;
177         } else {
178            return 0;
179         }
180     }
181     # ok; can't compare exif. Compare sha256 sums
182     for my $f (@_) {
183         if (-l $f->{name}) {
184             # this is probably a git annex file
185             $f->{sha256} = git_annex_sha256($f->{name});
186         } elsif (-e $f->{name}) {
187             $f->{sha256} = calc_sha256($f->{name})
188         }
189     }
190     # if the sha256 are equal, they're the same. if not, or if we
191     # can't compare, assume they're different.
192     if (defined $f1->{sha256} and
193         defined $f2->{sha256} and
194         $f1->{sha256} eq $f2->{sha256}
195        ) {
196         return 1;
197     } else {
198        return 0;
199     }
200 }
201
202 sub calc_sha256{
203     my ($fn) = @_;
204
205     my $sha = Digest::SHA->new(256);
206     $sha->addfile($fn);
207     return($sha->hexdigest());
208 }
209
210 sub git_annex_sha256 {
211     my ($fn) = @_;
212     my $info = capturex('git','-C',dirname($fn),'annex','info',basename($fn));
213     my ($sha256) = $info =~ /key:.+SHA256E-[^-]+--([^\.]+)/;
214     return $sha256;
215 }
216
217
218
219 __END__