#!/usr/bin/perl

#
#
#
#
#
#      Warning  WARNING  Warning  WARNING  Warning
#
#        This is not the file you want to edit.
#
#       the original can be found at:
#       /afs/csail.mit.edu/u/g/gremio/public_html/pics
#
#
#
#
#
#
#
#
#
#
#
#

use strict;
use File::Basename;
use Cwd;
$|=1;

#< deny
my %deny = ("65.75.152.120" => 1,
	    "66.111.215.196" => 1
	    );
if (defined $deny{$ENV{REMOTE_ADDR}}) {
    exit 0;
}
#>

my $diricon = "/~gremio/icons/directory.jpg";
my $logdir = "/afs/csail/u/g/gremio/public_html/pics/.log/";
my $default_height = 300;
my $lighterPrefix = ".l-";

#  Standard CGI stuff: $debug, debug_info(), space(n)
#<                     htesc(str), uriesc(str), a/url_button(uri,str,opts)

use Data::Dumper;

use CGI qw/:all/;
print header;
use CGI::Carp qw(fatalsToBrowser);
my $input= new CGI;
$input->import_names('in');

my $debug = $in::debug if (defined $in::debug);

#< Postgres   -- commented out --
#  use Postgres;
my $conn;
#  if (defined $database and $database ne "") {
#      $conn = Postgres::db_connect($database) 
#  	or die "could not connect -- $Postgres::error";
#  }
#>

#< htesc (text)

sub htesc {
    my $text = shift;
    $text =~ s/\&/&amp;/g;
    $text =~ s/\</&lt;/g;
    $text =~ s/\>/&gt;/g;
#    $text =~ s/\'/&apos;/g;
    $text =~ s/\"/&quot;/g;
    $text =~ s/([^\s\x20-\x7e])/sprintf("\&%x;", ord($1))/ge;
    $text =~ s/\n/<BR>\n/gs;
    $text =~ s/\t/&space(8)/ges;
    $text =~ s/ /&space(1)/ges;
    return $text;
}
#>
#< uriesc (text)

sub uriesc {
    my ($url) = @_;
    my ($olink) = ($url =~ /\?(.*)$/);
    my $link = $olink;
    foreach my $badchar ($link =~ /([^\w=&:;+\.])/g) {
        my $goodchar = sprintf "%%%x", ord($badchar);
        $link =~ s/\Q$badchar\E/$goodchar/g;
    }
    $url =~ s/\Q$olink\E$/$link/;
    return $url;
}
#>
#< a (url, text [, %options])

sub a {
    my ($url, $text, %options) = @_;
    $url = uriesc($url);
    my $link = qq(<A HREF="$url");
    foreach (keys %options) {
        $link .= qq( $_="$options{$_}");
    }
    $link .= qq(>$text</A>);
    return $link;
}

#>
#< space(n): return n HTML non-breaking spaces
sub space {
    my ($n) = @_;
    my $s="";
    $n=1 unless $n;
    $s .= "\n";
    for (my $i=0; $i < $n; $i++) {
        $s .= "&nbsp;";
    }
    $s .= "\n";
    return $s;
}
#>
#< debug_info() some environment info for debugging

sub dUmper {
    my $varstr = shift;
    use Data::Dumper;
    my $string = Dumper(@_);
    $string =~ s/^\$VAR1/$varstr/;
    return htesc $string;
}
sub debug_info {
    return unless $debug;
    my %options = @_;
    print "\n"; #NOTE: required if you haven't printed anything yet!!!

    my ($cpack, $cfile, $cline) = caller();
    print qq(<h3>[$cfile:$cline] package $cpack</h3>);

    if (%options) {
        foreach (keys %options) {
            print dUmper("\$$_", $options{$_});
        }
    }
    
    if (defined $conn or defined $options{conn}) {
        print qq(<h3>Database Connection Information</h3>);
        $conn ||= $options{conn};
        print "Connected Database: ", $conn->db(), "\n<BR>";
        print "Connected Host: ", $conn->host(), "\n<BR>";
        print "Connection Options: ", $conn->options(), "\n<BR>";
        print "Connected Port: ", $conn->port(), "\n<BR>";
        print "Connected tty: ", $conn->tty(), "\n<BR>";
        print "Connection Error Message: ", $conn->errorMessage(), "\n<BR>";
    }

    print qq(<h3>Package 'in::' Variables</h3>);

    foreach my $symname (sort keys %in::) {
	no strict 'vars';
        local *sym = $in::{$symname};
        print dUmper("\$in::$symname", $sym) if defined $sym;
        print dUmper("\@in::$symname", \@sym) 
	    if defined @sym and scalar @sym > 1;
    }

    print qq(<h3>Environment Variables:</h3>);
    print dUmper("\\\%ENV", \%ENV) . "<BR>\n";

    print qq(<HR>);
}

#>
#< url_button (url, text, %options)
sub url_button {
    my ($url, $text, %opts) = @_;
    
    my $out = qq(<small><form action="$url" method="post">);
    foreach (keys %opts) {
        $out .= qq(<input type="hidden" name="$_" value="$opts{$_}">);
    }
#    $out .= qq(<input type="image" src="img/$text.jpg" alt="$text" value="$text" border=1>);
    $out .= qq(<input type="submit" alt="$text" value="$text" border=1>);
    $out .= qq(</form></small>);
    return $out;
}
#>
#< self_url
my $self_url;
{
    my $SELFURL = "http://" . $ENV{SERVER_NAME} . $ENV{SCRIPT_NAME};
    my @params = param();
    my %opts;
    foreach my $param (@params) {
        $opts{$param}=param($param);
    }
    $self_url = sub {
        my %newopts = @_;
        my $data={ %opts };
        my $url = $SELFURL . "?";
        foreach my $opt (keys %newopts) {
            $data->{$opt} = $newopts{$opt};
        }
        foreach my $opt (keys %$data) {
            $url .= $opt ."=". $data->{$opt} . ";";
        }
        return uriesc($url);
    }
}
#>        

