Bio/SeqIO/FTHelper.pm

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