Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Image Gallery script

by dmmiller2k (Chaplain)
on Dec 25, 2001 at 01:08 UTC ( #134218=sourcecode: print w/ replies, xml ) Need Help??

Category: CGI Programming
Author/Contact Info David M. Miller
Description:

As a 'web-parent' at my sons' school, I came up with this little ditty for displaying the kids computer artwork. It is intended to populate a two-frame page, displaying an index with thumbnails on the left-hand side and the selected image on the right.

See it in action here (choose one of the '... Pics' links in the left-hand panel).

#!/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";
}

Comment on Image Gallery script
Download Code
Re: Image Gallery script
by merlyn (Sage) on Dec 25, 2001 at 08:40 UTC
    Since you appear to be executing this code:
    img( { -width => 57, -height => 42,
    with either the thumbnail if it exists, or the original file if it doesn't, you are creating dumbnails, not thumbnails. This is a bad idea. Search the net for "dumbnails" for the problems and solutions, including my columns.

    -- Randal L. Schwartz, Perl hacker

      Thanks, merlyn!!

      I knew it wouldn't be a waste of time posting this script here. From your cited article [bold accents added]:

      Thumbnails, which are miniature versions of the original pictures, help the visitors to a site decide whether they want to take the time to download the entire picture. (Please don't confuse this with what one of my friends calls dumbnails, which are fullsized downloads that are scaled in the browser to be small. Lame.) There's nothing worse than spending two to five minutes downloading a typical JPEG file, only to discover that you've already got it, or it looks, well, useless.

      Admittedly, I am, in fact, using so-called "dumbnails" when there are no thumbnails available.

      As it happens, in this particular application, this turns out not only NOT to be a bad thing, it actually turns out to be a good thing: scaling the full-sized images into thumbnails, in effect, caches them at the browser, making the gallery somewhat faster than when I supply actual thumbnails (presuming most kids' parents will wind up looking at every image, which appears to be the case 9 times out of 10).

      Typical image sizes created with Kid Pix Studio Deluxe on a machine with a 800x600 pixel screen average anywhere from 3 to 18 Kb in size, or 2 to 12 seconds each to download on a typical dialup speed connection.

      One pleasant side effect of using frames is that even before all of the so-called dumbnails are loaded, clicking on one to display it full-sized in the other frame seems to affect the background downloading (caching) of the remaining images not at all.

      Your point is well taken, however, that I am forcing users to unnecessarily download ALL of the images; I agree that in probably any other context, this simply would NOT be acceptable. Here, however, the users are almost all, shall we say, motivated.

      Next, I plan to augment the script with a version of the solution you present in the article, above, hopefully making it more acceptable for other applications.

      dmm

      You can give a man a fish and feed him for a day ...
      Or, you can
      teach him to fish and feed him for a lifetime
Re: Image Gallery script
by perlservant (Initiate) on Oct 21, 2002 at 00:24 UTC
    Hi there! Code is probably great for intranet or fast internet but in reality has no real useful meaning. It uses the M$ FrontPage shrank images for thumbnails. Thumbnail is not the re-sized image tags but new image created from the original and re-sized, then it's a thumbnail.

    I have created a number of commercial albums for use on the internet -> one of the Albums. All images processed and site logos posted in real time and thumbnails created.

    I'd rather write some code instead of searching for one that'll do the job. If you'll look at the source of the pages - you will notice that code has no garbage as " ' or # as browsers just ignore them unless you use whitespace in ALT or form tags.

    Well, my whole image processing code (using NetPBM) is about 5 times shorter then your code above that uses modules. Why use modules at all in this case???

    If you need a code - lemmiknow and I'd be glad to help!


    if you want to do something - use Perl
    if you can't do something - use Perl

      Nice of you to comment, and I appreciate your remarks. You are absolutely right, this program is inefficient and big and it doesn't even generate real thumbnails.

      All of that is true, but

      1. I wrote this in about twenty minutes because I needed it for a low volume site,
      2. I added the code to generate thumbnail-sized images dynamically (when they weren't already provided), in order to use the script as an index page for a frameset, also in about twenty minutes,
      3. I may have tweaked once or twice since then, most certainly before posting it here,
      4. the ISP which was hosting the site was running an ancient (5.004) version of perl, did not support installing perl modules or libraries or allow arbitrary executables to be compiled for executing under CGI scripts,
      5. the site was donated, so changing ISP's wasn't an option,
      6. it is my children's school website

      All in all, I thought it was a useful thing for what it was, and that's all I posted for. It has provisions for locating thumbnail images, if provided and named appropriately, and using those instead of dynamically scaling them at the browser (this is how we use it, actually).

      I downvoted you because you apparently have a lot to learn about how we do (or say) things on Perl Monks, regardless of how smart or how clever a perl coder you may be (and I do not mean to imply one way or another that you're deficient in either of those areas -- how would I know?).

      dmm

      If you GIVE a man a fish you feed him for a day
      But,
      TEACH him to fish and you feed him for a lifetime

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2014-07-30 10:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (230 votes), past polls