Part of Slepp's Projects — Pastebin — TURL — Imagebin — Filebin
Feedback -- English French German Japanese
Create Upload Newest Tools Donate
Sign In | Create Account

Paste Actions

Download Raw
Embed
Post to Twitter
Remove Paste

Paste Details

Perl Source format, 4 years 1 month old, and 105 hits.

Advertising

lalala-imagemagickisajerk
Wednesday, April 2nd, 2008 at 10:47:13pm MDT 

  1. # version 3
  2. # don't steal it
  3. # or else
  4.  
  5. use strict;
  6. use warnings;
  7. use subs qw(inbox);
  8. use File::Basename; # imports basename()
  9. use IO::Handle;
  10. use FileHandle;
  11. use File::Copy; # imports copy()
  12. use File::Find; # imports find()
  13. use Image::MetaData::JPEG;
  14. use Image::Magick;
  15. use Getopt::Long qw(:config bundling);
  16. use Deans::Functions qw( skew ); # imports skew()
  17. use constant {
  18.   NAME => basename($0),
  19.   HOME => skew(@{[ fileparse($0) ]}[1])
  20. };
  21.  
  22. ## get the command line args
  23. my (
  24.   $orig_remove,             # Do not unlink old pics from the camera.
  25.   $justin_is_sexy,          # Well, I am.
  26.   $image_format_regex,      # The regex that find will use to see if it's found a valid file.
  27.   $raw_dir_orig,            # Specify where the camera stores it's pictures.
  28.   $raw_dir_final,           # Specify where raw pictures are to be moved.
  29.   $raw_dir_temp             # Specify a pictures will be worked on.
  30. ) = (
  31.   1,
  32.   1,
  33.   'hpim(\d+)\.jpe?g$',
  34.   'P:/',
  35.   skew($ENV{USERPROFILE},'My Documents/My Pictures/From Camera/raws'),
  36.   $ENV{TEMP}
  37. );
  38.  
  39. GetOptions(
  40.   'raw-directory|R=s'    => \$raw_dir_orig,
  41.   'local-directory|L=s'  => \$raw_dir_final,
  42.   'temp-directory|T=s'   => \$raw_dir_temp,
  43.   'remove-old!'          => \$orig_remove,
  44.   'image-format-regex=s' => \$image_format_regex,
  45.   'help|h|H'             => \&print_help
  46. );
  47.  
  48. ## test the directories, and enter the temp dir
  49. die $! unless -d $raw_dir_orig;
  50. die $! unless -d $raw_dir_final;
  51. die $! unless -d $raw_dir_temp;
  52. die $! unless chdir($raw_dir_temp);
  53.  
  54. ## check if there's already a temp dir, if not make one
  55. unless (-d 'MNSPICMAN') {
  56.   die $! unless mkdir('MNSPICMAN',0777);
  57. }
  58. die $! unless chdir('MNSPICMAN');
  59. unlink(<*.jpg>);
  60. unlink(<*.jpeg>);
  61.  
  62. ## prime our best smokin' pipe
  63. my  ($from_file_manager, $to_compressor);
  64. pipe $from_file_manager, $to_compressor or die $!;
  65. $to_compressor->autoflush(1);
  66.  
  67. ## FORK!
  68. if (my $pid = fork) { ## parent (compresses)
  69.   while (inbox) {
  70.     my $dir  = inbox;
  71.     my $path = inbox;
  72.     die $! unless defined $dir;
  73.     die $! unless defined $path;
  74.     my $file = skew($dir,join('',split(/_TEMP_/,$path))); #haha, screw off
  75.     print "$file";
  76.  
  77.     my $magick = new Image::Magick;
  78.        $magick->Read($path);
  79.  
  80.     $magick->[0]->Resize(
  81.       geometry => '52%',
  82.       filter   => 'sinc'
  83.     );
  84.  
  85.     $magick->[0]->Crop(
  86.       geometry => '1600x1200'
  87.     );
  88.  
  89.     $magick->[0]->Write(
  90.       filename => $file,
  91.       comment  => 'Captured by: Justin Lee (kool.name@gmail.com)',
  92.       quality  => 97
  93.     );
  94.  
  95.     die $! unless -e $file;
  96.     undef  $magick;
  97.     unlink $path;
  98.     print "...done\n";
  99.   }
  100.  
  101.   print "DONE!\n";
  102.  
  103. } elsif (defined $pid) { ## child (copies and dates pictures)
  104.   print "welcome\n";
  105.   find(
  106.     { no_chdir => 1,
  107.       wanted   => \&copy_date_move },
  108.     $raw_dir_orig
  109.   );
  110.  
  111.   print $to_compressor "done\n";
  112. } else { ## fork failed
  113.   die $!;
  114. }
  115.  
  116. ## the end
  117. exit 0;
  118.  
  119. ## subs
  120. sub inbox {
  121.   chomp(my $in = <$from_file_manager>);
  122.  
  123.   return   0 unless $in;
  124.   return   0 if $in =~ /^(?:0|done|failed)$/io;
  125.   return   1 if $in =~ /^(?:1|working)$/io;
  126.   return $in;
  127. }
  128.  
  129. sub copy_date_move {
  130.   return unless $_ =~ /$image_format_regex/oi;
  131.   my $id = defined($1) ? $1 : '';
  132.   print $to_compressor "working\n";
  133.  
  134.   my $old = $_;
  135.   my $new = basename($old); #this is okay, you'll see
  136.   move($old,$new);
  137.  
  138.   my  $image = new Image::MetaData::JPEG ($new);
  139.   my  $exif  = $image->get_Exif_data('IMAGE_DATA', 'TEXTUAL');
  140.   my ($date,
  141.       $time) = split(/\s+/,$exif->{DateTimeOriginal}->[0]);
  142.   $date =~ s/:|\s|;/-/go;
  143.   $time =~ s/:|\s|-|;//go;
  144.   chop($time); #wtf
  145.  
  146.   my $dated_dir = skew($raw_dir_final,$date);
  147.   unless (-d $dated_dir) {
  148.     die $! unless mkdir($dated_dir,0777);
  149.   }
  150.   print $to_compressor "$dated_dir\n";
  151.  
  152.   my $to_compress = "${time}${id}_TEMP_.JPG";
  153.   die $! unless move($new,$to_compress);
  154.  
  155.   undef $image;
  156.   undef $exif;
  157.  
  158.   print $to_compressor "$to_compress\n";
  159.   return;
  160. }
  161.  
  162. sub print_help {
  163.   print <<"EOH";
  164.  
  165. Name          : \u@{[ NAME ]} - Automatically move, compress and sort your pictures.
  166. Usage         : @{[ NAME ]} [options]
  167. Description   : \u@{[ NAME ]} is a script written for moving and compressing pictures
  168.                 from your camera to a local folder. The pictures are stored in
  169.                 directories named with ISO-like dates of `yyyy-mm-dd'.
  170. Options       :
  171.   -h, -H, --help
  172.     Prints this message.
  173.  
  174.   -R, --raw-directory < /path/to/camera/raws/ >
  175.     Specifies the path to the camera raws.  It can also be specified
  176.     with -I in the setup file.  Note that this is a required piece of
  177.     data.
  178.  
  179.   -L, --local-directory < /path/to/new/files/ >
  180.     Specifies the place to save the sorted pictures and directories.
  181.     Defaults to `@{[ skew($ENV{'USERPROFILE'},'/My Documents/My Pictures/From Camera/raws') ]}'.
  182.  
  183.   -T, --temp-directory < /path/to/temp/files/ >
  184.     Specifies the place to store pictures while they are being worked on.
  185.     Defaults to `@{[ skew($ENV{'TEMP'}) ]}'.
  186.  
  187.    --image-format-regex
  188.     Specifies the regex that find() will use to see if it's found a valid file.
  189.     Defaults to `^hpim(\\d+)\\.jpe?g$', uses /i.  You can have one backtrace for
  190.     use in the final file name.
  191.  
  192.    --remove-old, --no-remove-old
  193.     Specifies whether or not to remove the original raws from the camera
  194.     directory.  --remove-old by default.
  195.  
  196. EOH
  197.  
  198.   exit 0;
  199. }

Paste Details

Tags: magic perl image magick manage

advertising

Update the Post

Either update this post and resubmit it with changes, or make a new post.

You may also comment on this post.

update paste below
details of the post (optional)

Note: Only the paste content is required, though the following information can be useful to others.

Save name / title?

(space separated, optional)



Please note that information posted here will expire by default in one month. If you do not want it to expire, please set the expiry time above. If it is set to expire, web search engines will not be allowed to index it prior to it expiring. Items that are not marked to expire will be indexable by search engines. Be careful with your passwords. All illegal activities will be reported and any information will be handed over to the authorities, so be good.

fantasy-obligation