------------------ snip 8< ------------------ From: steve silvers [mailto:[EMAIL PROTECTED] Sent: Tuesday, May 17, 2005 12:44 PM To: [email protected] 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 ------------------- _______________________________________________ Perl-Win32-Users mailing list [email protected] To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
