branch-1-6/Bio/Tools/EPCR.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Tools::EPCR
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Jason Stajich <jason-at-bioperl.org>
   8 #
   9 # Copyright Jason Stajich
  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::Tools::EPCR - Parse ePCR output and make features
  18
  19 =head1 SYNOPSIS
  20
  21     # A simple annotation pipeline wrapper for ePCR data
  22     # assuming ePCR data is already generated in file seq1.epcr
  23     # and sequence data is in fasta format in file called seq1.fa
  24
  25     use Bio::Tools::EPCR;
  26     use Bio::SeqIO;
  27     my $parser = Bio::Tools::EPCR->new(-file => 'seq1.epcr');
  28     my $seqio = Bio::SeqIO->new(-format => 'fasta', -file => 'seq1.fa');
  29     my $seq = $seqio->next_seq || die("cannot get a seq object from SeqIO");
  30
  31     while( my $feat = $parser->next_feature ) {
  32         # add EPCR annotation to a sequence
  33         $seq->add_SeqFeature($feat);
  34     }
  35     my $seqout = Bio::SeqIO->new(-format => 'embl');
  36     $seqout->write_seq($seq);
  37
  38
  39 =head1 DESCRIPTION
  40
  41 This object serves as a parser for ePCR data, creating a
  42 Bio::SeqFeatureI for each ePCR hit.  These can be processed or added
  43 as annotation to an existing Bio::SeqI object for the purposes of
  44 automated annotation.
  45
  46 =head1 FEEDBACK
  47
  48 =head2 Mailing Lists
  49
  50 User feedback is an integral part of the evolution of this and other
  51 Bioperl modules. Send your comments and suggestions preferably to
  52 the Bioperl mailing list.  Your participation is much appreciated.
  53
  54   bioperl-l@bioperl.org                  - General discussion
  55   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  56
  57 =head2 Support
  58
  59 Please direct usage questions or support issues to the mailing list:
  60
  61 I<bioperl-l@bioperl.org>
  62
  63 rather than to the module maintainer directly. Many experienced and
  64 reponsive experts will be able look at the problem and quickly
  65 address it. Please include a thorough description of the problem
  66 with code and data examples if at all possible.
  67
  68 =head2 Reporting Bugs
  69
  70 Report bugs to the Bioperl bug tracking system to help us keep track
  71 of the bugs and their resolution. Bug reports can be submitted via the
  72 web:
  73
  74   http://bugzilla.open-bio.org/
  75
  76 =head1 AUTHOR - Jason Stajich
  77
  78 Email jason-at-bioperl.org
  79
  80 =head1 APPENDIX
  81
  82 The rest of the documentation details each of the object methods.
  83 Internal methods are usually preceded with a _
  84
  85 =cut
  86
  87
  88 # Let the code begin...
  89
  90
  91 package Bio::Tools::EPCR;
  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;