From: "Chris Snyder" <[EMAIL PROTECTED]>
To: "'steve silvers'"
<[EMAIL PROTECTED]>,<perl-win32-users@listserv.ActiveState.com>
Subject: RE: Perl and Images
Date: Tue, 17 May 2005 16:17:13 -0500
------------------ snip 8< ------------------
From: steve silvers [mailto:[EMAIL PROTECTED]
Sent: Tuesday, May 17, 2005 12:44 PM
To: perl-win32-users@listserv.ActiveState.com
Subject: Perl and Images
Quick question. Is there a way that I can go into a directory with a static
html file in it and create a thumbnail image of the html file?
Any suggestions or examples greatly appreciated.
Steve
------------------ snip 8< ------------------
There are a lot of scripts out there that do that sort of thing. I wrote
one a few years ago that I used on my web site. It created a thumbs
directory and made the thumbnails, and resized the images to a maximum size
(all configurable). It uses Image::Magick which I recall may have been
somewhat difficult to install. Going from memory, I believe I had to just
install the app and put the perl module files where they belong, bypassing
the perl installation / testing routines.
Anyway, It's not pretty, but it worked fine last time I used it. The
script
is for CGI, but can be converted to command line as all it does it produce
a
basic log file. Here is the script (the module I wrote ImageIndex.pm is at
the bottom):
---------------------------- begin script
----------------------#!/usr/bin/perl -w
use strict;
use CGI;
use CGI::Carp;
use Data::Dumper;
require ImageIndex;
require Image::Magick;
print CGI::header();
my $dirLoc = CGI::param("dirLoc") || '../grace/Photos1';
my $imageIndex = ImageIndex->new(
"maxWidth" => 800,
"maxHeight" => 600,
"dirLoc" => CGI::param("dirLoc") || '../grace/Photos1',
"HTMLDirLoc" => CGI::param("HTMLdirLoc") || '/grace/Photos1',
"thumbLoc" => './thumbs',
"xmlFileName" => 'pictures.xml',
"overwriteXML" => 0,
"thumbMaxWidth" => 100,
"thumbMaxHeight" => 100
);
my @messages;
print <<EOHTML;
<html>
<head><title>Image Magick Resizer</title></head>
<body>
EOHTML
eval {
print "opening directory<br>\n";
if ($dirLoc && -d $dirLoc) { #dirloc was passed as a param and the
directory exists
print "is a directory<br>\n";
print "height = ".$imageIndex->maxHeight.", width =
".$imageIndex->maxWidth." from imageIndex.<br>\n";
opendir(DIRFH, $dirLoc) or die "CANTOPENDIR: $@";
my @fileList = grep {/[\.jpg|\.jpeg]$/i && (! -d $_)}
readdir DIRFH;
die "NOFILELIST" if ([EMAIL PROTECTED]);
print "Number of files = ".scalar(@fileList)."<br>\n";
my @pictures;
for (@fileList) {
my $fileName = $_;
my $fullName = ImageIndex::pathFile($dirLoc,
$fileName);
my $message = "fullName = '$fullName'...";
print "Dealing with fullName $fullName<br>\n";
if (-f $fullName) {
my $picture = $imageIndex->newPicture(dirLoc
=> $dirLoc, fileName => $fileName);
print "got picture object<br>\n";
$message .= $picture->resizeImage."\n";
my $thumb = $picture->mkThumb;
print "resized thumb<br>\n";
} else {
print "file $fullName does not exist<br>\n";
$message .= "file $fullName does not exist";
}
push @messages, $message;
}
closedir DIRFH;
} else {
print "no dirLoc: $dirLoc" unless $dirLoc;
}
};
print "done<br>\n";
print "error: $@" if $@;
print "$_<br>\n" for @messages;
print "</body></html>";
---------------------------- end script ----------------------
---------------------- Begin ImageIndex.pm -------------------
#!/usr/bin/perl -w
use strict;
use Data::Dumper;
use Image::Magick;
package ImageIndex;
sub BEGIN {
%ImageIndex::defaultArgs = (
"maxWidth" => 800,
"maxHeight" => 600,
"dirLoc" => '',
"thumbLoc" => './thumbs',
"xmlFileName" => 'pictures.xml',
"overwriteXML" => 0,
"thumbMaxWidth" => 100,
"thumbMaxHeight" => 100,
"makeDirs" => 1
);
}
sub new {
my ($class, %args) = @_;
my %newArgs;
for my $keyName (keys %ImageIndex::defaultArgs) {
if (exists $args{$keyName}) {
$newArgs{$keyName} = $args{$keyName};
} else {
$newArgs{$keyName} =
$ImageIndex::defaultArgs{$keyName};
}
my $subName = $class.'::'.$keyName;
eval {
if (!defined(*$subName)) {
no strict 'refs';
*$subName = sub {my $self = shift;
@_?$self->{$keyName} = shift():$self->{$keyName};};
}
}
}
return bless(\%newArgs, $class);
}
sub newPicture {
my ($self, %args) = @_;
my %tmpArgs = (%$self, %args);
my $thing = ImageIndex::Picture->new(%tmpArgs);
return $thing;
}
sub pathFile {
my $path = shift;
while (@_) {
my $fname = shift;
if ($path) {
if (substr($path, -1) eq '/') {
$path .= $fname;
} else {
$path.= '/'.$fname;
}
} else {
$path = './'.$fname;
}
}
return $path
}
sub min {
my $newMin = shift;
while (@_) {
my $tmpMin = shift;
$newMin=$tmpMin<$newMin?$tmpMin:$newMin;
}
return $newMin;
}
1;
package ImageIndex::Picture;
use base qw(ImageIndex);
sub BEGIN {
%ImageIndex::Picture::defaultArgs = (
"maxWidth" => $ImageIndex::defaultArgs{maxWidth},
"maxHeight" => $ImageIndex::defaultArgs{maxHeight},
"dirLoc" => $ImageIndex::defaultArgs{dirLoc},,
"HTMLDirLoc" => $ImageIndex::defaultArgs{HTMLDirLoc},,
"description" => '',
"thumbLoc" => $ImageIndex::defaultArgs{thumbLoc},
"fileName" => '',
"makeDirs" => $ImageIndex::defaultArgs{makeDirs});
}
sub new {
my ($class, %args) = @_;
my %newArgs;
for my $keyName (keys %ImageIndex::Picture::defaultArgs) {
if (exists $args{$keyName}) {
$newArgs{$keyName} = $args{$keyName};
} else {
$newArgs{$keyName} =
$ImageIndex::defaultArgs{$keyName};
}
my $subName = $class.'::'.$keyName;
eval {
if (!defined(*$subName)) {
no strict 'refs';
*$subName = sub {my $self = shift;
@_?$self->{$keyName} = shift():$self->{$keyName};};
}
}
}
$newArgs{thumb} = "";
return bless(\%newArgs, $class);
}
sub fullName {
# I could, if passed an argument, load up dirLoc and fileName by
separating a passed in argument,
# but not today. And tomorrow doesn't look so hot, either.
my ($self, %args) = @_;
if (exists $self->{fileName}) {
if (exists $self->{dirLoc}) {
return ImageIndex::pathFile($self->{dirLoc},
$self->{fileName});
} else {
return $self->{fileName};
}
} else {
return "";
}
}
sub resizeImage {
my ($self, %args) = @_;
my $maxHeight =
exists($args{maxHeight})?$args{maxHeight}:$self->maxHeight;
my $maxWidth = exists($args{maxWidth}) ?$args{maxWidth}
:$self->maxWidth;
my $outFile = exists($args{outFile}) ?$args{outFile} :undef;
my $image = $self->getImage(%args);
die "Unable to get image: $@" if $@;
my ($width, $height, $columns) = $image->Get("width", "height",
"columns");
if ($width > $maxWidth || $height > $maxHeight) {
my $proportion = ImageIndex::min($maxWidth/$width,
$maxHeight/$height);
if (!(my $imageMessage = $image->Resize(width =>
int($proportion * $width), height => int($proportion * $height)))) {
print $outFile?"resizing file: $outFile
<br>\n":"resizing file: ".$self->fullName;
return $outFile?$image->Write(fileName =>
$outFile):$image->Write();
} else {
return $imageMessage;
}
}
return undef;
}
sub getImage {
my ($self, %args) = @_;
my $image;
if (exists($args{image})) {
$image = $args{image};
} else {
my $fullName = $self->fullName;
if ($fullName && -f $fullName) {
$image = Image::Magick->new;
print "Read fullName = $fullName<br>\n";
if (my $readResponse = $image->Read($fullName)) {
die "unable to get image for $fullName:
$readResponse";
}
} else {
die "unable to find image for $fullName";
}
}
return $image;
}
sub mkThumb {
my ($self, %args) = @_;
my %tmpArgs = %args;
$tmpArgs{maxWidth} = $args{maxWidth} || $self->thumbMaxWidth ||
$ImageIndex::defaultArgs{thumbMaxWidth};
$tmpArgs{maxHeight} = $args{maxHeight} || $self->thumbMaxHeight ||
$ImageIndex::defaultArgs{thumbMaxHeight};
my $outDir = $args{dirLoc} ||
ImageIndex::pathFile($self->dirLoc, $self->thumbLoc);
if (!-d $outDir && $self->makeDirs) {
mkdir $outDir;
}
$tmpArgs{outFile} = $args{outFile} ||
ImageIndex::pathFile($self->dirLoc, $self->thumbLoc, $self->fileName);
my $response = $self->resizeImage(%tmpArgs);
$tmpArgs{dirLoc} = $outDir;
$tmpArgs{HTMLDirLoc} = $args{HTMLDirLoc} ||
ImageIndex::pathFile($self->HTMLDirLoc, $self->thumbLoc);
if ($response) {
return $response;
} else {
return $self->thumb(ImageIndex::Thumb->new(%$self,
%tmpArgs));
}
}
sub thumb {
my $self = shift;
if (@_ && $_[0]->isa("ImageIndex::Thumb")) {
return $self->{thumb} = $_[0];
} elsif ($self->{thumb}->isa("ImageIndex::Thumb")) {
return $self->{thumb};
} else {
return undef;
}
}
1;
package ImageIndex::Thumb;
use base qw(ImageIndex::Picture);
sub BEGIN {
%ImageIndex::Thumb::defaultArgs = (
"maxWidth" => $ImageIndex::defaultArgs{thumbMaxWidth},
"maxHeight" =>
$ImageIndex::defaultArgs{thumbMaxHeight},
"dirLoc" => '',
"HTMLDirLoc" => '',
"description" => '',
"fileName" => '');
}
sub new {
my ($class, %args) = @_;
my %newArgs;
for my $keyName (keys %ImageIndex::Thumb::defaultArgs) {
if (exists $args{$keyName}) {
$newArgs{$keyName} = $args{$keyName};
} else {
$newArgs{$keyName} =
$ImageIndex::defaultArgs{$keyName};
}
my $subName = $class.'::'.$keyName;
eval {
if (!defined(*$subName)) {
no strict 'refs';
*$subName = sub {my $self = shift;
@_?$self->{$keyName} = shift():$self->{$keyName};};
}
}
}
return bless(\%newArgs, $class);
}
1;
---------------------- End ImageIndex.pm -------------------
