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