[Bio] / FigKernelPackages / HTML.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/HTML.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : efrank 1.1 package HTML;
2 :    
3 :     use Carp;
4 :     use Data::Dumper;
5 :     use LWP::UserAgent;
6 :     use LWP::Simple;
7 :     use URI::URL;
8 :     use HTTP::Request::Common;
9 :    
10 :     sub show_page {
11 :     my($cgi,$html,$no_home) = @_;
12 :     my $i;
13 :    
14 : olson 1.2 #
15 :     # Find the HTML header
16 :     #
17 :    
18 :     my $html_hdr_file = "./Html/html.hdr";
19 :     if (! -f $html_hdr_file)
20 :     {
21 :     $html_hdr_file = "$FIG_Config::fig/CGI/Html/html.hdr";
22 :     }
23 :    
24 :     my $html_tail_file = "./Html/html.tail";
25 :     if (! -f $html_tail_file)
26 :     {
27 :     $html_tail_file = "$FIG_Config::fig/CGI/Html/html.tail";
28 :     }
29 :    
30 :    
31 : efrank 1.1 print $cgi->header;
32 :     print "<base href=\"" . &FIG::cgi_url . "/\">\n";
33 :     for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<body\>/i); $i++) {}
34 :     if ($i < @$html)
35 :     {
36 : olson 1.2 splice(@$html,$i+1,0,`cat $html_hdr_file`);
37 : efrank 1.1 }
38 :     else
39 :     {
40 :     for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<html\>/i); $i++) {}
41 :     if ($i < @$html)
42 :     {
43 : olson 1.2 splice(@$html,$i+1,0,`cat $html_hdr_file`);
44 : efrank 1.1 }
45 :     else
46 :     {
47 : olson 1.2 splice(@$html,0,0,`cat $html_hdr_file`);
48 : efrank 1.1 }
49 :     }
50 :    
51 : olson 1.2 @tail = `cat $html_tail_file`;
52 : efrank 1.1 if (! $no_home)
53 :     {
54 :     my $user = $cgi->param('user');
55 :     $user = $user ? $user : "";
56 :     my $link = $cgi->url();
57 :     $link =~ s/[a-zA-Z_]+\.cgi$/index.cgi/;
58 :     push(@tail,"<hr><a href=\"$link?user=$user\">FIG search</a>\n");
59 :     }
60 :    
61 :     if (@tail > 0)
62 :     {
63 :     for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/body\>/i); $i++) {}
64 :     if ($i < @$html)
65 :     {
66 :     splice(@$html,$i,0,@tail);
67 :     }
68 :     else
69 :     {
70 :     for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/html\>/i); $i++) {}
71 :     if ($i < @$html)
72 :     {
73 :     splice(@$html,$i,0,@tail);
74 :     }
75 :     else
76 :     {
77 :     push(@$html,@tail);
78 :     }
79 :     }
80 :     }
81 :     print @$html;
82 :     }
83 :    
84 :     sub make_table {
85 :     my($col_hdrs,$tab,$title,$instr) = @_;
86 :     my(@tab);
87 :    
88 :     push(@tab,"<table border><caption><b>$title</b></caption>\n");
89 :     push(@tab,"<tr><th>" . join("</th><th>",@$col_hdrs) . "</th></tr>\n");
90 :     my($i,$nowrap);
91 :    
92 :     for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {}
93 :     $nowrap = ($i == @$instr) ? "" : " nowrap";
94 :    
95 :     foreach $_ (@$tab)
96 :     {
97 :     push(@tab,"<tr><td$nowrap>" . join("</td><td$nowrap>",@$_) . "</td></tr>\n");
98 :     }
99 :     push(@tab,"</table>\n");
100 :     return join("",@tab);
101 :     }
102 :    
103 :     sub ec_link {
104 :     my($role) = @_;
105 :    
106 :     if ($role =~ /(\d+\.\d+\.\d+\.\d+)/)
107 :     {
108 :     return "<a href=\"http://www.genome.ad.jp/dbget-bin/www_bget?ec:$1\">$role</a>";
109 :     }
110 :     else
111 :     {
112 :     return $role;
113 :     }
114 :     }
115 :    
116 :     sub role_link {
117 :     my($cgi,$role) = @_;
118 :    
119 :     my $roleR = ($role =~ /^(\d+\.\d+\.\d+\.\d+)\s+-\s+/) ? $1 : $role;
120 :     my $user = $cgi->param('user');
121 :     if (! $user) { $user = "" }
122 :     my $link = $cgi->url() . "?role=$roleR&user=$user";
123 :     $link =~ s/[a-z]+\.cgi\?/pom.cgi?/;
124 :     return "<a href=$link>$role</a>";
125 :     }
126 :    
127 :     sub fid_link {
128 :     my($cgi,$fid,$local,$just_url) = @_;
129 :     my($n);
130 :    
131 :     if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)
132 :     {
133 :     if ($local)
134 :     {
135 :     if ($1 eq "peg")
136 :     {
137 :     $n = $2;
138 :     }
139 :     else
140 :     {
141 :     $n = "$1.$2";
142 :     }
143 :     }
144 :     else
145 :     {
146 :     $n = $fid;
147 :     }
148 :     if ($1 ne "peg") { return $n }
149 :     my $user = $cgi->param('user');
150 :     if (! $user) { $user = "" }
151 :     my $trans = $cgi->param('translate') ? "&translate=1" : "";
152 :     my $link = $cgi->url() . "?prot=$fid&user=$user$trans";
153 :     $link =~ s/[a-z_A-Z]+\.cgi\?/protein.cgi?/;
154 :     if ($just_url)
155 :     {
156 :     return $link;
157 :     }
158 :     else
159 :     {
160 :     return "<a href=$link>$n</a>";
161 :     }
162 :     }
163 :     return $fid;
164 :     }
165 :    
166 :     sub family_link {
167 :     my($family,$user) = @_;
168 :    
169 :     return $family;
170 :     }
171 :    
172 :     use URI::Escape;
173 :    
174 :     sub get_html {
175 :     my( $url, $type, $kv_pairs) = @_;
176 :     my( $encoded, $ua, $args, @args, $out, @output, $x );
177 :    
178 :     $ua = new LWP::UserAgent;
179 :     $ua->timeout( 900 );
180 :    
181 :     if ($type =~/post/i)
182 :     {
183 :     $args = [];
184 :     foreach $x (@$kv_pairs)
185 :     {
186 :     push(@$args, ( $x->[0], $x->[1]) );
187 :     }
188 :     my $request = POST $url, $args;
189 :     my $response = $ua->request($request);
190 :     $out = $response->content;
191 :     }
192 :     else
193 :     {
194 :     @args = ();
195 :     foreach $x (@$kv_pairs)
196 :     {
197 :     push( @args, "$x->[0]=" . uri_escape($x->[1]) );
198 :     }
199 :    
200 :     if (@args > 0)
201 :     {
202 :     $url .= "?" . join("&",@args);
203 :     }
204 :     $request = new HTTP::Request('GET', $url);
205 :     my $response = $ua->request($request);
206 :    
207 :     if ($response->is_success)
208 :     {
209 :     $out = $response->content;
210 :     }
211 :     else
212 :     {
213 :     $out = "<H1>Error: " . $response->code . "</H1>" . $response->message;
214 :     }
215 :     }
216 :     # set up a document with proper eol characters
217 :     @output = split(/[\012\015]+/,$out);
218 :     foreach $out (@output) { $out .= "\n"; }
219 :    
220 :     # Now splice in a line of the form <base href=URL> to cause all relative links to work
221 :     # properly. Remove the header.
222 :    
223 :     for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}
224 :     if ($i < @output)
225 :     {
226 :    
227 :     splice(@output,0,$i);
228 :     }
229 :    
230 :     for ($i=0; ($i < @output) && ($output[$i] !~ /\<body\>/i); $i++) {}
231 :     if ($i == @output)
232 :     {
233 :     $i = -1;
234 :     }
235 :     splice(@output,$i+1,0,"<base href=\"$url\">\n");
236 :     return @output;
237 :     }
238 :    
239 :     sub trim_output {
240 :     my($out) = @_;
241 :     my $i;
242 :    
243 :     for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}
244 :     splice(@$out,0,$i);
245 :    
246 :     for ($i=0; ($i < @$out) && ($out->[$i] !~ /\<body\>/i); $i++) {}
247 :     if ($i == @$out)
248 :     {
249 :     for ($i=0; ($i < @$out) && ($out->[$i] !~ /\<html\>/i); $i++) {}
250 :     if ($i == @$out)
251 :     {
252 :     $i = -1;
253 :     }
254 :     }
255 :     for ($j=$i+1; ($j < @$out) && ($out->[$j] !~ /^\<hr\>$/); $j++) {}
256 :     if ($j < @$out)
257 :     {
258 :     splice(@$out,$i+1,($j-$i));
259 :     }
260 :    
261 :     for ($i=0; ($i < @$out) && ($out->[$i] !~ /\<\/body\>/i); $i++) {}
262 :     if ($i == @$out)
263 :     {
264 :     for ($i=0; ($i < @$out) && ($out->[$i] !~ /\<\/html\>/i); $i++) {}
265 :     }
266 :    
267 :     for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}
268 :     if ($j > 0)
269 :     {
270 : olson 1.2 my @tmp = `cat $html_tail_file`;
271 : efrank 1.1 my $n = @tmp;
272 :     splice(@$out,$j-$n,$n+1);
273 :     }
274 :     }
275 :    
276 :     sub set_prot_links {
277 :     my($cgi,$x) = @_;
278 :     my($before,$match,$after);
279 :    
280 :     if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/)
281 :     {
282 :     $before = $1;
283 :     $match = $2;
284 :     $after = $3;
285 :     return &set_prot_links($cgi,$before) . &HTML::fid_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";
286 :     }
287 :     elsif ($x =~ /^(.*)(gi\|\d+)(.*)$/)
288 :     {
289 :     $before = $1;
290 :     $match = $2;
291 :     $after = $3;
292 :     return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";
293 :     }
294 :     elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)$/)
295 :     {
296 :     $before = $1;
297 :     $match = $2;
298 :     $after = $3;
299 :     return &set_prot_links($cgi,$before) . &HTML::sp_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";
300 :     }
301 :     elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)$/)
302 :     {
303 :     $before = $1;
304 :     $match = $2;
305 :     $after = $3;
306 :     return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";
307 :     }
308 :     return $x;
309 :     }
310 :    
311 :     sub gi_link {
312 :     my($cgi,$gi) = @_;
313 :    
314 :     if ($gi =~ /^gi\|(\d+)$/)
315 :     {
316 :     return "<a href=http://www.ncbi.nlm.nih.gov:80/entrez/query.fcgi?cmd=Retrieve&db=Protein&list_uids=$1&dopt=GenPept>$gi</a>";
317 :     }
318 :     return $gi;
319 :     }
320 :    
321 :     sub sp_link {
322 :     my($cgi,$sp) = @_;
323 :    
324 :     if ($sp =~ /^sp\|(\S+)$/)
325 :     {
326 :     return "<a href=http://us.expasy.org/cgi-bin/get-sprot-entry?$1>$sp</a>";
327 :     }
328 :     return $sp;
329 :     }
330 :    
331 :     sub pir_link {
332 :     my($cgi,$pir) = @_;
333 :    
334 :     if ($pir =~ /^pirnr\|(NF\d+)$/)
335 :     {
336 :     return "<a href=http://pir.georgetown.edu/cgi-bin/nfEntry.pl?id=$1>$pir</a>";
337 :     }
338 :     return $pir;
339 :     }
340 :    
341 :    
342 :     1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3