Bio/Tools/EPCR.pm

   1 #
   2 # BioPerl module for Bio::Tools::EPCR
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-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::Tools::EPCR - Parse ePCR output and make features
  17
  18 =head1 SYNOPSIS
  19
  20     # A simple annotation pipeline wrapper for ePCR data
  21     # assuming ePCR data is already generated in file seq1.epcr
  22     # and sequence data is in fasta format in file called seq1.fa
  23
  24     use Bio::Tools::EPCR;
  25     use Bio::SeqIO;
  26     my $parser = Bio::Tools::EPCR->new(-file => 'seq1.epcr');
  27     my $seqio = Bio::SeqIO->new(-format => 'fasta', -file => 'seq1.fa');
  28     my $seq = $seqio->next_seq || die("cannot get a seq object from SeqIO");
  29
  30     while( my $feat = $parser->next_feature ) {
  31         # add EPCR annotation to a sequence
  32         $seq->add_SeqFeature($feat);
  33     }
  34     my $seqout = Bio::SeqIO->new(-format => 'embl');
  35     $seqout->write_seq($seq);
  36
  37
  38 =head1 DESCRIPTION
  39
  40 This object serves as a parser for ePCR data, creating a
  41 Bio::SeqFeatureI for each ePCR hit.  These can be processed or added
  42 as annotation to an existing Bio::SeqI object for the purposes of
  43 automated annotation.
  44
  45 =head1 FEEDBACK
  46
  47 =head2 Mailing Lists
  48
  49 User feedback is an integral part of the evolution of this and other
  50 Bioperl modules. Send your comments and suggestions preferably to
  51 the Bioperl mailing list.  Your participation is much appreciated.
  52
  53   bioperl-l@bioperl.org                  - General discussion
  54   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  55
  56 =head2 Support
  57
  58 Please direct usage questions or support issues to the mailing list:
  59
  60 I<bioperl-l@bioperl.org>
  61
  62 rather than to the module maintainer directly. Many experienced and
  63 reponsive experts will be able look at the problem and quickly
  64 address it. Please include a thorough description of the problem
  65 with code and data examples if at all possible.
  66
  67 =head2 Reporting Bugs
  68
  69 Report bugs to the Bioperl bug tracking system to help us keep track
  70 of the bugs and their resolution. Bug reports can be submitted via the
  71 web:
  72
  73   https://github.com/bioperl/bioperl-live/issues
  74
  75 =head1 AUTHOR - Jason Stajich
  76
  77 Email jason-at-bioperl.org
  78
  79 =head1 APPENDIX
  80
  81 The rest of the documentation details each of the object methods.
  82 Internal methods are usually preceded with a _
  83
  84 =cut
  85
  86
  87 # Let the code begin...
  88
  89
  90 package Bio::Tools::EPCR;
  91 use strict;
  92
  93 use Bio::SeqFeature::FeaturePair;
  94 use Bio::SeqFeature::Generic;
  95
  96 use base qw(Bio::Root::Root Bio::SeqAnalysisParserI Bio::Root::IO);
  97
  98 =head2 new
  99
 100  Title   : new
 101  Usage   : my $epcr = Bio::Tools::EPCR->new(-file => $file,
 102                                            -primary => $fprimary,
 103                                            -source => $fsource,
 104                                            -groupclass => $fgroupclass);
 105  Function: Initializes a new EPCR parser
 106  Returns : Bio::Tools::EPCR
 107  Args    : -fh   => filehandle
 108            OR
 109            -file => filename
 110
 111            -primary => a string to be used as the common value for
 112                        each features '-primary' tag.  Defaults to
 113                        'sts'.  (This in turn maps to the GFF 'type'
 114                        tag (aka 'method')).
 115
 116             -source => a string to be used as the common value for
 117                        each features '-source' tag.  Defaults to
 118                        'e-PCR'. (This in turn maps to the GFF 'source'
 119                        tag)
 120
 121              -groupclass => a string to be used as the name of the tag
 122                            which will hold the sts marker namefirst
 123                            attribute.  Defaults to 'name'.
 124
 125 =cut
 126
 127 sub new {
 128   my($class,@args) = @_;
 129
 130   my $self = $class->SUPER::new(@args);
 131   my ($primary, $source,
 132       $groupclass) = $self->_rearrange([qw(PRIMARY
 133                                            SOURCE
 134                                            GROUPCLASS)],@args);
 135   $self->primary(defined $primary ? $primary : 'sts');
 136   $self->source(defined $source ? $source : 'e-PCR');
 137   $self->groupclass(defined $groupclass ? $groupclass : 'name');
 138
 139   $self->_initialize_io(@args);
 140   return $self;
 141 }
 142
 143 =head2 next_feature
 144
 145  Title   : next_feature
 146  Usage   : $seqfeature = $obj->next_feature();
 147  Function: Returns the next feature available in the analysis result, or
 148            undef if there are no more features.
 149  Example :
 150  Returns : A Bio::SeqFeatureI implementing object, or undef if there are no
 151            more features.
 152  Args    : none
 153
 154 =cut
 155
 156 sub next_feature {
 157     my ($self) = @_;
 158     my $line = $self->_readline;
 159     return unless defined($line);
 160     chomp($line);
 161     my($seqname,$location,$mkrname, $rest) = split(/\s+/,$line,4);
 162
 163     my ($start,$end) = ($location =~ /(\S+)\.\.(\S+)/);
 164
 165     # `e-PCR -direct` results code match strand in $rest as (+) and (-).  Decode it if present.
 166     my $strandsign;
 167     if ($rest =~ m/^\(([+-])\)(.*)$/) {
 168       ($strandsign,$rest) = ($1, $2);
 169     } else {
 170       $strandsign = "?";
 171     }
 172     my $strand = $strandsign eq "+" ? 1 :  $strandsign eq "-" ? -1 : 0;
 173
 174     my $markerfeature = Bio::SeqFeature::Generic->new
 175         ( '-start'   => $start,
 176           '-end'     => $end,
 177           '-strand'  => $strand,
 178           '-source'  => $self->source,
 179           '-primary' => $self->primary,
 180           '-seq_id'  => $seqname,
 181           '-tag'     => {
 182               $self->groupclass => $mkrname,
 183               ($rest ? ('Note'            => $rest ) : ()),
 184           });
 185     #$markerfeature->add_tag_value('Note', $rest) if defined $rest;
 186     return $markerfeature;
 187 }
 188
 189 =head2 source
 190
 191  Title   : source
 192  Usage   : $obj->source($newval)
 193  Function:
 194  Example :
 195  Returns : value of source (a scalar)
 196  Args    : on set, new value (a scalar or undef, optional)
 197
 198
 199 =cut
 200
 201 sub source{
 202     my $self = shift;
 203     return $self->{'_source'} = shift if @_;
 204     return $self->{'_source'};
 205 }
 206
 207 =head2 primary
 208
 209  Title   : primary
 210  Usage   : $obj->primary($newval)
 211  Function:
 212  Example :
 213  Returns : value of primary (a scalar)
 214  Args    : on set, new value (a scalar or undef, optional)
 215
 216
 217 =cut
 218
 219 sub primary{
 220     my $self = shift;
 221     return $self->{'_primary'} = shift if @_;
 222     return $self->{'_primary'};
 223 }
 224
 225 =head2 groupclass
 226
 227  Title   : groupclass
 228  Usage   : $obj->groupclass($newval)
 229  Function:
 230  Example :
 231  Returns : value of groupclass (a scalar)
 232  Args    : on set, new value (a scalar or undef, optional)
 233
 234
 235 =cut
 236
 237 sub groupclass{
 238     my $self = shift;
 239
 240     return $self->{'_groupclass'} = shift if @_;
 241     return $self->{'_groupclass'};
 242 }
 243
 244 1;