Parent Directory
| 
Revision Log
Revision 1.1 - (view) (download)
| 1 : | overbeek | 1.1 | # -*- perl -*- |
| 2 : | # | ||
| 3 : | # Copyright (c) 2003-2006 University of Chicago and Fellowship | ||
| 4 : | # 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 : | print "$_\t:",join(",",$cgi->param($_)),":\n"; | ||
| 46 : | } | ||
| 47 : | |||
| 48 : | if (0) | ||
| 49 : | { | ||
| 50 : | if (open(TMP,">/tmp/get_dlit_parms")) | ||
| 51 : | { | ||
| 52 : | print TMP &Dumper($cgi); | ||
| 53 : | close(TMP); | ||
| 54 : | } | ||
| 55 : | } | ||
| 56 : | exit; | ||
| 57 : | } | ||
| 58 : | my($genome); | ||
| 59 : | |||
| 60 : | my $html = []; | ||
| 61 : | unshift @$html, "<TITLE>Get Dlits</TITLE>\n"; | ||
| 62 : | |||
| 63 : | my $user = $cgi->param('user'); | ||
| 64 : | my $curator = $cgi->param('curator'); | ||
| 65 : | my $role = $cgi->param('role'); | ||
| 66 : | my $submit1 = $cgi->param('Show Genomes'); | ||
| 67 : | my $submit2 = $cgi->param('Show Roles'); | ||
| 68 : | my $submit3 = $cgi->param('Show Genome'); | ||
| 69 : | my $submit4 = $cgi->param('Show Role'); | ||
| 70 : | my $show_just = $cgi->param('show_just'); | ||
| 71 : | $show_just = ($show_just eq "all") ? '' : $show_just; | ||
| 72 : | |||
| 73 : | my $genomeD = $cgi->param('genomeD'); | ||
| 74 : | my $submit5 = $cgi->param('Process Changes'); | ||
| 75 : | my $rdbH = $fig->db_handle; | ||
| 76 : | |||
| 77 : | if (! $user) | ||
| 78 : | { | ||
| 79 : | push(@$html,$cgi->h1('you need to set user= in the URL')); | ||
| 80 : | } | ||
| 81 : | elsif (! -d "$FIG_Config::data/Dlits") | ||
| 82 : | { | ||
| 83 : | push(@$html,$cgi->h1("dlit data not installed")); | ||
| 84 : | } | ||
| 85 : | elsif ($submit5) | ||
| 86 : | { | ||
| 87 : | &process_changes($fig,$cgi,$html); | ||
| 88 : | } | ||
| 89 : | elsif ($submit1) | ||
| 90 : | { | ||
| 91 : | my $where = $show_just ? "AND (dlits.status = '$show_just ') " : ""; | ||
| 92 : | my $genomes = $rdbH->SQL("select DISTINCT genome_hash.genome from genome_hash,dlits WHERE genome_hash.md5_hash = dlits.md5_hash $where"); | ||
| 93 : | my @genomes = sort map { &compute_genome_label($fig,$_->[0]) } @$genomes; | ||
| 94 : | |||
| 95 : | push(@$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'), | ||
| 96 : | $cgi->hidden(-name => 'user', -value=>$user), | ||
| 97 : | $cgi->hidden(-name => 'show_just', -value=>$show_just), | ||
| 98 : | $cgi->hidden(-name => 'curator', -value=> $curator), | ||
| 99 : | $cgi->scrolling_list( -name => 'genomeD', | ||
| 100 : | -values => [@genomes], | ||
| 101 : | -size => 30 | ||
| 102 : | ), | ||
| 103 : | $cgi->br, | ||
| 104 : | $cgi->submit( 'Show Genome' ), | ||
| 105 : | $cgi->end_form | ||
| 106 : | ); | ||
| 107 : | } | ||
| 108 : | elsif ($submit2) | ||
| 109 : | { | ||
| 110 : | my $where1 = $show_just ? "AND (dlits.status = '$show_just ') " : ""; | ||
| 111 : | my $where2 = $curator ? "AND (curr_role.curator = '$curator' AND curr_role.role = hash_role.role) " : ""; | ||
| 112 : | |||
| 113 : | 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")}; | ||
| 114 : | push(@$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'), | ||
| 115 : | $cgi->hidden(-name => 'user', -value=>$user), | ||
| 116 : | $cgi->hidden(-name => 'show_just', -value=>$show_just), | ||
| 117 : | $cgi->hidden(-name => 'curator', -value=> $curator), | ||
| 118 : | $cgi->scrolling_list( -name => 'role', | ||
| 119 : | -values => [@roles], | ||
| 120 : | -size => 30 | ||
| 121 : | ), | ||
| 122 : | $cgi->br, | ||
| 123 : | $cgi->submit( 'Show Role' ), | ||
| 124 : | $cgi->end_form | ||
| 125 : | ); | ||
| 126 : | } | ||
| 127 : | elsif ($submit3 && $genomeD && ($genomeD =~ /\((\d+\.\d+)\)/)) | ||
| 128 : | { | ||
| 129 : | my $where = $show_just ? " AND dlits.status = '$show_just'" : ''; | ||
| 130 : | my $genome = $1; | ||
| 131 : | my $tuples = $rdbH->SQL("select DISTINCT dlits.status,dlits.md5_hash,dlits.pubmed | ||
| 132 : | FROM genome_hash,dlits | ||
| 133 : | WHERE genome_hash.genome = '$genome' AND genome_hash.md5_hash = dlits.md5_hash $where"); | ||
| 134 : | my @to_display = (); | ||
| 135 : | foreach my $x (@$tuples) | ||
| 136 : | { | ||
| 137 : | my($status,$hash,$pubmed) = @$x; | ||
| 138 : | foreach my $peg ($fig->pegs_with_md5($hash)) | ||
| 139 : | { | ||
| 140 : | if (&FIG::genome_of($peg) eq $genome) | ||
| 141 : | { | ||
| 142 : | push(@to_display,[$status,$peg,$pubmed]); | ||
| 143 : | } | ||
| 144 : | } | ||
| 145 : | } | ||
| 146 : | &display_set($fig,$cgi,$html,\@to_display,'Genes for $genomeD','Show Genome'); | ||
| 147 : | } | ||
| 148 : | elsif ($submit4) | ||
| 149 : | { | ||
| 150 : | my $where = $show_just ? " AND dlits.status = '$show_just'" : ''; | ||
| 151 : | my $roleQ = quotemeta $role; | ||
| 152 : | my $tuples = $rdbH->SQL("select DISTINCT dlits.status,dlits.md5_hash,dlits.pubmed | ||
| 153 : | FROM hash_role,dlits,pubmed_titles | ||
| 154 : | WHERE hash_role.role = '$roleQ' AND hash_role.md5_hash = dlits.md5_hash $where"); | ||
| 155 : | my @to_display = (); | ||
| 156 : | foreach my $x (@$tuples) | ||
| 157 : | { | ||
| 158 : | my($status,$hash,$pubmed) = @$x; | ||
| 159 : | my @pegs = $fig->pegs_with_md5($hash); | ||
| 160 : | if (@pegs > 0) | ||
| 161 : | { | ||
| 162 : | push(@to_display,[$status,$pegs[0],$pubmed]); | ||
| 163 : | } | ||
| 164 : | } | ||
| 165 : | &display_set($fig,$cgi,$html,\@to_display,'Genes for Role: $role','Show Role'); | ||
| 166 : | } | ||
| 167 : | else | ||
| 168 : | { | ||
| 169 : | my @cur = map { $_->[0]} @{$rdbH->SQL( "SELECT DISTINCT curator FROM dlits" )}; | ||
| 170 : | |||
| 171 : | my $curN = @cur; | ||
| 172 : | |||
| 173 : | my $show_just_opt = $cgi->scrolling_list( -name => 'show_just', | ||
| 174 : | -values => ['all',' ','D','R','N','G'], | ||
| 175 : | -default => 'all', | ||
| 176 : | -override => 1, | ||
| 177 : | -size => 1 | ||
| 178 : | ), | ||
| 179 : | |||
| 180 : | push(@$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'), | ||
| 181 : | $cgi->hidden(-name => 'user', -value=>$user), | ||
| 182 : | $cgi->scrolling_list( -name => 'curator', | ||
| 183 : | -values => [ @cur ], | ||
| 184 : | -size => $curN | ||
| 185 : | ), | ||
| 186 : | $cgi->scrolling_list( -name => 'show_just', | ||
| 187 : | -values => ['all',' ','D','R','N','G'], | ||
| 188 : | -default => 'all', | ||
| 189 : | -override => 1, | ||
| 190 : | -size => 1 | ||
| 191 : | ), | ||
| 192 : | $cgi->br, | ||
| 193 : | $cgi->submit( 'Show Roles' ), | ||
| 194 : | $cgi->br, | ||
| 195 : | $cgi->submit( 'Show Genomes' ), | ||
| 196 : | $cgi->end_form | ||
| 197 : | ); | ||
| 198 : | } | ||
| 199 : | |||
| 200 : | &HTML::show_page($cgi,$html); | ||
| 201 : | |||
| 202 : | sub compute_genome_label | ||
| 203 : | { | ||
| 204 : | my($fig, $org) = @_; | ||
| 205 : | |||
| 206 : | my $gs = $fig->genus_species($org); | ||
| 207 : | return "$gs ($org)"; | ||
| 208 : | } | ||
| 209 : | |||
| 210 : | sub title_of { | ||
| 211 : | my($fig,$pubmed) = @_; | ||
| 212 : | |||
| 213 : | my $rdbH = $fig->db_handle; | ||
| 214 : | my $retval = $rdbH->SQL( "SELECT title FROM pubmed_titles WHERE (pubmed = $pubmed)"); | ||
| 215 : | return (@$retval > 0) ? $retval->[0]->[0] : ""; | ||
| 216 : | } | ||
| 217 : | |||
| 218 : | |||
| 219 : | sub display_set { | ||
| 220 : | my($fig,$cgi,$html,$to_display,$tab_title,$submit) = @_; | ||
| 221 : | |||
| 222 : | my $from = $cgi->param('from_line'); | ||
| 223 : | if (! $from) { $from = 0 } | ||
| 224 : | my $lines_left = 100; | ||
| 225 : | |||
| 226 : | my %status_code = ( 'D' => 1, ' ' => 2, 'N' => 3, 'R' => 4, 'G' => 5); | ||
| 227 : | |||
| 228 : | my $col_hdrs = [' ','G','N','R','D','PEG','Function','PubMed','Title']; | ||
| 229 : | my $tab = []; | ||
| 230 : | foreach $_ (@$to_display) { $_->[0] =~ s/^\s*$/ /; } | ||
| 231 : | my @tuples = sort { ($status_code{$a->[0]} <=> $status_code{$b->[0]}) or &FIG::by_fig_id($a->[1],$b->[1]) } @$to_display; | ||
| 232 : | my $total_tuples = @tuples; | ||
| 233 : | |||
| 234 : | if (@tuples > 0) { splice(@tuples,0,$from); $from = $from + $lines_left; splice(@tuples,$lines_left) } | ||
| 235 : | else | ||
| 236 : | { | ||
| 237 : | undef $from; | ||
| 238 : | } | ||
| 239 : | |||
| 240 : | my $i; | ||
| 241 : | for ($i=0; ($i < @tuples); $i++) | ||
| 242 : | { | ||
| 243 : | my $tuple = $tuples[$i]; | ||
| 244 : | my($status,$peg,$pubmed) = @$tuple; | ||
| 245 : | my $title = &title_of($fig,$pubmed); | ||
| 246 : | my $func = $fig->function_of($peg); | ||
| 247 : | my @codes = $cgi->radio_group(-name => "tuple:$peg:$pubmed:$status", | ||
| 248 : | -values => [' ','G','N','R','D'], | ||
| 249 : | -default => "$status", | ||
| 250 : | -nolabels => 1); | ||
| 251 : | |||
| 252 : | if (($i % 15) == 14) { push(@$tab,$col_hdrs) } | ||
| 253 : | push(@$tab,[@codes,&HTML::fid_link($cgi,$peg),$func, | ||
| 254 : | "<a target=_blank href=http://www.ncbi.nlm.nih.gov/sites/entrez?db=pubmed&cmd=search&term=$pubmed>$pubmed</a>", | ||
| 255 : | $title]); | ||
| 256 : | } | ||
| 257 : | push(@$html, $cgi->start_form(-action => "get_dlits.cgi", -method => 'post'), | ||
| 258 : | $cgi->hidden(-name => 'user', -value=>$user), | ||
| 259 : | $cgi->br, | ||
| 260 : | ); | ||
| 261 : | |||
| 262 : | push(@$html,&HTML::make_table($col_hdrs,$tab,$tab_title)); | ||
| 263 : | if (defined($from)) | ||
| 264 : | { | ||
| 265 : | my $genomeD = $cgi->param('genomeD'); | ||
| 266 : | $genomeD = $genomeD ? $genomeD : "none"; | ||
| 267 : | push(@$html,"<br>To get the next 100 (out of $total_tuples)", | ||
| 268 : | $cgi->hidden(-name => 'from_line', -value => $from, -override => 1), | ||
| 269 : | $cgi->hidden(-name => 'genomeD', -value => "$genomeD"), | ||
| 270 : | $cgi->submit($submit)); | ||
| 271 : | } | ||
| 272 : | push(@$html,$cgi->br,$cgi->submit('Process Changes')); | ||
| 273 : | push(@$html,$cgi->end_form); | ||
| 274 : | } | ||
| 275 : | |||
| 276 : | sub process_changes { | ||
| 277 : | my($fig,$cgi,$html) = @_; | ||
| 278 : | |||
| 279 : | my @tuples = grep { $_->[2] ne $_->[3] } | ||
| 280 : | map { ($_ =~ /^tuple:(fig\|\d+\.\d+\.peg\.\d+)\s*:\s*(\d+)\s*:([ RDGN])/) ? [$1,$2,$3,$cgi->param($_)] : () } | ||
| 281 : | $cgi->param(); | ||
| 282 : | my $user = $cgi->param('user'); | ||
| 283 : | foreach my $tuple (@tuples) | ||
| 284 : | { | ||
| 285 : | my($peg,$pubmed,$from,$to) = @$tuple; | ||
| 286 : | $fig->add_dlit( -status => $to, | ||
| 287 : | -peg => $peg, | ||
| 288 : | -pubmed => $pubmed, | ||
| 289 : | -curator => $user, | ||
| 290 : | -override => 1 | ||
| 291 : | ); | ||
| 292 : | } | ||
| 293 : | push(@$html,$cgi->h2('made the requested changes')); | ||
| 294 : | } | ||
| 295 : | |||
| 296 : |
| MCS Webmaster | ViewVC Help |
| Powered by ViewVC 1.0.3 |