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

Annotation of /FigKernelPackages/HTML.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3