in reply to Re: Re: Startup cost, CGI performance
in thread Startup cost, CGI performance

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.

  • Comment on Re: Re: Re: Startup cost, CGI performance

Replies are listed 'Best First'.
Re: Re: Re: Re: Startup cost, CGI performance
by dd-b (Pilgrim) on Jan 14, 2004 at 21:26 UTC

    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"; } }
      I can see several things in there that you might want to do spot performance analysis on. For example, how long does
      $galinfo = LoadFile ("galinfo.yaml");
      take? Run down the code, and any place you're doing something that you can't easily characterize behavior on, throw some timing code around it. You can emit the raw timing info in an HTML comment, and get at it via View Source.

      Another thing to note, if you aren't clear on it, is that putting a use inside a conditional doesn't make the use conditional; it just limits scope.

      You might also consider whether you really need File::stat, or can make do with built-ins.

        The YAML read takes about .5 seconds in this case -- it's there in the timings in my original post, and has been discussed already. That's the single big chunk of time, other than loading the modules. However, the application depends on manual editing of that file as well as automated reading/writing, so changing it to a binary format would require me to develop a whole new application for the "manual editing", so that's low on my priorities.

        Is File::stat particularly big? I could work around dropping that. I'll look/test that; I'm not hopeful, though, the .pm file is only 2.8k, plus it pulls in Class::Struct which is 18.7k. I guess if nothing else pulls in Class::Struct that might be of some significance.