Bio-PrimerDesigner-0.07/0000755000076400007640000000000011230162372014433 5ustar smckaysmckayBio-PrimerDesigner-0.07/Makefile0000644000076400007640000000556711175452637016126 0ustar smckaysmckay# PREREQ_PM => { Class::Base=>q[0], LWP::UserAgent=>q[0], HTTP::Response=>q[0], HTTP::Request=>q[0], Readonly=>q[0] } all : force_do_it /usr/bin/perl Build --makefile_env_macros 1 realclean : force_do_it /usr/bin/perl Build --makefile_env_macros 1 realclean /usr/bin/perl -e unlink -e shift Makefile force_do_it : @ true build : force_do_it /usr/bin/perl Build --makefile_env_macros 1 build clean : force_do_it /usr/bin/perl Build --makefile_env_macros 1 clean code : force_do_it /usr/bin/perl Build --makefile_env_macros 1 code config_data : force_do_it /usr/bin/perl Build --makefile_env_macros 1 config_data diff : force_do_it /usr/bin/perl Build --makefile_env_macros 1 diff dist : force_do_it /usr/bin/perl Build --makefile_env_macros 1 dist distcheck : force_do_it /usr/bin/perl Build --makefile_env_macros 1 distcheck distclean : force_do_it /usr/bin/perl Build --makefile_env_macros 1 distclean distdir : force_do_it /usr/bin/perl Build --makefile_env_macros 1 distdir distmeta : force_do_it /usr/bin/perl Build --makefile_env_macros 1 distmeta distsign : force_do_it /usr/bin/perl Build --makefile_env_macros 1 distsign disttest : force_do_it /usr/bin/perl Build --makefile_env_macros 1 disttest docs : force_do_it /usr/bin/perl Build --makefile_env_macros 1 docs fakeinstall : force_do_it /usr/bin/perl Build --makefile_env_macros 1 fakeinstall help : force_do_it /usr/bin/perl Build --makefile_env_macros 1 help html : force_do_it /usr/bin/perl Build --makefile_env_macros 1 html install : force_do_it /usr/bin/perl Build --makefile_env_macros 1 install manifest : force_do_it /usr/bin/perl Build --makefile_env_macros 1 manifest manpages : force_do_it /usr/bin/perl Build --makefile_env_macros 1 manpages pardist : force_do_it /usr/bin/perl Build --makefile_env_macros 1 pardist ppd : force_do_it /usr/bin/perl Build --makefile_env_macros 1 ppd ppmdist : force_do_it /usr/bin/perl Build --makefile_env_macros 1 ppmdist prereq_report : force_do_it /usr/bin/perl Build --makefile_env_macros 1 prereq_report pure_install : force_do_it /usr/bin/perl Build --makefile_env_macros 1 pure_install retest : force_do_it /usr/bin/perl Build --makefile_env_macros 1 retest skipcheck : force_do_it /usr/bin/perl Build --makefile_env_macros 1 skipcheck test : force_do_it /usr/bin/perl Build --makefile_env_macros 1 test testall : force_do_it /usr/bin/perl Build --makefile_env_macros 1 testall testcover : force_do_it /usr/bin/perl Build --makefile_env_macros 1 testcover testdb : force_do_it /usr/bin/perl Build --makefile_env_macros 1 testdb testpod : force_do_it /usr/bin/perl Build --makefile_env_macros 1 testpod testpodcoverage : force_do_it /usr/bin/perl Build --makefile_env_macros 1 testpodcoverage versioninstall : force_do_it /usr/bin/perl Build --makefile_env_macros 1 versioninstall .EXPORT : INC PREFIX DESTDIR VERBINST INSTALLDIRS TEST_VERBOSE LIB UNINST INSTALL_BASE POLLUTE Bio-PrimerDesigner-0.07/Build.PL0000444000076400007640000000463511175452637015753 0ustar smckaysmckay# $Id: Build.PL 26 2008-11-10 20:36:37Z kyclark $ use strict; use warnings; use Cwd; use Data::Dumper; use Getopt::Long; use Pod::Usage; use File::Spec::Functions 'catfile'; eval { require Module::Build }; if ( $@ =~ /Can\'t locate/ ) { print qq[Please install "Module::Build" before continuing.\n]; exit(0); } my $help = ''; my $url = ''; GetOptions( 'h|help' => \$help, 'url:s' => \$url, ); if ( $help ) { pod2usage({ -exitval => 0 }); } # # Write any local config info to the Config file # if ( $url && $url !~ m{^http://} ) { $url = 'http://' . $url; } my $cwd = cwd; my $tmpl_file = catfile( $cwd, 'templates', 'Config.pm' ); open my $in_fh, '<', $tmpl_file or die "Can't read $tmpl_file: $!\n"; my $tmpl = join('', <$in_fh>); my $config = sprintf( $tmpl, " local_url => '$url'," ); close $in_fh; my $config_pm = catfile( cwd(), 'lib', 'Bio', 'PrimerDesigner', 'Config.pm' ); open my $out_fh, '>', $config_pm or die "Can't write '$config': $!\n"; print $out_fh $config; close $out_fh; # # Here we make the Build script # my $builder = Module::Build->new( create_readme => 1, dist_name => 'Bio-PrimerDesigner', dist_abstract => 'Design PCR primers using primer3 and epcr', dist_author => 'Sheldon McKay ; Ken Youens-Clark ', module_name => 'Bio::PrimerDesigner', dist_version => 0.04, license => 'gpl', script_files => [ 'scripts/primer_designer' ], requires => { 'Class::Base' => 0, 'HTTP::Request' => 0, 'HTTP::Response' => 0, 'LWP::UserAgent' => 0, 'Readonly' => 0, }, test_requires => { 'Test::More' => 0, 'Test::Pod::Coverage' => 0, 'Test::Pod' => 0, }, ); my $tarball = $builder->dist_dir . '.tar.gz'; $builder->add_to_cleanup( $tarball, 'lib/Bio/PrimerDesigner/Config.pm' ); $builder->create_build_script; print "Now run './Build' and './Build install'\n"; exit 0; __END__ =pod =head1 NAME Build.PL - Installer for Bio::PrimerDesigner =head1 SYNOPSIS perl Build.PL [options] Options: -h|--help Show usage --url The URL to use for remote program access, e.g., http://my.org/cgi-bin/primer_designer.cgi =head1 AUTHOR Ken Youens-Clark Ekclark@cpan.orgE. =cut Bio-PrimerDesigner-0.07/MANIFEST0000444000076400007640000000072411175452637015603 0ustar smckaysmckayBuild.PL INSTALL lib/Bio/PrimerDesigner.pm lib/Bio/PrimerDesigner/epcr.pm lib/Bio/PrimerDesigner/ispcr.pm lib/Bio/PrimerDesigner/primer3.pm lib/Bio/PrimerDesigner/Remote.pm lib/Bio/PrimerDesigner/Result.pm lib/Bio/PrimerDesigner/Tables.pm Makefile.PL MANIFEST This list of files README scripts/primer_designer scripts/primer_designer.cgi t/epcr.t t/pod-coverage.t t/pod.t t/primer3.t t/primer_designer.t t/remote.t t/result.t t/tables.t templates/Config.pm META.yml Bio-PrimerDesigner-0.07/INSTALL0000444000076400007640000000171311175452637015502 0ustar smckaysmckayTo install Bio::PrimerDesigner, run the following commands: $ perl Build.PL $ ./Build $ ./Build test $ su # ./Build install To learn which arguments Build.PL accepts, run the following command: $ perl Build.PL [-h|--help] NOTE: For local installations, make sure you have installed the binary executables for your OS for primer3 and e-PCR e-PCR : http://www.ncbi.nlm.nih.gov/sutils/e-pcr/ primer3: http://primer3.sourceforge.net Included are two scripts: primer_designer.cgi: Installed on remote linux/unix webserver to provide access to thr primer3 and e-PCR binaries. Requires a server-side installation of Bio::PrimerDesigner primer_designer: Script to demonstrate Bio::PrimerDesigner functions Google Code project home page: http://code.google.com/p/bio-primer-designer/ CPAN home page: http://search.cpan.org/dist/Bio-PrimerDesigner/ If you have problems, please contact the author: Sheldon McKay Bio-PrimerDesigner-0.07/scripts/0000755000076400007640000000000011175452731016133 5ustar smckaysmckayBio-PrimerDesigner-0.07/scripts/primer_designer0000555000076400007640000004247511175452731021251 0ustar smckaysmckay#!/usr/local/bin/perl # $Id: primer_designer 10 2008-11-06 22:51:00Z kyclark $ use strict; use warnings; use Bio::PrimerDesigner; use Getopt::Long; use Pod::Usage; $| = 1; my ( $program, $num_primers, $binary_path, $method, $url, $list_aliases, $list_params, $list_designers, $show_help ); GetOptions( 'd|designer:s' => \$program, 'n|number:i' => \$num_primers, 'b|binary:s' => \$binary_path, 'm|method:s' => \$method, 'u|url:s' => \$url, 'list-aliases' => \$list_aliases, 'list-params' => \$list_params, 'h|help' => \$show_help, ) or pod2usage(2); pod2usage({ -exitval => 1 }) if $show_help; # # Create Bio::PrimerDesigner object. # my $pd = Bio::PrimerDesigner->new( program => $program, method => $method, url => $url, binary_path => $binary_path, ) or die Bio::PrimerDesigner->error; # # List paramaters to primer design program. # if ( $list_params ) { my $title = $program . ' Parameters:'; print join "\n", $title, '-' x length $title, $pd->list_params, ''; print "\n"; } # # List aliased keys to primer design program and exit. # if ( $list_aliases ) { my %alias_list = ( $pd->list_aliases ); my $longest = 0; for my $length ( map { length $_ } keys %alias_list ) { $longest = $length if $length > $longest; } my @aliases; for my $key ( sort keys %alias_list ) { my $length = length $key; my $space = ' ' x ( $longest - $length + 5 ); push @aliases, "$key$space$alias_list{$key}"; } my $header = 'Primer3 Parameter'; my $space = ' ' x ( $longest - length( $header ) + 5 ); my $title = "$header${space}Bio::PrimerDesigner Alias"; unshift @aliases, $title, '-' x length $title; print join "\n", @aliases, ''; exit; } # # Get the DNA sequence from somewhere. # chomp (my $dna = ); $num_primers ||= 5; my $length = length $dna; my $seqID = "C02D5.1"; # # Define Bio::PrimerDesigner parameters # in this case I use aliased keys # the primer3 Boulder IO keys are also valid # my %params = ( num => $num_primers, seq => $dna, sizerange => '500-600', target => '5001,200', excluded => '1,4500 5500,'.($length-5500-1), id => $seqID ); # # Design the primers. # my $result = $pd->design( %params ); # # Did it work? # die ("Some sort of primer3 error\n", $result->raw_output) unless $result && $result->left; # # Initialize e-PCR object # $method ||= 'local'; my $epcr = Bio::PrimerDesigner->new( program => 'epcr', method => $method ) or die Bio::PrimerDesigner->error; # # List paramaters for epcr program and exit. # if ( $list_params ) { my $title = 'e-PCR Parameters:'; print join "\n", $title, '-' x length $title, $epcr->list_params, ''; exit; } my $header = "Primers designed using $method primer3/e-PCR" ." installation"; my $hline = '-' x length $header; print "\n$hline\n$header\n$hline\n\nPrimer", (" " x 14), "\tF/R\t5' Coord Pair-qual\n"; for ( 1 .. $num_primers ) { my %params = ( seq => $dna, left => $result->left($_), right => $result->right($_), permute => 1 ); my $epcr_result = $epcr->design( %params ) or die $epcr->error; print "Set $_\n", $result->left($_), "\t F \t", $result->startleft($_), "\n", $result->right($_), "\t R \t", $result->startright($_), "\t", $result->qual($_)."\n", "\ne-PCR products: ", $epcr_result->products, "\n"; for my $prod ( 1 .. $epcr_result->products ) { printf "product %s: start->%s end->%s size->%s bp\n\n", $prod, $epcr_result->start($prod), $epcr_result->stop($prod), $epcr_result->size($prod), ; } } # ---------------------------------------------------- =pod =head1 NAME primer_designer.pl -- command-line interface Bio::PrimerDesigner =head1 SYNOPSIS ./primer_designer.pl [options] [dna_sequence or file] Options: -p|--program Program (default "primer3") -n|--number Number of primer sets to return (default "5") -b|--binary Path to binary executable (default "/usr/local/bin") -m|--method "local" or "remote" (default "local") -u|--url URL of remote primer3/e-PCR system (default "aceserver.biotech.ubc.ca/cgi-bin/primer_designer.cgi") --list-aliases Print alias list to primer3 input options and exit --list-params Print a list of primer3/e-PCR input options and exit -h|--help Print help and exit =head1 DESCRIPTION This script tests/demonstrates the Bio::PrimerDesigner interface to primer3 and e-PCR. It can be used with a local installation of the unix binaries or remotely via an HTTP/CGI request. =cut =head1 AUTHOR Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.eduE, Ken Youens-Clark Ekclark@cpan.orgE. =head1 SEE ALSO Bio::PrimerDesigner. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =cut __DATA__ cagagttaaagagaaaactgataattttttttccatctttctcctcacttgtgaataaactaaacgcatttctgtggacgttccaagtgtaatatgagagttgttttcatttggaaatgcgggaatatattgaatcttccattagatgttcaggaatatataaatacgttgtctgctctgaaaattcacacggaaaatctaaaaattgtcaaattatagatttcattctcaaatgactatataacattttatttttgcaatttcttttcaattaggaaacatttcaaaaagctacgttgtttttcacattcaaaatgattactgtcggtgcgttcattttccgagtttttccaatttcacgcttgctcttcttcgtaaaaaactcgtaatttagaaattgtgtctagatcaaaaaaaaaattttctgagcaatcctgaatcaggcatgctctctaaacaactctcagatatctgagatatgggaagcaaattttgagaccttactagttataaaaatcattaaaaatcaacgccgacagtttctcacagaaacttaaaccgaaaaatcccaacgaagacttcagctcttttttctttgaaatttgagacaaaggcccgttctattgtctttccgactcacatcgttcattaataaatcgttctttcttctacttcattcatcaatttcctcttgaccagagagagtccctactcttgaagctcctcttctttactcttttcttacttacgcacaaaaagtctctctatcactgcgtctctctatccatctcttctacatgtcacttgtcgtctctgcgcctctataacacgtaacaatctctaccttcaagttctctagtcacctgtcttcgtctataccttttgccacgaaaattactacgtagaagctgtcctattgtaaagatgaaacagtttgaagagaaattggatgattgtgatctattggtctcagaatttgatggatttcttttccatgttttcaattttaacgtctatattcttacctaggtactcataattttaactttgtttatatttttataaacttataagttacaatttttaaatcagttaacaacttcctataatcaaattgtattctattttttttggcacaaacacatataaatgtccaaatatttgcgcacgagtcacccctctccactcatttgccgcccaattttgacgttttcttccttgcacattttgacagcatttctaatttcaggaaattcttcatatatcaattggtcagtcacaattatcctcctcattcttggactttacgcctgtcatcgatttttgaacatgaagaagttgactcgagatgcacaggaaccacttttacgtgagtttttaaagattttttttttgaaaattgatgtcttgcattttatttagctcactggatagtagaaaaaatattttttttatctatttgaaaatcaaatgtgttaaaaaaatatttttggagaaaaataactgaaagctcctttctgaattattgttttattattaaacatttgttttcttctaactttatgttttttaatgttttttttttactttttaaatcctgaattattttgtgaaaattcaaacagtttcatttttaaaatttcaaaccctgataaaaagttcaatatttttcactgaactttaatttttttaaaagtttatgaaaatttcctatgaaattaagttcagaagttttttagctcatatccgcccctccacaaggaataaaattcgaaaatatatttatggaactatttttattttatcaatttttctcctttatcgatcactgaacagtccagacacatcaaaacacggaattggcagaaatggagatgtaagttttgagatttattgcaacaaataatttacaaaataatttcagtttattgaatatgagccaaaagcaggacccacgataaaagagcctgtagagaatatagttaaattggacgtttatatggaagcacagtgtccggatacatctaggtgagcagttagtaattaaattaatttaatatttgatttattttaagatttttccgtcaacaacttaaaaaagcgtgggatattctaggaaggctaaatcgaatcgaattgaatgtaattccatttggaaaagcgaggtgtacagagaaaggaaacgatttcgagtgagttttttttgttaattgattttaaatctgatcataaaatattgcagatgtcaatgtcagcatggtccgacagaatgtcagattaatcaattaatgaattgtgtcattgatcgatttgggtttccacatagatatttgccaggtgttttgtgtatgcagggaaaatattcattagatgaggcaatgaaatgtgttactgagaattatccatctgaatatgaaaggtatgtattttgtgccgtaaatgcatagttagaccaacgaatactttttaaaatcatacgaaatatattttcatatattatcactgaatataatagttaatgaaagagtaatgctcatttttcagttcaactttatttttcaaagaatattgaattttagaatgcgtgaatgtgcatcaggaactcgaggtcgccgccttcttgctctttccggacagaaaactgcatcactaactccagcaattgacttcattccctggattgttattaatggttcacgtaactcggatgctctttatgatctaacacagaatgtctgtgaagcaatgcaaccaatgccatctgcatgcaaagattacttacgttcattacaataatcacatcttttacgggttgacttttcgtcttatagttttttttaaaatacaattggtgtctatctatgagtgcctttcacaactcggcgggtcctaaaattgtttattatatttatttaaatttttgttgtagtttgtgttagtgtgactaacttattgtgttaattttcttaaaaagaacgttttttattaaaataaaaagttgcaaattgtaaaagtttgtgtttatcacattatgatattttgggcaattgtgaggatctattaaaaatttataaatctctttgacagtgtgtgggaaaaataagttatttttagcttctgatattttctaggattaacagaaaaaacagcaaatttcaggtatacccgcttgccagttcgtgatcaactccagtgttttccaaaaaaacaaatctacccttccccagcttcagatgttacaaactcgataaaatttgtttcagaaacatctcttcagtgtgaccacaaactagtctttcgcttccttttaacaacaaaaaatggaaaaagaaggagggatttacaagaggctacgacgatacgaatgaatgaaaacgatttgatgcaatcagctgctgcttctgcatttgccattcaatttgtcacctttctgccaaatttacacgatctgttttgagtgtggactttttgaaagtttaaaccacttttcgtcaatttttaaatgatgtttttacttcagtttttattattttgttttgcaaaaaatatttcagtatgcctgcattttttaaatatttaaagtttgattttttttaacatccaagtagaaatgatagctcacctactccaactaaattttgaccaacaactgtcacttctatatttgaagacataattaacataaatcttgaatttttgaagtaattttaatgtctgaacatcttgttttgaatcttgtttttttgccgaaaaatttgaagaaaaaagaaactgaaatattgcaaacatcgccagaatgcagacggtagggttgaataagatagagggcattgaaccctttctaattttctgttttgcaaattattttacagtaggtctgaacttcacagtttcatggtacgcccaatttttaacttcttttttgaattcaaattttctaaactacattatcgatttccatgaaaacagttgcattaacttcctctgaccattccaagaatttctggcttaccaaccgacatcactcttgccccctcgtcattaagccgtaattgatagcgacaaaaaaaaagaaaagccggctattttaatcgaatcttcttcatttgagaatggagggtgctacttgaatgggtgacaattgactcgtgaaattcttctttatcttttctccttatttttctcagaatttcttcatcatccacttttttggagtttcaaatgttaattgcaatctgtctcattttggtagtcatttggaaaacacgggggaggcgataacaggaagcttaagggatagacatacacttgcaattgtcgaaaaagcgatatctttaacgattattacgattctttcagtgtgacgtaatcctaatcagtttatttttattttttctgaaagcttcttttacgaattgcgcaattaatagtgtcagtagaaaaggcataatttttgaagaatatgccaaaatatgtaaaccctctccgttaatagcagtagctagtgatctagactatatgcaatacacactagttgtccaattgaaacaggtatccacaatattcacgatttttgaagtgtgatgtattagataatcctatcattttttcctcatcggccagtactttttttgttgttatttttgcaatatcctccgctttttattgttttcctattcacacctgtatttgattctggtttcccaaaaagaacaggcatagtttttgcgttgggaactggttttatttcagcatatcttctcatttctcaaccagaattagaaacatttttagaacaatcacatttatagcctaaatttttactaaaaatatctgaaaaacatgatatacactttgtagaatttttgaaaataatatccgcctatccatgatttaaccttattattcgaaatctgtgagattcctcaaagtagaaacataaaatttcaggcacaacacaaaagtcggaactcaattaaaatcgaataccctgtttgagatggcgtttctggctcgtaaaacgtcttctctcctaccagccaccacatcctctacagtcaagcatatgatctacgatgaaccacattttgcaatgcagaacagtttggcaaaacttatcaaagagaaaataaacccaaatgttgcacaatgggaaaagagtggaagatatccagcacattttgtgttcaaaatgcttggacaacttggagtatttgcggtgaataagcctgtaggtgaggatacttattttaaagaaaaaattttggaagttgaaaattattgaagactatggtgggactggtcgagattttgcaatgtcaatagcaatagctgaacaaattggagcagttgattgtggatcgattccaatgtcagtcatggttcaaagtgacatgagtactcctgctcttgcacaatttggtgagttctataaaacttatactgtaacttaattgatatatcaggctccgattcactccgcaatcgctttcttcgtccttcaatcaatggtgatctagttagttcaattgcagtctccgaaccacatgcaggatcagatgtatccgcaattcgcacacatgcccgtcggtacggcagcgacttgataataaatggctcaaaaatgtggataacaaatggagatcaggcagattgggcatgtgttctagtaaatacttcaaatgcgaaaaatttgcacaaaaataagtcgctggtgtgtattccactggactcaattggtgtacatcgatcaactccgttggataaattaggaatgagaagctccgatacagttcaactattttttgaagatgttagggtgagtttcttaaaatgatctacggcccctttaaccaattttaataaataattcaatgttcatttcaatcgaatcatttttcaggttccctcgtcatacataataggcgaagaaggacgtggatttgcatatcaaatgaatcaattcaatgatgagcgccttgtaacagttgctgttgggcttctcccacttcaaaaatgtataaatgagacgattgagtatgcaagagaacgattaatatttggaaagacacttctcgatcagcaatatgttcaatttcggttagccgagttggaggctgaactggaggcaacccgttctttgctctatcgaacagtgctggcacgttgccaaggcgaggatgtgagcatgttgactgcgatggcgaaattgaaaattggaagactggcaagaaaagttactgatcagtgtctacaggtgaggcgtttttgttctaaaatatacaaaaaattctcaaaatatgtatataaatcacttgtaatattctccatattagacttgaatattccttgctcttctttgtcagattatatctcggttgtatttgtttttatgaaaacaaaattgccaactaacaaaatttgtgcaaaataatttgctttattttggatgttgaactttttttgatgaaattaagacaaccgagatataaacagtcaaagtatagcaatgcaaggataattcggtatatgtttttgtgatccctccagtggcagtttttcataacttgatggtttttttatagaaatgaattggaataacgctaaagcttcattattaatattctcttaatttcagatctggggaggtgctggatatctgaatgacaatggaatatcgagagccttcagagatttccgtatattttcgattggcgctggttgcgatgaagttatgatgcagattattcataaaacacagtccaaaaggcaacagaaaagaatttgagaacatttttaaatgttatatttgtaaatacgaaaataaaatgcaattgtactgaaaacgataaaaataaaacagcgaaaaagtcatattgtatagaatttggcacgtatatctacaaccagtttctagtgacccaggtatcttgaagtaagtattcaatgaatcaattcaagttattatatttatatttgtccgcatcggaaggaaagcgcaaagaagtttctctctccgcctcatcaaattttttgtgtttgcatttcaaaaatgactgcaatgaaacgcgaattactgcgagtaagtaaagttagttttgatagaaactactgtatgagaaaaccggttgaaaagtaaagatgagcagcagtatttcatggaaaaaagagggagacaacaagagacggagtatataaggtgtcatggatgctccgagagtgtttacttctttgtttcaattttcacacttttcattcttttcattctttttgtttttcacaattatttagcagatcggtaactttttgctttgataatttcatagatactttcgaatcgaaattaattttcaaattagcctacagtaattttgctctcatctctgagttctagatcatgtttcaatttaccgaaagtgtttacacaagttaccaagaaaacaaaaaattcaagtttccgaaaattatcaaatgtttatcaaaaaggtcctatgatgtttaaaacaatttttcaaacttccagaaaaattttaacttactgtttcttgagcgtttacagtaactccggtgtttccagtaggcatagcttaccttgaaagcaggcaggcgaaaatttctctagaccaaccagaataacttactttattgctaagttgaatcaaacaattttgtaaaaaaaacgaattttggaatcatgatccctattcaagcttctagttgctggtcagctaggttttgggtttttttttggaaaaatattcaaaaaacatttatataatagttagaattaacattttttgataaaacctcgacatttttgttttgtctgaaaaaataggaaaatcttacgtttttcgaaaaaacccgtgctcgtgaaaagtatgtcctctgagagaagtaatgtttcatctgaccagttgcaactttctgtgtgcacattcttttgataaaatggtatcacagatctattctaaaagccaacatctaaattctttgctctatctttatcagttgatacggatcttctcatctcattcgcccacaatcttcccatactaattcatcaaacccacttgtaaatatacgcgcggttgatcaaaatttgtgtgtgttatggcacattgtgcaaatagttttaccacacttacatacttcaactcaaacctttgaggagtttgacagagagatggaaagatagtctgcaaacggcagatttttgaagtttcaccgctgtccatctaattttaggtatttttcggaatcttttgcaggacgttatcatctatctttcccgttatcaattagtcataattatccaattagtggcagttgttagaagaaataggtaatatgcataatagtgtcatttgccattggccacctccaccaaactttcgattatgccgttttccgttttctgtgtgtttcttcgtccttcctcatcatttctcattcgcttttttttcttcccatcttttccaacatgtcgcactaagagtgaccaaaaaacctttcaaattttgcgtgttctttcggtctttccggaagggacaaaaatcaaaacgacactggaattatgaactcatccattttccactttaaaagttgaaaaaagtaaacagcggggttattgtggtttgatctcttttaaaaatcagttaaatataggagtcaagacctcaatgagcactcttcaagatatggttctactagactcaacttgaagattttcaagagttctggagactttttcaaggctactgctttcaagcttcagaattttaaacattttggaaataatcttaaactggagttcaatagccaattgagcaatttgttataacgtttttttcttaattttttaaattagaatcagtgtaaatttataagtttcaaaattagttttgcacttatctttgggcgttactgaattttttacgtggtgaaccttgagaaaaaattctaaggcttctaattgagaaaactaatttaaattccgctcccaggagttaccaattttaatacgtttccaaaaaattaaatattcttcgaatctcatttttaaagtttccatttggcacaaaccacaataatttaagtaagacgtttgatctatgccgtagtttgtgtacttcaacgtttatccttaagtacctaggcccgtgtttttacagctctgctctttatcggtacatactgttctctgtctttattgatagaaattttgaaaaatgcaacaatatggtatctatcaggtcgtcccataagtttttgtacttttttaaaactttttgaacaagttctaaactgacagaacaaaatcgaatcttttataaatgcgcatgtatagtatgtactacttgtcaaaatttttatgcgttatttcaatatcctcctgataacaatcacggaaaccagagccacaaatagcgacatacccaaataatgggaggtgttttccttcgtcctgctattcacagggaatttatcaatgaacatgaaaacatagtattagtaaagataatgattcaaaatacatgttcagtatggttaaaattatcattagcacttattagccgttttggacgtggactatttggctcatgtttatcaagcactgagtgaacatcttcatggaataatttctcactaaaagtgatgggattattttgattgttgtttctaattttatataacaatacttgcatagtacaaatacaaacttcgttttacttgctgatttctcaatcataaattagaagcccaacactataaatgtcgggtatcacatgaggttggccatgtagattgtttgaacgaagaggccaccagtaaagtttgttaatttatttatgatacatatatccacttctaaataacactagacttaattatctatctttcattccgaggactaaatggaccaatatatgcttcaatcactcctataggcaattgttaaaagtacaaaatagtgtggttacaatgttctcaattataacatctccccatgactgaaaaaattaaatttttttaaaattttgactgcacatgatgtgcacttatcgtaaacatacacgatgcacccgttccattcccagcggcttcacaggaatcaaaaactcgggcgccatatttaattggcctcaacaattgtgtttagctacagtagtttttccggaatagttatactaaatttaaaattatttaaaacaagagtgtggaagcatctacttgacagtatatattaaccattactttaagctctgggtggtgtagaacaaactccagaaggaatggtgtaaaaagctgattctatagttactcgtttttctaaacaaccgcgggggcctgggatgccagagttatgttgcaataaggtgacaagttggtgacatgctaccactaatataaaatcttagaattgtccgaaaaagttttgggaataattcgaaaaaaagtacaaaaacttatgggacgacctgataggatatatgttaaaaactatttttgaaaaaatattttattttgaacaatgaaataaggttcctgcctcaaggtttctttttgacgcgaactccgatgacattttaattatcaaacggtctaagtgaaaatttattggacaactctttagttgaagtgcactttaggagcaggcatacatgaaggcgtgaggcaggcgtaggtcgcttacgaggcagacaatttttaaaaaaatcaccatccttttgtactaataaacactctctaaaagtttgcaatgttgtctcccaacacgaaaagttcaatcaacttctgcactcaatttttttgcaagatgacccatttgattcaagggggttaccagtagacttacctgcaaaaaaacagtattcgtgcataaatccatcaaaatgaagtgtgcgtcttcttcttagtttccgtctcccgttgtttcttaatgtatacagaagatgtacggggcagcagcagcagaaaaaagatttgcgtacaccaaacacatcaaaacgatatgcgtgaaatgagcgaatcgtccgcattctccccttttttctttcaattttcaaggagagagaaaactctgtgagacagtgaagaagtggggttttgactggaaaagaagaagaagaagaagaagaagaagaagaagaagaactgattcttatctgagttccgacgacgattccaccgttttttggtctggtcttctttcctccgcttcttcttcttctacttctcttttcacgtctttctcatatttggttgtttttcaagttttgaactctttctactacatacttttcacatgtacctttaaaaaactcataattcattttccaatgtgttgaaaactactgtaactgcttaaaagtcagaaacagtaacgaaactattttcatgataaaatcaaaaattgtttcgattcgaaaatgtttttatatactcgacatgtgtgtacatgtgtaaaccagtcgtttcaaaaattttacaaaaaaatgtaaagaaactgttcagtgatcagtatgctccagcttcttagtttcttagtttctaggacttcacacactgcctgccttcaaactaccgcctattaacatttattccggtcgctcttttgtatttattgaggaaatcaactactgtagttttttaaaaattaatttattgatttggcaatttttctttttttttcaagattcaaaaataagaaattgtattttactcaccattattcaaaaaacttgatgaaatgtttaaattttatggtaaatgatcaaaactaat Bio-PrimerDesigner-0.07/scripts/primer_designer.cgi0000555000076400007640000000647511175452731022012 0ustar smckaysmckay#!/usr/bin/perl # $Id: primer_designer.cgi 6 2008-11-06 21:34:01Z kyclark $ use strict; use warnings; use CGI ':standard'; use CGI::Carp 'fatalsToBrowser'; use Bio::PrimerDesigner; use Readonly; Readonly my %BINARY => ( primer3 => \&primer3, ePCR => \&ePCR, ); print header; check(param('check')); # # Get remote config info and re-hashify it. # my $input = param('config') or die "No config info provided"; my @config = split '#', $input; my %config = (); for (@config) { my ($key, $value) = split '=', $_; $config{$key} = $value; } # # Get binary name. # my $binary = $config{'program'} or die "No program defined"; my $method = $BINARY{ $binary } or die "Invalid binary '$binary'"; delete $config{'program'}; $method->( %config ); # ------------------------------------------------------------------- sub primer3 { my %config = @_ or die "no primer3 input"; my $primer3 = Bio::PrimerDesigner->new or die Bio::PrimerDesigner->error; my $result = $primer3->design( %config ) or die $primer3->error; print $result->raw_output; } # ------------------------------------------------------------------- sub ePCR { my %config = @_; my $local_epcr = Bio::PrimerDesigner->new( program => 'epcr') or die Bio::PrimerDesigner->error; my $result = $local_epcr->run( %config ) or die $local_epcr->error; print $result->raw_output; } exit 0; # ------------------------------------------------------------------- # # Pass the request and parameters to the local Bio::PrimerDesigner. # $binary eq 'primer3' ? primer3( %config ) : ePCR( %config ); # ------------------------------------------------------------------- sub check{ =head2 check Verifies that this CGI is active and supports the requested binary. =cut my $program = shift; if ($program) { print "$program OK\n" if $program =~ /e-PCR|primer3/; exit; } } =pod =head1 NAME primer_designer.cgi -- server-side wrapper for the primer3 and e-PCR binaries =head1 SYNOPSIS # # Design request is made client-side. # use Bio::PrimerDesigner; my $local_obj = Bio::PrimerDesigner ( method => 'remote', program => 'primer3', ) or die Bio::PrimerDesigner->error; # # Get the program input options. # (See Bio::PrimerDesigner docs for input options.) # my %options = %hash_of_input_options; # # make request and retrieve results of server-side processing # my $result = design( %options ); =head1 AUTHORS Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.eduE, Ken Youens-Clark Ekclark@cpan.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =head1 SEE ALSO Bio::PrimerDesigner, Bio::PrimerDesigner::primer3, Bio::PrimerDesigner::e-PCR. =cut Bio-PrimerDesigner-0.07/README0000444000076400007640000000712011175452637015327 0ustar smckaysmckayNAME Bio::PrimerDesigner - Design PCR Primers using primer3 and epcr SYNOPSIS use Bio::PrimerDesigner; my $pd = Bio::PrimerDesigner->new; # # Define the DNA sequence, etc. # my $dna = "CGTGC...TTCGC"; my $seqID = "sequence 1"; # # Define design parameters (native primer3 syntax) # my %params = ( PRIMER_NUM_RETURN => 2, PRIMER_SEQUENCE_ID => $seqID, SEQUENCE => $dna, PRIMER_PRODUCT_SIZE => '500-600' ); # # Or use input aliases # %param = ( num => 2, id => $seqID, seq => $dna, sizerange => '500-600' ); # # Design primers # my $results = $pd->design( %params ) or die $pd->error; # # Make sure the design was successful # if ( !$results->left ) { die "No primers found\n", $results->raw_data; } # # Get results (single primer set) # my $left_primer = $results->left; my $right_primer = $results->right; my $left_tm = $results->lefttm; # # Get results (multiple primer sets) # my @left_primers = $results->left(1..3); my @right_primers = $results->right(1..3); my @left_tms = $results->lefttm(1..3); DESCRIPTION Bio::PrimerDesigner provides a low-level interface to the primer3 and epcr binary executables and supplies methods to return the results. Because primer3 and e-PCR are only available for Unix-like operating systems, Bio::PrimerDesigner offers the ability to accessing the primer3 binary via a remote server. Local installations of primer3 or e-PCR on Unix hosts are also supported. METHODS binary_path Gets/sets path to the primer3 binary. design Makes the primer design or e-PCR request. Returns an Bio::PrimerDesigner::Result object. epcr_example Run test e-PCR job. Returns an Bio::PrimerDesigner::Results object. list_aliases Lists aliases for primer3 input/output options list_params Lists input options for primer3 or epcr, depending on the context method Gets/sets method of accessing primer3 or epcr binaries. os_is_unix Returns 1 if it looks like the operating system is a Unix variant, otherwise returns 0. primer3_example Runs a sample design job for primers. Returns an Bio::PrimerDesigner::Results object. program Gets/sets which program to use. run Alias to "design." url Gets/sets the URL for accessing the remote binaries. verify Tests local installations of primer3 or e-PCR to ensure that they are working properly. AUTHORS Copyright (C) 2003-2009 Sheldon McKay , Ken Youens-Clark . LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. SEE ALSO Bio::PrimerDesigner::primer3, Bio::PrimerDesigner::epcr. Bio-PrimerDesigner-0.07/lib/0000755000076400007640000000000011106125353015201 5ustar smckaysmckayBio-PrimerDesigner-0.07/lib/Bio/0000755000076400007640000000000011230162134015706 5ustar smckaysmckayBio-PrimerDesigner-0.07/lib/Bio/PrimerDesigner.pm0000444000076400007640000002327511230161720021172 0ustar smckaysmckaypackage Bio::PrimerDesigner; # $Id: PrimerDesigner.pm 25 2008-11-10 20:22:18Z kyclark $ =head1 NAME Bio::PrimerDesigner - Design PCR Primers using primer3 and epcr =head1 SYNOPSIS use Bio::PrimerDesigner; my $pd = Bio::PrimerDesigner->new; # # Define the DNA sequence, etc. # my $dna = "CGTGC...TTCGC"; my $seqID = "sequence 1"; # # Define design parameters (native primer3 syntax) # my %params = ( PRIMER_NUM_RETURN => 2, PRIMER_SEQUENCE_ID => $seqID, SEQUENCE => $dna, PRIMER_PRODUCT_SIZE => '500-600' ); # # Or use input aliases # %param = ( num => 2, id => $seqID, seq => $dna, sizerange => '500-600' ); # # Design primers # my $results = $pd->design( %params ) or die $pd->error; # # Make sure the design was successful # if ( !$results->left ) { die "No primers found\n", $results->raw_data; } # # Get results (single primer set) # my $left_primer = $results->left; my $right_primer = $results->right; my $left_tm = $results->lefttm; # # Get results (multiple primer sets) # my @left_primers = $results->left(1..3); my @right_primers = $results->right(1..3); my @left_tms = $results->lefttm(1..3); =head1 DESCRIPTION Bio::PrimerDesigner provides a low-level interface to the primer3 and epcr binary executables and supplies methods to return the results. Because primer3 and e-PCR are only available for Unix-like operating systems, Bio::PrimerDesigner offers the ability to accessing the primer3 binary via a remote server. Local installations of primer3 or e-PCR on Unix hosts are also supported. =head1 METHODS =cut use strict; use warnings; use Bio::PrimerDesigner::primer3; use Bio::PrimerDesigner::epcr; use Readonly; use base 'Class::Base'; Readonly my $EMPTY_STR => q{}; Readonly my %DEFAULT => ( method => 'local', binary_path => '/usr/local/bin', program => 'primer3', url => 'http://aceserver.biotech.ubc.ca/cgi-bin/primer_designer.cgi', ); Readonly my %DESIGNER => ( primer3 => 'Bio::PrimerDesigner::primer3', epcr => 'Bio::PrimerDesigner::epcr', ); Readonly our $VERSION => '0.04'; # must break like this for Module::Build to find # ------------------------------------------------------------------- sub init { my ( $self, $config ) = @_; for my $param ( qw[ program method url ] ) { $self->$param( $config->{ $param } ) or return; } if ($self->method eq 'local') { $self->binary_path( $config->{'binary_path'} ) or return; } my $loc = $self->method eq 'local' ? 'path' : 'url'; $self->{ $loc } = $config->{'path'} || $config->{'url'} || $EMPTY_STR; return $self; } # ------------------------------------------------------------------- sub binary_path { =pod =head2 binary_path Gets/sets path to the primer3 binary. =cut my $self = shift; if ( my $path = shift ) { if ( ! $self->os_is_unix ) { return $self->error("Cannot set binary_path on non-Unix-like OS"); } else { if ( -e $path ) { $self->{'binary_path'} = $path; } else { $self->error( "Can't find path to " . $self->program->binary_name . ":\nPath '$path' does not exist" ); return $EMPTY_STR; } } } unless ( defined $self->{'binary_path'} ) { $self->{'binary_path'} = ( $self->os_is_unix ) ? $DEFAULT{'binary_path'} : $EMPTY_STR; } return $self->{'binary_path'}; } # ------------------------------------------------------------------- sub design { =pod =head2 design Makes the primer design or e-PCR request. Returns an Bio::PrimerDesigner::Result object. =cut my $self = shift; my %params = @_ or $self->error("no design parameters"); my $designer = $self->{'program'}; my $method = $self->method; my $loc = $method eq 'local' ? $self->binary_path : $self->url; my $function = $designer =~ /primer3/ ? 'design' : 'run'; my $result = $designer->$function( $method, $loc, \%params ) or return $self->error( $designer->error ); return $result; } # ------------------------------------------------------------------- sub epcr_example { =head2 epcr_example Run test e-PCR job. Returns an Bio::PrimerDesigner::Results object. =cut my $self = shift; my $epcr = Bio::PrimerDesigner::epcr->new; return $epcr->verify( 'remote', $DEFAULT{'url'} ) || $self->error( $epcr->error ); } # ------------------------------------------------------------------- sub list_aliases { =pod =head2 list_aliases Lists aliases for primer3 input/output options =cut my $self = shift; my $designer = $self->program or return $self->error; return $designer->list_aliases; } # ------------------------------------------------------------------- sub list_params { =pod =head2 list_params Lists input options for primer3 or epcr, depending on the context =cut my $self = shift; my $designer = $self->program or return $self->error; return $designer->list_params; } # ------------------------------------------------------------------- sub method { =pod =head2 method Gets/sets method of accessing primer3 or epcr binaries. =cut my $self = shift; if ( my $arg = lc shift ) { return $self->error("Invalid argument for method: '$arg'") unless $arg eq 'local' || $arg eq 'remote'; if ( !$self->os_is_unix && $arg eq 'local' ) { return $self->error("Local method doesn't work on Windows"); } $self->{'method'} = $arg; } unless ( defined $self->{'method'} ) { $self->{'method'} = $self->os_is_unix ? $DEFAULT{'method'} : 'remote'; } return $self->{'method'}; } # ------------------------------------------------------------------- sub os_is_unix { =pod =head2 os_is_unix Returns 1 if it looks like the operating system is a Unix variant, otherwise returns 0. =cut my $self = shift; # technically, this should be 'os_is_not_windows' unless ( defined $self->{'os_is_unix'} ) { #$self->{'os_is_unix'} = ( $^O =~ /(n[iu]x|darwin)/ ) ? 1 : 0; $self->{'os_is_unix'} = ( $^O !~ /^MSWin/i ) ? 1 : 0; } return $self->{'os_is_unix'}; } # ------------------------------------------------------------------- sub primer3_example { =head2 primer3_example Runs a sample design job for primers. Returns an Bio::PrimerDesigner::Results object. =cut my $self = shift; my $pcr = Bio::PrimerDesigner::primer3->new; return $pcr->example || $self->error( $pcr->error ); } # ------------------------------------------------------------------- sub program { =pod =head2 program Gets/sets which program to use. =cut my $self = shift; my $program = shift || $EMPTY_STR; my $reset = 0; if ( $program ) { return $self->error("Invalid argument for program: '$program'") unless $DESIGNER{ $program }; $reset = 1; } if ( $reset || !defined $self->{'program'} ) { $program ||= $DEFAULT{'program'}; my $class = $DESIGNER{ $program }; $self->{'program'} = $class->new or return $self->error( $class->error ); } return $self->{'program'}; } # ------------------------------------------------------------------- sub run { =pod =head2 run Alias to "design." =cut my $self = shift; return $self->design( @_ ); } # ------------------------------------------------------------------- sub url { =pod =head2 url Gets/sets the URL for accessing the remote binaries. =cut my $self = shift; my $url = shift; if ( defined $url && $url eq $EMPTY_STR ) { $self->{'url'} = $EMPTY_STR; } elsif ( $url ) { $url = 'http://' . $url unless $url =~ m{https?://}; $self->{'url'} = $url; } eval { require Bio::PrimerDesigner::Config }; my $local_url = $EMPTY_STR; if ( !$@ ) { $local_url = $Bio::PrimerDesigner::Config->{'local_url'}; } return $self->{'url'} || $local_url || $DEFAULT{'url'}; } # ------------------------------------------------------------------- sub verify { =head2 verify Tests local installations of primer3 or e-PCR to ensure that they are working properly. =cut my $self = shift; my $designer = $self->{'program'}; my $method = $self->method; my $loc = $method eq 'local' ? $self->binary_path : $self->url; return $designer->verify( $method, $loc ) || $self->error( $designer->error ); } 1; # ------------------------------------------------------------------- =pod =head1 AUTHORS Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.eduE, Ken Youens-Clark Ekclark@cpan.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =head1 SEE ALSO Bio::PrimerDesigner::primer3, Bio::PrimerDesigner::epcr. =cut Bio-PrimerDesigner-0.07/lib/Bio/PrimerDesigner/0000755000076400007640000000000011175452637020647 5ustar smckaysmckayBio-PrimerDesigner-0.07/lib/Bio/PrimerDesigner/ispcr.pm0000444000076400007640000002115011175452637022322 0ustar smckaysmckaypackage Bio::PrimerDesigner::ispcr; # $Id: ispcr.pm 9 2008-11-06 22:48:20Z kyclark $ =head1 NAME Bio::PrimerDesigner::ispcr - A class for accessing the isPcr (in-silico PCR) binary =head1 SYNOPSIS use Bio::PrimerDesigner::ispcr; =head1 DESCRIPTION A low-level interface to the isPcr program. Uses supplied PCR primers, DNA sequence and stringency parameters to predict both expected and unexpected PCR products. =head1 METHODS =cut use strict; use warnings; use File::Spec::Functions 'catfile'; use File::Temp 'tempfile'; use Bio::PrimerDesigner::Remote; use Bio::PrimerDesigner::Result; use Readonly; Readonly our $VERSION => sprintf "%s", q$Revision: 24 $ =~ /(\d+)/; use base 'Class::Base'; # ------------------------------------------------------------------- sub run { =pod =head2 run Sets up the isPcr request for a single primer combination and returns an Bio::PrimerDesigner::Result object If the permute flag is true, all three possible primer combinations will be tested (ie: forward + reverse, forward + forward, reverse + reverse) =cut my $self = shift; my @result = (); my @params = @_ or return $self->error("No arguments for run method"); my $args = $_[2]; my $permute = $args->{'permute'} ? 1 : 0; my $left = $args->{'left'} or $self->error("No left primer"); my $right = $args->{'right'} or $self->error("No right primer"); $args->{'permute'} = 0; if ( $permute ) { for my $combo ( 1 .. 3 ) { my %seen = (); local $args->{'right'} = $left if $combo == 2; local $args->{'left'} = $right if $combo == 3; $params[2] = $args; my @pre_result = $self->request(@params); # # same-primer comparisons give two identical # results, we will ignore duplicates # for my $line (@pre_result) { push @result, $line unless ++$seen{$line} > 1; } } } else { @result = $self->request( @params ); } # first element will be empty shift @result; my $out = Bio::PrimerDesigner::Result->new; $out->{1}->{'products'} = @result; $out->{1}->{'raw_output'} = join('','>',@result); my $count = 0; for (@result) { $count++; s/>//; my @lines = split "\n", $_; chomp @lines; my $idline = shift @lines; my ($location) = split /\s+/, $idline; my ($start,$strand,$stop) = $location =~ /(\d+)([-+])(\d+)$/; my $size = abs($stop - $start); $out->{$count}->{'start'} = $start; $out->{$count}->{'stop'} = $out->{$count}->{'end'} = $stop; $out->{$count}->{'size'} = $size; $out->{$count}->{'amplicon'} = join '', @lines; } return $out; } # ------------------------------------------------------------------- sub request { =pod =head2 request Assembles the config file and command-line arguments and sends the request to the local binary or remote server. =cut my $self = shift; my ($method, $loc, $args) = @_; my @data = (); $method ||= 'remote'; if ( $method eq 'remote' ) { if ( ! defined $args->{'seq'} ) { $self->error( "A sequence must be supplied (not a file name) for remote ispcr" ); return ''; } my $cgi = Bio::PrimerDesigner::Remote->new; $cgi->{'program'} = 'ispcr'; $args->{'program'} = 'ispcr'; @data = $cgi->CGI_request( $loc, $args ); } elsif ( $method eq 'local') { # run ePCR locally # # required parameters # my $left = uc $args->{'left'} || $self->error("no left primer"); my $right = uc $args->{'right'} || $self->error("no right primer"); my $seq = $args->{'seq'} || ''; my $file = $args->{'seqfile'} || ''; $self->error("No sequence supplied") unless $seq || $file; # # config file # my ( $temp_loc_fh, $temp_loc ) = tempfile; print $temp_loc_fh "isPCR_test\t$left\t$right\n"; close $temp_loc_fh; # # sequence file (fasta format) # my ($seq_loc_fh, $seq_loc, $seq_file, $seq_temp); if ($seq) { ( $seq_loc_fh, $seq_loc ) = tempfile; $seq_temp = $seq_loc; print $seq_loc_fh ">test\n$seq\n"; close $seq_loc_fh; } else { $seq_loc = $file or $self->error('No sequence file'); } # # command-line arguments # my $params = ''; for my $p (qw/tileSize stepSize maxSize minSize minPerfect minGood mask/) { $params .= "-$p=$args->{$p}" if defined $args->{$p}; } $loc = catfile( $loc, $self->binary_name ); local $/ = '>'; open ISPCR, "$loc $seq_loc $temp_loc $params stdout |"; @data = (); close ISPCR; unlink $temp_loc; unlink $seq_temp if $seq_temp && -e $seq_temp; } return @data; } # ------------------------------------------------------------------- sub verify { =pod =head2 verify Check to make that the isPCR binary is installed and functioning properly. Since ispcr returns nothing if no PCR product is found in the sequence, we have to be able to distinguish between a valid, undefined output from a functioning ispcr and an undefined output for some other reason. verify uses sham ispcr data that is known to produce a PCR product. =cut my $self = shift; my ($method, $loc) = @_ or $self->error('No verify parameters'); my %param = (); $param{'left'} = 'TTGCGCATTTACGATTACGA'; $param{'right'} = 'ATGCTGTAATCGGCTGTCCT'; $param{'seq'} = 'GCAGCGAGTTGCGCATTTACGATTACGACATACGACACGA' . 'TTACAGACAGGACAGCCGATTACAGCATATCGACAGCAT'; my $result = $self->run( $method, $loc, \%param ); my $output = $result->raw_output || ''; unless ( $output =~ />\S+\s+\S+\s+\S+\s+\S+/ ) { return $self->error("ispcr did not verify!"); } else { return $result; } } # ------------------------------------------------------------------- sub binary_name { =pod =head2 binary_name Defines the binary's name on the system. =cut my $self = shift; return 'isPcr'; } # ------------------------------------------------------------------- sub list_aliases { =pod =head2 list_aliases There are no aliases to list for ispcr. =cut my $self = shift; return; } # ------------------------------------------------------------------- sub list_params { =pod =head2 list_params Returns a list of ispcr configuration options. Required ispcr input is a sequence string or file and the left and right primers. Default values will be used for the remaining options if none are supplied. =cut my $self = shift; return ( 'REQUIRED:', 'seq (string) Raw DNA sequence to search for PCR products', 'OR', 'seqfile (string) Fasta file to search for PCR products', '', 'left (string) Left primer sequence', 'right (string) Right primer sequence', '', 'OPTIONAL:', 'tileSize (int) size of match that triggers alignment (default 11)', 'stepSize (int) spacing between tiles (default 5)', 'maxSize (int) max size of PCR product (default 4000)', 'minSize (int) min size of PCR product (default 0)', 'minPerfect (int) min size of perfect match at 3 prime end of primer (default 15)', 'minGood (int) min size where there must be 2 matches for each mismatch (default 15)', 'permute (true) Try all primer combinations (l/r, l/l, r/r)', 'mask (upper|lower) Mask out lower or upper-cased sequences' ); } 1; # ------------------------------------------------------------------- =head1 AUTHOR Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.edu, Ken Y. Clark Ekclark@cpan.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =head1 SEE ALSO Bio::PrimerDesigner::primer3. =cut Bio-PrimerDesigner-0.07/lib/Bio/PrimerDesigner/Remote.pm0000444000076400007640000000701311175452637022437 0ustar smckaysmckaypackage Bio::PrimerDesigner::Remote; # $Id: Remote.pm 9 2008-11-06 22:48:20Z kyclark $ =head1 NAME Bio::PrimerDesigner::Remote - A class for remote access to Bio::PrimerDesigner =head1 SYNOPSIS use Bio::PrimerDesigner::Remote; =head1 DESCRIPTION Interface to the server-side binaries. Passes the primer design paramaters to a remote CGI, which uses a server-side installation of Bio::PrimerDesigner to process the request. =head1 METHODS =cut use strict; use warnings; use HTTP::Request; use LWP::UserAgent; use Readonly; Readonly our $VERSION => sprintf "%s", q$Revision: 24 $ =~ /(\d+)/; use base 'Class::Base'; # ------------------------------------------------------------------- sub CGI_request { =pod =head2 CGI_request Passes arguments to the URL of the remote Bio::PrimerDesigner CGI and returns the raw output for further processing by local design classes. =cut my $self = shift; my $url = shift or return $self->error('No URL specified'); $url = 'http://' . $url unless $url =~ m{https?://}; my $args = shift or return $self->error('No config file'); my $program = $args->{'program'}; my $ua = LWP::UserAgent->new; # # Is the remote server able to process our request? # unless ( $self->check( $url, $ua, $program ) ) { return $self->error("$url did not return expected result"); } my $request = HTTP::Request->new('POST', $url); # # string-ify the config hash to pass to the CGI # my @content = (); @content = map {"$_=" . $args->{$_}} keys %$args; my $content = join "#", @content; $request->content( "config=$content" ); my $response = $ua->request( $request ); my $output = $response->content; return $self->error("Some sort of HTTP error") unless $ua && $request && $response; return map { $_ . "\n" } split "\n", $output; } # ------------------------------------------------------------------- sub check { =pod =head2 check Tests the URL to make sure the host is live and the CGI returns the expected results. =cut my $self = shift; my ($url, $ua, $program) = @_; my $content = "check=" . $program; my $request = HTTP::Request->new( 'POST', $url ); $request->content( $content ); my $response = $ua->request( $request ); return $self->error("No reponse from host $url") unless $response; my $output = $response->content; return $self->error("Incorrect response from host $url") unless $output =~ /$program OK/m; return 1; } 1; # ------------------------------------------------------------------- =pod =head1 AUTHOR Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.eduE, Ken Youens-Clark Ekclark@cpan.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =head1 SEE ALSO Bio::PrimerDesigner, primer_designer.cgi. =cut Bio-PrimerDesigner-0.07/lib/Bio/PrimerDesigner/Result.pm0000444000076400007640000001421411175452637022463 0ustar smckaysmckaypackage Bio::PrimerDesigner::Result; # $Id: Result.pm 14 2008-11-07 02:40:49Z kyclark $ =head1 NAME Bio::PrimerDesigner::Result - a class for handling primer design or validation results =head1 SYNOPSIS use Bio::PrimerDesigner; # # primer3 # my $primer3_obj = Bio::PrimerDesigner->new( program => 'primer3 ); my $result = $primer3_obj->design( %hash_of_options ); my $left_primer = $result->left; my @left_primers = $result->left(1..$num_primers); # # e-PCR -- first make a hash of options from primer3 results # then run e-PCR # my $epcr_obj = Bio::PrimerDesigner->new( program => 'primer3 ); my $epcr_result = $epcr_obj->design( %hash_of_options ); my $num_products = $epcr_result->products; # # one product # my $first_prod_size = $epcr_result->size; my $first_prod_start = $epcr_result->start; my $first_prod_stop = $epcr_result->start; # # more than one product # my @pcr_product_sizes = (); for (1..$num_products) { push @pcr_product_sizes, $epcr_result->size; } =head1 DESCRIPTION Bio::PrimerDesigner::Result will autogenerate result access methods for for Native Boulder IO keys and Bio::PrimerDesigner keys for primer3, e-PCR, isPcr and ipcress. =head1 METHODS =cut use strict; use warnings; use Readonly; Readonly our $VERSION => sprintf "%s", q$Revision: 24 $ =~ /(\d+)/; use base 'Class::Base'; Readonly my @AUTO_FIELDS => qw( ***PRIMER3_KEYS*** PRIMER_LEFT_EXPLAIN PRIMER_RIGHT_EXPLAIN PRIMER_PAIR_EXPLAIN PRIMER_INTERNAL_OLIGO_EXPLAIN left_explain right_explain hyb_oligo_explain hyb_oligo lselfend PRIMER_LEFT rendstab PRIMER_LEFT_SEQUENCE prod SEQUENCE TARGET PRIMER_RIGHT_END_STABILITY right lselfany PRIMER_RIGHT_GC_PERCENT left PRIMER_PRODUCT_SIZE_RANGE PRIMER_PAIR_COMPL_END raw_output lendstab PRIMER_INTERNAL_OLIGO_TM hyb_tm PRIMER_RIGHT_SEQUENCE PRIMER_PRODUCT_SIZE PRIMER_PAIR_COMPL_ANY leftgc PRIMER_LEFT_SELF_END rightgc rqual qual PRIMER_PAIR_PENALTY PRIMER_LEFT_SELF_ANY PRIMER_SEQUENCE_ID PRIMER_LEFT_TM PRIMER_RIGHT_TM tmright PRIMER_RIGHT startright tmleft pairendcomp PRIMER_RIGHT_SELF_END PRIMER_LEFT_GC_PERCENT rselfend PRIMER_LEFT_PENALTY PRIMER_RIGHT_PENALTY EXCLUDED_REGION PRIMER_LEFT_END_STABILITY PRIMER_NUM_RETURN PRIMER_RIGHT_SELF_ANY rselfany pairanycomp lqual startleft ***other keys*** products size start stop end amplicon strand ); # ------------------------------------------------------------------- sub init { my ( $self, $config ) = @_; $self->params( $config, 'data' ); for my $sub_name ( @AUTO_FIELDS ) { next if $sub_name =~ /^\*/; no strict 'refs'; *{ $sub_name } = sub { my $self = shift; my @nums = @_; $nums[0] ||= 1; my @result = map { $self->{$_}->{$sub_name} } @nums; return @result > 1 ? @result : $result[0]; } } return $self; } # ------------------------------------------------------------------- sub keys { =pod =head2 keys This handles result method calls made via the Bio::PrimerDesigner::Result object. Returns either a scalar or list depending on the on the arguments: ------------------+------------------------ Args passed | Returns ------------------+------------------------ none scalar value for set 1 numeric n scalar value for set n numeric list 1..n list with n elements The aliased output methods (below) return a string when called in a scalar context and a list when called in a list context. The native primer3 (Boulder IO) keys can also be used. There are also e-PCR, isPcr and ipcress specific methods B =over 4 =item * left -- left primer sequence =item * right -- right primer sequence =item * hyb_oligo -- internal oligo sequence =item * startleft -- left primer 5' sequence coordinate =item * startright -- right primer 5' sequence coordinate =item * tmleft -- left primer tm =item * tmright -- right primer tm =item * qual -- primer pair penalty (Q value) =item * lqual -- left primer penalty =item * rqual -- right primer penalty =item * leftgc -- left primer % gc =item * rightgc -- right primer % gc =item * lselfany -- left primer self-complementarity (any) =item * lselfend -- left primer self-complementarity (end) =item * rselfany -- right primer self-complementarity (any) =item * rselfend -- right primer self-complementarity (end) =item * pairanycomp -- primer pair complementarity (any) =item * pairendcomp -- primer pair complementarity (end) =item * lendstab -- left primer end stability =item * rendstab -- right primer end stability =item * amplicon -- amplified PCR product =back B =over 4 =item * products -- number of PCR products =item * size -- product size =item * start -- product start coordinate =item * stop -- product stop coordinate =item * end -- synonymous with stop =item * strand -- strand of product relative to the ref. sequence (isPCR, ipcress) =item * amplicon -- returns the PCR product (isPCR only) =back =cut my $self = shift; return $self->error('method not implemented'); } 1; # ------------------------------------------------------------------- =pod =head1 AUTHOR Copyright (c) 2003-2009 Sheldon McKay Emckays@cshl.eduE, Ken Youens-Clark Ekclark@cpan.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =head1 SEE ALSO Bio::PrimerDesigner. =cut Bio-PrimerDesigner-0.07/lib/Bio/PrimerDesigner/Tables.pm0000444000076400007640000001746211175452637022427 0ustar smckaysmckaypackage Bio::PrimerDesigner::Tables; # $Id: Tables.pm 9 2008-11-06 22:48:20Z kyclark $ =pod =head1 NAME Bio::PrimerDesigner::Table -- Draw HTML tables for PCR primer display =head1 DESCRIPTION Draws simple HTML tables to display Bio::PrimerDesigner PCR primer design and e-PCR results for web applications. =head1 METHODS =cut use strict; use warnings; use Readonly; Readonly our $VERSION => sprintf "%s", q$Revision: 24 $ =~ /(\d+)/; use base 'Class::Base'; # ------------------------------------------------------------------- sub info_table { =head2 info_table Prints a two-column table for generic, key-value style annotations. Expects to be passed the name of the gene/feature/etc. and a hash of attributes. If there is an 'image' key, the value is assumed to be an image URL, which is printed in a double-wide cell at the bottom of the table. my $gene = 'Abc-1'; my %gene_info = ( Chromosome => I, Start => 100450, Stop => 102893, Strand => '+' ); my $page = Bio::PrimerDesigner::Tables->new; $page->info_table( $gene, %gene_info ); =cut my $self = shift; my $name = shift or return $self->error('No name argument'); my %info = @_ or return $self->error('No attributes'); my $image = $info{'image'} || ''; delete $info{'image'} if $image; my $table .= <<" END"; END for my $key (sort keys %info) { next if $key eq 'other'; my $ukey = ucfirst $key; $table .= <<" END"; END } my $other = $info{'other'}; $table .= <<" END" if $other; END $table .= $image ? "
$name Information
$ukey $info{$key}
Other $other
$image
" : "
"; } # ------------------------------------------------------------------- sub PCR_header { =head2 PCR_header Returns a generic header for the PCR primer table. Does not expect any argumments. =cut my $self = shift; return "
PCR Primers
" } # ------------------------------------------------------------------- sub PCR_set { =head2 PCR_set Returns the top row for the PCR primer table. Expects the primer set number as its only argument. =cut my $self = shift; my $num = shift || ''; return " "; } # ------------------------------------------------------------------- sub PCR_row { =head2 PCR_row Returns table rows with PCR primer info. Should be called once for each primer pair. Expects to be passed a hash containing the Bio::PrimerDesigner::Result object and the primer set number and an (optional) label. my $pcr_row = PCR_row( primers => $result_obj, setnum => $set_number, label => $label ); =cut my $self = shift; my %primers = @_ or return $self->error('No arguments for PCR_row method'); my $set = $primers{'setnum'} || 1; my $label = $primers{'label'} || 1; my %args = %{$primers{'primers'}{$set}}; return " "; } # ------------------------------------------------------------------- sub ePCR_row { =head2 ePCR_row Returns table rows summarizing e-PCR results. Expects to be passed an Bio::PrimerDesigner::Result e-PCR results object and an optional e-PCR label. =cut my $self = shift; my $args = shift or return $self->error('No arguments for ePCR_row method'); my %epcr = %$args; my $label = shift; my $num_prods = $epcr{1}{'products'}; my $s = $num_prods > 1 ? 's' : ''; $num_prods ||= 'No'; my $sizes = ''; for (1..$num_prods) { if ($_ == 1) { $sizes = "Size$s $epcr{$_}{'size'}" } elsif ($_ < $num_prods) { $sizes .= ", " . $epcr{$_}{'size'} } else { $sizes .= "and " . $epcr{$_}{'size'} } } $sizes .= " bp" if $num_prods ne 'No'; my $row = " "; $row; } # ------------------------------------------------------------------- sub render { =head2 render Renders the image URL. Expects to be passed a hash of the map start and stop, and other features to be mapped (i.e. gene,forward_primer,reverse_primer, label,start and stop of each feature, and gene strand). my $image = $page->render( start => $startleft, stop => $startright, feat => $features ); =cut my $self = shift; my %draw = @_ or return $self->error('No name argument'); my $start = $draw{'start'} || 0; my $stop = $draw{'stop'} || 0; my $feat = $draw{'feat'} || ''; (my $config = <<"END") =~ s/^\s+//gm; [general] bases = $start-$stop height = 12 [gene] glyph = transcript2 bgcolor = cyan label = 1 description = 1 height = 7 [forward_primer] glyph = triangle bgcolor = blue orient = E height = 7 label = 1 [reverse_primer] glyph = triangle bgcolor = green orient = W height = 7 label = 1 $feat END $config =~ s/\n/@@/gm; $config =~ s/\s+/%20/g; $config = "
"; return $config; } # ------------------------------------------------------------------- sub PCR_map { =head2 PCR_map Returns a 6 column wide table cell with the info. Will display the image of mapped primers in the browser when passed the image URL. =cut my $self = shift; my $image_url = shift || ''; return " "; } 1; # ------------------------------------------------------------------- =pod =head1 AUTHOR Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.eduE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =head1 SEE ALSO Bio::PrimerDesigner::primer3, Bio::PrimerDesigner::epcr. =cut Bio-PrimerDesigner-0.07/lib/Bio/PrimerDesigner/primer3.pm0000444000076400007640000004430211175452637022567 0ustar smckaysmckaypackage Bio::PrimerDesigner::primer3; # $Id: primer3.pm 9 2008-11-06 22:48:20Z kyclark $ =head1 NAME Bio::PrimerDesigner::primer3 - An class for accessing primer3 =head1 SYNOPSIS use Bio::PrimerDesigner::primer3; =head1 METHODS Methods are called using the simplifed alias for each primer3 result or the raw primer3 BoulderIO key. Use the raw_output method to view the raw output. =cut use strict; use warnings; use File::Spec::Functions 'catfile'; use File::Temp 'tempfile'; use Bio::PrimerDesigner::Remote; use Bio::PrimerDesigner::Result; use Readonly; Readonly our $VERSION => sprintf "%s", q$Revision: 24 $ =~ /(\d+)/; Readonly our $REMOTE_URL => 'mckay.cshl.edu/cgi-bin/primer_designer.cgi'; use base 'Class::Base'; # ------------------------------------------------------------------- sub binary_name { =pod =head2 binary_name Defines the binary's name on the system. =cut my $self = shift; return 'primer3'; } # ------------------------------------------------------------------- sub check_params { =pod =head2 check_params Make sure we have required primer3 arguments. =cut my ( $self, $args ) = @_; if ( defined $args->{'PRIMER_LEFT_INPUT'} && defined $args->{'PRIMER_RIGHT_INPUT'} ) { return $self->error( "Number of sets must be set to 1 for defined primers" ) if $args->{'PRIMER_NUM_RETURN'} > 1; return $self->error("Sequence input is missing") unless defined $args->{'SEQUENCE'}; } else { return $self->error("Required design paramaters are missing") unless defined $args->{'PRIMER_SEQUENCE_ID'} && defined $args->{'SEQUENCE'} && defined $args->{'PRIMER_PRODUCT_SIZE_RANGE'}; } return 1; } # ------------------------------------------------------------------- sub design { =pod =head2 design Build the primer3 config file, run primer3, then parse the results. Expects to be passed a hash of primer3 input options. Returns an object that can be used to call result methods. =cut my ( $self, $method, $loc, $args ) = @_; return $self->error('No arguments for design method' ) unless $args; # # Unalias incoming parameters if required. # my %aliases = $self->list_aliases; my %lookup = reverse %aliases; while ( my ( $k, $v ) = each %$args ) { next if exists $aliases{ $k }; my $alias = $lookup{ $k } or return $self->error("No alias for '$k'"); delete $args->{ $k }; $args->{ $alias } = $v; } # # Check that everything required is present. # $self->check_params( $args ) or return $self->error; # # Send request to designer. # my @data = $self->request( $method, $loc, $args ); # # abort on empty or undefined data array # return '' unless @data && @data > 1; my $output = ''; my $count = 1; my $result = Bio::PrimerDesigner::Result->new; for ( @data ) { $output .= $_;# unless /^SEQUENCE=/; # save raw output into the results hash my ($key, $value) = /(.+)=(.+)/; $result->{$count}->{$key} = $value if $key && $value; # save aliased output $result->{$count}->{'qual'} = $1 if /R_PAIR_PENALT\S+=(\S+)/ || /R_PAIR_QUAL\S+=(\S+)/; $result->{$count}->{'left'} = $1 if /R_LEFT\S+SEQUENC\S+=(\S+)/; $result->{$count}->{'right'} = $1 if /R_RIGHT\S+SEQUENC\S+=(\S+)/; $result->{$count}->{'startleft'} = $1 if /R_LEFT_?\d*=(\d+),\d+/; $result->{$count}->{'startright'} = $1 if /R_RIGHT_?\d*=(\d+),\d+/; $result->{$count}->{'lqual'} = $1 if /R_LEFT\S*_PENALT\S+=(\S+)/ || /R_LEFT\S*_QUAL\S+=(\S+)/; $result->{$count}->{'rqual'} = $1 if /R_RIGHT\S*_PENALT\S+=(\S+)/ || /R_RIGHT\S*_QUAL\S+=(\S+)/; $result->{$count}->{'leftgc'} = int $1 if /R_LEFT\S+GC_PERCEN\S+=(\S+)/; $result->{$count}->{'rightgc'} = int $1 if /R_RIGHT\S+GC_PERCEN\S+=(\S+)/; $result->{$count}->{'lselfany'} = int $1 if /R_LEFT\S+SELF_AN\S+=(\S+)/; $result->{$count}->{'rselfany'} = int $1 if /R_RIGHT\S+SELF_AN\S+=(\S+)/; $result->{$count}->{'lselfend'} = int $1 if /R_LEFT\S+SELF_EN\S+=(\S+)/; $result->{$count}->{'rselfend'} = int $1 if /R_RIGHT\S+SELF_EN\S+=(\S+)/; $result->{$count}->{'lendstab'} = int $1 if /R_LEFT\S+END_STABILIT\S+=(\S+)/; $result->{$count}->{'rendstab'} = int $1 if /R_RIGHT\S+END_STABILIT\S+=(\S+)/; $result->{$count}->{'pairendcomp'}= int $1 if /R_PAIR\S+COMPL_EN\S+=(\S+)/; $result->{$count}->{'pairanycomp'}= int $1 if /R_PAIR\S+COMPL_AN\S+=(\S+)/; $result->{$count}->{'hyb_oligo'}= lc $1 if /PRIMER_INTERNAL_OLIGO_SEQUENC\S+=(\S+)/; # # round up Primer Tm's # $result->{$count}->{'hyb_tm'}= int (0.5 + $1) if /PRIMER_INTERNAL_OLIGO\S+TM=(\d+)/; $result->{$count}->{'tmleft'} = int (0.5 + $1) if (/^PRIMER_LEFT.*_TM=(\S+)/); $result->{$count}->{'tmright'} = int (0.5 + $1) if (/^PRIMER_RIGHT.*_TM=(\S+)/); # # product size key means that we are at the end of each primer set # $result->{$count}->{'prod'} = $1 and $count++ if /^PRIMER_PRODUCT_SIZ\S+=(\S+)/ && !/RANGE/; # # abort if we encounter a primer3 error message # if (/PRIMER_ERROR/) { $self->error("Some sort of primer3 error:\n$output"); return ''; } } # # save the raw primer3 output (except for input sequence -- too big) # $result->{1}->{'raw_output'} = $output; return $result; } # ------------------------------------------------------------------- sub request { =pod =head2 request Figures out where the primer3 binary resides and accesses it with a list of parameters for designing primers. =cut my ( $self, $method, $loc, $args ) = @_; $method ||= 'remote'; my $config = ''; while ( my ( $key, $value ) = each %$args ) { $config .= "$key=$value\n"; } my @data = (); if ( $method eq 'remote' ) { my $cgi = Bio::PrimerDesigner::Remote->new or return $self->error('could not make remote object'); my $url = $loc; $args->{'program'} = $self->binary_name; @data = $cgi->CGI_request( $url, $args ); } else { # "local" my $path = $loc; my $binary_name = $self->binary_name or return; my $binary_path = catfile( $path, $binary_name ); return $self->error("Can't execute local binary '$binary_path'") unless -x $binary_path; my ( $tmp_fh, $tmp_file ) = tempfile; print $tmp_fh $config, "=\n"; close $tmp_fh; # # send the instructions to primer3 and get results # open RESULT_FILE, "$binary_path < $tmp_file |"; @data = ; close RESULT_FILE; unlink $tmp_file; } if ( $self->check_results( $method, @data ) ) { return @data; } else { return ''; } } # ------------------------------------------------------------------- sub check_results { =pod =head2 check_results Verify the validity of the design results. =cut my $self = shift; my $method = shift; my $results = join '', grep {defined} @_; my $thing = $method eq 'remote' ? 'URL' : 'binary'; my $problem = "Possible problem with the primer3 $thing"; if ( $results =~ /SEQUENCE=/m ) { return 1; } else { return $self->error("Primer design failure:\n", $problem); } } # ------------------------------------------------------------------- sub list_aliases { =pod =head2 list_aliases Prints a list of shorthand aliases for the primer3 BoulderIO input format. The full input/ouput options and the aliases can be used interchangeably. =cut my $self = shift; return ( PRIMER_SEQUENCE_ID => 'id', SEQUENCE => 'seq', INCLUDED_REGION => 'inc', TARGET => 'target', EXCLUDED_REGION => 'excluded', PRIMER_COMMENT => 'comment', PRIMER_SEQUENCE_QUALITY => 'quality', PRIMER_LEFT_INPUT => 'leftin', PRIMER_RIGHT_INPUT => 'rightin', PRIMER_START_CODON_POSITION => 'start_cod_pos', PRIMER_PICK_ANYWAY => 'pickanyway', PRIMER_MISPRIMING_LIBRARY => 'misprimelib', PRIMER_MAX_MISPRIMING => 'maxmisprime', PRIMER_PAIR_MAX_MISPRIMING => 'pairmaxmisprime', PRIMER_PRODUCT_MAX_TM => 'prodmaxtm', PRIMER_PRODUCT_MIN_TM => 'prodmintm', PRIMER_EXPLAIN_FLAG => 'explain', PRIMER_PRODUCT_SIZE_RANGE => 'sizerange', PRIMER_GC_CLAMP => 'gcclamp', PRIMER_OPT_SIZE => 'optpsize', PRIMER_INTERNAL_OLIGO_OPT_SIZE => 'hyb_opt_size', PRIMER_MIN_SIZE => 'minpsize', PRIMER_MAX_SIZE => 'maxpsize', PRIMER_OPT_TM => 'opttm', PRIMER_MIN_TM => 'mintm', PRIMER_MAX_TM => 'maxtm', PRIMER_MAX_DIFF_TM => 'maxtmdiff', PRIMER_MIN_GC => 'mingc', PRIMER_OPT_GC_PERCENT => 'optgc', PRIMER_MAX_GC => 'maxgc', PRIMER_SALT_CONC => 'saltconc', PRIMER_DNA_CONC => 'dnaconc', PRIMER_NUM_NS_ACCEPTED => 'maxN', PRIMER_SELF_ANY => 'selfany', PRIMER_SELF_END => 'selfend', PRIMER_DEFAULT_PRODUCT => 'sizerangelist', PRIMER_MAX_POLY_X => 'maxpolyX', PRIMER_LIBERAL_BASE => 'liberal', PRIMER_NUM_RETURN => 'num', PRIMER_FIRST_BASE_INDEX => '1stbaseindex', PRIMER_MAX_END_STABILITY => 'maxendstab', PRIMER_PRODUCT_OPT_TM => 'optprodtm', PRIMER_PRODUCT_OPT_SIZE => 'optprodsize', PRIMER_WT_TM_GT => 'wt_tm_gt', PRIMER_WT_TM_LT => 'wt_tm_lt', PRIMER_WT_SIZE_LT => 'wt_size_lt', PRIMER_WT_SIZE_GT => 'wt_size_gt', PRIMER_WT_GC_PERCENT_LT => 'wt_gc_lt', PRIMER_WT_GC_PERCENT_GT => 'wt_gc_gt', PRIMER_WT_COMPL_ANY => 'wt_comp_any', PRIMER_WT_COMPL_END => 'wt_comp_end', PRIMER_WT_NUM_NS => 'wt_numN', PRIMER_WT_REP_SIM => 'wt_rep_sim', PRIMER_WT_SEQ_QUAL => 'wt_seq_qual', PRIMER_WT_END_QUAL => 'wt_end_qual', PRIMER_WT_END_STABILITY => 'wt_end_stab', PRIMER_PAIR_WT_PR_PENALTY => 'wt_pr_penalty', PRIMER_PAIR_WT_DIFF_TM => 'wt_pr_tmdiff', PRIMER_PAIR_WT_COMPL_ANY => 'wt_pr_comp_any', PRIMER_PAIR_WT_COMPL_END => 'wt_pr_comp_end', PRIMER_PAIR_WT_PRODUCT_TM_LT => 'wt_prodtm_lt', PRIMER_PAIR_WT_PRODUCT_TM_GT => 'wt_prodtm_gt', PRIMER_PAIR_WT_PRODUCT_SIZE_GT => 'wt_prodsize_gt', PRIMER_PAIR_WT_PRODUCT_SIZE_LT => 'wt_prodsize_lt', PRIMER_PAIR_WT_REP_SIM => 'wt_repsim', PRIMER_PICK_INTERNAL_OLIGO => 'hyb_oligo', PRIMER_LEFT_EXPLAIN => 'left_explain', PRIMER_RIGHT_EXPLAIN => 'right_explain', PRIMER_PAIR_EXPLAIN => 'pair_explain', PRIMER_INTERNAL_OLIGO_EXPLAIN => 'hyb_explain', PRIMER_INTERNAL_OLIGO_MIN_SIZE => 'hyb_min_size', PRIMER_INTERNAL_OLIGO_MAX_SIZE => 'hyb_max_size', ); } # ------------------------------------------------------------------- sub list_params { =pod =head2 list_params Returns a list of primer3 configuration options. primer3 will use reasonable default options for most parameters. =cut my $self = shift; return ( 'PRIMER_SEQUENCE_ID (string, optional)', 'SEQUENCE (nucleotide sequence, REQUIRED)', 'INCLUDED_REGION (interval, optional)', 'TARGET (interval list, default empty)', 'EXCLUDED_REGION (interval list, default empty)', 'PRIMER_COMMENT (string, optional)', 'PRIMER_SEQUENCE_QUALITY (quality list, default empty)', 'PRIMER_LEFT_INPUT (nucleotide sequence, default empty)', 'PRIMER_RIGHT_INPUT (nucleotide sequence, default empty)', 'PRIMER_START_CODON_POSITION (int, default -1000000)', 'PRIMER_PICK_ANYWAY (boolean, default 0)', 'PRIMER_MISPRIMING_LIBRARY (string, optional)', 'PRIMER_MAX_MISPRIMING (decimal,9999.99, default 12.00)', 'PRIMER_PAIR_MAX_MISPRIMING (decimal,9999.99, default 24.00)', 'PRIMER_PRODUCT_MAX_TM (float, default 1000000.0)', 'PRIMER_PRODUCT_MIN_TM (float, default -1000000.0)', 'PRIMER_EXPLAIN_FLAG (boolean, default 0)', 'PRIMER_PRODUCT_SIZE_RANGE (size range list, default 100-300)', 'PRIMER_GC_CLAMP (int, default 0)', 'PRIMER_OPT_SIZE (int, default 20)', 'PRIMER_MIN_SIZE (int, default 18)', 'PRIMER_MAX_SIZE (int, default 27)', 'PRIMER_OPT_TM (float, default 60.0C)', 'PRIMER_MIN_TM (float, default 57.0C)', 'PRIMER_MAX_TM (float, default 63.0C)', 'PRIMER_MAX_DIFF_TM (float, default 100.0C)', 'PRIMER_MIN_GC (float, default 20.0%)', 'PRIMER_OPT_GC_PERCENT (float, default 50.0%)', 'PRIMER_MAX_GC (float, default 80.0%)', 'PRIMER_SALT_CONC (float, default 50.0 mM)', 'PRIMER_DNA_CONC (float, default 50.0 nM)', 'PRIMER_NUM_NS_ACCEPTED (int, default 0)', 'PRIMER_SELF_ANY (decimal,9999.99, default 8.00)', 'PRIMER_SELF_END (decimal 9999.99, default 3.00)', 'PRIMER_DEFAULT_PRODUCT (size range list, default 100-300)', 'PRIMER_MAX_POLY_X (int, default 5)', 'PRIMER_LIBERAL_BASE (boolean, default 0)', 'PRIMER_NUM_RETURN (int, default 5)', 'PRIMER_FIRST_BASE_INDEX (int, default 0)', 'PRIMER_MAX_END_STABILITY (float 999.9999, default 100.0)', 'PRIMER_PRODUCT_OPT_TM (float, default 0.0)', 'PRIMER_PRODUCT_OPT_SIZE (int, default 0)', '', '** PENALTY WEIGHTS **', '', 'PRIMER_WT_TM_GT (float, default 1.0)', 'PRIMER_WT_TM_LT (float, default 1.0)', 'PRIMER_WT_SIZE_LT (float, default 1.0)', 'PRIMER_WT_SIZE_GT (float, default 1.0)', 'PRIMER_WT_GC_PERCENT_LT (float, default 1.0)', 'PRIMER_WT_GC_PERCENT_GT (float, default 1.0)', 'PRIMER_WT_COMPL_ANY (float, default 0.0)', 'PRIMER_WT_COMPL_END (float, default 0.0)', 'PRIMER_WT_NUM_NS (float, default 0.0)', 'PRIMER_WT_REP_SIM (float, default 0.0)', 'PRIMER_WT_SEQ_QUAL (float, default 0.0)', 'PRIMER_WT_END_QUAL (float, default 0.0)', 'PRIMER_WT_END_STABILITY (float, default 0.0)', 'PRIMER_PAIR_WT_PR_PENALTY (float, default 1.0)', 'PRIMER_PAIR_WT_DIFF_TM (float, default 0.0)', 'PRIMER_PAIR_WT_COMPL_ANY (float, default 0.0)', 'PRIMER_PAIR_WT_COMPL_END (float, default 0.0)', 'PRIMER_PAIR_WT_PRODUCT_TM_LT (float, default 0.0)', 'PRIMER_PAIR_WT_PRODUCT_TM_GT (float, default 0.0)', 'PRIMER_PAIR_WT_PRODUCT_SIZE_GT (float, default 0.0)', 'PRIMER_PAIR_WT_PRODUCT_SIZE_LT (float, default 0.0)', 'PRIMER_PAIR_WT_REP_SIM (float, default 0.0)', ); } # ------------------------------------------------------------------- sub example { =pod =head2 example Runs a sample remote primer design job. Returns an Bio::PrimerDesigner::Result object. =cut my $self = shift; my $dna = $self->_example_dna; my $length = length $dna; my $result = $self->design( 'remote', $REMOTE_URL, { num => 1, seq => $dna, sizerange => '100-200', target => '150,10', excluded => '1,30 400,' . ($length - 401), id => 'test_seq' } ) or return $self->error("Can't get remote server call to work"); return $result; } # ------------------------------------------------------------------- sub _example_dna { =pod =head2 _example_dna Returns an example DNA sequence. =cut my $self = shift; return 'cagagttaaagagaaaactgataattttttttccatctttctcctcacttgtgaataaac' . 'taaacgcatttctgtggacgttccaagtgtaatatgagagttgttttcatttggaaatgc' . 'gggaatatattgaatcttccattagatgttcaggaatatataaatacgttgtctgctctg' . 'aaaattcacacggaaaatctaaaaattgtcaaattatagatttcattctcaaatgactat' . 'ataacattttatttttgcaatttcttttcaattaggaaacatttcaaaaagctacgttgt' . 'ttttcacattcaaaatgattactgtcggtgcgttcattttccgagtttttccaatttcac' . 'gcttgctcttcttcgtaaaaaactcgtaatttagaaattgtgtctagatcaaaaaaaaaa' . 'ttttctgagcaatcctgaatcaggcatgctctctaaacaactctcagatatctgagatat' . 'gggaagcaaattttgagaccttactagttataaaaatcattaaaaatcaacgccgacagt' . 'ttctcacagaaacttaaaccgaaaaatcccaacgaagacttcagctcttttttctttgaa'; } 1; # ------------------------------------------------------------------- =pod =head1 AUTHOR Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.eduE, Ken Youens-Clark Ekclark@cpan.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =head1 SEE ALSO Bio::PrimerDesigner::epcr. =cut Bio-PrimerDesigner-0.07/lib/Bio/PrimerDesigner/epcr.pm0000444000076400007640000002102411175452637022133 0ustar smckaysmckaypackage Bio::PrimerDesigner::epcr; # $Id: epcr.pm 9 2008-11-06 22:48:20Z kyclark $ =head1 NAME Bio::PrimerDesigner::epcr - A class for accessing the epcr binary =head1 SYNOPSIS use Bio::PrimerDesigner::epcr; =head1 DESCRIPTION A low-level interface to the e-PCR binary. Uses supplied PCR primers, DNA sequence and stringency parameters to predict both expected and unexpected PCR products. =head1 METHODS =cut use strict; use warnings; use File::Spec::Functions 'catfile'; use File::Temp 'tempfile'; use Bio::PrimerDesigner::Remote; use Bio::PrimerDesigner::Result; use Readonly; Readonly our $VERSION => sprintf "%s", q$Revision: 24 $ =~ /(\d+)/; use base 'Class::Base'; # ------------------------------------------------------------------- sub run { =head2 run Sets up the e-PCR request for a single primer combination and returns an Bio::PrimerDesigner::Result object If the permute flag is true, all three possible primer combinations will be tested (ie: forward + reverse, forward + forward, reverse + reverse) =cut my $self = shift; my @result = (); my @params = @_ or return $self->error("No arguments for run method"); my $args = $_[2]; my $permute = $args->{'permute'} ? 1 : 0; my $left = $args->{'left'} or $self->error("No left primer"); my $right = $args->{'right'} or $self->error("No right primer"); $args->{'permute'} = 0; if ( $permute ) { for my $combo ( 1 .. 3 ) { my %seen = (); local $args->{'right'} = $left if $combo == 2; local $args->{'left'} = $right if $combo == 3; $params[2] = $args; my @pre_result = $self->request(@params); # # e-pcr quirk, same-primer comparisons give two identical # results, we will ignore duplicates # for my $line (@pre_result) { push @result, $line unless $seen{$line}; $seen{$line} = 1 if !$seen{$line}; } } } else { @result = $self->request( @params ); } my $out = Bio::PrimerDesigner::Result->new; $out->{1}->{'products'} = @result; $out->{1}->{'raw_output'} = join '', grep {defined} @result; my $count = 0; for (@result) { $count++; next unless $_ && /\.\./; my ($start, $stop) = /(\d+)\.\.(\d+)/; my $size = abs($stop - $start); $out->{$count}->{'start'} = $start - 1; $out->{$count}->{'stop'} = $out->{$count}->{'end'} = $stop - 1; $out->{$count}->{'size'} = $size; } return $out; } # ------------------------------------------------------------------- sub request { =head2 request Assembles the e-PCR config file and command-line arguments and send the e-PCR request to the local e-PCR binary or remote server. =cut my $self = shift; my ($method, $loc, $args) = @_; my @data = (); $method ||= 'remote'; if ( $method eq 'remote' ) { if ( ! defined $args->{'seq'} ) { $self->error( "A sequence must be supplied (not a file name) for remote epcr" ); return ''; } my $cgi = Bio::PrimerDesigner::Remote->new; $cgi->{'program'} = 'e-PCR'; $args->{'program'} = 'e-PCR'; @data = $cgi->CGI_request( $loc, $args ); } elsif ( $method eq 'local') { # run ePCR locally # # required parameters # my $left = uc $args->{'left'} || $self->error("no left primer"); my $right = uc $args->{'right'} || $self->error("no right primer"); my $seq = $args->{'seq'} || ''; my $file = $args->{'seqfile'} || ''; $self->error("No sequence supplied") unless $seq || $file; # # optional parameters # my $prod_size = $args->{'prod_size'} || 2000; my $margin = $args->{'margin'} || 2000; my $word_size = $args->{'word_size'} || 7; my $num_mismatch = $args->{'mismatch'} || 2; # # e-PCR config file # my ( $temp_loc_fh, $temp_loc ) = tempfile; print $temp_loc_fh "ePCR_test\t$left\t$right\t$prod_size\t\n"; close $temp_loc_fh; # # e-PCR sequence file (fasta format) # my ($seq_loc_fh, $seq_loc, $seq_file, $seq_temp); if ($seq) { ( $seq_loc_fh, $seq_loc ) = tempfile; $seq_temp = $seq_loc; print $seq_loc_fh ">Test sequence\n$seq\n"; close $seq_loc_fh; } else { $seq_loc = $file or $self->error('No sequence file'); } # # e-PCR command-line arguments # my $params = "$temp_loc $seq_loc "; $params .= "M=$margin W=$word_size N=$num_mismatch"; $loc = catfile( $loc, $self->binary_name ); # # run e-PCR # open EPCR, "$loc $params |"; @data = ; close EPCR; unlink $temp_loc; unlink $seq_temp if $seq_temp && -e $seq_temp; } return @data; } # ------------------------------------------------------------------- sub verify { =head2 verify Check to make that the e-PCR binary is installed and functioning properly. Since e-PCR returns nothing if no PCR product is found in the sequence, we have to be able to distinguish between a valid, undefined output from a functioning e-PCR and an undefined output for some other reason. verify uses sham e-PCR data that is known to produce a PCR product. =cut my $self = shift; my ($method, $loc) = @_ or $self->error('No verify parameters'); my %param = (); $param{'left'} = 'TTGCGCATTTACGATTACGA'; $param{'right'} = 'ATGCTGTAATCGGCTGTCCT'; $param{'seq'} = 'GCAGCGAGTTGCGCATTTACGATTACGACATACGACACGA' . 'TTACAGACAGGACAGCCGATTACAGCATATCGACAGCAT'; $param{'prod_size'} = 70; $param{'margin'} = 20; my $result = $self->run( $method, $loc, \%param ); my $output = $result->raw_output || ''; unless ( $output =~ /\d+\.\.\d+/ ) { return $self->error("e-PCR did not verify!"); } else { return $result; } } # ------------------------------------------------------------------- sub binary_name { =pod =head2 binary_name Defines the binary's name on the system. =cut my $self = shift; return 'e-PCR'; } # ------------------------------------------------------------------- sub list_aliases { =pod =head2 list_aliases There are no aliases to list for epcr. =cut my $self = shift; return; } # ------------------------------------------------------------------- sub list_params { =pod =head2 list_params Returns a list of e-PCR configuration options. Required e-PCR input is a sequence string or file and the left and right primers. Default values will be used for the remaining options if none are supplied. =cut my $self = shift; return ( 'REQUIRED:', 'seq (string) Raw DNA sequence to search for PCR products', 'OR', 'seqfile (string) Fasta file to search for PCR products', '', 'left (string) Left primer sequence', 'right (string) Right primer sequence', '', 'OPTIONAL:', 'word_size (int; default 7) The size of the perfect match at 3\' end', 'mismatch (int; default 2) Allowed number of mismatches', 'prod_size (int; default 2000) Expected PCR product size', 'margin (int; default 2000) Allowed size variation', 'permute (true) Try all primer combinations (l/r, l/l, r/r)' ); } 1; # ------------------------------------------------------------------- =head1 AUTHOR Copyright (C) 2003-2009 Sheldon McKay Emckays@cshl.eduE, Ken Youens-Clark Ekclark@cpan.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 3 or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. =head1 SEE ALSO Bio::PrimerDesigner::primer3. =cut Bio-PrimerDesigner-0.07/META.yml0000444000076400007640000000215211230162364015703 0ustar smckaysmckay--- name: Bio-PrimerDesigner version: 0.07 author: - 'Sheldon McKay ; Ken Youens-Clark ' abstract: Design PCR primers using primer3 and epcr license: gpl resources: license: http://www.opensource.org/licenses/gpl-license.php requires: Class::Base: 0 HTTP::Request: 0 HTTP::Response: 0 LWP::UserAgent: 0 Readonly: 0 provides: Bio::PrimerDesigner: file: lib/Bio/PrimerDesigner.pm version: 0.65 Bio::PrimerDesigner::Remote: file: lib/Bio/PrimerDesigner/Remote.pm version: 0.65 Bio::PrimerDesigner::Result: file: lib/Bio/PrimerDesigner/Result.pm version: 0.65 Bio::PrimerDesigner::Tables: file: lib/Bio/PrimerDesigner/Tables.pm version: 0.65 Bio::PrimerDesigner::epcr: file: lib/Bio/PrimerDesigner/epcr.pm version: 0.65 Bio::PrimerDesigner::ispcr: file: lib/Bio/PrimerDesigner/ispcr.pm version: 0.65 Bio::PrimerDesigner::primer3: file: lib/Bio/PrimerDesigner/primer3.pm version: 0.65 generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Bio-PrimerDesigner-0.07/t/0000755000076400007640000000000011175452254014707 5ustar smckaysmckayBio-PrimerDesigner-0.07/t/pod.t0000444000076400007640000000035011106125353015641 0ustar smckaysmckay#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Bio-PrimerDesigner-0.07/t/tables.t0000444000076400007640000000217111106125353016334 0ustar smckaysmckay#!/usr/bin/perl # $Id: tables.t 16 2008-11-07 02:44:52Z kyclark $ # # Tests specific to "Bio::PrimerDesigner::Tables." # use strict; use Test::More tests => 10; use Bio::PrimerDesigner; use Data::Dumper; use_ok( 'Bio::PrimerDesigner::Tables' ); my $t = Bio::PrimerDesigner::Tables->new; isa_ok( $t, 'Bio::PrimerDesigner::Tables' ); my $pd = Bio::PrimerDesigner->new; my $pcr = $pd->primer3_example; SKIP: { skip $pd->error, 8 unless defined $pcr; #my $epcr = $pd->epcr_example; ok( $t->info_table( 'foo', bar => 'baz' ), 'info_table returns something' ); ok( $t->PCR_header, 'PCR_header returns something' ); ok( $t->PCR_set, 'PCR_set returns something' ); ok( $t->PCR_row( primers => $pcr ), 'PCR_row returns something' ); ok( !$t->PCR_row, 'PCR_row fails with no arguments' ); # # still needs work -- works locally but remote CGI fails # #ok( $t->ePCR_row( $epcr ), 'ePCR_row returns something' ); ok( !$t->ePCR_row, 'ePCR_row fails with no arguments' ); ok( $t->render(foo=>'bar'), 'render returns something' ); ok( $t->PCR_map, 'PCR_map returns something' ); } Bio-PrimerDesigner-0.07/t/result.t0000444000076400007640000000066311106125353016404 0ustar smckaysmckay#!/usr/bin/perl # $Id: result.t 16 2008-11-07 02:44:52Z kyclark $ # # Tests specific to "Bio::PrimerDesigner::Result." # use strict; use Test::More tests => 3; use_ok( 'Bio::PrimerDesigner' ); my $pd = Bio::PrimerDesigner->new; my $result = $pd->primer3_example; SKIP: { skip $pd->error, 2 if !defined $result; isa_ok( $result, 'Bio::PrimerDesigner::Result' ); ok( $result->left, 'Result returns primers' ); } Bio-PrimerDesigner-0.07/t/primer_designer.t0000444000076400007640000000621711106125353020245 0ustar smckaysmckay#!/usr/bin/perl # $Id: primer_designer.t 16 2008-11-07 02:44:52Z kyclark $ # # Tests for "Bio::PrimerDesigner" module. # use strict; my $OS_name = $^O; use Test::More; if ($OS_name =~ /n[iu]x|darwin/i) { plan tests => 22; } else { plan tests => 20; } use_ok( 'Bio::PrimerDesigner' ); my $pd = Bio::PrimerDesigner->new; isa_ok( $pd, 'Bio::PrimerDesigner' ); # # Check defaults. # isa_ok( $pd->program, 'Bio::PrimerDesigner::primer3' ); # # Non-unix tests # if ( $OS_name !~ /n[iu]x|darwin/ ) { is( $pd->method, 'remote', 'Default method for non-unix-like OS is "remote"' ); is( $pd->binary_path, '', qq[Default binary path for non-unix is ""] ); # # Check new with args. # my $pd2 = Bio::PrimerDesigner->new( binary_path => '', method => 'remote', url => 'https://www.google.com/', program => 'epcr', ) or die Bio::PrimerDesigner->error; isa_ok( $pd2, 'Bio::PrimerDesigner', 'object with args' ); is( $pd2->method, 'remote', 'method is "remote"' ); is( $pd2->url, 'https://www.google.com/', 'url is "https://www.google.com/"' ); is( $pd2->binary_path, '', 'binary_path is ""' ); isa_ok( $pd2->program, 'Bio::PrimerDesigner::epcr' ); } # # Unix tests # else { is( $pd->method, 'local', 'Default method for unix-like OS is "local"' ); my $def_bin = '/usr/local/bin'; is( $pd->binary_path, $def_bin, qq[Default binary path for unix-like OS is "$def_bin"] ); # # "binary_path" tests. # is ( $pd->binary_path('/bin'), '/bin', 'binary_path set to "/bin"' ); is ( $pd->binary_path('/foo/bar/baz/quux'), '', 'binary_path rejects bad arg' ); like( $pd->error, qr/does not exist/i, 'Error message set' ); is( $pd->binary_path, '/bin', 'binary_path remembers last good arg' ); # # Check new with args. # my $pd2 = Bio::PrimerDesigner->new( #binary_path => '/bin', method => 'remote', url => 'https://www.google.com/', program => 'epcr', ) or die Bio::PrimerDesigner->error; isa_ok( $pd2, 'Bio::PrimerDesigner', 'object with args' ); is( $pd2->method, 'remote', 'method is "remote"' ); is( $pd2->url, 'https://www.google.com/', 'url is "https://www.google.com/"' ); isa_ok( $pd2->program, 'Bio::PrimerDesigner::epcr' ); } # # "method" tests. # is( $pd->method('REMOTE'), 'remote', 'method set to "remote"' ); is( $pd->method('foo'), undef, 'method rejects bad arg' ); like( $pd->error, qr/invalid argument for method/i, 'Error message set' ); is( $pd->method, 'remote', 'method remembers last good arg' ); # # "url" tests. # my $url = 'http://www.google.com'; is( $pd->url( 'www.google.com' ), $url, qq[url set to "$url"] ); #is( $pd->url( '' ), $def_url, 'url takes empty arg, resets to default' ); # # "program" tests. # isa_ok( $pd->program('epcr'), 'Bio::PrimerDesigner::epcr', 'program' ); is( $pd->program('foo'), undef, 'program rejects bad arg' ); like( $pd->error, qr/invalid argument for program/i, 'Error message set' ); isa_ok( $pd->program, 'Bio::PrimerDesigner::epcr', 'program still' ); Bio-PrimerDesigner-0.07/t/epcr.t0000444000076400007640000000120311106125353016006 0ustar smckaysmckay#!/usr/bin/perl # $Id: epcr.t 16 2008-11-07 02:44:52Z kyclark $ # # Tests specific to "epcr" program. # use strict; use Test::More tests => 8; use_ok( 'Bio::PrimerDesigner' ); my $pd = Bio::PrimerDesigner->new; isa_ok( $pd, 'Bio::PrimerDesigner' ); my $prog = $pd->program('epcr'); isa_ok( $prog, 'Bio::PrimerDesigner::epcr', 'program' ); is( $prog->binary_name, 'e-PCR', 'binary_name is "e-PCR"' ); ok( $prog->list_params, 'program returns params' ); ok( !$prog->list_aliases, 'program returns no aliases' ); ok( !$prog->verify, 'e-PCR verification fails with no args' ); ok( !$prog->run, 'run method fails with no arguments' ); Bio-PrimerDesigner-0.07/t/pod-coverage.t0000444000076400007640000000111311106125353017430 0ustar smckaysmckayuse strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok( { also_private => [ qr/^init$/ ] } ); Bio-PrimerDesigner-0.07/t/remote.t0000444000076400007640000000110011175452067016357 0ustar smckaysmckay#!/usr/bin/perl # $Id: remote.t 16 2008-11-07 02:44:52Z kyclark $ # # Tests specific to "Bio::PrimerDesigner::Remote." # use strict; use Test::More tests => 5; use_ok( 'Bio::PrimerDesigner::Remote' ); my $rem = Bio::PrimerDesigner::Remote->new; isa_ok( $rem, 'Bio::PrimerDesigner::Remote' ); is( $rem->CGI_request, undef, 'Remote croaks with no args' ); like( $rem->error, qr/no url specified/i, 'Error because no URL' ); ok( $rem->CGI_request( 'mckay.cshl.edu/cgi-bin/primer_designer.cgi', { program => 'primer3' } ), 'Call to remote server' ); Bio-PrimerDesigner-0.07/t/primer3.t0000444000076400007640000000112411106125353016440 0ustar smckaysmckay#!/usr/bin/perl # $Id: primer3.t 16 2008-11-07 02:44:52Z kyclark $ # # Tests specific to "primer3" program. # use strict; use Test::More tests => 7; use_ok( 'Bio::PrimerDesigner' ); my $pd = Bio::PrimerDesigner->new; isa_ok( $pd, 'Bio::PrimerDesigner' ); my $prog = $pd->program('primer3'); isa_ok( $prog, 'Bio::PrimerDesigner::primer3', 'program' ); is( $prog->binary_name, 'primer3', 'binary_name is "primer3"' ); ok( $prog->list_params, 'program returns params' ); ok( $prog->list_aliases, 'program returns aliases' ); ok( !$prog->design, 'design method fails without arguments' ); Bio-PrimerDesigner-0.07/templates/0000755000076400007640000000000011106125353016431 5ustar smckaysmckayBio-PrimerDesigner-0.07/templates/Config.pm0000444000076400007640000000176411106125353020202 0ustar smckaysmckaypackage Bio::PrimerDesigner::Config; use strict; $Bio::PrimerDesigner::Config = { %s }; # ------------------------------------------------------------------- =pod =head1 NAME Bio::PrimerDesigner::Config =head1 AUTHORS Copyright (C) 2003-2008 Sheldon McKay Emckays@cshl.eduE, Ken Youens-Clark Ekclark@cpan.orgE. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. =head1 SEE ALSO Bio::PrimerDesigner. =cut Bio-PrimerDesigner-0.07/Makefile.PL0000444000076400007640000000060411175452637016421 0ustar smckaysmckay# This Makefile.PL creates a pass-through Makefile that simply calls # the equivalent Module::Build methods for each make target. See the # documentation for Module::Build::Compat for more information. use 5.005_04; use lib qw(lib); use Module::Build::Compat; Module::Build::Compat->run_build_pl(args => \@ARGV); Module::Build::Compat->write_makefile(build_class => 'Module::Build');
Set $num Primer Sequence Tm Coordinate Primer Pair Quality
$label Forward $args{'left'} $args{'tmleft'} $args{'startleft'}  
  Reverse $args{'right'} $args{'tmright'} $args{'startright'} $args{'qual'}
$label e-PCR Results:  $num_prods product${s}    $sizes
 
$image_url