Parent Directory
|
Revision Log
Revision 1.13 - (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 : | golsen | 1.8 | # |
20 : | # DBMS tables used: | ||
21 : | # | ||
22 : | golsen | 1.11 | # dlits |
23 : | golsen | 1.8 | # flds => "status char(1), md5_hash varchar(32), pubmed varchar(16), curator varchar(30), go_code varchar(15)" |
24 : | # | ||
25 : | # titles | ||
26 : | # flds => "pubmed varchar(16), title varchar(1000)" | ||
27 : | # | ||
28 : | # hash_role | ||
29 : | # flds => "md5_hash char(32), role varchar(1000)" | ||
30 : | # | ||
31 : | # curr_role | ||
32 : | # flds => "curator varchar(30), role varchar(1000)" | ||
33 : | # | ||
34 : | # genome_hash | ||
35 : | # flds => "genome varchar(32), md5_hash char(32)" | ||
36 : | # | ||
37 : | overbeek | 1.1 | |
38 : | use FIG; | ||
39 : | my $fig = new FIG; | ||
40 : | |||
41 : | use HTML; | ||
42 : | use strict; | ||
43 : | |||
44 : | use CGI; | ||
45 : | my $cgi = new CGI; | ||
46 : | |||
47 : | golsen | 1.11 | use Data::Dumper; |
48 : | overbeek | 1.1 | |
49 : | if (0) | ||
50 : | { | ||
51 : | my $VAR1; | ||
52 : | eval(join("",`cat /tmp/get_dlit_parms`)); | ||
53 : | $cgi = $VAR1; | ||
54 : | # print STDERR &Dumper($cgi); | ||
55 : | } | ||
56 : | |||
57 : | if (0) | ||
58 : | { | ||
59 : | print $cgi->header; | ||
60 : | my @params = $cgi->param; | ||
61 : | print "<pre>\n"; | ||
62 : | foreach $_ (@params) | ||
63 : | { | ||
64 : | golsen | 1.7 | print "$_\t:",join(",",$cgi->param($_)),":\n"; |
65 : | overbeek | 1.1 | } |
66 : | |||
67 : | if (0) | ||
68 : | { | ||
69 : | golsen | 1.7 | if (open(TMP,">/tmp/get_dlit_parms")) |
70 : | { | ||
71 : | print TMP &Dumper($cgi); | ||
72 : | close(TMP); | ||
73 : | } | ||
74 : | overbeek | 1.1 | } |
75 : | exit; | ||
76 : | } | ||
77 : | my($genome); | ||
78 : | |||
79 : | my $html = []; | ||
80 : | golsen | 1.11 | push @$html, "<TITLE>Get Dlits</TITLE>\n"; |
81 : | overbeek | 1.1 | |
82 : | golsen | 1.7 | my $user = $cgi->param('user'); # Current user |
83 : | my $curator = $cgi->param('curator') || ''; # Filter roles by subsystem curator | ||
84 : | my $genomeD = $cgi->param('genomeD'); # Find lit by genome | ||
85 : | golsen | 1.8 | my $ref_id = $cgi->param('ref_id'); # Show data by reference |
86 : | golsen | 1.7 | my $role = $cgi->param('role'); # Find lit by role |
87 : | my $show_just = $cgi->param('show_just'); # Filter lit by status | ||
88 : | overbeek | 1.1 | $show_just = ($show_just eq "all") ? '' : $show_just; |
89 : | |||
90 : | golsen | 1.7 | # Requested actions: |
91 : | |||
92 : | my ( $submit1, $submit2, $submit3, $submit4, $submit5 ); | ||
93 : | if ( $cgi->param( 'Process Changes' ) ) { $submit5 = 1 } | ||
94 : | golsen | 1.8 | if ( $ref_id ) {} |
95 : | elsif ( $cgi->param( 'Change subsystem curator' ) ) {} | ||
96 : | golsen | 1.7 | elsif ( $cgi->param( 'Show Genomes' ) ) { $submit1 = 1 } |
97 : | elsif ( $cgi->param( 'Show Roles' ) ) { $submit2 = 1 } | ||
98 : | elsif ( $cgi->param( 'Show Genome' ) ) { $submit3 = 1 } | ||
99 : | elsif ( $cgi->param( 'Show Role' ) ) { $submit4 = 1 } | ||
100 : | |||
101 : | my $done = 0; | ||
102 : | |||
103 : | overbeek | 1.1 | my $rdbH = $fig->db_handle; |
104 : | |||
105 : | golsen | 1.7 | if (! -d "$FIG_Config::data/Dlits") |
106 : | overbeek | 1.1 | { |
107 : | golsen | 1.7 | push( @$html, $cgi->h1("dlit data are not installed") ); |
108 : | $done = 1; | ||
109 : | overbeek | 1.1 | } |
110 : | golsen | 1.7 | elsif ( ! $user ) |
111 : | overbeek | 1.1 | { |
112 : | golsen | 1.7 | push( @$html, $cgi->h2('To curate literature, please provide a user name') ); |
113 : | push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'), | ||
114 : | 'Username: ', | ||
115 : | $cgi->textfield( -name=>"user", -size => 20 ), | ||
116 : | $cgi->br, | ||
117 : | $cgi->submit( 'Set user' ), | ||
118 : | $cgi->end_form | ||
119 : | ); | ||
120 : | $done = 1; | ||
121 : | overbeek | 1.1 | } |
122 : | golsen | 1.7 | |
123 : | golsen | 1.11 | |
124 : | # This is a one-time special case to add an index to the dlits table | ||
125 : | |||
126 : | |||
127 : | golsen | 1.7 | # Process a page of curated literature ---------------------------------------- |
128 : | |||
129 : | if ( $submit5 && ! $done ) | ||
130 : | { | ||
131 : | &process_changes( $fig, $cgi, $html ); | ||
132 : | my $prev_req = $cgi->param( 'prev_req' ); | ||
133 : | $submit3 = 1 if $prev_req eq 'Show Genome'; | ||
134 : | $submit4 = 1 if $prev_req eq 'Show Role'; | ||
135 : | overbeek | 1.1 | } |
136 : | golsen | 1.7 | |
137 : | # If there is a problem, skip the rest of the action tests -------------------- | ||
138 : | # This is organized this way so that a useful page can be | ||
139 : | # provided after processing a curated page. | ||
140 : | |||
141 : | if ( $done ) { } | ||
142 : | |||
143 : | golsen | 1.8 | # All sequences in a reference ------------------------------------------------ |
144 : | |||
145 : | elsif ( $ref_id ) | ||
146 : | { | ||
147 : | my $and_status = $show_just ? " AND ( dlits.status = '$show_just' )" : ''; | ||
148 : | golsen | 1.11 | my $tuples = $rdbH->SQL( "SELECT DISTINCT status,md5_hash,curator " |
149 : | . "FROM dlits " | ||
150 : | . "WHERE ( pubmed = '$ref_id' )" | ||
151 : | . $and_status | ||
152 : | golsen | 1.8 | ); |
153 : | my @to_display = (); | ||
154 : | foreach my $x ( @$tuples ) | ||
155 : | { | ||
156 : | golsen | 1.10 | my( $status, $hash, $prev_curator ) = @$x; |
157 : | my @pegs = grep { $fig->is_real_feature($_) } | ||
158 : | $fig->pegs_with_md5( $hash ); | ||
159 : | golsen | 1.8 | if ( @pegs > 0 ) |
160 : | { | ||
161 : | golsen | 1.10 | push( @to_display, [ $status, $pegs[0], $ref_id, $prev_curator ] ); |
162 : | golsen | 1.8 | } |
163 : | } | ||
164 : | |||
165 : | &display_set( $fig, $cgi, $html, \@to_display, "Genes linked to Reference: $ref_id", 'Show Reference' ) ; | ||
166 : | } | ||
167 : | |||
168 : | golsen | 1.7 | # Literature selected by role ------------------------------------------------- |
169 : | |||
170 : | elsif ( $submit4 && $role ) | ||
171 : | overbeek | 1.1 | { |
172 : | golsen | 1.7 | my $roleQ = quotemeta $role; |
173 : | golsen | 1.8 | my $and_status = $show_just ? " AND ( dlits.status = '$show_just' )" : ''; |
174 : | golsen | 1.11 | my $tuples = $rdbH->SQL( "SELECT DISTINCT dlits.status,dlits.md5_hash,dlits.pubmed,dlits.curator " |
175 : | . "FROM hash_role,dlits " | ||
176 : | . "WHERE ( hash_role.role = '$roleQ') AND ( hash_role.md5_hash = dlits.md5_hash )" | ||
177 : | golsen | 1.8 | . $and_status |
178 : | golsen | 1.7 | ); |
179 : | overbeek | 1.1 | my @to_display = (); |
180 : | golsen | 1.8 | foreach my $x ( @$tuples ) |
181 : | overbeek | 1.1 | { |
182 : | golsen | 1.10 | my( $status, $hash, $pubmed, $prev_curator ) = @$x; |
183 : | my @pegs = grep { $fig->is_real_feature($_) } | ||
184 : | $fig->pegs_with_md5( $hash ); | ||
185 : | golsen | 1.8 | if ( @pegs > 0 ) |
186 : | golsen | 1.7 | { |
187 : | golsen | 1.10 | push( @to_display, [ $status, $pegs[0], $pubmed, $prev_curator ] ); |
188 : | golsen | 1.7 | } |
189 : | overbeek | 1.1 | } |
190 : | golsen | 1.8 | |
191 : | &display_set( $fig, $cgi, $html, \@to_display, "Genes for Role: $role", 'Show Role' ); | ||
192 : | golsen | 1.7 | } |
193 : | |||
194 : | # Show the role list ---------------------------------------------------------- | ||
195 : | |||
196 : | elsif ( $submit2 || $submit4 ) | ||
197 : | { | ||
198 : | # Did user request role literature, and not select a role? | ||
199 : | push @$html, $cgi->h3( '<FONT Color=red>Please select a role.</FONT>' ) if $submit4; | ||
200 : | |||
201 : | my $where1 = $show_just ? " AND (dlits.status = '$show_just')" : ""; | ||
202 : | olson | 1.12 | my($where2, $from_list); |
203 : | golsen | 1.7 | |
204 : | olson | 1.12 | $from_list = "hash_role,dlits"; |
205 : | if ($curator) | ||
206 : | { | ||
207 : | $where2 = " AND (curr_role.curator = '$curator' AND curr_role.role = hash_role.role)"; | ||
208 : | $from_list .= ",curr_role"; | ||
209 : | } | ||
210 : | |||
211 : | golsen | 1.7 | my @roles = sort { lc $a cmp lc $b } # Make sort case insensitive |
212 : | map { $_->[0] } | ||
213 : | golsen | 1.11 | @{ $rdbH->SQL( "SELECT DISTINCT hash_role.role " |
214 : | olson | 1.12 | . "FROM $from_list " |
215 : | golsen | 1.11 | . "WHERE hash_role.md5_hash = dlits.md5_hash $where1 $where2" |
216 : | golsen | 1.7 | ) }; |
217 : | push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'), | ||
218 : | golsen | 1.9 | $cgi->hidden( -name => 'user', -value => $user ), |
219 : | golsen | 1.10 | $cgi->hidden( -name => 'curator', -value => $curator ) |
220 : | golsen | 1.7 | ); |
221 : | |||
222 : | my $whom = $curator ? "'$curator'" : "any one"; | ||
223 : | my $status = $show_just ? " with literature of status code '$show_just':" : ":"; | ||
224 : | push( @$html, $cgi->h3( "Subsystem roles curated by $whom" . $status ) ); | ||
225 : | |||
226 : | push( @$html, $cgi->scrolling_list( -name => 'role', | ||
227 : | -values => [@roles], | ||
228 : | -size => 30 | ||
229 : | ), | ||
230 : | $cgi->br, &show_just_selector( $cgi ), | ||
231 : | $cgi->br, $cgi->submit( 'Show Role' ), | ||
232 : | $cgi->br, $cgi->submit( 'Show Genomes' ), | ||
233 : | $cgi->br, $cgi->submit( 'Change subsystem curator' ), " currently '$curator'.", | ||
234 : | $cgi->end_form | ||
235 : | ); | ||
236 : | overbeek | 1.1 | } |
237 : | golsen | 1.7 | |
238 : | # Literature selected by genome ----------------------------------------------- | ||
239 : | |||
240 : | elsif ( $submit3 && $genomeD && ( $genomeD =~ /\((\d+\.\d+)\)$/ ) ) | ||
241 : | overbeek | 1.1 | { |
242 : | golsen | 1.7 | my $genome = $1; |
243 : | my $where = $show_just ? " AND (dlits.status = '$show_just')" : ''; | ||
244 : | golsen | 1.11 | my $tuples = $rdbH->SQL( "SELECT DISTINCT dlits.status,dlits.md5_hash,dlits.pubmed,dlits.curator " |
245 : | . "FROM genome_hash,dlits " | ||
246 : | . "WHERE genome_hash.genome = '$genome' AND genome_hash.md5_hash = dlits.md5_hash $where" | ||
247 : | golsen | 1.7 | ); |
248 : | overbeek | 1.1 | my @to_display = (); |
249 : | golsen | 1.7 | foreach my $x ( @$tuples ) |
250 : | overbeek | 1.1 | { |
251 : | golsen | 1.10 | my ( $status, $hash, $pubmed, $prev_curator ) = @$x; |
252 : | push @to_display, map { [ $status, $_, $pubmed, $prev_curator ] } | ||
253 : | grep { &FIG::genome_of($_) eq $genome && $fig->is_real_feature($_) } | ||
254 : | $fig->pegs_with_md5($hash); | ||
255 : | overbeek | 1.1 | } |
256 : | golsen | 1.10 | |
257 : | golsen | 1.7 | &display_set( $fig, $cgi, $html, \@to_display, "Genes for $genomeD", 'Show Genome' ); |
258 : | } | ||
259 : | |||
260 : | # Show genome list ------------------------------------------------------------ | ||
261 : | |||
262 : | elsif ( $submit1 || $submit3 ) | ||
263 : | { | ||
264 : | # Did user request genome literature, and not select a genome? | ||
265 : | push @$html, $cgi->h3( '<FONT Color=red>Please select a genome.</FONT>' ) if $submit3; | ||
266 : | |||
267 : | my $where = $show_just ? " AND (dlits.status = '$show_just')" : ""; | ||
268 : | |||
269 : | golsen | 1.11 | my $genomes = $rdbH->SQL( "SELECT DISTINCT genome_hash.genome " |
270 : | . "FROM genome_hash,dlits " | ||
271 : | . "WHERE genome_hash.md5_hash = dlits.md5_hash $where" | ||
272 : | golsen | 1.7 | ); |
273 : | my @genomes = sort { lc $a cmp lc $b } # Make sort case insensitive | ||
274 : | map { &compute_genome_label( $fig, $_->[0] ) } | ||
275 : | @$genomes; | ||
276 : | |||
277 : | push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'), | ||
278 : | golsen | 1.9 | $cgi->hidden( -name => 'user', -value => $user ), |
279 : | $cgi->hidden( -name => 'curator', -value => $curator ), | ||
280 : | golsen | 1.7 | $cgi->scrolling_list( -name => 'genomeD', |
281 : | -values => [@genomes], | ||
282 : | -size => 30 | ||
283 : | ), | ||
284 : | $cgi->br, &show_just_selector( $cgi ), | ||
285 : | golsen | 1.11 | $cgi->br, $cgi->submit( 'Show Genome' ), ' selected above.', |
286 : | golsen | 1.7 | $cgi->br, $cgi->submit( 'Show Roles' ), |
287 : | golsen | 1.11 | ( $curator ? " for subsystem curator '$curator'." : '' ), |
288 : | golsen | 1.7 | $cgi->br, $cgi->submit( 'Change subsystem curator' ), " currently '$curator'.", |
289 : | $cgi->end_form | ||
290 : | ); | ||
291 : | overbeek | 1.1 | } |
292 : | golsen | 1.7 | |
293 : | # Default = display subsystem curators ---------------------------------------- | ||
294 : | |||
295 : | overbeek | 1.1 | else |
296 : | { | ||
297 : | golsen | 1.7 | my @cur = map { $_->[0] } |
298 : | sort { $a->[1] cmp $b->[1] || length $a->[0] <=> length $b->[0] } | ||
299 : | map { my $cur = $_->[0]; | ||
300 : | my $nam = lc $cur; | ||
301 : | $nam =~ s/^master[:_]?//; | ||
302 : | [ $cur, $nam ] | ||
303 : | } | ||
304 : | @{ $rdbH->SQL( "SELECT DISTINCT curator FROM dlits" ) }; | ||
305 : | my $curN = @cur; | ||
306 : | |||
307 : | push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'), | ||
308 : | golsen | 1.9 | $cgi->hidden( -name => 'user', -value => $user ), |
309 : | golsen | 1.7 | $cgi->scrolling_list( -name => 'curator', |
310 : | -values => [ @cur ], | ||
311 : | -size => $curN | ||
312 : | ), | ||
313 : | $cgi->br, | ||
314 : | &show_just_selector( $cgi ), | ||
315 : | $cgi->submit( 'Show Roles' ), | ||
316 : | $cgi->br, | ||
317 : | $cgi->submit( 'Show Genomes' ), | ||
318 : | $cgi->end_form | ||
319 : | ); | ||
320 : | } | ||
321 : | &HTML::show_page($cgi,$html); | ||
322 : | exit; | ||
323 : | overbeek | 1.1 | |
324 : | |||
325 : | golsen | 1.7 | sub show_just_selector |
326 : | { | ||
327 : | my ( $cgi, $html ) = @_; | ||
328 : | my $default = $cgi->param( 'show_just' ); | ||
329 : | $default =~ /^[ A-Z]$/ or $default = 'all'; | ||
330 : | return 'Show literature links with all status codes, or pick a specific one: ' | ||
331 : | . $cgi->scrolling_list( -name => 'show_just', | ||
332 : | -values => ['all',' ','D','R','N','G'], | ||
333 : | -default => $default, | ||
334 : | -override => 1, | ||
335 : | -size => 1 | ||
336 : | ) | ||
337 : | . $cgi->br; | ||
338 : | overbeek | 1.1 | } |
339 : | |||
340 : | |||
341 : | sub compute_genome_label | ||
342 : | { | ||
343 : | my($fig, $org) = @_; | ||
344 : | |||
345 : | my $gs = $fig->genus_species($org); | ||
346 : | return "$gs ($org)"; | ||
347 : | } | ||
348 : | |||
349 : | golsen | 1.7 | |
350 : | overbeek | 1.1 | sub title_of { |
351 : | golsen | 1.8 | my( $fig, $pubmed ) = @_; |
352 : | overbeek | 1.1 | |
353 : | my $rdbH = $fig->db_handle; | ||
354 : | golsen | 1.11 | my $retval = $rdbH->SQL( "SELECT title " |
355 : | . "FROM pubmed_titles " | ||
356 : | . "WHERE (pubmed = $pubmed)" | ||
357 : | golsen | 1.7 | ); |
358 : | return ( @$retval > 0 ) ? $retval->[0]->[0] : ""; | ||
359 : | } | ||
360 : | |||
361 : | |||
362 : | sub pubmed_link | ||
363 : | { | ||
364 : | return "<a target=_blank href=http://www.ncbi.nlm.nih.gov/sites/entrez?db=pubmed&cmd=search&term=$_[0]>$_[0]</a>"; | ||
365 : | overbeek | 1.1 | } |
366 : | golsen | 1.7 | |
367 : | overbeek | 1.1 | |
368 : | sub display_set { | ||
369 : | golsen | 1.7 | my( $fig, $cgi, $html, $to_display, $tab_title, $submit ) = @_; |
370 : | overbeek | 1.1 | |
371 : | golsen | 1.7 | my %status_code = ( 'D' => 1, ' ' => 2, 'N' => 3, 'R' => 4, 'G' => 5 ); |
372 : | overbeek | 1.1 | |
373 : | golsen | 1.7 | # @$to_distplay items are [ $status, $peg, $pubmed ] |
374 : | overbeek | 1.1 | |
375 : | golsen | 1.7 | foreach $_ ( @$to_display ) { $_->[0] =~ s/^\s*$/ /; } # fix empty status strings |
376 : | my @tuples = sort { ( $status_code{$a->[0]} <=> $status_code{$b->[0]} ) | ||
377 : | or &FIG::by_fig_id( $a->[1], $b->[1] ) | ||
378 : | golsen | 1.10 | or ( $a->[2] <=> $b->[2] ) # Numeric sort of PMID |
379 : | golsen | 1.7 | } |
380 : | @$to_display; | ||
381 : | overbeek | 1.1 | my $total_tuples = @tuples; |
382 : | |||
383 : | golsen | 1.7 | my $from; # Offset to first item displayed |
384 : | golsen | 1.8 | my $n_per_page = 100; # Really the lines per page |
385 : | golsen | 1.7 | |
386 : | if ( $cgi->param( 'Go to item numbers' ) ) | ||
387 : | { | ||
388 : | $from = $cgi->param( 'offset_select' ); | ||
389 : | } | ||
390 : | else | ||
391 : | { | ||
392 : | $from = $cgi->param( 'from_line' ) || 0; | ||
393 : | golsen | 1.8 | $from -= $n_per_page if $cgi->param( 'Previous page' ); |
394 : | $from += $n_per_page if $cgi->param( 'Next page' ); | ||
395 : | golsen | 1.7 | } |
396 : | |||
397 : | # Cut down the array to that to be displayed | ||
398 : | |||
399 : | if ( $total_tuples > 0 ) | ||
400 : | { | ||
401 : | if ( $from < 0 ) { $from = 0 } | ||
402 : | if ( $from > $total_tuples ) | ||
403 : | { | ||
404 : | golsen | 1.8 | $from = $n_per_page * int( ( $total_tuples - 1 ) / $n_per_page ); |
405 : | golsen | 1.7 | } |
406 : | splice( @tuples, 0, $from ); | ||
407 : | golsen | 1.8 | splice( @tuples, $n_per_page ); |
408 : | golsen | 1.7 | } |
409 : | overbeek | 1.1 | else |
410 : | { | ||
411 : | golsen | 1.7 | undef $from; |
412 : | overbeek | 1.1 | } |
413 : | |||
414 : | golsen | 1.7 | # Add status code key at top of page |
415 : | |||
416 : | &desc( $html ); | ||
417 : | |||
418 : | # Build the html form | ||
419 : | |||
420 : | push( @$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post') ); | ||
421 : | |||
422 : | # Current user | ||
423 : | my $user = $cgi->param('user'); | ||
424 : | push( @$html, $cgi->hidden( -name => 'user', -value => $user, -override => 1 ) ); | ||
425 : | |||
426 : | # Filter roles by subsystem curator | ||
427 : | golsen | 1.8 | my $curator = $cgi->param('curator'); |
428 : | golsen | 1.7 | push( @$html, $cgi->hidden( -name => 'curator', -value => $curator, -override => 1 ) ) if $curator; |
429 : | |||
430 : | # Find lit by genome | ||
431 : | my $genomeD = $cgi->param('genomeD'); | ||
432 : | push( @$html, $cgi->hidden( -name => 'genomeD', -value => $genomeD, -override => 1 ) ) if $genomeD; | ||
433 : | |||
434 : | golsen | 1.8 | # Show sequences associated with a reference |
435 : | my $ref_id = $cgi->param('ref_id'); | ||
436 : | push( @$html, $cgi->hidden( -name => 'ref_id', -value => $ref_id, -override => 1 ) ) if $ref_id; | ||
437 : | |||
438 : | golsen | 1.7 | # Find lit by role |
439 : | my $role = $cgi->param('role'); | ||
440 : | push( @$html, $cgi->hidden( -name => 'role', -value => $role, -override => 1 ) ) if $role; | ||
441 : | |||
442 : | # Requested action | ||
443 : | push( @$html, $cgi->hidden( -name => 'prev_req', -value => $submit, -override => 1 ) ) if $submit; | ||
444 : | |||
445 : | # Used to inherit action | ||
446 : | push( @$html, $cgi->hidden( -name => $submit, -value => 1, -override => 1 ) ) if $submit; | ||
447 : | |||
448 : | push( @$html, $cgi->br ); | ||
449 : | |||
450 : | golsen | 1.8 | # If this is not a table built around one reference, we want to append |
451 : | # links to all proteins associated with the reference. We will | ||
452 : | # compute this on a unique set of the references: | ||
453 : | |||
454 : | my %genes_in_pub; | ||
455 : | if ( ! $ref_id ) | ||
456 : | { | ||
457 : | foreach ( @tuples ) | ||
458 : | { | ||
459 : | my $pub = $_->[2]; | ||
460 : | next if defined $genes_in_pub{ $pub }; | ||
461 : | # This count intentionally omits filtering by status | ||
462 : | $genes_in_pub{ $pub } = scalar ( &all_seqs_in_pub( $fig, $pub ) ); | ||
463 : | } | ||
464 : | } | ||
465 : | |||
466 : | golsen | 1.7 | # Build the status selection table |
467 : | |||
468 : | golsen | 1.10 | my $col_hdrs = [' ','G','N','R','D','Curator','PEG','Function','Genus/Species','PubMed','Title']; |
469 : | golsen | 1.7 | my $tab = []; |
470 : | overbeek | 1.1 | my $i; |
471 : | golsen | 1.8 | for ( $i = 0; ($i < @tuples); $i++ ) |
472 : | overbeek | 1.1 | { |
473 : | golsen | 1.7 | my $tuple = $tuples[$i]; |
474 : | golsen | 1.10 | my( $status, $peg, $pubmed, $prev_curator ) = @$tuple; |
475 : | next if ( ! $fig->is_real_feature($peg) ); # This should never fail | ||
476 : | |||
477 : | $prev_curator =~ s/^master://i; # Remove master from displayed curator | ||
478 : | golsen | 1.7 | my $gs = $fig->genus_species( &FIG::genome_of( $peg ) ); |
479 : | $gs =~ s/^(\S+\s+\S+).*$/$1/; | ||
480 : | my $title = &title_of( $fig, $pubmed ); | ||
481 : | my $func = $fig->function_of($peg); | ||
482 : | my @codes = $cgi->radio_group( -name => "tuple:$peg:$pubmed:$status", | ||
483 : | -values => [' ','G','N','R','D'], | ||
484 : | -default => "$status", | ||
485 : | -nolabels => 1 | ||
486 : | ); | ||
487 : | |||
488 : | golsen | 1.8 | my $pub_link = &pubmed_link( $pubmed ); |
489 : | |||
490 : | # Does this paper cover more than one protein? | ||
491 : | |||
492 : | if ( $genes_in_pub{ $pubmed } > 1 ) | ||
493 : | { | ||
494 : | golsen | 1.11 | # This link intentionally omits $show_just |
495 : | golsen | 1.9 | my $href = "get_dlits.cgi?user=$user&ref_id=$pubmed"; |
496 : | $pub_link .= "<BR />(<A HRef='$href' Target=_blank>$genes_in_pub{$pubmed} seqs</A>)"; | ||
497 : | golsen | 1.8 | } |
498 : | golsen | 1.11 | if ( $i && ($i % 15) == 0 ) { push(@$tab,$col_hdrs) } |
499 : | golsen | 1.10 | push( @$tab, [ @codes, $prev_curator, &HTML::fid_link( $cgi, $peg ), $func, $gs, $pub_link, $title ] ); |
500 : | golsen | 1.7 | } |
501 : | |||
502 : | push( @$html,&HTML::make_table( $col_hdrs, $tab, $tab_title ) ); | ||
503 : | |||
504 : | push( @$html, $cgi->br, &show_just_selector( $cgi ) ); | ||
505 : | |||
506 : | # Navigation controls through long lists | ||
507 : | |||
508 : | golsen | 1.8 | if ( defined( $from ) && ( $total_tuples > $n_per_page ) ) |
509 : | golsen | 1.7 | { |
510 : | my $i1 = $from + 1; | ||
511 : | golsen | 1.8 | my $i2 = $from + $n_per_page; |
512 : | golsen | 1.7 | $i2 = $total_tuples if $i2 > $total_tuples; |
513 : | push( @$html, $cgi->hidden( -name => 'from_line', -value => $from, -override => 1 ) ); | ||
514 : | push( @$html, $cgi->br, "Currently displaying items $i1 - $i2 of $total_tuples.", $cgi->br ); | ||
515 : | push( @$html, $cgi->submit( 'Previous page' ) ) if $from > 0; | ||
516 : | push( @$html, $cgi->submit( 'Next page' ) ) if $i2 < $total_tuples; | ||
517 : | |||
518 : | my @offsets; | ||
519 : | my %labels; | ||
520 : | golsen | 1.8 | for ( my $i = 0; $i < $total_tuples; $i += $n_per_page ) |
521 : | golsen | 1.7 | { |
522 : | push @offsets, $i; | ||
523 : | golsen | 1.8 | my $imax = $i + $n_per_page; |
524 : | golsen | 1.7 | $imax = $total_tuples if $imax > $total_tuples; |
525 : | $labels{ $i } = ( $i+1 ) . " - $imax"; | ||
526 : | } | ||
527 : | push( @$html, $cgi->submit( 'Go to item numbers' ), | ||
528 : | $cgi->scrolling_list( -name => 'offset_select', | ||
529 : | -values => \@offsets, | ||
530 : | -labels => \%labels, | ||
531 : | -default => $from, | ||
532 : | -size => 1, | ||
533 : | -override => 1 | ||
534 : | ), | ||
535 : | $cgi->br ); | ||
536 : | overbeek | 1.1 | } |
537 : | golsen | 1.7 | |
538 : | # Some action buttons: | ||
539 : | |||
540 : | push( @$html, $cgi->br, $cgi->submit( 'Process Changes' ), "entered on this page." ); | ||
541 : | |||
542 : | golsen | 1.8 | # Display some general navigation buttons. However, these are not |
543 : | # consistent with the intended use of the publication-based view. | ||
544 : | golsen | 1.7 | |
545 : | golsen | 1.8 | if ( ! $ref_id ) |
546 : | golsen | 1.7 | { |
547 : | golsen | 1.8 | push( @$html, $cgi->br, $cgi->submit( 'Show Genomes' ), "discarding any changes made on this page." ); |
548 : | if ( $curator ) | ||
549 : | { | ||
550 : | push( @$html, $cgi->br, $cgi->submit( 'Show Roles' ), | ||
551 : | "for subsystem curator '$curator', discarding any changes made on this page." ); | ||
552 : | } | ||
553 : | push( @$html, $cgi->br, $cgi->submit( 'Change subsystem curator' ), " currently '$curator', discarding any changes made on this page." ); | ||
554 : | golsen | 1.7 | } |
555 : | |||
556 : | golsen | 1.8 | push( @$html, $cgi->end_form ); |
557 : | } | ||
558 : | |||
559 : | golsen | 1.7 | |
560 : | golsen | 1.11 | # dlits |
561 : | golsen | 1.8 | # flds => "status char(1), md5_hash varchar(32), pubmed varchar(16), curator varchar(30), go_code varchar(15)" |
562 : | |||
563 : | sub all_seqs_in_pub { | ||
564 : | my ( $fig, $pubmed, $status ) = @_; | ||
565 : | my $rdbH = $fig->db_handle; | ||
566 : | my $and_status = $status ? " AND ( status = '$status' )" : ""; | ||
567 : | golsen | 1.11 | my $response = $rdbH->SQL( "SELECT DISTINCT md5_hash " |
568 : | . "FROM dlits " | ||
569 : | . "WHERE ( pubmed = '$pubmed' )" | ||
570 : | . $and_status | ||
571 : | golsen | 1.8 | ); |
572 : | return ( ref $response ) ? map { $_->[0] } @$response : (); | ||
573 : | overbeek | 1.1 | } |
574 : | |||
575 : | golsen | 1.7 | |
576 : | overbeek | 1.4 | sub desc { |
577 : | golsen | 1.7 | my( $html ) = @_; |
578 : | overbeek | 1.4 | |
579 : | golsen | 1.7 | my $col_hdrs = [ "Code", "Meaning" ]; |
580 : | my $tab = [ [ [" ","TD Align=center"], "No one has curated this link yet" ], | ||
581 : | [ ["G","TD Align=center"], "Genome paper - marks all uncurated protein links of this paper to 'G' (implicitly irrelevant)" ], | ||
582 : | [ ["N","TD Align=center"], "Not relevant to this protein" ], | ||
583 : | [ ["R","TD Align=center"], "Relevant, but not strong enough to determine function" ], | ||
584 : | [ ["D","TD Align=center"], "Direct reference that can be used to support function assertion" ] | ||
585 : | ]; | ||
586 : | push( @$html, &HTML::make_table( $col_hdrs, $tab, "Code Meanings" ), "<hr>" ); | ||
587 : | overbeek | 1.4 | } |
588 : | |||
589 : | golsen | 1.7 | |
590 : | overbeek | 1.1 | sub process_changes { |
591 : | golsen | 1.7 | my( $fig, $cgi, $html ) = @_; |
592 : | my $user = $cgi->param('user'); | ||
593 : | overbeek | 1.1 | |
594 : | my @tuples = grep { $_->[2] ne $_->[3] } | ||
595 : | map { ($_ =~ /^tuple:(fig\|\d+\.\d+\.peg\.\d+)\s*:\s*(\d+)\s*:([ RDGN])/) ? [$1,$2,$3,$cgi->param($_)] : () } | ||
596 : | $cgi->param(); | ||
597 : | golsen | 1.7 | my $n_change = 0; |
598 : | foreach my $tuple ( @tuples ) | ||
599 : | overbeek | 1.1 | { |
600 : | golsen | 1.7 | my( $peg, $pubmed, $from, $to ) = @$tuple; |
601 : | $fig->add_dlit( -status => $to, | ||
602 : | -peg => $peg, | ||
603 : | -pubmed => $pubmed, | ||
604 : | -curator => $user, | ||
605 : | -override => 1 | ||
606 : | ); | ||
607 : | $n_change++; | ||
608 : | overbeek | 1.1 | } |
609 : | golsen | 1.7 | |
610 : | push( @$html, $cgi->h2( "<FONT Color=green>Made $n_change requested changes.</FONT>" ) ); | ||
611 : | overbeek | 1.1 | } |
612 : |
MCS Webmaster | ViewVC Help |
Powered by ViewVC 1.0.3 |