&debug_info();
#>


#< unesc (text)

sub unesc {
    my ($str) = @_;
    foreach my $badchar ($str =~ /%([0-9A-F][0-9A-F])/g) {
        my $goodchar = sprintf("%c", hex($badchar));
        $str =~ s/\Q%$badchar\E/$goodchar/g;
    }
    return $str;
}

#>

#< acc(text)  convert flying accents to html

# Note: as I've been lazy, I've only implemented Hungarian flying
# accents, and I've changed the standard single quote a' to ,a with a 
# comma, so as to reduce confusion with words like "I've" and "Olya's".

sub acc { 
    local $_ = join('',@_);
    s/(?<!\\),a/\&\#225/g;s/\\,a/,a/g;
    s/(?<!\\),e/\&\#233/g;s/\\,e/,e/g;
    s/(?<!\\),i/\&\#237/g;s/\\,i/,i/g;
    s/(?<!\\),o/\&\#243/g;s/\\,o/,o/g;
    s/(?<!\\),u/\&\#250/g;s/\\,u/,u/g;
    s/o:/\&\#246/g;
    s/u:/\&\#252/g;
    s/o=/\&\#244/g;
    s/u=/\&\#251/g;

    s/(?<!\\),A/\&\#193/g;s/\\,A/,A/g;
    s/(?<!\\),E/\&\#201/g;s/\\,E/,E/g;
    s/(?<!\\),I/\&\#205/g;s/\\,I/,I/g;
    s/(?<!\\),O/\&\#211/g;s/\\,O/,O/g;
    s/(?<!\\),U/\&\#218/g;s/\\,U/,U/g;
    s/O:/\&\#214/g;
    s/U:/\&\#220/g;s/\\:/:/g;
    s/O=/\&\#212/g;
    s/U=/\&\#219/g;s/\\=/=/g;
    return $_;
}
#>

my %photos = ();
my %folders = ();
my %captions = ();
my %thumbs = ();
my %northumbs = ();
my %brithumbs = ();
my %hilights = ();
my %hashilights = ();
my %ages = ();
my %other = ();
my %hilighted = ();
my $title = "Photos";
my $havebrighter=0; # bool : brightened photos are available in this directory

my $hilightfilename = ".hilights";

if (not $in::height or $in::height !~ /^\d+$/) {
    $in::height = $default_height;
}

my $height = "";
if ($in::height != $default_height) {
    $height = qq(height=$in::height);
} 

