#!/usr/bin/perl -w # -*- Mode: Perl -*- ( $TS = "Time-stamp: " ) =~ s/.*\<([^\>]+)\>/$1/; =head1 NAME classViewImg - A simple gallery script =head1 SYNOPSIS Simple gallery script for displaying images in a two-frame arrangement. The lefthand frame contains the index, which is a vertical series of thumbnails, while the right-hand frame will contain the selected image. =head1 DESCRIPTION Given the name of a relative directory (off a common root), looks for image files in a 'images' subdirectory. Images are expected to be named like this: Childname_TitleOfPicture.gif (or, .jpeg, .png or .jpg). Thumbnails (for the index frame), if present, should be 57h x 42v pixels and are expected to be named accordingly: Childname_TitleOfPicture_th.gif. Otherwise, the images themselves will be scaled to this size (57 x 42 pixels). The thumbnail size is an artifact of the drawing program the kids were using, Kid Pix Studio Deluxe and the screen size of the machines they were using it with. This particular program did not support scrolling and so set the size of the saved images to exactly whatever screen space was available when the image was drawn (571 x 419, in this case). The script itself is run in two modes, with or without an image specifier (filename, sans extension). If run without the image specifier, the script builds a gallery index. Otherwise it displays the specified image with title and appropriate Previous, Top and Next links. Expects to be run using a frameset similar to the following: =cut require 5.004; use strict; use vars qw( $TS ); use CGI qw(:all); use CGI::Carp qw(fatalsToBrowser); use File::Basename; use constant FS_DIR => '/path/to/public_html/classroom'; BEGIN { ++$|; sub IMG_TYPES { ('gif','jpeg', 'jpg', 'png') } } # Main { my ( $title, $img_type ); my $classroom = param('classroom'); # teachers' names (relative path from 'classrooms' directory) # look for parameter of the form, 'image_type=file_name', e.g., jpeg=Samuel_BirdPicture for my $type ( IMG_TYPES ) { if ( $title = param( $type ) ) { $img_type = $type; last; } } if (! $title) { display_thumbnails( $classroom ); } else { my ( $childName, $imageName ) = map { separate_cap_words( $_ ) } split /_/, $title; $imageName = "No Title" unless (defined $imageName); my $rel_dir = $classroom; # relative directory from /path/to/public_html/classroom root dir my $rel_img_dir = "$rel_dir/images"; my $fs_dir = FS_DIR ."/$rel_img_dir"; my $fileName = "$title.$img_type"; my $label = b( $childName ) .': '. u( i( $imageName )); my $image = (( -e "$fs_dir/$fileName") ? img( { -src => "/$rel_img_dir/$fileName", -alt => "$childName: $imageName" } ) : "The image requested did not upload correctly and is therefore not " . "available at this time. Another attempt to upload it will be made shortly." ); # exclude filenames with embedded whitespace my @newimgs = find_images( $fs_dir, $img_type ); # for each name in @newimgs, find the previous and next names, if any my ( $prev, $this ); my $next = shift @newimgs; # prime the pump while ( defined( $next ) && (( $prev, $this, $next ) = ( $this, $next, shift @newimgs )) ) { last if ( $this eq $title ); } #print STDERR "Going with prev => ". ($prev||'(undef)') .", this => ". ($this||'(undef)') ." and next => ". ($next||'(undef)') ."\n"; my ( $url_prefix, $prev_text, $top, $next_text ) = ( url( -relative => 1 ) ."?classroom=$classroom&$img_type=", '[Prev]', a( { -href => "../$rel_dir/empty.html" }, '[Return to Top]' ), '[Next]' ); if ( defined $prev ) { $prev =~ s/&/%26/g; $prev_text = a( { -href => $url_prefix . $prev }, $prev_text ); } if ( defined $next ) { $next =~ s/&/%26/g; $next_text = a( { -href => $url_prefix . $next }, $next_text ); } print header, join( "\n", start_html( '-title' => $title, '-meta' => { 'generator' => $TS }, -bgcolor => 'silver' ), table( join( "\n", caption( join( "\n", $prev_text, $top, $next_text ) ), Tr( td( { -valign => "top" }, font( { -size => '+1' }, $label ) )), Tr( td( $image ))) ."\n" ), end_html ), "\n"; } } sub separate_cap_words { my $str = shift; # precede all embedded capitalized words with a space $str =~ s/([^ ])([A-Z][a-z]*)/$1 $2/g; return $str; } # Find Images sub find_images { my ( $dir, $img_type ) = @_; # exclude filenames with embedded whitespace my @imgs = glob( "$dir/*.$img_type" ); # This oughtn't be necessary, but ... (for some reason it is) $imgs[0] =~ s/Warning: cannot determine current directory\n//; # strip off paths $_ = basename $_ for @imgs; # Now we look for pairs of filenames of the form: 'Name_MixedCaseTitle.jpg' # and 'Name_MixedCaseTitle_th.jpg' (or .gif, etc.) and stash 'Name_MixedCaseTitle' # in @newimgs for each pair found my ( $first, $firstbase, @newimgs ); my $second = shift @imgs; OUTER: while ( ( $first, $second ) = ( $second, shift( @imgs ) || "" ), defined($first) ) { #print STDERR "Got '$first','$second'\n"; # get the base of the first name, then see whether the second is the # same with '_th' appended and the same file type. If not, make certain # the first name matches the pattern, 'Name_TitleWithMixedCase.jpg' (or # .gif, etc.) and add the name to @newimgs. Otherwise, # throw away the first one, shift the second to the first then get another second # name and try again. If there are no more names, end the whole loop INNER: if ( ( $firstbase = basename( $first, '.'. $img_type ) ) .'_th.'. $img_type eq $second ) { ( $first, $second ) = ( $second, shift( @imgs ) ); $second = "" if (! defined $second ); } elsif ( $firstbase !~ /^[A-Z][A-Za-z&]*(?:_([A-Z][a-z]*)+)?/ ) { ( $first, $second ) = ( $second, shift( @imgs ) ); last OUTER if ( $first eq "" ); $second = "" if (! defined $second ); #print STDERR "Now have '$first','$second'\n"; next INNER; } #print STDERR "Found '$first','$second'\n"; push @newimgs, $firstbase; } return (wantarray ? @newimgs : \@newimgs); } sub display_thumbnails { my ( $classroom ) = @_; my $rel_img_dir = "$classroom/images"; my $fs_dir = FS_DIR ."/$rel_img_dir"; my ( $img_type, @images, @links ); foreach my $type ( IMG_TYPES ) { if ( @images = find_images( $fs_dir, $type ) ) { $img_type = $type; last; } } # @images should now have a list of non-thumbnail image files; the corresponding # thumbnails have '_th' just prior to the image type extension ('.jpg', etc.) foreach my $title ( @images ) { my ( $childName, $imageName ) = map { separate_cap_words( $_ ) } split /_/, $title; $childName =~ s/&/ & /g; $imageName = "No Title" unless (defined $imageName); my $urlTitle = $title; $urlTitle =~ s/&/%26/g; my $link = "/cgi-bin/classViewImg.pl?classroom=$classroom&$img_type=$urlTitle"; my $thumbnail = "${title}_th.$img_type"; $thumbnail = "$title.$img_type" if ( ! -e "$fs_dir/$thumbnail" ); push @links, Tr( { -align => "left" }, td( table( Tr( td( a( { -href => $link }, img( { -width => 57, -height => 42, -src => "/$rel_img_dir/$thumbnail", -alt => "$childName: $imageName" } ) ) ), td( a( { -href => $link }, $childName ) ) ) ) ) ); } my $address = "Don't hesitate to email me at" . a( { -href => 'mailto:dmmiller@acm.org' }, 'David M. Miller'); print header, join( "\n", start_html( '-title' => 'Index', '-meta' => { 'generator' => $TS }, -target => 'content', -bgcolor => 'silver' ), table( { -width => "100%", -align => "center", -border => 1 }, caption( strong( i( 'Index' ) ) ), join( "\n", @links ) ), hr, font( { -size => -2 }, address( $address ) ), end_html ), "\n"; }