基于perl的用convert批量转换某个目录下的图片到另外一个目录的脚本

因为需要，把原先几M大小的图片，转换为一般大小上传网络使用。看到convert命令可以实现转换，命令很简单：
convert -resize weightxheight source_file target_file
这个weight和height是宽和高，图片按照最大的限度按照比例进行resize，如果需要强制成某个size，只需要在resize的值后面加个叹号：
conver -resize weightxheight! source_file target_file

perl脚本来做这个事情，首先把源路径计算出来。判断输入参数是绝对路径，就使用该路径，否则为当前路径/源路径。再计算目标路径，本脚本自动定义目标路径为”源路径_weightxheight“。
然后perl用opendir读取源目录，数出.jpg图片的数量，如果无，则不进行转换了。
图片有，生成目标目录，循环遍历，利用convert进行转换，就是这样子的。

下面是代码

#!/usr/bin/perl


############################################################

#

# picresize.pl, v 0.1

#

# author: dorainm

# mail: [e-mail]

#

# resize pics from one path to another within convert

#

############################################################


use strict;
use File::Basename qw/basename dirname/;
use IO::Handle;
use Digest::MD5;


STDOUT->autoflush( 1 );

# usage

my ( $arg_path, $arg_size ) = @ARGV;
die( "usage: " . &appname() . " PATH RESIZE(widthxheight)\n" ) unless $arg_path && $arg_size;
die( "RESIZE must has the format as widthxheight\n" ) unless $arg_size =~ /^[0-9]+x[0-9]+[!]*$/;

# get operation size

my $basedir = $ENV{'PWD'} . '/';
if ( $arg_path =~ /^\// )
{
    $basedir = $ARGV[0] . '/';
}
else
{
    $basedir .= $ARGV[0] . '/';
}
my $targetdir = $basedir;
$targetdir =~ s/([^\/]+)\/$/$1_$arg_size\//m;


print "Source : $basedir ... ";
opendir( my $dir, $basedir )
    || die ( "Can not get the list from dir $basedir\n" );
my @imgs;
while ( my $file = readdir($dir) )
{
    next unless $file =~ /\.jpg$/im;
    push( @imgs, $file );
}
closedir( $dir );
my $count = $#imgs + 1;

die ( "No Images!!\n" ) if $count<=0;
print "$count P(s)\n";

print "Target : $targetdir\n";
`mkdir -p $targetdir`;

print "Resize : $arg_size\n";
for ( my $i=1; $i<=$count; $i++ )
{
    my $img = $imgs[$i-1];
    print "\r[$i/$count] convert $img ... ";
    `convert -resize $arg_size $basedir/$img $targetdir/$img`;
}
print "All done.\n";

# create the target dir


exit;


print "O.SYSTEM: $^O\n";
print "APP_NAME: ".&appname()."\n";
print "APP_PATH: ".&apppath()."\n";
print "DATETIME: ".&getdatetime()."\n";


############### common codes zone ##########################


sub apppath
{
    my $pwd = $ENV{'PWD'};
    my $scp = $0;
    my $file;
    my $dir;
    
    if( $scp =~ m/^\/.*/ )
    {
        $file = $scp;
    }
    else
    {
        $file = $pwd . "/" . $scp;
    }
    $file =~ s/(.*)\/.*$/$1\//;    # dir path

    $file =~ s/\/[^\/]*\/\.\.//g;    # replace /*/.. -> /

    $file =~ s,\/\.\/,\/,g;        # replace /./ -> /

    $file =~ s,\/\/,\/,g;        # replace // -> /

    return $file;
}

sub appname
{
    my $scp = $0;
    
    ## real path??

    $scp =~ m/(.*)\/(.*)$/;
    return $2;
}


sub getdate($offset='0')
{
    my $offset = $_[0];
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime(time()+$offset*24*60*60);
    $mon++;
    $year+=1900;

    my $retval = sprintf "%04d-%02d-%02d", $year, $mon, $mday, $hour, $min, $sec;
    return $retval;
}

sub gettime($offset='0')
{
    my $offset = $_[0];
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime(time()+$offset*24*60*60);
    $mon++;
    $year+=1900;

    my $retval = sprintf "%02d:%02d:%02d", $hour, $min, $sec;
    return $retval;
}

sub getdatetime($offset='0')
{
    my $offset = $_[0];
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime(time()+$offset*24*60*60);
    $mon++;
    $year+=1900;

    my $retval = sprintf "%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec;
    return $retval;
}


sub sayyes
{
    my $caption = $_[0] ? $_[0]." " : "";
    print $caption."( yes or no ) ? ";
    my $answer = <STDIN>;
    chomp $answer;
    return $answer =~ /^yes$/i;
}


sub hash2array
{
    my $lref = $_[0];
    my @retval;

    if( ref($lref) eq 'HASH' )
    {
        $retval[0] = $lref;
    }
    else
    {
        @retval = @{$lref};
    }
    return @retval;
}



sub print_r
{
    my ( $r, $prefix, $inhash ) = @_;
    my $type = ref( $r );

    if( $type eq 'HASH' )
    {
        print "\n" if $inhash;
        print $prefix."{\n";
        foreach my $key ( sort keys %{$r} )
        {
            print $prefix."\t$key => ";
            &print_r( $r->{$key}, $prefix."\t", 1 );
        }
        print $prefix."},\n";
    }
    elsif( $type eq 'ARRAY' )
    {
        print "\n" if $inhash;
        print $prefix."[\n";
        foreach my $value ( @{$r} )
        {
            &print_r( $value, $prefix."\t" );
        }
        print $prefix."],\n";
    }
    else
    {
        print $prefix unless $inhash;
        print "$r,\n";
    }
}



1;