Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options

pobocks's scratchpad

by pobocks (Chaplain)
on Jan 14, 2009 at 07:04 UTC ( #736150=scratchpad: print w/replies, xml ) Need Help??

#!/usr/bin/perl use strict; use warnings; use Getopt::Std; use File::Find; my %opts; getopts('w:s:d:p:h', \%opts); #Options stand for width, source, and de +stination respectively $opts{s} = "./" unless $opts{s}; if ($opts{h}){ print <<EOD; Usage: -w WIDTH_IN_PIXELS -d DESTINATION_DIRECTORY + [-s source/directory (Default: "./"] Convert a number of .tif files to a number of .jpg files, resizing whe +re larger than -w Options: -w INT Desired width to resize pictures to. Any already under t +he limit will not be resized. -s STRING Directory to recursively search for pictures. (Default . +/) -d STRING Directory to place all pictures after conversion. -p INT Number of processes to run (Default 3) -h VOID Produce this help text EOD exit; } die "Destination directory is required - use -d option to set\n" unles +s $opts{d}; if ($opts{d} =~ /\/$/){ chop $opts{d}; } $opts{p} = 3 unless $opts{p}; die "No Width set - use -w option to set\n" unless $opts{w}; my @files; find(sub {push @files, $File::Find::name unless -d}, $opts{s}); my $pid; my @children; my $parent = $$; my $batch_size = int(($#files / $opts{p}) + $opts{p}); sub resize { for my $infile (@_){ if ($infile =~ m/(p\d\d\-\d\d-\d\d)\.tif/){ system('/opt/local/bin/convert', '-resize', "$opts{w}x>", $infil +e, "$opts{d}/$1.jpg"); } else { warn "File ($infile) does not match naming convention; skipping. +"; } } } while (my @batch = splice(@files, 0 , $batch_size)) { unless ($pid = fork()) { resize(@batch); exit; } if (defined $pid){ push @children, $pid; } else { die "Failed to fork!"; } } foreach (@children){ wait; }
Log In?

What's my password?
Create A New User
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (9)
As of 2018-06-24 17:44 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (126 votes). Check out past polls.