[Bio] / Clearinghouse / pins_for_peg.pl Repository:
ViewVC logotype

View of /Clearinghouse/pins_for_peg.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (as text) (annotate)
Wed Jan 11 21:19:21 2006 UTC (13 years, 9 months ago) by olson
Branch: MAIN
CVS Tags: myrast_33, HEAD
Changes since 1.1: +2 -2 lines
Collected clearinghouse updates.

use CGI;
use strict;
use URI::Escape;

#
# Retrieve the cached pins page for the peg given in the peg parameter.
# If want_jpeg is set, return the jpeg image. Otherwise return the
# html file.
#

my $pin_base_dir = "/disks/space0/olson/Pins";

my $cgi = new CGI;

my $peg = $cgi->param('peg');
my $want_jpeg = $cgi->param('want_jpeg');

if (!$peg)
{
    &error("PEG parameter missing");
}

my($genome, $pnum) = $peg =~ /^fig\|(\d+\.\d+)\.peg\.(\d+)/;

my $pindir = "$pin_base_dir/out.$genome";

my $cache = "$pindir/Cache/${peg}:1";
my $jpeg = "$pindir/Save/GGcache.$peg.jpg";

if (!-f $cache or ! -f $jpeg)
{
    &error("Cached pins not found for $peg)");
}

#
# If we're handling the jpeg, just return it. This is the easy case.
#

if ($want_jpeg)
{
    open(JPEG, "<$jpeg") or &error("Cannot open jpeg file $jpeg");
    my $buf;
    my $size = (stat(JPEG))[7];

    print $cgi->header(-type => 'image/jpeg',
		       -Content_Length => $size);
    while (read(JPEG, $buf, 4096))
    {
	print $buf;
    }
    close(JPEG);
    exit(0);
}

#
# Otherwise, read the HTML and replace any http://hostname/FIG/ links with the
# base url as passed in the fig_base parameter, and the link to GGCache with a link
# to this script.
#

my $fig_base = $cgi->param("fig_base");
my $peg_enc = uri_escape($peg);
my $jpg_url = "http://$ENV{SERVER_NAME}:$ENV{SERVER_PORT}/$ENV{SCRIPT_NAME}?peg=$peg_enc&want_jpeg=1";

open(IN, "<$cache") or &error("Cannot open $cache: $!");

print $cgi->header;

while (<IN>)
{
    s,http://\S+/FIG/,$fig_base/,g;
    s,http://\S+/FIG-Tmp/Save/GGcache.(fig\|\d+\.\d+\.peg\.\d+).jpg,$jpg_url,;
    print;
}
close(IN);

sub error
{
    my($why) = @_;

    print $cgi->header(-type => 'text/plain',
		       -status => "500 $why");
    print "$why\n";
    exit(0);
    
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3