images.pl

#!/usr/bin/perl
use strict;
use vars qw(@images $stat);
use subs qw(getimages);
use CGI qw(-compile :standard);
$|++;

# Fetch input (no input and this script will output the first image)
my $query=new CGI;
my $pos=$query->param('POS');
my $action=$query->param('ACTION');
print $query->header();

# If first instance of script, or directory has changed since
#load, reload list
if($stat==undef||(-M '.' <0)) {
   @images=();
   getimages(\@images);
   die "No Images Found" if($#images<0);
   $^T=time;
   $stat=1;
   }

my $next = sub { return ($pos<$#images) ? $pos+1 : 0 };
my $back = sub { return ($pos>0) ? $pos-1 : $#images };
my $random = sub { srand; return int(rand($#images)) };

my %goto = ( 	'NEXT'=>&$next,
	  	'BACK'=>&$back,
          	'RANDOM'=>&$random,
          	'JUMP'=>$query->param('GOTO') );

if($action ne "") { $pos=$goto{$action}; } else { $pos=0; }
$query->param(-name=>'POS',-values=>$pos);

print<<END;
<HTML><HEAD><TITLE>Images ($pos of $#images)</TITLE></HEAD>
<BODY BGCOLOR=black TEXT=white LINK=red VLINK=gray ALINK=blue>
<CENTER>
END

print "<FORM ALIGN=CENTER METHOD=POST ACTION=\"",$query->url(-full=>1),"\">";

print<<END;
<INPUT TYPE=IMAGE NAME=ACTION VALUE=NEXT SRC="$images[$pos]" ALT="$images[$pos]" TITLE="&gt;&gt; Click &gt;&gt;">
<BR>
<I>$images[$pos]</I>
END

print "<INPUT TYPE=HIDDEN NAME=POS VALUE=$pos>";
print<<END;
<TABLE ALIGN=CENTER BORDER=0>
<TR><TH>
<INPUT TYPE=SUBMIT NAME=ACTION VALUE=BACK>
<INPUT TYPE=SUBMIT NAME=ACTION VALUE=NEXT>
<INPUT TYPE=SUBMIT NAME=ACTION VALUE=RANDOM>
<INPUT TYPE=SUBMIT NAME=ACTION VALUE=JUMP>
END

print "<INPUT TYPE=TEXT NAME=GOTO SIZE=", int(1+log($#images)/log(10));
print " VALUE=$pos>";
print<<END;
</TABLE></FORM>
END

print "</CENTER></BODY></HTML>";
# to-do: detach button (form optional), image is input to next img

# Load A List of the images that might be viewable in a browser
# Under mod_perl, we'll make it so this will occur only on the 1st
# invocation of this script

sub getimages {
   my $ref=shift;
   sub alpha { lc($a) cmp lc($b); }
   opendir HERE, "." or die "Couldn\'t read directory! Errno: $!";
   push @$ref, (sort alpha grep /^.+?\.(jpe{0,1}g|gif|png|xbm)$/i , readdir HERE);
   closedir HERE;
   }