Happy to show the code, but never uploaded code to Perlmonks before (just joined this week). Is there something better than just putting it in an ordinary message? And do I have to go through and escape lots of special characters when I do that?

Actually, I think the profiling demonstrates that the main problem is the loading of modules. So I have to either find some way to use fewer or smaller modules, or to get greater persistance of the process (mod_perl or fastcgi). Using something other than YAML for communicating the config from the front-end program to the picture display program might conceivably help -- but that config is also user-editable, so a binary format would cost me a lot of work elsewhere.

Is there something better than just putting it in an ordinary message? And do I have to go through and escape lots of special characters when I do that?

Putting code fragments in messages is standard practice here. Surround the code with a <code> .. </code> tag pair, and HTML entities with the code will be handled automagically.

Okay, here's the current code.

#! /usr/bin/perl -w

# $Id: picpage.cgi,v 1.25 2004/01/09 04:44:32 ddb Exp $

use Date::Format;
use URI::Escape;
use File::stat;
use Fcntl ':flock';        # import LOCK_* constants

my $debug = 0;

# Easy lookup index of image files we'll handle
my %imagetypes = (
           'jpg', 1,
           'jpeg', 1,
           'JPG', 1,
           'JPEG', 1,
           'gif', 1,
           'GIF', 1,
           'png', 1,
           'PNG', 1
           );

# This script is intended to work in conjunction with image-index. It
# makes a custom page for the given image, and brings in possible
# associated data for that page.  Put picpage in /cgi-bin; it expects
# the path to the file in PATH_INFO.

# It's to be invoked with additional path info leading to the actual
# image; $PATH_TRANSLATED must point there.

# This extended version should be backwards-compatible with the old
# one, and also work (rather more featurefully) with galpage.pl
# pages. 

# Newform is used if the galinfo.yaml file is present and doesn't
# contain <the thing to force oldform>.  In newform, you specify the
# album directory as additional path info, and the photo ID as a
# parameter (id=).

$newform = 0;

$ENV{PATH} = "/bin:/usr/bin:/usr/local/bin";

# Config add comments (overridden by galcfg in galinfo for newform)
my $AddCommentsScript = 'GalleryAddComment.pl';
#my $AddCommentsScript = 'gac.cgi'; # ZZZ for testing
my $AddCommentsText = 'To add a comment to this photo, enter it here a
+nd click submit.';
my $AddCommentsFromPrompt = 'Who is commenting?';

# Get directory part of path info only, even if filename is there too.
$ENV{'PATH_TRANSLATED'} =~ qr|^(.*?)(/[^/]+\..+)?$|;
my $picdir = $1;
chdir ($picdir) || die "Can't chdir to $picdir";    
my $galinfo;
my $picid;

if (-r "galinfo.yaml") {
    use YAML qw (LoadFile);
    $galinfo = LoadFile ("galinfo.yaml");
    if (! $galinfo) {
    die "Failed to load galinfo.yaml";
    }
    if ($galinfo->{OLDPICPAGE}) {
    $newform = $galinfo->{OLDPICPAGE};
    } else {
    $newform = 1;
    }
    undef $galinfo unless $newform;
}
# Missing id can override above decision, however
# Note this isn't fully general!
if ($ENV{QUERY_STRING} =~ /id=(.*)/i) {
    $picid = uri_unescape($1);
} else {
    $newform = 0;
}

