Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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/&/ &amp; /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"; }

In reply to Image Gallery script by dmmiller2k

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others contemplating the Monastery: (7)
    As of 2014-09-03 05:38 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite cookbook is:










      Results (35 votes), past polls