ido50 has asked for the wisdom of the Perl Monks concerning the following question:
#!/usr/bin/perl -w BEGIN { $|=1; print "Content-type: text/html\n\n"; use CGI::Carp('fatalsToBrowser'); } use lib "/path-to-perl-modules"; use GD; use CGI; use strict; my $directory = "/path-to-pics"; my $thumbdir = "/path-to-pics/thumbs"; my $url = "http://www.www.com/cgi-bin"; my @dirs = getdirs($directory); for my $dir (@dirs) { update($dir); } print "Thumbnails created/updated successfully"; sub getdirs { my $directory = shift; my @dirs; opendir (DIR, $directory); my @files = grep { !/^\.\.?$/ } readdir DIR; closedir DIR; push (@dirs, $directory); for my $file (@files) { if (-d "$directory/$file") { getdirs("$directory/$file"); } } return @dirs; } sub update { my ($directory) = shift; my ($image, $desimage); opendir (DIR, $directory); my @files = grep { !/^\.\.?$/ } readdir DIR; closedir DIR; for my $file (@files) { my $full = "$directory/$file"; if (-f $full && $full =~ m/\.(png|jpg)/i) { my $extension = $1; open (PNG, "$full") || die; if ($extension eq "png") { $image = newFromPng GD::Image(\*PNG) || die; } else { $image = newFromJpeg GD::Image(\*PNG) || die; } close PNG; my ($width,$height) = $image->getBounds(); if ($width <= 250 && $height <= 250) { # DO NOTHING } else { if ($width <= 250 && $height > 250) { my $percent = (250*100)/$height; my $newidth = ($width*$percent)/100; $desimage = new GD::Image($newidth, 250); $desimage->copyResized($image, 0, 0, 0, 0, $newidth, 250, $w +idth, $height); } elsif ($width > 250 && $height <= 250) { my $percent = (250*100)/$width; my $newheight = ($height*$percent)/100; $desimage = new GD::Image(250, $newheight); $desimage->copyResized($image, 0, 0, 0, 0, 250, $newheight, +$width, $height); } else { if ($width > $height) { my $percent = (250*100)/$width; my $newheight = ($height*$percent)/100; $desimage = new GD::Image(250, $newheight); $desimage->copyResized($image, 0, 0, 0, 0, 250, $newheight +, $width, $height); } else { my $percent = (250*100)/$height; my $newidth = ($width*$percent)/100; $desimage = new GD::Image($newidth, 250); $desimage->copyResized($image, 0, 0, 0, 0, $newidth, 250, +$width, $height); } } $file =~ m/^(.+)\.\w+$/; my $new = "${file}.png"; open (FILE, "+>$thumbdir/$new") or die "Can't open file: $!"; binmode FILE; print FILE $desimage->png; close FILE; } } } }
edited by ybiC: balanced <readmore> tags
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Problem with the GD module
by Beatnik (Parson) on Aug 15, 2003 at 00:52 UTC | |
Re: Problem with the GD module
by jmanning2k (Pilgrim) on Aug 14, 2003 at 20:55 UTC | |
by ido50 (Scribe) on Aug 14, 2003 at 21:18 UTC | |
by jmanning2k (Pilgrim) on Aug 15, 2003 at 13:52 UTC | |
by ido50 (Scribe) on Aug 15, 2003 at 17:21 UTC |