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"; } }
In reply to Re: Re: Re: Re: Startup cost, CGI performance
by dd-b
in thread Startup cost, CGI performance
by dd-b
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |