Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

way long-overdue init commit of primer3 rewrite (needs tests)

svn path=/bioperl-dev/trunk/; revision=16879
  • Loading branch information...
commit 8dfb1142d5c393080a18d4addff133b1a4ca4e92 1 parent 9611fcb
cjfields authored
View
219 Bio/Tools/Primer3Redux.pm
@@ -0,0 +1,219 @@
+# $Id: Primer3Redux.pm 15549 2009-02-21 00:48:48Z maj $
+#
+# BioPerl module for Bio::Tools::Primer3Redux
+#
+# Copyright (c) Chris Fields
+#
+# You may distribute this module under the same terms as perl itself
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Primer3Redux - Create input for and work with the output from
+the program primer3.
+
+=head1 SYNOPSIS
+
+ # parse primer3 output to get some data
+ # this is also called from Bio::Tools::Run::Primer3
+ use Bio::Tools::Primer3;
+
+ # read a primer3 output file
+ my $p3 = Bio::Tools::Primer3::Redux->new(-file=>"data/primer3_output.txt");
+
+ # iterate through each result in the file
+
+=head1 DESCRIPTION
+
+Bio::Tools::Primer3 creates the input files needed to design primers using
+primer3 and provides mechanisms to access data in the primer3 output files.
+
+This module provides a bioperl interface to the program primer3. See
+http://www-genome.wi.mit.edu/genome_software/other/primer3.html
+for details and to download the software.
+
+This module is based on one written by Chad Matsalla
+(bioinformatics1@dieselwurks.com)
+
+I have ripped some of his code, and added a lot of my own. I hope he
+is not mad at me!
+
+This is probably best run in one of the two following ways:
+
+ i. To parse the output from Bio::Tools::Run::Primer3.
+ You will most likely just use next_primer to get the results from
+ Bio::Tools::Run::Primer3.
+ ii. To parse the output of primer3 handed to it as a file name.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to one
+of the Bioperl mailing lists. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Support
+
+Please direct usage questions or support issues to the mailing list:
+
+L<bioperl-l@bioperl.org>
+
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
+with code and data examples if at all possible.
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+the bugs and their resolution. Bug reports can be submitted via the web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR -
+
+ Rob Edwards
+
+ redwards@utmem.edu
+
+ Based heavily on work of
+
+ Chad Matsalla
+
+ bioinformatics1@dieselwurks.com
+
+=head1 CONTRIBUTORS
+
+ Brian Osborne bosborne at alum.mit.edu
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+# Let the code begin...
+
+package Bio::Tools::Primer3Redux;
+
+use strict;
+use warnings;
+
+use Bio::Tools::Primer3Redux::Result;
+
+use base qw(Bio::Root::IO Bio::AnalysisParserI);
+
+=head2 new
+
+ Title : new()
+ Usage : my $primer3 = Bio::Tools::Primer3->new(-file=>$file)
+ to read a primer3 output file.
+ Function: Parse primer3 output
+ Returns : Does not return anything. If called with a filename will
+ allow you to retrieve the results
+ Args : -file (optional) file of primer3 results to parse -verbose
+ (optional) set verbose output
+ Notes :
+
+=cut
+
+{
+
+my $SF_TAGS =
+(
+
+);
+
+sub next_result {
+ my $self = shift;
+
+ $self->start_document;
+
+ while (my $line = $self->_readline) {
+ last if index($line, '=') == 0;
+ chomp $line;
+ my ($tag, $data) = split('=', $line, 2 );
+ if ($tag =~ /^PRIMER_(LEFT|RIGHT|INTERNAL_OLIGO|INTERNAL|PAIR|PRODUCT)(?:(?:_(\d+))?_(.*))?/xmso) {
+ my ($type, $rank, $primer_tag) = ($1, $2, $3);
+ if (!defined $rank && defined $primer_tag && $primer_tag =~ /(?:(\w+)_)?(\d+)$/) {
+ ($primer_tag, $rank) = ($1, $2);
+ }
+ $rank ||= 0;
+ $type = 'INTERNAL' if $type eq 'INTERNAL_OLIGO';
+ # indicates location information
+ $primer_tag ||= 'LOCATION';
+ if ($primer_tag eq 'EXPLAIN' || $primer_tag eq 'NUM_RETURNED') {
+ $self->{persistent}->{$type}->{lc $primer_tag} = $data;
+ next;
+ }
+ # v1 -> v2 change
+ if ($type eq 'PRODUCT') {
+ $type = 'PAIR';
+ $primer_tag = 'PRODUCT_SIZE';
+ }
+ $self->{features}->{$rank}->{$type}->{lc $primer_tag} = $data;
+ } elsif ($tag =~ /^(?:PRIMER_)?SEQUENCE(?:_(?:ID|TEMPLATE))?$/ ) {
+ $self->{sequence}->{$tag} = $data;
+ } else{ # anything else
+ $self->{run_parameters}->{$tag} = $data;
+ }
+ }
+
+ my $doc = $self->end_document;
+
+ return $doc;
+}
+
+}
+
+=head2 start_document
+
+ Title : start_document
+ Usage : $obj->start_document
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub start_document {
+ my $self = shift;
+ for my $data (qw(sequence features persistent run_parameters)) {
+ $self->{$data} = undef;
+ }
+}
+
+=head2 end_document
+
+ Title : end_document
+ Usage : $obj->end_document
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub end_document {
+ my $self = shift;
+ my $result;
+ if (defined $self->{sequence} || defined $self->{features}) {
+ $result = Bio::Tools::Primer3Redux::Result->new();
+
+ # data is created on the fly within the result
+ $result->_initialize(-seq => $self->{sequence},
+ -features => $self->{features},
+ -persistent => $self->{persistent},
+ -parameters => $self->{run_parameters});
+ }
+ return $result;
+}
+
+1;
+
+__END__
+
View
184 Bio/Tools/Primer3Redux/Primer.pm
@@ -0,0 +1,184 @@
+# $Id: Report.pm,v 0.01 2007-03-27 12:43:27 heikki Exp $
+#
+# BioPerl module for Bio::Tools::Primer3Redux::Primer
+#
+# Cared for by Chris Fields cjfields at bioperl dot org
+#
+# Copyright Chris Fields
+#
+# You may distribute this module under the same terms as perl itself
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Primer3Redux::Primer - Simple Decorator of a Bio::SeqFeature::Generic
+with convenience methods for retrieving Tm, GC, validating primer seq against
+attached sequence, etc.
+
+=head1 SYNOPSIS
+
+ # get the Bio::Tools::Primer3Redux::Primer through Bio::Tools::Primer3Redux...
+
+ # dies with an error if no sequence is attached, or if sequence region
+ # does not match cached sequence from Primer3. Useful if decorating an already
+ # generated Bio::Seq with primers.
+
+ $primer->validate_seq;
+
+ my $seq = $primer->seq; # Bio::Seq object
+ if ($primer->melting_temp < 55) {
+ warn "Primer ".$primer->display_name." is below optimal temp";
+ }
+
+ # if primer3 EXPLAIN settings are used...
+ print "Run parameters:".$primer->run_description."\n";
+
+=head1 DESCRIPTION
+
+
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+the web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR - Chris Fields
+
+ Email cjfields at bioperl dot org
+
+Describe contact details here
+
+=head1 CONTRIBUTORS
+
+Additional contributors names and emails here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+# Let the code begin...
+
+package Bio::Tools::Primer3Redux::Primer;
+
+use strict;
+
+# Object preamble - inherits from Bio::Root::Root
+
+use base qw(Bio::SeqFeature::Generic);
+
+=head2 oligo_type
+
+ Title : oligo_type
+ Usage : $obj->oligo_type
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub oligo_type {
+ my ($self, $type) = @_;
+ if (defined $type) {
+ $self->remove_tag('type') if $self->has_tag('type');
+ $self->add_tag_value('type', $type);
+ }
+ $self->has_tag('type') ? return ($self->get_tag_values('type'))[0] : return;
+}
+
+=head2 validate_seq
+
+ Title : validate_seq
+ Usage : $obj->validate_seq
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub validate_seq {
+ my ($self) = shift;
+ my $cached = $self->has_tag('sequence') ? ($self->get_tag_values('sequence'))[0] : '';
+ my $seq = $self->seq->seq;
+ if ($cached ne $seq) {
+ $self->warn("Sequence [$seq] does not match predicted [$cached], check attached sequence");
+ return 0;
+ }
+ return 1;
+}
+
+=head2 melting_temp
+
+ Title : melting_temp
+ Usage : $obj->melting_temp
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub melting_temp {
+ my ($self, $tm) = @_;
+ if (defined $tm) {
+ $self->remove_tag('tm') if $self->has_tag('tm');
+ $self->add_tag_value('tm', $tm);
+ }
+ $self->has_tag('tm') ? return ($self->get_tag_values('tm'))[0] : return;
+}
+
+=head2 gc_content
+
+ Title : gc
+ Usage : $obj->gc
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub gc_content {
+ my ($self, $gc) = @_;
+ if (defined $gc) {
+ $self->remove_tag('gc_percent') if $self->has_tag('gc_percent');
+ $self->add_tag_value('gc_percent', $gc);
+ }
+ $self->has_tag('gc_percent') ? return ($self->get_tag_values('gc_percent'))[0] : return;
+}
+
+=head2 run_description
+
+ Title : run_description
+ Usage : $obj->run_description
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub run_description {
+ my ($self, $desc) = @_;
+ if (defined $desc) {
+ $self->remove_tag('explain') if $self->has_tag('explain');
+ $self->add_tag_value('explain', $desc);
+ }
+ $self->has_tag('explain') ? return ($self->get_tag_values('explain'))[0] : return;
+}
+
+1;
View
166 Bio/Tools/Primer3Redux/PrimerPair.pm
@@ -0,0 +1,166 @@
+# $Id: PrimerPair.pm,v 0.01 2007-03-27 12:43:27 heikki Exp $
+#
+# BioPerl module for Bio::Tools::Primer3Redux::PrimerPair
+#
+# Cared for by Chris Fields cjfields at bioperl dot org
+#
+# Copyright Chris Fields
+#
+# You may distribute this module under the same terms as perl itself
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Primer3Redux::PrimerPair - Simple Decorator of a
+Bio::SeqFeature::Generic with convenience methods for retrieving left and
+right primers, internal oligos, and any amplicon-related information
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+Bio::Tools::Primer3Redux::PrimerPair acts as a simple SeqFeature that bundles
+primer pair data together into one object. This object can be used to retrieve
+the amplicon sequence, the forward/reversion (left/right) primers, and any
+internal oligos. Furthermore, any primer information relative to the product
+is included as SeqFeature tags.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+the web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR - Chris Fields
+
+ Email cjfields at bioperl dot org
+
+Describe contact details here
+
+=head1 CONTRIBUTORS
+
+Additional contributors names and emails here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+# Let the code begin...
+
+package Bio::Tools::Primer3Redux::PrimerPair;
+
+use strict;
+
+# Object preamble - inherits from Bio::Root::Root
+
+use base qw(Bio::SeqFeature::Generic);
+
+=head2 left_primer
+
+ Title : left_primer
+ Usage : $obj->left_primer
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub left_primer {
+ shift->forward_primer(@_);
+}
+
+=head2 forward_primer
+
+ Title : forward_primer
+ Usage : $obj->forward_primer
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub forward_primer {
+ my ($self, $primer) = @_;
+ if ($primer) {
+ $self->throw("Not a Primer object") unless $primer->isa('Bio:::Tools::Primer3Redux::Primer');
+ $self->add_SeqFeature($primer, 'EXPAND');
+ }
+ my ($for) = grep {$_->primary_tag eq 'forward_primer'} $self->get_SeqFeatures;
+ return $for;
+}
+
+=head2 right_primer
+
+ Title : right_primer
+ Usage : $obj->right_primer
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub right_primer { shift->reverse_primer(@_)}
+
+=head2 reverse_primer
+
+ Title : reverse_primer
+ Usage : $obj->reverse_primer
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub reverse_primer {
+ my ($self, $primer) = @_;
+ if ($primer) {
+ $self->throw("Not a Primer object") unless $primer->isa('Bio:::Tools::Primer3Redux::Primer');
+ $self->add_SeqFeature($primer, 'EXPAND');
+ }
+ my ($rev) = grep {$_->primary_tag eq 'reverse_primer'} $self->get_SeqFeatures;
+ return $rev;
+}
+
+=head2 internal_oligo
+
+ Title : internal_oligo
+ Usage : $obj->internal_oligo
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub internal_oligo {
+ my ($self, $primer) = @_;
+ if ($primer) {
+ $self->throw("Not a Primer object") unless $primer->isa('Bio:::Tools::Primer3Redux::Primer');
+ # Note this doesn't expand to fit; the assumption is this is added
+ # after forward/reverse primers are added and acts to ensure the
+ # oligo is actually internal to the fragment (otherwise it throws)
+ $self->add_SeqFeature($primer);
+ }
+ my ($oligo) = grep {$_->primary_tag eq 'ss_oligo'} $self->get_SeqFeatures;
+ return $oligo;
+}
+
+1;
View
458 Bio/Tools/Primer3Redux/Result.pm
@@ -0,0 +1,458 @@
+# $Id: Result.pm,v 0.01 2007-03-27 12:43:27 heikki Exp $
+#
+# BioPerl module for Bio::Tools::Primer3Redux::Result
+#
+# Cared for by Chris Fields cjfields at bioperl dot org
+#
+# Copyright Chris Fields
+#
+# You may distribute this module under the same terms as perl itself
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Primer3::Result - Result class for Primer3 data
+
+=head1 SYNOPSIS
+
+
+
+=head1 DESCRIPTION
+
+This is a simple holder class for Primer3 sequence results. The sequence used by
+default is the one returned in the Primer3 results, but one can pass in a
+(more-SeqFeature/Annotation-rich) version as a Bio::Seq using attach_seq() (see
+below for more on this).
+
+As mentioned above, one can either use the default Bio::Seq generated from the
+Primer3 results, or pass in a more richly decorated version to add more features
+to. This parser will attach any lazily-generated features to it. The sequence
+can be retrieved via get_seq() at any point, such as prior to the end of a
+parse). To retrieve a sequence guaranteed to have all Primer/PrimerPair data
+attached, use get_processed_seq(). Switching seqs will cause a new batch of
+features to be generated and attached.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+the web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR - Chris Fields
+
+ Email cjfields at bioperl dot org
+
+Describe contact details here
+
+=head1 CONTRIBUTORS
+
+Additional contributors names and emails here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+# Let the code begin...
+
+package Bio::Tools::Primer3Redux::Result;
+
+use strict;
+use warnings;
+
+use base qw(Bio::Root::Root);
+
+use Bio::Seq;
+use Bio::Tools::Primer3Redux::Primer;
+use Bio::Tools::Primer3Redux::PrimerPair;
+
+=head2 new
+
+ Title : new
+ Usage : my $obj = new
+ Function: Builds a new Bio::Tools::Primer3::Result object
+ Returns : an instance of Bio::Tools::Primer3::Result
+ Args :
+
+=cut
+
+sub _initialize {
+ my ($self) = shift;
+ my %args;
+ ($self->{sequence_data},
+ $self->{feature_data},
+ $self->{persistent_data},
+ $self->{run_parameters}) =
+ $self->_rearrange([qw(SEQ FEATURES PERSISTENT PARAMETERS)], @_);
+}
+
+=head2 attach_seq
+
+ Title : attach_seq
+ Usage : $obj->attach_seq
+ Function :
+ Returns : Bio::SeqI
+ Args : Bio::SeqI (warning: may or may not have primers attached)
+ Note : calling this method resets the feature iterators to prevent (for
+ instance) issues with references
+
+=cut
+
+sub attach_seq {
+ my ($self) = shift;
+ if (@_) {
+ my $seq = shift;
+ if (defined $seq) {
+ $self->throw("Passed sequence must be a Bio::SeqI")
+ unless UNVERSAL::isa($seq, 'Bio::SeqI');
+ }
+ # this allows resetting seq() to use built-in report sequence
+ $self->{using_seq} = $seq;
+ $self->{reattach_sf} = 1;
+ }
+}
+
+=head2 get_seq
+
+ Title : get_seq
+ Usage : $obj->get_seq
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub get_seq {
+ my $self = shift;
+ if (defined $self->{using_seq}) {
+ return $self->{using_seq}
+ } else {
+ if (!defined $self->{default_seq}) {
+ $self->{default_seq} = $self->_create_default_seq;
+ }
+ return $self->{default_seq}
+ }
+}
+
+=head2 get_processed_seq
+
+ Title : get_processed_seq
+ Usage : $obj->get_processed_seq
+ Function :
+ Returns :
+ Args :
+ Note : unlike get_seq(), this guarantees getting back the full
+ sequence with attached Primer/PrimerPair SeqFeatureI
+
+=cut
+
+sub get_processed_seq {
+ my ($self) = shift;
+ # Run through all iterators to generate features
+ # Run out primer pair first, then others
+ for my $it_type (qw(PAIR LEFT RIGHT INTERNAL)) {
+ my $it = $self->_generate_iterator($it_type);
+ while (my $sf = $it->()) {}
+ }
+ return $self->get_seq();
+}
+
+=head2 num_primer_pairs
+
+ Title : num_primer_pairs
+ Usage : $obj->num_primer_pairs
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub num_primer_pairs {
+ my $self = shift;
+ exists($self->{persistent_data}{PAIR}{num_returned}) ?
+ return $self->{persistent_data}{PAIR}{num_returned} : 0;
+}
+
+=head2 next_left_primer
+
+ Title : next_left_primer
+ Usage : $obj->next_left_primer
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub next_left_primer {
+ my ($self, @args) = @_;
+ if (!exists $self->{it}->{left} || !defined $self->{it}->{left}) {
+ $self->{it}->{left} = $self->_generate_iterator('left',@args);
+ }
+ $self->{it}->{left}->($self);
+}
+
+=head2 next_right_primer
+
+ Title : next_right_primer
+ Usage : $obj->next_right_primer
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub next_right_primer {
+ my ($self, @args) = @_;
+ if (!exists $self->{it}->{right} || !defined $self->{it}->{right}) {
+ $self->{it}->{right} = $self->_generate_iterator('right',@args);
+ }
+ $self->{it}->{right}->($self);
+}
+
+=head2 next_internal_oligo
+
+ Title : next_internal_oligo
+ Usage : $obj->next_internal_oligo
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub next_internal_oligo {
+ my ($self, @args) = @_;
+ if (!exists $self->{it}->{internal} || !defined $self->{it}->{internal}) {
+ $self->{it}->{internal} = $self->_generate_iterator('internal',@args);
+ }
+ $self->{it}->{internal}->($self);
+}
+
+=head2 next_primer_pair
+
+ Title : next_primer_pair
+ Usage : $obj->next_primer_pair
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub next_primer_pair {
+ my ($self, @args) = @_;
+ if (!exists $self->{it}->{pair} || !defined $self->{it}->{pair}) {
+ $self->{it}->{pair} = $self->_generate_iterator('pair',@args);
+ }
+ $self->{it}->{pair}->($self);
+}
+
+=head2 run_parameters
+
+ Title : run_parameters
+ Usage : $obj->run_parameters
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub run_parameters {
+ my ($self, @params) = @_;
+ my %params;
+ if (@params) {
+ %params =
+ map {
+ $_ => $self->{run_parameters}->{$_}
+ }
+ grep {
+ exists $self->{run_parameters}->{$_}
+ } @params;
+ } else {
+ %params = %{$self->{run_parameters}};
+ }
+ return %params;
+}
+
+=head2 run_parameter
+
+ Title : run_parameter
+ Usage : $obj->run_parameter('FOO')
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub run_parameter {
+ my ($self, $param) = @_;
+ return unless defined $param && exists $self->{run_parameters}->{$param};
+ return $self->{run_parameters}->{$param};
+}
+
+=head2 rewind
+
+ Title : rewind
+ Usage : $obj->rewind('primer_pair')
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub rewind {
+ my ($self, $it_type) = @_;
+ return unless defined $it_type;
+ if (exists $self->{it}->{$it_type}) {
+ delete $self->{it}->{$it_type};
+ }
+ return;
+}
+
+################ PRIVATE STUFF ################
+
+{
+my %VALID_ITERATORS = (
+ PAIR => \&_generate_pair,
+ INTERNAL => \&_generate_primer,
+ LEFT => \&_generate_primer,
+ RIGHT => \&_generate_primer,
+ );
+
+sub _generate_iterator {
+ my ($self, $it_type, @args) = @_;
+ $self->throw("Must define a valid iterator; current allowed values are ".
+ join(',', sort keys %VALID_ITERATORS)) unless
+ (defined $it_type || !exists $VALID_ITERATORS{uc $it_type});
+ $it_type = uc $it_type;
+
+ my $mth = $VALID_ITERATORS{$it_type};
+
+ my $persistent_data = $self->{persistent_data}{$it_type};
+ my @feat_data = ($it_type eq 'PAIR') ?
+ map {$self->{feature_data}{$_}} sort {$a <=> $b} keys %{$self->{feature_data}} :
+ map {$self->{feature_data}{$_}{$it_type}} sort {$a <=> $b} keys %{$self->{feature_data}};
+ my $ct = 0;
+
+ # for attaching the features
+ my $seq = $self->get_seq;
+
+ return ($it_type eq 'PAIR') ?
+ sub {
+ my $instance = shift;
+ my $ft = shift @feat_data;
+ return unless $ft;
+ # return cached features if previously generated and seq already attached
+ return $ft->{PAIR} if (UNIVERSAL::isa($ft->{PAIR}, 'Bio::SeqFeature::Generic'))
+ && !$self->{reattach_sf};
+
+ # carry over persistent data
+ for my $fkey (keys %{$ft}) {
+ $ft->{$fkey}{rank} = $ct;
+ $ft->{$fkey}{type} = lc $fkey;
+ for my $pkey (keys %{$persistent_data}) {
+ $ft->{$fkey}{$pkey} = $persistent_data->{$pkey};
+ }
+ }
+ my $sf = $mth->($ft,$seq,$instance);
+ # run caching here
+ $ct++;
+ $sf;
+ } :
+ sub {
+ my $instance = shift;
+ # these are tags
+ my $ft = shift @feat_data;
+ return unless $ft;
+ # return cached features if previously generated and seq already attached
+ if (UNIVERSAL::isa($ft, 'Bio::SeqFeature::Generic') && !$self->{reattach_sf}) {
+ $ct++;
+ return $ft;
+ }
+
+ # carry over persistent data
+ for my $key (keys %{$persistent_data}) {
+ $ft->{$key} = $persistent_data->{$key};
+ }
+
+ $ft->{rank} = $ct;
+ $ft->{type} = lc $it_type;
+ my $sf = $mth->($ft, $seq, $instance);
+ $ct++;
+ $sf;
+ }
+}
+
+}
+
+sub _generate_primer {
+ my ($ft, $seq, $instance) = @_;
+ my ($type, $loc) = (delete($ft->{type}), delete($ft->{location}));
+ my $rank = $ft->{rank};
+ my $strand = $type eq 'right' ? -1 : 1;
+ my ($start, $len) = split(',', $loc);
+ # coordinates for Primer3 may be zero-based, may need conversion to 1-based
+ if (!$instance->run_parameter('PRIMER_FIRST_BASE_INDEX')) {
+ $start++
+ }
+ my $end = ($strand == 1) ? $start + $len -1 : $start - $len + 1;
+ ($start, $end) = ($end, $start) if $strand == -1;
+ my $primary = $type eq 'internal' ? 'ss_oligo' :
+ $type eq 'left' ? 'forward_primer' :
+ 'reverse_primer' ;
+ my $sf = Bio::Tools::Primer3Redux::Primer->new(-start => $start,
+ -end => $end,
+ -strand => $strand,
+ -display_name => $type.'_'.$rank,
+ -primary_tag => $primary,
+ -tag => $ft);
+ $seq->add_SeqFeature($sf) if $seq and UNIVERSAL::isa($seq, 'Bio::SeqI');
+
+ # cache Primer
+ $instance->{feature_data}{$rank}{uc $type} = $sf;
+ $sf;
+}
+
+sub _generate_pair {
+ my ($ft, $seq, $instance) = @_;
+ # some combinations of parameters do not return proper pairings,
+ # so punt and return
+ return if (!exists $ft->{PAIR} || !exists $ft->{PAIR}->{num_returned} || $ft->{PAIR}->{num_returned} == 0);
+ my $pair = delete $ft->{PAIR};
+ my $rank = $pair->{rank};
+ $pair = Bio::Tools::Primer3Redux::PrimerPair->new(-tag => $pair);
+
+ for my $type (sort keys %$ft) {
+ my $sf = _generate_primer($ft->{$type}, $seq, $instance);
+ $pair->add_SeqFeature($sf, 'EXPAND');
+ }
+ $seq->add_SeqFeature($pair) if $seq and UNIVERSAL::isa($seq, 'Bio::SeqI');
+ # cache PrimerPair
+ $instance->{feature_data}{$rank}{PAIR} = $pair;
+ return $pair;
+}
+
+sub _create_default_seq {
+ my $self = shift;
+ return Bio::Seq->new(-seq => $self->{sequence_data}{SEQUENCE_TEMPLATE} ||
+ $self->{sequence_data}{SEQUENCE} ,
+ -accession_number => $self->{sequence_data}{SEQUENCE_ID} ||
+ $self->{sequence_data}{PRIMER_SEQUENCE_ID},
+ -alphabet => 'dna');
+}
+
+1;
View
88 Bio/Tools/Primer3Redux/Sequence.pm
@@ -0,0 +1,88 @@
+# $Id: Primer3.pm,v 0.01 2007-03-27 12:43:27 heikki Exp $
+#
+# BioPerl module for Bio::Tools::Primer3::Sequence
+#
+# Cared for by Chris Fields cjfields at bioperl dot org
+#
+# Copyright Chris Fields
+#
+# You may distribute this module under the same terms as perl itself
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Primer3::Sequence - DESCRIPTION of Object
+
+=head1 SYNOPSIS
+
+Give standard usage here
+
+=head1 DESCRIPTION
+
+Describe the object here
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://bioperl.org/wiki/Mailing_lists - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+the web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR - Chris Fields
+
+ Email cjfields at bioperl dot org
+
+Describe contact details here
+
+=head1 CONTRIBUTORS
+
+Additional contributors names and emails here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+# Let the code begin...
+
+package Bio::Tools::Primer3::Sequence;
+
+use strict;
+
+# Object preamble - inherits from Bio::Root::Root
+
+use base qw(Bio::Root::Root);
+
+=head2 new
+
+ Title : new
+ Usage : my $obj = new
+ Function: Builds a new Bio::Tools::Primer3::Sequence object
+ Returns : an instance of Bio::Tools::Primer3::Sequence
+ Args :
+
+=cut
+
+sub new {
+ my($class,@args) = @_;
+ my $self = $class->SUPER::new(@args);
+ my ($seq) = $self->_rearrange();
+ return $self;
+}
+
+1;
View
708 Bio/Tools/Run/Primer3Redux.pm
@@ -0,0 +1,708 @@
+# $Id: Primer3.pm 15558 2009-02-21 22:07:57Z maj $
+#
+# This is the original copyright statement. I have relied on Chad's module
+# extensively for this module.
+#
+# Copyright (c) 1997-2001 bioperl, Chad Matsalla. All Rights Reserved.
+# This module is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# Copyright Chad Matsalla
+#
+# You may distribute this module under the same terms as perl itself
+# POD documentation - main docs before the code
+#
+# But I have modified lots of it, so I guess I should add:
+#
+# Copyright (c) 2003 bioperl, Rob Edwards. All Rights Reserved.
+# This module is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# Copyright Chris Fields
+#
+# You may distribute this module under the same terms as perl itself
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::Run::Primer3 - Create input for and work with the output
+from the program primer3
+
+=head1 SYNOPSIS
+
+ # design some primers.
+ # the output will be put into temp.out
+ use Bio::Tools::Run::Primer3;
+ use Bio::SeqIO;
+
+ my $seqio = Bio::SeqIO->new(-file=>'data/dna1.fa');
+ my $seq = $seqio->next_seq;
+
+ my $primer3 = Bio::Tools::Run::Primer3->new(-outfile => "temp.out",
+ -path => "/usr/bin/primer3_core");
+
+ # or after the fact you can change the program_name
+ $primer3->program_name('my_suprefast_primer3');
+
+ unless ($primer3->executable) {
+ print STDERR "primer3 can not be found. Is it installed?\n";
+ exit(-1)
+ }
+
+ # set the maximum and minimum Tm of the primer
+ $primer3->add_targets('PRIMER_MIN_TM'=>56, 'PRIMER_MAX_TM'=>90);
+
+ # design the primers. This runs primer3 and returns a
+ # Bio::Tools::Primer3Parser object with the results
+ $results = $primer3->run($seq);
+
+ # see the Bio::Tools::Primer3Parser pod for
+ # things that you can get from this. For example:
+
+ print "There were ", $results->number_of_results, " primers\n";
+
+=head1 DESCRIPTION
+
+Bio::Tools::Run::Primer3 creates the input files needed to design primers
+using primer3 and provides mechanisms to access data in the primer3
+output files.
+
+This module is largely a streamlined refactoring of the original Primer3 module
+written by Rob Edwards. See http://primer3.sourceforge.net for details and to
+download the software. This module should work for primer3 release 1 and above
+but is not guaranteed to work with earlier versions.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to one
+of the Bioperl mailing lists. Your participation is much appreciated.
+
+ bioperl-l@bioperl.org - General discussion
+ http://www.bioperl.org/MailList.html - About the mailing lists
+
+=head2 Support
+
+Please direct usage questions or support issues to the mailing list:
+
+L<bioperl-l@bioperl.org>
+
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
+with code and data examples if at all possible.
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+the bugs and their resolution. Bug reports can be submitted via the
+web:
+
+ http://bugzilla.open-bio.org/
+
+=head1 AUTHOR
+
+Chris Fields cjfields-at-bioperl-dot-org
+
+Largely refactored from the original Primer3 parser by Rob Edwards, which in
+turn was based heavily on work of Chad Matsalla
+
+bioinformatics1@dieselwurks.com
+
+=head1 CONTRIBUTORS
+
+Rob Edwards redwards@utmem.edu
+Chad Matsalla bioinformatics1@dieselwurks.com
+Shawn Hoon shawnh-at-stanford.edu
+Jason Stajich jason-at-bioperl.org
+Brian Osborne osborne1-at-optonline.net
+Chris Fields cjfields-at-bioperl-dot-org
+
+=head1 SEE ALSO
+
+L<Bio::Tools::Primer3>
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+# Let the code begin...
+
+package Bio::Tools::Run::Primer3Redux;
+
+use strict;
+use Bio::Tools::Primer3Redux;
+use File::Spec;
+use Data::Dumper;
+
+use base qw(Bio::Root::Root Bio::Tools::Run::WrapperBase);
+
+my $PROGRAMNAME;
+my %PARAMS;
+my @P1;
+my @P2;
+# 2.0 is still in alpha (3/12/09), so fallback
+# to v1 for determining parameters
+my $DEFAULT_VERSION = '1.1.4';
+BEGIN {
+ # $ct assigns order of parameter building
+@P1 = qw(
+ PRIMER_SEQUENCE_ID
+ SEQUENCE
+ TARGET
+ EXCLUDED_REGION
+ INCLUDED_REGION
+ PRIMER_COMMENT
+ PRIMER_DNA_CONC
+ PRIMER_EXPLAIN_FLAG
+ PRIMER_FILE_FLAG
+ PRIMER_FIRST_BASE_INDEX
+ PRIMER_GC_CLAMP
+ PRIMER_DIVALENT_CONC
+ PRIMER_DNTP_CONC
+ PRIMER_LOWERCASE_MASKING
+ PRIMER_SALT_CORRECTIONS
+ PRIMER_INTERNAL_OLIGO_DNTP_CONC PRIMER_INTERNAL_OLIGO_DIVALENT_CONC
+ PRIMER_INTERNAL_OLIGO_DNA_CONC PRIMER_INTERNAL_OLIGO_EXCLUDED_REGION
+ PRIMER_INTERNAL_OLIGO_INPUT PRIMER_INTERNAL_OLIGO_MAX_GC
+ PRIMER_INTERNAL_OLIGO_MAX_MISHYB PRIMER_INTERNAL_OLIGO_MAX_POLY_X
+ PRIMER_INTERNAL_OLIGO_MAX_SIZE PRIMER_INTERNAL_OLIGO_MAX_TM
+ PRIMER_INTERNAL_OLIGO_MIN_GC PRIMER_INTERNAL_OLIGO_MIN_QUALITY
+ PRIMER_INTERNAL_OLIGO_MIN_SIZE PRIMER_INTERNAL_OLIGO_MIN_TM
+ PRIMER_INTERNAL_OLIGO_MISHYB_LIBRARY PRIMER_INTERNAL_OLIGO_OPT_GC_PERCENT
+ PRIMER_INTERNAL_OLIGO_OPT_SIZE PRIMER_INTERNAL_OLIGO_OPT_TM
+ PRIMER_INTERNAL_OLIGO_SALT_CONC PRIMER_INTERNAL_OLIGO_SELF_ANY
+ PRIMER_INTERNAL_OLIGO_SELF_END
+ PRIMER_IO_WT_COMPL_ANY
+ PRIMER_IO_WT_COMPL_END PRIMER_IO_WT_END_QUAL
+ PRIMER_IO_WT_GC_PERCENT_GT PRIMER_IO_WT_GC_PERCENT_LT
+ PRIMER_IO_WT_NUM_NS PRIMER_IO_WT_REP_SIM
+ PRIMER_IO_WT_SEQ_QUAL PRIMER_IO_WT_SIZE_GT
+ PRIMER_IO_WT_SIZE_LT PRIMER_IO_WT_TM_GT
+ PRIMER_IO_WT_TM_LT
+ PRIMER_LEFT_INPUT PRIMER_RIGHT_INPUT
+ PRIMER_LIBERAL_BASE
+ PRIMER_MAX_DIFF_TM PRIMER_MAX_END_STABILITY
+ PRIMER_MAX_GC PRIMER_MAX_MISPRIMING
+ PRIMER_MAX_POLY_X PRIMER_MAX_SIZE
+ PRIMER_MAX_TM
+ PRIMER_MIN_END_QUALITY PRIMER_MIN_GC
+ PRIMER_MIN_QUALITY PRIMER_MIN_SIZE
+ PRIMER_MIN_TM
+ PRIMER_MISPRIMING_LIBRARY
+ PRIMER_NUM_NS_ACCEPTED PRIMER_NUM_RETURN
+ PRIMER_OPT_GC_PERCENT PRIMER_OPT_SIZE
+ PRIMER_OPT_TM
+ PRIMER_PAIR_MAX_MISPRIMING PRIMER_PAIR_WT_COMPL_ANY
+ PRIMER_PAIR_WT_COMPL_END PRIMER_PAIR_WT_DIFF_TM
+ PRIMER_PAIR_WT_IO_PENALTY PRIMER_PAIR_WT_PRODUCT_SIZE_GT
+ PRIMER_PAIR_WT_PRODUCT_SIZE_LT PRIMER_PAIR_WT_PRODUCT_TM_GT
+ PRIMER_PAIR_WT_PRODUCT_TM_LT PRIMER_PAIR_WT_PR_PENALTY
+ PRIMER_PAIR_WT_REP_SIM
+ PRIMER_PICK_ANYWAY PRIMER_PICK_INTERNAL_OLIGO
+ PRIMER_PRODUCT_MAX_TM PRIMER_PRODUCT_MIN_TM
+ PRIMER_PRODUCT_OPT_SIZE PRIMER_PRODUCT_OPT_TM
+ PRIMER_PRODUCT_SIZE_RANGE
+ PRIMER_QUALITY_RANGE_MAX PRIMER_QUALITY_RANGE_MIN
+ PRIMER_SALT_CONC
+ PRIMER_SELF_ANY PRIMER_SELF_END
+ PRIMER_SEQUENCE_QUALITY
+ PRIMER_START_CODON_POSITION
+ PRIMER_TASK
+ PRIMER_TM_SANTALUCIA
+ PRIMER_WT_COMPL_ANY PRIMER_WT_COMPL_END
+ PRIMER_WT_END_QUAL PRIMER_WT_END_STABILITY
+ PRIMER_WT_GC_PERCENT_GT PRIMER_WT_GC_PERCENT_LT
+ PRIMER_WT_NUM_NS PRIMER_WT_POS_PENALTY
+ PRIMER_WT_REP_SIM PRIMER_WT_SEQ_QUAL
+ PRIMER_WT_SIZE_GT PRIMER_WT_SIZE_LT
+ PRIMER_WT_TM_GT PRIMER_WT_TM_LT
+ PRIMER_WT_TEMPLATE_MISPRIMING
+ PRIMER_DEFAULT_PRODUCT PRIMER_DEFAULT_SIZE
+ PRIMER_INSIDE_PENALTY
+ PRIMER_INTERNAL_OLIGO_MAX_TEMPLATE_MISHYB
+ PRIMER_OUTSIDE_PENALTY
+ PRIMER_LIB_AMBIGUITY_CODES_CONSENSUS
+ PRIMER_MAX_TEMPLATE_MISPRIMING
+ PRIMER_PAIR_MAX_TEMPLATE_MISPRIMING PRIMER_PAIR_WT_TEMPLATE_MISPRIMING
+);
+@P2 = qw(
+ SEQUENCE_EXCLUDED_REGION
+ SEQUENCE_INCLUDED_REGION
+ SEQUENCE_QUALITY
+ SEQUENCE_FORCE_LEFT_END
+ SEQUENCE_INTERNAL_EXCLUDED_REGION
+ SEQUENCE_START_CODON_POSITION
+ SEQUENCE_FORCE_LEFT_START
+ SEQUENCE_INTERNAL_OLIGO
+ SEQUENCE_TARGET
+ SEQUENCE_FORCE_RIGHT_END
+ SEQUENCE_PRIMER
+ SEQUENCE_TEMPLATE
+ SEQUENCE_FORCE_RIGHT_START
+ SEQUENCE_PRIMER_OVERLAP_POS
+ SEQUENCE_ID
+ SEQUENCE_PRIMER_REVCOMP
+
+ PRIMER_DNA_CONC
+ PRIMER_LIBERAL_BASE
+ PRIMER_PAIR_WT_PR_PENALTY
+ PRIMER_DNTP_CONC
+ PRIMER_LIB_AMBIGUITY_CODES_CONSENSUS
+ PRIMER_PAIR_WT_TEMPLATE_MISPRIMING
+ PRIMER_EXPLAIN_FLAG
+ PRIMER_LOWERCASE_MASKING
+ PRIMER_PICK_ANYWAY
+ PRIMER_FIRST_BASE_INDEX
+ PRIMER_MAX_END_GC
+ PRIMER_PICK_INTERNAL_OLIGO
+ PRIMER_GC_CLAMP
+ PRIMER_MAX_END_STABILITY
+ PRIMER_PICK_LEFT_PRIMER
+ PRIMER_INSIDE_PENALTY
+ PRIMER_MAX_GC
+ PRIMER_PICK_RIGHT_PRIMER
+ PRIMER_INTERNAL_DNA_CONC
+ PRIMER_MAX_LIBRARY_MISPRIMING
+ PRIMER_POS_OVERLAP_TO_END_DIST
+ PRIMER_INTERNAL_DNTP_CONC
+ PRIMER_MAX_NS_ACCEPTED
+ PRIMER_PRODUCT_MAX_TM
+ PRIMER_INTERNAL_MAX_GC
+ PRIMER_MAX_POLY_X
+ PRIMER_PRODUCT_MIN_TM
+ PRIMER_INTERNAL_MAX_LIBRARY_MISHYB
+ PRIMER_MAX_SELF_ANY
+ PRIMER_PRODUCT_OPT_SIZE
+ PRIMER_INTERNAL_MAX_NS_ACCEPTED
+ PRIMER_MAX_SELF_END
+ PRIMER_PRODUCT_OPT_TM
+ PRIMER_INTERNAL_MAX_POLY_X
+ PRIMER_MAX_SIZE
+ PRIMER_PRODUCT_SIZE_RANGE
+ PRIMER_INTERNAL_MAX_SELF_ANY
+ PRIMER_MAX_TEMPLATE_MISPRIMING
+ PRIMER_QUALITY_RANGE_MAX
+ PRIMER_INTERNAL_MAX_SELF_END
+ PRIMER_MAX_TM
+ PRIMER_QUALITY_RANGE_MIN
+ PRIMER_INTERNAL_MAX_SIZE
+ PRIMER_MIN_END_QUALITY
+ PRIMER_SALT_CORRECTIONS
+ PRIMER_INTERNAL_MAX_TEMPLATE_MISHYB
+ PRIMER_MIN_GC
+ PRIMER_SALT_DIVALENT
+ PRIMER_INTERNAL_MAX_TM
+ PRIMER_MIN_QUALITY
+ PRIMER_SALT_MONOVALENT
+ PRIMER_INTERNAL_MIN_GC
+ PRIMER_MIN_SIZE
+ PRIMER_SEQUENCING_ACCURACY
+ PRIMER_INTERNAL_MIN_QUALITY
+ PRIMER_MIN_THREE_PRIME_DISTANCE
+ PRIMER_SEQUENCING_INTERVAL
+ PRIMER_INTERNAL_MIN_SIZE
+ PRIMER_MIN_TM
+ PRIMER_SEQUENCING_LEAD
+ PRIMER_INTERNAL_MIN_TM
+ PRIMER_MISPRIMING_LIBRARY
+ PRIMER_SEQUENCING_SPACING
+ PRIMER_INTERNAL_MISHYB_LIBRARY
+ PRIMER_NUM_RETURN
+ PRIMER_TASK
+ PRIMER_INTERNAL_OPT_GC_PERCENT
+ PRIMER_OPT_GC_PERCENT
+ PRIMER_TM_FORMULA
+ PRIMER_INTERNAL_OPT_SIZE
+ PRIMER_OPT_SIZE
+ PRIMER_WT_END_QUAL
+ PRIMER_INTERNAL_OPT_TM
+ PRIMER_OPT_TM
+ PRIMER_WT_END_STABILITY
+ PRIMER_INTERNAL_SALT_DIVALENT
+ PRIMER_OUTSIDE_PENALTY
+ PRIMER_WT_GC_PERCENT_GT
+ PRIMER_INTERNAL_SALT_MONOVALENT
+ PRIMER_PAIR_MAX_COMPL_ANY
+ PRIMER_WT_GC_PERCENT_LT
+ PRIMER_INTERNAL_WT_END_QUAL
+ PRIMER_PAIR_MAX_COMPL_END
+ PRIMER_WT_LIBRARY_MISPRIMING
+ PRIMER_INTERNAL_WT_GC_PERCENT_GT
+ PRIMER_PAIR_MAX_DIFF_TM
+ PRIMER_WT_NUM_NS
+ PRIMER_INTERNAL_WT_GC_PERCENT_LT
+ PRIMER_PAIR_MAX_LIBRARY_MISPRIMING
+ PRIMER_WT_POS_PENALTY
+ PRIMER_INTERNAL_WT_LIBRARY_MISHYB
+ PRIMER_PAIR_MAX_TEMPLATE_MISPRIMING
+ PRIMER_WT_SELF_ANY
+ PRIMER_INTERNAL_WT_NUM_NS
+ PRIMER_PAIR_WT_COMPL_ANY
+ PRIMER_WT_SELF_END
+ PRIMER_INTERNAL_WT_SELF_ANY
+ PRIMER_PAIR_WT_COMPL_END
+ PRIMER_WT_SEQ_QUAL
+ PRIMER_INTERNAL_WT_SELF_END
+ PRIMER_PAIR_WT_DIFF_TM
+ PRIMER_WT_SIZE_GT
+ PRIMER_INTERNAL_WT_SEQ_QUAL
+ PRIMER_PAIR_WT_IO_PENALTY
+ PRIMER_WT_SIZE_LT
+ PRIMER_INTERNAL_WT_SIZE_GT
+ PRIMER_PAIR_WT_LIBRARY_MISPRIMING
+ PRIMER_WT_TEMPLATE_MISPRIMING
+ PRIMER_INTERNAL_WT_SIZE_LT
+ PRIMER_PAIR_WT_PRODUCT_SIZE_GT
+ PRIMER_WT_TM_GT
+ PRIMER_INTERNAL_WT_TEMPLATE_MISHYB
+ PRIMER_PAIR_WT_PRODUCT_SIZE_LT
+ PRIMER_WT_TM_LT
+ PRIMER_INTERNAL_WT_TM_GT
+ PRIMER_PAIR_WT_PRODUCT_TM_GT
+ PRIMER_INTERNAL_WT_TM_LT
+ PRIMER_PAIR_WT_PRODUCT_TM_LT
+
+ P3_FILE_ID
+ P3_FILE_FLAG
+ P3_COMMENT
+);
+}
+
+=head2 new()
+
+ Title : new()
+ Usage : my $primer3 = Bio::Tools::Run::Primer3->new(-file=>$file) to read
+ a primer3 output file.
+ my $primer3 = Bio::Tools::Run::Primer3->new(-seq=>sequence object)
+ design primers against sequence
+ Function: Start primer3 working and adds a sequence. At the moment it
+ will not clear out the old sequence, but I suppose it should.
+ Returns : Does not return anything. If called with a filename will allow
+ you to retrieve the results
+ Args : -outfile : file name send output results to
+ -path : path to primer3 executable
+
+=cut
+
+sub new {
+ my($class,@args) = @_;
+ my $self = $class->SUPER::new(@args);
+ $self->io->_initialize_io();
+
+ my ($program, $outfile, $path) = $self->_rearrange(
+ [qw(PROGRAM OUTFILE PATH)], @args);
+
+ $program && $self->program_name($program);
+
+ if ($outfile) {
+ $self->outfile_name($outfile);
+ }
+ if ($path) {
+ my (undef,$path,$prog) = File::Spec->splitpath($path);
+ $self->program_dir($path);
+ $self->program_name($prog);
+ }
+
+ # determine the correct set of parameters to use (v1 vs v2)
+ my $v = ($self->executable) ? $self->version : $DEFAULT_VERSION;
+
+ my $ct = 0;
+
+ %PARAMS = ($v && $v =~ /^2/) ? map {$_ => $ct++} @P2 :
+ map {$_ => $ct++} @P1;
+
+ $self->_set_from_args(\@args,
+ -methods => [sort keys %PARAMS],
+ -create => 1
+ );
+
+ return $self;
+}
+
+=head2 program_name
+
+ Title : program_name
+ Usage : $primer3->program_name()
+ Function: holds the program name
+ Returns: string
+ Args : None
+
+=cut
+
+sub program_name {
+ my $self = shift;
+ # if explicitly set, use that
+ return $self->{'program_name'} = shift @_ if @_;
+ # then if previously set, use that
+ return $self->{'program_name'} if $self->{'program_name'};
+ # run a quick check to look for programm set class attribute if found
+ if (!$PROGRAMNAME) {
+ for (qw(primer3 primer3_core)) {
+ if ($self->io->exists_exe($_)) {
+ $PROGRAMNAME = $_;
+ last;
+ }
+ }
+ }
+ # don't set permanently, use global
+ return $PROGRAMNAME;
+}
+
+=head2 program_dir
+
+ Title : program_dir
+ Usage : $primer3->program_dir($dir)
+ Function: returns the program directory, which may also be obtained from ENV variable.
+ Returns : string
+ Args :
+
+=cut
+
+sub program_dir {
+ my ($self, $dir) = @_;
+ if ($dir) {
+ $self->{'program_dir'}=$dir;
+ }
+
+ # we need to stop here if we know what the answer is, otherwise we can
+ # never set it and then call it later
+ return $self->{'program_dir'} if $self->{'program_dir'};
+
+ if ($ENV{PRIMER3}) {
+ $self->{'program_dir'} = Bio::Root::IO->catfile($ENV{PRIMER3});
+ } else {
+ $self->{'program_dir'} = Bio::Root::IO->catfile('usr','local','bin');
+ }
+
+ return $self->{'program_dir'}
+}
+
+=head2 version
+
+ Title : version
+ Usage : $v = $prog->version();
+ Function: Determine the version number of the program
+ Example :
+ Returns : float or undef
+ Args : none
+
+=cut
+
+sub version {
+ my ($self) = @_;
+ return unless my $exe = $self->executable;
+ if (!defined $self->{'_progversion'}) {
+ my $string = `$exe -about 2>&1`;
+ my $v;
+ if ($string =~ m{primer3\s+release\s+([\d\.]+)}) {
+ $self->{'_progversion'} = $1;
+ }
+ }
+ return $self->{'_progversion'} || undef;
+}
+
+=head2 set_parameters()
+
+ Title : set_parameters()
+ Usage : $primer3->set_parameters(key=>value)
+ Function: Sets parameters for the input file
+ Returns : Returns the number of arguments added
+ Args : See the primer3 docs.
+ Notes : To set individual parameters use the associated method:
+ $primer3->PRIMER_MAX_TM(40)
+
+=cut
+
+sub set_parameters {
+ my ($self, %args)=@_;
+ # hack around _rearrange issue to deal with lack of '-'
+ my ($seq) = map {
+ $args{$_}
+ }
+ grep { uc $_ eq 'SEQ' } keys %args;
+ if (defined $seq) {
+ my @seqs = (UNIVERSAL::isa($seq, 'ARRAY')) ? @$seq : ($seq);
+ for my $s (@seqs) {
+ $self->throw("-seq must be a single or array reference of Bio::SeqI") unless (ref $seq &&
+ UNIVERSAL::isa($seq, 'Bio::SeqI'));
+ }
+ $self->{seq_cache} = \@seqs;
+ }
+
+ my $added_args = 0;
+
+ # add this back in
+ unless ($self->{'no_param_checks'}) {
+ for my $key (sort keys %args) {
+ my $method = uc $key; # consistency
+ $method =~ s/^-//; # remove possible hanging bp-like parameter prefix
+ if (!$self->can($method)) {
+ next if $method eq 'SEQ';
+ $self->warn("Parameter $key is not a valid Primer3 parameter");
+ next
+ }
+ $self->$method($args{$key});
+ $added_args++;
+ }
+ }
+ return $added_args;
+}
+
+=head2 get_parameters
+
+ Title : get_parameters
+ Usage : $obj->get_parameters
+ Function :
+ Returns :
+ Args :
+
+=cut
+
+sub get_parameters {
+ my $self = shift;
+ my %args = map {$_->[0] => $_->[1]}
+ grep { defined $_->[1] }
+ map { [$_, $self->$_] } sort keys %PARAMS;
+ return %args;
+}
+
+=head2 reset_parameters()
+
+ Title : reset_parameters()
+ Usage : $primer3->reset_parameters()
+ Function: Resets all parameters to be undef
+ Returns : none
+ Args : none; to reset specific targets call the specific method for that
+ target (i.e. $primer3->PRIMER_MAX_TM(undef))
+
+=cut
+
+sub reset_parameters {
+ my $self = shift;
+ my %args = map {$_ => undef} sort keys %PARAMS;
+ $self->_set_from_args(\%args, -methods => [sort keys %PARAMS]);
+}
+
+=head2 run
+
+ Title : run
+ Usage : $primer3->run;
+ Function: Run the primer3 program with the arguments that you have supplied.
+ Returns : A Bio::Tools::Primer3 object containing the results.
+ See the Bio::Tools::Primer3 documentation for those functions.
+ Args : Same as for add_targets() (these are just delegated to that
+ method prior creating the input file on the fly)
+ Note :
+
+
+=cut
+
+sub run {
+ my($self, @seqs) = @_;
+ my $executable = $self->executable;
+ my $out = $self->outfile_name;
+ unless ($executable && -e $executable) {
+ $self->throw("Executable was not found. Do not know where primer3 is!") if !$executable;
+ $self->throw("$executable was not found. Do not know where primer3 is!");
+ exit(-1);
+ }
+
+ my %params = $self->get_parameters;
+
+ my $file = $self->_generate_input_file(\%params, \@seqs);
+
+ my $str = "$executable < $file";
+
+ my $obj = Bio::Tools::Primer3Redux->new(-verbose => $self->verbose);
+ my @args;
+ # file output
+ if ($out) {
+ $str .= " > $out";
+ my $status = system($str);
+ if($status || !-e $out || -z $out ) {
+ my $error = ($!) ? "$! Status: $status" : "Status: $status";
+ $self->throw( "Primer3 call crashed: $error \n[command $str]\n");
+ return undef;
+ }
+ if ($obj && ref($obj)) {
+ $obj->file($out);
+ @args = (-file => $out);
+ }
+ # fh-based (no outfile)
+ } else {
+ open(my $fh,"$str |") || $self->throw("Primer3 call ($str) crashed: $?\n");
+ if ($obj && ref($obj)) {
+ $obj->fh($fh);
+ @args = (-fh => $fh);
+ } else {
+ # dump to debugging
+ my $io;
+ while(<$fh>) {$io .= $_;}
+ close($fh);
+ $self->debug($io);
+ return 1;
+ }
+ }
+ $obj->_initialize_io(@args) if $obj && ref($obj);
+ return $obj;
+}
+
+sub _generate_input_file {
+ # note that I write this to a temp file because we need both read
+ # and write access to primer3, therefore,
+ # we can't use a simple pipe.
+ my ($self, $args, $seqs) = @_;
+ my ($tmpfh, $tmpfile) = $self->io->tempfile();
+
+ # this is a hack to get around interface issues and conflicts when passing
+ # in raw sequence via PRIMER_SEQUENCE_ID and SEQUENCE (one can potentially
+ # have both). For now, push any explicitly set parameters on last
+
+ my ($id_tag, $seq_tag) = $self->version =~ /^2/ ? # v2 differs from v1
+ qw(SEQUENCE_ID SEQUENCE_TEMPLATE) : #v2
+ qw(PRIMER_SEQUENCE_ID SEQUENCE); #v1
+ my @seqdata;
+ for my $seq (@$seqs) {
+ $self->throw("Arguments to run() must be a single or array ref of Bio::SeqI")
+ if !UNIVERSAL::isa($seq, 'Bio::SeqI');
+ push @seqdata, {$id_tag => $seq->id,
+ $seq_tag => $seq->seq};
+ }
+
+ if (exists $args->{$id_tag} || exists $args->{$seq_tag}) {
+ push @seqdata, {$id_tag => $args->{$id_tag},
+ $seq_tag => $args->{$seq_tag}};
+ delete $args->{$id_tag};
+ delete $args->{$seq_tag};
+ }
+
+ # generate the common BoulderIO string to be used for each sequence
+ my $string = '';
+
+ for my $param (sort keys %$args) {
+ my $tmp = $self->$param;
+ my @data = UNIVERSAL::isa($tmp, 'ARRAY') ? @$tmp : $tmp;
+ for my $d (@data) {
+ $string .= "$param=$d\n";
+ }
+ }
+
+ $string .= "=\n";
+
+ for my $data (@seqdata) {
+ my $str = join("\n", map { "$_=".$data->{$_}} sort keys %$data)."\n$string";
+ $self->debug("TRYING\n$str");
+ print $tmpfh $str;
+ }
+
+ close($tmpfh);
+ return $tmpfile;
+}
+
+1;
Please sign in to comment.
Something went wrong with that request. Please try again.