Bio/Seq/SeqFastaSpeedFactory.pm

   1 #
   2 # BioPerl module for Bio::Seq::SeqFastaSpeedFactory
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason@bioperl.org>
   7 #
   8 # Copyright Jason Stajich
   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::Seq::SeqFastaSpeedFactory - Instantiates a new Bio::PrimarySeqI (or derived class) through a factory
  17
  18 =head1 SYNOPSIS
  19
  20     use Bio::Seq::SeqFastaSpeedFactory;
  21     my $factory = Bio::Seq::SeqFastaSpeedFactory->new();
  22     my $seq = $factory->create(-seq => 'WYRAVLC',
  23                                -id  => 'name');
  24
  25     # If you want the factory to create Bio::Seq objects instead
  26     # of the default Bio::PrimarySeq objects, use the -type parameter:
  27
  28     my $factory = Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq');
  29
  30
  31 =head1 DESCRIPTION
  32
  33 This object will build Bio::Seq objects generically.
  34
  35 =head1 FEEDBACK
  36
  37 =head2 Mailing Lists
  38
  39 User feedback is an integral part of the evolution of this and other
  40 Bioperl modules. Send your comments and suggestions preferably to
  41 the Bioperl mailing list.  Your participation is much appreciated.
  42
  43   bioperl-l@bioperl.org                  - General discussion
  44   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  45
  46 =head2 Support
  47
  48 Please direct usage questions or support issues to the mailing list:
  49
  50 I<bioperl-l@bioperl.org>
  51
  52 rather than to the module maintainer directly. Many experienced and
  53 reponsive experts will be able look at the problem and quickly
  54 address it. Please include a thorough description of the problem
  55 with code and data examples if at all possible.
  56
  57 =head2 Reporting Bugs
  58
  59 Report bugs to the Bioperl bug tracking system to help us keep track
  60 of the bugs and their resolution. Bug reports can be submitted via the
  61 web:
  62
  63   https://redmine.open-bio.org/projects/bioperl/
  64
  65 =head1 AUTHOR - Jason Stajich
  66
  67 Email jason@bioperl.org
  68
  69 =head1 APPENDIX
  70
  71 The rest of the documentation details each of the object methods.
  72 Internal methods are usually preceded with a _
  73
  74 =cut
  75
  76
  77 # Let the code begin...
  78
  79
  80 package Bio::Seq::SeqFastaSpeedFactory;
  81 use strict;
  82
  83 use Bio::Seq;
  84 use Bio::PrimarySeq;
  85
  86 use base qw(Bio::Root::Root Bio::Factory::SequenceFactoryI);
  87
  88 =head2 new
  89
  90  Title   : new
  91  Usage   : my $obj = Bio::Seq::SeqFastaSpeedFactory->new();
  92  Function: Builds a new Bio::Seq::SeqFastaSpeedFactory object
  93  Returns : Bio::Seq::SeqFastaSpeedFactory
  94  Args    : -type => string, name of a PrimarySeqI derived class
  95                     This is optional. Default=Bio::PrimarySeq.
  96
  97 =cut
  98
  99 sub new {
 100   my($class,@args) = @_;
 101   my $self = $class->SUPER::new(@args);
 102   return $self;
 103 }
 104
 105
 106 =head2 create
 107
 108  Title   : create
 109  Usage   : my $seq = $seqbuilder->create(-seq => 'CAGT', -id => 'name');
 110  Function: Instantiates a new Bio::Seq object, correctly built but very
 111            fast, knowing stuff about Bio::PrimarySeq and Bio::Seq
 112  Returns : Bio::Seq
 113
 114  Args    : initialization parameters specific to the type of sequence
 115            object we want.  Typically
 116            -seq        => $str,
 117            -id         => $name
 118
 119 =cut
 120
 121 sub create {
 122     my ($self,@args) = @_;
 123
 124     my %param = @args;
 125     @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
 126
 127     my $sequence = $param{'-seq'};
 128     my $fulldesc = $param{'-desc'};
 129     my $id       = defined $param{'-id'} ? $param{'-id'} : $param{'-primary_id'};
 130     my $alphabet = $param{'-alphabet'};
 131
 132     my $seq = bless {}, "Bio::Seq";
 133     my $t_pseq = $seq->{'primary_seq'} = bless {}, "Bio::PrimarySeq";
 134     $t_pseq->{'seq'}  = $sequence;
 135     $t_pseq->{'desc'} = $fulldesc;
 136     $t_pseq->{'display_id'} = $id;
 137     $t_pseq->{'primary_id'} = $id;
 138     $seq->{'primary_id'} = $id; # currently Bio::Seq does not delegate this
 139     if( $sequence and !$alphabet ) {
 140         $t_pseq->_guess_alphabet();
 141     } elsif ( $sequence and $alphabet ) {
 142         $t_pseq->{'alphabet'} = $alphabet;
 143     }
 144
 145     return $seq;
 146 }
 147
 148 1;
 149