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

Diff of /FigWebServices/sgv.cgi

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

revision 1.4, Mon Dec 14 15:00:14 2009 UTC revision 1.9, Tue Feb 23 21:46:30 2010 UTC
# Line 16  Line 16 
16  # http://www.theseed.org/LICENSE.TXT.  # http://www.theseed.org/LICENSE.TXT.
17  #  #
18    
   
19  use SeedHTML;  use SeedHTML;
20  use strict;  use strict;
21  use SeedEnv;  use SeedEnv;
# Line 27  Line 26 
26  use CGI;  use CGI;
27  my $cgi = new CGI;  my $cgi = new CGI;
28    
29    my $sv_url = "http://seed-viewer.theseed.org/";
30    $GenoGraphics::image_type = "png";
31    $GenoGraphics::image_suffix = "png";
32    $GenoGraphics::temp_url = "/FIG-Tmp";
33    eval {
34        require FIG_Config;
35        $GenoGraphics::temp_url = $FIG_Config::temp_url;
36        $sv_url = "$FIG_Config::cgi_url/seedviewer.cgi";
37    };
38    
39    #print STDERR "$_ = $ENV{$_}\n" for sort keys %ENV;
40    
41  if (0)  if (0)
42  {  {
43      my $VAR1;      my $VAR1;
# Line 56  Line 67 
67      exit;      exit;
68  }  }
69    
70    
71  my $html = [];  my $html = [];
72  unshift @$html, "<TITLE>Simple Genome Viewer</TITLE>\n";  unshift @$html, "<TITLE>Simple Genome Viewer</TITLE>\n";
73    
# Line 121  Line 133 
133  sub make_subsystem_index {  sub make_subsystem_index {
134      my($cgi,$html,$dir) = @_;      my($cgi,$html,$dir) = @_;
135    
136      my %ss = map { chomp; my($subsys,$var) = split(/\t/,$_); (($var ne "-1") && ($var ne 0)) ? ($subsys => $var) : () }      my %ss = map { chomp; my($subsys,$var) = split(/\t/,$_); (($var ne "-1") && ($var ne 0)) ? (&fix_ss($subsys) => $var) : () }
137               `cat $dir/Subsystems/subsystems`;               `cat $dir/Subsystems/subsystems`;
138    
139      my $sapObject = SAPserver->new;      my $sapObject = SAPserver->new;
# Line 131  Line 143 
143      {      {
144          chomp;          chomp;
145          my($subsys,$role,$peg) = split(/\t/,$_);          my($subsys,$role,$peg) = split(/\t/,$_);
146            $subsys = &fix_ss($subsys);
147          if ($ss{$subsys})          if ($ss{$subsys})
148          {          {
149              my $class = ($_ = $ssH->{$subsys}) ? join("; ",@$_) : "";              my $class = ($_ = $ssH->{$subsys}) ? join("; ",@$_) : "";
# Line 144  Line 157 
157      my($cgi,$dir,$html) = @_;      my($cgi,$dir,$html) = @_;
158    
159      my $queryG = $cgi->param('genome');      my $queryG = $cgi->param('genome');
160      push(@$html,$cgi->start_form(-action => "sgv.cgi"),      push(@$html,$cgi->start_form(), # -action => "sgv.cgi"),
161                  '<br><b>Get Protein Page for FIG ID, or ACH Page for non-FIG IDs</b><br><br> ',                  '<br><b>Get Protein Page for FIG ID, or ACH Page for non-FIG IDs</b><br><br> ',
162                  $cgi->textfield(-name => 'id', -size => 20),                  $cgi->textfield(-name => 'id', -size => 20),
163                  $cgi->submit('go'),                  $cgi->submit('go'),
# Line 159  Line 172 
172    
173      if (! -d "$dir/CorrToReferenceGenomes")      if (! -d "$dir/CorrToReferenceGenomes")
174      {      {
175          system "$FIG_Config::bin/get_neighbors_and_corr_to_ref $dir &";          my $rc = system "$FIG_Config::bin/get_neighbors_and_corr_to_ref $dir &";
176      }      }
177  }  }
178    
# Line 171  Line 184 
184    
185      &id_search_form($cgi,$dir,$html);      &id_search_form($cgi,$dir,$html);
186    
187      push(@$html,$cgi->start_form(-action => "sgv.cgi"),      push(@$html,$cgi->start_form(), # -action => "sgv.cgi"),
188                  '<b>Query Features in Genome</b>: ',                  '<b>Query Features in Genome</b>: ',
189                  $cgi->textfield(-name => 'pattern', -size => 30),                  $cgi->textfield(-name => 'pattern', -size => 30),
190                  $cgi->submit('go'),                  $cgi->submit('go'),
# Line 180  Line 193 
193                  $cgi->end_form,                  $cgi->end_form,
194                  $cgi->hr,                  $cgi->hr,
195    
196                  $cgi->start_form(-action => "sgv.cgi"),                  $cgi->start_form(), # -action => "sgv.cgi"),
197                  '<b>Query Subsystems in Genome</b>: ',                  '<b>Query Subsystems in Genome</b>: ',
198                  $cgi->textfield(-name => 'pattern', -size => 30),                  $cgi->textfield(-name => 'pattern', -size => 30),
199                  $cgi->submit('go'),                  $cgi->submit('go'),
# Line 191  Line 204 
204          );          );
205    
206      my $cache = "$dir/CorrToReferenceGenomes";      my $cache = "$dir/CorrToReferenceGenomes";
207      opendir(CACHE,$cache) || die "could not open $cache";      my @refG;
208      my @refG = map { ((-s "$cache/$_") && ($_ =~ /^(\d+\.\d+$)/)) ? $1 : () } readdir(CACHE);      if (opendir(CACHE,$cache))
209        {
210            @refG = map { ((-s "$cache/$_") && ($_ =~ /^(\d+\.\d+$)/)) ? $1 : () } readdir(CACHE);
211      closedir(CACHE);      closedir(CACHE);
212        }
213        else
214        {
215            @refG = ();
216        }
217    
218      if (@refG > 0)      if (@refG > 0)
219      {      {
220          my $sapObject = SAPserver->new();          my $sapObject = SAPserver->new();
221          my($refG,$labels) = &build_labels(\@refG,$sapObject);          my($refG,$labels) = &build_labels(\@refG,$sapObject);
222    
223          push(@$html,$cgi->start_form(-action => "sgv.cgi"),          push(@$html,$cgi->start_form(), # -action => "sgv.cgi"),
224                      '<b>Compare Genome Against Reference Genome</b>: ',                      '<b>Compare Genome Against Reference Genome</b>: ',
225                      $cgi->scrolling_list( -name     => 'reference',                      $cgi->scrolling_list( -name     => 'reference',
226                                            -values   => $refG,                                            -values   => $refG,
# Line 271  Line 291 
291      my $refG   = $cgi->param('reference');      my $refG   = $cgi->param('reference');
292      my $queryG = $cgi->param('genome');      my $queryG = $cgi->param('genome');
293      my $dir  = $cgi->param('dir');      my $dir  = $cgi->param('dir');
294      push(@$html,$cgi->start_form(-action => "sgv.cgi"),      push(@$html,$cgi->start_form(), # -action => "sgv.cgi"),
295                  '<b>Corresponding Features</b>: ',                  '<b>Corresponding Features</b>: ',
296                  $cgi->textfield(-name => 'pattern', -size => 30),                  $cgi->textfield(-name => 'pattern', -size => 30),
297                  $cgi->submit('go'),                  $cgi->submit('go'),
# Line 281  Line 301 
301                  $cgi->end_form,                  $cgi->end_form,
302                  $cgi->hr,                  $cgi->hr,
303    
304                  $cgi->start_form(-action => "sgv.cgi"),                  $cgi->start_form(), # -action => "sgv.cgi"),
305                  '<b>Features in Query, but Not Reference</b>: ',                  '<b>Features in Query, but Not Reference</b>: ',
306                  $cgi->textfield(-name => 'pattern', -size => 30),                  $cgi->textfield(-name => 'pattern', -size => 30),
307                  $cgi->submit('go'),                  $cgi->submit('go'),
# Line 291  Line 311 
311                  $cgi->end_form,                  $cgi->end_form,
312                  $cgi->hr,                  $cgi->hr,
313    
314                  $cgi->start_form(-action => "sgv.cgi"),                  $cgi->start_form(), # -action => "sgv.cgi"),
315                  '<b>Features in Reference, but Not Query</b>: ',                  '<b>Features in Reference, but Not Query</b>: ',
316                  $cgi->textfield(-name => 'pattern', -size => 30),                  $cgi->textfield(-name => 'pattern', -size => 30),
317                  $cgi->submit('go'),                  $cgi->submit('go'),
# Line 309  Line 329 
329      my $pattern = $cgi->param('pattern');      my $pattern = $cgi->param('pattern');
330      my $dir     = $cgi->param('dir');      my $dir     = $cgi->param('dir');
331      my $refG    = $cgi->param('reference');      my $refG    = $cgi->param('reference');
332        my $refGgs  = &genus_species($refG);
333      my $genome  = $cgi->param('genome');      my $genome  = $cgi->param('genome');
334      my $file    = "$dir/CorrToReferenceGenomes/$refG";      my $file    = "$dir/CorrToReferenceGenomes/$refG";
335      my @corr    = sort { &SeedUtils::by_fig_id($a->[0],$b->[0]) }      my @corr    = sort { &SeedUtils::by_fig_id($a->[0],$b->[0]) }
# Line 326  Line 347 
347                      $psc,$bbh,$n_context,$aliasesR]);                      $psc,$bbh,$n_context,$aliasesR]);
348      }      }
349      my $filtered = &filter_tab_entries($tab,$pattern);      my $filtered = &filter_tab_entries($tab,$pattern);
350      push(@$html,&SeedHTML::make_table($col_headings,$filtered,'Correspondences'));      push(@$html,&SeedHTML::make_table($col_headings,$filtered,"Correspondences with $refGgs"));
351  }  }
352    
353  sub process_query_only_search {  sub process_query_only_search {
# Line 335  Line 356 
356      my $pattern = $cgi->param('pattern');      my $pattern = $cgi->param('pattern');
357      my $dir     = $cgi->param('dir');      my $dir     = $cgi->param('dir');
358      my $refG    = $cgi->param('reference');      my $refG    = $cgi->param('reference');
359        my $refGgs  = &genus_species($refG);
360      my $queryG  = $cgi->param('genome');      my $queryG  = $cgi->param('genome');
361      my $file    = "$dir/CorrToReferenceGenomes/$refG";      my $file    = "$dir/CorrToReferenceGenomes/$refG";
362      my %in_corr = map { $_ =~ /^(\S+)/; $1 => 1 } `cat $file`;      my %in_corr = map { $_ =~ /^(\S+)/; $1 => 1 } `cat $file`;
# Line 347  Line 369 
369      my @tab          = map { [&peg_link($cgi,$_),$functionsH{$_} ? $functionsH{$_} : ""] }      my @tab          = map { [&peg_link($cgi,$_),$functionsH{$_} ? $functionsH{$_} : ""] }
370                         sort { &SeedUtils::by_fig_id($a,$b) } @to_show;                         sort { &SeedUtils::by_fig_id($a,$b) } @to_show;
371      my $filtered = &filter_tab_entries(\@tab,$pattern);      my $filtered = &filter_tab_entries(\@tab,$pattern);
372      push(@$html,&SeedHTML::make_table($col_hdrs,$filtered,"Genes Missing in Reference Genome"));      if (@$filtered > 0)
373        {
374            push(@$html,&SeedHTML::make_table($col_hdrs,$filtered,"Genes Missing in Reference Genome $refGgs"));
375        }
376        else
377        {
378            push(@$html,$cgi->h2('No Genes Found only in the Given Genome'));
379        }
380  }  }
381    
382  sub process_ref_only_search {  sub process_ref_only_search {
# Line 356  Line 385 
385      my $pattern = $cgi->param('pattern');      my $pattern = $cgi->param('pattern');
386      my $dir     = $cgi->param('dir');      my $dir     = $cgi->param('dir');
387      my $refG    = $cgi->param('reference');      my $refG    = $cgi->param('reference');
388        my $refGgs  = &genus_species($refG);
389    
390      my $queryG  = $cgi->param('genome');      my $queryG  = $cgi->param('genome');
391      my $file    = "$dir/CorrToReferenceGenomes/$refG";      my $file    = "$dir/CorrToReferenceGenomes/$refG";
392    
# Line 370  Line 401 
401      my @tab          = map { [&ref_peg_link($cgi,$_),$functionsH->{$_} ? $functionsH->{$_} : ""] }      my @tab          = map { [&ref_peg_link($cgi,$_),$functionsH->{$_} ? $functionsH->{$_} : ""] }
402                         sort { &SeedUtils::by_fig_id($a,$b) } @to_show;                         sort { &SeedUtils::by_fig_id($a,$b) } @to_show;
403      my $filtered = &filter_tab_entries(\@tab,$pattern);      my $filtered = &filter_tab_entries(\@tab,$pattern);
404      push(@$html,&SeedHTML::make_table($col_hdrs,$filtered,"Genes Present Only in Reference Genome"));      if (@$filtered > 0)
405        {
406            push(@$html,&SeedHTML::make_table($col_hdrs,$filtered,"Genes Present Only in Reference Genome $refGgs"));
407        }
408        else
409        {
410            push(@$html,$cgi->h2('No Genes Found only in $refGgs'));
411        }
412    }
413    
414    sub genus_species {
415        my($g) = @_;
416    
417        my $sapO = SAPserver->new;
418        my $gH   = $sapO->genome_names( -ids => $g);
419        return $gH->{$g};
420  }  }
421    
422  sub process_index {  sub process_index {
# Line 478  Line 524 
524          my($class,$subsys,$role,$variant,$peg) = @$entry;          my($class,$subsys,$role,$variant,$peg) = @$entry;
525          push(@$tab,[          push(@$tab,[
526                      $class,                      $class,
527                      $subsys,                      &fix_ss($subsys),
528                      $role,                      $role,
529                      $variant,                      $variant,
530                      &peg_link($cgi,$peg)                      &peg_link($cgi,$peg)
# Line 509  Line 555 
555    
556      if ($fid !~ /\.peg\./) { return "" }      if ($fid !~ /\.peg\./) { return "" }
557      my $dir = $cgi->param('dir');      my $dir = $cgi->param('dir');
558      return $cgi->url() . "?request=feature&fid=$fid&dir=$dir";      return "$sv_url?page=Annotation;feature=$fid";
559  }  }
560    
561  sub comp_reg_link {  sub comp_reg_link {
# Line 654  Line 700 
700  sub push_compare_regions {  sub push_compare_regions {
701      my($cgi,$html,$fid,$sapObject,$seedV,$contig,$beg,$end) = @_;      my($cgi,$html,$fid,$sapObject,$seedV,$contig,$beg,$end) = @_;
702    
703      my $min = ($beg < $end) ? ($beg - 4000) : $end - 4000;      my $mid = int(($beg+$end)/2);
704      my $max = ($beg < $end) ? ($end + 4000) : $beg + 4000;      my $min = ($beg < $end) ? ($mid - 4000) : $mid - 4000;
705        my $max = ($beg < $end) ? ($mid + 4000) : $mid + 4000;
706    
707      my ($genes,$minV,$maxV) = $seedV->genes_in_region($contig,$min,$max);      my ($genes,$minV,$maxV) = $seedV->genes_in_region($contig,$min,$max);
708      my %genesG = map { ($_ => 1 ) } @$genes;      my %genesG = map { ($_ => 1 ) } @$genes;
709      my %locsG = map { $_ => $seedV->feature_location($_) } @$genes;      my %locsG = map { $_ => $seedV->feature_location($_) } @$genes;
# Line 738  Line 786 
786      my $functionH = &function_hash($sapObject,$seedV,\@map_data);      my $functionH = &function_hash($sapObject,$seedV,\@map_data);
787    
788      my $gg = [];      my $gg = [];
789      my $sz_region = 12000;      my $sz_region = 8500;
790    
791      foreach my $map_set (@map_data)      foreach my $map_set (@map_data)
792      {      {
# Line 753  Line 801 
801              foreach my $entry (@$gene_data)              foreach my $entry (@$gene_data)
802              {              {
803                  my($fid1,$contig1,$beg1,$end1,$color) = @$entry;                  my($fid1,$contig1,$beg1,$end1,$color) = @$entry;
804                  my $beg1 = &in_bounds($min,$max,$beg1);                  $beg1 = &in_bounds($min,$max,$beg1);
805                  my $end1 = &in_bounds($min,$max,$end1);                  $end1 = &in_bounds($min,$max,$end1);
806                  my $function = $functionH->{$fid1};                  my $function = $functionH->{$fid1};
807                  if (! $function) { $function = "hypothetical protein" }                  if (! $function) { $function = "hypothetical protein" }
808                  my $info = join('<br/>', "<b>PEG:</b> $fid1",                  my $info = join('<br/>', "<b>PEG:</b> $fid1",
# Line 774  Line 822 
822                                    ($fid1 !~ /\.bs\./) ? $color : 'black',                                    ($fid1 !~ /\.bs\./) ? $color : 'black',
823                                    undef,,                                    undef,,
824                                    (@$gg == 0) ? &url_to_new($cgi,$fid1) : &url_to_sv($cgi,$fid1),                                    (@$gg == 0) ? &url_to_new($cgi,$fid1) : &url_to_sv($cgi,$fid1),
                                   $function,  
825                                    $info                                    $info
826                                  ];                                  ];
827    
# Line 806  Line 853 
853      {      {
854          push(@gene_data,[$peg1,&split_loc($locs->{$peg1}),$peg1]);          push(@gene_data,[$peg1,&split_loc($locs->{$peg1}),$peg1]);
855      }      }
856      my @gene_data = sort { ($a->[2]+$a->[3]) <=> ($b->[2]+$b->[3]) } @gene_data;      @gene_data = sort { ($a->[2]+$a->[3]) <=> ($b->[2]+$b->[3]) } @gene_data;
857      return [[$peg,&split_loc($locs->{$peg}),$seedV->genus_species],[@gene_data]];      return [[$peg,&split_loc($locs->{$peg}),$seedV->genus_species],[@gene_data]];
858  }  }
859    
# Line 823  Line 870 
870  #       print STDERR &Dumper($peg1,$color->{$peg1}); die "aborted";  #       print STDERR &Dumper($peg1,$color->{$peg1}); die "aborted";
871          push(@gene_data,[$peg1,&split_new_loc($locH1->{$peg1}->[0]),$color->{$peg1}]);          push(@gene_data,[$peg1,&split_new_loc($locH1->{$peg1}->[0]),$color->{$peg1}]);
872      }      }
873      my @gene_data = sort { ($a->[2]+$a->[3]) <=> ($b->[2]+$b->[3]) } @gene_data;      @gene_data = sort { ($a->[2]+$a->[3]) <=> ($b->[2]+$b->[3]) } @gene_data;
874      return [$pinned_data,[@gene_data]];      return [$pinned_data,[@gene_data]];
875  }  }
876    
# Line 955  Line 1002 
1002      }      }
1003  }  }
1004    
1005    sub fix_ss {
1006        my($ss) = @_;
1007    
1008        $ss =~ s/_/ /g;
1009        return $ss;
1010    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3