package HTML; use Carp; use Data::Dumper; use LWP::UserAgent; use LWP::Simple; use URI::URL; use HTTP::Request::Common; sub show_page { my($cgi,$html,$no_home) = @_; my $i; # # Find the HTML header # my $html_hdr_file = "./Html/html.hdr"; if (! -f $html_hdr_file) { $html_hdr_file = "$FIG_Config::fig/CGI/Html/html.hdr"; } my $html_tail_file = "./Html/html.tail"; if (! -f $html_tail_file) { $html_tail_file = "$FIG_Config::fig/CGI/Html/html.tail"; } print $cgi->header; print "\n"; for ($i=0; ($i < @$html) && ($html->[$i] !~ /\/i); $i++) {} if ($i < @$html) { splice(@$html,$i+1,0,`cat $html_hdr_file`); } else { for ($i=0; ($i < @$html) && ($html->[$i] !~ /\/i); $i++) {} if ($i < @$html) { splice(@$html,$i+1,0,`cat $html_hdr_file`); } else { splice(@$html,0,0,`cat $html_hdr_file`); } } @tail = `cat $html_tail_file`; if (! $no_home) { my $user = $cgi->param('user'); $user = $user ? $user : ""; my $link = $cgi->url(); $link =~ s/[a-zA-Z_]+\.cgi$/index.cgi/; push(@tail,"
FIG search\n"); } if (@tail > 0) { for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/body\>/i); $i++) {} if ($i < @$html) { splice(@$html,$i,0,@tail); } else { for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/html\>/i); $i++) {} if ($i < @$html) { splice(@$html,$i,0,@tail); } else { push(@$html,@tail); } } } print @$html; } sub make_table { my($col_hdrs,$tab,$title,$instr) = @_; my(@tab); push(@tab,"\n"); push(@tab,"\n"); my($i,$nowrap); for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {} $nowrap = ($i == @$instr) ? "" : " nowrap"; my $row; foreach $row (@$tab) { push(@tab,"" . join("",map { &expand($_) } @$row) . "\n"); } push(@tab,"
$title
" . join("",@$col_hdrs) . "
\n"); return join("",@tab); } sub expand { my($x) = @_; if ($x =~ /^\@([^:]+)\:([^:]+)\:(.*)$/) { return "$3"; } else { return "$x"; } } sub ec_link { my($role) = @_; if ($role =~ /(\d+\.\d+\.\d+\.\d+)/) { return "$role"; } else { return $role; } } sub role_link { my($cgi,$role) = @_; my $roleR = ($role =~ /^(\d+\.\d+\.\d+\.\d+)\s+-\s+/) ? $1 : $role; my $user = $cgi->param('user'); if (! $user) { $user = "" } my $link = $cgi->url() . "?role=$roleR&user=$user"; $link =~ s/[a-z]+\.cgi\?/pom.cgi?/; return "$role"; } sub fid_link { my($cgi,$fid,$local,$just_url) = @_; my($n); if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/) { if ($local) { if ($1 eq "peg") { $n = $2; } else { $n = "$1.$2"; } } else { $n = $fid; } if ($1 ne "peg") { return $n } my $user = $cgi->param('user'); if (! $user) { $user = "" } my $trans = $cgi->param('translate') ? "&translate=1" : ""; my $link = $cgi->url() . "?prot=$fid&user=$user$trans"; $link =~ s/[a-z_A-Z]+\.cgi\?/protein.cgi?/; if ($just_url) { return $link; } else { return "$n"; } } return $fid; } sub family_link { my($family,$user) = @_; return $family; } use URI::Escape; sub get_html { my( $url, $type, $kv_pairs) = @_; my( $encoded, $ua, $args, @args, $out, @output, $x ); $ua = new LWP::UserAgent; $ua->timeout( 900 ); if ($type =~/post/i) { $args = []; foreach $x (@$kv_pairs) { push(@$args, ( $x->[0], $x->[1]) ); } my $request = POST $url, $args; my $response = $ua->request($request); $out = $response->content; } else { @args = (); foreach $x (@$kv_pairs) { push( @args, "$x->[0]=" . uri_escape($x->[1]) ); } if (@args > 0) { $url .= "?" . join("&",@args); } $request = new HTTP::Request('GET', $url); my $response = $ua->request($request); if ($response->is_success) { $out = $response->content; } else { $out = "

Error: " . $response->code . "

" . $response->message; } } # set up a document with proper eol characters @output = split(/[\012\015]+/,$out); foreach $out (@output) { $out .= "\n"; } # Now splice in a line of the form to cause all relative links to work # properly. Remove the header. for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\/i); $i++) {} if ($i == @output) { $i = -1; } splice(@output,$i+1,0,"\n"); return @output; } sub trim_output { my($out) = @_; my $i; for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\[$i] !~ /\/i); $i++) {} if ($i == @$out) { for ($i=0; ($i < @$out) && ($out->[$i] !~ /\/i); $i++) {} if ($i == @$out) { $i = -1; } } for ($j=$i+1; ($j < @$out) && ($out->[$j] !~ /^\$/); $j++) {} if ($j < @$out) { splice(@$out,$i+1,($j-$i)); } for ($i=0; ($i < @$out) && ($out->[$i] !~ /\<\/body\>/i); $i++) {} if ($i == @$out) { for ($i=0; ($i < @$out) && ($out->[$i] !~ /\<\/html\>/i); $i++) {} } for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {} if ($j > 0) { my @tmp = `cat $html_tail_file`; my $n = @tmp; splice(@$out,$j-$n,$n+1); } } sub set_prot_links { my($cgi,$x) = @_; my($before,$match,$after); if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/) { $before = $1; $match = $2; $after = $3; return &set_prot_links($cgi,$before) . &HTML::fid_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n"; } elsif ($x =~ /^(.*)(gi\|\d+)(.*)$/) { $before = $1; $match = $2; $after = $3; return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n"; } elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)$/) { $before = $1; $match = $2; $after = $3; return &set_prot_links($cgi,$before) . &HTML::sp_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n"; } elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)$/) { $before = $1; $match = $2; $after = $3; return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n"; } return $x; } sub gi_link { my($cgi,$gi) = @_; if ($gi =~ /^gi\|(\d+)$/) { return "$gi"; } return $gi; } sub sp_link { my($cgi,$sp) = @_; if ($sp =~ /^sp\|(\S+)$/) { return "$sp"; } return $sp; } sub pir_link { my($cgi,$pir) = @_; if ($pir =~ /^pirnr\|(NF\d+)$/) { return "$pir"; } return $pir; } 1