Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re^2: Swimsuits2004

by jbrugger (Parson)
on Feb 14, 2005 at 07:29 UTC ( [id://430709]=note: print w/replies, xml ) Need Help??


in reply to Re: Swimsuits2004
in thread Swimsuits2004

Hmm...
Just could not help myself and create thumbs and links...
Have fun :-) (ps. feel free to improve it... that's the real fun, isn't it?)
#!/usr/bin/perl -w use strict; use Image::Magick; use File::Glob qw(:globally :nocase); use File::Basename; use CGI; my $realdir = qw( /var/www/html/thumbnailer/images/ ); # The dir tha +t holds the origional images my @ext = qw( jpg png gif); # Image exten +tions to look for my $savedir = qw( /var/www/html/thumbnailer/thumbs/ ); # Dir to save + thumbnails my $serverdir = qw( /thumbnailer/ ); # Relative se +rver-path my $thumbdir = qw( thumbs/ ); # Holds the t +humbnails for the webpage my $imagedir = qw( images/ ); # Holds the r +eal images for the webpage my $x_size = 150; # Size in pix +els. my $y_size = 150; # Size in pix +els. my $resize = 1; # Resize befo +re crop. my $aspect_S = 0.5; # Only reseze + if aspect-ratio is above this value, else thumbnail becomes to blurr +ed. my $aspect_H = 2; # Only resize + if aspect-ratio is below this value, else thumbnaik becomes to blurr +ed. my $overwrite = 0; # Allways rem +ake (overwrite) the thumbnails. my $cols = 5; # Max horizon +tal thumbs. my $rows = 10; # Max vertica +l thumbs. my $cgi = new CGI; main(); cleanUp(); sub main { my $content = "<tr>"; my $files = readDir(); my $thumbs_per_page = $rows * $cols; my $total = scalar(@$files) ? scalar(@$files) : 0; my $pages = $total / $thumbs_per_page; my $currentPage = $cgi->param('p') ? $cgi->param('p') : 1; my $hasPrevious = $currentPage-1 ? 1 : 0; my $hasNext = ($currentPage < $pages) ? 1 : 0 ; my $startImage = (($currentPage-1) * $thumbs_per_page) ; my $nav = ""; my $c = 1; my $i = 0; foreach my $file (@$files) { $i++; if ($i >= $total) { $nav .= "<tr><td align=\"center\" nowrap=\"now +rap\" colspan=\"$cols\">"; if ($hasPrevious) { $nav .= "<a href=\"?p=" . +($currentPage - 1) . "\">Previous<\/a>\&nbsp;\&nbsp;"; } if ($hasNext) { $nav .= "<a href=\"?p=" . +($currentPage + 1) . "\">Next<\/a>"; } $nav .= "<\/td><\/tr>"; } next if ($i <= $startImage || $i > ($startImage + $thu +mbs_per_page)); if ($c > $cols) { $content .= "<\/tr><tr>\n"; $c = 1; } # Check if the file alreaddy exists: my $filename = "thumb_" . fileparse($file); if (!-e $savedir . $filename || $overwrite) { # Make new thumbnails... my $image = Image::Magick->new; $image->Read($file); my ($x,$y) = $image->Get('width', 'height'); # Enlarge image if thumbnail > origional, or r +esize before crop is enabled... if ($x < $x_size || $resize) { my $aspectratio = $y / $x; # Only resize if aspect-ratio is betwe +en given apect ratio-borders if ($aspectratio > $aspect_S && $aspec +tratio < $aspect_H || $x < $x_size) { $x = $x_size; $y=$x * $aspectratio; $image->Resize(width => $x, he +ight => $y, filter => 'Cubic', blur => 1); } } if ($y < $y_size) { my $aspectratio = $x / $y; $y = $y_size; $x=$y * $aspectratio; $image->Resize(width => $x, height => +$y, filter => 'Cubic', blur => 1); } # Get center (offset) of image, and crop to $x +_size * $y_size. my $ox = ($x - $x_size) / 2; my $oy = ($y - $y_size) / 2; $image->Crop("${x_size}x${y_size}+$ox+$oy"); $image->Write($savedir.$filename); $content .= " <td> <a href=\"" . $serverdir . +$imagedir . fileparse($file) . "\" > <img src=" . $serverdir . $thumb +dir . $filename. " alt=\"\" border=\"1\"> <\/a><\/td> "; } else { # Skip writing... $content .= " <td> <a href=\"" . $serverdir . +$imagedir . fileparse($file) . "\" > <img src=" . $serverdir . $thumb +dir . $filename. " alt=\"\" border=\"2\"> <\/a><\/td> "; } $c++; } $content .= "<\/tr>\n" . $nav; printHtml($content); } sub printHtml { my ($content) = @_; # my $cgi = new CGI; print $cgi->header(-type => 'text/html', ); print $cgi->start_html( -title => 'Testpage', -BGCOLOR => '#ffffff',); print "<table border=\"0\" cellpadding=\"0\" cellspacing=\"3\" +>\n"; print $content; print "\n<\/table>\n"; print $cgi->end_html; } sub readDir { my $files="*.{" . join(",",@ext) . "}"; my @files= glob($realdir.$files); return \@files; } sub cleanUp { undef $cgi, $realdir, @ext, $serverdir, $savedir, $x_size, $co +ls; undef $y_size, $resize, $aspect_S , $aspect_H, $overwrite, $ro +ws; undef $thumbdir, $imagedir; }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://430709]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (4)
As of 2024-04-24 19:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found