--- /dev/null
+#!/usr/bin/perl
+# archive_photos archives photos into a directory structure
+# and is released under the terms of the GNU GPL version 3, or any
+# later version, at your option. See the file README and COPYING for
+# more information.
+# Copyright 2013 by Don Armstrong <don@donarmstrong.com>.
+
+
+use warnings;
+use strict;
+
+use Getopt::Long;
+use Pod::Usage;
+
+=head1 NAME
+
+archive_photos - archives photos into a directory structure
+
+=head1 SYNOPSIS
+
+archive_photos [options] path/to/photos [additional photos]
+
+ Options:
+ --recurse, -r recurse into subdirectories (default)
+ --archive-dir, -a directory to archive into (~/media/photos)
+ --debug, -d debugging level (Default 0)
+ --help, -h display this help
+ --man, -m display manual
+
+=head1 OPTIONS
+
+=over
+
+=item B<--recurse, -r>
+
+Recurse into subdirectories (default; use --no-recurse to disable
+
+=item B<--archive-dir, -a>
+
+Directory to archive to (default is ~/media/photos)
+
+=item B<--debug, -d>
+
+Debug verbosity. (Default 0)
+
+=item B<--help, -h>
+
+Display brief usage information.
+
+=item B<--man, -m>
+
+Display this manual.
+
+=back
+
+=head1 EXAMPLES
+
+archive_photos
+
+=cut
+
+
+use vars qw($DEBUG);
+use User;
+use File::Find;
+use Image::ExifTool qw(ImageInfo);
+use POSIX qw(strftime);
+use File::Copy;
+use File::Path qw(make_path);
+use File::Basename;
+use Date::Parse qw(str2time);
+
+my %options = (debug => 0,
+ help => 0,
+ man => 0,
+ archive_dir => User->Home."/media/photos",
+ recurse => 1,
+ );
+
+GetOptions(\%options,
+ 'archive_dir|archive-dir=s',
+ 'recurse!',
+ 'debug|d+','help|h|?','man|m');
+
+pod2usage() if $options{help};
+pod2usage({verbose=>2}) if $options{man};
+
+$DEBUG = $options{debug};
+
+my @USAGE_ERRORS;
+if (not @ARGV) {
+ push @USAGE_ERRORS,"You must give at least one directory";
+}
+
+pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
+
+our @files;
+
+# loads files into @files as appropriate
+sub file_pusher {
+ if (-d $_ and not $options{recurse}) {
+ $File::Find::prune = 1;
+ return;
+ }
+ if (-f $_ and $_ =~ /\.(?:NEF|JPG|MOV)$/i) {
+ push @files,$File::Find::name;
+ }
+}
+
+my @dirs;
+
+for my $arg (@ARGV) {
+ if (-d $arg) {
+ push @dirs,$arg;
+ } else {
+ push @files,$arg;
+ }
+}
+
+# search all of the directories and store the files in @files;
+find(\&file_pusher,@dirs) if @dirs;
+
+# find already existing files
+my %existing_files;
+find(sub { if (-f $_) {$existing_files{$_} = $File::Find::name;} },$options{archive_dir});
+
+for my $file (@files) {
+ my $file_basename=basename($file);
+ # find out when the photo was shot
+ my $info = ImageInfo($file);
+ if (not defined $info->{CreateDate}) {
+ print STDERR "No date information for $file\n";
+ next;
+ }
+ my $epoch = str2time($info->{CreateDate});
+ my $dir = strftime('%Y/%m_%B/%Y_%m_%d/',localtime($epoch)).'orig/';
+ if (not -d $options{archive_dir}.'/'.$dir) {
+ make_path($options{archive_dir}.'/'.$dir) or
+ die "Unable to make dir $!";
+ }
+ my $end_location = $options{archive_dir}.'/'.$dir.$file_basename;
+ if (-e $end_location) {
+ print STDERR "$file already exists in $end_location\n";
+ } elsif (exists $existing_files{$file_basename}) {
+ print STDERR "$file already exists in $existing_files{$file_basename}\n";
+ } else {
+ print STDERR "copying $file to $end_location\n";
+ copy($file,$end_location);
+ }
+}
+
+
+
+__END__