################################################################################
# #
# ############################################################################ #
# # Title : move_n_sort # #
# # Description : Copies, parses, sorts. # #
# # Coded by : Justin Lee # #
# # Version : 0.1.3-RC1 # #
# # Date : Tuesday, February 19, 2008 # #
# # License : GNU General Public License v.2 # #
# # Copyright (C) 2008 Justin Lee <kool.name at gmail.com> # #
# ############################################################################ #
# #
# ############################################################################ #
# # This program is free software; you can redistribute it and/or # #
# # modify it under the terms of the GNU General Public License version 2 # #
# # as published by the Free Software Foundation. # #
# # # #
# # This program is distributed in the hope that it will be useful, # #
# # but WITHOUT ANY WARRANTY; without even the implied warranty of # #
# # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # #
# # GNU General Public License for more details. # #
# # # #
# # You should have received a copy of the GNU General Public License # #
# # along with this program; if not, write to the Free Software # #
# # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # #
# # 02110-1301, USA. Or, see: <http://www.gnu.org/licenses/> # #
# ############################################################################ #
# #
################################################################################
use strict;
use warnings;
use subs qw(inbox);
# use some nice modules
use File::Basename;
use IO::Handle;
use FileHandle;
use File::Copy qw(cp);
use File::Find;
use Image::MetaData::JPEG;
use Image::Magick;
use Getopt::Long qw(:config bundling);
# get my name, and where I live
use constant {
NAME => basename($0),
HOME => @{[ fileparse($0) ]}[1]
};
# open my library
use lib HOME . 'lib';
use Data::Logger;
# clean out our old logs
if (opendir(LOGS,HOME . 'logs')) {
my @logs = readdir(LOGS);
shift @logs; # kill .
shift @logs; # and ..
pop @logs; pop @logs; # we only keep
pop @logs; pop @logs; # four old ones
map {
unlink(HOME . 'logs/' . $_); # kill the rest (if any)
} @logs;
undef @logs;
closedir(LOGS);
}
# get our new log going
my $debug = new Data::Logger; # it's just that simple
# set my default command line variables
my (
$use_cli_progress_bar, # Use a crazy text-only progress bar.
$use_hidden_root_window, # Use Win32::GUI to hide the CMD window.
$use_verbose, # Display the log file in real time.
$use_logging, # Disable saving of the log file... Bad.
$orig_remove, # Do not unlink old pics from the camera.
$justin_is_sexy, # Well, I am.
$raw_dir_orig, # Specify where the camera stores it's pictures.
$raw_dir_new, # Specify where raw pictures are to be moved.
) = (
'','',
'', 1,
1, 1,
'E:/',
join(
'/',
split(/\\|\//,$ENV{USERPROFILE}),
'My Documents/My Pictures/From Camera/raws'
)
);
# get your command line options
GetOptions(
'progress-bar|P' => \$use_cli_progress_bar,
'hide-window|w' => \$use_hidden_root_window,
'verbose|v!' => \$use_verbose,
'raw-directory|R=s' => \$raw_dir_orig,
'local-directory|L=s' => \$raw_dir_new,
'logging!' => \$use_logging,
'remove-old!' => \$orig_remove,
'justin-is-sexy+' => \$justin_is_sexy,
'help|h|H' => \&print_help
);
# check if I'm shy
if ($use_hidden_root_window) {
require Win32::GUI;
my $root = Win32::GUI::GetPerlWindow();
Win32::GUI::Hide($root);
}
# make sure we have both directories
$debug->die('raw dir not accessible') unless -d $raw_dir_orig;
$debug->die('local dir not accessible') unless -d $raw_dir_new;
$debug->log('we got our dirs');
# clean and prime our best smokin' pipe
my ($on_its_way, $work_to_do);
pipe $on_its_way, $work_to_do or die;
$work_to_do->autoflush(1);
$debug->log('we\'re primed for smoking.');
# enter new raw directory
chdir($raw_dir_new) or $debug->die($!);
$debug->log('we\'re home, let\'s do some housekeeping');
# do some housekeeping
unlink(<*.jpg>);
unlink(<*.jpeg>);
# part ways with my child, you didn't know I had one?
$debug->log('time to split');
if (my $pid = fork) {
print $debug->tstamp, " - Welcome to the picture syncer!\n";
# have a nap now that I'm finally alone
$debug->log('Having a nap..');
sleep 1;
$debug->log('i\'m up');
# wait for a call from my child
if (inbox) {
$debug->log('got a call from the kid');
while (inbox) {
$debug->log('awaiting file');
# get returned basename from move()'r
my $path = inbox;
$debug->die unless $path;
$debug->log("File recieved ($path)");
print $debug->tstamp, " - Work on $path.....";
# get date
my $image = new Image::MetaData::JPEG ($path);
my $exif = $image->get_Exif_data('IMAGE_DATA', 'TEXTUAL');
my ($date,
$time) = split(/\s+/,$exif->{DateTimeOriginal}->[0]);
$date =~ s/:/-/go;
$debug->log("date aquired ($date)");
# make a new directory if I don't already have one
unless (-d $date) {
mkdir($date,0777) or $debug->die;
$debug->log('directory created');
}
# make our image magick object
my $magick = new Image::Magick;
$magick->Read($path);
$debug->log('the magician is ready');
$debug->log("work on `$path' for `$date' started");
# resize the pic
$magick->[0]->Resize(
geometry => '52%',
filter => 'sinc'
);
$debug->log(' > Resized');
# crop the pic
$magick->[0]->Crop(
geometry => '1600x1200'
);
$debug->log(' > Cropped');
# save the new image with a comment
$magick->[0]->Write(
filename => join('/',$date,$path),
comment => 'Captured by: Justin Lee < kool.name at gmail.com >',
quality => 97
);
$debug->log(' > Written');
# unlink the old pic
$debug->die unless -e join('/',$date,$path);
unlink $path;
undef $magick;
$debug->log(' > Hands washed');
$debug->log("work on `$path' for `$date' ended");
print "done!\n";
}
$debug->log('looks like we\'re almost done');
}
} elsif (defined $pid) {
# first thing I do away from my parent...
# start smoking
print $work_to_do "start\n";
# find some jpeg's
find(
{
no_chdir => 1,
wanted => sub {
# we only want jpegs (or JPGs or JPEGs or jpgs)... regex <3
return unless $_ =~ /jpe?g$/oi;
# tell the parent we're now copying, they should get ready
print $work_to_do "copying\n";
# copy and send the basename
print $work_to_do move($_), "\n";
}
},
# where to look
$raw_dir_orig
);
# move back in with the parent
print $work_to_do "done\n";
} else {
# couldn't separate from the parent.
$debug->die($!);
}
# done!
$debug->log('well that was fun');
$debug->close;
# check if I was shy
if ($use_hidden_root_window) {
require Win32::GUI;
my $root = Win32::GUI::GetPerlWindow();
Win32::GUI::Show($root);
}
exit 0;
# pretty *drools*
sub move {
my $o_pth = shift;
my $n_pth = $raw_dir_new . '/' . basename($o_pth);
my $o_fh = new FileHandle $o_pth, "<";
my $n_fh = new FileHandle $n_pth, ">";
return unless defined $o_fh;
return unless defined $n_fh;
return unless cp($o_fh,$n_fh);
undef $o_fh;
undef $n_fh;
return unless unlink ($o_pth);
return basename($n_pth);
}
sub inbox {
chomp(my $in = <$on_its_way>);
return 0 unless $in;
return 0 if $in =~ /^(?:0|n(?:o(?:pe)?)?|done)$/io;
return 1 if $in =~ /^(?:1|y(?:e(?:a?h|s)|up)?|copy|start)$/io;
return $in;
}
sub print_help {
print <<"EOH";
Name : \u@{[ NAME ]} - Automatically move, compress and sort your pictures.
Usage : @{[ NAME ]} [options]
Description : \u@{[ NAME ]} is a script written for moving and compressing pictures
from your camera to a local folder. The pictures are stored in
directories named with ISO-like dates of `yyyy-mm-dd'.
Options :
-h, -H, --help
Prints this message.
-w, --hide-window
Use Win32::GUI to hide the console window.
-P, --progress-bar
Display a crude text progress bar.
-v, --verbose, --no-verbose
Display the log file in real time. (--no-verbose is default)
-R, --raw-directory < /path/to/camera/raws/ >
Specifies the path to the camera raws. It can also be specified
with -I in the setup file. Note that this is a required piece of
data.
-L, --local-directory < /path/to/new/files/ >
Specifies the place to save the sorted pictures and directories.
Defaults to `@{[ $ENV{'USERPROFILE'} . '/My Documents/My Pictures/From Camera/raws' ]}'.
--remove-old, --no-remove-old
Specifies whether or not to remove the original raws from the camera
directory. The default is to remove them. (--remove-old is default)
--logging, --no-logging
Keeps log files in @{[ HOME ]}logs (default). It is not recommended
to use --no-logging.
EOH