Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

comment on

( [id://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":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (5)
As of 2024-03-28 13:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found