lib/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
  92 use strict;
  93
  94 use Bio::SeqFeature::FeaturePair;
  95 use Bio::SeqFeature::Generic;
  96
  97 use base qw(Bio::Root::Root Bio::SeqAnalysisParserI Bio::Root::IO);
  98
  99 =head2 new
 100
 101  Title   : new
 102  Usage   : my $epcr = Bio::Tools::EPCR->new(-file => $file,
 103                                            -primary => $fprimary,
 104                                            -source => $fsource,
 105                                            -groupclass => $fgroupclass);
 106  Function: Initializes a new EPCR parser
 107  Returns : Bio::Tools::EPCR
 108  Args    : -fh   => filehandle
 109            OR
 110            -file => filename
 111
 112            -primary => a string to be used as the common value for
 113                        each features '-primary' tag.  Defaults to
 114                        'sts'.  (This in turn maps to the GFF 'type'
 115                        tag (aka 'method')).
 116
 117             -source => a string to be used as the common value for
 118                        each features '-source' tag.  Defaults to
 119                        'e-PCR'. (This in turn maps to the GFF 'source'
 120                        tag)
 121
 122              -groupclass => a string to be used as the name of the tag
 123                            which will hold the sts marker namefirst
 124                            attribute.  Defaults to 'name'.
 125
 126 =cut
 127
 128 sub new {
 129   my($class,@args) = @_;
 130
 131   my $self = $class->SUPER::new(@args);
 132   my ($primary, $source,
 133       $groupclass) = $self->_rearrange([qw(PRIMARY
 134                                            SOURCE
 135                                            GROUPCLASS)],@args);
 136   $self->primary(defined $primary ? $primary : 'sts');
 137   $self->source(defined $source ? $source : 'e-PCR');
 138   $self->groupclass(defined $groupclass ? $groupclass : 'name');
 139
 140   $self->_initialize_io(@args);
 141   return $self;
 142 }
 143
 144 =head2 next_feature
 145
 146  Title   : next_feature
 147  Usage   : $seqfeature = $obj->next_feature();
 148  Function: Returns the next feature available in the analysis result, or
 149            undef if there are no more features.
 150  Example :
 151  Returns : A Bio::SeqFeatureI implementing object, or undef if there are no
 152            more features.
 153  Args    : none
 154
 155 =cut
 156
 157 sub next_feature {
 158     my ($self) = @_;
 159     my $line = $self->_readline;
 160     return unless defined($line);
 161     chomp($line);
 162     my($seqname,$location,$mkrname, $rest) = split(/\s+/,$line,4);
 163
 164     my ($start,$end) = ($location =~ /(\S+)\.\.(\S+)/);
 165
 166     # `e-PCR -direct` results code match strand in $rest as (+) and (-).  Decode it if present.
 167     my $strandsign;
 168     if ($rest =~ m/^\(([+-])\)(.*)$/) {
 169       ($strandsign,$rest) = ($1, $2);
 170     } else {
 171       $strandsign = "?";
 172     }
 173     my $strand = $strandsign eq "+" ? 1 :  $strandsign eq "-" ? -1 : 0;
 174
 175     my $markerfeature = Bio::SeqFeature::Generic->new
 176         ( '-start'   => $start,
 177           '-end'     => $end,
 178           '-strand'  => $strand,
 179           '-source'  => $self->source,
 180           '-primary' => $self->primary,
 181           '-seq_id'  => $seqname,
 182           '-tag'     => {
 183               $self->groupclass => $mkrname,
 184               ($rest ? ('Note'            => $rest ) : ()),
 185           });
 186     #$markerfeature->add_tag_value('Note', $rest) if defined $rest;
 187     return $markerfeature;
 188 }
 189
 190 =head2 source
 191
 192  Title   : source
 193  Usage   : $obj->source($newval)
 194  Function:
 195  Example :
 196  Returns : value of source (a scalar)
 197  Args    : on set, new value (a scalar or undef, optional)
 198
 199
 200 =cut
 201
 202 sub source{
 203     my $self = shift;
 204     return $self->{'_source'} = shift if @_;
 205     return $self->{'_source'};
 206 }
 207
 208 =head2 primary
 209
 210  Title   : primary
 211  Usage   : $obj->primary($newval)
 212  Function:
 213  Example :
 214  Returns : value of primary (a scalar)
 215  Args    : on set, new value (a scalar or undef, optional)
 216
 217
 218 =cut
 219
 220 sub primary{
 221     my $self = shift;
 222     return $self->{'_primary'} = shift if @_;
 223     return $self->{'_primary'};
 224 }
 225
 226 =head2 groupclass
 227
 228  Title   : groupclass
 229  Usage   : $obj->groupclass($newval)
 230  Function:
 231  Example :
 232  Returns : value of groupclass (a scalar)
 233  Args    : on set, new value (a scalar or undef, optional)
 234
 235
 236 =cut
 237
 238 sub groupclass{
 239     my $self = shift;
 240
 241     return $self->{'_groupclass'} = shift if @_;
 242     return $self->{'_groupclass'};
 243 }
 244
 245 1;