Bio/SeqIO/FTHelper.pm

   1 #
   2 # BioPerl module for Bio::SeqIO::FTHelper
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Ewan Birney <birney@ebi.ac.uk>
   7 #
   8 # Copyright Ewan Birney
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::SeqIO::FTHelper - Helper class for EMBL/Genbank feature tables
  17
  18 =head1 SYNOPSIS
  19
  20 Used by Bio::SeqIO::EMBL,Bio::SeqIO::genbank, and Bio::SeqIO::swiss to
  21 help process the Feature Table
  22
  23 =head1 DESCRIPTION
  24
  25 Represents one particular Feature with the following fields
  26
  27       key - the key of the feature
  28       loc - the location string of the feature
  29       <other fields> - other fields
  30
  31 =head1 FEEDBACK
  32
  33 =head2 Mailing Lists
  34
  35 User feedback is an integral part of the evolution of this and other
  36 Bioperl modules. Send your comments and suggestions preferably to one
  37 of the Bioperl mailing lists.  Your participation is much appreciated.
  38
  39   bioperl-l@bioperl.org                  - General discussion
  40   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  41
  42 =head2 Support
  43
  44 Please direct usage questions or support issues to the mailing list:
  45
  46 I<bioperl-l@bioperl.org>
  47
  48 rather than to the module maintainer directly. Many experienced and
  49 reponsive experts will be able look at the problem and quickly
  50 address it. Please include a thorough description of the problem
  51 with code and data examples if at all possible.
  52
  53 =head2 Reporting Bugs
  54
  55 Report bugs to the Bioperl bug tracking system to help us keep track
  56 the bugs and their resolution.  Bug reports can be submitted via the web:
  57
  58   https://github.com/bioperl/bioperl-live/issues
  59
  60 =head1 AUTHOR - Ewan Birney
  61
  62 Email birney@ebi.ac.uk
  63
  64 =head1 CONTRIBUTORS
  65
  66 Jason Stajich jason@bioperl.org
  67
  68 =head1 APPENDIX
  69
  70 The rest of the documentation details each of the object
  71 methods. Internal methods are usually preceded with a _
  72
  73 =cut
  74
  75
  76 # Let the code begin...
  77
  78
  79 package Bio::SeqIO::FTHelper;
  80 use strict;
  81
  82 use Bio::SeqFeature::Generic;
  83 use Bio::Location::Simple;
  84 use Bio::Location::Fuzzy;
  85 use Bio::Location::Split;
  86
  87 use base qw(Bio::Root::Root);
  88
  89 sub new {
  90     my ($class, @args) = @_;
  91
  92     # no chained new because we make lots and lots of these.
  93     my $self = {};
  94     bless $self,$class;
  95     $self->{'_field'} = {};
  96     return $self;
  97 }
  98
  99 =head2 _generic_seqfeature
 100
 101  Title   : _generic_seqfeature
 102  Usage   : $fthelper->_generic_seqfeature($annseq, "GenBank")
 103  Function: processes fthelper into a generic seqfeature
 104  Returns : TRUE on success and otherwise FALSE
 105  Args    : The Bio::Factory::LocationFactoryI object to use for parsing
 106            location strings. The ID (e.g., display_id) of the sequence on which
 107            this feature is located, optionally a string indicating the source
 108            (GenBank/EMBL/SwissProt)
 109
 110 =cut
 111
 112 sub _generic_seqfeature {
 113     my ($fth, $locfac, $seqid, $source) = @_;
 114     my ($sf);
 115
 116     # set a default if not specified
 117     if(! defined($source)) {
 118         $source = "EMBL/GenBank/SwissProt";
 119     }
 120
 121     # initialize feature object
 122     $sf = Bio::SeqFeature::Generic->direct_new();
 123
 124     # parse location; this may cause an exception, in which case we gently
 125     # recover and ignore this feature
 126
 127
 128     my $loc;
 129     eval {
 130         $loc = $locfac->from_string($fth->loc);
 131     };
 132
 133     if(! $loc) {
 134           $fth->warn("exception while parsing location line [" . $fth->loc .
 135                       "] in reading $source, ignoring feature " .
 136                       $fth->key() . " (seqid=" . $seqid . "): " . $@);
 137           return;
 138     }
 139
 140     # set additional location attributes
 141     if($seqid && (! $loc->is_remote())) {
 142         $loc->seq_id($seqid); # propagates if it is a split location
 143     }
 144
 145
 146     # set attributes of feature
 147     $sf->location($loc);
 148     $sf->primary_tag($fth->key);
 149     $sf->source_tag($source);
 150     $sf->seq_id($seqid);
 151     foreach my $key ( keys %{$fth->field} ){
 152         foreach my $value ( @{$fth->field->{$key}} ) {
 153             $sf->add_tag_value($key,$value);
 154         }
 155     }
 156     return $sf;
 157 }
 158
 159
 160 =head2 from_SeqFeature
 161
 162  Title   : from_SeqFeature
 163  Usage   : @fthelperlist = Bio::SeqIO::FTHelper::from_SeqFeature($sf,
 164                                                      $context_annseq);
 165  Function: constructor of fthelpers from SeqFeatures
 166          :
 167          : The additional annseq argument is to allow the building of FTHelper
 168          : lines relevant to particular sequences (ie, when features are spread over
 169          : enteries, knowing how to build this)
 170  Returns : an array of FThelpers
 171  Args    : seq features
 172
 173
 174 =cut
 175
 176 sub from_SeqFeature {
 177   my ($sf, $context_annseq) = @_;
 178   my @ret;
 179
 180   #
 181   # If this object knows how to make FThelpers, then let it
 182   # - this allows us to store *really* weird objects that can write
 183   # themselves to the EMBL/GenBank...
 184   #
 185
 186   if ( $sf->can("to_FTHelper") ) {
 187         return $sf->to_FTHelper($context_annseq);
 188   }
 189
 190   my $fth = Bio::SeqIO::FTHelper->new();
 191   my $key = $sf->primary_tag();
 192   my $locstr = $sf->location->to_FTstring;
 193
 194   # ES 25/06/01 Commented out this code, Jason to double check
 195   #The location FT string for all simple subseqfeatures is already
 196   #in the Split location FT string
 197
 198   # going into sub features
 199   #foreach my $sub ( $sf->sub_SeqFeature() ) {
 200   #my @subfth = &Bio::SeqIO::FTHelper::from_SeqFeature($sub);
 201   #push(@ret, @subfth);
 202   #}
 203
 204   $fth->loc($locstr);
 205   $fth->key($key);
 206   $fth->field->{'note'} = [];
 207
 208   # the lines below take specific tags (e.g. /score=23 ) and re-enter them as
 209   # new tags like /note="score=25" - if the file is round-tripped this creates
 210   # duplicate values
 211
 212   #$sf->source_tag && do { push(@{$fth->field->{'note'}},"source=" . $sf->source_tag ); };
 213
 214   #($sf->can('score') && $sf->score) && do { push(@{$fth->field->{'note'}},
 215   #                                               "score=" . $sf->score ); };
 216
 217   #($sf->can('frame') && $sf->frame) && do { push(@{$fth->field->{'note'}},
 218   #                                               "frame=" . $sf->frame ); };
 219
 220   #$sf->strand && do { push(@{$fth->field->{'note'}},"strand=" . $sf->strand ); };
 221
 222   foreach my $tag ( $sf->get_all_tags ) {
 223     # Tags which begin with underscores are considered
 224     # private, and are therefore not printed
 225     next if $tag =~ /^_/;
 226         if ( !defined $fth->field->{$tag} ) {
 227       $fth->field->{$tag} = [];
 228         }
 229         foreach my $val ( $sf->get_tag_values($tag) ) {
 230       push(@{$fth->field->{$tag}},$val);
 231         }
 232   }
 233   push(@ret, $fth);
 234
 235   unless (@ret) {
 236         $context_annseq->throw("Problem in processing seqfeature $sf - no fthelpers. Error!");
 237   }
 238   foreach my $ft (@ret) {
 239         if ( !$ft->isa('Bio::SeqIO::FTHelper') ) {
 240       $sf->throw("Problem in processing seqfeature $sf - made a $fth!");
 241         }
 242   }
 243
 244   return @ret;
 245 }
 246
 247
 248 =head2 key
 249
 250  Title   : key
 251  Usage   : $obj->key($newval)
 252  Function:
 253  Example :
 254  Returns : value of key
 255  Args    : newvalue (optional)
 256
 257
 258 =cut
 259
 260 sub key {
 261    my ($obj, $value) = @_;
 262    if ( defined $value ) {
 263       $obj->{'key'} = $value;
 264     }
 265     return $obj->{'key'};
 266
 267 }
 268
 269 =head2 loc
 270
 271  Title   : loc
 272  Usage   : $obj->loc($newval)
 273  Function:
 274  Example :
 275  Returns : value of loc
 276  Args    : newvalue (optional)
 277
 278
 279 =cut
 280
 281 sub loc {
 282    my ($obj, $value) = @_;
 283    if ( defined $value ) {
 284       $obj->{'loc'} = $value;
 285     }
 286     return $obj->{'loc'};
 287 }
 288
 289
 290 =head2 field
 291
 292  Title   : field
 293  Usage   :
 294  Function:
 295  Example :
 296  Returns :
 297  Args    :
 298
 299
 300 =cut
 301
 302 sub field {
 303    my ($self) = @_;
 304
 305    return $self->{'_field'};
 306 }
 307
 308 =head2 add_field
 309
 310  Title   : add_field
 311  Usage   :
 312  Function:
 313  Example :
 314  Returns :
 315  Args    :
 316
 317
 318 =cut
 319
 320 sub add_field {
 321    my ($self, $key, $val) = @_;
 322
 323    if ( !exists $self->field->{$key} ) {
 324        $self->field->{$key} = [];
 325    }
 326    push( @{$self->field->{$key}} , $val);
 327
 328 }
 329
 330 1;