[Bio] / FigWebServices / get_dlits.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/get_dlits.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :     #
3 : golsen 1.7 # Copyright (c) 2003-2008 University of Chicago and Fellowship
4 : overbeek 1.1 # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 :    
20 :     use FIG;
21 :     my $fig = new FIG;
22 :    
23 :     use HTML;
24 :     use strict;
25 :    
26 :     use CGI;
27 :     my $cgi = new CGI;
28 :    
29 :    
30 :     if (0)
31 :     {
32 :     my $VAR1;
33 :     eval(join("",`cat /tmp/get_dlit_parms`));
34 :     $cgi = $VAR1;
35 :     # print STDERR &Dumper($cgi);
36 :     }
37 :    
38 :     if (0)
39 :     {
40 :     print $cgi->header;
41 :     my @params = $cgi->param;
42 :     print "<pre>\n";
43 :     foreach $_ (@params)
44 :     {
45 : golsen 1.7 print "$_\t:",join(",",$cgi->param($_)),":\n";
46 : overbeek 1.1 }
47 :    
48 :     if (0)
49 :     {
50 : golsen 1.7 if (open(TMP,">/tmp/get_dlit_parms"))
51 :     {
52 :     print TMP &Dumper($cgi);
53 :     close(TMP);
54 :     }
55 : overbeek 1.1 }
56 :     exit;
57 :     }
58 :     my($genome);
59 :    
60 :     my $html = [];
61 :     unshift @$html, "<TITLE>Get Dlits</TITLE>\n";
62 :    
63 : golsen 1.7 my $user = $cgi->param('user'); # Current user
64 :     my $curator = $cgi->param('curator') || ''; # Filter roles by subsystem curator
65 :     my $genomeD = $cgi->param('genomeD'); # Find lit by genome
66 :     my $role = $cgi->param('role'); # Find lit by role
67 :     my $show_just = $cgi->param('show_just'); # Filter lit by status
68 : overbeek 1.1 $show_just = ($show_just eq "all") ? '' : $show_just;
69 :    
70 : golsen 1.7 # Requested actions:
71 :    
72 :     my ( $submit1, $submit2, $submit3, $submit4, $submit5 );
73 :     if ( $cgi->param( 'Process Changes' ) ) { $submit5 = 1 }
74 :     if ( $cgi->param( 'Change subsystem curator' ) ) {}
75 :     elsif ( $cgi->param( 'Show Genomes' ) ) { $submit1 = 1 }
76 :     elsif ( $cgi->param( 'Show Roles' ) ) { $submit2 = 1 }
77 :     elsif ( $cgi->param( 'Show Genome' ) ) { $submit3 = 1 }
78 :     elsif ( $cgi->param( 'Show Role' ) ) { $submit4 = 1 }
79 :    
80 :     my $done = 0;
81 :    
82 : overbeek 1.1 my $rdbH = $fig->db_handle;
83 :    
84 : golsen 1.7 if (! -d "$FIG_Config::data/Dlits")
85 : overbeek 1.1 {
86 : golsen 1.7 push( @$html, $cgi->h1("dlit data are not installed") );
87 :     $done = 1;
88 : overbeek 1.1 }
89 : golsen 1.7 elsif ( ! $user )
90 : overbeek 1.1 {
91 : golsen 1.7 push( @$html, $cgi->h2('To curate literature, please provide a user name') );
92 :     push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'),
93 :     'Username: ',
94 :     $cgi->textfield( -name=>"user", -size => 20 ),
95 :     $cgi->br,
96 :     $cgi->submit( 'Set user' ),
97 :     $cgi->end_form
98 :     );
99 :     $done = 1;
100 : overbeek 1.1 }
101 : golsen 1.7
102 :     # Process a page of curated literature ----------------------------------------
103 :    
104 :     if ( $submit5 && ! $done )
105 :     {
106 :     &process_changes( $fig, $cgi, $html );
107 :     my $prev_req = $cgi->param( 'prev_req' );
108 :     $submit3 = 1 if $prev_req eq 'Show Genome';
109 :     $submit4 = 1 if $prev_req eq 'Show Role';
110 : overbeek 1.1 }
111 : golsen 1.7
112 :     # If there is a problem, skip the rest of the action tests --------------------
113 :     # This is organized this way so that a useful page can be
114 :     # provided after processing a curated page.
115 :    
116 :     if ( $done ) { }
117 :    
118 :     # Literature selected by role -------------------------------------------------
119 :    
120 :     elsif ( $submit4 && $role )
121 : overbeek 1.1 {
122 : golsen 1.7 my $roleQ = quotemeta $role;
123 :     my $where = $show_just ? " AND (dlits.status = '$show_just')" : '';
124 :     my $tuples = $rdbH->SQL( "SELECT DISTINCT dlits.status,dlits.md5_hash,dlits.pubmed
125 :     FROM hash_role,dlits,pubmed_titles
126 :     WHERE hash_role.role = '$roleQ' AND hash_role.md5_hash = dlits.md5_hash $where"
127 :     );
128 : overbeek 1.1 my @to_display = ();
129 :     foreach my $x (@$tuples)
130 :     {
131 : golsen 1.7 my($status,$hash,$pubmed) = @$x;
132 :     my @pegs = $fig->pegs_with_md5($hash);
133 :     if (@pegs > 0)
134 :     {
135 :     push(@to_display,[$status,$pegs[0],$pubmed]);
136 :     }
137 : overbeek 1.1 }
138 : golsen 1.7 &display_set($fig,$cgi,$html,\@to_display,"Genes for Role: $role",'Show Role');
139 :     }
140 :    
141 :     # Show the role list ----------------------------------------------------------
142 :    
143 :     elsif ( $submit2 || $submit4 )
144 :     {
145 :     # Did user request role literature, and not select a role?
146 :     push @$html, $cgi->h3( '<FONT Color=red>Please select a role.</FONT>' ) if $submit4;
147 :    
148 :     my $where1 = $show_just ? " AND (dlits.status = '$show_just')" : "";
149 :     my $where2 = $curator ? " AND (curr_role.curator = '$curator' AND curr_role.role = hash_role.role)" : "";
150 :    
151 :     my @roles = sort { lc $a cmp lc $b } # Make sort case insensitive
152 :     map { $_->[0] }
153 :     @{ $rdbH->SQL( "SELECT DISTINCT hash_role.role
154 :     FROM hash_role,dlits,curr_role
155 :     WHERE hash_role.md5_hash = dlits.md5_hash $where1 $where2"
156 :     ) };
157 :     push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'),
158 :     $cgi->hidden(-name => 'user', -value => $user),
159 :     $cgi->hidden(-name => 'curator', -value => $curator)
160 :     );
161 :    
162 :     my $whom = $curator ? "'$curator'" : "any one";
163 :     my $status = $show_just ? " with literature of status code '$show_just':" : ":";
164 :     push( @$html, $cgi->h3( "Subsystem roles curated by $whom" . $status ) );
165 :    
166 :     push( @$html, $cgi->scrolling_list( -name => 'role',
167 :     -values => [@roles],
168 :     -size => 30
169 :     ),
170 :     $cgi->br, &show_just_selector( $cgi ),
171 :     $cgi->br, $cgi->submit( 'Show Role' ),
172 :     $cgi->br, $cgi->submit( 'Show Genomes' ),
173 :     $cgi->br, $cgi->submit( 'Change subsystem curator' ), " currently '$curator'.",
174 :     $cgi->end_form
175 :     );
176 : overbeek 1.1 }
177 : golsen 1.7
178 :     # Literature selected by genome -----------------------------------------------
179 :    
180 :     elsif ( $submit3 && $genomeD && ( $genomeD =~ /\((\d+\.\d+)\)$/ ) )
181 : overbeek 1.1 {
182 : golsen 1.7 my $genome = $1;
183 :     my $where = $show_just ? " AND (dlits.status = '$show_just')" : '';
184 :     my $tuples = $rdbH->SQL( "SELECT DISTINCT dlits.status,dlits.md5_hash,dlits.pubmed
185 :     FROM genome_hash,dlits
186 :     WHERE genome_hash.genome = '$genome' AND genome_hash.md5_hash = dlits.md5_hash $where"
187 :     );
188 : overbeek 1.1 my @to_display = ();
189 : golsen 1.7 foreach my $x ( @$tuples )
190 : overbeek 1.1 {
191 : golsen 1.7 my ( $status, $hash, $pubmed ) = @$x;
192 :     foreach my $peg ( $fig->pegs_with_md5($hash) )
193 :     {
194 :     if ( &FIG::genome_of($peg) eq $genome )
195 :     {
196 :     push(@to_display,[ $status, $peg, $pubmed ]);
197 :     }
198 :     }
199 : overbeek 1.1 }
200 : golsen 1.7 &display_set( $fig, $cgi, $html, \@to_display, "Genes for $genomeD", 'Show Genome' );
201 :     }
202 :    
203 :     # Show genome list ------------------------------------------------------------
204 :    
205 :     elsif ( $submit1 || $submit3 )
206 :     {
207 :     # Did user request genome literature, and not select a genome?
208 :     push @$html, $cgi->h3( '<FONT Color=red>Please select a genome.</FONT>' ) if $submit3;
209 :    
210 :     my $where = $show_just ? " AND (dlits.status = '$show_just')" : "";
211 :    
212 :     my $genomes = $rdbH->SQL( "SELECT DISTINCT genome_hash.genome
213 :     FROM genome_hash,dlits
214 :     WHERE genome_hash.md5_hash = dlits.md5_hash $where"
215 :     );
216 :     my @genomes = sort { lc $a cmp lc $b } # Make sort case insensitive
217 :     map { &compute_genome_label( $fig, $_->[0] ) }
218 :     @$genomes;
219 :    
220 :     push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'),
221 :     $cgi->hidden(-name => 'user', -value => $user),
222 :     $cgi->hidden(-name => 'curator', -value => $curator),
223 :     $cgi->scrolling_list( -name => 'genomeD',
224 :     -values => [@genomes],
225 :     -size => 30
226 :     ),
227 :     $cgi->br, &show_just_selector( $cgi ),
228 :     $cgi->br, $cgi->submit( 'Show Genome' ),
229 :     $cgi->br, $cgi->submit( 'Show Roles' ),
230 :     $cgi->br, $cgi->submit( 'Change subsystem curator' ), " currently '$curator'.",
231 :     $cgi->end_form
232 :     );
233 : overbeek 1.1 }
234 : golsen 1.7
235 :     # Default = display subsystem curators ----------------------------------------
236 :    
237 : overbeek 1.1 else
238 :     {
239 : golsen 1.7 my @cur = map { $_->[0] }
240 :     sort { $a->[1] cmp $b->[1] || length $a->[0] <=> length $b->[0] }
241 :     map { my $cur = $_->[0];
242 :     my $nam = lc $cur;
243 :     $nam =~ s/^master[:_]?//;
244 :     [ $cur, $nam ]
245 :     }
246 :     @{ $rdbH->SQL( "SELECT DISTINCT curator FROM dlits" ) };
247 :     my $curN = @cur;
248 :    
249 :     push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'),
250 :     $cgi->hidden(-name => 'user', -value=>$user),
251 :     $cgi->scrolling_list( -name => 'curator',
252 :     -values => [ @cur ],
253 :     -size => $curN
254 :     ),
255 :     $cgi->br,
256 :     &show_just_selector( $cgi ),
257 :     $cgi->submit( 'Show Roles' ),
258 :     $cgi->br,
259 :     $cgi->submit( 'Show Genomes' ),
260 :     $cgi->end_form
261 :     );
262 :     }
263 :     &HTML::show_page($cgi,$html);
264 :     exit;
265 : overbeek 1.1
266 :    
267 : golsen 1.7 sub show_just_selector
268 :     {
269 :     my ( $cgi, $html ) = @_;
270 :     my $default = $cgi->param( 'show_just' );
271 :     $default =~ /^[ A-Z]$/ or $default = 'all';
272 :     return 'Show literature links with all status codes, or pick a specific one: '
273 :     . $cgi->scrolling_list( -name => 'show_just',
274 :     -values => ['all',' ','D','R','N','G'],
275 :     -default => $default,
276 :     -override => 1,
277 :     -size => 1
278 :     )
279 :     . $cgi->br;
280 : overbeek 1.1 }
281 :    
282 :    
283 :     sub compute_genome_label
284 :     {
285 :     my($fig, $org) = @_;
286 :    
287 :     my $gs = $fig->genus_species($org);
288 :     return "$gs ($org)";
289 :     }
290 :    
291 : golsen 1.7
292 : overbeek 1.1 sub title_of {
293 :     my($fig,$pubmed) = @_;
294 :    
295 :     my $rdbH = $fig->db_handle;
296 : golsen 1.7 my $retval = $rdbH->SQL( "SELECT title
297 :     FROM pubmed_titles
298 :     WHERE (pubmed = $pubmed)"
299 :     );
300 :     return ( @$retval > 0 ) ? $retval->[0]->[0] : "";
301 :     }
302 :    
303 :    
304 :     sub pubmed_link
305 :     {
306 :     return "<a target=_blank href=http://www.ncbi.nlm.nih.gov/sites/entrez?db=pubmed&cmd=search&term=$_[0]>$_[0]</a>";
307 : overbeek 1.1 }
308 : golsen 1.7
309 : overbeek 1.1
310 :     sub display_set {
311 : golsen 1.7 my( $fig, $cgi, $html, $to_display, $tab_title, $submit ) = @_;
312 : overbeek 1.1
313 : golsen 1.7 my %status_code = ( 'D' => 1, ' ' => 2, 'N' => 3, 'R' => 4, 'G' => 5 );
314 : overbeek 1.1
315 : golsen 1.7 # @$to_distplay items are [ $status, $peg, $pubmed ]
316 : overbeek 1.1
317 : golsen 1.7 foreach $_ ( @$to_display ) { $_->[0] =~ s/^\s*$/ /; } # fix empty status strings
318 :     my @tuples = sort { ( $status_code{$a->[0]} <=> $status_code{$b->[0]} )
319 :     or &FIG::by_fig_id( $a->[1], $b->[1] )
320 :     or ( $a->[2] <=> $b->[2] )
321 :     }
322 :     @$to_display;
323 : overbeek 1.1 my $total_tuples = @tuples;
324 :    
325 : golsen 1.7 my $from; # Offset to first item displayed
326 :     my $lines_left = 100; # Really the lines per page
327 :    
328 :     if ( $cgi->param( 'Go to item numbers' ) )
329 :     {
330 :     $from = $cgi->param( 'offset_select' );
331 :     }
332 :     else
333 :     {
334 :     $from = $cgi->param( 'from_line' ) || 0;
335 :     $from -= $lines_left if $cgi->param( 'Previous page' );
336 :     $from += $lines_left if $cgi->param( 'Next page' );
337 :     }
338 :    
339 :     # Cut down the array to that to be displayed
340 :    
341 :     if ( $total_tuples > 0 )
342 :     {
343 :     if ( $from < 0 ) { $from = 0 }
344 :     if ( $from > $total_tuples )
345 :     {
346 :     $from = $lines_left * int( ( $total_tuples - 1 ) / $lines_left );
347 :     }
348 :     splice( @tuples, 0, $from );
349 :     splice( @tuples, $lines_left );
350 :     }
351 : overbeek 1.1 else
352 :     {
353 : golsen 1.7 undef $from;
354 : overbeek 1.1 }
355 :    
356 : golsen 1.7 # Add status code key at top of page
357 :    
358 :     &desc( $html );
359 :    
360 :     # Build the html form
361 :    
362 :     push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post') );
363 :    
364 :     # Current user
365 :     my $user = $cgi->param('user');
366 :     push( @$html, $cgi->hidden( -name => 'user', -value => $user, -override => 1 ) );
367 :    
368 :     # Filter roles by subsystem curator
369 :     my $curator = $cgi->param('curator') || '';
370 :     push( @$html, $cgi->hidden( -name => 'curator', -value => $curator, -override => 1 ) ) if $curator;
371 :    
372 :     # Find lit by genome
373 :     my $genomeD = $cgi->param('genomeD');
374 :     push( @$html, $cgi->hidden( -name => 'genomeD', -value => $genomeD, -override => 1 ) ) if $genomeD;
375 :    
376 :     # Find lit by role
377 :     my $role = $cgi->param('role');
378 :     push( @$html, $cgi->hidden( -name => 'role', -value => $role, -override => 1 ) ) if $role;
379 :    
380 :     # Requested action
381 :     push( @$html, $cgi->hidden( -name => 'prev_req', -value => $submit, -override => 1 ) ) if $submit;
382 :    
383 :     # Used to inherit action
384 :     push( @$html, $cgi->hidden( -name => $submit, -value => 1, -override => 1 ) ) if $submit;
385 :    
386 :     push( @$html, $cgi->br );
387 :    
388 :     # Build the status selection table
389 :    
390 :     my $col_hdrs = [' ','G','N','R','D','PEG','Function','Genus/Species','PubMed','Title'];
391 :     my $tab = [];
392 : overbeek 1.1 my $i;
393 :     for ($i=0; ($i < @tuples); $i++)
394 :     {
395 : golsen 1.7 my $tuple = $tuples[$i];
396 :     my( $status, $peg, $pubmed ) = @$tuple;
397 :     next if (! $fig->is_real_feature($peg));
398 :     my $gs = $fig->genus_species( &FIG::genome_of( $peg ) );
399 :     $gs =~ s/^(\S+\s+\S+).*$/$1/;
400 :     my $title = &title_of( $fig, $pubmed );
401 :     my $func = $fig->function_of($peg);
402 :     my @codes = $cgi->radio_group( -name => "tuple:$peg:$pubmed:$status",
403 :     -values => [' ','G','N','R','D'],
404 :     -default => "$status",
405 :     -nolabels => 1
406 :     );
407 :    
408 :     if (($i % 15) == 14) { push(@$tab,$col_hdrs) }
409 :     push( @$tab, [ @codes, &HTML::fid_link($cgi,$peg), $func, $gs, pubmed_link($pubmed), $title ] );
410 :     }
411 :    
412 :     push( @$html,&HTML::make_table( $col_hdrs, $tab, $tab_title ) );
413 :    
414 :     push( @$html, $cgi->br, &show_just_selector( $cgi ) );
415 :    
416 :     # Navigation controls through long lists
417 :    
418 :     if ( defined( $from ) && ( $total_tuples > $lines_left ) )
419 :     {
420 :     my $i1 = $from + 1;
421 :     my $i2 = $from + $lines_left;
422 :     $i2 = $total_tuples if $i2 > $total_tuples;
423 :     push( @$html, $cgi->hidden( -name => 'from_line', -value => $from, -override => 1 ) );
424 :     push( @$html, $cgi->br, "Currently displaying items $i1 - $i2 of $total_tuples.", $cgi->br );
425 :     push( @$html, $cgi->submit( 'Previous page' ) ) if $from > 0;
426 :     push( @$html, $cgi->submit( 'Next page' ) ) if $i2 < $total_tuples;
427 :    
428 :     my @offsets;
429 :     my %labels;
430 :     for ( my $i = 0; $i < $total_tuples; $i += $lines_left )
431 :     {
432 :     push @offsets, $i;
433 :     my $imax = $i + $lines_left;
434 :     $imax = $total_tuples if $imax > $total_tuples;
435 :     $labels{ $i } = ( $i+1 ) . " - $imax";
436 :     }
437 :     push( @$html, $cgi->submit( 'Go to item numbers' ),
438 :     $cgi->scrolling_list( -name => 'offset_select',
439 :     -values => \@offsets,
440 :     -labels => \%labels,
441 :     -default => $from,
442 :     -size => 1,
443 :     -override => 1
444 :     ),
445 :     $cgi->br );
446 : overbeek 1.1 }
447 : golsen 1.7
448 :     # Some action buttons:
449 :    
450 :     push( @$html, $cgi->br, $cgi->submit( 'Process Changes' ), "entered on this page." );
451 :    
452 :     push( @$html, $cgi->br, $cgi->submit( 'Show Genomes' ), "discarding any changes made on this page." );
453 :    
454 :     if ( $curator )
455 :     {
456 :     push( @$html, $cgi->br, $cgi->submit( 'Show Roles' ),
457 :     "for subsystem curator '$curator', discarding any changes made on this page." );
458 :     }
459 :    
460 :     push( @$html, $cgi->br, $cgi->submit( 'Change subsystem curator' ), " currently '$curator', discarding any changes made on this page." );
461 :    
462 :     push( @$html, $cgi->end_form );
463 : overbeek 1.1 }
464 :    
465 : golsen 1.7
466 : overbeek 1.4 sub desc {
467 : golsen 1.7 my( $html ) = @_;
468 : overbeek 1.4
469 : golsen 1.7 my $col_hdrs = [ "Code", "Meaning" ];
470 :     my $tab = [ [ [" ","TD Align=center"], "No one has curated this link yet" ],
471 :     [ ["G","TD Align=center"], "Genome paper - marks all uncurated protein links of this paper to 'G' (implicitly irrelevant)" ],
472 :     [ ["N","TD Align=center"], "Not relevant to this protein" ],
473 :     [ ["R","TD Align=center"], "Relevant, but not strong enough to determine function" ],
474 :     [ ["D","TD Align=center"], "Direct reference that can be used to support function assertion" ]
475 :     ];
476 :     push( @$html, &HTML::make_table( $col_hdrs, $tab, "Code Meanings" ), "<hr>" );
477 : overbeek 1.4 }
478 :    
479 : golsen 1.7
480 : overbeek 1.1 sub process_changes {
481 : golsen 1.7 my( $fig, $cgi, $html ) = @_;
482 :     my $user = $cgi->param('user');
483 : overbeek 1.1
484 :     my @tuples = grep { $_->[2] ne $_->[3] }
485 :     map { ($_ =~ /^tuple:(fig\|\d+\.\d+\.peg\.\d+)\s*:\s*(\d+)\s*:([ RDGN])/) ? [$1,$2,$3,$cgi->param($_)] : () }
486 :     $cgi->param();
487 : golsen 1.7 my $n_change = 0;
488 :     foreach my $tuple ( @tuples )
489 : overbeek 1.1 {
490 : golsen 1.7 my( $peg, $pubmed, $from, $to ) = @$tuple;
491 :     $fig->add_dlit( -status => $to,
492 :     -peg => $peg,
493 :     -pubmed => $pubmed,
494 :     -curator => $user,
495 :     -override => 1
496 :     );
497 :     $n_change++;
498 : overbeek 1.1 }
499 : golsen 1.7
500 :     push( @$html, $cgi->h2( "<FONT Color=green>Made $n_change requested changes.</FONT>" ) );
501 : overbeek 1.1 }
502 :    
503 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3