[Bio] / FigKernelPackages / RAST_submission.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/RAST_submission.pm

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

revision 1.14, Mon Nov 23 20:38:04 2009 UTC revision 1.15, Fri Dec 4 18:24:36 2009 UTC
# Line 75  Line 75 
75  {  {
76      my($self, $params) = @_;      my($self, $params) = @_;
77    
78    #     my $fh_log;
79    #     open($fh_log, q(>>/home/rastcode/Tmp/server.log))
80    #       || warn qq(Could not open logfile);
81    #     print $fh_log (qq(----------------------------------------\n), Dumper($params));
82    
83      my $id_list = $params->{-id};      my $id_list = $params->{-id};
84      if (!ref($id_list))      if (!ref($id_list))
85      {      {
# Line 87  Line 92 
92          my $ent = { id => $id };          my $ent = { id => $id };
93    
94          my $file = $self->retrieve_contig_data($id);          my $file = $self->retrieve_contig_data($id);
95    #       print $fh_log qq(id=$id,\tfile=$file\n);
96    
97          open(F, "<", $file);          open(F, "<", $file);
98    
99          my $txt = <F>;          my $txt = <F>;
100          my $cur_section;          my $cur_section    = q();
101          my $cur_subsection;          my $cur_subsection = q();
102          if ($txt =~ /^LOCUS.*?(\d+)\s+bp/)          if ($txt =~ /^LOCUS.*?(\d+)\s+bp/)
103          {          {
104              $ent->{length} = $1;              $ent->{length} = $1;
# Line 102  Line 108 
108          my @sources;          my @sources;
109          $_ = <F>;          $_ = <F>;
110          $txt .= $_;          $txt .= $_;
111            my @wgs = ();
112    #       my @wgs_scafld = ();   #...For now, we will not handle scaffolds....
113          while (defined($_))          while (defined($_))
114          {          {
115    #           print $fh_log ($., qq(:\t), $_);
116    
117                if (m{//\n}) {
118    #               print $fh_log qq(Found end of file\n);
119    
120                    if (@wgs) {
121                        $txt = q();
122                        push @$id_list, @wgs;
123                    }
124    
125                    last;
126                }
127    
128              if (/^(\S+)/)              if (/^(\S+)/)
129              {              {
130                  $cur_section = $1;                  $cur_section = $1;
131                  undef $cur_subsection;                  undef $cur_subsection;
132    #               print $fh_log qq(cur_section=$cur_section\n);
133                }
134    
135                if ($cur_section =~ m/^(WGS\S*)/) {
136    #               print $fh_log qq(Found $1\n);
137                    my $trouble = 0;
138    
139                    #++++++++++++++++++++++++++++++++++++++++++++++++++
140                    #... Assume a simple range of accession-IDs
141                    # (NOTE: this may not be a valid assumption!)
142                    #--------------------------------------------------
143                    my ($prefix, $first_num, $last_num);
144                    if ($_ =~ m/^WGS\s+([^-]+)\-(\S+)/) {
145                        my ($first_acc, $last_acc) = ($1, $2);
146    #                   print $fh_log qq(first_acc=$first_acc,\tlast_acc=$last_acc\n);
147    
148                        if ($first_acc =~ m/^(\D+)(\d+)$/) {
149                            ($prefix, $first_num) = ($1, $2);
150                        }
151                        else {
152                            $trouble = 1;
153                            warn qq(In WGS accession $id, could not parse first accession $first_acc\n);
154                        }
155    
156                        if ($last_acc =~ m/^(\D+)(\d+)$/) {
157                            if ($1 ne $prefix) {
158                                $trouble = 1;
159                                warn qq(In WGS accession $id, first accession $first_acc and last accession $last_acc have differing prefixes\n);
160                            }
161                            else {
162                                $last_num = $2;
163                            }
164                        }
165                        else {
166                            $trouble = 1;
167                            warn qq(In WGS accession $id, could not parse first accession $last_acc\n);
168                        }
169    
170                        if ($trouble) {
171                            warn qq(Could not handle WGS accession $id --- skipping\n);
172                        }
173                        else {
174                            if ($cur_section eq q(WGS)) {
175                                push @wgs, map { $prefix.$_ } ($first_num..$last_num);
176                            }
177    #                       elsif ($cur_section eq q(WGS_SCAFLD)) {
178    #                           @wgs = ();
179    #                           push @wgs_scafld, map { $prefix.$_ } ($first_num..$last_num);
180    #                       }
181    #                       else {
182    #                           print $fh_log qq(Something is wrong, in WGS section --- skipping\n);
183    #                           next;
184    #                       }
185                        }
186                    }
187              }              }
188    
189              if ($cur_section eq 'SOURCE' && /^\s+ORGANISM\s+(.*)/)              if ($cur_section eq 'SOURCE' && /^\s+ORGANISM\s+(.*)/)
# Line 134  Line 210 
210                      $_ = <F>;                      $_ = <F>;
211                      $txt .= $_;                      $txt .= $_;
212                      chomp;                      chomp;
213                      while (defined($_))                      while (defined($_) && m/^\s/)
214                      {                      {
215                          if (m,^ {5}\S,)                          if (m,^ {5}\S,)
216                          {                          {
# Line 161  Line 237 
237              $_ = <F>;              $_ = <F>;
238              $txt .= $_;              $txt .= $_;
239          }          }
240    
241            if ($txt) {
242          $ent->{contents} = $txt;          $ent->{contents} = $txt;
243            }
244            else {
245                #... $txt was cleared because entry is a WGS wrapper
246                next;
247            }
248    
249          #          #
250          # Determine the taxonomy id. If one of the sources in the source list          # Determine the taxonomy id. If one of the sources in the source list

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3