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

Diff of /FigWebServices/ss_export.cgi

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

revision 1.1, Wed May 26 22:32:15 2004 UTC revision 1.7, Tue Jun 8 18:16:40 2004 UTC
# Line 54  Line 54 
54      chdir($tmp);      chdir($tmp);
55    
56      #      #
57        # Write a README with the mapping from genome and role index to name.
58        #
59    
60        open(my $rfh, ">README");
61    
62        print $rfh "Roles\n";
63        for my $role (@roles)
64        {
65            my $name = $sub->get_role($role);
66            my $abbr = $sub->get_role_abbr($role);
67    
68            print $rfh "$role\t$abbr\t$name\n";
69        }
70    
71        print $rfh "\n";
72    
73        print $rfh "Genomes\n";
74    
75        for my $g (@genomes)
76        {
77            my $gname = $sub->get_genome($g);
78            my $gs = $fig->genus_species($gname);
79    
80            print $rfh "$g\t$gname\t$gs\n";
81        }
82        close($rfh);
83    
84        #
85      # Write the role exports.      # Write the role exports.
86      #      #
87    
88      for my $role (@roles)      for my $role (@roles)
89      {      {
90          my $file = "role_$role.fasta";          my $file = "role_$role.dna.fasta";
91            my $protfile = "role_$role.prot.fasta";
92          open(my $fh, ">$file");          open(my $fh, ">$file");
93            open(my $protfh, ">$protfile");
94          for my $g (@genomes)          for my $g (@genomes)
95          {          {
96              my $gname = $sub->get_genome($g);              my $gname = $sub->get_genome($g);
# Line 69  Line 99 
99              {              {
100                  for my $peg (@$entry)                  for my $peg (@$entry)
101                  {                  {
102                        my $pegname = $peg;
103                        $pegname =~ s/^fig\|//;
104                        $pegname =~ s/\.peg\././;
105    
106                      my @location = $fig->feature_location($peg);                      my @location = $fig->feature_location($peg);
107                      if (@location > 0)                      if (@location > 0)
108                      {                      {
109                          my $seq = $fig->dna_seq($gname, @location);                          my $seq = $fig->dna_seq($gname, @location);
110                          &FIG::display_id_and_seq($peg, \$seq, $fh);                          if ($seq ne "")
111                            {
112                                &FIG::display_id_and_seq($pegname, \$seq, $fh);
113                            }
114                        }
115                        my $seq = $fig->get_translation($peg);
116                        if ($seq ne "")
117                        {
118                            &FIG::display_id_and_seq($pegname, \$seq, $protfh);
119                      }                      }
120                  }                  }
121              }              }
122          }          }
123          close($fh);          close($fh);
124            close($protfh);
125      }      }
126    
127      #      #
# Line 86  Line 129 
129      # all-sequences file.      # all-sequences file.
130      #      #
131    
132      open(my $all_fh, ">all.fasta");      open(my $all_fh, ">all.dna.fasta");
133        open(my $allprot_fh, ">all.prot.fasta");
134        my $catfile = "all.prot.cat.fasta";
135        open(my $catfh, ">$catfile");
136    
137      for my $g (@genomes)      for my $g (@genomes)
138      {      {
139          my $gname = $sub->get_genome($g);          my $gname = $sub->get_genome($g);
140          my $file = "genome_$g.fasta";          my $file = "genome_$g.dna.fasta";
141            my $protfile = "genome_$g.prot.fasta";
142    
143          open(my $fh, ">$file");          open(my $fh, ">$file");
144            open(my $protfh, ">$protfile");
145            print $catfh ">$gname/" . $fig->genus_species($gname) . "\n";
146          for my $role (@roles)          for my $role (@roles)
147          {          {
148              my $entry = $sub->get_cell($g, $role);              my $entry = $sub->get_cell($g, $role);
# Line 101  Line 150 
150              {              {
151                  for my $peg (@$entry)                  for my $peg (@$entry)
152                  {                  {
153                        my $pegname = $peg;
154                        $pegname =~ s/^fig\|//;
155                        $pegname =~ s/\.peg\././;
156                      my @location = $fig->feature_location($peg);                      my @location = $fig->feature_location($peg);
157                      if (@location > 0)                      if (@location > 0)
158                      {                      {
159                          my $seq = $fig->dna_seq($gname, @location);                          my $seq = $fig->dna_seq($gname, @location);
160                          &FIG::display_id_and_seq($peg, \$seq, $fh);                          if ($seq ne "")
161                          &FIG::display_id_and_seq($peg, \$seq, $all_fh);                          {
162                                &FIG::display_id_and_seq($pegname, \$seq, $fh);
163                                &FIG::display_id_and_seq($pegname, \$seq, $all_fh);
164                            }
165                        }
166                        my $seq = $fig->get_translation($peg);
167                        if ($seq ne "")
168                        {
169                            &FIG::display_id_and_seq($pegname, \$seq, $protfh);
170                            &FIG::display_id_and_seq($pegname, \$seq, $allprot_fh);
171                            &FIG::display_seq(\$seq, $catfh);
172                      }                      }
173                  }                  }
174              }              }
175          }          }
176          close($fh);          close($fh);
177            close($protfh);
178      }      }
179        close($catfh);
180      close($all_fh);      close($all_fh);
181        close($allprot_fh);
182    
183        my $outname = "$subsystem.$$.tar.gz";
184        $outname =~ s/[^\w.-]/_/g;
185    
186        system("tar czf ../$outname .");
187        my $size = (stat("../$outname"))[7];
188    
 #    print "Content-Type: application/x-tar\n";  
     print "Content-Disposition:attachment;filename=$subsystem.tar.gz\n";  
189      print "Content-Type: application/octet-stream\n";      print "Content-Type: application/octet-stream\n";
190      #    print "Content-Encoding: x-gzip\n";      print "Content-Length: $size\n";
191        print "Content-Disposition:attachment;filename=$outname\n";
192      print "\n";      print "\n";
193      system("tar czf - .");  
194        my $buf;
195        open(my $myout, "<../$outname");
196        while (read($myout, $buf, 4096))
197        {
198            print $buf;
199        }
200        close($myout);
201    
202      chdir("..");      chdir("..");
203      system("rm -r $tmp");      system("rm -r $tmp $outname");
204    
205      exit;      exit;
206  }  }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3