#!/usr/bin/perl -w
# -*- Mode: Perl -*-
( $TS = "Time-stamp: <classViewImg.pl 2001/12/24 15:07:50 dmmiller>" )
+ =~ 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:
<FRAMESET COLS="180,1*" FRAMEBORDER="No" BORDER="0">
<FRAME NAME="index" SRC="/cgi-bin/classViewImg.pl?classroom=smith/
+firstPics">
<FRAME NAME="content" SRC="javascript:document.close();document.wr
+ite('<HTML><HEAD>/HEAD><BODY><H3>Please Choose A Student, at left</H3
+></BODY></HTML>')">
</FRAMESET>
=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 (re
+lative 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( $_ ) } s
+plit /_/, $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 theref
+ore not " .
"available at this time. Another attempt to upload it wi
+ll 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, $n
+ext, 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&$i
+mg_type=",
'[Prev]',
a( { -href => "../$rel_dir/empty.html" }, '[Return to To
+p]' ),
'[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_MixedCaseTit
+le.jpg'
# and 'Name_MixedCaseTitle_th.jpg' (or .gif, etc.) and stash 'Name_M
+ixedCaseTitle'
# in @newimgs for each pair found
my ( $first, $firstbase, @newimgs );
my $second = shift @imgs;
OUTER:
while ( ( $first, $second ) = ( $second, shift( @imgs ) || "" ), def
+ined($first) ) {
#print STDERR "Got '$first','$second'\n";
# get the base of the first name, then see whether the second is t
+he
# same with '_th' appended and the same file type. If not, make c
+ertain
# 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 lo
+op
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 c
+orresponding
# thumbnails have '_th' just prior to the image type extension ('.jp
+g', etc.)
foreach my $title ( @images ) {
my ( $childName, $imageName ) = map { separate_cap_words( $_ ) } s
+plit /_/, $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_typ
+e=$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 => 'mailt
+o: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";
}
|