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

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.

Replies are listed 'Best First'.
Re: Re: Re: Startup cost, CGI performance
by dws (Chancellor) on Jan 14, 2004 at 18:53 UTC
    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"; } }
        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.

(z) Re^3: Startup cost, CGI performance
by zigdon (Deacon) on Jan 14, 2004 at 19:03 UTC
    Just post the code in a reply, between <code> tags.

    -- zigdon