if ($newform) {

    # Show a single picture in the context of a gallery; meaning links
    # back to the gallery, and forward and backward links, and title
    # and info information and comments.

    use strict;
    use warnings;
    use Data::Dumper;

    my ($title, $picurl, $picfile, $picnav, $previd, 
    $nextid, $debinfo, $descr, $piccomments, $mtimestr, 
    $entercmt, $style, $picbottomtext);
    my $error = '';
    $debinfo = '';
    eval {            # Trap errors to make error page
    # Get data
    my $picobj;

    # Photo ID must be present
    if (! defined ($picid)) {
        die "No picture id defined in query string";
    }
    if (! exists ($galinfo->{OBJINFO}->{$picid})) {
        die "Invalid picture id $picid";
    }
    $picobj = $galinfo->{OBJINFO}->{$picid};
    $picurl = $ENV{PATH_INFO};
    if ($picurl =~ /(\.\.)/) {
        die "Attempt to leave current directory in picture path $picur
+l";
    }
    $picfile = $picobj->{file};
    if ($picfile =~ /(\.\.)|\//) {
        die "Attempt to leave current directory in picture file $picfi
+le";
    }
    if (! -r $picfile) {
        die "No readable file for picture $picfile";
    }
    my $ext;
    if ($picfile =~ /^.*\.(.+)$/) {
        $ext = $1;
        die "$picfile not a picture type I understand" unless $imagety
+pes{$ext};
    } else {
        die "No file extension in $picfile";
    }

    # Allow local config of comment prompts and handling
    $AddCommentsScript = $galinfo->{GALCFG}->{ADDCOMMENTSSCRIPT} || $A
+ddCommentsScript;
    $AddCommentsText = $galinfo->{GALCFG}->{ADDCOMMENTSTEXT} || $AddCo
+mmentsText;
    $AddCommentsFromPrompt = $galinfo->{GALCFG}->{ADDCOMMENTSFROMPROMP
+T} ||
        $AddCommentsFromPrompt;
    # Make ordered list
    my @order = sort {$a->[1] <=> $b->[1] || $a->[0] cmp $b->[0]} map 
+[$_,$galinfo->{OBJINFO}->{$_}->{sort}], keys %{$galinfo->{OBJINFO}};
    $debinfo .= " order " . Dumper (@order);
    # Find our current one ($picid). Only once, so no point bulding ha
+sh.
    for (my $i=0; $i<$#order; $i++) {
        if ($order[$i]->[0] eq $picid) {
        if ($i > 0) {
            # There's a previous, get it
            $previd = $order[$i-1]->[0];
        } else {
            undef $previd;
        }
        if ($i < $#order) {
            # There's a next, get it
            $nextid = $order[$i+1]->[0];
        } else {
            undef $nextid;
        }
        last;
        }
    }

    # Assemble the navigation elements
    $picnav = "";
    $picnav .= "<a href=\"$ENV{SCRIPT_NAME}$picurl?id=$previd\">[prev]
+</a>" if $previd;
    $picnav .= "<a href=\".\">[up]</a>";
    $picnav .= "<a href=\"$ENV{SCRIPT_NAME}$picurl?id=$nextid\">[next]
+</a>" if $nextid;

    if ($picobj->{title}) {
        $title = $picobj->{title};
    } else {
        $title = $picid;
    }

    $descr = $picobj->{descr};

    # Get comment block, if any
    my ($commentfn, $commentts);
    $commentfn = "$picid.comments";
    eval {            # Protect from blowouts
        $piccomments = "";
        $commentts = 0;
        my $if;
        open ($if, $commentfn) and
        flock ($if, LOCK_SH) and
        ($commentts = stat($if)->mtime) and
        ($piccomments = join (" ", <$if>)) and
        flock ($if, LOCK_UN);
        close $if;
    };
    if ($@) {
        # It's legal to not have this stuff
        $piccomments = '';
        $commentts = 0;
    }

    # Decide if we're allowing comments, and generate html block
    # to allow users to do so, or else blank block.
    $entercmt = '';
    if ($galinfo->{GALCFG}->{COMMENTS} && 
        (-w "$picid.comment" || -f ".mkcomment")) {
        $entercmt =  qq|<p><hr></p>\n|;
        $entercmt .=  "<p>$AddCommentsText</p>\n";
        $entercmt .=  "<form method=\"post\" action=\"$AddCommentsScri
+pt$picurl?id=$picid\">\n";
        $entercmt .=  "<p>$AddCommentsFromPrompt <input type=\"text\" 
+size=30 maxsize=50 name=\"user\"></p>\n";
        $entercmt .=  qq|<p><textarea name="comment" rows=5 cols=60></
+textarea></p>\n|;
        $entercmt .=  qq|<p><input type="submit" value="Submit Comment
+"></p>\n|;
        $entercmt .=  "</form>\n";
    }

    # Figure out what lie we're going to tell about last-modified time
    # Check actual image file
    my $imagets;
    $imagets = stat($picobj->{file})->mtime or 0;
    my $mtime;
    $mtime = $imagets > $commentts ? $imagets : $commentts;
    $mtimestr = time2str ("%a, %d %b %Y %H:%M:%S %z", $mtime, "GMT");

    # Grab proper local stylesheet from config in info
    $style = $galinfo->{GALCFG}->{STYLESHEET} || "local.css";

    # Very bottom text (bottom nav, usually)
    $picbottomtext = $galinfo->{GALCFG}->{PICBOTTOMTEXT};
    };
    if ($@) {
    $error = $@;
    # Display error page
    print <<errpage ;
Content-type: text/html; charset=iso-8859-1;
Cache-Control: no-cache;

<html><head>
<title>Picture display error</title>
</head>
<body>
<h1>Picture Display Error</h1>
<p>$error</p>
</body></html>
errpage
    } else {
    # Display page
    # We don't use CGI since it's so big, and this is doing such simpl
+e
    # stuff.
    print <<pagetop ;
Content-type: text/html; charset=iso-8859-1;
Cache-Control: public;
Last-Modified: $mtimestr;

<html><head>
<title>$title</title>
<base href="$picurl/">
<link rel="stylesheet" type="text/css" href="$style">
pagetop

        print "</head><body>\n";
    print '<!-- Generated by $Id: picpage.cgi,v 1.25 2004/01/09 04:44:
+32 ddb Exp $ -->', "\n";
    print "<div class=\"picnav\">", $picnav, "</div>\n";
    print "<div class=\"pictitle\">$title</div>\n";
    print "<div class=\"picimg\">",
    "<img class=\"picimg\" src=\"$picfile\" alt=\"$title\">",
    "</div>", "\n";
    print "<div class=\"picinfo\">", $descr, "</div>\n";
    print "<div class=\"picnav\">", $picnav, "</div>\n";
    print "<div class=\"piccomments\">", $piccomments, "</div>\n";
    print "<div class=\"picentercomments\">", $entercmt, "</div>\n";
#    print "<div class=\"debug\">picdir $picdir<br> previd $previd <br
+>picid $picid <br>nextid $nextid <br>picurl $picurl <br>picfile $picf
+ile
#<p>$debinfo</p></div>\n";
    print "<div class=\"posttext\">", $picbottomtext, "</div>\n";
    print "</body></html>\n";
    }
} else {
    # Old-style display
    # Set some defaults, which the config file may override.
    my $AddComments = 0;

# Pick up a config file if it's in the same directory as the image fil
+e
# ZZZ Should follow the chain up somehow, or at least look at the "top
+".
# ZZZ Should make image-index behave identically in finding config fil
+es
    if ($ENV{"PATH_TRANSLATED"}) {
    $ENV{'PATH_TRANSLATED'} =~ qr{(.*)/[^/]*};
    $dir = $1;
    chdir ($dir) || die "Can't chdir to $dir";    
    @buf = ();
    open (CUSTOM, "image-index.config") && 
        (@buf = <CUSTOM>) &&
        close (CUSTOM);
    eval "@buf"; warn "image-index: error in $dir init file: $@" if $@
+;
    }

    $error = undef;
    $fpath = $ENV{'PATH_TRANSLATED'};
    if (!$fpath) {
    $error = "No path to image file specified";
    } elsif (! -r $fpath) {
    $error = "Image file nonexistent or unreadable";
    } elsif ($fpath !~ /^(.*)\.([^.]+)$/) {
    $error = "Image file name doesn't have an extension";
    } else {
    $base = $1;
    $extn = $2;
    if (!$imagetypes{$extn}) {
        $error = "Image file extension isn't one we recognize";
    } else {
        eval {
        $name = "";
        $namemtime = 0;
        open (NFILE, "$base.name") and 
            $namemtime = stat(NFILE)->mtime and
            $name = join (" ", <NFILE>);
        close NFILE;
        };
        if (!$name) {
        $name = "Image $base";
        }
        eval {
        $info = "";
        $infomtime = 0;
        open (IFILE, "$base.info") and
            $infomtime = stat (IFILE)->mtime and
            $info = join (" ", <IFILE>);
        close IFILE;
        };

        # Note that the image mtime isn't needed, since the image is f
+etched
        # separately from a static file, and Apache provides the right
+ mtime
        # for that. This may result in an mtime of 0 if no .name or .i
+nfo is
        # present!  But it'll be consistent from request to request, s
+o that's 
        # okay.

        # Pick latest modification date
        $infomtime = $namemtime if $namemtime > $infomtime;

        print "Content-type: text/html\n";
        print "Last-Modified: ", time2str ("%a, %d %b %Y %H:%M:%S %z",
+ $infomtime, "GMT"), "\n";
        print "Cache-control: public\n";
        print "\n";

        print "<html><head>\n";
        print '<!-- $Id: picpage.cgi,v 1.25 2004/01/09 04:44:32 ddb Ex
+p $ -->' . "\n";
        print "<title>$name</title>\n";
        print "</head><body>\n";
        print "<h1>$name</h1>\n";
        $URL = $ENV{'PATH_INFO'};
        $URL =~ s/ /%20/g ;
        print '<img src="' . $URL . '">' . "\n";
        if ($debug) {
        print '<p>URL: ' . $URL . "</p>\n";
        print "</p>\n";
        }
        if ($info) {
        print "<div> $info </div>\n";
        }
        if ($AddComments && -w "$base.info") {
        print qq{<p><hr></p>}, "\n";
        print "<p>$AddCommentsText</p>\n";
        print "<form method=\"post\" action=\"$AddCommentsScript$URL\"
+>\n";
        print "<p>$AddCommentsFromPrompt <input type=\"text\" size=30 
+maxsize=50 name=\"user\"></p>\n";
        print '<p><textarea name="comment" rows=5 cols=60></textarea><
+/p>', "\n";
        print '<p><input type="submit" value="Submit Comment"></p>', "
+\n";
        print '</form>', "\n";
        }
        print "</body></html>\n";
    }
    }
    if ($error) {
    print "Content-type: text/html\nCache-Control: no-cache\n\n";
    print "<html><head><title>picpage error</title></head>\n";
    print "<body>\n";
    print "<h1>Picpage error</h1>\n";
    print "<p> $error </p>\n";
    print '<p> Image file: ' . $ENV{'PATH_INFO'} . "\n";
    print "</body></html>\n";
    }
}
[download]

Just post the code in a reply, between <code> tags.

-- zigdon