#!/usr/bin/perl -w
##############################################################################
# Scale an image to a certain size or scale, keeping aspect ratio
# supported input types
#   jpeg
#   gif
#   png
#   pnm
#   tiff
#   xpm
# output type is the same as the input type
#
# this script requires libjpeg and netpbm
#
# Author: Chris Rouch
# Date: 1998-2003
# Copyright (c) Chris Rouch 1998-2003
#
#     This program is free software; you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation; either version 2 of the License, or
#     (at your option) any later version.
#
#     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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#     or see http://www.gnu.org/licenses/gpl.txt
##############################################################################
use strict;
use Getopt::Long;
use Image::Size;

# constants

use constant PNMSCALE=>"/usr/bin/pnmscale 2> /dev/null";
use constant DJPEG=>"/usr/bin/djpeg";
use constant CJPEG=>"/usr/bin/cjpeg -q 80";
use constant DTIFF=>"/usr/bin/tifftopnm";
use constant CTIFF=>"/usr/bin/pnmtotiff";
use constant DPNG=>"/usr/bin/pngtopnm";
use constant CPNG=>"/usr/bin/pnmtopng";
use constant DXPM=>"/usr/bin/xpmtoppm";
use constant CXPM=>"/usr/bin/ppmquant 256 |/usr/bin/ppmtoxpm";
use constant DGIF=>"/usr/bin/giftopnm";
use constant CGIF=>"/usr/bin/ppmquant 256 |/usr/bin/ppmtogif";
use constant DPNM=>"/bin/cat";
use constant CPNM=>"/bin/cat";
use constant DEFWIDTH=>750;
use constant DEFHEIGHT=>750;
use constant DEFPREFIX=>'s_';
use constant THUMBSIZE=>160;

# general global variables
my ($PROG,$USAGE,$OPTIONS);
use vars qw ($outfile $encode $decode $w $h $base $dir $tmp);

# command line variables

my $width=DEFWIDTH;	    # width of the new image
my $height=DEFHEIGHT;	    # height of the new image
my $verbose;		    # make some noise
my $force;		    # force creation of new image
my $scale;		    # scale factor 
my $prefix=DEFPREFIX;	    # prefix for new image
my $overwrite;		    # overwrite new image if it already exists
my $thumb;		    # use THUMSBIZE for with and height
my $inplace;		    # output file has same name as input
my $alpha;		    # keep alpha info for png

# command line switch
my %opts=
(
 "w|width=s" => \$width,
 "h|height=s" => \$height,
 "v|verbose" => \$verbose,
 "f|force" => \$force,
 "t|thumb" => \$thumb,
 "o|overwrite" => \$overwrite,
 "s|scale=s" => \$scale,
 "p|prefix=s" => \$prefix,
 "a|alpha" => \$alpha,
 "i|inplace" => \$inplace,
);


($PROG=$0) =~ s#.*/##;
SetUsage(\%opts,\$OPTIONS);

$USAGE="Usage: $PROG $OPTIONS";
die "$USAGE\n" unless GetOptions(%opts);
die "$USAGE\n" unless  ($ARGV[0]);
foreach my $file (@ARGV) {
    if ($file =~ /\.tif/i) {
	$decode=DTIFF;
	$encode=CTIFF;
    }
    elsif ($file =~ /\.pnm/i) {
	$decode=DPNM;
	$encode=CPNM;
    }
    elsif ($file =~ /\.pgm/i) {
	$decode=DPNM;
	$encode=CPNM;
    }
    elsif ($file =~ /\.gif/i) {
	$decode=DGIF;
	$encode=CGIF;
    }
    elsif ($file =~ /\.xpm/i) {
	$decode=DXPM;
	$encode=CXPM;
    }
    elsif ($file =~ /\.jpg/i) {
	$decode=DJPEG;
	$encode=CJPEG;
    }
    elsif ($file =~ /\.png/i) {
	$decode=DPNG;
	$encode=CPNG;
    }
    else {
	warn "Unknown file type for $file, skipping\n";
	next;
    }
    # make sure decoder exists, it it does, assume encoder also exists
    # encode may not be a simple executable
    unless (-x $decode) {
	warn "Can't run $decode\n";
	next;
    }

    if ($thumb) {
	print "Using @{[THUMBSIZE]} for width and height\n" if ($verbose);
	$width=THUMBSIZE;
	$height=THUMBSIZE;
    }

    ($w, $h) = imgsize($file);
    unless ($h) {
	warn "Can't get size for $file\n";
	next;
    }
    ($base=$file) =~ s!.*/!!;
    ($dir=$file) =~ s!(.*)/.*$!$1!;
    $dir='.' if ($dir eq $file);

    $base= $prefix .$base;
    $outfile="$dir/$base";

    if (!$overwrite) {
	while ( -f "$outfile" ) {
	    # outfile exists, keep prefixing until we get a unique name
	    warn "$outfile exists, adding extra prefix\n";
	    $base= $prefix .$base;
	    $outfile="$dir/$base";
	}
    }
    if ($inplace) {
	# swap file and outfile
	if (!rename($file,$outfile)) {
	    warn ("failed to backup $file to $outfile\n");
	    next;
	}
	$tmp=$file;
	$file=$outfile;
	$outfile=$tmp;
	print "scaling $file to $outfile\n" if ($verbose);
    }
    print "$file to $outfile\n" if ($verbose);
    if ($scale) {
	print "actual $w,$h * $scale\n" if ($verbose);
	if ($alpha) {
	    system("$decode -alpha $file | @{[PNMSCALE]} -xscale $scale -yscale $scale  > $outfile.alpha");
	system("$decode $file | @{[PNMSCALE]} -xscale $scale -yscale $scale | $encode -alpha  $outfile.alpha > $outfile");
	    unlink("$outfile.alpha");
	}
    }
    elsif (($h > $height)|| ($w > $width)) {
	print "actual $w,$h vs. $width,$height\n" if ($verbose);
	if ($alpha) {
	    system("$decode -alpha $file | @{[PNMSCALE]} -xysize $width $height  > $outfile.alpha");
	    system("$decode $file | @{[PNMSCALE]} -xysize $width $height | $encode -alpha  $outfile.alpha > $outfile ");
	    unlink("$outfile.alpha");
	}
	else {
	    system("$decode $file | @{[PNMSCALE]} -xysize $width $height | $encode > $outfile");
	    
	}
    }
    else {
	print "$file is small enough\n";
	system("cp $file $outfile") if ($force);
    }
}
############### end of main #############
sub SetUsage {
    my ($ropts,$rstr) = @_;
    foreach my $key (keys %$ropts) {
	if ($key =~ /\|/) {
	    $key=~ s!^.*\|!!;
	}
	if ($key =~ /=/) {
	    $key =~ s!=.*$! value!;
	}
	$key = '-' . $key;
	$$rstr .= '[' . $key . '] ';
    }
}
############### end of file #############