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

Diff of /FigWebServices/ss_directed_compare_regions.cgi

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

revision 1.1, Mon Feb 9 18:16:38 2015 UTC revision 1.4, Tue Feb 10 20:15:01 2015 UTC
# Line 1  Line 1 
 ########################################################################  
 use CGI;  
   
   
 if (-f "$FIG_Config::data/Global/why_down")  
 {  
     local $/;  
     open my $fh, "<$FIG_Config::data/Global/why_down";  
     my $down_msg = <$fh>;  
   
     print CGI::header();  
     print CGI::head(CGI::title("SEED Server down"));  
     print CGI::start_body();  
     print CGI::h1("SEED Server down");  
     print CGI::p("The seed server is not currently running:");  
     print CGI::pre($down_msg);  
     print CGI::end_body();  
     exit;  
 }  
   
 if ($FIG_Config::readonly)  
 {  
     CGI::param("user", undef);  
 }  
1  # -*- perl -*-  # -*- perl -*-
2  #  #
3  # Copyright (c) 2003-2008 University of Chicago and Fellowship  # Copyright (c) 2003-2008 University of Chicago and Fellowship
# Line 65  Line 41 
41      exit;      exit;
42  }  }
43    
44  my $subsys = "/vol/core-seed/FIGdisk/FIG/Data/Subsystems";  my $subsys = "$FIG_Config::data/Subsystems";
45    #my $subsys = "/vol/core-seed/FIGdisk/FIG/Data/Subsystems";
46    
47  my $html = [];  my $html = [];
48  unshift @$html, "<TITLE>Subsystem-based compare-regions</TITLE>\n";  unshift @$html, "<TITLE>Subsystem-based compare-regions</TITLE>\n";
# Line 84  Line 61 
61      &HTML::show_page($cgi,$html);      &HTML::show_page($cgi,$html);
62      exit;      exit;
63  }  }
64  my @pegs = &pegs_in_spreadsheet("$subsys/$ss",$abbr);  my @pegs = &pegs_in_spreadsheet("$subsys/$ss",$abbr,$fig);
65    
66  if (@pegs == 0)  if (@pegs == 0)
67  {  {
# Line 95  Line 72 
72    
73  my $number_pegs = $cgi->param('n');  my $number_pegs = $cgi->param('n');
74  if (! $number_pegs) { $number_pegs = 10 }  if (! $number_pegs) { $number_pegs = 10 }
75    push(@$html, "<table>\n");
76  while (@pegs > 0)  while (@pegs > 0)
77  {  {
78      my $sz = (@pegs > $number_pegs) ? $number_pegs : @pegs;      my $sz = (@pegs > $number_pegs) ? $number_pegs : @pegs;
79      my @batch = splice(@pegs,0,$sz);      my @batch = splice(@pegs,0,$sz);
80      my $start_href = &link(\@batch);      my @bpegs = map { $_->[0] } @batch;
81      my $start_link = "<a target=_blank href=$start_href>$batch[0]</a>\n";      my $start_href = &link(\@bpegs);
82      push(@$html,"<br><br>",$start_link,"<br>\n");      my $start_link = "<a target=_blank href=$start_href>$batch[0]->[0]</a><br>\n";
83        #push(@$html,"<br><br>",$start_link,"<br>\n");
84        push(@$html,"<tr><td>",$start_link,"</td><td>$batch[0]->[2]</td></tr>\n");
85    
86        #push(@$html, "<a target=_blank href='$FIG_Config::cgi_url/seedviewer.cgi?page=Annotation&feature=$_->[0]'>$_->[0]</a><br>\n") foreach @batch;
87    
88  }  }
89    push(@$html, "</table>\n");
90    
91  &HTML::show_page($cgi,$html);  &HTML::show_page($cgi,$html);
92    
# Line 110  Line 94 
94      my($pegs) = @_;      my($pegs) = @_;
95    
96      my $features = join('&feature=',@$pegs);      my $features = join('&feature=',@$pegs);
97      return "http://core.theseed.org/FIG/seedviewer.cgi?page=Regions&feature=" . $features;      return "$FIG_Config::cgi_url/seedviewer.cgi?page=Regions&feature=" . $features;
98        #return "http://core.theseed.org/FIG/seedviewer.cgi?page=Regions&feature=" . $features;
99  }  }
100    
101  sub pegs_in_spreadsheet {  sub pegs_in_spreadsheet {
102      my($ssF,$abbr) = @_;      my($ssF,$abbr,$fig) = @_;
103    
104      my $spreadsheet = join("",`cat $ssF/spreadsheet`);      my $spreadsheet = join("",`cat $ssF/spreadsheet`);
105      my($hdrs,undef,$genomes) = split(/\n\/\/\n/,$spreadsheet);      my($hdrs,undef,$genomes) = split(/\n\/\/\n/,$spreadsheet);
# Line 129  Line 114 
114          shift @rows;  # dump variant code          shift @rows;  # dump variant code
115          push(@pegs,map { "fig|$g.peg.$_" } split(/,/,$rows[$i]));          push(@pegs,map { "fig|$g.peg.$_" } split(/,/,$rows[$i]));
116      }      }
117      return @pegs;      @pegs = grep { $fig->is_real_feature($_) } @pegs;
118        my @tuples = map { [$_,$fig->taxonomy_of(&SeedUtils::genome_of($_)),$fig->genus_species(&SeedUtils::genome_of($_))] } @pegs;
119        @tuples = sort { $a->[1] cmp $b->[1] } @tuples;
120        #print STDERR Dumper(\@tuples);
121        #return map { $_->[0] } @tuples;
122        return @tuples;
123  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3