lib/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
  81 use strict;
  82
  83 use Bio::SeqFeature::Generic;
  84 use Bio::Location::Simple;
  85 use Bio::Location::Fuzzy;
  86 use Bio::Location::Split;
  87
  88 use base qw(Bio::Root::Root);
  89
  90 sub new {
  91     my ($class, @args) = @_;
  92
  93     # no chained new because we make lots and lots of these.
  94     my $self = {};
  95     bless $self,$class;
  96     $self->{'_field'} = {};
  97     return $self;
  98 }
  99
 100 =head2 _generic_seqfeature
 101
 102  Title   : _generic_seqfeature
 103  Usage   : $fthelper->_generic_seqfeature($annseq, "GenBank")
 104  Function: processes fthelper into a generic seqfeature
 105  Returns : TRUE on success and otherwise FALSE
 106  Args    : The Bio::Factory::LocationFactoryI object to use for parsing
 107            location strings. The ID (e.g., display_id) of the sequence on which
 108            this feature is located, optionally a string indicating the source
 109            (GenBank/EMBL/SwissProt)
 110
 111 =cut
 112
 113 sub _generic_seqfeature {
 114     my ($fth, $locfac, $seqid, $source) = @_;
 115     my ($sf);
 116
 117     # set a default if not specified
 118     if(! defined($source)) {
 119         $source = "EMBL/GenBank/SwissProt";
 120     }
 121
 122     # initialize feature object
 123     $sf = Bio::SeqFeature::Generic->direct_new();
 124
 125     # parse location; this may cause an exception, in which case we gently
 126     # recover and ignore this feature
 127
 128
 129     my $loc;
 130     eval {
 131         $loc = $locfac->from_string($fth->loc);
 132     };
 133
 134     if(! $loc) {
 135           $fth->warn("exception while parsing location line [" . $fth->loc .
 136                       "] in reading $source, ignoring feature " .
 137                       $fth->key() . " (seqid=" . $seqid . "): " . $@);
 138           return;
 139     }
 140
 141     # set additional location attributes
 142     if($seqid && (! $loc->is_remote())) {
 143         $loc->seq_id($seqid); # propagates if it is a split location
 144     }
 145
 146
 147     # set attributes of feature
 148     $sf->location($loc);
 149     $sf->primary_tag($fth->key);
 150     $sf->source_tag($source);
 151     $sf->seq_id($seqid);
 152     foreach my $key ( keys %{$fth->field} ){
 153         foreach my $value ( @{$fth->field->{$key}} ) {
 154             $sf->add_tag_value($key,$value);
 155         }
 156     }
 157     return $sf;
 158 }
 159
 160
 161 =head2 from_SeqFeature
 162
 163  Title   : from_SeqFeature
 164  Usage   : @fthelperlist = Bio::SeqIO::FTHelper::from_SeqFeature($sf,
 165                                                      $context_annseq);
 166  Function: constructor of fthelpers from SeqFeatures
 167          :
 168          : The additional annseq argument is to allow the building of FTHelper
 169          : lines relevant to particular sequences (ie, when features are spread over
 170          : enteries, knowing how to build this)
 171  Returns : an array of FThelpers
 172  Args    : seq features
 173
 174
 175 =cut
 176
 177 sub from_SeqFeature {
 178   my ($sf, $context_annseq) = @_;
 179   my @ret;
 180
 181   #
 182   # If this object knows how to make FThelpers, then let it
 183   # - this allows us to store *really* weird objects that can write
 184   # themselves to the EMBL/GenBank...
 185   #
 186
 187   if ( $sf->can("to_FTHelper") ) {
 188         return $sf->to_FTHelper($context_annseq);
 189   }
 190
 191   my $fth = Bio::SeqIO::FTHelper->new();
 192   my $key = $sf->primary_tag();
 193   my $locstr = $sf->location->to_FTstring;
 194
 195   # ES 25/06/01 Commented out this code, Jason to double check
 196   #The location FT string for all simple subseqfeatures is already
 197   #in the Split location FT string
 198
 199   # going into sub features
 200   #foreach my $sub ( $sf->sub_SeqFeature() ) {
 201   #my @subfth = &Bio::SeqIO::FTHelper::from_SeqFeature($sub);
 202   #push(@ret, @subfth);
 203   #}
 204
 205   $fth->loc($locstr);
 206   $fth->key($key);
 207   $fth->field->{'note'} = [];
 208
 209   # the lines below take specific tags (e.g. /score=23 ) and re-enter them as
 210   # new tags like /note="score=25" - if the file is round-tripped this creates
 211   # duplicate values
 212
 213   #$sf->source_tag && do { push(@{$fth->field->{'note'}},"source=" . $sf->source_tag ); };
 214
 215   #($sf->can('score') && $sf->score) && do { push(@{$fth->field->{'note'}},
 216   #                                               "score=" . $sf->score ); };
 217
 218   #($sf->can('frame') && $sf->frame) && do { push(@{$fth->field->{'note'}},
 219   #                                               "frame=" . $sf->frame ); };
 220
 221   #$sf->strand && do { push(@{$fth->field->{'note'}},"strand=" . $sf->strand ); };
 222
 223   foreach my $tag ( $sf->get_all_tags ) {
 224     # Tags which begin with underscores are considered
 225     # private, and are therefore not printed
 226     next if $tag =~ /^_/;
 227         if ( !defined $fth->field->{$tag} ) {
 228       $fth->field->{$tag} = [];
 229         }
 230         foreach my $val ( $sf->get_tag_values($tag) ) {
 231       push(@{$fth->field->{$tag}},$val);
 232         }
 233   }
 234   push(@ret, $fth);
 235
 236   unless (@ret) {
 237         $context_annseq->throw("Problem in processing seqfeature $sf - no fthelpers. Error!");
 238   }
 239   foreach my $ft (@ret) {
 240         if ( !$ft->isa('Bio::SeqIO::FTHelper') ) {
 241       $sf->throw("Problem in processing seqfeature $sf - made a $fth!");
 242         }
 243   }
 244
 245   return @ret;
 246 }
 247
 248
 249 =head2 key
 250
 251  Title   : key
 252  Usage   : $obj->key($newval)
 253  Function:
 254  Example :
 255  Returns : value of key
 256  Args    : newvalue (optional)
 257
 258
 259 =cut
 260
 261 sub key {
 262    my ($obj, $value) = @_;
 263    if ( defined $value ) {
 264       $obj->{'key'} = $value;
 265     }
 266     return $obj->{'key'};
 267
 268 }
 269
 270 =head2 loc
 271
 272  Title   : loc
 273  Usage   : $obj->loc($newval)
 274  Function:
 275  Example :
 276  Returns : value of loc
 277  Args    : newvalue (optional)
 278
 279
 280 =cut
 281
 282 sub loc {
 283    my ($obj, $value) = @_;
 284    if ( defined $value ) {
 285       $obj->{'loc'} = $value;
 286     }
 287     return $obj->{'loc'};
 288 }
 289
 290
 291 =head2 field
 292
 293  Title   : field
 294  Usage   :
 295  Function:
 296  Example :
 297  Returns :
 298  Args    :
 299
 300
 301 =cut
 302
 303 sub field {
 304    my ($self) = @_;
 305
 306    return $self->{'_field'};
 307 }
 308
 309 =head2 add_field
 310
 311  Title   : add_field
 312  Usage   :
 313  Function:
 314  Example :
 315  Returns :
 316  Args    :
 317
 318
 319 =cut
 320
 321 sub add_field {
 322    my ($self, $key, $val) = @_;
 323
 324    if ( !exists $self->field->{$key} ) {
 325        $self->field->{$key} = [];
 326    }
 327    push( @{$self->field->{$key}} , $val);
 328
 329 }
 330
 331 1;