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

Diff of /FigWebServices/get_dlits.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.12

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3