Bio/SeqIO/kegg.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::SeqIO::kegg
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Allen Day <allenday@ucla.edu>
   8 #
   9 # Copyright Allen Day
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12
  13 # POD documentation - main docs before the code
  14
  15 =head1 NAME
  16
  17 Bio::SeqIO::kegg - KEGG sequence input/output stream
  18
  19 =head1 SYNOPSIS
  20
  21   # It is probably best not to use this object directly, but
  22   # rather go through the SeqIO handler system. Go:
  23
  24   use Bio::SeqIO;
  25
  26   $stream = Bio::SeqIO->new(-file => $filename, -format => 'KEGG');
  27
  28   while ( my $seq = $stream->next_seq() ) {
  29         # do something with $seq
  30   }
  31
  32 =head1 DESCRIPTION
  33
  34 This class transforms KEGG gene records into Bio::Seq objects.
  35
  36 =head2 Mapping of record properties to object properties
  37
  38 This section is supposed to document which sections and properties of
  39 a KEGG databank record end up where in the Bioperl object model. It
  40 is far from complete and presently focuses only on those mappings
  41 which may be non-obvious. $seq in the text refers to the
  42 Bio::Seq::RichSeqI implementing object returned by the parser for each
  43 record.
  44
  45 =over 4
  46
  47 =item 'ENTRY'
  48
  49  $seq->primary_id
  50
  51 =item 'NAME'
  52
  53  $seq->display_id
  54
  55 =item 'DEFINITION'
  56
  57  $seq->annotation->get_Annotations('description');
  58
  59 =item 'ORTHOLOG'
  60
  61  grep {$_->database eq 'KO'} $seq->annotation->get_Annotations('dblink')
  62
  63 =item 'CLASS'
  64
  65  grep {$_->database eq 'PATH'}
  66           $seq->annotation->get_Annotations('dblink')
  67
  68 =item 'POSITION'
  69
  70 FIXME, NOT IMPLEMENTED
  71
  72 =item 'PATHWAY'
  73
  74  for my $pathway ( $seq->annotation->get_Annotations('pathway') ) {
  75     #
  76  }
  77
  78 =item 'DBLINKS'
  79
  80  $seq->annotation->get_Annotations('dblink')
  81
  82 =item 'CODON_USAGE'
  83
  84 FIXME, NOT IMPLEMENTED
  85
  86 =item 'AASEQ'
  87
  88  $seq->translate->seq
  89
  90 =item 'NTSEQ'
  91
  92  $seq-E<gt>seq
  93
  94 =back
  95
  96 =head1 FEEDBACK
  97
  98 =head2 Mailing Lists
  99
 100 User feedback is an integral part of the evolution of this and other
 101 Bioperl modules. Send your comments and suggestions preferably to one
 102 of the Bioperl mailing lists.  Your participation is much appreciated.
 103
 104   bioperl-l@bioperl.org                  - General discussion
 105   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 106
 107 =head2 Support
 108
 109 Please direct usage questions or support issues to the mailing list:
 110
 111 L<bioperl-l@bioperl.org>
 112
 113 rather than to the module maintainer directly. Many experienced and
 114 reponsive experts will be able look at the problem and quickly
 115 address it. Please include a thorough description of the problem
 116 with code and data examples if at all possible.
 117
 118 =head2 Reporting Bugs
 119
 120 Report bugs to the Bioperl bug tracking system to help us keep track
 121 the bugs and their resolution. Bug reports can be submitted via the web:
 122
 123   http://bugzilla.open-bio.org/
 124
 125 =head1 AUTHOR - Allen Day
 126
 127 Email allenday@ucla.edu
 128
 129 =head1 APPENDIX
 130
 131 The rest of the documentation details each of the object
 132 methods. Internal methods are usually preceded with a _
 133
 134 =cut
 135
 136 # Let the code begin...
 137
 138 package Bio::SeqIO::kegg;
 139 use strict;
 140
 141 use Bio::SeqFeature::Generic;
 142 use Bio::Species;
 143 use Bio::Seq::SeqFactory;
 144 use Bio::Annotation::Collection;
 145 use Bio::Annotation::Comment;
 146 use Bio::Annotation::DBLink;
 147
 148 use base qw(Bio::SeqIO);
 149
 150 sub _initialize {
 151         my($self,@args) = @_;
 152
 153         $self->SUPER::_initialize(@args);
 154         # hash for functions for decoding keys.
 155         $self->{'_func_ftunit_hash'} = {};
 156         if( ! defined $self->sequence_factory ) {
 157                 $self->sequence_factory(Bio::Seq::SeqFactory->new
 158                                                                                 (-verbose => $self->verbose(),
 159                                                                                  -type => 'Bio::Seq::RichSeq'));
 160         }
 161 }
 162
 163 =head2 next_seq
 164
 165  Title   : next_seq
 166  Usage   : $seq = $stream->next_seq()
 167  Function: returns the next sequence in the stream
 168  Returns : Bio::Seq::RichSeq object
 169  Args    :
 170
 171 =cut
 172
 173 sub next_seq {
 174         my ($self,@args) = @_;
 175         my $builder = $self->sequence_builder();
 176         my $seq;
 177         my %params;
 178
 179         my $buffer;
 180         my (@acc, @features);
 181         my ($display_id, $annotation);
 182         my $species;
 183
 184         # initialize; we may come here because of starting over
 185         @features = ();
 186         $annotation = undef;
 187         @acc = ();
 188         $species = undef;
 189         %params = (-verbose => $self->verbose); # reset hash
 190         local($/) = "///\n";
 191
 192         $buffer = $self->_readline();
 193
 194         return if( !defined $buffer ); # end of file
 195         $buffer =~ /^ENTRY/ ||
 196           $self->throw("KEGG stream with bad ENTRY line. Not KEGG in my book. Got $buffer'");
 197
 198         my %FIELDS;
 199         my @chunks = split /\n(?=\S)/, $buffer;
 200
 201         foreach my $chunk (@chunks){
 202                 my($key) = $chunk =~ /^(\S+)/;
 203                 $FIELDS{$key} = $chunk;
 204         }
 205
 206         # changing to split method to get entry_ids that include
 207         # sequence version like Whatever.1
 208         my(undef,$entry_id,$entry_seqtype,$entry_species) =
 209           split(' ',$FIELDS{ENTRY});
 210
 211         my($name);
 212         if ($FIELDS{NAME}) {
 213           ($name) = $FIELDS{NAME} =~ /^NAME\s+(.+)$/;
 214         }
 215
 216         my( $definition, $aa_length, $aa_seq, $nt_length, $nt_seq );
 217
 218         if(( exists $FIELDS{DEFINITION} ) and ( $FIELDS{DEFINITION} =~ /^DEFINITION/ )) {
 219           ($definition) = $FIELDS{DEFINITION} =~ /^DEFINITION\s+(.+)$/s;
 220           $definition =~ s/\s+/ /gs;
 221         }
 222         if(( exists $FIELDS{AASEQ} ) and ( $FIELDS{AASEQ} =~ /^AASEQ/ )) {
 223           ($aa_length,$aa_seq) = $FIELDS{AASEQ} =~ /^AASEQ\s+(\d+)\n(.+)$/s;
 224           $aa_seq =~ s/\s+//g;
 225         }
 226         if(( exists  $FIELDS{NTSEQ} ) and ( $FIELDS{NTSEQ} =~ /^NTSEQ/ )) {
 227           ($nt_length,$nt_seq) = $FIELDS{NTSEQ} =~ /^NTSEQ\s+(\d+)\n(.+)$/s;
 228           $nt_seq =~ s/\s+//g;
 229         }
 230
 231         $annotation = Bio::Annotation::Collection->new();
 232
 233         $annotation->add_Annotation('description',
 234                                                 Bio::Annotation::Comment->new(-text => $definition));
 235
 236         $annotation->add_Annotation('aa_seq',
 237                                                 Bio::Annotation::Comment->new(-text => $aa_seq));
 238
 239         my($ortholog_db,$ortholog_id,$ortholog_desc);
 240         if ($FIELDS{ORTHOLOG}) {
 241                 ($ortholog_db,$ortholog_id,$ortholog_desc) = $FIELDS{ORTHOLOG}
 242                   =~ /^ORTHOLOG\s+(\S+):\s+(\S+)\s+(.*?)$/;
 243
 244         $annotation->add_Annotation('dblink',Bio::Annotation::DBLink->new(
 245                      -database => $ortholog_db,
 246                      -primary_id => $ortholog_id,
 247                      -comment => $ortholog_desc) );
 248   }
 249
 250   if($FIELDS{MOTIF}){
 251      $FIELDS{MOTIF} =~ s/^MOTIF\s+//;
 252      while($FIELDS{MOTIF} =~/\s*?(\S+):\s+(.+?)$/mg){
 253          my $db = $1;
 254          my $ids = $2;
 255          foreach my $id (split(/\s+/, $ids)){
 256
 257      $annotation->add_Annotation('dblink',Bio::Annotation::DBLink->new(
 258               -database =>$db,
 259               -primary_id => $id,
 260               -comment => "")   );
 261         }
 262      }
 263   }
 264
 265   if($FIELDS{PATHWAY}) {
 266      $FIELDS{PATHWAY} =~ s/^PATHWAY\s+//;
 267      while($FIELDS{PATHWAY} =~ /\s*PATH:\s+(.+)$/mg){
 268         $annotation->add_Annotation('pathway',
 269            Bio::Annotation::Comment->new(-text => "$1"));
 270      }
 271   }
 272
 273   if($FIELDS{POSITION}) {
 274     $FIELDS{POSITION} =~ s/^POSITION\s+//;
 275     $annotation->add_Annotation('position',
 276       Bio::Annotation::Comment->new(-text => $FIELDS{POSITION}));
 277   }
 278
 279   if ($FIELDS{CLASS}) {
 280       $FIELDS{CLASS} =~ s/^CLASS\s+//;
 281       $FIELDS{'CLASS'} =~ s/\n//g;
 282       while($FIELDS{CLASS} =~ /(.*?)\[(\S+):(\S+)\]/g){
 283           my ($pathway,$db,$id) = ($1,$2,$3);
 284           $pathway =~ s/\s+/ /g;
 285           $pathway =~ s/\s$//g;
 286           $pathway =~ s/^\s+//;
 287           $annotation->add_Annotation('pathway',
 288                   Bio::Annotation::Comment->new(-text => $pathway));
 289
 290           $annotation->add_Annotation('dblink',Bio::Annotation::DBLink->new(
 291                       -database => $db, -primary_id => $id));
 292       }
 293   }
 294
 295   if($FIELDS{DBLINKS}) {
 296       $FIELDS{DBLINKS} =~ s/^DBLINKS/       /;
 297       while($FIELDS{DBLINKS} =~ /\s+(\S+):\s+(\S+)\n?/gs){ ### modified
 298            $annotation->add_Annotation('dblink',Bio::Annotation::DBLink->new(
 299                     -database => $1, -primary_id => $2)) if $1;
 300       }
 301   }
 302
 303   $params{'-alphabet'}         = 'dna';
 304   $params{'-seq'}              = $nt_seq;
 305   $params{'-display_id'}       = $name;
 306   $params{'-accession_number'} = $entry_id;
 307   $params{'-species'}          = Bio::Species->new(
 308                                                                                           -common_name => $entry_species);
 309   $params{'-annotation'}       = $annotation;
 310
 311   $builder->add_slot_value(%params);
 312   $seq = $builder->make_object();
 313
 314   return $seq;
 315 }
 316
 317 =head2 write_seq
 318
 319  Title   : write_seq
 320  Note    : write_seq() is not implemented for KEGG format output.
 321
 322 =cut
 323
 324 sub write_seq {
 325     shift->throw("write_seq() not implemented for KEGG format output.");
 326 }
 327
 328 1;