if ($in::url) {
    #< read everything from a url that gives me a pure directory list
    $height = q(&).$height if $height;

    use LWP::Simple;

    my $loc = $ENV{REQUEST_URI};
    $loc =~ s/\?.*//;

    my $urlfilepart = $in::url;
    $urlfilepart =~ s|\w+://[\w\.-]+/||;
    $urlfilepart =~ s|/$||;
    $title = basename($urlfilepart);

    my @listing = ();
    if ($in::url =~ m|^\w+://\w+|) {
	@listing = split /[\r\n]+/, get($in::url);
    }

    $in::url =~ s|/$||; #strip trailing slash

    local $_;
    my $thumbsdir;
    foreach (@listing) {
	#< directories
	#print qq($_\n);
	if (/\[DIR\]/) {
	    next if />Parent Directory</;
	    my ($name) = (/HREF="(.+?)"/i);
	    $name = &unesc($name);

	    my $target = qq($loc?url=$in::url/$name).$height;
	    if ($name eq "Thumbs/") {
		$thumbsdir=$name;
		next;
	    }

	    $folders{$name} = $target;
	}
	#>
	#< images

	elsif (/\[IMG\]/) {
	    my ($photo) = (/HREF="(.+?)"/i);
	    unless ($photo) {
		warm("could not read IMG line [$_]");
		next;
	    }

	    next if /\s1k\s*$/;

	    #construct name
	    my $name = $photo;
	    $name =~ s/\.[^\.]+$//;     # remove dot extension
	    
	    #keep current of duplicate iff I'm sure I can display it:
	    next if (defined $photos{$name} and
		     $photos{$name} =~ /\.(gif|jpg)$/i);
	    #assign target
	    $photos{$name}=qq($in::url/$photo);
	}

	#>
	#< captions
	elsif (/.cap\b/) {
	    my ($caption) = (/HREF="(.+?)"/);
	    next unless $caption =~ /\.cap$/;
	    
	    #construct name
	    my $name = $caption;
	    $name =~ s/\.[^\.]+$//;     # remove dot extension
	    
	    #assign target
	    $captions{$name} = get(qq($in::url/$caption));
	}	    
	#>
	#< other file types
	else {
	    my ($url) = (/HREF="(.+?)"/i);
	    next unless $url;
	    next if $url =~ /(~|\.cgi)$/;
	    next if $url =~ /\?/; # avoid passing args to cgi

	    #construct name
	    my $name = $url;
	    $name =~ s/\.[^\.]+$//;     # remove dot extension
	    
	    #assign target
	    $other{$name} ||= [];
	    push @{$other{$name}}, $url;
	}
	#>
    }

    #< nothing here? Display a form for a new url
    if (scalar(keys %folders) + scalar(keys %photos) == 0) {
	print <<"EOT";
<H3>Did not find a standard Apache directory listing to process at URL 
    <a href="$in::url">$in::url</a>.</H3>
    <form action="$loc">
    <b>URL:</b><input type=text name=url value="$in::url" size="70%">
	&nbsp;&nbsp;&nbsp;&nbsp;
    <b>image height:</b><input type=text name=height value="$default_height" size=4>
    <BR><input type=submit value="Try Again">
    </form>

EOT
    ;
    }
    #>
    #< read thumbnails from thumbsdir
    if (defined $thumbsdir) {
	@listing = split /[\r\n]+/, get($in::url."/".$thumbsdir);
	foreach (@listing) {
	    if (/\[IMG\]/) {
		my ($photo) = (/HREF="(.+?)"/);
		
		next if /\s1k\s*$/;
		
		#construct name
		my $name = $photo;
		$name =~ s/\.[^\.]+$//;     # remove dot extension
		
		#assign target
		$thumbs{$name}=qq($in::url/$thumbsdir/$photo);
	    }
	}
    }
    #>

    #>
    #< edit? no
    if ($in::edit) {
	print qq(<font color=red>Cannot edit a remote location</font><BR>\n);
	undef $in::edit;
    }
    #>
} else {
    #< read everything locally

    my $cwd = cwd();
    opendir(DIR, $cwd) or die "cannot read directory $cwd: $!\n";
    my @listing = readdir(DIR);
    closedir(DIR);

    my $loc = dirname($ENV{SCRIPT_NAME});
    $title = basename($loc);

    my $thumbsdir;

    my $unreadable=0;
    foreach (grep {!/^\./ and !/RCS/} @listing) {
	if (not -r $_) {
	    $unreadable++;
	    next;
	}
	#< directories (and find thumbsdir if any)
	if ( -d _ and -x _ ) { 
	    my $dir = $_;

	    if ($dir eq "Thumbs") {
		$thumbsdir=$dir;
		next;
	    }
	    
	    my $target = qq($loc/$dir);
	    if (-x qq($dir/index.cgi)) {
		$target .= qq(/index.cgi?$height);
	    } else {
		$target = qq($ENV{REQUEST_URI}?url=http://$ENV{SERVER_NAME}$target&$height);
	    }

	    my $hilightfile = qq($dir/$hilightfilename);
	    if (open(HILIGHT, $hilightfile)) {
		$hilights{$dir} = [];
		while (<HILIGHT>) {
		    next unless /\S/ and !/^\#/;
		    chomp;
		    push @{$hilights{$dir}}, $_ if -r qq($dir/$_);
		}
		$hashilights{$dir}=1;
	    } else {  # back off to a randomly selected image. 
		my @all;
		if (-r qq($dir/Thumbs) and -x _ and 
		    opendir(HDIR, qq($dir/Thumbs))) {
		    @all = grep /^[^\.].*\.(gif|jpg)$/i, readdir(HDIR);
		    @all = grep { s|^|Thumbs/|; } @all;
		} elsif (opendir(HDIR, $dir)) {
#		    @all = grep /^[^\.].*\.(gif|jpg)$/i, readdir(HDIR);
		    # loading and scaling these takes too long.
		}
		$hilights{$dir} = [ @all ] if @all;
	    }

	    $ages{$dir} = -M $dir;
	    
	    $folders{$dir} = $target;
	}
	#> 
	#< read photos
	elsif (/(\w.+)\.(gif|jpg|png)$/i) {
	    my $photo = $_;
	    my $name = $1;

	    #assign target
	    $photos{$name}=qq($loc/$photo);
	    if (-r qq($lighterPrefix$photo)) {
		if ($in::l) {
		    $photos{$name}=qq($loc/$lighterPrefix$photo);
		} else {
		    $havebrighter=1;
		}
	    }

	    $ages{$name} = -M $photo;
	}
	#> 
	#< read captions
	elsif (/(\w.+)\.(cap)$/i) {
	    my $caption = $_;
	    my $name = $1;
	    
	    #assign target
	    open(CAPTION, "<".$caption) or next;
	    $captions{$name} = join ("", <CAPTION>);
	    close CAPTION;
	}
	#>
	#< other file types
	else {
	    my $url = $_;
	    next if $url =~ /(~|\.cgi)$/;
	    
	    #construct name
	    my $name = $url;
	    $name =~ s/\.[^\.]+$//;     # remove dot extension
	    
	    #assign target
	    $other{$name} ||= [];
	    push @{$other{$name}}, $url;
	}
	#>
    }

    #< read thumbnails from thumbsdir
    if (defined $thumbsdir and opendir(DIR, $thumbsdir)) {
	my @thentries = readdir(DIR);
	closedir DIR;
	my @phos = grep { !/^\./ and /\w.+\.(gif|jpg|png)$/i } @thentries;
	foreach my $photo (@phos) {
	    #check readable
	    next unless -r $photo;
	    
	    #construct name
	    my $name = $photo;
	    $name =~ s/\.[^\.]+$//;     # remove dot extension
	    
	    #assign target
	    $northumbs{$name} = qq($thumbsdir/$photo);
	    $thumbs{$name}=qq($loc/$thumbsdir/$photo);
	    if (-r qq($thumbsdir/$lighterPrefix$photo)) {
		$brithumbs{$name} = qq($thumbsdir/$lighterPrefix$photo);
		if ($in::l) {
		    $thumbs{$name}=qq($loc/$thumbsdir/$lighterPrefix$photo);
		} else {
		    $havebrighter=1;
		}
	    }
	}
    }
    #>

    print qq(<font color=red>$unreadable files were unreadable</font><br>\n)
	if $unreadable;

    #>
    #< edit? writeable? 
    if (not -w $cwd) {
	print qq(<font color=red>Cannot write to this directory</font><BR>\n)
	    if $in::edit;
	undef $in::edit;
    } else {
	$in::editable=1;
    }
    #>
    #< %hilighted

    if (open(H,"<$hilightfilename")) {
	while(<H>) {
	    chomp;
	    my $base = $_;
	    $base =~ s|.*/||;
	    $base =~ s|\.\w+$||;
	    $hilighted{$base} = $_;
	}
    }

    #>
}

my @photoorder = (&range(values %ages) > 7) ? 
    sort { $ages{$a} <=> $ages{$b} } keys %photos : 
    sort keys %photos;
my $numhilights = scalar(grep { /^Thumbs/ or !/\// } values %hilighted);
$numhilights = 0 if $in::edit or $in::all;
my $bright = ($in::l?"l=1":"l=0");
$in::all = "&all=1" if $in::all;

#< slideshow find prev and next
my $prevphoto = "";
my $nextphoto = "";
if ($in::photo) {
    my $photo_index = 0;
    foreach my $photo (@photoorder) {
	if ($photo eq $in::photo) {
	    # find the next photo
	    $photo_index++; # start with next one
	    while (not $nextphoto and $photo_index < scalar @photoorder) {
		my $cand = $photoorder[$photo_index++];
		$nextphoto = $cand 
		    if $hilighted{$cand} or not $numhilights or $in::all;
	    }
	    last;
	} else {
	    $prevphoto = $photo
		if $hilighted{$photo} or not $numhilights or $in::all;
	}
	$photo_index++;
    }
}
#> 

#< save edits
if ($in::edit eq "save") {
    my $cwd = cwd();
    foreach my $item ("_header", "_footer", "_copyright", keys %photos) { 
	my $prm = param($item);
	if ($prm) {
	    my $filename = "$cwd/$item.cap";
	    open (CAP, ">".$filename) 
		or die "cannot write $filename: $@$!\n";
	    print CAP $prm;
	    print CAP "\n";
	    close CAP;
	    system qq(chmod a+w $filename\n);
	    #print qq(saved <font color=green>$filename</font>.<BR>\n);
	    $captions{$item}=$prm;
	}
    }
    foreach my $item (keys %photos) {
	my $photofile = $photos{$item};
	$photofile =~ s|.*$item([^/]+)$|$item$1|; #remove loc, just file.

	my $prm = param("hide-$item");
	if ($prm) {
	    if (-e $photofile) {
		system qq(mv $photofile .$photofile)
		    and die "could not hide $photofile: $!$@\n";
	    } else {
		die "$photofile does not exist?\n";
	    }
	    if (-e $lighterPrefix.$photofile) {
		unlink $lighterPrefix.$photofile or
		    die "cannot unlink $lighterPrefix$photofile: $!$@\n";
	    }
	    if (defined $northumbs{$item}) {
		unlink $northumbs{$item} or
		    die "cannot unlink $northumbs{$item}: $!$@\n";
	    }
	    if (defined $brithumbs{$item}) {
		unlink qq($brithumbs{$item}) or 
		    die "cannot unlink $brithumbs{$item}: $!$@\n";
	    }
	}
	$prm = param("hilight-$item");
	if ($prm) {
	    if (defined $thumbs{$item}) {
		$hilighted{$item} = "Thumbs/".$photofile;
	    } else {
		$hilighted{$item} = $photofile;
	    }
	} else {
	    if (defined $hilighted{$item}) {
		delete $hilighted{$item};
	    }
	}
    }
    if (scalar keys %hilighted) {
	open(H, ">$hilightfilename") or &cgidie("cannot save hilights: $!\n");
	foreach my $h (values %hilighted) {
	    print H qq($h\n);
	}
	close H;
    } else {
	if (-e "$hilightfilename") {
	    unlink "$hilightfilename";
	}
    }
    
    undef $in::edit;
    my $SELFURL = "http://" . $ENV{SERVER_NAME} . $ENV{SCRIPT_NAME};
    print <<"EOT";
<HTML>
<HEAD>
<META http-equiv="Refresh" content="0;URL=$SELFURL">
</HEAD>
<BODY>
Saved captions.  Refreshing, one moment...
</BODY>
</HTML>
EOT
    ;
    exit 0;
}
#>
#< save feedback
if ($in::feedback eq "save") {
    my $cwd = cwd();
    my $time = time();
    my $ip = $ENV{REMOTE_ADDR};
    my $ua = $ENV{HTTP_USER_AGENT};
    my $logfile = qq($logdir/$ip-$time);
    while (-e $logfile) {
	sleep 1;
	$time = time();
	$logfile = qq($logdir/$ip-$time);
    }
    open(LOG, ">", $logfile) or die "cannot write logfile: $!\n";
    print LOG qq(cwd=$cwd\n);
    print LOG qq(useragent=$ua\n);
    print LOG qq(localtime=).localtime()."\n";
    foreach my $g (qw(name contact share overall)) {
	my $p = param("feedback-$g");
	$p||="";
	print LOG qq($g=$p\n);
    }
    foreach my $g (qw(rate adj comment)) {
	foreach my $ph (keys %photos) {
	    my $prm = param("$g-$ph");
	    print LOG qq($g\t$ph\t$prm\n)
		if $prm;
	}
    }
    exit 0 if $debug;
    undef $in::feedback;
    my $SELFURL = "http://" . $ENV{SERVER_NAME} . $ENV{SCRIPT_NAME};
    print <<"EOT";
<HTML>
<HEAD>
<META http-equiv="Refresh" content="0;URL=$SELFURL">
</HEAD>
<BODY>
Sent feedback.  Thank you!  Refreshing, one moment...
</BODY>
</HTML>
EOT
    ;
    exit 0;
}
#>

#< generate html
$title = acc($title);
my $js = "&js=$in::js";
$js="" unless $in::js;

#< html head
print <<"EOH";
<HTML>
<HEAD><TITLE>Photos: $title</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
EOH
    ;
unless ($in::js or $in::photo) {
    print <<"EOH";
<SCRIPT type="text/javascript" language="JavaScript">
<!--
window.location="index.cgi?$bright$in::all&js=1";
// -->
</SCRIPT>
EOH
    ;
}
#>
#< title and buttons
print <<"EOH";
<table border=0 cellpadding=5>
<tr><td width="100%">
<H2>$title</H2>
EOH
    ;
&button_bar();
print <<"EOH";
</td></tr></table>
EOH
    ;
#>

#< debug_info
&debug_info("photos", \%photos, "thumbs", \%thumbs, 
	    "captions", \%captions, "folders", \%folders, 
	    "other", \%other);
#>

#< edit header.
if ($in::edit) {
    print qq(<form action="index.cgi" method="post">\n);
    print qq(<input type=hidden name=js value="$in::js">\n);
    print qq(<input type=hidden name=l value="$in::l">\n);
    print qq(<input type=hidden name=all value="$in::all">\n);
    print qq(<input type=hidden name=debug value="$in::debug">\n);
    print qq(<input type=hidden name=photo value="$in::photo">\n);
    print qq(<input type=hidden name=height value="$in::height">\n);

    print qq(<input type=hidden name=edit value=save>\n);
}
#>
#< _header and _copyright
$captions{_header} ||= "";
if (defined $captions{_header} and not $in::edit and not $in::photo) {
    print acc($captions{_header});
} elsif ($in::edit) {
    print qq(Copyright info:  e.g. <samp>2005 Gregory Marton</samp>, can also: include a url on its own line; more text; leave blank for default<BR>\n);
    print qq(<textarea name="_copyright" cols=100>);
    print $captions{_copyright};
    print qq(</textarea><BR><BR>\n);
    print qq(Header appears at top of page:<BR>\n);
    print qq(<textarea name="_header" cols=100>);
    print $captions{_header};
    print qq(</textarea><BR><BR>\n);
}   
if ($in::feedback) {
    print qq(<BR><BR>Thank you for offering your feedback!);
}
#>

if ((scalar(keys %folders) or scalar(keys %other)) and 
    not $in::photo and not $in::edit and not $in::feedback) {
    #< folders
    print qq(<BR>). scalar(keys %folders) . " folders:<BR>\n";
    #< @folderorder = sort the folders in some good way: 
    print "<!-- " . Dumper(\%ages) . " -->";
    my @folderorder = (&range(values %ages) > 7) ? 
	sort { 
	    if ($a =~ /^\d+-/ and $b =~ /^\d+-/) {
		$b cmp $a;
	    } elsif ($a =~ /^\d+-/) {
		-1;
	    } elsif ($b =~ /^\d+-/) {
		1;
	    } else {
		$b cmp $a;
	    } } keys %folders :
	sort keys %folders;
    #>
    my $iter=0;
    print qq(<table border=0>);
    foreach my $dir (@folderorder) {
	print qq(<tr>\n) unless ($iter % 4);
	$iter++;
	print qq(<TD valign=bottom>);
	if (defined $hilights{$dir} and scalar @{$hilights{$dir}}) {
	    print qq(<center>);
	    print qq(<a href="$folders{$dir}$bright$js">);
	    my @choice = @{$hilights{$dir}};
	    my $hilight = $dir ."/". $choice[rand(scalar @choice)];
	    if ($in::l) {
		my (@parts) = split "/", $hilight;
		my $f = pop @parts;
		my $lighter = join("/", @parts)."/.l-".$f;
		$hilight = $lighter if (-e $lighter);
		print qq(<!-- lighter would have been [$lighter] -->\n);
	    }
	    print qq(<img src="$hilight" width=200 border=0><BR>);
	    print qq(</a>\n);
	    print qq(<a href="$folders{$dir}">);
	    if ($hashilights{$dir}) {
		print acc($dir).qq(</a>);
		print qq(<font size="-1">\().scalar(@choice).qq(\)</font>);
	    } else {
		print qq(<font size="-1">).acc($dir).qq(</a>);
	    }
	    print qq(</center></td>\n);
	} else {
	    print qq(<a href="$folders{$dir}">);
	    print qq(<img src="$diricon" border=0>);
	    print qq(</a>\n);
	    print qq(\&nbsp;\&nbsp;\&nbsp;<a href="$folders{$dir}$bright">);
	    print acc($dir).qq(</a></td>\n);
	}
	print qq(</tr>\n) unless ($iter % 4);
    }
    print qq(</table>\n);
    #>
}

if ($in::photo) {
    #< show slide

    #< get slide size ($w, $h)
    my ($winW, $winH)= (640, 480);
    my ($w, $h) = (640, 480);
    if ($photos{$in::photo} !~ m|^http://|) {
	my $photo_file = $photos{$in::photo};
	my $current_dir = dirname($ENV{SCRIPT_NAME});
	$photo_file =~ s|\Q$current_dir\E/||;
	push @INC, qw(/afs/csail/u/g/gremio/.cpan/keepers/Data-Dump-1.06/lib/ /afs/csail/u/g/gremio/.cpan/keepers/IO-String-1.06/blib/lib/ /afs/csail/u/g/gremio/.cpan/keepers/Image-Info-1.21/lib/); 
	require Image::Info;
	#print $photo_file;
	($w,$h) = Image::Info::dim(Image::Info::image_info($photo_file));
	#print $w."x".$h."<BR>\n";
    }
    #>
    #< caption
    if (defined $captions{$in::photo}) {
	print qq(<font size="+1">).acc($captions{$in::photo}).qq(</font><BR>);
    }
    #>

    print qq(<center>);
    print qq(<a href="index.cgi?photo=$nextphoto&$bright$in::all$js">);
#    print qq(<a href="$photos{$in::photo}">);
    if ($in::js) {
	#< javascript resizer (to window size) and show img
	my $photofile = $photos{$in::photo};
	$photofile =~ s|\'|\\\'|g;
	print <<"EOJ";
<SCRIPT type="text/javascript" language="JavaScript">
<!-- //for intelligent sizing of photos: 

    function showMyImage() {
	var winW = 630, winH = 460;
	
	if (parseInt(navigator.appVersion)>3) {
	    if (navigator.appName=="Netscape") {
		winW = window.innerWidth;
		winH = window.innerHeight;
	    }
	    if (navigator.appName.indexOf("Microsoft")!=-1) {
		winW = document.body.offsetWidth;
		winH = document.body.offsetHeight;
	    }
	}
	
	document.write('<img src="$photofile"');
	winH -= 95;  // buttons height
	winW -= 30;
	if ($h/winH > $w/winW) {
	    if ($h > winH) {
		document.write(' height='+winH);
	    } 
	} else if ($w > winW) {
	    document.write(' width='+winW);
	}
	document.write(' border=1><BR>');
	// document.write('w='+winW+' h='+winH+'<BR>');
    };
    showMyImage();
  -->
</SCRIPT>
EOJ
;
	#print qq( border=1><BR>);
	print qq(\n</a>);
	print qq(<BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>\n);
	print qq(\(<a href="index.cgi?photo=$in::photo&$bright$in::all">);
	print qq(click here</a> if there is no image\)<BR>\n);
	#>
    } else {
	#< perl resizer (to defaults) 
	my $sizec;
    	if ($h > $w) {
	    if ($h > $winH) {
		$sizec = ' height='.$winH;
	    } 
	} elsif ($w > $winW) {
	    $sizec = ' width='.$winW;
	}
	print qq(<img src="$photos{$in::photo}");
	print qq( $sizec);
	print qq( border=1>);
	#>
    }
    print qq(</center>);

    #>
} elsif (scalar keys %photos) {
    print qq(<table border=0 cellpadding=0><tr>);
    #< photos
    if ($in::edit or $in::feedback) {
	print qq(<TD width="90%" valign=top>\n);
    } else {
	print qq(<TD width="67%" valign=top>\n);
    }
    print qq(<BR>);

    print "$numhilights of " if $numhilights;
    print scalar(keys %photos) . " photos:";
    print &url_button(&self_url(), "Show All", "all"=>1) if $numhilights;
    print "<BR>\n";
    #< feedback header
    # radio buttons and nested forms don't work well together in firefox
    # (Safari handles them correctly) so I have to be careful not to open
    # this form until I've closed the previous form (Show All) above.
    if ($in::feedback) {
	print qq(<form action="index.cgi" method="post">\n);
	print qq(<input type=hidden name=js value="$in::js">\n);
	print qq(<input type=hidden name=l value="$in::l">\n);
	print qq(<input type=hidden name=all value="$in::all">\n);
	print qq(<input type=hidden name=debug value="$in::debug">\n);
	print qq(<input type=hidden name=photo value="$in::photo">\n);
	print qq(<input type=hidden name=height value="$in::height">\n);
	
	print qq(<input type=hidden name=feedback value=save>\n);
	print qq(<center><BR><BR>);
	print qq(<input type=submit value="Submit Ratings and Comments">);
	print qq(</center><BR><BR><BR>);
    }
    #>
    print qq(<table border=0 cellpadding=1>\n);

    foreach my $photo (@photoorder) {
	next if $numhilights and not $hilighted{$photo};
	print qq(<tr><td>\n);
#	print qq(<a href="$photos{$photo}" target="photoview">);
	print qq(<a href="index.cgi?photo=$photo&$bright$in::all$js" target="photoview">);
	#< thumbnail
	if (defined $thumbs{$photo}) {
	    print qq(<img src="$thumbs{$photo}" valign=top align=left>);
	} else {
	    print qq(<img src="$photos{$photo}" height=$in::height valign=top align=left>);
	}
	#> 
	print qq(</a>);
	#< related files/formats
	if (defined $other{$photo}) {
	    foreach my $file (@{$other{$photo}}) {
		print qq( \&nbsp;\&nbsp;\&nbsp; <a href="$file">$file</a>);
	    }
	    delete $other{$photo};
	}
	print qq(\n);
	#>
	#< caption
	if (defined $captions{$photo} and not $in::edit) {
	    print acc($captions{$photo});
	} 
	#>
	#< edit form
	elsif ($in::edit) {
	    print qq(<input type=checkbox name="hide-$photo" value=1>hide<br>);
	    my $hilight_checked = "checked" if $hilighted{$photo};
	    print qq(<input type=checkbox name="hilight-$photo" value=1 $hilight_checked>hilight<br>);
	    print qq(<textarea width="20" name="$photo" cols=40 rows=16>);
	    print qq($captions{$photo});
	    print qq(</textarea><BR>);
	} 
	#> 
	#< feedback form
	if ($in::feedback) { 
	    print qq(<BR><HR>rate this photo: &nbsp;&nbsp;&nbsp;);
	    print qq(<font size="-1"><tt>terrific</tt></font> );
	    my $scale=5;
	    for my $i (0 .. ($scale-1)) {
		my $n = $scale-$i;
		print qq(<input type="radio" name="rate-$photo" value="$n">$n );
	    }
	    print qq( <font size="-1"><tt>terrible</tt></font> );
#	    print qq(&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; );
#	    print qq(<select name="adj-$photo"><option value=""></option>);
#	    for my $opt (qw(funny pretty interesting neat boring unflattering please_remove_it)) {
#		my $adj = $opt; $adj =~ s/_/ /g;
#		print qq(<option value="$opt">$adj</option> );
#	    }
#	    print qq(</select>);
	    print qq(<BR><BR>);
	    print qq(your comments? <BR>); 
	    print qq(<textarea name="comment-$photo" cols=40 rows=2></textarea>);
	}
	#>
	#< thirdcol (image link)
	if ("thirdcol") {
	    my $ext = $photos{$photo};
	    $ext =~ s/.*\.//;
	    print qq(</td><td valign=top><a href="$photos{$photo}" target="photoview"><font size="-1">$ext</font></a>);
	}
	#>
	print qq(\n</td></tr>);
    }
    print qq(</table></TD>\n);
    #>
    print qq(</tr></table>\n);
}
if (scalar(keys %other) and not $in::photo and not $in::feedback) {
    #< other
    print qq(<BR>). scalar(keys %other) . " files:<BR>\n";
    foreach my $name (sort keys %other) {
	foreach my $file (@{$other{$name}}) {
	    print qq(<a href="$file">$file</a> \&nbsp;\&nbsp;\&nbsp; );
	}
	print qq(<BR>\n);
	print acc($captions{$name}) if defined $captions{$name};
	print qq(\n<BR><BR>);
    }
    #>
}

#< _footer
if (defined $captions{_footer} and not $in::edit and not $in::photo) {
    print acc($captions{_footer});
} elsif ($in::edit) {
    print qq(<textarea name="_footer" cols=100>);
    print $captions{_footer};
    print qq(</textarea><BR><BR>\n);
}   
#>
#< edit: submit
if ($in::edit) {
    print qq(<input type=submit value="Save Changes">);
    print qq(</form>\n);
} elsif ($in::editable) {
#    print qq(<form action=\").&self_url().qq(\">);
#    print qq(<input type=hidden name=edit value=1>);
#    print qq(<input type=submit align=right value="Edit"></form>\n);
} 
#>
#< feedback: submit
if (not $in::edit and $in::feedback) {
    print qq(<BR><BR>);
    print qq(<center>);
    print qq(<input type=submit value="Submit Ratings and Comments"><BR><BR>);
    print qq(<table border=1><tr><td>);
    print qq(What is your name?);
    print qq( <input type=text name="feedback-name" size=20><BR><BR>);
    print qq(Would you like a response?  If so, how may I reach you? <BR>);
    print qq( <input type=text name="feedback-contact" size=41><BR><BR>);
    print qq(Do you have overall comments about this album?<BR>);
    print qq(<textarea name="feedback-overall" cols=40 rows=4></textarea><BR>);
    print qq(May I share your feedback with other readers?);
    print qq(<input type=checkbox name="feedback-share"> Yes.<BR>);

    print qq(Thanks again for your comments! &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; );
    print qq(<input type=submit value="Send Feedback">);
    print qq(</td></tr></table></center>);
    print qq(</form>\n);    
}
#>

#< title and buttons
print <<"EOH";
<table border=0 cellpadding=5>
<tr><td width="100%">
<H2>$title</H2>
EOH
    ;
&button_bar();
print <<"EOH";
</td></tr></table>
EOH
    ;
#>

print qq(</body></html>\n);
#< button_bar
sub button_bar {
#< slideshow buttons
if ($in::photo) {
    print qq(</td><td align=right>\n);
    print qq(<a href="index.cgi?photo=$prevphoto&$bright$in::all$js"><img src="/~gremio/icons/blue_prev.gif" alt="prev"></a>);
    print qq(<a href="index.cgi?$bright$in::all$js"><img src="/~gremio/icons/blue_top.gif" alt="up"></a>);
    print qq(<a href="$photos{$in::photo}"><img src="/~gremio/icons/blue_readme.gif" alt="detail"></a>);
    print qq(<a href="index.cgi?photo=$nextphoto&$bright$in::all$js"><img src="/~gremio/icons/blue_next.gif" alt="next"></a>\n);
#    print qq(<center><font size="-2">click photo = next</a></font></center>\n);
} elsif (scalar @photoorder) {
    print qq(</td><td align=right>\n);
    $nextphoto=$photoorder[0];
    print qq(<a href="index.cgi?photo=$nextphoto&$bright$in::all$js"><img src="/~gremio/icons/slideshow.png" alt="next" border=0></a>\n);
}
#>
#< send feedback
    if (scalar keys %photos) {
	print <<"EOT";
</td><td align=right width=56>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href="index.cgi?$bright$js$in::all&feedback=1"><img src="http://csail.mit.edu/~gremio/icons/feedback" border=0></a>
EOT
;
    }
#>
#< up-a-dir
my $upurl = "";
if ($in::url) {
    $upurl = $in::url;
    $upurl =~ s|/[^/]+/?$|/|;
} elsif ($ENV{SCRIPT_NAME} !~ m|gremio/pics/[^/]+(/[^/]+)?$|) {
    $upurl = "../index.cgi?$bright$in::all$js";
}
if ($upurl) {
    print <<"EOH";
</td><td align=right width=100>
<center><a href="$upurl">
<img src="/~gremio/icons/blue_up.gif" alt="up a directory" border=0>
</a></center>
EOH
    ;
}
#>
#< back to Grem's photos
unless ($in::url) {
    print <<"EOH";
</td><td align=right width=100>
<center><a href="/~gremio/pics/index.cgi?$js">
<font size="-3">back to</font><BR>Grem&apos;s<BR>photos
</a></center>
EOH
    ;
}
#>
#< copyright info
{
    my $copyright = $captions{_copyright};
    if ($copyright or $in::url) {
	#< show copyright as promised. 
	my $copyicon = "/~gremio/logos/copyright.gif";
	if ($copyright =~ /creativecommons.org/) {
	    $copyicon = "/~gremio/logos/cc.png";
	}

	my $copyurl = "http://www.whatiscopyright.org/";
	if ($copyright =~ m|^(http://[\w\.-]+/\S+)$|m) {
	    $copyurl = $1;
	}
	
	my $copytext = "copyright";
	if ($copyright =~ m@^(\d*(\s|\&nbsp;)*[A-Z][a-z]+[^\n]*)\n@s) {
	    $copytext = $1;
	}
	print <<"EOH";
</td><td align=right width=150>
<center>
<a href="$copyurl">
  <img src="$copyicon" border=0><BR>
  <font size="-2">$copytext</font></a></center>
EOH
    ;
#>
    } else {
	#< creative commons copyright info
	print <<"EOH";
</td><td align=center width=150>
<!-- Creative Commons License -->
<a rel="license" href="http://creativecommons.org/licenses/by-nc-sa/3.0/us/">
<img alt="Creative Commons License" style="border-width:0" src="http://i.creativecommons.org/l/by-nc-sa/3.0/us/88x31.png" />
</a><br />
<font size="-2">Distributed under a <a rel="license" href="http://creativecommons.org/licenses/by-nc-sa/3.0/us/">Creative&nbsp;Commons&nbsp;License</a></font>
<!-- /Creative Commons License -->

<!--

<rdf:RDF xmlns="http://web.resource.org/cc/"
    xmlns:dc="http://purl.org/dc/elements/1.1/"
    xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
<Work rdf:about="">
   <dc:type rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
   <license rdf:resource="http://creativecommons.org/licenses/by-nc-sa/3.0/"
/>
</Work>

<License rdf:about="http://creativecommons.org/licenses/by-nc-sa/3.0/">
   <permits rdf:resource="http://web.resource.org/cc/Reproduction" />
   <permits rdf:resource="http://web.resource.org/cc/Distribution" />
   <requires rdf:resource="http://web.resource.org/cc/Notice" />
   <requires rdf:resource="http://web.resource.org/cc/Attribution" />
   <prohibits rdf:resource="http://web.resource.org/cc/CommercialUse" />
   <permits rdf:resource="http://web.resource.org/cc/DerivativeWorks" />
   <requires rdf:resource="http://web.resource.org/cc/ShareAlike" />
</License>
</rdf:RDF>

-->
EOH
;
    #>
    }
}
#>
#< brightness icon
print <<"EOH";
</td><td align=right width=100>
EOH
    ;
if ($in::l) {
    print qq(<a href="index.cgi?l=0&photo=$in::photo$in::all$js">
	     <img src="/~gremio/icons/brightness-cancel.gif" 
	          alt="darker" border=0></a>\n);
} elsif ($havebrighter) {   # put up the golden brightness icon with the title
    print qq(<a href="index.cgi?l=1&photo=$in::photo$in::all$js">
	     <img src="/~gremio/icons/brightness-icon.png" 
	          alt="brighter" border=0></a>\n);
}
#>
}
#>

#>

#< range(@numeric-list) returns max - min
sub range {
    my @list = @_;
    return undef unless @list;
    my $min = shift @list;
    my $max = $min;
    foreach my $ele (@list) {
	$min = $ele if $ele < $min;
	$max = $ele if $ele > $max;
    }
    return $max - $min;
}
#>