view release on metacpan or  search on metacpan

throttleimg  view on Meta::CPAN

#!/usr/bin/perl -w
#
# $Id: throttleimg,v 1.4 1998/09/14 16:15:01 don Exp $

use Image::Magick;
use Getopt::Long;

GetOptions( "help|h|?!" => \$help,
	    "quiet|q!" => \$quiet,
	    "time|t=f" => \$time,
	    "steps|s=i" => \$steps,
	    "same-size!" => \$same_size,
	    "same-quality!" => \$same_quality,
	    "same-colors!" => \$same_colors,
            "undo|u" => \$undo,
	    );

usage() if $help || !@ARGV;
do_undo() if $undo;

if (!$time) {
    print STDERR "--time option wasn't specified, assuming 5.0 seconds.\n";
    $time = 5.0;
} elsif ($time < 0) {
    print STDERR "--time option must be a positive float.\n";
    exit 1;
}
if (!$steps) {
    print STDERR "--steps option wasn't specified, assuming 3 steps.\n";
    $steps = 3;
} elsif ($steps < 1 || $steps > 35 || ($steps != int($steps))) {
    print STDERR "--steps option must be an integer between 1 and 35.\n";
    exit 1;
}

my $count = 0;
foreach my $file (@ARGV) {
    if (-d $file) {
	print STDERR "Skipping $file, it's already a directory.\n";
        next;
    } elsif ($file !~ /\.(?:gif|jpg)$/) {
	print STDERR "Skipping $file, doesn't appear to be a GIF or JPEG.\n";
	next;
    }

    print "Processing $file...\n" unless $quiet;
    
    mkdir "$file.dir", 0775 or die $!;
    rename $file, "$file.dir/Z-$file" or die $!;
    rename "$file.dir", $file or die $!;

    print "Creating control file for $time seconds.\n" unless $quiet;
    open (CONF, "> $file/.throttle") or die $!;
    flock (CONF, 2);
    print CONF "$time\n";
    close CONF;

    my $des = "0";
    for my $i (0 .. $steps - 1) {
	my $percent = $i / $steps;
	
	my $image = new Image::Magick;
	$image->Read("$file/Z-$file");
	my ($width, $height) = $image->Get("width", "height");
	
	my @changes = ();
	if (!$same_size) {
	    my $new_width = $width * (.25 + .75 * $percent);
	    my $new_height = $height * (.25 + .75 * $percent);
	    $image->Scale(width => $new_width, height => $new_height);
	    push(@changes, "size=${new_width}x${new_height}");
	}
	if (!$same_quality && ($image->Get("magick") eq "JPG")) {
	    my $quality = 10 + 90 * $percent;
	    $image->Set(quality => $quality);
	    push(@changes, "quality=${quality}%");
	}
	if (!$same_colors && ($image->Get("magick") eq "GIF")) {
            my $colors = 10 + 245 * $percent;
            $image->Quantize(colors => $colors, colorspace => "RGB",
                             dither => "true");
            push(@changes, "colors=$colors");

	}
	$image->Write("$file/" . ++$des . "-$file");
	print "Wrote $des-$file, ", (-s "$file/$des-$file"), " bytes: ",
	      join(", ", @changes), "\n" unless $quiet;
    }
    print "Original is now Z-$file, ", (-s "$file/Z-$file"),
          " bytes\n" unless $quiet;
    $count++;
}

print "Done.  Modified $count file", $count == 1 ? "":"s", ".\n" unless $quiet;

sub do_undo {
    foreach my $file (@ARGV) {
	$file =~ s|/$||;
	if (!(-d $file)) {
	    print STDERR "Skipping $file, it isn't directory.\n";
	    next;
	} elsif (!(-e "$file/.throttle")) {
	    print STDERR "Skipping $file, no .throttle file found.\n";
	    next;
	} elsif ($file !~ /\.(?:gif|jpg)$/) {
	    print STDERR "Skipping $file, doesn't appear to be a ".
                         "GIF or JPEG.\n";
	    next;
	} elsif (!(-e "$file/Z-$file")) {
	    print STDERR "Skipping $file, no original (\"Z-$file\") found.\n";
	    next;
	}

	print "Processing $file...\n" unless $quiet;
    
	rename "$file", "$file.dir" or die $!;
	rename "$file.dir/Z-$file", "$file" or die $!;

	opendir (SF, "$file.dir") || die $!;
	foreach (readdir(SF)) {
	    if (/^[0-9A-Y]-$file$/ || /^\.throttle/) {
		print "Removing $_...\n" unless $quiet;