From bugzilla-daemon at portal.open-bio.org Mon Feb 1 08:45:46 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Mon, 1 Feb 2010 08:45:46 -0500 Subject: [Bioperl-guts-l] [Bug 3005] New: SearchIO::Blast fails to parse result produces from ncbi url-api Message-ID: http://bugzilla.open-bio.org/show_bug.cgi?id=3005 Summary: SearchIO::Blast fails to parse result produces from ncbi url-api Product: BioPerl Version: 1.6 branch Platform: All OS/Version: Linux Status: NEW Severity: critical Priority: P2 Component: Bio::Search/Bio::SearchIO AssignedTo: bioperl-guts-l at bioperl.org ReportedBy: jiandingzhe at msn.com It recognize something as a HSP start in fault, and reports: ------------- EXCEPTION: Bio::Root::Exception ------------- MSG: no data for midline Reference: Stephen F. Altschul, Thomas L. Madden, Alejandro STACK: Error::throw STACK: Bio::Root::Root::throw /usr/lib/perl5/vendor_perl/5.10.0/Bio/Root/Root.pm:368 STACK: Bio::SearchIO::blast::next_result /usr/lib/perl5/vendor_perl/5.10.0/Bio/SearchIO/blast.pm:1805 STACK: used_bls_parse.pl:58 ----------------------------------------------------------- -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Mon Feb 1 08:50:08 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Mon, 1 Feb 2010 08:50:08 -0500 Subject: [Bioperl-guts-l] [Bug 3005] SearchIO::Blast fails to parse result produces from ncbi url-api In-Reply-To: Message-ID: <201002011350.o11Do8EH029541@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3005 ------- Comment #1 from jiandingzhe at msn.com 2010-02-01 08:50 EST ------- Created an attachment (id=1435) --> (http://bugzilla.open-bio.org/attachment.cgi?id=1435&action=view) the parser stucks at the very beginning of the file -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Mon Feb 1 09:40:44 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Mon, 1 Feb 2010 09:40:44 -0500 Subject: [Bioperl-guts-l] [Bug 3003] Bio::Tools::Run::StandAloneBlastPlus can't find an exising blast db In-Reply-To: Message-ID: <201002011440.o11EeiiQ031596@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3003 maj at fortinbras.us changed: What |Removed |Added ---------------------------------------------------------------------------- Status|NEW |RESOLVED Resolution| |FIXED ------- Comment #6 from maj at fortinbras.us 2010-02-01 09:40 EST ------- According to Mike, latest code (>r16781) appears to resolve this issue. Thanks! MAJ -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Mon Feb 1 09:40:59 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Mon, 1 Feb 2010 09:40:59 -0500 Subject: [Bioperl-guts-l] [Bug 3003] Bio::Tools::Run::StandAloneBlastPlus can't find an exising blast db In-Reply-To: Message-ID: <201002011440.o11EexpA031614@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3003 maj at fortinbras.us changed: What |Removed |Added ---------------------------------------------------------------------------- Status|RESOLVED |CLOSED ------- Comment #7 from maj at fortinbras.us 2010-02-01 09:40 EST ------- closing out -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From maj at dev.open-bio.org Mon Feb 1 19:19:57 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Mon, 1 Feb 2010 19:19:57 -0500 Subject: [Bioperl-guts-l] [16805] bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm: File:: Temp::filename is full path--fix Message-ID: <201002020019.o120Jvdl008697@dev.open-bio.org> Revision: 16805 Author: maj Date: 2010-02-01 19:19:55 -0500 (Mon, 01 Feb 2010) Log Message: ----------- File::Temp::filename is full path--fix Modified Paths: -------------- bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm Modified: bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm =================================================================== --- bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm 2010-02-01 04:48:41 UTC (rev 16804) +++ bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm 2010-02-02 00:19:55 UTC (rev 16805) @@ -593,8 +593,9 @@ my $fh = File::Temp->new(TEMPLATE => 'DBXXXXX', DIR => $self->db_dir, UNLINK => 1); - $self->{_db} = $fh->filename; - $self->{_db_path} = File::Spec->catfile($self->db_dir,$self->db); + my ($v,$d,$f) = File::Spec->splitpath($fh->filename); + $self->{_db} = $f; + $self->{_db_path} = $fh->filename; $self->_register_temp_for_cleanup($self->db_path); $fh->close; } From bugzilla-daemon at portal.open-bio.org Mon Feb 1 19:45:22 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Mon, 1 Feb 2010 19:45:22 -0500 Subject: [Bioperl-guts-l] [Bug 3005] SearchIO::Blast fails to parse result produces from ncbi url-api In-Reply-To: Message-ID: <201002020045.o120jMik017536@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3005 jiandingzhe at msn.com changed: What |Removed |Added ---------------------------------------------------------------------------- Status|NEW |RESOLVED Resolution| |INVALID ------- Comment #2 from jiandingzhe at msn.com 2010-02-01 19:45 EST ------- Not a bug. I've found the invalid pattern at the end of blast result, which contains a non-terminated hit. -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From rbuels at dev.open-bio.org Tue Feb 2 14:34:36 2010 From: rbuels at dev.open-bio.org (Robert Buels) Date: Tue, 2 Feb 2010 14:34:36 -0500 Subject: [Bioperl-guts-l] [16806] Bio-FeatureIO/trunk/Build.PL: tweaked and tidied Build.PL, adding pointer to repository, create_license Message-ID: <201002021934.o12JYaZn003099@dev.open-bio.org> Revision: 16806 Author: rbuels Date: 2010-02-02 14:34:35 -0500 (Tue, 02 Feb 2010) Log Message: ----------- tweaked and tidied Build.PL, adding pointer to repository, create_license Modified Paths: -------------- Bio-FeatureIO/trunk/Build.PL Modified: Bio-FeatureIO/trunk/Build.PL =================================================================== --- Bio-FeatureIO/trunk/Build.PL 2010-02-02 00:19:55 UTC (rev 16805) +++ Bio-FeatureIO/trunk/Build.PL 2010-02-02 19:34:35 UTC (rev 16806) @@ -8,20 +8,26 @@ use Module::Build; my $build = Module::Build->new( - dist_name => 'Bio::FeatureIO', - dist_version => '0.01', - module_name => 'Bio::FeatureIO', - dist_author => 'BioPerl Team ', - dist_abstract => 'Bio::FeatureIO - feature parsers', - license => 'perl', + dist_name => 'Bio::FeatureIO', + dist_version => '0.01', + module_name => 'Bio::FeatureIO', + dist_author => 'BioPerl Team ', + dist_abstract => 'Bio::FeatureIO - modules for reading and writing sequence features', + license => 'perl', recursive_test_files => 1, - requires => { - 'perl' => '5.6.1', - 'Bio::Root::Version' => '1.006900', - 'URI::Escape' => '0', # dealing with web resources/Bio::FeatureIO::gff,Bio::FeatureIO::interpro,Bio::DB::Biblio::eutils,Bio::DB::EUtilParameters,Bio::DB::Query::GenBank,Bio::DB::NCBIHelper,Bio::SeqFeature::Annotated', - 'XML::DOM::XPath' => '0.13', # parsing interpro features/Bio::FeatureIO::interpro', - }, - dynamic_config => 1, + create_license => 1, + meta_merge => { + 'resources' => { + 'repository' => 'svn://code.open-bio.org/bioperl/Bio-FeatureIO', + }, + }, + requires => { + 'perl' => '5.6.1', + 'Bio::Root::Version' => '1.006900', + 'URI::Escape' => '0', # dealing with web resources/Bio::FeatureIO::gff,Bio::FeatureIO::interpro,Bio::DB::Biblio::eutils,Bio::DB::EUtilParameters,Bio::DB::Query::GenBank,Bio::DB::NCBIHelper,Bio::SeqFeature::Annotated', + 'XML::DOM::XPath' => '0.13', # parsing interpro features/Bio::FeatureIO::interpro', + }, + dynamic_config => 1, ); # Create the build script and exit From maj at dev.open-bio.org Tue Feb 2 17:36:19 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Tue, 2 Feb 2010 17:36:19 -0500 Subject: [Bioperl-guts-l] [16807] bioperl-dev/trunk/Bio/Tools: dev changes assoc w/WrapperMaker Message-ID: <201002022236.o12MaJhi008287@dev.open-bio.org> Revision: 16807 Author: maj Date: 2010-02-02 17:36:19 -0500 (Tue, 02 Feb 2010) Log Message: ----------- dev changes assoc w/WrapperMaker Added Paths: ----------- bioperl-dev/trunk/Bio/Tools/Run/ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm bioperl-dev/trunk/Bio/Tools/Run/WrapperBase.pm Added: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm (rev 0) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-02 22:36:19 UTC (rev 16807) @@ -0,0 +1,1397 @@ +# $Id$ +# +# BioPerl module for Bio::Tools::Run::WrapperBase::CommandExts +# +# Please direct questions and support issues to +# +# Cared for by Mark A. Jensen +# +# Copyright Mark A. Jensen +# +# You may distribute this module under the same terms as perl itself + +# POD documentation - main docs before the code + +=head1 NAME + +Bio::Tools::Run::WrapperBase::CommandExts - Extensions to WrapperBase for handling programs with commands *BETA* + +=head1 SYNOPSIS + +Users, see L. +Devs, see L. + +=head1 DESCRIPTION + +The main idea of this module is to extend +L to make it relatively easy to create +run wrappers around I of related programs, like C or +C. + +Some definitions: + +=over + +=item * program + +The program is the command-line frontend application. C, for example, is run from the command line as follows: + + $ samtools view -bS in.bam > out.sam + $ samtools faidx + +=item * command + +The command is the specific component of a suite run by executing the +program. In the example above, C and C are commands. + +=item * command prefix + +The command prefix is an abbreviation of the command name used +internally by C method, and sometimes by the user of the +factory for specifying command line parameters to subcommands of +composite commands. + +=item * composite command + +A composite command is a pipeline or script representing a series of +separate executions of different commands. Composite commands can be +specified by configuring C appropriately; the composite +command can be run by the user from a factory in the same way as +ordinary commands. + +=item * options, parameters, switches and filespecs + +An option is any command-line option; i.e., a specification set off by +a command-line by a specifier (like C<-v> or C<--outfile>). Parameters +are command-line options that accept a value (C<-title mydb>); +switches are boolean flags (C<--no-filter>). Filespecs are barewords +at the end of the command line that usually indicate input or output +files. In this module, this includes files that capture STDIN, STDOUT, +or STDERR via redirection. + +=item * pseudo-program + +A "pseudo-program" is a way to refer to a collection of related +applications that are run independently from the command line, rather +than via a frontend program. The C suite of programs is an +example: C, C, etc. C can be +configured to create a single factory for a suite of related, +independent programs that treats each independent program as a +"pseudo-program" command. + +=back + +This module essentially adds the non-assembler-specific wrapper +machinery of fangly's L to the +L namespace, adding the general +command-handling capability of L. It creates run +factories that are automatically Bio::ParameterBaseI compliant, +meaning that C, C, +C, C, and C +are available. + +=head1 USER INTERFACE + +Using a wrapper created with C: + +=over + +=item * Getting a list of available commands, parameters, and filespecs: + +To get a list of commands, simply: + + @commands = Bio::Tools::Run::ThePkg->available_commands; + +The wrapper will generally have human-readable aliases for each of the +command-line options for the wrapped program and commands. To obtain a +list of the parameters and switches available for a particular +command, do + + $factory = Bio::Tools::Run::ThePkg->new( -command => 'glurb' ); + @params = $factory->available_parameters('params'); + @switches = $factory->available_parameters('switches'); + @filespec = $factory->available_parameters('filespec'); + @filespec = $factory->filespec; # alias + +=item * Create factories + +The factory is a handle on the program and command you wish to +run. Create a factory using C to set command-line parameters: + + $factory = Bio::Tools::Run::ThePkg->new( -command => 'glurb', + -freen => 1, + -furschlugginer => 'vreeble' ); + +A shorthand for this is: + + $factory = Bio::Tools::Run::ThePkg->new_glurb( + -freen => 1, + -furschlugginer => 'vreeble' ); + +=item * Running programs + +To run the program, use the C<_run> method, providing filespecs as arguments + + $factory = Bio::Tools::Run::ThePkg->new_assemble( -min_qual => 63 ); + $factory->_run( -faq1 => 'read1.fq', -faq2 => 'read2.fq', + -ref => 'refseq.fas', -out => 'new.sam' ); + # do another + $factory->_run( -faq1 => 'read-old1.fq', -faq2 => 'read-old2.fq', + -ref => 'refseq.fas', -out => 'old.sam' ); + +Messages on STDOUT and STDERR are dumped into their respective attributes: + + $stdout = $factory->stdout; + $stderr = $factory->stderr; + +unless STDOUT and/or STDERR are part of the named files in the filespec. + +=item * Setting/getting/resetting/polling parameters. + +A C-based factory is always L +compliant. That means that you may set, get, and reset parameters +using C, C, and +C. You can ask whether parameters have changed since +they were last accessed by using the predicate +C. See L for more details. + +Once set, parameters become attributes of the factory. Thus, you can get their values as follows: + + if ($factory->freen) { + $furs = $factory->furshlugginer; + #... + } + +=back + +=head1 DEVELOPER INTERFACE + +C is currently set up to read particular package globals +which define the program, the commands available, command-line options +for those commands, and human-readable aliases for those options. + +The easiest way to use C is probably to create two modules: + + Bio::Tools::Run::YourRunPkg + Bio::Tools::Run::YourRunPkg::Config + +The package globals should be defined in the C module, and the +run package itself should begin with the following mantra: + + use YourRunPkg::Config; + use Bio::Tools::Run::WrapperBase; + use Bio::Tools::Run::WrapperBase::CommandExts; + sub new { + my $class = shift; + my @args = @_; + my $self = $class->SUPER::new(@args); + ... + return $self; + } + +The following globals can/should be defined in the C module: + + $program_name + $program_dir + $use_dash + $join + @program_commands + %command_prefixes + @program_params + @program_switches + %param_translation + %composite_commands + %command_files + +See L for detailed descriptions. + +The work of creating a run wrapper with C lies mainly in +setting up the globals. The key methods for the developer interface are: + +=over + +=item * program_dir($path_to_programs) + +Set this to point the factory to the executables. + +=item * _run(@file_args) + +Runs an instantiated factory with the given file args. Use in the + C method override. + +=item * _create_factory_set() + +Returns a hash of instantiated factories for each true command from a +composite command factory. The hash keys are the true command names, so +you could do + + $cmds = $composite_fac->_create_factory_set; + for (@true_commands) { + $cmds->{$_}->_run(@file_args); + } + +=item * executables($cmd,[$fullpath]) + +For pseudo-programs, this gets/sets the full path to the executable of +the true program corresponding to the command C<$cmd>. + +=back + +=head2 Implementing Composite Commands + +=head2 Implementing Pseudo-programs + +To indicate that a package wraps disparate programs under a single pseudo program, use an asterisk before the program name: + + package Bio::Tools::Run::YourPkg::Config; + ... + our $program_name = '*blast+'; + +and C<_run> will know what to do. Specify the rest of the globals as +if the desired programs were commands. Use the basename of the +programs for the command names. + +If all the programs can be found in a single directory, just specify +that directory in C. If not, use C to set the paths to each program explicitly: + + foreach (keys %cmdpaths) { + $self->executables($_, $cmdpaths{$_}); + } + +=head2 Config Globals + +Here is an example config file. Further details in prose are below. + + package Dummy::Config; + use strict; + use warnings; + no warnings qw(qw); + use Exporter; + our (@ISA, @EXPORT, @EXPORT_OK); + push @ISA, 'Exporter'; + @EXPORT = qw( + $program_name + $program_dir + $use_dash + $join + @program_commands + %command_prefixes + @program_params + @program_switches + %param_translation + %command_files + %composite_commands + ); + + our $program_name = '*flurb'; + our $program_dir = 'C:\cygwin\usr\local\bin'; + our $use_dash = 'mixed'; + our $join = ' '; + + our @program_commands = qw( + rpsblast + cat + goob + blorb + multiglob + ); + + our %command_prefixes = ( + blastp => 'blp', + tblastn => 'tbn', + goob => 'g', + blorb => 'b', + multiglob => 'm' + ); + + our @program_params = qw( + command + g|narf + g|schlurb + b|scroob + b|frelb + m|trud + ); + + our @program_switches = qw( + g|freen + b|klep + ); + + our %param_translation = ( + 'g|narf' => 'n', + 'g|schlurb' => 'schlurb', + 'g|freen' => 'f', + 'b|scroob' => 's', + 'b|frelb' => 'frelb' + ); + + our %command_files = ( + 'goob' => [qw( fas faq )], + ); + @@ Diff output truncated at 10000 characters. @@ From maj at dev.open-bio.org Tue Feb 2 17:37:56 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Tue, 2 Feb 2010 17:37:56 -0500 Subject: [Bioperl-guts-l] [16808] bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm: exporting wrapper object Message-ID: <201002022237.o12Mbulx008363@dev.open-bio.org> Revision: 16808 Author: maj Date: 2010-02-02 17:37:56 -0500 (Tue, 02 Feb 2010) Log Message: ----------- exporting wrapper object Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm Property Changed: ---------------- bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm 2010-02-02 22:36:19 UTC (rev 16807) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm 2010-02-02 22:37:56 UTC (rev 16808) @@ -69,7 +69,6 @@ # Let the code begin... - package Bio::Tools::WrapperMaker; use strict; @@ -77,6 +76,8 @@ use Bio::Root::Root; use XML::Twig; +use Bio::Tools::Run::WrapperBase; +use Bio::Tools::Run::WrapperBase::CommandExts; use base qw(Bio::Root::Root ); @@ -122,6 +123,8 @@ %command_files, %accepted_types ); + at program_commands = qw(command); + our %lookups; # container for arbitrary lookup tables #create the run factory and deliver : class or instance method @@ -141,7 +144,11 @@ $self->_twig->parse($self->_defs); $self->_export_globals; # get the globals (now loaded) into the # desired namespace - return; # $an_instance_of_the_desired_namespace; + my $ns = $self->namespace; + eval "\@$ns\::ISA = qw(Bio::Tools::Run::WrapperBase + Bio::Root::Root)"; + my $wrapper = $ns->new(); + } =head2 new @@ -165,6 +172,9 @@ } $self->namespace($ns); } + else { + $self->namespace('MyWrapper'); + } unless ($defs) { $self->throw( "Definitions arg DEFS is required" ); } @@ -178,6 +188,7 @@ 'defs-version' => \&defs_version, 'perl-namespace' => \&perlns, 'commands' => \&commands, + 'self' => \&self_command, 'composite-commands' => \&composite_commands, 'lookups' => \&lookups } ); @@ -308,11 +319,18 @@ __PACKAGE__->namespace($elt->text) unless __PACKAGE__->namespace; } +sub self_command { + my ($twig, $elt) = @_; + # tricky kludge alert: + commands($twig, $elt->parent); +} + sub commands { my ($twig, $elt) = @_; foreach my $cmd ($elt->children) { # looping over commandType elements - push @program_commands, $cmd->att('name'); + push @program_commands, ($cmd->att('default') ? '*' : ''). + $cmd->att('name'); $command_prefixes{$cmd->att('name')} = $cmd->att('prefix') if $cmd->att('prefix'); # handle options Property changes on: bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm ___________________________________________________________________ Name: svn:keywords - Id Rev Date Author + Id Author Date Rev From maj at dev.open-bio.org Tue Feb 2 17:38:19 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Tue, 2 Feb 2010 17:38:19 -0500 Subject: [Bioperl-guts-l] [16809] bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd: schema tweaks and additions Message-ID: <201002022238.o12McJP4008407@dev.open-bio.org> Revision: 16809 Author: maj Date: 2010-02-02 17:38:19 -0500 (Tue, 02 Feb 2010) Log Message: ----------- schema tweaks and additions Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-02 22:37:56 UTC (rev 16808) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-02 22:38:19 UTC (rev 16809) @@ -133,6 +133,15 @@ + + + + Indicate with "true" that this command is the default (selected + when the -command parameter is not set.) + + + + @@ -344,7 +353,38 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -425,6 +465,18 @@ + + + + + This is a single, restricted commandType element, to + describe options and filespecs applied to the program + itself; that is, without an intervening command. Useful + for setting up wrappers for simple programs. The 'name' + and 'prefix" attributes are fixed at "_self". + + + @@ -460,10 +512,15 @@ - - + + + + + + + + + From maj at dev.open-bio.org Wed Feb 3 00:03:33 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Wed, 3 Feb 2010 00:03:33 -0500 Subject: [Bioperl-guts-l] [16810] bioperl-dev/trunk/Bio/Tools: pod build-out, various fixes Message-ID: <201002030503.o1353XbA014537@dev.open-bio.org> Revision: 16810 Author: maj Date: 2010-02-03 00:03:33 -0500 (Wed, 03 Feb 2010) Log Message: ----------- pod build-out, various fixes Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-02 22:38:19 UTC (rev 16809) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-03 05:03:33 UTC (rev 16810) @@ -539,13 +539,27 @@ Function: get/set the program dir Returns: string Args : string + Default : if $dir is not specified and program_dir + has not yet been set explicitly, + returns the value of the an environment + variable constructed by uppercasing the + program name and appending 'DIR'; e.g., + for samtools, the value of $SAMTOOLSDIR =cut sub program_dir { my ($self, $val) = @_; - $self->{'_program_dir'} = $val if $val; - return $self->{'_program_dir'}; + if ($val) { + $self->{'_program_dir'} = $val; + } + elsif (!$self->{'_program_dir'}) { + my $envar = uc($self->program_name)."DIR"; + return $ENV{$envar}; + } + else { + return $self->{'_program_dir'}; + } } =head2 _translate_params @@ -562,8 +576,14 @@ sub _translate_params { my ($self) = @_; # Get option string - my ($params, $switches, $join, $dash, $translat) = - @{$self->{_options}}{qw(_params _switches _join _dash _translation)}; + my ($join, $dash, $translat) = + @{$self->{_options}}{qw(_join _dash _translation)}; + + my %params = $self->get_parameters('parameters'); + my %switches = $self->get_parameters('switches'); + # submit only those options that have been set... + my $params = [keys %params]; + my $switches = [keys %switches]; # access the multiple dash choices of _setparams... my @dash_args; @@ -591,6 +611,7 @@ @dash_args = ( -dash => 1 ); }; } + $DB::single=1; my $options = $self->_setparams( -params => $params, -switches => $switches, @@ -949,6 +970,7 @@ my $exe = $self->executable; $self->throw("Can't find executable for '".($self->is_pseudo ? $self->command : $self->program_name)."'; can't continue") unless $exe; # Get command-line options + $DB::single=1; my $options = $self->_translate_params(); # Get file specs sans redirects in correct order my @specs = map { Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-02 22:38:19 UTC (rev 16809) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-03 05:03:33 UTC (rev 16810) @@ -378,7 +378,7 @@ - + @@ -508,19 +508,18 @@ + + + Note: At least one of 'commands' or 'self' MUST occur, + but both MAY occur... + + - - - - - - - - - + + Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm 2010-02-02 22:38:19 UTC (rev 16809) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm 2010-02-03 05:03:33 UTC (rev 16810) @@ -14,18 +14,248 @@ =head1 NAME -Bio::Tools::WrapperMaker - Build BioPerl wrapper classes for external pgms +Bio::Tools::WrapperMaker - DIY BioPerl wrapper classes for external pgms =head1 SYNOPSIS -Give standard usage here + $samt = Bio::Tools::WrapperMaker->compile( -defs => "samtools.xml" ); + $samt->set_parameters( -sam_input => 1, -bam_output => 1); + $samt->run( -bam => 'my.sam', -out => 'my_bam' ); + $samt = Bio::Tools::WrapperMaker->compile( -defs => $xml_string, + -xsd => 'maker_tweaked.xsd' ); + + Bio::Tools::WrapperMaker->compile( -defs => "samtools.xml", + -namespace => "My::Samtools" ); + $viewfac = My::Samtools->new_view( -sam_input => 1, -bam_output => 1); + + $viewfac->run( -bam => 'my.sam', -out => 'my_bam'); + =head1 DESCRIPTION -Describe the object here +C will produce a fully-functional BioPerl run +wrapper for any command-line program, based on a wrapper definition +file written in XML. -Discuss security issues here. +=head1 USAGE +=head2 WRAPPER DEFINITION FILE + +The wrapper definition file is an XML document that validates against +the schema C, found in the local installation directory +C<$YOUR_INSTALL_ROOT/Bio/Tools/Wrapper> or at (currently) +L. + +The definition file defines: + +=over + +=item * the program name + +=item * the commands (if any) that the program supports + +=item * the parameters and switches associated with the program and/or +individual commands + +=item * the other items (typically filenames, but not always) that +appear at the end of the command line. + +=back + +Other useful elements can appear in the definitions file; see the +documentation in C itself for more detail. + +Here is a brief overview of these components based on a simple example. + +I: + + 1 + 2 + 3 + 4 + 5 + 10 + 11 + 12 + 13 + 14 + 15 + +The root element of the schema is the C element. The namespace +definition as given is required. + +The C element (line 2) defines the name of the program as +typed on the command line. The C attribute indicates +whether C or C dashes are used to set off the program +parameters or switches. C indicates that single character +options are set off with single dashes, and long options with a double +dash. + +The C element (line 3) encompasses the options and filespecs +associated with the program itself, and not with program commands (for +example, in + + svn --version + +C is a "self option", while in + + svn update -r 16784 + +C is a command option, for the command C). Program +commands, their options and filespecs are specified in a C +element. + +The C element (line 4) specifies the options to make +available to the wrapper, and can be used to create human-readable +aliases to these options. If the C specified is an alias, the +C attribute indicates the command-line equivalent (B); compare lines 5 and 6. The C attribute specifies +either C, meaning the option takes a value (as in the C +option in the Subversion client, above), or C, meaning the +option indicates a boolean state indicated by the option's presence or +absence on the command line. + +The C element (line 10) defines how files or paths are +aliased, and also specifies stdin/stdout/stderr redirection. Each +C element (lines 11 and 12) must be included in the +definition file in the order they would appear on the command +line. The C attribute becomes the wrapper parameter for this +path. The C attribute indicates whether this filespec is optional +or required, and whether multiple files or just a single file is +allowed on the command line (C). + +This is a basic overview. The C system is +designed to support complex programs and groups of programs, and +provides many other features. See +L [to appear, one day] for +more complex examples involving programs with multiple commands, and +the representation of a group of related programs in a single wrapper. + +=head2 MAKING A WRAPPER + +To produce a run wrapper factory, use the C method: + + $lsfac = Bio::Tools::WrapperMaker->compile( -defs => 'ls.xml' ); + +or + + $lsfac = Bio::Tools::WrapperMaker->compile( -defs => $ls_xml_string ); + +The wrapper definition XML will be validated each time a factory is +compiled (if L is installed). To inhibit the validation +step, set + + $Bio::Tools::WrapperMaker::VALIDATE_DEFS = 0; + +and to turn off all validation warnings, set + + $Bio::Tools::WrapperMaker::VALIDATE_DEFS = -1; + +The run wrapper factory is placed in the Perl namespace C +by default. This namespace can be used to run any class method in +C and +C, and to set up any +package globals you may desire. For example, the following code works: + + Bio::Tools::WrapperMaker->compile( -defs => 'ls.xml' ); + + $lsfac = MyWrapper->new( -all => 1 ); + +Magic! + @@ Diff output truncated at 10000 characters. @@ From maj at dev.open-bio.org Wed Feb 3 12:56:03 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Wed, 3 Feb 2010 12:56:03 -0500 Subject: [Bioperl-guts-l] [16811] bioperl-dev/trunk/Bio/Tools: more WrapperMaker/ CommandExts crosstalk Message-ID: <201002031756.o13Hu3FL022272@dev.open-bio.org> Revision: 16811 Author: maj Date: 2010-02-03 12:56:02 -0500 (Wed, 03 Feb 2010) Log Message: ----------- more WrapperMaker/CommandExts crosstalk Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-03 05:03:33 UTC (rev 16810) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-03 17:56:02 UTC (rev 16811) @@ -419,6 +419,21 @@ use base qw(Bio::Root::Root Bio::ParameterBaseI); our $AUTOLOAD; +our @IMPORT_SYMBOLS = qw( + @program_commands + %command_prefixes + @program_params + @program_switches + %param_translation + $use_dash + $join + $program_name + $program_dir + %composite_commands + %command_files + %incompat_options + %coreq_options +); =head2 new() @@ -451,18 +466,11 @@ $name, $dir, $composite_commands, - $files); - for (qw( @program_commands - %command_prefixes - @program_params - @program_switches - %param_translation - $use_dash - $join - $program_name - $program_dir - %composite_commands - %command_files ) ) { + $files, + $incompat_options, + $coreq_options, +); + for ( @IMPORT_SYMBOLS ) { my ($sigil, $var) = m/(.)(.*)/; my $qualvar = "${sigil}${pkg}::${var}"; for ($sigil) { @@ -489,10 +497,11 @@ } @registry{qw( _commands _default_command _prefixes _files _params _switches _translation - _composite_commands )} = + _composite_commands _incompat _coreq )} = ($commands, $default_command, $prefixes, $files, $params, $switches, $translation, - $composite_commands); + $composite_commands, $incompat_options, $coreq_options); + $self->{_options} = \%registry; if (not defined $use_dash) { $self->{'_options'}->{'_dash'} = 1; @@ -1196,6 +1205,18 @@ } } +# options predicates + +sub _is_parameter { + my ($self, $opt) = @_; + return grep /^$opt$/, $self->available_parameters('parameters'); +} + +sub _is_switch { + my ($self, $opt) = @_; + return grep /^$opt$/, $self->available_parameters('switches'); +} + =head1 Bio:ParameterBaseI compliance =head2 set_parameters() @@ -1212,11 +1233,11 @@ my ($self, @args) = @_; # currently stored stuff my $opts = $self->{'_options'}; - my $params = $opts->{'_params'}; - my $switches = $opts->{'_switches'}; - my $translation = $opts->{'_translation'}; - my $use_dash = $opts->{'_dash'}; - my $join = $opts->{'_join'}; + my ($params, $switches, $translation, $use_dash, $join) = + @{$opts}{qw(_params _switches _translation _dash _join)}; + # check incompatibilites and corequisites, attempting to DTRT + # (ripped for kortsch's Bowtie, thanks Dan) + $self->_massage_options(@args); unless (($self->can('command') && $self->command) || (grep /command/, @args)) { if ($opts->{'_default_command'}) { @@ -1416,4 +1437,45 @@ return @ret; } +# DTRT with incompatible/corequired options; +# if impossible, throw... +# liberally ripped from kortsch's Bowtie.pm + +sub _massage_options { + my $self = shift; + my %args = @_; + my ($incompat, $coreqs) = @{$self->{_options}}{qw( _incompat _coreq)}; + foreach (keys %args) { + my @added; + my @removed; + s/^-//; + foreach my $conflict (@{$$incompat{$_}}) { + if (grep /$conflict/, @added) { + $self->debug("Argument imcompatibility cannot be resolved : '$conflict' is required by one option and incompatible with another"); + return; + } + delete $args{'-'.$conflict}; + if ($self->{'_'.$conflict}) { + $args{'-'.$conflict} = undef; + push @removed, $conflict; + } + } + foreach my $requirement (@{$$coreqs{$_}}) { + if (grep /$requirement/, @removed) { + $self->debug("Argument imcompatibility cannot be resolved : '$requirement' is incompatible with one option and required by another"); + return; + } + if ($self->_is_switch($requirement)) { + $args{'-'.$requirement}=1 if $args{$_}; + push @added, $requirement; + } + else { + $self->debug("The co-required option '$requirement', which itself requires an argument, is not specified"); + return; + } + } + $self->debug("Removed incompatibilities : \n".join("\n", @removed)."\n") if @removed; + $self->debug("Added corequisites : \n".join("\n", at added)."\n") if @added; + } +} 1; Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm 2010-02-03 05:03:33 UTC (rev 16810) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm 2010-02-03 17:56:02 UTC (rev 16811) @@ -206,7 +206,7 @@ (Or you might have little heart-to-heart with your sysadmin.) -=head2 USING THE WRAPPER OBJECT +=head2 USING THE WRAPPER OBJECT DIRECTLY The wrapper object will manage the program according to the facilities in C. It will automatically @@ -229,6 +229,49 @@ $lsfac->run( -pth => "~" ); @myfiles = split("\n", $lsfac->stdout); +=head2 USING WRAPPERMAKER IN A NEW WRAPPER MODULE + +If you are designing a new wrapper module that requires more complex +sanity checking or other computation than C provides, you +can use C to "initialize" that module. Set the +C<-namespace> parameter to the qualified module name: + + package My::Complex::Wrapper; + use strict; + use warnings; + use Bio::Tools::WrapperMaker; + my $WRAPPER_DEFS = "./complex_wrapper.xml"; + + Bio::Tools::WrapperMaker->compile( + -defs => $WRAPPER_DEFS, + -namespace => __PACKAGE__ ); + + sub additional_computation { + my $self; + ... + } + ... + 1; + + +In support of this usage, C defines the +element. It can be used to define arbitrary lookup hashes, which +C will import as package globals: + + + ... + + + + + + + ... + + + +The C of the C members is an arbitrary string. + =head1 SECURITY NOTES Because this module is designed to run commands outside Perl as directed @@ -320,7 +363,7 @@ our $LOCAL_XSD = File::Spec->catfile($where_i_am, "WrapperMaker","maker.xsd"); # config globals for export to specified namespace: -my @export_symbols = +my @EXPORT_SYMBOLS = qw( $defs_version $version @@ -334,7 +377,7 @@ %command_prefixes %composite_commands %incompat_options - %corequisite_options + %coreq_options %param_translation %command_files %accepted_types @@ -352,15 +395,14 @@ @program_params, @program_switches, %incompat_options, - %corequisite_options, + %coreq_options, %param_translation, %command_files, - %accepted_types ); + %accepted_types, + %lookups); @program_commands = qw(command); -our %lookups; # container for arbitrary lookup tables - #create the run factory and deliver : class or instance method # main user access; validation and parse happens here... @@ -479,7 +521,7 @@ no strict qw(subs); ### my $ns = $self->namespace; $ns ||= "MyWrapper"; - foreach (@export_symbols) { + foreach (@EXPORT_SYMBOLS) { # export only if symbol defined... if ( defined(eval) ) { /(.)(.*)/; @@ -488,6 +530,12 @@ eval "$sigil$ns\::$token = $_"; } } + # handle lookup tables... + if (%lookups) { + foreach my $lkup (keys %lookups) { + eval "\%$ns\::$lkup = \%\{$lookups{$lkup}\};"; + } + } return; } @@ -542,6 +590,11 @@ # going to (try to) assume that xsd validation has # caught malformed/invalid entries... +# other logic errors to test for during validation: +# - options not present in are referenced +# in or +# - no nor present + sub program { my ($twig, $elt) = @_; $program_name = $elt->att('name'); @@ -636,7 +689,7 @@ } if ($opt->first_child('corequisites')) { foreach ($opt->first_child('corequisites')->children) { - $corequisite_options{$opt->att('name')} = $_->att('name'); + $coreq_options{$opt->att('name')} = $_->att('name'); } } } From bugzilla-daemon at portal.open-bio.org Thu Feb 4 03:53:45 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Thu, 4 Feb 2010 03:53:45 -0500 Subject: [Bioperl-guts-l] [Bug 2977] TreeIO problems In-Reply-To: Message-ID: <201002040853.o148rjMO010623@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=2977 online at davemessina.com changed: What |Removed |Added ---------------------------------------------------------------------------- CC| |online at davemessina.com ------- Comment #5 from online at davemessina.com 2010-02-04 03:53 EST ------- Hi Sandra, I'm having a little bit of trouble reproducing the problem you're seeing. The sequence file you uploaded contains all of the sequences on one line, they're not aligned, and they're not the right length to be codons (385 not evenly divisible by 3). The script you uploaded does a lot of things besides run codeml, so it's a bit tricky to figure out what's going on. The part which hands the tree to PAML seems to be commented out (line 360). Also, it requires as input some files I don't have, such as "orthologous_teste.txt". If I take the code out which reads in the treefile, though (lines 340-349), and make a test script with that, I get warnings: --------------------- WARNING --------------------- MSG: cannot call add_tag_value with an undefined value (B) --------------------------------------------------- And that is due to this line in your code: -internal_node_id => 'bootstrap', which asks that internal node ids in the tree be set to the bootstrap value, but your tree does not contain any bootstrap values. If you remove that line, the warnings go away. Now, I know you said you were able to run codeml successfully outside of BioPerl, so there very well may still be a problem in the BioPerl code. To diagnose that, what I would need from you is: - the file of multiply aligned DNA sequences that you pass to codeml - the codeml.ctl file you use - the codeml output files that you get from a successful run And, ideally, a small test script which would try to run codeml using BioPerl with that exact same input data and settings, and the complete output from running that script. Dave -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From maj at dev.open-bio.org Thu Feb 4 09:33:00 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Thu, 4 Feb 2010 09:33:00 -0500 Subject: [Bioperl-guts-l] [16812] bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm: adding self options functionality; tightening Message-ID: <201002041433.o14EX0SS006900@dev.open-bio.org> Revision: 16812 Author: maj Date: 2010-02-04 09:32:59 -0500 (Thu, 04 Feb 2010) Log Message: ----------- adding self options functionality; tightening Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-03 17:56:02 UTC (rev 16811) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-04 14:32:59 UTC (rev 16812) @@ -587,12 +587,11 @@ # Get option string my ($join, $dash, $translat) = @{$self->{_options}}{qw(_join _dash _translation)}; - + my $opts = $self->{_options}; my %params = $self->get_parameters('parameters'); my %switches = $self->get_parameters('switches'); - # submit only those options that have been set... - my $params = [keys %params]; - my $switches = [keys %switches]; + my %self_params = $self->get_parameters('self_parameters'); + my %self_switches = $self->get_parameters('self_switches'); # access the multiple dash choices of _setparams... my @dash_args; @@ -620,14 +619,38 @@ @dash_args = ( -dash => 1 ); }; } - $DB::single=1; + my $options = $self->_setparams( - -params => $params, - -switches => $switches, + -params => [keys %params], + -switches => [keys %switches], -join => $join, @dash_args ); + # handle self options, if any: + my $self_options; + if ( %self_params || %self_switches ) { + $self_options = $self->_setparams( + -params => [keys %self_params], + -switches => [keys %self_switches], + -join => $join, + @dash_args + ); + }; + + if ($self->can('self_options')) { + my @p = grep(/^_self\|/, @{$opts->{_params}}); + my @s = grep(/^_self\|/, @{$opts->{_switches}}); + s/.*?\|// for @p; + s/.*?\|// for @s; + + $self_options = $self->_setparams( + -params => \@p, + -switches => \@s, + -join => $join, + @dash_args + ); + } # Translate options my @options = split(/(\s|$join)/, $options); for (my $i = 0; $i < scalar @options; $i++) { @@ -652,7 +675,7 @@ # special : the command '_self' indicates # the program should be run without an # intervening command - shift @options if $options[0] eq '_self'; + shift @options if ($options[0] and $options[0] eq '_self'); $options = join('', @options); @@ -979,7 +1002,7 @@ my $exe = $self->executable; $self->throw("Can't find executable for '".($self->is_pseudo ? $self->command : $self->program_name)."'; can't continue") unless $exe; # Get command-line options - $DB::single=1; + my $options = $self->_translate_params(); # Get file specs sans redirects in correct order my @specs = map { @@ -1225,7 +1248,10 @@ Usage : $pobj->set_parameters(%params); Function: sets the parameters listed in the hash or array Returns : true if any parameters were set, false (0) if not - Args : [optional] hash or array of parameter/values. + Args : [optional] hash or array of parameter/values. + special: + -self_options => arrayref of valid *program* (not command) + options =cut @@ -1236,40 +1262,65 @@ my ($params, $switches, $translation, $use_dash, $join) = @{$opts}{qw(_params _switches _translation _dash _join)}; # check incompatibilites and corequisites, attempting to DTRT - # (ripped for kortsch's Bowtie, thanks Dan) - $self->_massage_options(@args); - unless (($self->can('command') && $self->command) - || (grep /command/, @args)) { - if ($opts->{'_default_command'}) { - push @args, '-command' => $opts->{'_default_command'}; + # (ripped from kortsch's Bowtie, thanks Dan) + $self->_massage_options(\@args); + my %args = @args; + my $cmd = $args{'-command'} || $args{'command'} || ($self->can('command') && $self->command); + unless ($cmd) { + if ($self->default_command) { + push @args, '-command' => $self->default_command; } elsif (grep /^run$/, @{$opts->{'_commands'}}) { push @args, '-command' => 'run'; } else { - return 0; # quietly, but undef, since a command is needed to - # route the parameters + return 0; # quietly, but 0, since a command is needed to + # route the parameters } } - my %args = @args; - my $cmd = $args{'-command'} || $args{'command'} || ($self->can('command') && $self->command); + %args = @args; if ($cmd) { - my (@p, at s, %x); - $self->warn('Command present, but no commands registered') unless $self->{'_options'}->{'_commands'}; + # filter the registered params/switches to + # the subset requested in the arguments to set_parameters, + # so we only create accessors for this command's options: $self->throw("Command '$cmd' not registered") unless grep /^$cmd$/, @{$self->{'_options'}->{'_commands'}}; $cmd = $self->{_options}->{_prefixes}->{$cmd} || $cmd; - @p = (grep(!/^.*?\|/, @$params), grep(/^${cmd}\|/, @$params)); - @s = (grep(!/^.*?\|/, @$switches), grep(/^${cmd}\|/, @$switches)); + my @p = (grep(!/^.*?\|/, @$params), grep(/^${cmd}\|/, @$params)); + my @s = (grep(!/^.*?\|/, @$switches), grep(/^${cmd}\|/, @$switches)); s/.*?\|// for @p; s/.*?\|// for @s; - @x{@p, @s} = @{$translation}{ - grep( !/^.*?\|/, @$params, @$switches), - grep(/^${cmd}\|/, @$params, @$switches) }; - $opts->{_translation} = $translation = \%x; - $opts->{_params} = $params = \@p; - $opts->{_switches} = $switches = \@s; +# @x{@p, @s} = @{$translation}{ +# grep( !/^.*?\|/, @$params, @$switches), +# grep(/^${cmd}\|/, @$params, @$switches) }; + +# $opts->{_translation} = $translation = \%x; +# $opts->{_params} = $params = \@p; +# $opts->{_switches} = $switches = \@s; + $params = \@p; + $switches = \@s; } + my $self_options = $args{'-self_options'} || $args{'-SELF_OPTIONS'}; + delete $args{'-self_options'}; + delete $args{'-SELF_OPTIONS'}; + if ($self_options) { + $self->throw( "Arrayref requried at arg '-self_options'") unless + ref($self_options) and ref($self_options) eq 'ARRAY'; + my @p = grep(/^_self\|/, @{$opts->{_params}}); + my @s = grep(/^_self\|/, @{$opts->{_switches}}); + s/.*?\|/self_/ for @p; + s/.*?\|/self_/ for @s; + $self->_set_from_args( + $self_options, + -methods => [@p, @s], + -create => 1, + -code => + ' my $self = shift; + $self->parameters_changed(0); + return $self->{\'_\'.$method} = shift if @_; + return $self->{\'_\'.$method};' + ); + } $self->_set_from_args( \@args, -methods => [ @$params, @$switches, 'command', 'program_name', 'program_dir', 'out_type' ], @@ -1418,12 +1469,30 @@ } last; }; - m/^s/i && do { #switches only + m/^sw/i && do { #switches only for (@{$opts->{'_switches'}}) { push(@ret, $_, $self->$_) if $self->can($_) && defined $self->$_; } last; }; + m/^self_p/i && do { # self parameters only + my @p = grep /^_self/, @{$opts->{'_params'}}; + s/^_self\|/self_/ for @p; + for (@p) { + push(@ret, $_, $self->$_) + if $self->can($_) && defined $self->$_; + } + last; + }; + m/^self_s/i && do { # self switches only + my @s = grep /^_self/, @{$opts->{'_switches'}}; + s/^_self\|/self_/ for @s; + for (@s) { + push(@ret, $_, $self->$_) + if $self->can($_) && defined $self->$_; + } + last; + }; m/^a/i && do { # all for ((@{$opts->{'_params'}},@{$opts->{'_switches'}})) { push(@ret, $_, $self->$_) if $self->can($_) && defined $self->$_; @@ -1443,7 +1512,8 @@ sub _massage_options { my $self = shift; - my %args = @_; + my $args = shift; + my %args = @$args; my ($incompat, $coreqs) = @{$self->{_options}}{qw( _incompat _coreq)}; foreach (keys %args) { my @added; @@ -1477,5 +1547,8 @@ $self->debug("Removed incompatibilities : \n".join("\n", @removed)."\n") if @removed; $self->debug("Added corequisites : \n".join("\n", at added)."\n") if @added; } + my @args = %args; + return $args = \@args; + } 1; From maj at dev.open-bio.org Fri Feb 5 12:00:51 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 12:00:51 -0500 Subject: [Bioperl-guts-l] [16813] bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd: small xsd refactoring and coresponding xml handling Message-ID: <201002051700.o15H0p3W030239@dev.open-bio.org> Revision: 16813 Author: maj Date: 2010-02-05 12:00:50 -0500 (Fri, 05 Feb 2010) Log Message: ----------- small xsd refactoring and coresponding xml handling Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-04 14:32:59 UTC (rev 16812) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-05 17:00:50 UTC (rev 16813) @@ -82,20 +82,15 @@ - + Contains a sequence of option descriptions. Element. Optional. - - - - - - + A sequence of filespecType elements, describing the I/O @@ -106,11 +101,6 @@ Element. Optional. - - - - - @@ -220,10 +210,20 @@ + + + + + + Contains a sequence of option descriptions. + Element. Optional. + + + + + + - - - @@ -235,8 +235,9 @@ - A list of filetypes that are accepted for this filespec. Allows - CommandExts to do sanity checking. Ex) Accepted types for filespec + A list of filetypes that are accepted for this filespec. + Causes creation of hash %accepted_types, intended for + user-provided sanity checking. Ex) Accepted types for filespec 'fas' might be 'fasta', 'fastq', 'raw'. Element. Optional. @@ -304,6 +305,22 @@ + + + + + A sequence of filespecType elements, describing the I/O + portion of the command-line for this command, and other + atypical options not flagged by dashes. + The order in which these appear in the xml must be the order + required by the program (this is how the correct mapping is made) + Element. Optional. + + + + + + @@ -335,6 +352,15 @@ + + + + Indicate with "true" that this command is the default (selected + when the -command parameter is not set.) + + + + @@ -361,22 +387,8 @@ - - - - - - - - - - - - - - + + @@ -478,12 +490,12 @@ - + - Define composite commands: a single method name associated with + Define a composite command: a single method name associated with execution of a set of native commands in order - Element (sequence). Optional. + Element. Optional. Multiple. @@ -520,7 +532,7 @@ - + From maj at dev.open-bio.org Fri Feb 5 12:02:01 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 12:02:01 -0500 Subject: [Bioperl-guts-l] [16814] bioperl-dev/trunk/Bio/Tools/Run/WrapperBase.pm: adding ordered hashes via Tie:IxHash, if available ( silently skips it if not) Message-ID: <201002051702.o15H21Ok030275@dev.open-bio.org> Revision: 16814 Author: maj Date: 2010-02-05 12:02:01 -0500 (Fri, 05 Feb 2010) Log Message: ----------- adding ordered hashes via Tie:IxHash, if available (silently skips it if not) Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase.pm Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase.pm 2010-02-05 17:00:50 UTC (rev 16813) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase.pm 2010-02-05 17:02:01 UTC (rev 16814) @@ -73,6 +73,7 @@ =head1 CONTRIBUTORS Sendu Bala, bix at sendu.me.uk +Mark A. Jensen, maj -at- fortinbras -dot- us =head1 APPENDIX @@ -95,8 +96,13 @@ use File::Spec; use File::Path qw(); # don't import anything -use vars qw($TMPMODE); +use vars qw($TMPMODE $HAVE_IXHASH); +# if you have Tie::IxHash, we use it to keep +# command-line options in calling order... + +$HAVE_IXHASH = eval "require 'Tie::IxHash'; 1;"; + $TMPMODE = 0777; =head2 run @@ -460,10 +466,14 @@ $self->throw('at least one of -params or -switches is required') unless ($params || $switches); $self->throw("-dash, -double_dash and -mixed_dash are mutually exclusive") if (defined($d) + defined($dd) + defined($md) > 1); $join ||= ' '; + my (%params, %switches); + if ($HAVE_IXHASH) { + tie my %params, 'Tie::IxHash'; + tie my %switches, 'Tie::IxHash'; + } + %params = ref($params) eq 'HASH' ? %{$params} : map { $_ => $_ } @{$params}; + %switches = ref($switches) eq 'HASH' ? %{$switches} : map { $_ => $_ } @{$switches}; - my %params = ref($params) eq 'HASH' ? %{$params} : map { $_ => $_ } @{$params}; - my %switches = ref($switches) eq 'HASH' ? %{$switches} : map { $_ => $_ } @{$switches}; - my $param_string = ''; for my $hash_ref (\%params, \%switches) { while (my ($method, $method_out) = each %{$hash_ref}) { From maj at dev.open-bio.org Fri Feb 5 12:02:58 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 12:02:58 -0500 Subject: [Bioperl-guts-l] [16815] bioperl-dev/trunk/Bio/Tools: refactoring CommandExts to handle self options Message-ID: <201002051702.o15H2wem030309@dev.open-bio.org> Revision: 16815 Author: maj Date: 2010-02-05 12:02:58 -0500 (Fri, 05 Feb 2010) Log Message: ----------- refactoring CommandExts to handle self options Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm bioperl-dev/trunk/Bio/Tools/WrapperMaker.pm Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-05 17:02:01 UTC (rev 16814) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-05 17:02:58 UTC (rev 16815) @@ -434,6 +434,7 @@ %incompat_options %coreq_options ); +our $HAVE_IXHASH = eval "require 'Tie::IxHash';1"; =head2 new() @@ -519,9 +520,11 @@ } $self->program_name($name) if not defined $self->program_name(); $self->program_dir($dir) if not defined $self->program_dir(); - $self->parameters_changed( - $self->set_parameters(@args) - ); # set on instantiation, per Bio::ParameterBaseI + if (@args) { + $self->parameters_changed( + $self->set_parameters(@args) + ); # set on instantiation, per Bio::ParameterBaseI + } return $self; } @@ -571,128 +574,6 @@ } } -=head2 _translate_params - - Title : _translate_params - Usage : @options = $assembler->_translate_params( ); - Function: Translate the Bioperl arguments into the arguments to pass to the - program on the command line - Returns : Arrayref of arguments - Args : none - -=cut - -sub _translate_params { - my ($self) = @_; - # Get option string - my ($join, $dash, $translat) = - @{$self->{_options}}{qw(_join _dash _translation)}; - my $opts = $self->{_options}; - my %params = $self->get_parameters('parameters'); - my %switches = $self->get_parameters('switches'); - my %self_params = $self->get_parameters('self_parameters'); - my %self_switches = $self->get_parameters('self_switches'); - - # access the multiple dash choices of _setparams... - my @dash_args; - $dash ||= 1; # default as advertised - for ($dash) { - $_ eq '1' && do { - @dash_args = ( -dash => 1 ); - last; - }; - /^s/ && do { #single dash only - @dash_args = ( -dash => 1); - last; - }; - /^d/ && do { # double dash only - @dash_args = ( -double_dash => 1); - last; - }; - /^m/ && do { # mixed dash: one-letter opts get -, - # long opts get -- - @dash_args = ( -mixed_dash => 1); - last; - }; - do { - $self->warn( "Dash spec '$dash' not recognized; using 'single'" ); - @dash_args = ( -dash => 1 ); - }; - } - - my $options = $self->_setparams( - -params => [keys %params], - -switches => [keys %switches], - -join => $join, - @dash_args - ); - # handle self options, if any: - my $self_options; - if ( %self_params || %self_switches ) { - $self_options = $self->_setparams( - -params => [keys %self_params], - -switches => [keys %self_switches], - -join => $join, - @dash_args - ); - }; - - - if ($self->can('self_options')) { - my @p = grep(/^_self\|/, @{$opts->{_params}}); - my @s = grep(/^_self\|/, @{$opts->{_switches}}); - s/.*?\|// for @p; - s/.*?\|// for @s; - - $self_options = $self->_setparams( - -params => \@p, - -switches => \@s, - -join => $join, - @dash_args - ); - } - # Translate options - my @options = split(/(\s|$join)/, $options); - for (my $i = 0; $i < scalar @options; $i++) { - my ($prefix, $name) = ( $options[$i] =~ m/^(-{0,2})(.+)$/ ); - if (defined $name) { - if ($name =~ /command/i) { - $name = $options[$i+2]; # get the command - splice @options, $i, 4; - $i--; - # don't add the command if this is a pseudo-program - unshift @options, $name unless ($self->is_pseudo); # put command first - } - elsif (defined $$translat{$name}) { - $options[$i] = $prefix.$$translat{$name}; - } - } - else { - splice @options, $i, 1; - $i--; - } - } - # special : the command '_self' indicates - # the program should be run without an - # intervening command - shift @options if ($options[0] and $options[0] eq '_self'); - - $options = join('', @options); - - # this is a kludge for mixed options: the reason mixed doesn't - # work right on the pass through _setparams is that the - # *aliases* and not the actual params are passed to it. - # here we just rejigger the dashes - if ($dash =~ /^m/) { - $options =~ s/--([a-z0-9](?:\s|$))/-$1/gi; - } - - # Now arrayify the options - @options = split(' ', $options); - - return \@options; -} - =head2 executable() Title : executable @@ -949,7 +830,8 @@ # -- provide these as arguments to this function my $cmd = $self->can('command') ? $self->command : $self->default_command; my $opts = $self->{_options}; - my %args; + my %args; + tie %args, 'Tie::IxHash' if $HAVE_IXHASH; $self->throw("No command specified for the object and no default available") unless $cmd; # setup files necessary for this command @@ -1204,6 +1086,9 @@ my $tok = $AUTOLOAD; my @args = @_; $tok =~ s/.*:://; + my %args; + tie %args, 'Tie::IxHash' if $HAVE_IXHASH; + if ($tok eq 'command') { return $self->default_command; } @@ -1211,7 +1096,7 @@ my ($cmd) = $tok =~ m/new_(.*)/; return $class->new( -command => $cmd, @args ); } - my %args = @args; + %args = @args; if ($self && grep(/^$tok$/, $class->available_commands)) { if ( @args{qw( command -command COMMAND -COMMAND)} ) { $self->warn("-command argument ignored in autorun"); @@ -1232,14 +1117,161 @@ sub _is_parameter { my ($self, $opt) = @_; - return grep /^$opt$/, $self->available_parameters('parameters'); + return grep /$opt$/, $self->available_parameters('parameters'); } sub _is_switch { my ($self, $opt) = @_; - return grep /^$opt$/, $self->available_parameters('switches'); + return grep /$opt$/, $self->available_parameters('switches'); } +=head2 _translate_params + + Title : _translate_params + Usage : @options = $obj->_translate_params( ); + Function: Translate the Bioperl arguments into the arguments to pass to the + program on the command line + Returns : Arrayref of arguments + Args : none + +=cut + +sub _translate_params { + my ($self) = @_; + # Get option string + my ($join, $dash) = + @{$self->{_options}}{qw(_join _dash)}; + my %xlt; + my $opts = $self->{_options}; + my (%params,%switches, %self_params, %self_switches); + if ($HAVE_IXHASH) { + tie %params, 'Tie::IxHash'; + tie %switches, 'Tie::IxHash'; + tie %self_params, 'Tie::IxHash'; + tie %self_switches, 'Tie::IxHash'; + } + + %params = $self->get_parameters('parameters'); + %switches = $self->get_parameters('switches'); + + if ($self->command ne '_self') { + %self_params = $self->get_parameters('self_parameters'); + %self_switches = $self->get_parameters('self_switches'); + } + + # access the multiple dash choices of _setparams... + my @dash_args; + $dash ||= 1; # default as advertised + for ($dash) { + $_ eq '1' && do { + @dash_args = ( -dash => 1 ); + last; + }; + /^s/ && do { #single dash only + @dash_args = ( -dash => 1); + last; + }; + /^d/ && do { # double dash only + @dash_args = ( -double_dash => 1); + last; + }; + /^m/ && do { # mixed dash: one-letter opts get -, + # long opts get -- + @dash_args = ( -mixed_dash => 1); + last; + }; + do { + $self->warn( "Dash spec '$dash' not recognized; using 'single'" ); + @dash_args = ( -dash => 1 ); + }; + } + my $options; + if (%params || %switches) { + $options = $self->_setparams( + -params => [keys %params], + -switches => [keys %switches], + -join => $join, + @dash_args + ); + + $xlt{$_} = $self->{_options}{_translation}->{ + $self->{_options}{_prefixes}->{$self->command}.'|'.$_ + } for (keys %params, keys %switches); + $options =~ s/^\s+//; + $options =~ s/\s+$//; + } + + # handle self options, if any: + my $self_options; + if ( %self_params || %self_switches ) { + $self_options = $self->_setparams( + -params => [keys %self_params], + -switches => [keys %self_switches], + -join => $join, + @dash_args + ); + $xlt{$_} = $self->{_options}{_translation}->{"_self|$_"} + for (keys %self_params, keys %self_switches); + $self_options =~ s/^\s+//; + $self_options =~ s/\s+$//; +}; + + # Translate options + my (@options, at self_options); + + @options = split(/\s+|$join/, $options) if $options; + @self_options = split(/\s+|$join/, $self_options) if $self_options; + for (my $i = 0; $i < scalar @options; $i++) { + my ($dash, $name) = ( $options[$i] =~ m/^(-{0,2})(.+)$/ ); + if (defined $name) { + # if ($name =~ /command/i) { +# $nname = $options[$i+2]; # get the command +# splice @options, $i, 4; +# $i--; +# # don't add the command if this is a pseudo-program +# unshift @options, $name unless ($self->is_pseudo); # put command first +# } + if (defined $xlt{$name}) { + $options[$i] = $dash.$xlt{$name}; + } + } + else { + splice @options, $i, 1; + $i--; + } + } + + if ( !$self->is_pseudo and $self->command ne '_self' ) { + unshift @options, $self->command; + } + + # translate and add additional self options if any + for (my $i = 0; $i < scalar @self_options; $i++) { + my ($dash, $name) = ( $self_options[$i] =~ m/^(-{0,2})(.+)$/ ); + if (defined $name && defined $xlt{$name} ) { + $self_options[$i] = $dash.$xlt{$name}; + } + } + @options = (@self_options, at options); + +# $options = join('', @options); + + # this is a kludge for mixed options: the reason mixed doesn't + # work right on the pass through _setparams is that the + # *aliases* and not the actual params are passed to it. + # here we just rejigger the dashes + if ($dash =~ /^m/) { + s/--([a-z0-9](?:\s|$))/-$1/gi for (@options); + } + + # Now arrayify the options + # @options = split(' ', $options); + + #trim wsp + + return \@options; +} + =head1 Bio:ParameterBaseI compliance =head2 set_parameters() @@ -1263,15 +1295,20 @@ @{$opts}{qw(_params _switches _translation _dash _join)}; # check incompatibilites and corequisites, attempting to DTRT # (ripped from kortsch's Bowtie, thanks Dan) - $self->_massage_options(\@args); - my %args = @args; @@ Diff output truncated at 10000 characters. @@ From maj at dev.open-bio.org Fri Feb 5 12:04:55 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 12:04:55 -0500 Subject: [Bioperl-guts-l] [16816] bioperl-dev/trunk/t: tests for WrapperMaker Message-ID: <201002051704.o15H4tLd030343@dev.open-bio.org> Revision: 16816 Author: maj Date: 2010-02-05 12:04:55 -0500 (Fri, 05 Feb 2010) Log Message: ----------- tests for WrapperMaker Added Paths: ----------- bioperl-dev/trunk/t/WrapperMaker.t bioperl-dev/trunk/t/data/perl.xml Added: bioperl-dev/trunk/t/WrapperMaker.t =================================================================== --- bioperl-dev/trunk/t/WrapperMaker.t (rev 0) +++ bioperl-dev/trunk/t/WrapperMaker.t 2010-02-05 17:04:55 UTC (rev 16816) @@ -0,0 +1,143 @@ +#-*-perl-*- +#$Id$ + +#testing Bio::Tools::WrapperMaker +use strict; +#use warnings; +our $home; +BEGIN { + use Bio::Root::Test; + $home = ".."; + unshift @INC, $home; + test_begin( -tests => 100, + -requires_modules => [qw( + Bio::Tools::Run::WrapperBase + Bio::Tools::Run::WrapperBase::CommandExts + )] + ); +} +use Cwd; +sub test_input_file { "data/".shift }; ### + +use_ok( 'Bio::Tools::WrapperMaker' ); +if (!$Bio::Tools::WrapperMaker::HAVE_LIBXML) { + # turn off validation warnings + $Bio::Tools::WrapperMaker::VALIDATE_DEFS = -1; +} + +my $synop_xml = < + + + + + + + + + + +END + +#synopsis and basic functionality + +ok -e $Bio::Tools::WrapperMaker::LOCAL_XSD, "local maker.xsd present"; +ok my $lsfac = Bio::Tools::WrapperMaker->compile( -defs => $synop_xml ), "import synopsis example xml"; +is (ref($lsfac), 'MyWrapper', "class correct"); +# check imports +is ($lsfac->program_name, 'ls', "program name in the namespace"); +is ($MyWrapper::use_dash, 'mixed','$use_dash'); +is_deeply (\@MyWrapper::program_commands, [qw( command _self )], '@program_commands'); +is_deeply (\@MyWrapper::program_switches, [qw( all sort_by_size sort_by_time one_line_each )], '@program_switches'); +is_deeply (\%MyWrapper::param_translation, { '_self|sort_by_size' => 'S', + '_self|sort_by_time' => 't', + '_self|one_line_each' => '1' }, + '%param_translations'); +is_deeply (\%MyWrapper::command_files, { _self => [qw( *#pth >#out )] }, + '%command_files'); +ok my $opts = $lsfac->{_options}; +is ($MyWrapper::use_dash, 'mixed','$use_dash'); +is_deeply ($opts->{_commands}, [qw( command _self )], 'registry (1)'); +is_deeply ($opts->{_switches}, [qw( _self|all _self|sort_by_size _self|sort_by_time _self|one_line_each )], 'registry (2)'); +is_deeply ($opts->{_translation}, { '_self|sort_by_size' => 'S', + '_self|sort_by_time' => 't', + '_self|one_line_each' => '1' }, + 'registry (3)'); +is_deeply ($opts->{_files}, { _self => [qw( *#pth >#out )] }, + 'registry (4)'); + +is_deeply ([$lsfac->available_parameters('switches')], [qw( _self|all _self|sort_by_size _self|sort_by_time _self|one_line_each )], "switches thru api"); + +SKIP : { + test_skip( -tests => 6, + -requires_executable => $lsfac); + ok $lsfac->run, "run ls"; + ok !$lsfac->stderr, "no err"; + ok $lsfac->set_parameters( -all => 1 ); + ok $lsfac->run; + like $lsfac->stdout, qr/^\.$/m, "-all"; + $lsfac->all(0); + opendir my $d, getcwd(); + my @ls = readdir $d; + + my @lsw = split("\n", $lsfac->stdout); + $DB::single=1; + is_deeply([sort @lsw], [sort @ls] , "return ok"); + 1; +} + +# deeper tests (also of CommandExts handling) + +ok my $pf = Bio::Tools::WrapperMaker->compile( -defs => test_input_file('perl.xml') ); + +ok $pf->set_parameters( -perl_version => 1 ), "set parms (0)"; + +is (join(' ',@{$pf->_translate_params}), "-v", "xlt parms(0)"); + +ok $pf->reset_parameters( -command => '_self', + -perl_version => 1), "set parms (1)"; +is (join(' ',@{$pf->_translate_params}), "-v", "xlt parms (1)"); +ok $pf->reset_parameters( -command => 'test1', + -boog => 42, + -goob => 1 ), "set parms (2)"; +is (join(' ',@{$pf->_translate_params}), "test1 --boog 42 -b", "xlt parms (2)"); +ok $pf->reset_parameters( -command => 'test1', + -goob => 1, + -self_options => [ + -module => 'Test::More' + ]), "set parms (3)"; +is (join(' ',@{$pf->_translate_params}), "-M Test::More test1 -b", "xlt parms (3)"); +$DB::single =1; +ok $pf->reset_parameters( -command => 'test1', + -freen => 1 ); +ok $pf->needed, "coreq switch massage"; + +ok !$pf->reset_parameters( -command => 'test1', + -glarb => 1), "coreq param fails"; + + +ok $pf->reset_parameters( -command => '_self', + -warnings => 1, + -nowarnings => 1 ), "massage incompatibles"; +is (join(' ',@{$pf->_translate_params}), "-W", "xlt parms (4)"); + +ok $pf->reset_parameters( -command => '_self', + -nowarnings => 1, + -warnings => 1), "massage incompatibles, rev order"; +is (join(' ',@{$pf->_translate_params}), "-X", "xlt parms (5)"); + +ok $pf->reset_parameters( -command => '_self', + -autoloop => 1, + -one_liner => "\'1;\'", + ), "one liner"; +ok $pf->_run(-stdin => test_input_file('perl.xml')), "run"; +like $pf->stdout, qr/reset_parameters( -command => '_self', + -one_liner => "print('hello,world')" ); +ok $pf->_run; +is $pf->stdout, "hello,world"; +1; Property changes on: bioperl-dev/trunk/t/WrapperMaker.t ___________________________________________________________________ Name: svn:executable + * Name: svn:keywords + Id Date Author Rev Added: bioperl-dev/trunk/t/data/perl.xml =================================================================== --- bioperl-dev/trunk/t/data/perl.xml (rev 0) +++ bioperl-dev/trunk/t/data/perl.xml 2010-02-05 17:04:55 UTC (rev 16816) @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file Property changes on: bioperl-dev/trunk/t/data/perl.xml ___________________________________________________________________ Name: svn:executable + * Name: svn:keywords + Id Date Author Rev From maj at dev.open-bio.org Fri Feb 5 12:25:13 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 12:25:13 -0500 Subject: [Bioperl-guts-l] [16817] bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm: tweak Message-ID: <201002051725.o15HPDP8030634@dev.open-bio.org> Revision: 16817 Author: maj Date: 2010-02-05 12:25:13 -0500 (Fri, 05 Feb 2010) Log Message: ----------- tweak Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-05 17:04:55 UTC (rev 16816) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-05 17:25:13 UTC (rev 16817) @@ -1538,7 +1538,8 @@ sub _massage_options { my $self = shift; - tie my %args, 'Tie::IxHash'; + my %args; + tie my %args, 'Tie::IxHash' if $HAVE_IXHASH; %args = @_; my @added; my @removed; From maj at dev.open-bio.org Fri Feb 5 13:55:36 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 13:55:36 -0500 Subject: [Bioperl-guts-l] [16818] bioperl-dev/trunk: tweaks to accommodate BlastPlus.pm Message-ID: <201002051855.o15ItatD030969@dev.open-bio.org> Revision: 16818 Author: maj Date: 2010-02-05 13:55:35 -0500 (Fri, 05 Feb 2010) Log Message: ----------- tweaks to accommodate BlastPlus.pm Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm bioperl-dev/trunk/t/WrapperMaker.t Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-05 17:25:13 UTC (rev 16817) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-05 18:55:35 UTC (rev 16818) @@ -1441,17 +1441,22 @@ my $subset = shift; my $opts = $self->{'_options'}; my @ret; + my $pfx = $opts->{_prefixes}->{$self->command}; for ($subset) { - (!defined || /^a/) && do { + !defined && do { @ret = (@{$opts->{'_params'}}, @{$opts->{'_switches'}}); last; }; + m/^a/i && do { + @ret = grep /^$pfx/,(@{$opts->{'_params'}}, @{$opts->{'_switches'}}); + last; + }; m/^p/i && do { - @ret = @{$opts->{'_params'}}; + @ret = grep /^$pfx/, @{$opts->{'_params'}}; last; }; m/^s/i && do { - @ret = @{$opts->{'_switches'}}; + @ret = grep /^$pfx/, @{$opts->{'_switches'}}; last; }; m/^c/i && do { @@ -1465,6 +1470,7 @@ $self->throw("available_parameters: unrecognized subset"); }; } + if ($subset =~ /^[psa]/i) { s/^.*\|// for (@ret); } return @ret; } @@ -1495,7 +1501,7 @@ $_ = "self_params"; } else { - @o = grep !/^_self/, @{$opts->{'_params'}}; + @o = grep !/^_self|command/, @{$opts->{'_params'}}; last; } }; @@ -1524,7 +1530,7 @@ $self->throw("get_parameters: unrecognized subset"); }; } - s/^.*\|// for @o; + unless ($subset =~ /^a/i) { s/^.*\|// for (@o);} for (@o) { push(@ret, $_, $self->$_) if $self->can($_) && defined $self->$_; } @@ -1539,7 +1545,7 @@ sub _massage_options { my $self = shift; my %args; - tie my %args, 'Tie::IxHash' if $HAVE_IXHASH; + tie %args, 'Tie::IxHash' if $HAVE_IXHASH; %args = @_; my @added; my @removed; Modified: bioperl-dev/trunk/t/WrapperMaker.t =================================================================== --- bioperl-dev/trunk/t/WrapperMaker.t 2010-02-05 17:25:13 UTC (rev 16817) +++ bioperl-dev/trunk/t/WrapperMaker.t 2010-02-05 18:55:35 UTC (rev 16818) @@ -85,7 +85,6 @@ my @ls = readdir $d; my @lsw = split("\n", $lsfac->stdout); - $DB::single=1; is_deeply([sort @lsw], [sort @ls] , "return ok"); 1; } @@ -111,7 +110,6 @@ -module => 'Test::More' ]), "set parms (3)"; is (join(' ',@{$pf->_translate_params}), "-M Test::More test1 -b", "xlt parms (3)"); -$DB::single =1; ok $pf->reset_parameters( -command => 'test1', -freen => 1 ); ok $pf->needed, "coreq switch massage"; From maj at dev.open-bio.org Fri Feb 5 15:45:48 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 15:45:48 -0500 Subject: [Bioperl-guts-l] [16819] bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm: propset Message-ID: <201002052045.o15KjmwI031765@dev.open-bio.org> Revision: 16819 Author: maj Date: 2010-02-05 15:45:48 -0500 (Fri, 05 Feb 2010) Log Message: ----------- propset Property Changed: ---------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm Property changes on: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm ___________________________________________________________________ Name: svn:keywords - Id Author Date Rev + Id Date Rev Author From maj at dev.open-bio.org Fri Feb 5 22:14:07 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 22:14:07 -0500 Subject: [Bioperl-guts-l] [16820] bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm: working on integrating CommandExts refactor with existing client code ( SABlast+, Bowtie) Message-ID: <201002060314.o163E7pZ000948@dev.open-bio.org> Revision: 16820 Author: maj Date: 2010-02-05 22:14:07 -0500 (Fri, 05 Feb 2010) Log Message: ----------- working on integrating CommandExts refactor with existing client code (SABlast+, Bowtie) Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-05 20:45:48 UTC (rev 16819) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-06 03:14:07 UTC (rev 16820) @@ -494,6 +494,8 @@ $default_command = '_self'; } else { + # the default command is indicated by a leading + # asterisk in the name: for (@$commands) { s/^\*// && ($default_command = $_); } } @registry{qw( _commands _default_command _prefixes _files @@ -505,7 +507,7 @@ $self->{_options} = \%registry; if (not defined $use_dash) { - $self->{'_options'}->{'_dash'} = 1; + $self->{'_options'}->{'_dash'} = 1; # single-dash policy } else { $self->{'_options'}->{'_dash'} = $use_dash; } @@ -514,6 +516,8 @@ } else { $self->{'_options'}->{'_join'} = $join; } + # a leading asterisk on the program name indicates + # a pseudo-program: if ($name =~ /^\*/) { $self->is_pseudo(1); $name =~ s/^\*//; @@ -614,7 +618,7 @@ =head2 executables() Title : executables - Usage : + Usage : called by executable() Function: find the full path to a command's executable Returns : full path (scalar string) Args : command (scalar string), @@ -650,6 +654,7 @@ Title : _find_executable Usage : my $exe_path = $fac->_find_executable($exe, $warn); + (internal method) Function: find the full path to a named executable, Returns : full path, if found Args : name of executable to find @@ -683,11 +688,14 @@ $path = File::Spec->catfile($self->program_dir, $exe); } else { $path = $exe; - $self->warn('Program directory not specified; use program_dir($path).') if $warn; + $self->warn('Program directory not specified; use program_dir($path).') + if $warn; } # use provided info - we are allowed to follow symlinks, but refuse directories - map { return $path.$_ if ( -x $path.$_ && !(-d $path.$_) ) } ('', '.exe') if defined $path; + map { + return $path.$_ if ( -x $path.$_ && !(-d $path.$_) ) + } ('', '.exe') if defined $path; # couldn't get path to executable from provided info, so use system path $path = $path ? " in $path" : undef; @@ -695,7 +703,10 @@ if ($path = $self->io->exists_exe($exe)) { return $path; } else { - $self->warn("Cannot find executable for program '".($self->is_pseudo ? $self->command : $self->program_name)."'") if $warn; + $self->warn("Cannot find executable for program '". + ($self->is_pseudo ? + $self->command : + $self->program_name)."'") if $warn; return; } } @@ -784,11 +795,11 @@ my $self = shift; my $cmd = shift; my %ret; - # default command is 'run' - $cmd ||= 'run'; - return unless $self->{'_options'}->{'_composite_commands'}; - return unless $self->{'_options'}->{'_composite_commands'}->{$cmd}; - my @subcmds = @{$self->{'_options'}->{'_composite_commands'}->{$cmd}}; + $cmd ||= $self->default_command; + my $compcmd = $self->{'_options'}->{'_composite_commands'}; + return unless $compcmd; + return unless $compcmd->{$cmd}; + my @subcmds = @{$compcmd->{$cmd}}; my $cur_options = $self->{'_options'}; # collate @@ -805,7 +816,8 @@ foreach my $opt (@params, @switches) { my $subopt = $opt; $subopt =~ s/^${pfx}_//; - push(@{$ret{$subcmd}}, '-'.$subopt => $self->$opt) if defined $self->$opt; + push(@{$ret{$subcmd}}, '-'.$subopt => $self->$opt) + if defined $self->$opt; } } return \%ret; @@ -824,7 +836,7 @@ sub _run { my ($self, @args) = @_; - # _translate_params will provide an array of command/parameters/switches + # _translate_options will provide an array of command/parameters/switches # -- these are set at object construction # to set up the run, need to add the files to the call # -- provide these as arguments to this function @@ -882,10 +894,13 @@ # Get program executable my $exe = $self->executable; - $self->throw("Can't find executable for '".($self->is_pseudo ? $self->command : $self->program_name)."'; can't continue") unless $exe; - # Get command-line options + $self->throw("Can't find executable for '". + ($self->is_pseudo ? + $self->command : + $self->program_name)."'; can't continue") unless $exe; - my $options = $self->_translate_params(); + # Get command-line options + my $options = $self->_translate_options(); # Get file specs sans redirects in correct order my @specs = map { my $s = $_; @@ -1125,10 +1140,11 @@ return grep /$opt$/, $self->available_parameters('switches'); } -=head2 _translate_params +=head2 _translate_options - Title : _translate_params - Usage : @options = $obj->_translate_params( ); + Title : _translate_options + Alias : _translate_params + Usage : @options = $obj->_translate_options( ); Function: Translate the Bioperl arguments into the arguments to pass to the program on the command line Returns : Arrayref of arguments @@ -1136,7 +1152,7 @@ =cut -sub _translate_params { +sub _translate_options { my ($self) = @_; # Get option string my ($join, $dash) = @@ -1272,6 +1288,8 @@ return \@options; } +sub _translate_params { shift->_translate_options(@_) } + =head1 Bio:ParameterBaseI compliance =head2 set_parameters() @@ -1430,9 +1448,13 @@ Usage : @params = $pobj->available_parameters() Function: Returns a list of the available parameters Returns : Array of parameters - Args : 'params' for settable program paramters + Args : undefined (params+switches for all commands, with prefixes),or + for current command (no prefixes): + 'all' : params+switches + 'params' for settable program parameters 'switches' for boolean program switches - default: all + 'self_params' for program ("self") parameters + 'self_switches' for program ("self") switches =cut @@ -1455,10 +1477,19 @@ @ret = grep /^$pfx/, @{$opts->{'_params'}}; last; }; - m/^s/i && do { + m/^sw/i && do { @ret = grep /^$pfx/, @{$opts->{'_switches'}}; last; }; + m/^self_p/i && do { + @ret = grep /^_self/, @{$opts->{'_params'}}; + last; + }; + + m/^self_sw/i && do { + @ret = grep /^_self/, @{$opts->{'_switches'}}; + last; + }; m/^c/i && do { @ret = @{$opts->{'_commands'}}; last; @@ -1470,7 +1501,7 @@ $self->throw("available_parameters: unrecognized subset"); }; } - if ($subset =~ /^[psa]/i) { s/^.*\|// for (@ret); } + if ($subset && $subset =~ /^[psa]/i) { s/^.*\|// for (@ret); } return @ret; } @@ -1482,55 +1513,20 @@ Title : get_parameters Usage : %params = $pobj->get_parameters; Function: Returns list of key-value pairs of parameter => value - Returns : List of key-value pairs - Args : [optional] A string is allowed if subsets are wanted or (if a - parameter subset is default) 'all' to return all parameters + Returns : List of key-value pairs ("unqualified" (no prefix) parameter + names associated with the current command (in $pobj->command) + Args : 'all' (default), 'parameters', 'switches', 'self_parameters' + 'self_switches' =cut sub get_parameters { my $self = shift; my $subset = shift; - $subset ||= 'all'; my @ret; my $opts = $self->{'_options'}; - my @o; - for ($subset) { - m/^p/i && do { #params only - if ($self->command eq '_self') { - $_ = "self_params"; - } - else { - @o = grep !/^_self|command/, @{$opts->{'_params'}}; - last; - } - }; - m/^sw/i && do { #switches only - if ($self->command eq '_self') { - $_ = "self_switches"; - } - else { - @o = grep !/^_self/, @{$opts->{'_switches'}}; - last; - } - }; - m/^self_p/i && do { # self parameters only - @o = grep /^_self/, @{$opts->{'_params'}}; - last; - }; - m/^self_s/i && do { # self switches only - @o = grep /^_self/, @{$opts->{'_switches'}}; - last; - }; - m/^a/i && do { # all - @o = ('command',@{$opts->{'_params'}},@{$opts->{'_switches'}}); - last; - }; - do { - $self->throw("get_parameters: unrecognized subset"); - }; - } - unless ($subset =~ /^a/i) { s/^.*\|// for (@o);} + $subset ||= 'all'; + my @o = $self->available_parameters($subset); for (@o) { push(@ret, $_, $self->$_) if $self->can($_) && defined $self->$_; } From maj at dev.open-bio.org Fri Feb 5 22:57:52 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 5 Feb 2010 22:57:52 -0500 Subject: [Bioperl-guts-l] [16821] bioperl-dev/trunk: bug squish/test tweak Message-ID: <201002060357.o163vqer001590@dev.open-bio.org> Revision: 16821 Author: maj Date: 2010-02-05 22:57:52 -0500 (Fri, 05 Feb 2010) Log Message: ----------- bug squish/test tweak Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm bioperl-dev/trunk/t/WrapperMaker.t Modified: bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm =================================================================== --- bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-06 03:14:07 UTC (rev 16820) +++ bioperl-dev/trunk/Bio/Tools/Run/WrapperBase/CommandExts.pm 2010-02-06 03:57:52 UTC (rev 16821) @@ -434,8 +434,9 @@ %incompat_options %coreq_options ); -our $HAVE_IXHASH = eval "require 'Tie::IxHash';1"; +our $HAVE_IXHASH = eval "require Tie::IxHash; 1"; + =head2 new() Title : new @@ -1363,7 +1364,7 @@ delete $args{'-self_options'}; delete $args{'-SELF_OPTIONS'}; if ($self_options) { - $self->throw( "Arrayref requried at arg '-self_options'") unless + $self->throw( "Arrayref required at arg '-self_options'") unless ref($self_options) and ref($self_options) eq 'ARRAY'; @p = grep(/^_self\|/, @{$opts->{_params}}); @s = grep(/^_self\|/, @{$opts->{_switches}}); @@ -1403,12 +1404,6 @@ # currently stored stuff my $opts = $self->{'_options'}; - # handle command name -# my %args = @args; -# my $cmd = $args{'-command'} || $args{'command'} || $self->command; -# $args{'command'} = $cmd; -# delete $args{'-command'}; -# @args = %args; my %p = $self->get_parameters('params'); my %s = $self->get_parameters('switches'); my (%self_p, %self_s); Modified: bioperl-dev/trunk/t/WrapperMaker.t =================================================================== --- bioperl-dev/trunk/t/WrapperMaker.t 2010-02-06 03:14:07 UTC (rev 16820) +++ bioperl-dev/trunk/t/WrapperMaker.t 2010-02-06 03:57:52 UTC (rev 16821) @@ -9,7 +9,7 @@ use Bio::Root::Test; $home = ".."; unshift @INC, $home; - test_begin( -tests => 100, + test_begin( -tests => 45, ### -requires_modules => [qw( Bio::Tools::Run::WrapperBase Bio::Tools::Run::WrapperBase::CommandExts @@ -52,7 +52,7 @@ is ($lsfac->program_name, 'ls', "program name in the namespace"); is ($MyWrapper::use_dash, 'mixed','$use_dash'); is_deeply (\@MyWrapper::program_commands, [qw( command _self )], '@program_commands'); -is_deeply (\@MyWrapper::program_switches, [qw( all sort_by_size sort_by_time one_line_each )], '@program_switches'); +is_deeply (\@MyWrapper::program_switches, [qw( _self|all _self|sort_by_size _self|sort_by_time _self|one_line_each )], '@program_switches'); is_deeply (\%MyWrapper::param_translation, { '_self|sort_by_size' => 'S', '_self|sort_by_time' => 't', '_self|one_line_each' => '1' }, @@ -70,7 +70,7 @@ is_deeply ($opts->{_files}, { _self => [qw( *#pth >#out )] }, 'registry (4)'); -is_deeply ([$lsfac->available_parameters('switches')], [qw( _self|all _self|sort_by_size _self|sort_by_time _self|one_line_each )], "switches thru api"); +is_deeply ([$lsfac->available_parameters('switches')], [qw( all sort_by_size sort_by_time one_line_each )], "switches thru api"); SKIP : { test_skip( -tests => 6, From maj at dev.open-bio.org Sat Feb 6 23:44:11 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Sat, 6 Feb 2010 23:44:11 -0500 Subject: [Bioperl-guts-l] [16822] bioperl-run/trunk/lib/Bio/DB/SoapEUtilities/FetchAdaptor/species.pm : yikes--this was a baddie. Message-ID: <201002070444.o174iBW6009261@dev.open-bio.org> Revision: 16822 Author: maj Date: 2010-02-06 23:44:09 -0500 (Sat, 06 Feb 2010) Log Message: ----------- yikes--this was a baddie. Fixed now. Modified Paths: -------------- bioperl-run/trunk/lib/Bio/DB/SoapEUtilities/FetchAdaptor/species.pm Modified: bioperl-run/trunk/lib/Bio/DB/SoapEUtilities/FetchAdaptor/species.pm =================================================================== --- bioperl-run/trunk/lib/Bio/DB/SoapEUtilities/FetchAdaptor/species.pm 2010-02-06 03:57:52 UTC (rev 16821) +++ bioperl-run/trunk/lib/Bio/DB/SoapEUtilities/FetchAdaptor/species.pm 2010-02-07 04:44:09 UTC (rev 16822) @@ -122,6 +122,7 @@ my $get_tl = sub { $toplev->{ shift @_ } }; my $sp = _read_species($get_tl); $self->warn("FetchAdaptor::species - parse error, no Bio::Species returned") unless $sp; + ($self->{_idx})++; return $sp; } 1; From cjfields at dev.open-bio.org Sun Feb 7 14:23:12 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Sun, 7 Feb 2010 14:23:12 -0500 Subject: [Bioperl-guts-l] [16823] bioperl-live/trunk/Bio/Root/Test.pm: export done_testing if it is present (shouldn' t use this in final tests until we upgrade the lib version, but it is awfully convenient) Message-ID: <201002071923.o17JNCTo019434@dev.open-bio.org> Revision: 16823 Author: cjfields Date: 2010-02-07 14:23:11 -0500 (Sun, 07 Feb 2010) Log Message: ----------- export done_testing if it is present (shouldn't use this in final tests until we upgrade the lib version, but it is awfully convenient) Modified Paths: -------------- bioperl-live/trunk/Bio/Root/Test.pm Modified: bioperl-live/trunk/Bio/Root/Test.pm =================================================================== --- bioperl-live/trunk/Bio/Root/Test.pm 2010-02-07 04:44:09 UTC (rev 16822) +++ bioperl-live/trunk/Bio/Root/Test.pm 2010-02-07 19:23:11 UTC (rev 16823) @@ -184,6 +184,10 @@ float_is ); +if (Test::More->can('done_testing')) { + push @EXPORT, 'done_testing'; +} + our $GLOBAL_FRAMEWORK = 'Test::More'; our @TEMP_FILES; From maj at dev.open-bio.org Mon Feb 8 22:30:40 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Mon, 8 Feb 2010 22:30:40 -0500 Subject: [Bioperl-guts-l] [16824] bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd: metadata element Message-ID: <201002090330.o193UeUk003952@dev.open-bio.org> Revision: 16824 Author: maj Date: 2010-02-08 22:30:39 -0500 (Mon, 08 Feb 2010) Log Message: ----------- metadata element Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-07 19:23:11 UTC (rev 16823) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-09 03:30:39 UTC (rev 16824) @@ -514,6 +514,23 @@ + + + + + Describe the document instance + + + + + + + + + + + + @@ -534,6 +551,7 @@ + From maj at dev.open-bio.org Mon Feb 8 23:29:08 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Mon, 8 Feb 2010 23:29:08 -0500 Subject: [Bioperl-guts-l] [16825] bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd: reagt. Message-ID: <201002090429.o194T8dn004685@dev.open-bio.org> Revision: 16825 Author: maj Date: 2010-02-08 23:29:08 -0500 (Mon, 08 Feb 2010) Log Message: ----------- reagt. Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-09 03:30:39 UTC (rev 16824) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-09 04:29:08 UTC (rev 16825) @@ -547,8 +547,8 @@ + - From maj at dev.open-bio.org Mon Feb 8 23:46:16 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Mon, 8 Feb 2010 23:46:16 -0500 Subject: [Bioperl-guts-l] [16826] bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd: tweak Message-ID: <201002090446.o194kGu3004882@dev.open-bio.org> Revision: 16826 Author: maj Date: 2010-02-08 23:46:16 -0500 (Mon, 08 Feb 2010) Log Message: ----------- tweak Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-09 04:29:08 UTC (rev 16825) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-09 04:46:16 UTC (rev 16826) @@ -525,9 +525,9 @@ - - - + + + From maj at dev.open-bio.org Mon Feb 8 23:48:20 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Mon, 8 Feb 2010 23:48:20 -0500 Subject: [Bioperl-guts-l] [16827] bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd: doh. must be late Message-ID: <201002090448.o194mKjZ004916@dev.open-bio.org> Revision: 16827 Author: maj Date: 2010-02-08 23:48:20 -0500 (Mon, 08 Feb 2010) Log Message: ----------- doh. must be late Modified Paths: -------------- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd Modified: bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd =================================================================== --- bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-09 04:46:16 UTC (rev 16826) +++ bioperl-dev/trunk/Bio/Tools/WrapperMaker/maker.xsd 2010-02-09 04:48:20 UTC (rev 16827) @@ -525,9 +525,9 @@ - - - + + + From bugzilla-daemon at portal.open-bio.org Tue Feb 9 08:57:59 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 9 Feb 2010 08:57:59 -0500 Subject: [Bioperl-guts-l] [Bug 3007] New: Bio::TreeIO::nhx cannot parse empty [&&NHX] + round-trip failure Message-ID: http://bugzilla.open-bio.org/show_bug.cgi?id=3007 Summary: Bio::TreeIO::nhx cannot parse empty [&&NHX] + round-trip failure Product: BioPerl Version: main-trunk Platform: PC OS/Version: Linux Status: NEW Severity: normal Priority: P2 Component: Core Components AssignedTo: bioperl-guts-l at bioperl.org ReportedBy: pkensche at cmbi.ru.nl Reading the following tree ((x:0.05, y:0.06),a:0.1[&&NHX:G=dummy]); and writing it back produces this tree: ((x:0.05,y:0.06)[&&NHX],a:0.1[&&NHX:G=dummy]); An empty [&&NHX] field was is added in the subtree containing leaves x and y. Reading this tree, with an empty NHX field, however, produces an error: ------------- EXCEPTION: Bio::Root::Exception ------------- MSG: Unrecognized, non &&NHX string: >>a<< STACK: Error::throw STACK: Bio::Root::Root::throw /data/work/local/lib64/perl5/site_perl/5.8.8/Bio/Root/Root.pm:359 STACK: Bio::TreeIO::nhx::next_tree /data/work/local/lib64/perl5/site_perl/5.8.8/Bio/TreeIO/nhx.pm:204 STACK: -e:1 ----------------------------------------------------------- I am not certain about the specification of the nhx format and whether this is rather a bug in the writing code than in the parser. I personally would prefer a robust parser that accepts empty [&&NHX] fields. In any case, a round-trip test should not fail. For completeness: I used this script: -- use Bio::TreeIO; my $in = new Bio::TreeIO (-fh => \*STDIN, -format => "nhx"); my $tree = $in->next_tree; my $out = new Bio::TreeIO (-fh => \*STDOUT, -format => "nhx"); $out->write_tree($tree); -- Greetings, Philip -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From rbuels at dev.open-bio.org Tue Feb 9 15:13:30 2010 From: rbuels at dev.open-bio.org (Robert Buels) Date: Tue, 9 Feb 2010 15:13:30 -0500 Subject: [Bioperl-guts-l] [16828] bioperl-live/trunk/t/Root/RootIO.t: fixed Bio::RootIO test count Message-ID: <201002092013.o19KDUYg004640@dev.open-bio.org> Revision: 16828 Author: rbuels Date: 2010-02-09 15:13:29 -0500 (Tue, 09 Feb 2010) Log Message: ----------- fixed Bio::RootIO test count Modified Paths: -------------- bioperl-live/trunk/t/Root/RootIO.t Modified: bioperl-live/trunk/t/Root/RootIO.t =================================================================== --- bioperl-live/trunk/t/Root/RootIO.t 2010-02-09 04:48:20 UTC (rev 16827) +++ bioperl-live/trunk/t/Root/RootIO.t 2010-02-09 20:13:29 UTC (rev 16828) @@ -7,7 +7,7 @@ use lib '.'; use Bio::Root::Test; - test_begin(-tests => 31); + test_begin(-tests => 35); use_ok('Bio::Root::IO'); } From maj at dev.open-bio.org Tue Feb 9 15:25:28 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Tue, 9 Feb 2010 15:25:28 -0500 Subject: [Bioperl-guts-l] [16829] bioperl-run/trunk/lib/Bio/Tools/Run: ease off on throws; let bl2seq work without a db being specified (as it should) Message-ID: <201002092025.o19KPS8O004858@dev.open-bio.org> Revision: 16829 Author: maj Date: 2010-02-09 15:25:28 -0500 (Tue, 09 Feb 2010) Log Message: ----------- ease off on throws; let bl2seq work without a db being specified (as it should) Modified Paths: -------------- bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm Modified: bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm =================================================================== --- bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm 2010-02-09 20:13:29 UTC (rev 16828) +++ bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm 2010-02-09 20:25:28 UTC (rev 16829) @@ -238,7 +238,7 @@ %usr_args = @$method_args; } # make db if necessary - $self->make_db unless $self->check_db or $self->is_remote; + $self->make_db unless $self->check_db or $self->is_remote or $usr_args{'-subject'} or $usr_args{'-SUBJECT'}; # no db nec if this is bl2seq... $self->{_factory} = Bio::Tools::Run::BlastPlus->new( -command => $method ); if (%usr_args) { my @avail_parms = $self->factory->available_parameters('all'); Modified: bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm =================================================================== --- bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm 2010-02-09 20:13:29 UTC (rev 16828) +++ bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus.pm 2010-02-09 20:25:28 UTC (rev 16829) @@ -583,7 +583,8 @@ $self->throw("DB '".$self->db."' can't be found. To create, set -create => 1.") unless $create; } if (!$self->db) { - $self->throw('No database or db data specified. '. + # allow this to pass; catch lazily at make_db... + $self->debug('No database or db data specified. '. 'To create a new database, provide '. '-db_data => [fasta|\@seqs|$seqio_object]') unless $self->db_data; From rbuels at dev.open-bio.org Tue Feb 9 16:19:08 2010 From: rbuels at dev.open-bio.org (Robert Buels) Date: Tue, 9 Feb 2010 16:19:08 -0500 Subject: [Bioperl-guts-l] [16830] bioperl-live/trunk: added some Bio::Root::IO tests for using File:: Temp filehandles, skipping if File:: Temp does not have the object-oriented interface. Message-ID: <201002092119.o19LJ8Kh005574@dev.open-bio.org> Revision: 16830 Author: rbuels Date: 2010-02-09 16:19:08 -0500 (Tue, 09 Feb 2010) Log Message: ----------- added some Bio::Root::IO tests for using File::Temp filehandles, skipping if File::Temp does not have the object-oriented interface. prettified (and hopefully did not enbug) Bio::Root::IO, while adding a check to prevent comparing object filehandles to STD* Modified Paths: -------------- bioperl-live/trunk/Bio/Root/IO.pm bioperl-live/trunk/t/Root/RootIO.t Modified: bioperl-live/trunk/Bio/Root/IO.pm =================================================================== --- bioperl-live/trunk/Bio/Root/IO.pm 2010-02-09 20:25:28 UTC (rev 16829) +++ bioperl-live/trunk/Bio/Root/IO.pm 2010-02-09 21:19:08 UTC (rev 16830) @@ -557,17 +557,20 @@ sub close { my ($self) = @_; - return if $self->noclose; # don't close if we explictly asked not to - if( defined $self->{'_filehandle'} ) { + + # don't close if we explictly asked not to + return if $self->noclose; + + if( defined( my $fh = $self->{'_filehandle'} )) { $self->flush; - return if( \*STDOUT == $self->_fh || - \*STDERR == $self->_fh || - \*STDIN == $self->_fh - ); # don't close STDOUT fh - if( ! ref($self->{'_filehandle'}) || - ! $self->{'_filehandle'}->isa('IO::String') ) { - close($self->{'_filehandle'}); - } + return if ref $fh eq 'GLOB' + && ( \*STDOUT == $fh + || \*STDERR == $fh + || \*STDIN == $fh + ); + + # don't close IO::Strings + close $fh unless ref $fh && $fh->isa('IO::String'); } $self->{'_filehandle'} = undef; delete $self->{'_readbuffer'}; Modified: bioperl-live/trunk/t/Root/RootIO.t =================================================================== --- bioperl-live/trunk/t/Root/RootIO.t 2010-02-09 20:25:28 UTC (rev 16829) +++ bioperl-live/trunk/t/Root/RootIO.t 2010-02-09 21:19:08 UTC (rev 16830) @@ -7,7 +7,7 @@ use lib '.'; use Bio::Root::Test; - test_begin(-tests => 35); + test_begin(-tests => 38); use_ok('Bio::Root::IO'); } @@ -93,6 +93,19 @@ ok $wio = Bio::Root::IO->new(-fh=>$O); is $wio->mode, 'w', 'handle, write'; +SKIP: { + my $warn; + local $SIG{__WARN__} = sub { $warn = shift }; + my $tempfile = eval { require File::Temp; File::Temp->new } + or skip 'could not create File::Temp object, maybe your File::Temp is 10 years old', 3; + my $temp_io; + ok $temp_io = Bio::Root::IO->new( -fh => $tempfile ); + is $temp_io->mode, 'w', 'is a write handle'; + # wish i could just use Test::Warn. but then there's ... THE DEPENDENCY HOBGOBLIN! (TM) + $temp_io->close; + ok !$warn, 'no warnings'; +} + ############################################## # tests _pushback for multi-line buffering ############################################## From kortsch at dev.open-bio.org Tue Feb 9 17:51:45 2010 From: kortsch at dev.open-bio.org (Dan Kortschak) Date: Tue, 9 Feb 2010 17:51:45 -0500 Subject: [Bioperl-guts-l] [16831] bioperl-live/trunk/t/Assembly/Assembly.t: Make bowtie test skip if no Bio::Tools::Run::Samtools available (i.e. Message-ID: <201002092251.o19Mpjj4006589@dev.open-bio.org> Revision: 16831 Author: kortsch Date: 2010-02-09 17:51:45 -0500 (Tue, 09 Feb 2010) Log Message: ----------- Make bowtie test skip if no Bio::Tools::Run::Samtools available (i.e. no bioperl-run) Modified Paths: -------------- bioperl-live/trunk/t/Assembly/Assembly.t Modified: bioperl-live/trunk/t/Assembly/Assembly.t =================================================================== --- bioperl-live/trunk/t/Assembly/Assembly.t 2010-02-09 21:19:08 UTC (rev 16830) +++ bioperl-live/trunk/t/Assembly/Assembly.t 2010-02-09 22:51:45 UTC (rev 16831) @@ -328,7 +328,7 @@ SKIP : { - test_skip(-tests => 828+755, + test_skip(-tests => 828, -requires_module => 'Bio::DB::Sam'); # @@ -378,12 +378,21 @@ } is(@all_seq_ids, 369); +} + +SKIP : { + + test_skip(-tests => 755, + -requires_modules => qw(Bio::DB::Sam Bio::Tools::Run::Samtools), + -requires_executable => 'Bio::Tools::Run::Samtools'); + # # Testing bowtie # - $file = 'test.bowtie'; - $refdb = 'test.ref.fas'; + + my $file = 'test.bowtie'; + my $refdb = 'test.ref.fas'; ok $aio = Bio::Assembly::IO->new( -file => test_input_file($file), -index => test_input_file($refdb), -format => 'bowtie' ), "init bowtie IO object"; From maj at fortinbras.us Tue Feb 9 21:43:21 2010 From: maj at fortinbras.us (Mark A. Jensen) Date: Tue, 9 Feb 2010 21:43:21 -0500 Subject: [Bioperl-guts-l] [Bioperl-l] Bio::Assembly::IO::bowtie circular dependency? In-Reply-To: <1265756325.12397.6.camel@zoidberg.mbs.adelaide.edu.au> References: <4B71C533.7060705@cornell.edu><46B2F24717394AB79664BB4732E18E77@NewLife> <1265756325.12397.6.camel@zoidberg.mbs.adelaide.edu.au> Message-ID: Hey Dan-- I'll take a look at those tests--very possible I'm not using ST right, though occasionally I'll get void errors when I misremember which Test::More functions take message strings as their last argument. cheers MAJ ----- Original Message ----- From: "Dan Kortschak" To: "Mark A. Jensen" Cc: "Robert Buels" ; "BioPerl List" Sent: Tuesday, February 09, 2010 5:58 PM Subject: Re: [Bioperl-l] Bio::Assembly::IO::bowtie circular dependency? > Given the general utility of samtools, I'd go with that approach. But in > the meantime, I've added a SKIP to the bowtie tests so that they depend > on B:T:R:Samtools and the samtools executable in addition to B:DB:Sam > (as they were previously piggy backing on with the B:A:IO:sam). > > BTW MAJ, there are a number of useless void arrays in the sam tests and > test failures from, I think, having the wrong expectations of the > results from B:DB:Sam. I left them when I was doing the bowtie tests as > I wasn't sure exactly what you were getting - the results seem correct > to me, but what do I know :) > > This should probably be in guts, so if we continue this can we jump over > there? > > cheers > Dan > > On Tue, 2010-02-09 at 16:21 -0500, Mark A. Jensen wrote: >> Yeah, this is getting kinda hairy-- B:T:R:Samtools is >> a basic wrapper for anything that wants to use >> Bio::DB::Samtools ( lstein's samtools library wrapper, >> a CPAN and not a BioPerl module. Savvy?). Because >> its likely that other parser-like modules will want to >> use samtools ( as well as wrapper-like modules), I >> would vote for moving Samtools and Samtools::Config >> into the bioperl-live version of Bio::Tools::Run. > > > _______________________________________________ > Bioperl-l mailing list > Bioperl-l at lists.open-bio.org > http://lists.open-bio.org/mailman/listinfo/bioperl-l > > From dan.kortschak at adelaide.edu.au Tue Feb 9 21:57:11 2010 From: dan.kortschak at adelaide.edu.au (Dan Kortschak) Date: Wed, 10 Feb 2010 13:27:11 +1030 Subject: [Bioperl-guts-l] [Bioperl-l] Bio::Assembly::IO::bowtie circular dependency? In-Reply-To: References: <4B71C533.7060705@cornell.edu> <46B2F24717394AB79664BB4732E18E77@NewLife> <1265756325.12397.6.camel@zoidberg.mbs.adelaide.edu.au> Message-ID: <1265770631.12397.23.camel@zoidberg.mbs.adelaide.edu.au> The issue with the warnings is that there are arrays in void context (not in tests, just sitting there), and with the test failures that your test is asking that singletons coming out of Bio::DB::Sam will retain its identity as a sequence, while what seems to happen is that it becomes a 'sam_assy' of one. cheers Dan On Tue, 2010-02-09 at 21:43 -0500, Mark A. Jensen wrote: > Hey Dan-- I'll take a look at those tests--very possible I'm not using > ST right, though occasionally I'll get void errors when I misremember > which Test::More functions take message strings as their last > argument. > cheers MAJ > From bugzilla-daemon at portal.open-bio.org Wed Feb 10 03:43:29 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Wed, 10 Feb 2010 03:43:29 -0500 Subject: [Bioperl-guts-l] [Bug 3008] New: Bio::TreeIO::nhx cannot parse empty [&&NHX] + round-trip failure Message-ID: http://bugzilla.open-bio.org/show_bug.cgi?id=3008 Summary: Bio::TreeIO::nhx cannot parse empty [&&NHX] + round-trip failure Product: BioPerl Version: main-trunk Platform: PC OS/Version: Linux Status: NEW Severity: normal Priority: P2 Component: Core Components AssignedTo: bioperl-guts-l at bioperl.org ReportedBy: pkensche at cmbi.ru.nl Reading the following tree ((x:0.05, y:0.06),a:0.1[&&NHX:G=dummy]); and writing it back produces this tree: ((x:0.05,y:0.06)[&&NHX],a:0.1[&&NHX:G=dummy]); An empty [&&NHX] field was is added in the subtree containing leaves x and y. Reading this tree, with an empty NHX field, however, produces an error: ------------- EXCEPTION: Bio::Root::Exception ------------- MSG: Unrecognized, non &&NHX string: >>a<< STACK: Error::throw STACK: Bio::Root::Root::throw /data/work/local/lib64/perl5/site_perl/5.8.8/Bio/Root/Root.pm:359 STACK: Bio::TreeIO::nhx::next_tree /data/work/local/lib64/perl5/site_perl/5.8.8/Bio/TreeIO/nhx.pm:204 STACK: -e:1 ----------------------------------------------------------- I am not certain about the specification of the nhx format and whether this is rather a bug in the writing code than in the parser. I personally would prefer a robust parser that accepts empty [&&NHX] fields. In any case, a round-trip test should not fail. For completeness: I used this script: -- use Bio::TreeIO; my $in = new Bio::TreeIO (-fh => \*STDIN, -format => "nhx"); my $tree = $in->next_tree; my $out = new Bio::TreeIO (-fh => \*STDOUT, -format => "nhx"); $out->write_tree($tree); -- Greetings, Philip -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Wed Feb 10 05:35:13 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Wed, 10 Feb 2010 05:35:13 -0500 Subject: [Bioperl-guts-l] [Bug 3008] Bio::TreeIO::nhx cannot parse empty [&&NHX] + round-trip failure In-Reply-To: Message-ID: <201002101035.o1AAZDS1002612@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3008 pkensche at cmbi.ru.nl changed: What |Removed |Added ---------------------------------------------------------------------------- Status|NEW |RESOLVED Resolution| |DUPLICATE ------- Comment #1 from pkensche at cmbi.ru.nl 2010-02-10 05:35 EST ------- *** This bug has been marked as a duplicate of bug 3007 *** -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Wed Feb 10 05:35:13 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Wed, 10 Feb 2010 05:35:13 -0500 Subject: [Bioperl-guts-l] [Bug 3007] Bio::TreeIO::nhx cannot parse empty [&&NHX] + round-trip failure In-Reply-To: Message-ID: <201002101035.o1AAZD8Y002620@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3007 ------- Comment #1 from pkensche at cmbi.ru.nl 2010-02-10 05:35 EST ------- *** Bug 3008 has been marked as a duplicate of this bug. *** -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From maj at dev.open-bio.org Wed Feb 10 08:57:30 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Wed, 10 Feb 2010 08:57:30 -0500 Subject: [Bioperl-guts-l] [16832] bioperl-live/trunk/t/Assembly/Assembly.t: removed strange orphan arrays; eliminated some bad tests ( to be replaced by good tests!) Message-ID: <201002101357.o1ADvUFp018850@dev.open-bio.org> Revision: 16832 Author: maj Date: 2010-02-10 08:57:29 -0500 (Wed, 10 Feb 2010) Log Message: ----------- removed strange orphan arrays; eliminated some bad tests (to be replaced by good tests!) Modified Paths: -------------- bioperl-live/trunk/t/Assembly/Assembly.t Modified: bioperl-live/trunk/t/Assembly/Assembly.t =================================================================== --- bioperl-live/trunk/t/Assembly/Assembly.t 2010-02-09 22:51:45 UTC (rev 16831) +++ bioperl-live/trunk/t/Assembly/Assembly.t 2010-02-10 13:57:29 UTC (rev 16832) @@ -7,7 +7,7 @@ use lib '.'; use Bio::Root::Test; - test_begin( -tests => 1635, + test_begin( -tests => 1264 + 755; -requires_module => 'DB_File' ); use_ok('Bio::Assembly::IO'); @@ -295,25 +295,25 @@ ok $assembly = $aio->next_assembly, "get maq assy"; isa_ok($aio, 'Bio::Assembly::IO'); - at contig_seq_ids; + ok(@contig_seq_ids = $assembly->get_contig_seq_ids, "get_contig_seq_ids"); is(@contig_seq_ids, 246); for my $contig_seq_id (@contig_seq_ids) { ok (not $contig_seq_id =~ m/maq_assy/i); } - at contig_ids; + ok(@contig_ids = $assembly->get_contig_ids, "get_contig_ids"); is(@contig_ids, 37); for my $contig_id (@contig_ids) { ok ($contig_id =~ m/maq_assy/i); } - at singlet_ids; + ok(@singlet_ids = $assembly->get_singlet_ids, "get_singlet_ids"); is(@singlet_ids, 4); for my $singlet_id (@singlet_ids) { ok ($singlet_id =~ m/maq_assy/i); } - at all_seq_ids; + ok(@all_seq_ids = $assembly->get_all_seq_ids, "get_all_seq_ids"); for my $seq_id (@all_seq_ids) { ok (not $seq_id =~ m/maq_assy/i); @@ -352,26 +352,28 @@ -format => 'sam' ),"reopen"; ok $assembly = $aio->next_assembly, "get sam assy"; is( $assembly->get_nof_contigs, 21, "got all contigs"); - @contig_seq_ids; + ok(@contig_seq_ids = $assembly->get_contig_seq_ids, "get_contig_seq_ids"); is(@contig_seq_ids, 334); - for my $contig_seq_id (@contig_seq_ids) { - ok ($contig_seq_id =~ m/^SRR/i); - } - @contig_ids; + # trashing these for now; not much a test really anyway/maj + # for my $contig_seq_id (@contig_seq_ids) { + # ok ($contig_seq_id =~ m/^SRR/i); + # } + ok(@contig_ids = $assembly->get_contig_ids, "get_contig_ids"); is(@contig_ids, 21); for my $contig_id (@contig_ids) { ok ($contig_id =~ m/sam_assy/i); } - @singlet_ids; + ok(@singlet_ids = $assembly->get_singlet_ids, "get_singlet_ids"); is(@singlet_ids, 35); - for my $singlet_id (@singlet_ids) { - ok ($singlet_id =~ m/^SRR/i); - } - @all_seq_ids; + # trashing these/maj + # for my $singlet_id (@singlet_ids) { + # ok ($singlet_id =~ m/^SRR/i); + # } + ok(@all_seq_ids = $assembly->get_all_seq_ids, "get_all_seq_ids"); for my $seq_id (@all_seq_ids) { ok ($seq_id =~ m/^SRR/i); @@ -382,9 +384,13 @@ SKIP : { + # this does the loading... test_skip(-tests => 755, - -requires_modules => qw(Bio::DB::Sam Bio::Tools::Run::Samtools), - -requires_executable => 'Bio::Tools::Run::Samtools'); + -requires_modules => [qw(Bio::Tools::Run::Samtools)]); +SKIP : { + # now loaded, this checks for executable... + test_skip(-tests => 755, + -requires_executable => Bio::Tools::Run::Samtools->new(-command=>'view')); # # Testing bowtie @@ -429,4 +435,4 @@ } is(@all_seq_ids, 348); -} +}} From maj at fortinbras.us Wed Feb 10 09:00:46 2010 From: maj at fortinbras.us (Mark A. Jensen) Date: Wed, 10 Feb 2010 09:00:46 -0500 Subject: [Bioperl-guts-l] [Bioperl-l] Bio::Assembly::IO::bowtie circular dependency? In-Reply-To: <1265770631.12397.23.camel@zoidberg.mbs.adelaide.edu.au> References: <4B71C533.7060705@cornell.edu> <46B2F24717394AB79664BB4732E18E77@NewLife> <1265756325.12397.6.camel@zoidberg.mbs.adelaide.edu.au> <1265770631.12397.23.camel@zoidberg.mbs.adelaide.edu.au> Message-ID: <7EE18585ACDC4F3BAE55E12E10F68FB9@NewLife> I just committed changes to Assembly.t that get rids of those strange orphan arrays. Also removed the failing tests: they were just checks (and not very strong ones) of the ids of the singletons. I will revisit that one day, but the problem wasn't the issue you refer to. I rejiggered (tech term) the skips for bowtie to make them compliant with bio::root::test (the -requires_executable param is a little strange, it takes a WrapperBase object) Let me know about other issues-- cheers MAJ ----- Original Message ----- From: "Dan Kortschak" To: "Mark A. Jensen" Cc: Sent: Tuesday, February 09, 2010 9:57 PM Subject: Re: [Bioperl-l] Bio::Assembly::IO::bowtie circular dependency? > The issue with the warnings is that there are arrays in void context > (not in tests, just sitting there), and with the test failures that your > test is asking that singletons coming out of Bio::DB::Sam will retain > its identity as a sequence, while what seems to happen is that it > becomes a 'sam_assy' of one. > > cheers > Dan > > On Tue, 2010-02-09 at 21:43 -0500, Mark A. Jensen wrote: >> Hey Dan-- I'll take a look at those tests--very possible I'm not using >> ST right, though occasionally I'll get void errors when I misremember >> which Test::More functions take message strings as their last >> argument. >> cheers MAJ >> > > > From dan.kortschak at adelaide.edu.au Wed Feb 10 19:37:01 2010 From: dan.kortschak at adelaide.edu.au (Dan Kortschak) Date: Thu, 11 Feb 2010 11:07:01 +1030 Subject: [Bioperl-guts-l] [Bioperl-l] Bio::Assembly::IO::bowtie circular dependency? In-Reply-To: <7EE18585ACDC4F3BAE55E12E10F68FB9@NewLife> References: <4B71C533.7060705@cornell.edu> <46B2F24717394AB79664BB4732E18E77@NewLife> <1265756325.12397.6.camel@zoidberg.mbs.adelaide.edu.au> <1265770631.12397.23.camel@zoidberg.mbs.adelaide.edu.au> <7EE18585ACDC4F3BAE55E12E10F68FB9@NewLife> Message-ID: <1265848621.13306.2.camel@zoidberg.mbs.adelaide.edu.au> Hi Mark, Have a look at the bowtie tests that correspond to the maq tests that you have ditched - since I used the same data as the maq tests I used pretty much exactly the same tests. I think the module require for Bio::DB::Sam should probably be left in the skip test declaration. cheers Dan On Wed, 2010-02-10 at 09:00 -0500, Mark A. Jensen wrote: > I just committed changes to Assembly.t that get rids of > those strange orphan arrays. Also removed the failing tests: > they were just checks (and not very strong ones) of the ids > of the singletons. I will revisit that one day, but the problem > wasn't the issue you refer to. I rejiggered (tech term) the > skips for bowtie to make them compliant with bio::root::test > (the -requires_executable param is a little strange, it takes a > WrapperBase object) > Let me know about other issues-- cheers MAJ From cjfields at dev.open-bio.org Thu Feb 11 15:20:41 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Thu, 11 Feb 2010 15:20:41 -0500 Subject: [Bioperl-guts-l] [16833] Bio-FeatureIO/trunk/README: add a few comments Message-ID: <201002112020.o1BKKf2x000924@dev.open-bio.org> Revision: 16833 Author: cjfields Date: 2010-02-11 15:20:40 -0500 (Thu, 11 Feb 2010) Log Message: ----------- add a few comments Modified Paths: -------------- Bio-FeatureIO/trunk/README Modified: Bio-FeatureIO/trunk/README =================================================================== --- Bio-FeatureIO/trunk/README 2010-02-10 13:57:29 UTC (rev 16832) +++ Bio-FeatureIO/trunk/README 2010-02-11 20:20:40 UTC (rev 16833) @@ -2,7 +2,7 @@ ========================== Bio::FeatureIO is a BioPerl-based parser for feature data from common biological -sequence formats, such as GFF3, GTF, and BED. +sequence formats, such as GFF3, GTF, and BED. INSTALLATION @@ -17,8 +17,8 @@ This module requires these other modules and libraries: - URI::Escape - XML::DOM::XPath + URI::Escape - for Bio::FeatureIO::gff + XML::DOM::XPath - for Bio::FeatureIO::interpro COPYRIGHT AND LICENCE From maj at dev.open-bio.org Fri Feb 12 13:39:45 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Fri, 12 Feb 2010 13:39:45 -0500 Subject: [Bioperl-guts-l] [16834] bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/ BlastMethods.pm: handle multiple results: next_result, rewind_results Message-ID: <201002121839.o1CIdjlY029901@dev.open-bio.org> Revision: 16834 Author: maj Date: 2010-02-12 13:39:44 -0500 (Fri, 12 Feb 2010) Log Message: ----------- handle multiple results: next_result, rewind_results Modified Paths: -------------- bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm Modified: bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm =================================================================== --- bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm 2010-02-11 20:20:40 UTC (rev 16833) +++ bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm 2010-02-12 18:39:44 UTC (rev 16834) @@ -178,8 +178,6 @@ our @BlastMethods = qw( blastp blastn blastx tblastn tblastx psiblast rpsblast rpstblastn ); - - =head2 run() Title : run @@ -279,6 +277,7 @@ $ret = Bio::SearchIO->new(-file => $outfile); $self->{_blastout} = $outfile; + $self->{_results} = $ret; $ret = $ret->next_result; last; }; @@ -290,8 +289,6 @@ return $ret; } - - =head2 bl2seq() Title : bl2seq @@ -345,6 +342,40 @@ } +=head2 next_result() + + Title : next_result + Usage : $result = $fac->next_result; + Function: get the next BLAST result + Returns : Bio::Search::Result::BlastResult object + Args : none + +=cut + +sub next_result() { + my $self = shift; + return unless $self->{_results}; + return $self->{_results}->next_result; +} + +=head2 rewind_results() + + Title : rewind_results + Usage : $fac->rewind_results; + Function: rewind BLAST results + Returns : true on success + Args : + +=cut + +sub rewind_results { + my $self = shift; + return unless $self->blast_out; + $self->{_results} = Bio::SearchIO->new( -file => $self->blast_out ); + return 1; +} + + =head2 blast_out() Title : blast_out @@ -355,7 +386,7 @@ =cut -sub blast_output { shift->{_blastout} } +sub blast_out { shift->{_blastout} } # =head2 _demodernize() From cjfields at illinois.edu Fri Feb 12 13:45:58 2010 From: cjfields at illinois.edu (Chris Fields) Date: Fri, 12 Feb 2010 12:45:58 -0600 Subject: [Bioperl-guts-l] [16834] bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/ BlastMethods.pm: handle multiple results: next_result, rewind_results In-Reply-To: <201002121839.o1CIdjlY029901@dev.open-bio.org> References: <201002121839.o1CIdjlY029901@dev.open-bio.org> Message-ID: <1550CFDD-32E5-414E-8C18-C0263AB608B7@illinois.edu> Mark, Are the current SearchIO parsers working for blast+? There was a recent post on the bioperl-l that there were some possible issues. chris On Feb 12, 2010, at 12:39 PM, Mark Allen Jensen wrote: > Revision: 16834 > Author: maj > Date: 2010-02-12 13:39:44 -0500 (Fri, 12 Feb 2010) > Log Message: > ----------- > handle multiple results: next_result, rewind_results > > Modified Paths: > -------------- > bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm > > Modified: bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm > =================================================================== > --- bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm 2010-02-11 20:20:40 UTC (rev 16833) > +++ bioperl-run/trunk/lib/Bio/Tools/Run/StandAloneBlastPlus/BlastMethods.pm 2010-02-12 18:39:44 UTC (rev 16834) > @@ -178,8 +178,6 @@ > our @BlastMethods = qw( blastp blastn blastx tblastn tblastx > psiblast rpsblast rpstblastn ); > > - > - > =head2 run() > > Title : run > @@ -279,6 +277,7 @@ > $ret = Bio::SearchIO->new(-file => $outfile); > > $self->{_blastout} = $outfile; > + $self->{_results} = $ret; > $ret = $ret->next_result; > last; > }; > @@ -290,8 +289,6 @@ > return $ret; > } > > - > - > =head2 bl2seq() > > Title : bl2seq > @@ -345,6 +342,40 @@ > > } > > +=head2 next_result() > + > + Title : next_result > + Usage : $result = $fac->next_result; > + Function: get the next BLAST result > + Returns : Bio::Search::Result::BlastResult object > + Args : none > + > +=cut > + > +sub next_result() { > + my $self = shift; > + return unless $self->{_results}; > + return $self->{_results}->next_result; > +} > + > +=head2 rewind_results() > + > + Title : rewind_results > + Usage : $fac->rewind_results; > + Function: rewind BLAST results > + Returns : true on success > + Args : > + > +=cut > + > +sub rewind_results { > + my $self = shift; > + return unless $self->blast_out; > + $self->{_results} = Bio::SearchIO->new( -file => $self->blast_out ); > + return 1; > +} > + > + > =head2 blast_out() > > Title : blast_out > @@ -355,7 +386,7 @@ > > =cut > > -sub blast_output { shift->{_blastout} } > +sub blast_out { shift->{_blastout} } > > # =head2 _demodernize() > > > _______________________________________________ > Bioperl-guts-l mailing list > Bioperl-guts-l at lists.open-bio.org > http://lists.open-bio.org/mailman/listinfo/bioperl-guts-l From bugzilla-daemon at portal.open-bio.org Sat Feb 13 11:35:41 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Sat, 13 Feb 2010 11:35:41 -0500 Subject: [Bioperl-guts-l] [Bug 3011] New: namespace support did not work properly for Bio::DB::Seqfeature::Store::DBI::Pg Message-ID: http://bugzilla.open-bio.org/show_bug.cgi?id=3011 Summary: namespace support did not work properly for Bio::DB::Seqfeature::Store::DBI::Pg Product: BioPerl Version: main-trunk Platform: All OS/Version: All Status: NEW Severity: normal Priority: P2 Component: Core Components AssignedTo: bioperl-guts-l at bioperl.org ReportedBy: awitney at sgul.ac.uk namespace/schema support was broken for Bio::DB::Seqfeature::Store::DBI::Pg. It was trying to use the same approach as did Bio::DB::Seqfeature::Store::DBI::mysql which just prefixed the table name with "namespace_". This was broken for Pg as the Indexes would not be qualified correctly. I have attached a patch that now allows the use of PostgreSQL SCHEMA's. I have also added some tests to LocalDB/SeqFeature.t which will test namespaces for mysql and Pg only. At the moment for Pg this will create an arbitrary schema which is used and then can be deleted at the end unless it was already present in the database. The name of the namespace could be moved into the Build.PL script such that the user is allowed to give the name of a namespace to use, when also filling out database connection details. -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Sat Feb 13 11:37:22 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Sat, 13 Feb 2010 11:37:22 -0500 Subject: [Bioperl-guts-l] [Bug 3011] namespace support did not work properly for Bio::DB::Seqfeature::Store::DBI::Pg In-Reply-To: Message-ID: <201002131637.o1DGbMZE021761@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3011 ------- Comment #1 from awitney at sgul.ac.uk 2010-02-13 11:37 EST ------- Created an attachment (id=1437) --> (http://bugzilla.open-bio.org/attachment.cgi?id=1437&action=view) provide namespace/schema support to Bio::DB::SeqFeature::Store::DBI::Pg.pm -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From cjfields at dev.open-bio.org Mon Feb 15 17:27:40 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Mon, 15 Feb 2010 17:27:40 -0500 Subject: [Bioperl-guts-l] [16835] bioperl-live/trunk/t/SeqIO/genbank.t: use test_input_file() for file path consistency Message-ID: <201002152227.o1FMReOH027677@dev.open-bio.org> Revision: 16835 Author: cjfields Date: 2010-02-15 17:27:39 -0500 (Mon, 15 Feb 2010) Log Message: ----------- use test_input_file() for file path consistency Modified Paths: -------------- bioperl-live/trunk/t/SeqIO/genbank.t Modified: bioperl-live/trunk/t/SeqIO/genbank.t =================================================================== --- bioperl-live/trunk/t/SeqIO/genbank.t 2010-02-12 18:39:44 UTC (rev 16834) +++ bioperl-live/trunk/t/SeqIO/genbank.t 2010-02-15 22:27:39 UTC (rev 16835) @@ -564,7 +564,7 @@ #bug 2982 embl/genbank contig handling -$ast = Bio::SeqIO->new( -file => 'bug2982.gb', +$ast = Bio::SeqIO->new( -file => test_input_file('bug2982.gb'), -format => 'genbank' ); $seq = $ast->next_seq; From cjfields at dev.open-bio.org Mon Feb 15 17:29:59 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Mon, 15 Feb 2010 17:29:59 -0500 Subject: [Bioperl-guts-l] [16836] bioperl-live/trunk/t/Tools/EUtilities/EUtilParameters.t: bioperl -> BioPerl Message-ID: <201002152229.o1FMTxTX027711@dev.open-bio.org> Revision: 16836 Author: cjfields Date: 2010-02-15 17:29:59 -0500 (Mon, 15 Feb 2010) Log Message: ----------- bioperl -> BioPerl Modified Paths: -------------- bioperl-live/trunk/t/Tools/EUtilities/EUtilParameters.t Modified: bioperl-live/trunk/t/Tools/EUtilities/EUtilParameters.t =================================================================== --- bioperl-live/trunk/t/Tools/EUtilities/EUtilParameters.t 2010-02-15 22:27:39 UTC (rev 16835) +++ bioperl-live/trunk/t/Tools/EUtilities/EUtilParameters.t 2010-02-15 22:29:59 UTC (rev 16836) @@ -33,8 +33,17 @@ my $request = $pobj->to_request; # 'exhaust' state isa_ok($request, 'HTTP::Request'); -is($request->url, 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=nucleotide&retmode=xml&id=6679096%2C31543332%2C134288853%2C483581%2C20805941%2C187951953%2C169158074%2C123228044%2C148676374%2C114326469%2C148707003%2C187952787%2C123233807%2C148694865%2C148694864%2C148694863%2C148694861%2C148694862%2C8705244%2C8568086&tool=bioperl&email=me%40foo.bar'); -is($pobj->to_string(), 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=nucleotide&retmode=xml&id=6679096%2C31543332%2C134288853%2C483581%2C20805941%2C187951953%2C169158074%2C123228044%2C148676374%2C114326469%2C148707003%2C187952787%2C123233807%2C148694865%2C148694864%2C148694863%2C148694861%2C148694862%2C8705244%2C8568086&tool=bioperl&email=me%40foo.bar'); +is($request->url, 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?'. + 'db=nucleotide&retmode=xml&id=6679096%2C31543332%2C134288853%2C483581%2C'. + '20805941%2C187951953%2C169158074%2C123228044%2C148676374%2C114326469%2C'. + '148707003%2C187952787%2C123233807%2C148694865%2C148694864%2C148694863%2C'. + '148694861%2C148694862%2C8705244%2C8568086&tool=BioPerl&email=me%40foo.bar'); +is($pobj->to_string(), 'http://eutils.ncbi.nlm.nih.gov/entrez/eutils/'. + 'efetch.fcgi?db=nucleotide&retmode=xml&id=6679096%2C31543332%2C134288853%2C'. + '483581%2C20805941%2C187951953%2C169158074%2C123228044%2C148676374%2C'. + '114326469%2C148707003%2C187952787%2C123233807%2C148694865%2C148694864%2C'. + '148694863%2C148694861%2C148694862%2C8705244%2C8568086'. + '&tool=BioPerl&email=me%40foo.bar'); is($pobj->parameters_changed, 0); # state won't change if the same parameters are passed From cjfields at dev.open-bio.org Mon Feb 15 22:53:05 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Mon, 15 Feb 2010 22:53:05 -0500 Subject: [Bioperl-guts-l] [16837] bioperl-live/trunk/t/Root/RootIO.t: TODO failing RootIO test, something borked with HTTPget Message-ID: <201002160353.o1G3r53a032096@dev.open-bio.org> Revision: 16837 Author: cjfields Date: 2010-02-15 22:53:05 -0500 (Mon, 15 Feb 2010) Log Message: ----------- TODO failing RootIO test, something borked with HTTPget Modified Paths: -------------- bioperl-live/trunk/t/Root/RootIO.t Modified: bioperl-live/trunk/t/Root/RootIO.t =================================================================== --- bioperl-live/trunk/t/Root/RootIO.t 2010-02-15 22:29:59 UTC (rev 16836) +++ bioperl-live/trunk/t/Root/RootIO.t 2010-02-16 03:53:05 UTC (rev 16837) @@ -139,11 +139,14 @@ ok $rio = Bio::Root::IO->new(-url=>$TESTURL), 'default -url method'; - if ($Bio::Root::IO::HAS_LWP) { - $Bio::Root::IO::HAS_LWP = 0; - ok $rio = Bio::Root::IO->new(-url=>$TESTURL), 'non-LWP -url method'; - } - else { - ok 1, 'non-LWP -url method not needed as non-LWP was default'; + TODO: { + local $TODO = 'HTTPget is not passing some tests on Ubuntu '; + if ($Bio::Root::IO::HAS_LWP) { + $Bio::Root::IO::HAS_LWP = 0; + lives_ok {$rio = Bio::Root::IO->new(-url=>$TESTURL)}; + } + else { + ok 1, 'non-LWP -url method not needed as non-LWP was default'; + } } } From fangly at dev.open-bio.org Tue Feb 16 01:05:54 2010 From: fangly at dev.open-bio.org (Florent E Angly) Date: Tue, 16 Feb 2010 01:05:54 -0500 Subject: [Bioperl-guts-l] [16838] bioperl-live/trunk: Added support for the '-type' method for specifying what type of sequence object to create in Bio::Seq:: SeqFastaSpeedFactory Message-ID: <201002160605.o1G65sR5001419@dev.open-bio.org> Revision: 16838 Author: fangly Date: 2010-02-16 01:05:54 -0500 (Tue, 16 Feb 2010) Log Message: ----------- Added support for the '-type' method for specifying what type of sequence object to create in Bio::Seq::SeqFastaSpeedFactory Added support for creating Bio::PrimarySeq objects in Bio::Seq::SeqFastaSpeedFactory Modified Paths: -------------- bioperl-live/trunk/Bio/Seq/Meta/Array.pm bioperl-live/trunk/Bio/Seq/SeqFactory.pm bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm bioperl-live/trunk/Bio/SeqIO/fasta.pm bioperl-live/trunk/Bio/SeqIO/metafasta.pm bioperl-live/trunk/Bio/SeqIO/tinyseq.pm bioperl-live/trunk/Bio/SeqIO.pm bioperl-live/trunk/t/SeqIO/fasta.t bioperl-live/trunk/t/SeqIO/metafasta.t Modified: bioperl-live/trunk/Bio/Seq/Meta/Array.pm =================================================================== --- bioperl-live/trunk/Bio/Seq/Meta/Array.pm 2010-02-16 03:53:05 UTC (rev 16837) +++ bioperl-live/trunk/Bio/Seq/Meta/Array.pm 2010-02-16 06:05:54 UTC (rev 16838) @@ -27,7 +27,7 @@ -start=>2434, -start=>2443, -strand=>1, - -varbose=>1, # to see warnings + -verbose=>1, # to see warnings ); # to test this is a meta seq object @@ -43,7 +43,7 @@ -start=>2443, -strand=>1, -meta=>'1 2 3 4 5 6 7 8 9 10', - -varbose=>1, # to see warnings + -verbose=>1, # to see warnings ); Modified: bioperl-live/trunk/Bio/Seq/SeqFactory.pm =================================================================== --- bioperl-live/trunk/Bio/Seq/SeqFactory.pm 2010-02-16 03:53:05 UTC (rev 16837) +++ bioperl-live/trunk/Bio/Seq/SeqFactory.pm 2010-02-16 06:05:54 UTC (rev 16838) @@ -25,10 +25,8 @@ # If you want the factory to create Bio::Seq objects instead # of the default Bio::PrimarySeq objects, use the -type parameter: - my $factory = Bio::Seq::SeqFactory->new(-type => 'Bio::Seq'); - =head1 DESCRIPTION This object will build L and L objects @@ -82,9 +80,10 @@ package Bio::Seq::SeqFactory; use strict; - use base qw(Bio::Root::Root Bio::Factory::SequenceFactoryI); +our $default_type = 'Bio::PrimarySeq'; + =head2 new Title : new @@ -100,9 +99,6 @@ my($class, at args) = @_; my $self = $class->SUPER::new(@args); my ($type) = $self->_rearrange([qw(TYPE)], @args); - if( ! defined $type ) { - $type = 'Bio::PrimarySeq'; - } $self->type($type); return $self; } @@ -137,21 +133,26 @@ Returns : value of type Args : newvalue (optional) - =cut -sub type{ +sub type { my ($self,$value) = @_; if( defined $value) { + # Set the sequence type eval "require $value"; - if( $@ ) { $self->throw("$@: Unrecognized Sequence type for SeqFactory '$value'");} - + if( $@ ) { $self->throw("$@: Unrecognized sequence type for SeqFactory '$value'");} my $a = bless {},$value; unless( $a->isa('Bio::PrimarySeqI') || $a->isa('Bio::Seq::QualI') ) { $self->throw("Must provide a valid Bio::PrimarySeqI or Bio::Seq::QualI or child class to SeqFactory Not $value"); } $self->{'type'} = $value; + } else { + # Get the sequence type + if (not defined $self->{'type'}) { + # Set the sequence type if not specified + $self->{'type'} = $default_type; + } } return $self->{'type'}; } Modified: bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm =================================================================== --- bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm 2010-02-16 03:53:05 UTC (rev 16837) +++ bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm 2010-02-16 06:05:54 UTC (rev 16838) @@ -14,7 +14,7 @@ =head1 NAME -Bio::Seq::SeqFastaSpeedFactory - Instantiates a new Bio::PrimarySeqI (or derived class) through a factory +Bio::Seq::SeqFastaSpeedFactory - Rapid instantiation of new Bio::SeqI objects through a factory using FASTA files. =head1 SYNOPSIS @@ -25,13 +25,12 @@ # If you want the factory to create Bio::Seq objects instead # of the default Bio::PrimarySeq objects, use the -type parameter: + my $factory = Bio::Seq::SeqFactory->new(-type => 'Bio::Seq'); - my $factory = Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq'); - - =head1 DESCRIPTION -This object will build Bio::Seq objects generically. +This factory is quick at building simple L and L +objects generically derived from FASTA files (no annotations). =head1 FEEDBACK @@ -84,8 +83,10 @@ use Bio::Seq; use Bio::PrimarySeq; -use base qw(Bio::Root::Root Bio::Factory::SequenceFactoryI); +use base qw(Bio::Root::Root Bio::Seq::SeqFactory); +# a Bio::Seq::SeqFactory is also a Bio::Factory::SequenceFactoryI + =head2 new Title : new @@ -100,6 +101,8 @@ sub new { my($class, at args) = @_; my $self = $class->SUPER::new(@args); + my ($type) = $self->_rearrange([qw(TYPE)], @args); + $self->type($type); return $self; } @@ -108,10 +111,11 @@ Title : create Usage : my $seq = $seqbuilder->create(-seq => 'CAGT', -id => 'name'); - Function: Instantiates a new Bio::Seq object, correctly built but very - fast, knowing stuff about Bio::PrimarySeq and Bio::Seq - Returns : Bio::Seq - + Function: Instantiates new Bio::SeqI (or one of its child classes) + This object allows us to genericize the instantiation of sequence + objects. + Returns : Bio::PrimarySeq object (default) + The return type is configurable using new(-type =>"..."). Args : initialization parameters specific to the type of sequence object we want. Typically -seq => $str, @@ -119,6 +123,7 @@ =cut +# Overloading the 'create' method of Bio::Seq::SeqFactory sub create { my ($self, at args) = @_; @@ -130,21 +135,50 @@ my $id = defined $param{'-id'} ? $param{'-id'} : $param{'-primary_id'}; my $alphabet = $param{'-alphabet'}; - my $seq = bless {}, "Bio::Seq"; - my $t_pseq = $seq->{'primary_seq'} = bless {}, "Bio::PrimarySeq"; + # Constructing Bio::PrimarySeq object + my $t_pseq = bless {}, 'Bio::PrimarySeq'; $t_pseq->{'seq'} = $sequence; $t_pseq->{'desc'} = $fulldesc; $t_pseq->{'display_id'} = $id; - $t_pseq->{'primary_id'} = $id; - $seq->{'primary_id'} = $id; # currently Bio::Seq does not delegate this if( $sequence and !$alphabet ) { $t_pseq->_guess_alphabet(); } elsif ( $sequence and $alphabet ) { $t_pseq->{'alphabet'} = $alphabet; } + + my $seq; + my $type = $self->type; + if ($type eq 'Bio::Seq') { + # Constructing Bio::Seq object + $seq = bless {}, 'Bio::Seq'; + $seq->{'primary_seq'} = $t_pseq; + } elsif ($type eq 'Bio::PrimarySeq') { + # Nothing more to do for a Bio::PrimarySeq + $seq = $t_pseq; + } else { + # Should not have any other sequence type + $self->warn("Expected sequence type Bio::Seq or Bio::Primary. Got ". + "$type. Defaulting to Bio::PrimarySeq\n"); + $self->type('Bio::PrimarySeq'); + $seq = $t_pseq; + } return $seq; } + +=head2 type + + Title : type + Usage : $obj->type($newval) + Function: + Returns : value of type + Args : newvalue (optional) + +=cut + +# Using the 'type' method from Bio::Seq::SeqFactory + + 1; Modified: bioperl-live/trunk/Bio/SeqIO/fasta.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/fasta.pm 2010-02-16 03:53:05 UTC (rev 16837) +++ bioperl-live/trunk/Bio/SeqIO/fasta.pm 2010-02-16 06:05:54 UTC (rev 16838) @@ -95,7 +95,7 @@ my ($width) = $self->_rearrange([qw(WIDTH)], @args); $width && $self->width($width); unless ( defined $self->sequence_factory ) { - $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new()); + $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::PrimarySeq')); } } Modified: bioperl-live/trunk/Bio/SeqIO/metafasta.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/metafasta.pm 2010-02-16 03:53:05 UTC (rev 16837) +++ bioperl-live/trunk/Bio/SeqIO/metafasta.pm 2010-02-16 06:05:54 UTC (rev 16838) @@ -111,7 +111,7 @@ my ($width) = $self->_rearrange([qw(WIDTH)], @args); $width && $self->width($width); unless ( defined $self->sequence_factory ) { - $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new()); + $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::PrimarySeq')); } } @@ -177,7 +177,6 @@ -direct => 1, ); - $seq = $seq->primary_seq; bless $seq, 'Bio::Seq::Meta'; foreach my $meta (@metas) { Modified: bioperl-live/trunk/Bio/SeqIO/tinyseq.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/tinyseq.pm 2010-02-16 03:53:05 UTC (rev 16837) +++ bioperl-live/trunk/Bio/SeqIO/tinyseq.pm 2010-02-16 06:05:54 UTC (rev 16838) @@ -28,7 +28,7 @@ This object reads and writes Bio::Seq objects to and from TinySeq XML format. A TinySeq is a lightweight XML file of sequence information, -analgous to FASTA format. +analogous to FASTA format. See L for the DTD. @@ -98,7 +98,7 @@ $self->SUPER::_initialize(@args); unless (defined $self->sequence_factory) { - $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new()); + $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq')); } $self->{'_species_objects'} = {}; Modified: bioperl-live/trunk/Bio/SeqIO.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO.pm 2010-02-16 03:53:05 UTC (rev 16837) +++ bioperl-live/trunk/Bio/SeqIO.pm 2010-02-16 06:05:54 UTC (rev 16838) @@ -443,11 +443,15 @@ my ($seqfact,$locfact,$objbuilder, $alphabet) = $self->_rearrange([qw(SEQFACTORY - LOCFACTORY - OBJBUILDER - ALPHABET) - ], @args); + LOCFACTORY + OBJBUILDER + ALPHABET) + ], @args); + # Florent 2010-02-16: It would probably be better to make the name of + # the attributes SEQFACTORY, LOCFACTORY, OBJBUILDER match the method + # names sequence_factory, location_factory and object_builder + $locfact = Bio::Factory::FTLocationFactory->new(-verbose => $self->verbose) if ! $locfact; @@ Diff output truncated at 10000 characters. @@ From bugzilla-daemon at portal.open-bio.org Tue Feb 16 11:22:04 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 16 Feb 2010 11:22:04 -0500 Subject: [Bioperl-guts-l] [Bug 3012] New: [TODO] Bio::Root::HTTPget tests failing Message-ID: http://bugzilla.open-bio.org/show_bug.cgi?id=3012 Summary: [TODO] Bio::Root::HTTPget tests failing Product: BioPerl Version: main-trunk Platform: PC OS/Version: Mac OS Status: NEW Severity: normal Priority: P2 Component: Core Components AssignedTo: bioperl-guts-l at bioperl.org ReportedBy: cjfields at bioperl.org Bio::Root::HTTPget tests are failing for some odd reason. This has been verified on Mac OS X (10.6.2) and Ubuntu (9.10). I have made this a TODO test fro the time being, but as it's a fallback if LWP isn't installed, might be nice to work out specifically why it's failing. Below is tail end of './Build test --test-files t/Root/RootIO.t' as of r16838: ... ok 31 ok 32 ok 33 ok 34 ok 35 ok 36 ok 37 - default -url method PATH: Bio::Root::HTTPget not ok 38 # TODO Bio::Root::HTTPget is not passing # Failed (TODO) test at t/Root/RootIO.t line 146. # died: Bio::Root::Exception ( # ------------- EXCEPTION: Bio::Root::Exception ------------- # MSG: request failed: HTTP/1.0 404 Not Found # STACK: Error::throw # STACK: Bio::Root::Root::throw Bio/Root/Root.pm:368 # STACK: Bio::Root::HTTPget::getFH Bio/Root/HTTPget.pm:242 # STACK: Bio::Root::IO::_initialize_io Bio/Root/IO.pm:310 # STACK: Bio::Root::IO::new Bio/Root/IO.pm:240 # STACK: try{} block t/Root/RootIO.t:146 # STACK: Sub::Uplevel::uplevel /opt/perl/lib/site_perl/5.10.1/Sub/Uplevel.pm:133 # STACK: Test::Exception::_try_as_caller /opt/perl/lib/site_perl/5.10.1/Test/Exception.pm:104 # STACK: Test::Exception::lives_ok /opt/perl/lib/site_perl/5.10.1/Test/Exception.pm:258 # STACK: t/Root/RootIO.t:146 # ----------------------------------------------------------- # ) ok All tests successful. Files=1, Tests=38, 1 wallclock secs ( 0.03 usr 0.01 sys + 0.26 cusr 0.07 csys = 0.37 CPU) -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Tue Feb 16 11:23:32 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 16 Feb 2010 11:23:32 -0500 Subject: [Bioperl-guts-l] [Bug 3012] [TODO] Bio::Root::HTTPget tests failing In-Reply-To: Message-ID: <201002161623.o1GGNWGZ020917@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3012 ------- Comment #1 from cjfields at bioperl.org 2010-02-16 11:23 EST ------- Note: in above output, the 'PATH:' statement is my debugging. May be variable name pollution of some sort (should be '/index.html'). -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From maj at dev.open-bio.org Tue Feb 16 11:52:09 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Tue, 16 Feb 2010 11:52:09 -0500 Subject: [Bioperl-guts-l] [16839] bioperl-live/trunk/Bio/Root/IO.pm: fixed #3012 Message-ID: <201002161652.o1GGq9la007785@dev.open-bio.org> Revision: 16839 Author: maj Date: 2010-02-16 11:52:08 -0500 (Tue, 16 Feb 2010) Log Message: ----------- fixed #3012 Modified Paths: -------------- bioperl-live/trunk/Bio/Root/IO.pm Modified: bioperl-live/trunk/Bio/Root/IO.pm =================================================================== --- bioperl-live/trunk/Bio/Root/IO.pm 2010-02-16 06:05:54 UTC (rev 16838) +++ bioperl-live/trunk/Bio/Root/IO.pm 2010-02-16 16:52:08 UTC (rev 16839) @@ -307,7 +307,7 @@ } else { #use Bio::Root::HTTPget #$self->warn("no lwp"); - $fh = Bio::Root::HTTPget->getFH($url); + $fh = Bio::Root::HTTPget::getFH($url); } } From bugzilla-daemon at portal.open-bio.org Tue Feb 16 11:52:46 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 16 Feb 2010 11:52:46 -0500 Subject: [Bioperl-guts-l] [Bug 3012] [TODO] Bio::Root::HTTPget tests failing In-Reply-To: Message-ID: <201002161652.o1GGqkqf021962@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3012 ------- Comment #2 from maj at fortinbras.us 2010-02-16 11:52 EST ------- I believe its fixed in r16839. cheers MAJ -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Tue Feb 16 11:56:47 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 16 Feb 2010 11:56:47 -0500 Subject: [Bioperl-guts-l] [Bug 3012] [TODO] Bio::Root::HTTPget tests failing In-Reply-To: Message-ID: <201002161656.o1GGulmS022104@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3012 cjfields at bioperl.org changed: What |Removed |Added ---------------------------------------------------------------------------- Severity|normal |trivial ------- Comment #3 from cjfields at bioperl.org 2010-02-16 11:56 EST ------- That did it, though we could probably fix HTTPget so that if it's called as a class/instance method it'll DTRT. I'll leave it open while I work on that. -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Tue Feb 16 12:03:23 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 16 Feb 2010 12:03:23 -0500 Subject: [Bioperl-guts-l] [Bug 3012] [TODO] Bio::Root::HTTPget tests failing In-Reply-To: Message-ID: <201002161703.o1GH3N0C022392@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3012 ------- Comment #4 from maj at fortinbras.us 2010-02-16 12:03 EST ------- Right-- I changed IO.pm rather than HTTPget.pm since most of the underscored methods in the latter didn't expect a class/instance. -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From cjfields at illinois.edu Tue Feb 16 11:54:00 2010 From: cjfields at illinois.edu (Chris Fields) Date: Tue, 16 Feb 2010 10:54:00 -0600 Subject: [Bioperl-guts-l] [16839] bioperl-live/trunk/Bio/Root/IO.pm: fixed #3012 In-Reply-To: <201002161652.o1GGq9la007785@dev.open-bio.org> References: <201002161652.o1GGq9la007785@dev.open-bio.org> Message-ID: <112B0BF4-29CD-40E6-AAD0-676DA6973287@illinois.edu> Hah! When did that change? chris On Feb 16, 2010, at 10:52 AM, Mark Allen Jensen wrote: > Revision: 16839 > Author: maj > Date: 2010-02-16 11:52:08 -0500 (Tue, 16 Feb 2010) > Log Message: > ----------- > fixed #3012 > > Modified Paths: > -------------- > bioperl-live/trunk/Bio/Root/IO.pm > > Modified: bioperl-live/trunk/Bio/Root/IO.pm > =================================================================== > --- bioperl-live/trunk/Bio/Root/IO.pm 2010-02-16 06:05:54 UTC (rev 16838) > +++ bioperl-live/trunk/Bio/Root/IO.pm 2010-02-16 16:52:08 UTC (rev 16839) > @@ -307,7 +307,7 @@ > } else { #use Bio::Root::HTTPget > #$self->warn("no lwp"); > > - $fh = Bio::Root::HTTPget->getFH($url); > + $fh = Bio::Root::HTTPget::getFH($url); > } > } > > > _______________________________________________ > Bioperl-guts-l mailing list > Bioperl-guts-l at lists.open-bio.org > http://lists.open-bio.org/mailman/listinfo/bioperl-guts-l From cjfields at dev.open-bio.org Tue Feb 16 12:14:12 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Tue, 16 Feb 2010 12:14:12 -0500 Subject: [Bioperl-guts-l] [16840] bioperl-live/trunk/t/Root/RootIO.t: no longer a TODO; writing up a couple of simple HTTPget tests for trunk Message-ID: <201002161714.o1GHECwV007984@dev.open-bio.org> Revision: 16840 Author: cjfields Date: 2010-02-16 12:14:12 -0500 (Tue, 16 Feb 2010) Log Message: ----------- no longer a TODO; writing up a couple of simple HTTPget tests for trunk Modified Paths: -------------- bioperl-live/trunk/t/Root/RootIO.t Modified: bioperl-live/trunk/t/Root/RootIO.t =================================================================== --- bioperl-live/trunk/t/Root/RootIO.t 2010-02-16 16:52:08 UTC (rev 16839) +++ bioperl-live/trunk/t/Root/RootIO.t 2010-02-16 17:14:12 UTC (rev 16840) @@ -2,6 +2,7 @@ # $Id$ use strict; +use warnings; BEGIN { use lib '.'; @@ -135,18 +136,10 @@ SKIP: { test_skip(-tests => 2, -requires_networking => 1); - my $TESTURL = 'http://www.google.com/index.html'; + my $TESTURL = 'http://www.google.com'; ok $rio = Bio::Root::IO->new(-url=>$TESTURL), 'default -url method'; - TODO: { - local $TODO = 'HTTPget is not passing some tests on Ubuntu '; - if ($Bio::Root::IO::HAS_LWP) { - $Bio::Root::IO::HAS_LWP = 0; - lives_ok {$rio = Bio::Root::IO->new(-url=>$TESTURL)}; - } - else { - ok 1, 'non-LWP -url method not needed as non-LWP was default'; - } - } + $Bio::Root::IO::HAS_LWP = 0; + lives_ok {$rio = Bio::Root::IO->new(-url=>$TESTURL)}; } From cjfields at dev.open-bio.org Tue Feb 16 12:19:47 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Tue, 16 Feb 2010 12:19:47 -0500 Subject: [Bioperl-guts-l] [16841] bioperl-live/trunk/t/Root/RootIO.t: add back original URL (wasn' t complete) Message-ID: <201002161719.o1GHJlLg008118@dev.open-bio.org> Revision: 16841 Author: cjfields Date: 2010-02-16 12:19:46 -0500 (Tue, 16 Feb 2010) Log Message: ----------- add back original URL (wasn't complete) Modified Paths: -------------- bioperl-live/trunk/t/Root/RootIO.t Modified: bioperl-live/trunk/t/Root/RootIO.t =================================================================== --- bioperl-live/trunk/t/Root/RootIO.t 2010-02-16 17:14:12 UTC (rev 16840) +++ bioperl-live/trunk/t/Root/RootIO.t 2010-02-16 17:19:46 UTC (rev 16841) @@ -136,7 +136,7 @@ SKIP: { test_skip(-tests => 2, -requires_networking => 1); - my $TESTURL = 'http://www.google.com'; + my $TESTURL = 'http://www.google.com/index.html'; ok $rio = Bio::Root::IO->new(-url=>$TESTURL), 'default -url method'; From cjfields at dev.open-bio.org Tue Feb 16 13:30:04 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Tue, 16 Feb 2010 13:30:04 -0500 Subject: [Bioperl-guts-l] [16842] bioperl-live/trunk: initial tests for HTTPget, including various calls (class, instance, sub) Message-ID: <201002161830.o1GIU4jL008730@dev.open-bio.org> Revision: 16842 Author: cjfields Date: 2010-02-16 13:30:04 -0500 (Tue, 16 Feb 2010) Log Message: ----------- initial tests for HTTPget, including various calls (class, instance, sub) Modified Paths: -------------- bioperl-live/trunk/Bio/Root/HTTPget.pm Added Paths: ----------- bioperl-live/trunk/t/Root/HTTPget.t Modified: bioperl-live/trunk/Bio/Root/HTTPget.pm =================================================================== --- bioperl-live/trunk/Bio/Root/HTTPget.pm 2010-02-16 17:19:46 UTC (rev 16841) +++ bioperl-live/trunk/Bio/Root/HTTPget.pm 2010-02-16 18:30:04 UTC (rev 16842) @@ -94,6 +94,9 @@ use base qw(Bio::Root::Root); +{ + # default attributes, in case used as a class/sub call + my %attributes; =head2 get @@ -111,7 +114,7 @@ sub get { my $self; - if( ref($_[0]) ) { + if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) { $self = shift; } @@ -199,6 +202,10 @@ =cut sub getFH { + my $self; + if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) { + $self = shift; + } my ($url,$proxy,$timeout,$auth_user,$auth_pass) = __PACKAGE__->_rearrange([qw(URL PROXY TIMEOUT USER PASS)], at _); my $dest = $proxy || $url; @@ -275,6 +282,10 @@ =cut sub _http_parse_url { + my $self; + if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) { + $self = shift; + } my $url = shift; my ($user,$pass,$hostent,$path) = $url =~ m!^http://(?:([^:]+):([^:]+)@)?([^/]+)(/?[^\#]*)! or return; @@ -318,6 +329,10 @@ =cut sub _encode_base64 { + my $self; + if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) { + $self = shift; + } my $res = ""; my $eol = $_[1]; $eol = "\n" unless defined $eol; @@ -353,7 +368,12 @@ =cut sub proxy { - my ($self,$protocol,$proxy,$username,$password) = @_; + my $self; + if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) { + $self = shift; + } + my ($protocol,$proxy,$username,$password) = @_; + my $atts = ref($self) ? $self : \%attributes; $protocol ||= 'http'; unless ($proxy) { if (defined $ENV{http_proxy}) { @@ -365,9 +385,10 @@ } } return unless (defined $proxy); - $self->authentication($username, $password) + # default to class method call + __PACKAGE__->authentication($username, $password) if ($username && $password); - return $self->{'_proxy'}->{$protocol} = $proxy; + return $atts->{'_proxy'}->{$protocol} = $proxy; } =head2 authentication @@ -381,13 +402,21 @@ =cut -sub authentication{ - my ($self,$u,$p) = @_; +sub authentication { + my $self; + if($_[0] && (ref($_[0]) or $_[0] =~ /^Bio::/)) { + $self = shift; + } + my $atts = ref($self) ? $self : \%attributes; + if (@_) { + my ($u,$p) = @_; + my $atts = ref($self) ? $self : \%attributes; + + $atts->{'_authentication'} = [ $u,$p]; + } + return @{$atts->{'_authentication'} || []}; +} - if( defined $u && defined $p ) { - $self->{'_authentication'} = [ $u,$p]; - } - return @{$self->{'_authentication'} || []}; } 1; Added: bioperl-live/trunk/t/Root/HTTPget.t =================================================================== --- bioperl-live/trunk/t/Root/HTTPget.t (rev 0) +++ bioperl-live/trunk/t/Root/HTTPget.t 2010-02-16 18:30:04 UTC (rev 16842) @@ -0,0 +1,115 @@ +# -*-Perl-*- Test Harness script for Bioperl +# $Id: RootIO.t 16840 2010-02-16 17:14:12Z cjfields $ + +use strict; +use warnings; + +BEGIN { + use lib '.'; + use Bio::Root::Test; + + test_begin(-tests => 28, + -requires_networking => 1); + + use_ok('Bio::Root::HTTPget'); +} + +my $TESTURL = 'http://www.google.com/index.html'; + +my $TEST_PROXY = 'http://myproxy'; + +my @TEST_AUTHENTICATION = qw(foo bar); + +my ($fh, $proxy); + +my @auth; + +=head1 Bio::Root::HTTPget comments + +This module is a bit schizophrenic in that it is called in three different +ways; as an instance method, a class method, or as an explicit subroutine. + +These tests check for all call types. They are by no means incomplete. + +=cut + +# test object method calls +my $obj = Bio::Root::HTTPget->new(); + +ok defined($obj) && $obj->isa('Bio::Root::Root'); + +lives_ok {$obj->get($TESTURL)}; +lives_ok {$fh = $obj->getFH($TESTURL)}; +isa_ok($fh, 'IO::Socket::INET'); + +undef($fh); + +is ($obj->proxy(), undef); +is_deeply([$obj->authentication], []); +$obj->proxy('http', $TEST_PROXY); +$obj->authentication(@TEST_AUTHENTICATION); +TODO: { + local $TODO = 'proxy not working'; + is ($obj->proxy(), $TEST_PROXY); +} +is_deeply([$obj->authentication], \@TEST_AUTHENTICATION); + +# test class method calls; note that mixing class and sub calls pollutes the +# class attributes + +lives_ok {Bio::Root::HTTPget->get($TESTURL)}; +lives_ok {$fh = Bio::Root::HTTPget->getFH($TESTURL)}; +isa_ok($fh, 'IO::Socket::INET'); + +undef($fh); + +is (Bio::Root::HTTPget->proxy(), undef); +is_deeply([Bio::Root::HTTPget->authentication], []); +Bio::Root::HTTPget->proxy('http', $TEST_PROXY); +Bio::Root::HTTPget->authentication(@TEST_AUTHENTICATION); +TODO: { + local $TODO = 'proxy not working'; + is (Bio::Root::HTTPget->proxy('http'), $TEST_PROXY); +} +is_deeply([Bio::Root::HTTPget->authentication], \@TEST_AUTHENTICATION); + +# test sub calls (not called as method) + +lives_ok {Bio::Root::HTTPget::get($TESTURL)}; +lives_ok {$fh = Bio::Root::HTTPget::getFH($TESTURL)}; +isa_ok($fh, 'IO::Socket::INET'); + +undef($fh); + +# note that mixing class and sub calls pollutes the class attributes, have to +# manually reset +Bio::Root::HTTPget->authentication(undef, undef); +Bio::Root::HTTPget->proxy('http', undef); + +is (Bio::Root::HTTPget::proxy(), undef); +is_deeply([Bio::Root::HTTPget->authentication], [undef, undef]); +Bio::Root::HTTPget::proxy('http', $TEST_PROXY); +Bio::Root::HTTPget::authentication(@TEST_AUTHENTICATION); +TODO: { + local $TODO = 'proxy not working'; + is (Bio::Root::HTTPget::proxy('http'), $TEST_PROXY); +} +is_deeply([Bio::Root::HTTPget::authentication], \@TEST_AUTHENTICATION); + +# check to make sure new instance attributes are not polluted by class attrbutes +# from previous tests + +my $newobj = Bio::Root::HTTPget->new(); + +ok defined($newobj) && $obj->isa('Bio::Root::Root'); + +is ($newobj->proxy(), undef); +is_deeply([$newobj->authentication], []); +$newobj->proxy('http', $TEST_PROXY); +$newobj->authentication(@TEST_AUTHENTICATION); +TODO: { + local $TODO = 'proxy not working'; + is ($newobj->proxy(), $TEST_PROXY); +} +is_deeply([$newobj->authentication], \@TEST_AUTHENTICATION); + From bugzilla-daemon at portal.open-bio.org Tue Feb 16 13:36:22 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 16 Feb 2010 13:36:22 -0500 Subject: [Bioperl-guts-l] [Bug 3012] [TODO] Bio::Root::HTTPget tests failing In-Reply-To: Message-ID: <201002161836.o1GIaMSI026299@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3012 ------- Comment #5 from cjfields at bioperl.org 2010-02-16 13:36 EST ------- Okay, have this working to catch all three call types: $obj->get('http://myurl'); # instance method Bio::Root::HTTPget->get('http://myurl'); # class method Bio::Root::HTTPget::get('http://myurl'); # sub The latter two use class attributes, but mixing the two calls cross-pollutes the attributes. Instances use their own attributes by default. We should probably change this so it is less schizophrenic, but it works. Oh, and the tests uncovered a significant bug (proxy() doesn't work), marked that as a TODO. Will close out if I can sort out why proxy doesn't work. -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From cjfields at dev.open-bio.org Tue Feb 16 13:49:15 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Tue, 16 Feb 2010 13:49:15 -0500 Subject: [Bioperl-guts-l] [16843] bioperl-live/trunk/t/Assembly/Assembly.t: fix syntax error and test number Message-ID: <201002161849.o1GInFZh008967@dev.open-bio.org> Revision: 16843 Author: cjfields Date: 2010-02-16 13:49:15 -0500 (Tue, 16 Feb 2010) Log Message: ----------- fix syntax error and test number Modified Paths: -------------- bioperl-live/trunk/t/Assembly/Assembly.t Modified: bioperl-live/trunk/t/Assembly/Assembly.t =================================================================== --- bioperl-live/trunk/t/Assembly/Assembly.t 2010-02-16 18:30:04 UTC (rev 16842) +++ bioperl-live/trunk/t/Assembly/Assembly.t 2010-02-16 18:49:15 UTC (rev 16843) @@ -7,7 +7,7 @@ use lib '.'; use Bio::Root::Test; - test_begin( -tests => 1264 + 755; + test_begin( -tests => 1266 + 755, -requires_module => 'DB_File' ); use_ok('Bio::Assembly::IO'); From cjfields at dev.open-bio.org Tue Feb 16 13:57:29 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Tue, 16 Feb 2010 13:57:29 -0500 Subject: [Bioperl-guts-l] [16844] bioperl-live/trunk/t/Map/Map.t: volatile data fix Message-ID: <201002161857.o1GIvTko009081@dev.open-bio.org> Revision: 16844 Author: cjfields Date: 2010-02-16 13:57:29 -0500 (Tue, 16 Feb 2010) Log Message: ----------- volatile data fix Modified Paths: -------------- bioperl-live/trunk/t/Map/Map.t Modified: bioperl-live/trunk/t/Map/Map.t =================================================================== --- bioperl-live/trunk/t/Map/Map.t 2010-02-16 18:49:15 UTC (rev 16843) +++ bioperl-live/trunk/t/Map/Map.t 2010-02-16 18:57:29 UTC (rev 16844) @@ -674,7 +674,7 @@ skip('Failed to retreive anything from Ensembl; not sure why', 19) unless $success; - is $gene->get_transcript_position($map1)->toString($pos->absolute_relative), '1001..85193'; + is $gene->get_transcript_position($map1)->toString($pos->absolute_relative), '1001..84737'; is $gene->get_transcript_position($map2)->toString($pos->absolute_relative), '501..47617'; is $gene->get_transcript_position($map4)->toString($pos->absolute_relative), '1373..37665'; like $gene->description($map1), qr/Breast cancer type 2 susceptibility protein \(Fanconi anemia group D1 protein\)/; @@ -694,11 +694,11 @@ # now the gene has a database connection, its maps and positions can get sequence ok my $seq = $map1->seq; - is length($seq), 85193; - is substr($seq, 0, 20), 'AGAACCAACGAATTCGGAGA'; # start of upstream - is substr($seq, -20, 20), 'CTTTCAAATTGGCACTGATT'; # end of gene since no downstream + is length($seq), 84737; + is substr($seq, 0, 20), 'TGTTACAGAACCAACGAATT'; # start of upstream + is substr($seq, -20, 20), 'CTACAAGTATTATTTTACAA'; # end of gene since no downstream is substr($map1->subseq($gene->coding_position($map1)), 0, 3), 'ATG'; - my $exon1_str = 'GTGGCGCGAGCTTCTGAAACTAGGCGGCAGAGGCGGAGCCGCTGTGGCACTGCTGCGCCTCTGCTGCGCCTCGGGTGTCTTTTGCGGCGGTGGGTCGCCGCCGGGAGAAGCGTGAGGGGACAGATTTGTGACCGGCGCGGTTTTTGTCAGCTTACTCCGGCCAAAAAAGAACTGCACCTCTGGAGCGG'; + my $exon1_str = 'GGGCTTGTGGCGCGAGCTTCTGAAACTAGGCGGCAGAGGCGGAGCCGCTGTGGCACTGCTGCGCCTCTGCTGCG'; my $exon1_pos = $gene->get_exon_position($map1, 1); is $map1->subseq($exon1_pos), $exon1_str; is $exon1_pos->seq, $exon1_str; From dave_messina at dev.open-bio.org Wed Feb 17 11:28:00 2010 From: dave_messina at dev.open-bio.org (Dave Messina) Date: Wed, 17 Feb 2010 11:28:00 -0500 Subject: [Bioperl-guts-l] [16845] bioperl-live/trunk: Correcting failures in tests 15 & 36 due to incorrect use of Bio::Species- >species. Message-ID: <201002171628.o1HGS0B9027070@dev.open-bio.org> Revision: 16845 Author: dave_messina Date: 2010-02-17 11:27:59 -0500 (Wed, 17 Feb 2010) Log Message: ----------- Correcting failures in tests 15 & 36 due to incorrect use of Bio::Species->species. All tests in seqxml.t now pass. Modified Paths: -------------- bioperl-live/trunk/Bio/SeqIO/seqxml.pm bioperl-live/trunk/t/SeqIO/seqxml.t Modified: bioperl-live/trunk/Bio/SeqIO/seqxml.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/seqxml.pm 2010-02-16 18:57:29 UTC (rev 16844) +++ bioperl-live/trunk/Bio/SeqIO/seqxml.pm 2010-02-17 16:27:59 UTC (rev 16845) @@ -284,13 +284,13 @@ # species and NCBI taxID if ( $seqobj->species ) { - my $name = $seqobj->species->binomial; + my $name = $seqobj->species->node_name; my $taxid = $seqobj->species->ncbi_taxid; if ( $name && ( $taxid =~ /[0-9]+/ ) ) { $writer->emptyTag( 'species', - 'name' => $seqobj->species->binomial, - 'ncbiTaxID' => $seqobj->species->ncbi_taxid + 'name' => $name, + 'ncbiTaxID' => $taxid ); } else { @@ -690,7 +690,7 @@ { $species_obj = Bio::Species->new( -ncbi_taxid => $species_data->{'ncbiTaxID'}, ); - $species_obj->binomial( $species_data->{'name'} ); + $species_obj->node_name( $species_data->{'name'} ); $data->{'species'} = $species_obj; } else { Modified: bioperl-live/trunk/t/SeqIO/seqxml.t =================================================================== --- bioperl-live/trunk/t/SeqIO/seqxml.t 2010-02-16 18:57:29 UTC (rev 16844) +++ bioperl-live/trunk/t/SeqIO/seqxml.t 2010-02-17 16:27:59 UTC (rev 16845) @@ -59,7 +59,7 @@ # species isa_ok( $seq_obj->species, 'Bio::Species', 'species' ); - is( $seq_obj->species->species, 'Homo sapiens', 'species name' ); + is( $seq_obj->species->node_name, 'Homo sapiens', 'species name' ); is( $seq_obj->species->ncbi_taxid, '9606', 'NCBI tax id' ); # alternative IDs @@ -128,7 +128,7 @@ # species isa_ok( $new_seqobj->species, 'Bio::Species', 'species' ); - is( $new_seqobj->species->species, 'Homo sapiens', 'species name' ); + is( $new_seqobj->species->node_name, 'Homo sapiens', 'species name' ); is( $new_seqobj->species->ncbi_taxid, '9606', 'NCBI tax id' ); # alternative IDs @@ -158,9 +158,15 @@ # write data from a Seq object created from a fasta file { + # forcing a Bio::Seq to be created + # due to SeqIO::fasta creating a PrimarySeq by default + # as of r16838 + my $factory = Bio::Seq::SeqFactory->new(-type => 'Bio::Seq'); + my $seq_stream = Bio::SeqIO->new( -file => test_input_file("test.fasta"), -format => 'fasta', + -seqfactory => $factory, ); my $outfile = test_output_file(); From jason at dev.open-bio.org Wed Feb 17 14:49:41 2010 From: jason at dev.open-bio.org (Jason Stajich) Date: Wed, 17 Feb 2010 14:49:41 -0500 Subject: [Bioperl-guts-l] [16846] bioperl-live/trunk/t/LocalDB/DBFasta.t: get the test count right Message-ID: <201002171949.o1HJnfSj000538@dev.open-bio.org> Revision: 16846 Author: jason Date: 2010-02-17 14:49:40 -0500 (Wed, 17 Feb 2010) Log Message: ----------- get the test count right Modified Paths: -------------- bioperl-live/trunk/t/LocalDB/DBFasta.t Modified: bioperl-live/trunk/t/LocalDB/DBFasta.t =================================================================== --- bioperl-live/trunk/t/LocalDB/DBFasta.t 2010-02-17 16:27:59 UTC (rev 16845) +++ bioperl-live/trunk/t/LocalDB/DBFasta.t 2010-02-17 19:49:40 UTC (rev 16846) @@ -6,9 +6,8 @@ use lib '.'; use Bio::Root::Test; - test_begin(-tests => 15, - -requires_module => 'Bio::DB::Fasta'); - + test_begin(-tests => 17, + -requires_modules => [qw(Bio::DB::Fasta Bio::SeqIO)]); use_ok('Bio::Root::IO'); use_ok('File::Copy'); } @@ -55,3 +54,22 @@ my $revcom = reverse $dna1; $revcom =~ tr/gatcGATC/ctagCTAG/; is($dna2, $revcom); + +# test out writing the Bio::PrimarySeq::Fasta objects with SeqIO + +$db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1); +my $out = Bio::SeqIO->new(-format => 'genbank'); +$primary_seq = Bio::Seq->new(-primary_seq => $db->get_Seq_by_acc('AW057119')); +eval { + warn(ref($primary_seq),"\n"); + $out->write_seq($primary_seq) +}; +ok(!$@); + +$out = Bio::SeqIO->new(-format => 'embl'); + +eval { + $out->write_seq($primary_seq) +}; +ok(!$@); + From jason at dev.open-bio.org Wed Feb 17 14:50:59 2010 From: jason at dev.open-bio.org (Jason Stajich) Date: Wed, 17 Feb 2010 14:50:59 -0500 Subject: [Bioperl-guts-l] [16847] bioperl-live/trunk: rollback Florent's changes that defaulted Bio:: PrimarySeq instead of Bio::Seq creation of objects Message-ID: <201002171950.o1HJox2Y000573@dev.open-bio.org> Revision: 16847 Author: jason Date: 2010-02-17 14:50:58 -0500 (Wed, 17 Feb 2010) Log Message: ----------- rollback Florent's changes that defaulted Bio::PrimarySeq instead of Bio::Seq creation of objects Modified Paths: -------------- bioperl-live/trunk/Bio/Seq/SeqFactory.pm bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm bioperl-live/trunk/Bio/SeqIO/fasta.pm bioperl-live/trunk/Bio/SeqIO/metafasta.pm bioperl-live/trunk/t/SeqIO/fasta.t Property Changed: ---------------- bioperl-live/trunk/t/SeqIO/fasta.t Modified: bioperl-live/trunk/Bio/Seq/SeqFactory.pm =================================================================== --- bioperl-live/trunk/Bio/Seq/SeqFactory.pm 2010-02-17 19:49:40 UTC (rev 16846) +++ bioperl-live/trunk/Bio/Seq/SeqFactory.pm 2010-02-17 19:50:58 UTC (rev 16847) @@ -82,7 +82,7 @@ use base qw(Bio::Root::Root Bio::Factory::SequenceFactoryI); -our $default_type = 'Bio::PrimarySeq'; +our $default_type = 'Bio::Seq'; =head2 new @@ -91,7 +91,7 @@ Function: Builds a new Bio::Seq::SeqFactory object Returns : Bio::Seq::SeqFactory Args : -type => string, name of a PrimarySeqI derived class - This is optional. Default=Bio::PrimarySeq. + This is optional. Default=Bio::Seq =cut @@ -111,7 +111,7 @@ Function: Instantiates new Bio::SeqI (or one of its child classes) This object allows us to genericize the instantiation of sequence objects. - Returns : Bio::PrimarySeq object (default) + Returns : Bio::Seq object (default) The return type is configurable using new(-type =>"..."). Args : initialization parameters specific to the type of sequence object we want. Typically Modified: bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm =================================================================== --- bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm 2010-02-17 19:49:40 UTC (rev 16846) +++ bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm 2010-02-17 19:50:58 UTC (rev 16847) @@ -23,9 +23,9 @@ my $seq = $factory->create(-seq => 'WYRAVLC', -id => 'name'); - # If you want the factory to create Bio::Seq objects instead - # of the default Bio::PrimarySeq objects, use the -type parameter: - my $factory = Bio::Seq::SeqFactory->new(-type => 'Bio::Seq'); + # If you want the factory to create Bio::PrimarySeq objects instead + # of the default Bio::Seq objects, use the -type parameter: + my $factory = Bio::Seq::SeqFactory->new(-type => 'Bio::PrimarySeq'); =head1 DESCRIPTION @@ -94,7 +94,7 @@ Function: Builds a new Bio::Seq::SeqFastaSpeedFactory object Returns : Bio::Seq::SeqFastaSpeedFactory Args : -type => string, name of a PrimarySeqI derived class - This is optional. Default=Bio::PrimarySeq. + This is optional. Default=Bio::Seq. =cut @@ -114,7 +114,7 @@ Function: Instantiates new Bio::SeqI (or one of its child classes) This object allows us to genericize the instantiation of sequence objects. - Returns : Bio::PrimarySeq object (default) + Returns : Bio::Seq object (default) The return type is configurable using new(-type =>"..."). Args : initialization parameters specific to the type of sequence object we want. Typically @@ -157,7 +157,7 @@ $seq = $t_pseq; } else { # Should not have any other sequence type - $self->warn("Expected sequence type Bio::Seq or Bio::Primary. Got ". + $self->warn("Expected sequence type Bio::Seq or Bio::PrimarySeq. Got ". "$type. Defaulting to Bio::PrimarySeq\n"); $self->type('Bio::PrimarySeq'); $seq = $t_pseq; Modified: bioperl-live/trunk/Bio/SeqIO/fasta.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/fasta.pm 2010-02-17 19:49:40 UTC (rev 16846) +++ bioperl-live/trunk/Bio/SeqIO/fasta.pm 2010-02-17 19:50:58 UTC (rev 16847) @@ -95,7 +95,7 @@ my ($width) = $self->_rearrange([qw(WIDTH)], @args); $width && $self->width($width); unless ( defined $self->sequence_factory ) { - $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::PrimarySeq')); + $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq')); } } Modified: bioperl-live/trunk/Bio/SeqIO/metafasta.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/metafasta.pm 2010-02-17 19:49:40 UTC (rev 16846) +++ bioperl-live/trunk/Bio/SeqIO/metafasta.pm 2010-02-17 19:50:58 UTC (rev 16847) @@ -111,7 +111,7 @@ my ($width) = $self->_rearrange([qw(WIDTH)], @args); $width && $self->width($width); unless ( defined $self->sequence_factory ) { - $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::PrimarySeq')); + $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq')); } } @@ -176,7 +176,7 @@ -alphabet => $alphabet, -direct => 1, ); - + $seq = $seq->primary_seq; bless $seq, 'Bio::Seq::Meta'; foreach my $meta (@metas) { Modified: bioperl-live/trunk/t/SeqIO/fasta.t =================================================================== --- bioperl-live/trunk/t/SeqIO/fasta.t 2010-02-17 19:49:40 UTC (rev 16846) +++ bioperl-live/trunk/t/SeqIO/fasta.t 2010-02-17 19:50:58 UTC (rev 16847) @@ -31,7 +31,7 @@ # checking the first sequence object my $seq_obj = $seqio_obj->next_seq(); -isa_ok($seq_obj, 'Bio::PrimarySeq'); +isa_ok($seq_obj, 'Bio::Seq'); my %expected = ('seq' => 'MVNSNQNQNGNSNGHDDDFPQDSITEPEHMRKLFIGGL' . 'DYRTTDENLKAHEKWGNIVDVVVMKDPRTKRSRGFGFI' . 'TYSHSSMIDEAQKSRPHKIDGRVEPKRAVPRQDIDSPN' . @@ -54,7 +54,7 @@ # checking the second sequence object my $seq_obj2 = $seqio_obj->next_seq(); -isa_ok($seq_obj2, 'Bio::PrimarySeq'); +isa_ok($seq_obj2, 'Bio::Seq'); my %expected2 = ('seq' => 'MVNSNQNQNGNSNGHDDDFPQDSITEPEHMRKLFIGGL' . 'DYRTTDENLKAHEKWGNIVDVVVMKDPTSTSTSTSTST' . 'STSTSTMIDEAQKSRPHKIDGRVEPKRAVPRQDIDSPN' . Property changes on: bioperl-live/trunk/t/SeqIO/fasta.t ___________________________________________________________________ Name: svn:mergeinfo - From cjfields at dev.open-bio.org Thu Feb 18 17:28:08 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Thu, 18 Feb 2010 17:28:08 -0500 Subject: [Bioperl-guts-l] [16848] Bio-FeatureIO/trunk: add proper Test suite to local inc as a backup Message-ID: <201002182228.o1IMS8Me016147@dev.open-bio.org> Revision: 16848 Author: cjfields Date: 2010-02-18 17:28:07 -0500 (Thu, 18 Feb 2010) Log Message: ----------- add proper Test suite to local inc as a backup Added Paths: ----------- Bio-FeatureIO/trunk/inc/ Bio-FeatureIO/trunk/inc/Test/ Bio-FeatureIO/trunk/inc/Test/Builder/ Bio-FeatureIO/trunk/inc/Test/Builder/IO/ Bio-FeatureIO/trunk/inc/Test/Builder/IO/Scalar.pm Bio-FeatureIO/trunk/inc/Test/Builder/Module.pm Bio-FeatureIO/trunk/inc/Test/Builder/Tester/ Bio-FeatureIO/trunk/inc/Test/Builder/Tester/Color.pm Bio-FeatureIO/trunk/inc/Test/Builder/Tester.pm Bio-FeatureIO/trunk/inc/Test/Builder.pm Bio-FeatureIO/trunk/inc/Test/Exception.pm Bio-FeatureIO/trunk/inc/Test/More.pm Bio-FeatureIO/trunk/inc/Test/Simple.pm Bio-FeatureIO/trunk/inc/Test/Tutorial.pod Bio-FeatureIO/trunk/inc/Test/Warn.pm Added: Bio-FeatureIO/trunk/inc/Test/Builder/IO/Scalar.pm =================================================================== --- Bio-FeatureIO/trunk/inc/Test/Builder/IO/Scalar.pm (rev 0) +++ Bio-FeatureIO/trunk/inc/Test/Builder/IO/Scalar.pm 2010-02-18 22:28:07 UTC (rev 16848) @@ -0,0 +1,658 @@ +package Test::Builder::IO::Scalar; + + +=head1 NAME + +Test::Builder::IO::Scalar - A copy of IO::Scalar for Test::Builder + +=head1 DESCRIPTION + +This is a copy of IO::Scalar which ships with Test::Builder to +support scalar references as filehandles on Perl 5.6. Newer +versions of Perl simply use C<>'s built in support. + +Test::Builder can not have dependencies on other modules without +careful consideration, so its simply been copied into the distribution. + +=head1 COPYRIGHT and LICENSE + +This file came from the "IO-stringy" Perl5 toolkit. + +Copyright (c) 1996 by Eryq. All rights reserved. +Copyright (c) 1999,2001 by ZeeGee Software Inc. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + +=cut + +# This is copied code, I don't care. +##no critic + +use Carp; +use strict; +use vars qw($VERSION @ISA); +use IO::Handle; + +use 5.005; + +### The package version, both in 1.23 style *and* usable by MakeMaker: +$VERSION = "2.110"; + +### Inheritance: + at ISA = qw(IO::Handle); + +#============================== + +=head2 Construction + +=over 4 + +=cut + +#------------------------------ + +=item new [ARGS...] + +I +Return a new, unattached scalar handle. +If any arguments are given, they're sent to open(). + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = bless \do { local *FH }, $class; + tie *$self, $class, $self; + $self->open(@_); ### open on anonymous by default + $self; +} +sub DESTROY { + shift->close; +} + +#------------------------------ + +=item open [SCALARREF] + +I +Open the scalar handle on a new scalar, pointed to by SCALARREF. +If no SCALARREF is given, a "private" scalar is created to hold +the file data. + +Returns the self object on success, undefined on error. + +=cut + +sub open { + my ($self, $sref) = @_; + + ### Sanity: + defined($sref) or do {my $s = ''; $sref = \$s}; + (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar"; + + ### Setup: + *$self->{Pos} = 0; ### seek position + *$self->{SR} = $sref; ### scalar reference + $self; +} + +#------------------------------ + +=item opened + +I +Is the scalar handle opened on something? + +=cut + +sub opened { + *{shift()}->{SR}; +} + +#------------------------------ + +=item close + +I +Disassociate the scalar handle from its underlying scalar. +Done automatically on destroy. + +=cut + +sub close { + my $self = shift; + %{*$self} = (); + 1; +} + +=back + +=cut + + + +#============================== + +=head2 Input and output + +=over 4 + +=cut + + +#------------------------------ + +=item flush + +I +No-op, provided for OO compatibility. + +=cut + +sub flush { "0 but true" } + +#------------------------------ + +=item getc + +I +Return the next character, or undef if none remain. + +=cut + +sub getc { + my $self = shift; + + ### Return undef right away if at EOF; else, move pos forward: + return undef if $self->eof; + substr(${*$self->{SR}}, *$self->{Pos}++, 1); +} + +#------------------------------ + +=item getline + +I +Return the next line, or undef on end of string. +Can safely be called in an array context. +Currently, lines are delimited by "\n". + +=cut + +sub getline { + my $self = shift; + + ### Return undef right away if at EOF: + return undef if $self->eof; + + ### Get next line: + my $sr = *$self->{SR}; + my $i = *$self->{Pos}; ### Start matching at this point. + + ### Minimal impact implementation! + ### We do the fast fast thing (no regexps) if using the + ### classic input record separator. + + ### Case 1: $/ is undef: slurp all... + if (!defined($/)) { + *$self->{Pos} = length $$sr; + return substr($$sr, $i); + } + + ### Case 2: $/ is "\n": zoom zoom zoom... + elsif ($/ eq "\012") { + + ### Seek ahead for "\n"... yes, this really is faster than regexps. + my $len = length($$sr); + for (; $i < $len; ++$i) { + last if ord (substr ($$sr, $i, 1)) == 10; + } + + ### Extract the line: + my $line; + if ($i < $len) { ### We found a "\n": + $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1); + *$self->{Pos} = $i+1; ### Remember where we finished up. + } + else { ### No "\n"; slurp the remainder: + $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos}); + *$self->{Pos} = $len; + } + return $line; + } + + ### Case 3: $/ is ref to int. Do fixed-size records. + ### (Thanks to Dominique Quatravaux.) + elsif (ref($/)) { + my $len = length($$sr); + my $i = ${$/} + 0; + my $line = substr ($$sr, *$self->{Pos}, $i); + *$self->{Pos} += $i; + *$self->{Pos} = $len if (*$self->{Pos} > $len); + return $line; + } + + ### Case 4: $/ is either "" (paragraphs) or something weird... + ### This is Graham's general-purpose stuff, which might be + ### a tad slower than Case 2 for typical data, because + ### of the regexps. + else { + pos($$sr) = $i; + + ### If in paragraph mode, skip leading lines (and update i!): + length($/) or + (($$sr =~ m/\G\n*/g) and ($i = pos($$sr))); + + ### If we see the separator in the buffer ahead... + if (length($/) + ? $$sr =~ m,\Q$/\E,g ### (ordinary sep) TBD: precomp! + : $$sr =~ m,\n\n,g ### (a paragraph) + ) { + *$self->{Pos} = pos $$sr; + return substr($$sr, $i, *$self->{Pos}-$i); + } + ### Else if no separator remains, just slurp the rest: + else { + *$self->{Pos} = length $$sr; + return substr($$sr, $i); + } + } +} + +#------------------------------ + +=item getlines + +I +Get all remaining lines. +It will croak() if accidentally called in a scalar context. + +=cut + +sub getlines { + my $self = shift; + wantarray or croak("can't call getlines in scalar context!"); + my ($line, @lines); + push @lines, $line while (defined($line = $self->getline)); + @lines; +} + +#------------------------------ + +=item print ARGS... + +I +Print ARGS to the underlying scalar. + +B this continues to always cause a seek to the end +of the string, but if you perform seek()s and tell()s, it is +still safer to explicitly seek-to-end before subsequent print()s. + +=cut + +sub print { + my $self = shift; + *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : "")); + 1; +} +sub _unsafe_print { + my $self = shift; + my $append = join('', @_) . $\; + ${*$self->{SR}} .= $append; + *$self->{Pos} += length($append); + 1; +} +sub _old_print { + my $self = shift; + ${*$self->{SR}} .= join('', @_) . $\; + *$self->{Pos} = length(${*$self->{SR}}); + 1; +} + + +#------------------------------ + +=item read BUF, NBYTES, [OFFSET] + +I +Read some bytes from the scalar. +Returns the number of bytes actually read, 0 on end-of-file, undef on error. + +=cut + +sub read { + my $self = $_[0]; + my $n = $_[2]; + my $off = $_[3] || 0; + + my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n); + $n = length($read); + *$self->{Pos} += $n; + ($off ? substr($_[1], $off) : $_[1]) = $read; + return $n; +} + +#------------------------------ + +=item write BUF, NBYTES, [OFFSET] + +I +Write some bytes to the scalar. + +=cut + +sub write { + my $self = $_[0]; + my $n = $_[2]; + my $off = $_[3] || 0; + + my $data = substr($_[1], $off, $n); + $n = length($data); + $self->print($data); + return $n; +} + +#------------------------------ + +=item sysread BUF, LEN, [OFFSET] + +I +Read some bytes from the scalar. +Returns the number of bytes actually read, 0 on end-of-file, undef on error. + +=cut + +sub sysread { + my $self = shift; + $self->read(@_); +} + +#------------------------------ + +=item syswrite BUF, NBYTES, [OFFSET] + +I +Write some bytes to the scalar. + +=cut + +sub syswrite { + my $self = shift; + $self->write(@_); +} + +=back + +=cut + + +#============================== + +=head2 Seeking/telling and other attributes + +=over 4 + +=cut + + +#------------------------------ + +=item autoflush + +I +No-op, provided for OO compatibility. + +=cut + +sub autoflush {} + +#------------------------------ + +=item binmode + +I +No-op, provided for OO compatibility. + +=cut + +sub binmode {} + +#------------------------------ + +=item clearerr + +I Clear the error and EOF flags. A no-op. + +=cut + +sub clearerr { 1 } + +#------------------------------ + +=item eof + +I Are we at end of file? + +=cut + +sub eof { + my $self = shift; + (*$self->{Pos} >= length(${*$self->{SR}})); +} + +#------------------------------ + +=item seek OFFSET, WHENCE + +I Seek to a given position in the stream. + +=cut + +sub seek { + my ($self, $pos, $whence) = @_; + my $eofpos = length(${*$self->{SR}}); + + ### Seek: + if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET + elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR + elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END + else { croak "bad seek whence ($whence)" } + + ### Fixup: + if (*$self->{Pos} < 0) { *$self->{Pos} = 0 } + if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos } + return 1; +} + +#------------------------------ + +=item sysseek OFFSET, WHENCE + +I Identical to C, I + +=cut + +sub sysseek { + my $self = shift; + $self->seek (@_); +} + @@ Diff output truncated at 10000 characters. @@ From cjfields at dev.open-bio.org Thu Feb 18 17:33:28 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Thu, 18 Feb 2010 17:33:28 -0500 Subject: [Bioperl-guts-l] [16849] Bio-FeatureIO/trunk: init refactoring of FeatureIO, just a simple stream of Generics at the moment Message-ID: <201002182233.o1IMXSuL016301@dev.open-bio.org> Revision: 16849 Author: cjfields Date: 2010-02-18 17:33:27 -0500 (Thu, 18 Feb 2010) Log Message: ----------- init refactoring of FeatureIO, just a simple stream of Generics at the moment Modified Paths: -------------- Bio-FeatureIO/trunk/lib/Bio/FeatureIO/gff.pm Bio-FeatureIO/trunk/lib/Bio/FeatureIO.pm Added Paths: ----------- Bio-FeatureIO/trunk/t/FeatureIO.t Bio-FeatureIO/trunk/t/FeatureIO.x Bio-FeatureIO/trunk/t/gff.t Bio-FeatureIO/trunk/t/ptt.t Bio-FeatureIO/trunk/t/vecscreen.t Removed Paths: ------------- Bio-FeatureIO/trunk/t/FeatureIO.t Modified: Bio-FeatureIO/trunk/lib/Bio/FeatureIO/gff.pm =================================================================== --- Bio-FeatureIO/trunk/lib/Bio/FeatureIO/gff.pm 2010-02-18 22:28:07 UTC (rev 16848) +++ Bio-FeatureIO/trunk/lib/Bio/FeatureIO/gff.pm 2010-02-18 22:33:27 UTC (rev 16849) @@ -1,258 +1,207 @@ -=pod +package Bio::FeatureIO::gff; -=head1 NAME +use base qw(Bio::FeatureIO); -Bio::FeatureIO::gff - read/write GFF feature files +use Modern::Perl; +use URI::Escape; +use Bio::FeatureIO::Handler::GenericFeatureHandler; +use Scalar::Util qw(blessed); +use Data::Dumper; -=head1 SYNOPSIS +=head1 - my $feature; #get a Bio::SeqFeature::Annotated somehow - my $featureOut = Bio::FeatureIO->new( - -format => 'gff', - -version => 3, - -fh => \*STDOUT, - -validate_terms => 1, #boolean. validate ontology terms online? default 0 (false). - ); - $featureOut->write_feature($feature); +Need to come up with a controlled vocabulary for parceling out this data. This +should be in lines with a defined schema, such as Chado or BioSQL. Should +possibly refactor the SeqIO drivers similarly. -=head1 DESCRIPTION - - Currently implemented: - - version read? write? - ------------------------------ - GFF 1 N N - GFF 2 N N - GFF 2.5 (GTF) N Y - GFF 3 Y Y - -=head1 FEEDBACK - -=head2 Mailing Lists - -User feedback is an integral part of the evolution of this and other -Bioperl modules. Send your comments and suggestions preferably to -the Bioperl mailing list. Your participation is much appreciated. - - bioperl-l at bioperl.org - General discussion - http://bioperl.org/wiki/Mailing_list - About the mailing lists - -=head2 Support - -Please direct usage questions or support issues to the mailing list: - -I - -rather than to the module maintainer directly. Many experienced and -reponsive experts will be able look at the problem and quickly -address it. Please include a thorough description of the problem -with code and data examples if at all possible. - -=head2 Reporting Bugs - -Report bugs to the Bioperl bug tracking system to help us keep track -of the bugs and their resolution. Bug reports can be submitted via -the web: - - http://bugzilla.open-bio.org/ - -=head1 AUTHOR - - Allen Day, - -=head1 CONTRIBUTORS - - Steffen Grossmann, - Scott Cain, - Rob Edwards - -=head1 APPENDIX - -The rest of the documentation details each of the object methods. -Internal methods are usually preceded with a _ - =cut - -# Let the code begin... - -package Bio::FeatureIO::gff; -use strict; - -#these are alphabetical, keep them that way. -use Bio::Annotation::DBLink; -use Bio::Annotation::OntologyTerm; -use Bio::Annotation::SimpleValue; -use Bio::Annotation::Target; -use Bio::FeatureIO; -use Bio::Ontology::OntologyStore; -use Bio::OntologyIO; -use Bio::SeqFeature::Annotated; -use Bio::SeqIO; -use URI::Escape; - -use base qw(Bio::FeatureIO); - -use constant DEFAULT_VERSION => 3; -my $RESERVED_TAGS = "ID|Name|Alias|Parent|Target|Gap|Derives_from|Note|Dbxref|dbxref|Ontology_term|Index|CRUD"; - sub _initialize { - my($self,%arg) = @_; - - $self->SUPER::_initialize(%arg); - - $self->version( $arg{-version} || DEFAULT_VERSION); - $self->validate($arg{-validate_terms} || 0); - - if ($arg{-file} =~ /^>.*/ ) { - $self->_print("##gff-version " . $self->version() . "\n"); - } - else { - my $directive; - while(($directive = $self->_readline()) && ($directive =~ /^##/) ){ - $self->_handle_directive($directive); - } - $self->_pushback($directive); - } + my($self, @args) = @_; - #need to validate against SOFA, no SO - if ($self->validate) { - $self->so( - Bio::Ontology::OntologyStore->get_ontology('Sequence Ontology Feature Annotation') - ); - } + $self->SUPER::_initialize(@args); + + my ($handler) = $self->_rearrange([qw(HANDLER)] , @args); + $handler ||= Bio::FeatureIO::Handler::GenericFeatureHandler->new(-verbose => $self->verbose); + $self->_init_stream(); + $self->handler($handler); } -=head2 next_feature() - - Usage : my $feature = $featureio->next_feature(); - Function: reads a feature record from a GFF stream and returns it as an object. - Returns : a Bio::SeqFeature::Annotated object - Args : N/A - -=cut - +# raw feature stream; returned features are as-is, may be modified post-return sub next_feature { - my $self = shift; - my $gff_string; - - my($f) = $self->_buffer_feature(); - if($f){ - return $f; - } - - return if $self->fasta_mode(); - - # be graceful about empty lines or comments, and make sure we return undef - # if the input is consumed - while(($gff_string = $self->_readline()) && defined($gff_string)) { - next if $gff_string =~ /^\s*$/; #skip blank lines - next if $gff_string =~ /^\#[^#]/; #skip comments, but not directives - last; - } - - return unless $gff_string; - - # looks like we went into FASTA mode without a directive. - if($gff_string =~ /^>/){ - $self->_pushback($gff_string); - $self->fasta_mode(1); - return; - } - - # got a directive - elsif($gff_string =~ /^##/){ - $self->_handle_directive($gff_string); - # recurse down to the next line. this will bottom out on finding a real feature or EOF - return $self->next_feature(); - } - - # got a feature - else { - return $self->_handle_feature($gff_string); - } + my $self = shift; + DATASET: + while (my $ds = $self->next_dataset) { + # leave it to the handler to decide when a feature is returned + while (my $sf = $self->handler->data_handler($ds)) { + return $sf; + } + } } -=head2 next_feature_group +=head1 - Title : next_feature_group - Usage : @feature_group = $stream->next_feature_group - Function: Reads the next feature_group from $stream and returns it. +Data is passed as hash-refs, similar to a SAX-based data stream, but containing +chunks of related information. A version of this is implemented in Bio::SeqIO +plugins gbdriver, embldriver, and swissdriver. - Feature groups in GFF3 files are separated by '###' directives. The - features in a group might form a hierarchical structure. The - complete hierarchy of features is returned, i.e. the returned array - represents only the top-level features. Lower-level features can - be accessed using the 'get_SeqFeatures' method recursively. +The key issue is defining specifically how bits are bundled and passed along to +the data handler. the other key point is that the start and length of the +specific chunk of data passed in is also passed along, primarily if one wanted +to create lazy feature collections . - Example : # getting the complete hierarchy of features in a GFF3 file - my @toplevel_features; - while (my @fg = $stream->next_feature_group) { - push(@toplevel_features, @fg); - } - Returns : an array of Bio::SeqFeature::Annotated objects - Args : none - =cut -sub next_feature_group { - my $self = shift; +# lowest level parser, returns simple hash refs - my $feat; - my %seen_ids; - my @all_feats; - my @toplevel_feats; +sub next_dataset { + my $self = shift; + local $/ = "\n"; + my $dataset; + my $len = 0; + GFFLINE: + while (my $line = $self->_readline) { + $len += CORE::length($line); + given ($line) { + when (/^\s*$/) { next GFFLINE } # blank lines + when (/^(\#{1,2})\s*(\S+)\s*([^\n]+)?$/) { # comments and directives + if (length($1) == 1) { + chomp $line; + @{$dataset}{qw(MODE DATA)} = ('comment', {DATA => $line}); + } else { + $self->{mode} = 'directive'; + @{$dataset}{qw(MODE DATA)} = ('directive', $self->directive($2, $3)); + } + } + when (/^>/) { # sequence + chomp $line; + @{$dataset}{qw(MODE DATA)} = ('sequence', {'sequence-header' => $line}); + $self->{mode} = 'sequence'; + } + when (/(?:\t[^\t]+){8}/) { + chomp $line; + $self->{mode} = $dataset->{MODE} = 'feature'; + my %feat; + @feat{qw(region source type start end score strand phase attributes)} + = split("\t",$line,9); + $dataset->{DATA} = \%feat; + } + default { + if ($self->{mode} eq 'sequence') { + chomp $line; + @{$dataset}{qw(MODE DATA)} = ('sequence', {sequence => $line}); + } else { + # anything else should be sequence, but there should be some + # kind of directive to change the mode or a typical FASTA header + # should be found, if not, die + $self->throw("Unknown line: $line, parser was in mode ".$self->{mode}); + } + } + } + if ($dataset) { + @$dataset{qw(START LEN)} = ($self->{stream_start}, $len); + $self->{stream_start} += $len; + return $dataset; + } + return; + } +} - $self->{group_not_done} = 1; +sub directive { + my ($self, $directive, $rest) = @_; + $rest ||= ''; + my %data; + + # convert for the pre 5.10 crowd to a lookup table + given ($directive) { + when ('sequence-region') { + @data{qw(type id start end)} = ('sequence', split(/\s+/, $rest)); + } + when ('genome-build') { + @data{qw(type source buildname)} = ($directive, split(/\s+/, $rest)); + } + when ('#') { + $data{type} = 'resolve_references'; + } + when ('FASTA') { + $data{type} = 'sequence'; + } + default { + @data{qw(type data)} = ($directive, $rest); + } + } + \%data; +} - while ($self->{group_not_done} && ($feat = $self->next_feature()) && defined($feat)) { @@ Diff output truncated at 10000 characters. @@ From cjfields at dev.open-bio.org Thu Feb 18 17:37:21 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Thu, 18 Feb 2010 17:37:21 -0500 Subject: [Bioperl-guts-l] [16850] Bio-FeatureIO/trunk/lib/Bio/FeatureIO: add handler Message-ID: <201002182237.o1IMbLJK016335@dev.open-bio.org> Revision: 16850 Author: cjfields Date: 2010-02-18 17:37:20 -0500 (Thu, 18 Feb 2010) Log Message: ----------- add handler Added Paths: ----------- Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/ Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericFeatureHandler.pm Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericHandler.pm Added: Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericFeatureHandler.pm =================================================================== --- Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericFeatureHandler.pm (rev 0) +++ Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericFeatureHandler.pm 2010-02-18 22:37:20 UTC (rev 16850) @@ -0,0 +1,298 @@ +package Bio::FeatureIO::Handler::GenericFeatureHandler; + +use base qw(Bio::Root::Root Bio::HandlerBaseI); + +use strict; +use warnings; +use Data::Dumper; +use Bio::SeqFeature::Generic; + +my $ct = 0; +my %GFF3_RESERVED_TAGS = map {$_ => $ct++ } + qw(ID Name Alias Parent Target Gap + Derives_from Note Dbxref Ontology_term Index); + +my %HANDLERS = ( + #'directive' => \&directives, + #'sequence' => \&sequence, + #'resolve-references' => \&resolve_refs, + #'source-ontology' => \&source_ontology, + #'feature-ontology' => \&feature_ontology, + #'attribute-ontology' => \&attribute_ontology, + #'genome-build' => \&genome_build, + #'sequence-region' => \&sequence_region, + 'feature' => \&seqfeature +); + +sub new { + my ($class, @args) = @_; + my $self = $class->SUPER::new(@args); + $self = {@args}; + bless $self,$class; + $self->handler_methods(); + return $self; +} + +sub data_handler { + my ($self, $data) = @_; + my $nm = $data->{MODE} || $self->throw("No type tag defined!\n".Dumper($data)); + + # this should handle data on the fly w/o caching; any caching should be + # done in the driver! + my $method = (exists $self->{'handlers'}->{$nm}) ? ($self->{'handlers'}->{$nm}) : + (exists $self->{'handlers'}->{'_DEFAULT_'}) ? ($self->{'handlers'}->{'_DEFAULT_'}) : + undef; + # needs a can check, but $self->can isn't working here... + + if ($method) { + return $self->$method($data); + } else { + $self->debug("No handler defined for $nm\n"); + return; + } +} + +sub handler_methods { + my $self = shift; + if (!($self->{'handlers'})) { + $self->{'handlers'} = \%HANDLERS; + } + return ($self->{'handlers'}); +} + +sub format { shift->throw_not_implemented; } + +sub reset_parameters { shift->throw_not_implemented; } + +sub get_parameters { shift->throw_not_implemented; } + +sub set_parameters { shift->throw_not_implemented; } + +# employ a lightweight location factory, one that just generates segments +# use for GenBank/EMBL, other formats with complex locations + +sub location_factory { shift->throw_not_implemented; } + +sub mode { + my $self = shift; + return $self->{mode} = shift if @_; + return $self->{mode}; +} + +# this needs to be a Bio::SeqFeature::CollectionI that can distinguish +# between sequence regions; the simplest versions don't + +sub feature_collection { + my $self = shift; + return $self->{feature_collection} = shift if @_; + return $self->{feature_collection}; +} + +################ HANDLERS ################ + +sub seqfeature { + my ($self, $data) = @_; + my %sf_data = map {'-'.$_ => $data->{DATA}->{$_}} sort keys %{$data->{DATA}}; + if ($data->{DATA}->{attributes}) { + delete $sf_data{attributes}; + my %tags; + for my $kv (split(/\s*;\s*/, $data->{DATA}->{attributes})) { + my ($key, $rest) = split(/[=\s]/, $kv, 2); + # add optional URI unescaping here + my @vals = split(',',$rest); + $tags{$key} = \@vals; + } + $data->{tags} = \%tags; + } + return Bio::SeqFeature::Generic->new(%sf_data); +} + + + +1; + +__END__ + +=head1 NAME + +Bio::FeatureIO::Handler::GenericFeatureHandler.pm - + +=head1 VERSION + +This documentation refers to Bio::FeatureIO::Handler::GenericFeatureHandler.pm version +Bio::Root::Root. + +=head1 SYNOPSIS + + use Bio::FeatureIO::Handler::GenericFeatureHandler.pm; + # Brief but working code example(s) here showing the most common usage(s) + + # This section will be as far as many users bother reading, + + # so make it as educational and exemplary as possible. + +=head1 DESCRIPTION + + +A full description of the module and its features. +May include numerous subsections (i.e., =head2, =head3, etc.). + +=head1 SUBROUTINES/METHODS + + +A separate section listing the public components of the module's interface. +These normally consist of either subroutines that may be exported, or methods +that may be called on objects belonging to the classes that the module provides. +Name the section accordingly. + +In an object-oriented module, this section should begin with a sentence of the +form "An object of this class represents...", to give the reader a high-level +context to help them understand the methods that are subsequently described. + +=head1 DIAGNOSTICS + + +A list of every error and warning message that the module can generate +(even the ones that will "never happen"), with a full explanation of each +problem, one or more likely causes, and any suggested remedies. + +=head1 CONFIGURATION AND ENVIRONMENT + + +A full explanation of any configuration system(s) used by the module, +including the names and locations of any configuration files, and the +meaning of any environment variables or properties that can be set. These +descriptions must also include details of any configuration language used. + +=head1 DEPENDENCIES + + +A list of all the other modules that this module relies upon, including any +restrictions on versions, and an indication of whether these required modules are +part of the standard Perl distribution, part of the module's distribution, +or must be installed separately. + +=head1 INCOMPATIBILITIES + + +A list of any modules that this module cannot be used in conjunction with. +This may be due to name conflicts in the interface, or competition for +system or program resources, or due to internal limitations of Perl +(for example, many modules that use source code filters are mutually +incompatible). + +=head1 BUGS AND LIMITATIONS + +There are no known bugs in this module. + +User feedback is an integral part of the evolution of this and other Biome and +BioPerl modules. Send your comments and suggestions preferably to one of the +BioPerl mailing lists. Your participation is much appreciated. + + bioperl-l at bioperl.org - General discussion + http://bioperl.org/wiki/Mailing_lists - About the mailing lists + +Patches are always welcome. + +=head2 Support + +Please direct usage questions or support issues to the mailing list: + +L + +rather than to the module maintainer directly. Many experienced and reponsive +experts will be able look at the problem and quickly address it. Please include +a thorough description of the problem with code and data examples if at all +possible. + +=head2 Reporting Bugs + +Preferrably, Biome bug reports should be reported to the GitHub Issues bug +tracking system: + + http://github.com/cjfields/biome/issues + +Bugs can also be reported using the BioPerl bug tracking system, submitted via +the web: + + http://bugzilla.open-bio.org/ + +=head1 EXAMPLES + + +Many people learn better by example than by explanation, and most learn better +by a combination of the two. Providing a /demo directory stocked with +well-commented examples is an excellent idea, but your users might not have +access to the original distribution, and the demos are unlikely to have been +installed for them. Adding a few illustrative examples in the documentation +itself can greatly increase the "learnability" of your code. + +=head1 FREQUENTLY ASKED QUESTIONS + + +Incorporating a list of correct answers to common questions may seem like extra +work (especially when it comes to maintaining that list), but in many cases it +actually saves time. Frequently asked questions are frequently emailed +questions, and you already have too much email to deal with. If you find +yourself repeatedly answering the same question by email, in a newsgroup, on a +web site, or in person, answer that question in your documentation as well. Not +only is this likely to reduce the number of queries on that topic you +subsequently receive, it also means that anyone who does ask you directly can +simply be directed to read the fine manual. + +=head1 COMMON USAGE MISTAKES + + +This section is really "Frequently Unasked Questions". With just about any kind +of software, people inevitably misunderstand the same concepts and misuse the +same components. By drawing attention to these common errors, explaining the +misconceptions involved, and pointing out the correct alternatives, you can once +again pre-empt a large amount of unproductive correspondence. Perl itself +provides documentation of this kind, in the form of the perltrap manpage. + +=head1 SEE ALSO + + +Often there will be other modules and applications that are possible +alternatives to using your software. Or other documentation that would be of use +to the users of your software. Or a journal article or book that explains the +ideas on which the software is based. Listing those in a "See Also" section +allows people to understand your software better and to find the best solution +for their problem themselves, without asking you directly. + +By now you have no doubt detected the ulterior motive for providing more +extensive user manuals and written advice. User documentation is all about not +having to actually talk to users. + +=head1 (DISCLAIMER OF) WARRANTY + + +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. + +=head1 ACKNOWLEDGEMENTS + + +Acknowledging any help you received in developing and improving your software is +plain good manners. But expressing your appreciation isn't only courteous; it's +also enlightened self-interest. Inevitably people will send you bug reports for +your software. But what you'd much prefer them to send you are bug reports @@ Diff output truncated at 10000 characters. @@ From cjfields at dev.open-bio.org Thu Feb 18 17:37:57 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Thu, 18 Feb 2010 17:37:57 -0500 Subject: [Bioperl-guts-l] [16851] Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericHandler.pm: remove redundant handler Message-ID: <201002182237.o1IMbv42016409@dev.open-bio.org> Revision: 16851 Author: cjfields Date: 2010-02-18 17:37:57 -0500 (Thu, 18 Feb 2010) Log Message: ----------- remove redundant handler Removed Paths: ------------- Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericHandler.pm Deleted: Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericHandler.pm =================================================================== --- Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericHandler.pm 2010-02-18 22:37:20 UTC (rev 16850) +++ Bio-FeatureIO/trunk/lib/Bio/FeatureIO/Handler/GenericHandler.pm 2010-02-18 22:37:57 UTC (rev 16851) @@ -1,271 +0,0 @@ -package Bio::FeatureIO::Handler::GenericHandler; - -use base qw(Bio::Root::Root Bio::HandlerBaseI); - -use Modern::Perl; -use Data::Dumper; - -my $ct = 0; -my %GFF3_RESERVED_TAGS = map {$_ => $ct++ } - qw(ID Name Alias Parent Target Gap - Derives_from Note Dbxref Ontology_term Index); - -my %HANDLERS = ( - #'directive' => \&directives, - #'sequence' => \&sequence, - #'resolve-references' => \&resolve_refs, - #'source-ontology' => \&source_ontology, - #'feature-ontology' => \&feature_ontology, - #'attribute-ontology' => \&attribute_ontology, - #'genome-build' => \&genome_build, - #'sequence-region' => \&sequence_region, - 'feature' => \&seqfeature -); - -sub new { - my ($class, @args) = @_; - my $self = $class->SUPER::new(@args); - $self = {@args}; - bless $self,$class; - $self->handler_methods(); - return $self; -} - -sub data_handler { - my ($self, $data) = @_; - my $nm = $data->{MODE} || $self->throw("No type tag defined!\n".Dumper($data)); - - # this should handle data on the fly w/o caching; any caching should be - # done in the driver! - my $method = (exists $self->{'handlers'}->{$nm}) ? ($self->{'handlers'}->{$nm}) : - (exists $self->{'handlers'}->{'_DEFAULT_'}) ? ($self->{'handlers'}->{'_DEFAULT_'}) : - undef; - if ($method) { - return $self->$method($data); - } else { - $self->debug("No handler defined for $nm\n"); - } -} - -sub handler_methods { - my $self = shift; - if (!($self->{'handlers'})) { - $self->{'handlers'} = \%HANDLERS; - } - return ($self->{'handlers'}); -} - -sub format { shift->throw_not_implemented; } - -sub reset_parameters { shift->throw_not_implemented; } - -sub get_parameters { shift->throw_not_implemented; } - -sub set_parameters { shift->throw_not_implemented; } - -# employ a lightweight location factory, one that just generates segments -# use for GenBank/EMBL, other formats with complex locations - -sub location_factory { shift->throw_not_implemented; } - -sub mode { - my $self = shift; - return $self->{mode} = shift if @_; - return $self->{mode}; -} - -################ HANDLERS ################ - -sub seqfeature { - my ($self, $data) = @_; - #say Dumper $data; - return 1; -} - -1; - -__END__ - -=head1 NAME - -Bio::FeatureIO::Handler::GenericHandler.pm - - -=head1 VERSION - -This documentation refers to Bio::FeatureIO::Handler::GenericHandler.pm version -Bio::Root::Root. - -=head1 SYNOPSIS - - use Bio::FeatureIO::Handler::GenericHandler.pm; - # Brief but working code example(s) here showing the most common usage(s) - - # This section will be as far as many users bother reading, - - # so make it as educational and exemplary as possible. - -=head1 DESCRIPTION - - -A full description of the module and its features. -May include numerous subsections (i.e., =head2, =head3, etc.). - -=head1 SUBROUTINES/METHODS - - -A separate section listing the public components of the module's interface. -These normally consist of either subroutines that may be exported, or methods -that may be called on objects belonging to the classes that the module provides. -Name the section accordingly. - -In an object-oriented module, this section should begin with a sentence of the -form "An object of this class represents...", to give the reader a high-level -context to help them understand the methods that are subsequently described. - -=head1 DIAGNOSTICS - - -A list of every error and warning message that the module can generate -(even the ones that will "never happen"), with a full explanation of each -problem, one or more likely causes, and any suggested remedies. - -=head1 CONFIGURATION AND ENVIRONMENT - - -A full explanation of any configuration system(s) used by the module, -including the names and locations of any configuration files, and the -meaning of any environment variables or properties that can be set. These -descriptions must also include details of any configuration language used. - -=head1 DEPENDENCIES - - -A list of all the other modules that this module relies upon, including any -restrictions on versions, and an indication of whether these required modules are -part of the standard Perl distribution, part of the module's distribution, -or must be installed separately. - -=head1 INCOMPATIBILITIES - - -A list of any modules that this module cannot be used in conjunction with. -This may be due to name conflicts in the interface, or competition for -system or program resources, or due to internal limitations of Perl -(for example, many modules that use source code filters are mutually -incompatible). - -=head1 BUGS AND LIMITATIONS - -There are no known bugs in this module. - -User feedback is an integral part of the evolution of this and other Biome and -BioPerl modules. Send your comments and suggestions preferably to one of the -BioPerl mailing lists. Your participation is much appreciated. - - bioperl-l at bioperl.org - General discussion - http://bioperl.org/wiki/Mailing_lists - About the mailing lists - -Patches are always welcome. - -=head2 Support - -Please direct usage questions or support issues to the mailing list: - -L - -rather than to the module maintainer directly. Many experienced and reponsive -experts will be able look at the problem and quickly address it. Please include -a thorough description of the problem with code and data examples if at all -possible. - -=head2 Reporting Bugs - -Preferrably, Biome bug reports should be reported to the GitHub Issues bug -tracking system: - - http://github.com/cjfields/biome/issues - -Bugs can also be reported using the BioPerl bug tracking system, submitted via -the web: - - http://bugzilla.open-bio.org/ - -=head1 EXAMPLES - - -Many people learn better by example than by explanation, and most learn better -by a combination of the two. Providing a /demo directory stocked with -well-commented examples is an excellent idea, but your users might not have -access to the original distribution, and the demos are unlikely to have been -installed for them. Adding a few illustrative examples in the documentation -itself can greatly increase the "learnability" of your code. - -=head1 FREQUENTLY ASKED QUESTIONS - - -Incorporating a list of correct answers to common questions may seem like extra -work (especially when it comes to maintaining that list), but in many cases it -actually saves time. Frequently asked questions are frequently emailed -questions, and you already have too much email to deal with. If you find -yourself repeatedly answering the same question by email, in a newsgroup, on a -web site, or in person, answer that question in your documentation as well. Not -only is this likely to reduce the number of queries on that topic you -subsequently receive, it also means that anyone who does ask you directly can -simply be directed to read the fine manual. - -=head1 COMMON USAGE MISTAKES - - -This section is really "Frequently Unasked Questions". With just about any kind -of software, people inevitably misunderstand the same concepts and misuse the -same components. By drawing attention to these common errors, explaining the -misconceptions involved, and pointing out the correct alternatives, you can once -again pre-empt a large amount of unproductive correspondence. Perl itself -provides documentation of this kind, in the form of the perltrap manpage. - -=head1 SEE ALSO - - -Often there will be other modules and applications that are possible -alternatives to using your software. Or other documentation that would be of use -to the users of your software. Or a journal article or book that explains the -ideas on which the software is based. Listing those in a "See Also" section -allows people to understand your software better and to find the best solution -for their problem themselves, without asking you directly. - -By now you have no doubt detected the ulterior motive for providing more -extensive user manuals and written advice. User documentation is all about not -having to actually talk to users. - -=head1 (DISCLAIMER OF) WARRANTY - - -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. - -=head1 ACKNOWLEDGEMENTS - - -Acknowledging any help you received in developing and improving your software is -plain good manners. But expressing your appreciation isn't only courteous; it's -also enlightened self-interest. Inevitably people will send you bug reports for -your software. But what you'd much prefer them to send you are bug reports -accompanied by working bug fixes. Publicly thanking those who have already done -that in the past is a great way to remind people that patches are always -welcome. - -=head1 AUTHOR - -Chris Fields (cjfields at bioperl dot org) - -=head1 LICENCE AND COPYRIGHT - -Copyright (c) 2010 Chris Fields (cjfields at bioperl dot org). All rights reserved. - -followed by whatever licence you wish to release it under. -For Perl code that is often just: - -This module is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. See L. From cjfields at dev.open-bio.org Fri Feb 19 00:27:43 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 00:27:43 -0500 Subject: [Bioperl-guts-l] [16852] bioperl-live/trunk/README: test Message-ID: <201002190527.o1J5Rh9w023334@dev.open-bio.org> Revision: 16852 Author: cjfields Date: 2010-02-19 00:27:43 -0500 (Fri, 19 Feb 2010) Log Message: ----------- test Modified Paths: -------------- bioperl-live/trunk/README Modified: bioperl-live/trunk/README =================================================================== --- bioperl-live/trunk/README 2010-02-18 22:37:57 UTC (rev 16851) +++ bioperl-live/trunk/README 2010-02-19 05:27:43 UTC (rev 16852) @@ -7,7 +7,7 @@ This is bioperl-live, from BioPerl Subversion HEAD o Getting Started - + Thanks for downloading this distribution! Please see the the INSTALL or INSTALL.WIN documents for installation From David.Messina at sbc.su.se Fri Feb 19 09:54:27 2010 From: David.Messina at sbc.su.se (Dave Messina) Date: Fri, 19 Feb 2010 15:54:27 +0100 Subject: [Bioperl-guts-l] bioperl 1.6.1 not on doc.bioperl.org Message-ID: <3C49EED6-9293-4693-8D5F-7969AB66E306@sbc.su.se> Hi, AFAICT the current release of bioperl (core) 1.6.1 isn't linked on: http://doc.bioperl.org/ When a spare moment arises, could a web admin please add it? Thanks, Dave From cjfields at dev.open-bio.org Fri Feb 19 12:21:11 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 12:21:11 -0500 Subject: [Bioperl-guts-l] [16853] bioperl-live/trunk/Bio/DB/GFF/Adaptor/dbi.pm: silence warning Message-ID: <201002191721.o1JHLBdX011521@dev.open-bio.org> Revision: 16853 Author: cjfields Date: 2010-02-19 12:21:11 -0500 (Fri, 19 Feb 2010) Log Message: ----------- silence warning Modified Paths: -------------- bioperl-live/trunk/Bio/DB/GFF/Adaptor/dbi.pm Modified: bioperl-live/trunk/Bio/DB/GFF/Adaptor/dbi.pm =================================================================== --- bioperl-live/trunk/Bio/DB/GFF/Adaptor/dbi.pm 2010-02-19 05:27:43 UTC (rev 16852) +++ bioperl-live/trunk/Bio/DB/GFF/Adaptor/dbi.pm 2010-02-19 17:21:11 UTC (rev 16853) @@ -1967,7 +1967,7 @@ sub bin_query { my $self = shift; my ($start,$stop,$minbin,$maxbin) = @_; - if ($start < 0 && $stop > 0) { # split the queries + if ($start && $start < 0 && $stop > 0) { # split the queries my ($lower_query, at lower_args) = $self->_bin_query($start,0,$minbin,$maxbin); my ($upper_query, at upper_args) = $self->_bin_query(0,$stop,$minbin,$maxbin); my $query = "$lower_query\n\t OR $upper_query"; From cjfields at dev.open-bio.org Fri Feb 19 12:22:44 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 12:22:44 -0500 Subject: [Bioperl-guts-l] [16854] bioperl-live/trunk/Bio: silence warning (uninit value) Message-ID: <201002191722.o1JHMiol011555@dev.open-bio.org> Revision: 16854 Author: cjfields Date: 2010-02-19 12:22:44 -0500 (Fri, 19 Feb 2010) Log Message: ----------- silence warning (uninit value) Modified Paths: -------------- bioperl-live/trunk/Bio/FeatureIO/gff.pm bioperl-live/trunk/Bio/SearchIO/blast_pull.pm Modified: bioperl-live/trunk/Bio/FeatureIO/gff.pm =================================================================== --- bioperl-live/trunk/Bio/FeatureIO/gff.pm 2010-02-19 17:21:11 UTC (rev 16853) +++ bioperl-live/trunk/Bio/FeatureIO/gff.pm 2010-02-19 17:22:44 UTC (rev 16854) @@ -308,7 +308,7 @@ $self->{'fasta_mode'} = $val if defined($val); - if ($val == 1) { + if ($val && $val == 1) { # seek $self->_fh(), -1, 1; #rewind 1 byte to get the previous line's \n $self->_pushback("\n"); } Modified: bioperl-live/trunk/Bio/SearchIO/blast_pull.pm =================================================================== --- bioperl-live/trunk/Bio/SearchIO/blast_pull.pm 2010-02-19 17:21:11 UTC (rev 16853) +++ bioperl-live/trunk/Bio/SearchIO/blast_pull.pm 2010-02-19 17:22:44 UTC (rev 16854) @@ -103,6 +103,7 @@ -score => integer or scientific notation number to be used as a score value cutoff for hits -piped_behaviour => 'temp_file'|'memory'|'sequential_read' + -noclose => Boolean, passed onto Bio::Root::IO::noclose -piped_behaviour defines what the parser should do if the input is an unseekable filehandle (eg. piped input), see @@ -115,12 +116,14 @@ # don't do normal SearchIO initialization - my ($writer, $file, $fh, $piped_behaviour, $evalue, $score) = + my ($writer, $file, $fh, $noclose, $piped_behaviour, $evalue, $score) = $self->_rearrange([qw(WRITER - FILE FH + FILE FH NOCLOSE PIPED_BEHAVIOUR EVALUE SCORE)], @args); + + $noclose && $self->noclose($noclose); $self->writer($writer) if $writer; $self->_fields( { ( header => undef, From cjfields at dev.open-bio.org Fri Feb 19 12:28:58 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 12:28:58 -0500 Subject: [Bioperl-guts-l] [16855] bioperl-live/trunk/Bio/SearchIO/blast_pull.pm: rollback accidental blast_pull commit Message-ID: <201002191728.o1JHSwe1011809@dev.open-bio.org> Revision: 16855 Author: cjfields Date: 2010-02-19 12:28:58 -0500 (Fri, 19 Feb 2010) Log Message: ----------- rollback accidental blast_pull commit Modified Paths: -------------- bioperl-live/trunk/Bio/SearchIO/blast_pull.pm Modified: bioperl-live/trunk/Bio/SearchIO/blast_pull.pm =================================================================== --- bioperl-live/trunk/Bio/SearchIO/blast_pull.pm 2010-02-19 17:22:44 UTC (rev 16854) +++ bioperl-live/trunk/Bio/SearchIO/blast_pull.pm 2010-02-19 17:28:58 UTC (rev 16855) @@ -103,7 +103,6 @@ -score => integer or scientific notation number to be used as a score value cutoff for hits -piped_behaviour => 'temp_file'|'memory'|'sequential_read' - -noclose => Boolean, passed onto Bio::Root::IO::noclose -piped_behaviour defines what the parser should do if the input is an unseekable filehandle (eg. piped input), see @@ -116,14 +115,12 @@ # don't do normal SearchIO initialization - my ($writer, $file, $fh, $noclose, $piped_behaviour, $evalue, $score) = + my ($writer, $file, $fh, $piped_behaviour, $evalue, $score) = $self->_rearrange([qw(WRITER - FILE FH NOCLOSE + FILE FH PIPED_BEHAVIOUR EVALUE SCORE)], @args); - - $noclose && $self->noclose($noclose); $self->writer($writer) if $writer; $self->_fields( { ( header => undef, From cjfields at dev.open-bio.org Fri Feb 19 12:36:14 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 12:36:14 -0500 Subject: [Bioperl-guts-l] [16856] bioperl-live/trunk/t/RemoteDB/Query/GenBank.t: test count changed ( volatile remote data) Message-ID: <201002191736.o1JHaEvY012202@dev.open-bio.org> Revision: 16856 Author: cjfields Date: 2010-02-19 12:36:14 -0500 (Fri, 19 Feb 2010) Log Message: ----------- test count changed (volatile remote data) Modified Paths: -------------- bioperl-live/trunk/t/RemoteDB/Query/GenBank.t Modified: bioperl-live/trunk/t/RemoteDB/Query/GenBank.t =================================================================== --- bioperl-live/trunk/t/RemoteDB/Query/GenBank.t 2010-02-19 17:28:58 UTC (rev 16855) +++ bioperl-live/trunk/t/RemoteDB/Query/GenBank.t 2010-02-19 17:36:14 UTC (rev 16856) @@ -7,7 +7,7 @@ use lib '.'; use Bio::Root::Test; - test_begin(-tests => 21, + test_begin(-tests => 18, -requires_modules => [qw(IO::String LWP::UserAgent HTTP::Request::Common)], @@ -50,7 +50,7 @@ $done++; } skip('No seqs returned', 5) if !$done; - is $done, 4; + is $done, 1; } $seq = $seqio = undef; From mauricio at open-bio.org Fri Feb 19 13:10:49 2010 From: mauricio at open-bio.org (Mauricio Herrera Cuadra) Date: Fri, 19 Feb 2010 12:10:49 -0600 Subject: [Bioperl-guts-l] bioperl 1.6.1 not on doc.bioperl.org In-Reply-To: <3C49EED6-9293-4693-8D5F-7969AB66E306@sbc.su.se> References: <3C49EED6-9293-4693-8D5F-7969AB66E306@sbc.su.se> Message-ID: <4B7ED429.1020409@open-bio.org> Added. Thanks for the reminder, Dave :) On 2/19/10 8:54 AM, Dave Messina wrote: > Hi, > > AFAICT the current release of bioperl (core) 1.6.1 isn't linked on: > http://doc.bioperl.org/ > > When a spare moment arises, could a web admin please add it? > > > Thanks, > Dave > > _______________________________________________ > Bioperl-guts-l mailing list > Bioperl-guts-l at lists.open-bio.org > http://lists.open-bio.org/mailman/listinfo/bioperl-guts-l > From David.Messina at sbc.su.se Fri Feb 19 13:34:34 2010 From: David.Messina at sbc.su.se (Dave Messina) Date: Fri, 19 Feb 2010 19:34:34 +0100 Subject: [Bioperl-guts-l] bioperl 1.6.1 not on doc.bioperl.org In-Reply-To: <4B7ED429.1020409@open-bio.org> References: <3C49EED6-9293-4693-8D5F-7969AB66E306@sbc.su.se> <4B7ED429.1020409@open-bio.org> Message-ID: <36884138-AFFD-4224-9543-FDAC279447B8@sbc.su.se> Thanks, Mauricio! D From cjfields at dev.open-bio.org Fri Feb 19 14:33:29 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 14:33:29 -0500 Subject: [Bioperl-guts-l] [16857] bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm: silence warnings about using next w/o a loop Message-ID: <201002191933.o1JJXTAp016052@dev.open-bio.org> Revision: 16857 Author: cjfields Date: 2010-02-19 14:33:29 -0500 (Fri, 19 Feb 2010) Log Message: ----------- silence warnings about using next w/o a loop Modified Paths: -------------- bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm Modified: bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm =================================================================== --- bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm 2010-02-19 17:36:14 UTC (rev 16856) +++ bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm 2010-02-19 19:33:29 UTC (rev 16857) @@ -1175,9 +1175,7 @@ # Update spectrum my $size = scalar @contig_seqs; - if ($size == 0) { - next; - } elsif ($size == 1) { + if ($size == 1) { $$asm_spectrum{1}++; } elsif ($size > 1) { # Reassemble good sequences @@ -1188,9 +1186,7 @@ for my $qsize (keys %$contig_spectrum) { $$asm_spectrum{$qsize} += $$contig_spectrum{$qsize}; } - } else { - $self->throw("The size is not valid... how could that happen?"); - } + } return $asm_spectrum, $good_seqs; } @@ -1707,11 +1703,7 @@ # Process overlaps my $nof_pairs = scalar keys %overlaps; - if ($nof_pairs == 0) { - # No overlaps - next; # process next contig - - } elsif ($nof_pairs == 1) { + if ($nof_pairs == 1) { # A unique overlap my $i = (keys %overlaps)[0]; my $j = (keys %{$overlaps{$i}})[0]; @@ -1720,7 +1712,7 @@ my @overlap_stats = ($length, $identity); @contig_stats = $self->_update_overlap_stats(@contig_stats, @overlap_stats); - } else { + } elsif ($nof_pairs > 1) { # At least 2 overlaps. Find the set of overlaps that goes through all the # reads of the contig and maximizes the total overlap score. Use the graph # theory minimum spanning tree (MST) method to solve this problem. From cjfields at dev.open-bio.org Fri Feb 19 14:55:38 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 14:55:38 -0500 Subject: [Bioperl-guts-l] [16858] bioperl-live/trunk/Bio/SeqIO: defaults to Bio::Seq, so unnecessary Message-ID: <201002191955.o1JJtc28016555@dev.open-bio.org> Revision: 16858 Author: cjfields Date: 2010-02-19 14:55:38 -0500 (Fri, 19 Feb 2010) Log Message: ----------- defaults to Bio::Seq, so unnecessary Modified Paths: -------------- bioperl-live/trunk/Bio/SeqIO/fasta.pm bioperl-live/trunk/Bio/SeqIO/metafasta.pm bioperl-live/trunk/Bio/SeqIO/tinyseq.pm Modified: bioperl-live/trunk/Bio/SeqIO/fasta.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/fasta.pm 2010-02-19 19:33:29 UTC (rev 16857) +++ bioperl-live/trunk/Bio/SeqIO/fasta.pm 2010-02-19 19:55:38 UTC (rev 16858) @@ -95,7 +95,7 @@ my ($width) = $self->_rearrange([qw(WIDTH)], @args); $width && $self->width($width); unless ( defined $self->sequence_factory ) { - $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq')); + $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new()); } } Modified: bioperl-live/trunk/Bio/SeqIO/metafasta.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/metafasta.pm 2010-02-19 19:33:29 UTC (rev 16857) +++ bioperl-live/trunk/Bio/SeqIO/metafasta.pm 2010-02-19 19:55:38 UTC (rev 16858) @@ -111,7 +111,7 @@ my ($width) = $self->_rearrange([qw(WIDTH)], @args); $width && $self->width($width); unless ( defined $self->sequence_factory ) { - $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq')); + $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new()); } } Modified: bioperl-live/trunk/Bio/SeqIO/tinyseq.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/tinyseq.pm 2010-02-19 19:33:29 UTC (rev 16857) +++ bioperl-live/trunk/Bio/SeqIO/tinyseq.pm 2010-02-19 19:55:38 UTC (rev 16858) @@ -98,7 +98,7 @@ $self->SUPER::_initialize(@args); unless (defined $self->sequence_factory) { - $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq')); + $self->sequence_factory(Bio::Seq::SeqFastaSpeedFactory->new()); } $self->{'_species_objects'} = {}; From cjfields at dev.open-bio.org Fri Feb 19 16:05:26 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 16:05:26 -0500 Subject: [Bioperl-guts-l] [16859] bioperl-live/trunk/Bio: really rollback florent's commit, was some cruft hanging around causing fasta to break Message-ID: <201002192105.o1JL5QXq019286@dev.open-bio.org> Revision: 16859 Author: cjfields Date: 2010-02-19 16:05:26 -0500 (Fri, 19 Feb 2010) Log Message: ----------- really rollback florent's commit, was some cruft hanging around causing fasta to break Modified Paths: -------------- bioperl-live/trunk/Bio/Seq/SeqFactory.pm bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm bioperl-live/trunk/Bio/SeqIO/metafasta.pm bioperl-live/trunk/Bio/SeqIO/tinyseq.pm bioperl-live/trunk/Bio/SeqIO.pm Modified: bioperl-live/trunk/Bio/Seq/SeqFactory.pm =================================================================== --- bioperl-live/trunk/Bio/Seq/SeqFactory.pm 2010-02-19 19:55:38 UTC (rev 16858) +++ bioperl-live/trunk/Bio/Seq/SeqFactory.pm 2010-02-19 21:05:26 UTC (rev 16859) @@ -25,8 +25,10 @@ # If you want the factory to create Bio::Seq objects instead # of the default Bio::PrimarySeq objects, use the -type parameter: + my $factory = Bio::Seq::SeqFactory->new(-type => 'Bio::Seq'); + =head1 DESCRIPTION This object will build L and L objects @@ -80,10 +82,9 @@ package Bio::Seq::SeqFactory; use strict; + use base qw(Bio::Root::Root Bio::Factory::SequenceFactoryI); -our $default_type = 'Bio::Seq'; - =head2 new Title : new @@ -91,7 +92,7 @@ Function: Builds a new Bio::Seq::SeqFactory object Returns : Bio::Seq::SeqFactory Args : -type => string, name of a PrimarySeqI derived class - This is optional. Default=Bio::Seq + This is optional. Default=Bio::PrimarySeq. =cut @@ -99,6 +100,9 @@ my($class, at args) = @_; my $self = $class->SUPER::new(@args); my ($type) = $self->_rearrange([qw(TYPE)], @args); + if( ! defined $type ) { + $type = 'Bio::PrimarySeq'; + } $self->type($type); return $self; } @@ -111,7 +115,7 @@ Function: Instantiates new Bio::SeqI (or one of its child classes) This object allows us to genericize the instantiation of sequence objects. - Returns : Bio::Seq object (default) + Returns : Bio::PrimarySeq object (default) The return type is configurable using new(-type =>"..."). Args : initialization parameters specific to the type of sequence object we want. Typically @@ -133,26 +137,21 @@ Returns : value of type Args : newvalue (optional) + =cut -sub type { +sub type{ my ($self,$value) = @_; if( defined $value) { - # Set the sequence type eval "require $value"; - if( $@ ) { $self->throw("$@: Unrecognized sequence type for SeqFactory '$value'");} + if( $@ ) { $self->throw("$@: Unrecognized Sequence type for SeqFactory '$value'");} + my $a = bless {},$value; unless( $a->isa('Bio::PrimarySeqI') || $a->isa('Bio::Seq::QualI') ) { $self->throw("Must provide a valid Bio::PrimarySeqI or Bio::Seq::QualI or child class to SeqFactory Not $value"); } $self->{'type'} = $value; - } else { - # Get the sequence type - if (not defined $self->{'type'}) { - # Set the sequence type if not specified - $self->{'type'} = $default_type; - } } return $self->{'type'}; } Modified: bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm =================================================================== --- bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm 2010-02-19 19:55:38 UTC (rev 16858) +++ bioperl-live/trunk/Bio/Seq/SeqFastaSpeedFactory.pm 2010-02-19 21:05:26 UTC (rev 16859) @@ -14,7 +14,7 @@ =head1 NAME -Bio::Seq::SeqFastaSpeedFactory - Rapid instantiation of new Bio::SeqI objects through a factory using FASTA files. +Bio::Seq::SeqFastaSpeedFactory - Instantiates a new Bio::PrimarySeqI (or derived class) through a factory =head1 SYNOPSIS @@ -23,14 +23,15 @@ my $seq = $factory->create(-seq => 'WYRAVLC', -id => 'name'); - # If you want the factory to create Bio::PrimarySeq objects instead - # of the default Bio::Seq objects, use the -type parameter: - my $factory = Bio::Seq::SeqFactory->new(-type => 'Bio::PrimarySeq'); + # If you want the factory to create Bio::Seq objects instead + # of the default Bio::PrimarySeq objects, use the -type parameter: + my $factory = Bio::Seq::SeqFastaSpeedFactory->new(-type => 'Bio::Seq'); + + =head1 DESCRIPTION -This factory is quick at building simple L and L -objects generically derived from FASTA files (no annotations). +This object will build Bio::Seq objects generically. =head1 FEEDBACK @@ -83,10 +84,8 @@ use Bio::Seq; use Bio::PrimarySeq; -use base qw(Bio::Root::Root Bio::Seq::SeqFactory); -# a Bio::Seq::SeqFactory is also a Bio::Factory::SequenceFactoryI +use base qw(Bio::Root::Root Bio::Factory::SequenceFactoryI); - =head2 new Title : new @@ -94,15 +93,13 @@ Function: Builds a new Bio::Seq::SeqFastaSpeedFactory object Returns : Bio::Seq::SeqFastaSpeedFactory Args : -type => string, name of a PrimarySeqI derived class - This is optional. Default=Bio::Seq. + This is optional. Default=Bio::PrimarySeq. =cut sub new { my($class, at args) = @_; my $self = $class->SUPER::new(@args); - my ($type) = $self->_rearrange([qw(TYPE)], @args); - $self->type($type); return $self; } @@ -111,11 +108,10 @@ Title : create Usage : my $seq = $seqbuilder->create(-seq => 'CAGT', -id => 'name'); - Function: Instantiates new Bio::SeqI (or one of its child classes) - This object allows us to genericize the instantiation of sequence - objects. - Returns : Bio::Seq object (default) - The return type is configurable using new(-type =>"..."). + Function: Instantiates a new Bio::Seq object, correctly built but very + fast, knowing stuff about Bio::PrimarySeq and Bio::Seq + Returns : Bio::Seq + Args : initialization parameters specific to the type of sequence object we want. Typically -seq => $str, @@ -123,7 +119,6 @@ =cut -# Overloading the 'create' method of Bio::Seq::SeqFactory sub create { my ($self, at args) = @_; @@ -135,50 +130,21 @@ my $id = defined $param{'-id'} ? $param{'-id'} : $param{'-primary_id'}; my $alphabet = $param{'-alphabet'}; - # Constructing Bio::PrimarySeq object - my $t_pseq = bless {}, 'Bio::PrimarySeq'; + my $seq = bless {}, "Bio::Seq"; + my $t_pseq = $seq->{'primary_seq'} = bless {}, "Bio::PrimarySeq"; $t_pseq->{'seq'} = $sequence; $t_pseq->{'desc'} = $fulldesc; $t_pseq->{'display_id'} = $id; + $t_pseq->{'primary_id'} = $id; + $seq->{'primary_id'} = $id; # currently Bio::Seq does not delegate this if( $sequence and !$alphabet ) { $t_pseq->_guess_alphabet(); } elsif ( $sequence and $alphabet ) { $t_pseq->{'alphabet'} = $alphabet; } - - my $seq; - my $type = $self->type; - if ($type eq 'Bio::Seq') { - # Constructing Bio::Seq object - $seq = bless {}, 'Bio::Seq'; - $seq->{'primary_seq'} = $t_pseq; - } elsif ($type eq 'Bio::PrimarySeq') { - # Nothing more to do for a Bio::PrimarySeq - $seq = $t_pseq; - } else { - # Should not have any other sequence type - $self->warn("Expected sequence type Bio::Seq or Bio::PrimarySeq. Got ". - "$type. Defaulting to Bio::PrimarySeq\n"); - $self->type('Bio::PrimarySeq'); - $seq = $t_pseq; - } return $seq; } - -=head2 type - - Title : type - Usage : $obj->type($newval) - Function: - Returns : value of type - Args : newvalue (optional) - -=cut - -# Using the 'type' method from Bio::Seq::SeqFactory - - 1; Modified: bioperl-live/trunk/Bio/SeqIO/metafasta.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/metafasta.pm 2010-02-19 19:55:38 UTC (rev 16858) +++ bioperl-live/trunk/Bio/SeqIO/metafasta.pm 2010-02-19 21:05:26 UTC (rev 16859) @@ -176,6 +176,7 @@ -alphabet => $alphabet, -direct => 1, ); + $seq = $seq->primary_seq; bless $seq, 'Bio::Seq::Meta'; Modified: bioperl-live/trunk/Bio/SeqIO/tinyseq.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/tinyseq.pm 2010-02-19 19:55:38 UTC (rev 16858) +++ bioperl-live/trunk/Bio/SeqIO/tinyseq.pm 2010-02-19 21:05:26 UTC (rev 16859) @@ -28,7 +28,7 @@ This object reads and writes Bio::Seq objects to and from TinySeq XML format. A TinySeq is a lightweight XML file of sequence information, -analogous to FASTA format. +analgous to FASTA format. See L for the DTD. Modified: bioperl-live/trunk/Bio/SeqIO.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO.pm 2010-02-19 19:55:38 UTC (rev 16858) +++ bioperl-live/trunk/Bio/SeqIO.pm 2010-02-19 21:05:26 UTC (rev 16859) @@ -443,15 +443,11 @@ my ($seqfact,$locfact,$objbuilder, $alphabet) = $self->_rearrange([qw(SEQFACTORY - LOCFACTORY - OBJBUILDER - ALPHABET) - ], @args); + LOCFACTORY + OBJBUILDER + ALPHABET) + ], @args); - # Florent 2010-02-16: It would probably be better to make the name of - # the attributes SEQFACTORY, LOCFACTORY, OBJBUILDER match the method - # names sequence_factory, location_factory and object_builder - $locfact = Bio::Factory::FTLocationFactory->new(-verbose => $self->verbose) if ! $locfact; $objbuilder = Bio::Seq::SeqBuilder->new(-verbose => $self->verbose) From cjfields at dev.open-bio.org Fri Feb 19 16:05:34 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 16:05:34 -0500 Subject: [Bioperl-guts-l] [16860] bioperl-live/trunk/t/SeqIO: really rollback florent's commit, was some cruft hanging around causing fasta to break Message-ID: <201002192105.o1JL5Y3p019320@dev.open-bio.org> Revision: 16860 Author: cjfields Date: 2010-02-19 16:05:34 -0500 (Fri, 19 Feb 2010) Log Message: ----------- really rollback florent's commit, was some cruft hanging around causing fasta to break Modified Paths: -------------- bioperl-live/trunk/t/SeqIO/fasta.t bioperl-live/trunk/t/SeqIO/metafasta.t Modified: bioperl-live/trunk/t/SeqIO/fasta.t =================================================================== --- bioperl-live/trunk/t/SeqIO/fasta.t 2010-02-19 21:05:26 UTC (rev 16859) +++ bioperl-live/trunk/t/SeqIO/fasta.t 2010-02-19 21:05:34 UTC (rev 16860) @@ -43,12 +43,12 @@ 'QQNYGGGPQRGGGNFNNNRMQPYQGGGGFKAGGGNQGN' . 'YGNNQGFNNGGNNRRY', 'length' => '358', - 'id' => 'roa1_drome', + 'primary_id' => 'roa1_drome', 'description' => qr(Rea guano receptor type III), ); is ($seq_obj->seq(), $expected{'seq'}, 'sequence'); is ($seq_obj->length(), $expected{'length'}, 'length'); -is ($seq_obj->id(), $expected{'id'}, 'id'); +is ($seq_obj->primary_id(), $expected{'primary_id'}, 'primary_id'); like ($seq_obj->description(), $expected{'description'}, 'description'); @@ -66,12 +66,12 @@ 'QQNYGGGPQRGGGNFNNNRMQPYQGGGGFKAGGGNQGN' . 'YGNNQGFNNGGNNRRY', 'length' => '358', - 'id' => 'roa2_drome', + 'primary_id' => 'roa2_drome', 'description' => qr(Rea guano ligand), ); is ($seq_obj2->seq(), $expected2{'seq'}, 'sequence'); is ($seq_obj2->length(), $expected2{'length'}, 'length'); -is ($seq_obj2->id(), $expected2{'id'}, 'id'); +is ($seq_obj2->primary_id(), $expected2{'primary_id'}, 'primary_id'); like ($seq_obj2->description(), $expected2{'description'}, 'description'); # from testformats.pl Modified: bioperl-live/trunk/t/SeqIO/metafasta.t =================================================================== --- bioperl-live/trunk/t/SeqIO/metafasta.t 2010-02-19 21:05:26 UTC (rev 16859) +++ bioperl-live/trunk/t/SeqIO/metafasta.t 2010-02-19 21:05:34 UTC (rev 16860) @@ -1,4 +1,30 @@ -# -*-Perl-*- Test Harness script for Bioperl + + + view: /bioperl/bioperl-live/trunk/t/SeqIO/metafasta.t (Rev: 15112, via SVN::Web) + +
+
+ +
+
+
+ +
+
+ +
+ + + + +
Revision 15112 (by sendu, 2008/12/08 18:12:38)BioperlTest -> Bio::Root::Test
+ +
# -*-Perl-*- Test Harness script for Bioperl
 # $Id$
 
 use strict;
@@ -7,21 +33,27 @@
 	use lib '.';
     use Bio::Root::Test;
     
-    test_begin(-tests => 8);
+    test_begin(-tests => 6);
 	
 	use_ok('Bio::SeqIO::metafasta');
 }
 
 my $verbose = test_debug();
 
-my $io = Bio::SeqIO->new(-format => 'metafasta',
-								 -verbose => $verbose,
-								 -file => test_input_file('test.metafasta'));
+my $io = Bio::SeqIO->new(-format => 'metafasta',
+								 -verbose => $verbose,
+								 -file => test_input_file('test.metafasta'));
 
 isa_ok($io, 'Bio::SeqIO');
-ok(my $seq = $io->next_seq);
+ok(my $seq = $io->next_seq);
 isa_ok($seq, 'Bio::Seq::Meta');
-is($seq->seq, 'ABCDEFHIJKLMNOPQRSTUVWXYZ');
-is($seq->display_id,'test');
-ok(my $charge = $seq->named_meta('charge'));
-is($charge, 'NBNAANCNJCNNNONNCNNUNNXNZ');
+is($seq->seq, "ABCDEFHIJKLMNOPQRSTUVWXYZ");
+is($seq->display_id,'test');
+
+ + + + \ No newline at end of file From cjfields at dev.open-bio.org Fri Feb 19 16:16:30 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 16:16:30 -0500 Subject: [Bioperl-guts-l] [16861] bioperl-live/trunk/t/SeqIO/metafasta.t: fix bad test file Message-ID: <201002192116.o1JLGUZj019838@dev.open-bio.org> Revision: 16861 Author: cjfields Date: 2010-02-19 16:16:30 -0500 (Fri, 19 Feb 2010) Log Message: ----------- fix bad test file Modified Paths: -------------- bioperl-live/trunk/t/SeqIO/metafasta.t Modified: bioperl-live/trunk/t/SeqIO/metafasta.t =================================================================== --- bioperl-live/trunk/t/SeqIO/metafasta.t 2010-02-19 21:05:34 UTC (rev 16860) +++ bioperl-live/trunk/t/SeqIO/metafasta.t 2010-02-19 21:16:30 UTC (rev 16861) @@ -1,30 +1,4 @@ - - - view: /bioperl/bioperl-live/trunk/t/SeqIO/metafasta.t (Rev: 15112, via SVN::Web) - -
-
- -
-
-
- -
-
- -
- - - - -
Revision 15112 (by sendu, 2008/12/08 18:12:38)BioperlTest -> Bio::Root::Test
- -
# -*-Perl-*- Test Harness script for Bioperl
+# -*-Perl-*- Test Harness script for Bioperl
 # $Id$
 
 use strict;
@@ -33,27 +7,19 @@
 	use lib '.';
     use Bio::Root::Test;
     
-    test_begin(-tests => 6);
+    test_begin(-tests => 6);
 	
 	use_ok('Bio::SeqIO::metafasta');
 }
 
 my $verbose = test_debug();
 
-my $io = Bio::SeqIO->new(-format => 'metafasta',
-								 -verbose => $verbose,
-								 -file => test_input_file('test.metafasta'));
+my $io = Bio::SeqIO->new(-format => 'metafasta',
+								 -verbose => $verbose,
+								 -file => test_input_file('test.metafasta'));
 
 isa_ok($io, 'Bio::SeqIO');
-ok(my $seq = $io->next_seq);
+ok(my $seq = $io->next_seq);
 isa_ok($seq, 'Bio::Seq::Meta');
-is($seq->seq, "ABCDEFHIJKLMNOPQRSTUVWXYZ");
-is($seq->display_id,'test');
-
- - - - \ No newline at end of file +is($seq->seq, "ABCDEFHIJKLMNOPQRSTUVWXYZ"); +is($seq->display_id,'test'); From cjfields at dev.open-bio.org Fri Feb 19 16:36:05 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 16:36:05 -0500 Subject: [Bioperl-guts-l] [16862] bioperl-live/trunk/Bio/SeqIO/embl.pm: deal with empty buffer warnings Message-ID: <201002192136.o1JLa5XJ020358@dev.open-bio.org> Revision: 16862 Author: cjfields Date: 2010-02-19 16:36:05 -0500 (Fri, 19 Feb 2010) Log Message: ----------- deal with empty buffer warnings Modified Paths: -------------- bioperl-live/trunk/Bio/SeqIO/embl.pm Modified: bioperl-live/trunk/Bio/SeqIO/embl.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/embl.pm 2010-02-19 21:16:30 UTC (rev 16861) +++ bioperl-live/trunk/Bio/SeqIO/embl.pm 2010-02-19 21:36:05 UTC (rev 16862) @@ -419,18 +419,19 @@ while ( defined ($buffer) && $buffer =~ /^XX/ ) { $buffer = $self->_readline(); } - + if ( $buffer =~ /^CO/ ) { # bug#2982 # special : create contig as annotation - until ( !defined ($buffer) ) { + while ( defined ($buffer) ) { $annotation->add_Annotation($_) for $self->_read_EMBL_Contig(\$buffer); - if ( $buffer !~ /^CO/ ) { + if ( !$buffer || $buffer !~ /^CO/ ) { last; } } + $buffer ||= ''; } -if ($buffer !~ /^\/\//) { # if no SQ lines following CO (bug#2958) + if ($buffer !~ /^\/\//) { # if no SQ lines following CO (bug#2958) if ( $buffer !~ /^SQ/ ) { while ( defined ($_ = $self->_readline) ) { /^SQ/ && last; From cjfields at dev.open-bio.org Fri Feb 19 17:38:12 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 17:38:12 -0500 Subject: [Bioperl-guts-l] [16863] bioperl-live/trunk/Bio/TreeIO/phyloxml.pm: squash warning Message-ID: <201002192238.o1JMcCVa022935@dev.open-bio.org> Revision: 16863 Author: cjfields Date: 2010-02-19 17:38:12 -0500 (Fri, 19 Feb 2010) Log Message: ----------- squash warning Modified Paths: -------------- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm =================================================================== --- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2010-02-19 21:36:05 UTC (rev 16862) +++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2010-02-19 22:38:12 UTC (rev 16863) @@ -345,7 +345,7 @@ } # check if rooted my ($b_rooted) = $tree->get_tag_values('rooted'); - print "b_rooted: $b_rooted\n"; + print "b_rooted: $b_rooted\n" if $b_rooted; if ($b_rooted) { $attr_str .= " rooted=\"true\""; } From cjfields at dev.open-bio.org Fri Feb 19 17:51:28 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 17:51:28 -0500 Subject: [Bioperl-guts-l] [16864] bioperl-live/trunk/Bio/LocatableSeq.pm: squash warnings Message-ID: <201002192251.o1JMpSkD023378@dev.open-bio.org> Revision: 16864 Author: cjfields Date: 2010-02-19 17:51:28 -0500 (Fri, 19 Feb 2010) Log Message: ----------- squash warnings Modified Paths: -------------- bioperl-live/trunk/Bio/LocatableSeq.pm Modified: bioperl-live/trunk/Bio/LocatableSeq.pm =================================================================== --- bioperl-live/trunk/Bio/LocatableSeq.pm 2010-02-19 22:38:12 UTC (rev 16863) +++ bioperl-live/trunk/Bio/LocatableSeq.pm 2010-02-19 22:51:28 UTC (rev 16864) @@ -327,7 +327,7 @@ $self->throw("Attribute start not set") unless defined($st); $self->throw("Attribute end not set") unless defined($end); - if ($strand == -1) { + if ($strand && $strand == -1) { ($st, $end) = ($end, $st); } From cjfields at dev.open-bio.org Fri Feb 19 17:56:06 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 17:56:06 -0500 Subject: [Bioperl-guts-l] [16865] bioperl-live/trunk/Bio/PrimarySeqI.pm: squash warning Message-ID: <201002192256.o1JMu6Xg023456@dev.open-bio.org> Revision: 16865 Author: cjfields Date: 2010-02-19 17:56:06 -0500 (Fri, 19 Feb 2010) Log Message: ----------- squash warning Modified Paths: -------------- bioperl-live/trunk/Bio/PrimarySeqI.pm Modified: bioperl-live/trunk/Bio/PrimarySeqI.pm =================================================================== --- bioperl-live/trunk/Bio/PrimarySeqI.pm 2010-02-19 22:51:28 UTC (rev 16864) +++ bioperl-live/trunk/Bio/PrimarySeqI.pm 2010-02-19 22:56:06 UTC (rev 16865) @@ -694,12 +694,13 @@ $class = 'Bio::PrimarySeq'; $self->_attempt_to_load_Seq; } + my $desc = $self->desc || ''; return $class->new( '-seq' => $s, '-alphabet' => 'rna', '-display_id' => $self->display_id, '-accession_number' => $self->accession_number, - '-desc' => $self->desc . "[TRANSCRIBED]", + '-desc' => "${desc}[TRANSCRIBED]", '-verbose' => $self->verbose ); } From cjfields at dev.open-bio.org Fri Feb 19 18:01:34 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 18:01:34 -0500 Subject: [Bioperl-guts-l] [16866] bioperl-live/trunk/t/LocalDB/DBFasta.t: squish verbose output from tests Message-ID: <201002192301.o1JN1Y58023835@dev.open-bio.org> Revision: 16866 Author: cjfields Date: 2010-02-19 18:01:33 -0500 (Fri, 19 Feb 2010) Log Message: ----------- squish verbose output from tests Modified Paths: -------------- bioperl-live/trunk/t/LocalDB/DBFasta.t Modified: bioperl-live/trunk/t/LocalDB/DBFasta.t =================================================================== --- bioperl-live/trunk/t/LocalDB/DBFasta.t 2010-02-19 22:56:06 UTC (rev 16865) +++ bioperl-live/trunk/t/LocalDB/DBFasta.t 2010-02-19 23:01:33 UTC (rev 16866) @@ -58,15 +58,16 @@ # test out writing the Bio::PrimarySeq::Fasta objects with SeqIO $db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1); -my $out = Bio::SeqIO->new(-format => 'genbank'); +my $out = Bio::SeqIO->new(-format => 'genbank', + -file => '>'.test_output_file()); $primary_seq = Bio::Seq->new(-primary_seq => $db->get_Seq_by_acc('AW057119')); eval { - warn(ref($primary_seq),"\n"); + #warn(ref($primary_seq),"\n"); $out->write_seq($primary_seq) }; ok(!$@); -$out = Bio::SeqIO->new(-format => 'embl'); +$out = Bio::SeqIO->new(-format => 'embl', -file => '>'.test_output_file()); eval { $out->write_seq($primary_seq) From cjfields at dev.open-bio.org Fri Feb 19 20:49:11 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 20:49:11 -0500 Subject: [Bioperl-guts-l] [16867] bioperl-live/trunk: Add id_mapper to SwissProt, and tests Message-ID: <201002200149.o1K1nBix028673@dev.open-bio.org> Revision: 16867 Author: cjfields Date: 2010-02-19 20:49:11 -0500 (Fri, 19 Feb 2010) Log Message: ----------- Add id_mapper to SwissProt, and tests Modified Paths: -------------- bioperl-live/trunk/Bio/DB/SwissProt.pm bioperl-live/trunk/t/RemoteDB/SwissProt.t Modified: bioperl-live/trunk/Bio/DB/SwissProt.pm =================================================================== --- bioperl-live/trunk/Bio/DB/SwissProt.pm 2010-02-19 23:01:33 UTC (rev 16866) +++ bioperl-live/trunk/Bio/DB/SwissProt.pm 2010-02-20 01:49:11 UTC (rev 16867) @@ -154,6 +154,21 @@ } ); +our %ID_MAPPING_DATABASES = map {$_ => 1} qw( +ACC+ID ACC ID UPARC NF50 NF90 NF100 EMBL_ID EMBL PIR UNIGENE_ID P_ENTREZGENEID +P_GI P_IPI P_REFSEQ_AC PDB_ID DISPROT_ID HSSP_ID DIP_ID MEROPS_ID PEROXIBASE_ID +PPTASEDB_ID REBASE_ID TCDB_ID 2DBASE_ECOLI_ID AARHUS_GHENT_2DPAGE_ID +ANU_2DPAGE_ID DOSAC_COBS_2DPAGE_ID ECO2DBASE_ID WORLD_2DPAGE_ID ENSEMBL_ID +ENSEMBL_PRO_ID ENSEMBL_TRS_ID P_ENTREZGENEID GENOMEREVIEWS_ID KEGG_ID TIGR_ID +UCSC_ID VECTORBASE_ID AGD_ID ARACHNOSERVER_ID BURULIST_ID CGD CYGD_ID +DICTYBASE_ID ECHOBASE_ID ECOGENE_ID EUHCVDB_ID FLYBASE_ID GENECARDS_ID +GENEDB_SPOMBE_ID GENEFARM_ID H_INVDB_ID HGNC_ID HPA_ID LEGIOLIST_ID LEPROMA_ID +LISTILIST_ID MAIZEGDB_ID MIM_ID MGI_ID MYPULIST_ID NMPDR ORPHANET_ID PHARMGKB_ID +PHOTOLIST_ID PSEUDOCAP_ID RGD_ID SAGALIST_ID SGD_ID SUBTILIST_ID TAIR_ID +TUBERCULIST_ID WORMBASE_ID WORMPEP_ID XENBASE_ID ZFIN_ID EGGNOG_ID OMA_ID +ORTHODB_ID BIOCYC_ID REACTOME_ID CLEANEX_ID GERMONLINE_ID DRUGBANK_ID +NEXTBIO_ID); + # new modules should be a little more lightweight and # should use Bio::Root::Root sub new { @@ -469,12 +484,62 @@ sub idtracker { my ($self, $id) = @_; $self->deprecated( - -message => 'The SwissProt IDTracker service is no longer available', + -message => 'The SwissProt IDTracker service is no longer available, '. + 'use id_mapper() instead', -warn_version => 1.006, # warn if $VERSION is >= this version -throw_version => 1.007 # throw if $VERSION is >= this version ); } +=head2 id_mapper + + Title : id_tracker + Usage : my $map = $self->id_mapper( -from => '', + -to => '', + -ids => \@ids); + Function: Retrieve new ID using old ID. + Returns : hash reference of successfully mapped IDs + Args : -from : database mapping from + -to : database mapped to + -ids : a single ID or array ref of IDs to map + +=cut + +sub id_mapper { + my $self = shift; + my ($from, $to, $ids) = $self->_rearrange([qw(FROM TO IDS)], @_); + for ($from, $to) { + $self->throw("$_ is not a recognized database") if !exists $ID_MAPPING_DATABASES{$_}; + } + my @ids = ref $ids ? @$ids : $ids; + my $params = { + from => $from, + to => $to, + format => 'tab', + query => join(' ', at ids) + }; + my $ua = $self->ua; + push @{ $ua->requests_redirectable }, 'POST'; + my $response = $ua->post("http://www.uniprot.org/mapping/", $params); + while (my $wait = $response->header('Retry-After')) { + $self->debug("Waiting...\n"); + $self->_sleep; + $response = $ua->get($response->base); + } + + my %map; + if ($response->is_success) { + for my $line (split("\n", $response->content)) { + my ($id_from, $id_to) = split(/\s+/, $line, 2); + next if $id_from eq 'From'; + $map{$id_from} = $id_to; + } + } else { + $self->throw("Error: ".$response->status_line."\n"); + } + \%map; +} + 1; __END__ Modified: bioperl-live/trunk/t/RemoteDB/SwissProt.t =================================================================== --- bioperl-live/trunk/t/RemoteDB/SwissProt.t 2010-02-19 23:01:33 UTC (rev 16866) +++ bioperl-live/trunk/t/RemoteDB/SwissProt.t 2010-02-20 01:49:11 UTC (rev 16867) @@ -7,7 +7,7 @@ use lib '.'; use Bio::Root::Test; - test_begin(-tests => 19, + test_begin(-tests => 21, -requires_modules => [qw(IO::String LWP::UserAgent HTTP::Request::Common)], @@ -67,21 +67,25 @@ -delay => 0, -verbose => -1); -TODO: { - local $TODO = "idtracker() not working (may be temporary)"; +SKIP: { + my $map; + # check old ID + eval {$map = $gb->id_mapper(-from => 'ACC+ID', + -to => 'ACC', + -ids => [qw(MYOD1_PIG YNB3_YEAST)]) + }; + skip("Problem with idtracker(), skipping these tests: $@", 4) if $@; - SKIP: { - my $newid; - # check old ID - eval {$newid = $gb->idtracker('myod_pig');}; - skip("Problem with idtracker(), skipping these tests", 2) if $@; - is($newid, 'MYOD1_PIG'); - # check ID that is current - eval {$newid = $gb->idtracker('YNB3_YEAST');}; - skip("Problem with idtracker(), skipping these tests", 1) if $@; - is($newid, 'YNB3_YEAST'); - } + is($map->{MYOD1_PIG}, 'P49811'); + is($map->{YNB3_YEAST}, 'P53979'); + eval {$map = $gb->id_mapper(-from => 'ACC+ID', + -to => 'ENSEMBL_PRO_ID', + -ids => [qw(MYOD1_PIG YNB3_YEAST)]) + }; + skip("Problem with idtracker(), skipping these tests: $@", 2) if $@; + is($map->{MYOD1_PIG}, 'ENSSSCP00000014214'); + is($map->{YNB3_YEAST}, 'YNL013C'); } 1; From cjfields at dev.open-bio.org Fri Feb 19 20:51:52 2010 From: cjfields at dev.open-bio.org (Christopher John Fields) Date: Fri, 19 Feb 2010 20:51:52 -0500 Subject: [Bioperl-guts-l] [16868] bioperl-live/trunk/Bio/DB/SwissProt.pm: add link for database Message-ID: <201002200151.o1K1pqIL028747@dev.open-bio.org> Revision: 16868 Author: cjfields Date: 2010-02-19 20:51:52 -0500 (Fri, 19 Feb 2010) Log Message: ----------- add link for database Modified Paths: -------------- bioperl-live/trunk/Bio/DB/SwissProt.pm Modified: bioperl-live/trunk/Bio/DB/SwissProt.pm =================================================================== --- bioperl-live/trunk/Bio/DB/SwissProt.pm 2010-02-20 01:49:11 UTC (rev 16867) +++ bioperl-live/trunk/Bio/DB/SwissProt.pm 2010-02-20 01:51:52 UTC (rev 16868) @@ -502,6 +502,8 @@ Args : -from : database mapping from -to : database mapped to -ids : a single ID or array ref of IDs to map + Note : For a list of valid database IDs, see: + http://www.uniprot.org/faq/28#id_mapping_examples =cut From bugzilla-daemon at portal.open-bio.org Mon Feb 22 12:01:28 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Mon, 22 Feb 2010 12:01:28 -0500 Subject: [Bioperl-guts-l] [Bug 3014] New: bowtie wrapper, support alternate OS Message-ID: http://bugzilla.open-bio.org/show_bug.cgi?id=3014 Summary: bowtie wrapper, support alternate OS Product: BioPerl Version: unspecified Platform: PC OS/Version: Windows Status: NEW Severity: normal Priority: P2 Component: bioperl-run AssignedTo: bioperl-guts-l at bioperl.org ReportedBy: bimber at wisc.edu The bowtie wrapper runs shell commands that are not PC compatible. ideally the commands would be cross-platform. if the wrapper does not already support some ability for the user to customize the path to the executable, this would also be useful. i do not recall whether this exists today. -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From kortsch at dev.open-bio.org Mon Feb 22 18:11:49 2010 From: kortsch at dev.open-bio.org (Dan Kortschak) Date: Mon, 22 Feb 2010 18:11:49 -0500 Subject: [Bioperl-guts-l] [16869] bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm: bug fix bugzilla #3014 Message-ID: <201002222311.o1MNBntt026951@dev.open-bio.org> Revision: 16869 Author: kortsch Date: 2010-02-22 18:11:49 -0500 (Mon, 22 Feb 2010) Log Message: ----------- bug fix bugzilla #3014 Modified Paths: -------------- bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm Modified: bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm =================================================================== --- bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm 2010-02-20 01:51:52 UTC (rev 16868) +++ bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm 2010-02-22 23:11:49 UTC (rev 16869) @@ -237,9 +237,7 @@ } my $self = $class->SUPER::new(@args); foreach (keys %command_executables) { - my $executable = `which $command_executables{$_}`; - chomp $executable; - $self->executables($_, $executable); + $self->executables($_, $self->_find_executable($command_executables{$_})); } my ($want) = $self->_rearrange([qw(WANT)], at args); $self->want($want); From bugzilla-daemon at portal.open-bio.org Mon Feb 22 18:16:07 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Mon, 22 Feb 2010 18:16:07 -0500 Subject: [Bioperl-guts-l] [Bug 3014] bowtie wrapper, support alternate OS In-Reply-To: Message-ID: <201002222316.o1MNG73q010157@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3014 dan.kortschak at adelaide.edu.au changed: What |Removed |Added ---------------------------------------------------------------------------- Status|NEW |ASSIGNED -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Mon Feb 22 18:20:50 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Mon, 22 Feb 2010 18:20:50 -0500 Subject: [Bioperl-guts-l] [Bug 3014] bowtie wrapper, support alternate OS In-Reply-To: Message-ID: <201002222320.o1MNKouc010388@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3014 dan.kortschak at adelaide.edu.au changed: What |Removed |Added ---------------------------------------------------------------------------- CC| |dan.kortschak at adelaide.edu.a | |u Status|ASSIGNED |RESOLVED Resolution| |FIXED ------- Comment #1 from dan.kortschak at adelaide.edu.au 2010-02-22 18:20 EST ------- Bio::Root::IO exists_exe method used through _find_executables method of ::WrapperBase::CommandExts. Now will find executables based on -prog_dir if provided, otherwise will search system path. Passes tests under unix, should be tested on other platforms. -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From kortsch at dev.open-bio.org Mon Feb 22 18:49:14 2010 From: kortsch at dev.open-bio.org (Dan Kortschak) Date: Mon, 22 Feb 2010 18:49:14 -0500 Subject: [Bioperl-guts-l] [16870] bioperl-run/trunk/lib/Bio/Tools/Run/BEDTools.pm: Remove unix command from constructor. Message-ID: <201002222349.o1MNnEIk028273@dev.open-bio.org> Revision: 16870 Author: kortsch Date: 2010-02-22 18:49:14 -0500 (Mon, 22 Feb 2010) Log Message: ----------- Remove unix command from constructor. Modified Paths: -------------- bioperl-run/trunk/lib/Bio/Tools/Run/BEDTools.pm Modified: bioperl-run/trunk/lib/Bio/Tools/Run/BEDTools.pm =================================================================== --- bioperl-run/trunk/lib/Bio/Tools/Run/BEDTools.pm 2010-02-22 23:11:49 UTC (rev 16869) +++ bioperl-run/trunk/lib/Bio/Tools/Run/BEDTools.pm 2010-02-22 23:49:14 UTC (rev 16870) @@ -222,9 +222,7 @@ } my $self = $class->SUPER::new(@args); foreach (keys %command_executables) { - my $executable = `which $command_executables{$_}`; - chomp $executable; - $self->executables($_, $executable); + $self->executables($_, $self->_find_executable($command_executables{$_})); } $self->want($self->_rearrange([qw(WANT)], at args)); $self->parameters_changed(1); # set on instantiation, per Bio::ParameterBaseI From nml5566 at dev.open-bio.org Mon Feb 22 19:31:03 2010 From: nml5566 at dev.open-bio.org (Nathan Liles) Date: Mon, 22 Feb 2010 19:31:03 -0500 Subject: [Bioperl-guts-l] [16871] bioperl-live/trunk: added noinfer, sofile, manual, conf command line options; added quotemeta to regex strings in OBOEngine. pm; commented out bracket substitution in obo synonym terms for obo.pm; added SO IDs to Typemapper.pm; added noinfer flag to Unflattener.pm Message-ID: <201002230031.o1N0V3nv029678@dev.open-bio.org> Revision: 16871 Author: nml5566 Date: 2010-02-22 19:31:03 -0500 (Mon, 22 Feb 2010) Log Message: ----------- added noinfer, sofile, manual, conf command line options; added quotemeta to regex strings in OBOEngine.pm; commented out bracket substitution in obo synonym terms for obo.pm; added SO IDs to Typemapper.pm; added noinfer flag to Unflattener.pm Modified Paths: -------------- bioperl-live/trunk/Bio/Ontology/OBOEngine.pm bioperl-live/trunk/Bio/OntologyIO/obo.pm bioperl-live/trunk/Bio/SeqFeature/Tools/TypeMapper.pm bioperl-live/trunk/Bio/SeqFeature/Tools/Unflattener.pm bioperl-live/trunk/Bio/SeqIO/genbank.pm bioperl-live/trunk/scripts/Bio-DB-GFF/genbank2gff3.PLS Modified: bioperl-live/trunk/Bio/Ontology/OBOEngine.pm =================================================================== --- bioperl-live/trunk/Bio/Ontology/OBOEngine.pm 2010-02-22 23:49:14 UTC (rev 16870) +++ bioperl-live/trunk/Bio/Ontology/OBOEngine.pm 2010-02-23 00:31:03 UTC (rev 16871) @@ -882,7 +882,7 @@ foreach my $string ( $term->name, $term->each_synonym() ) { $matching_terms{$term->identifier} = $term and next - if $string =~ /$qstring/ or $qstring =~ /$string/; + if $string =~ /\Q$qstring\E/ or $qstring =~ /\Q$string\E/; } } } Modified: bioperl-live/trunk/Bio/OntologyIO/obo.pm =================================================================== --- bioperl-live/trunk/Bio/OntologyIO/obo.pm 2010-02-22 23:49:14 UTC (rev 16870) +++ bioperl-live/trunk/Bio/OntologyIO/obo.pm 2010-02-23 00:31:03 UTC (rev 16871) @@ -662,7 +662,7 @@ $term->add_dbxref(-dbxrefs => $ann); } elsif ( $tag =~ /(\w*)synonym/i ) { - $val =~ s/['"\[\]]//g; + #$val =~ s/['"\[\]]//g; #NML commented out b/c need quotes $term->add_synonym($val); } elsif ( $tag eq "ALT_ID" ) { Modified: bioperl-live/trunk/Bio/SeqFeature/Tools/TypeMapper.pm =================================================================== --- bioperl-live/trunk/Bio/SeqFeature/Tools/TypeMapper.pm 2010-02-22 23:49:14 UTC (rev 16870) +++ bioperl-live/trunk/Bio/SeqFeature/Tools/TypeMapper.pm 2010-02-23 00:31:03 UTC (rev 16871) @@ -233,99 +233,191 @@ =cut -sub FT_SO_map { +sub ft_so_map { # $self= shift; - # note : some of the FT_SO mappings are commented out and overriden... - return { - "FT term" => "SO term", - "-" => "located_sequence_feature", - "-10_signal" => "minus_10_signal", - "-35_signal" => "minus_35_signal", - "3'UTR" => "three_prime_UTR", - "3'clip" => "three_prime_clip", - "5'UTR" => "five_prime_UTR", - "5'clip" => "five_prime_clip", - "CAAT_signal" => "CAAT_signal", - "CDS" => "CDS", - "C_region" => "undefined", - "D-loop" => "D_loop", - "D_segment" => "D_gene", - "GC_signal" => "GC_rich_region", - "J_segment" => "undefined", - "LTR" => "long_terminal_repeat", - "N_region" => "undefined", - "RBS" => "ribosome_entry_site", - "STS" => "STS", - "S_region" => "undefined", - "TATA_signal" => "TATA_box", - "V_region" => "undefined", - "V_segment" => "undefined", - "attenuator" => "attenuator", - "conflict" => "undefined", - "enhancer" => "enhancer", - "exon" => "exon", - "gap" => "gap", - "gene" => "gene", - "iDNA" => "iDNA", - "intron" => "intron", - "mRNA" => "mRNA", - "mat_peptide" => "mature_protein_region", - "mature_peptide" => "mature_protein_region", -# "misc_RNA" => "transcript", - "misc_binding" => "binding_site", - "misc_difference" => "sequence_difference", - "misc_feature" => "region", - "misc_recomb" => "recombination_feature", - "misc_signal" => "regulatory_region", - "misc_structure" => "sequence_secondary_structure", - "modified_base" => "modified_base_site", - "old_sequence" => "undefined", - "operon" => "operon", - "oriT" => "origin_of_transfer", - "polyA_signal" => "polyA_signal_sequence", - "polyA_site" => "polyA_site", - "precursor_RNA" => "primary_transcript", - "prim_transcript" => "primary_transcript", - "primer_bind" => "primer_binding_site", - "promoter" => "promoter", - "protein_bind" => "protein_binding_site", - "rRNA" => "rRNA", - "repeat_region" => "repeat_region", - "repeat_unit" => "repeat_unit", - "satellite" => "satellite_DNA", - "scRNA" => "scRNA", - "sig_peptide" => "signal_peptide", - "snRNA" => "snRNA", - "snoRNA" => "snoRNA", -# "source" => "databank_entry", - "stem_loop" => "stem_loop", - "tRNA" => "tRNA", - "terminator" => "terminator", - "transit_peptide" => "transit_peptide", - "unsure" => "undefined", - "variation" => "sequence_variant", + # note : some of the ft_so mappings are commented out and overriden... + return { + "-" => ["located_sequence_feature", "so:0000110"], + "-10_signal" => ["minus_10_signal", "so:0000175"], + "-35_signal" => ["minus_35_signal", "so:0000176"], + "3'utr" => ["three_prime_utr", "so:0000205"], + "3'clip" => ["three_prime_clip", "so:0000557"], + "5'utr" => ["five_prime_utr", "so:0000204"], + "5'clip" => ["five_prime_clip", "so:0000555"], + "caat_signal" => ["caat_signal", "so:0000172"], + "cds" => ["cds", "so:0000316"], + "c_region" => ["undefined", ""], + "d-loop" => ["d_loop", "so:0000297"], + "d_segment" => ["d_gene", "so:0000458"], + "gc_signal" => ["gc_rich_region", "so:0000173"], + "j_segment" => ["undefined", ""], + "ltr" => ["long_terminal_repeat", "so:0000286"], + "n_region" => ["undefined", ""], + "rbs" => ["ribosome_entry_site", "so:0000139"], + "sts" => ["sts", "so:0000331"], + "s_region" => ["undefined", ""], + "tata_signal" => ["tata_box", "so:0000174"], + "v_region" => ["undefined", ""], + "v_segment" => ["undefined", ""], + "attenuator" => ["attenuator", "so:0000140"], + "conflict" => ["undefined", ""], + "enhancer" => ["enhancer", "so:0000165"], + "exon" => ["exon", "so:0000147"], + "gap" => ["gap", "so:0000730"], + "gene" => ["gene", "so:0000704"], + "idna" => ["idna", "so:0000723"], + "intron" => ["intron", "so:0000188"], + "mrna" => ["mrna", "so:0000234"], + "mat_peptide" => ["mature_protein_region", "so:0000419"], + "mature_peptide" => ["mature_protein_region", "so:0000419"], + #"misc_rna" => ["transcript", "so:0000673"], + "misc_binding" => ["binding_site", "so:0000409"], + "misc_difference" => ["sequence_difference", "so:0000413"], + #"misc_feature" => ["region", "so:0000001"], + "misc_recomb" => ["recombination_feature", "so:0000298"], + "misc_signal" => ["regulatory_region", "so:0005836"], + "misc_structure" => ["sequence_secondary_structure", "so:0000002"], + "modified_base" => ["modified_base_site", "so:0000305"], + "old_sequence" => ["undefined", ""], + "operon" => ["operon", "so:0000178"], + "oriT" => ["origin_of_transfer", "so:0000724"], + "polya_signal" => ["polyA_signal_sequence", "so:0000551"], + "polya_site" => ["polyA_site", "so:0000553"], + "precursor_rna" => ["primary_transcript", "so:0000185"], + "prim_transcript" => ["primary_transcript", "so:0000185"], + "primer_bind" => ["primer_binding_site", "so:0005850"], + "promoter" => ["promoter", "so:0000167"], + "protein_bind" => ["protein_binding_site", "so:0000410"], + "rrna" => ["rrna", "so:0000252"], + "repeat_region" => ["repeat_region", "so:0000657"], + "repeat_unit" => ["repeat_unit", "so:0000726"], + "satellite" => ["satellite_dna", "so:0000005"], + "scrna" => ["scrna", "so:0000013"], + "sig_peptide" => ["signal_peptide", "so:0000418"], + "snrna" => ["snrna", "so:0000274"], + "snorna" => ["snorna", "so:0000275"], + #"source" => ["databank_entry", "so:2000061"], + "stem_loop" => ["stem_loop", "so:0000313"], + "trna" => ["trna", "so:0000253"], + "terminator" => ["terminator", "so:0000141"], + "transit_peptide" => ["transit_peptide", "so:0000725"], + "unsure" => "undefined", + "variation" => ["sequence_variant", "so:0000109"], - "pseudomRNA" => "pseudogenic_transcript", ## has parent = pseudogene ; dgg - "pseudotranscript" => "pseudogenic_transcript", ## from Unflattener misc_RNA ; dgg - "pseudoexon" => "pseudogenic_exon", - "pseudoCDS" => "pseudogenic_exon", - "pseudomisc_feature" => "pseudogenic_region", - "pseudointron" => "pseudogenic_region", + # manually added + ## has parent = pseudogene ; dgg + "pseudomrna" => ["pseudogenic_transcript", "so:0000516"], + ## from unflattener misc_rna ; dgg + "pseudotranscript" => ["pseudogenic_transcript", "so:0000516"], + "pseudoexon" => ["pseudogenic_exon", "so:0000507"], + "pseudomisc_feature" => ["pseudogenic_region", "so:0000462"], + "pseudointron" => ["pseudogenic_region", "so:0000462"], + + + ## "undefined" => "region", + + # this is the most generic form for rnas; + # we always represent the processed form of + # the transcript + misc_rna => ['mature_transcript',"so:0000233"], + + # not sure about this one... + source=>['contig', "SO:0000149"], + + rep_origin=>['origin_of_replication',"SO:0000296"], + + Protein=>['polypeptide',"SO:0000104"], + }; +# return { + #"FT term" => "SO term", + #"-" => "located_sequence_feature", + #"-10_signal" => "minus_10_signal", + #"-35_signal" => "minus_35_signal", + #"3'UTR" => "three_prime_UTR", + #"3'clip" => "three_prime_clip", + #"5'UTR" => "five_prime_UTR", + #"5'clip" => "five_prime_clip", + #"CAAT_signal" => "CAAT_signal", + #"CDS" => "CDS", + #"C_region" => "undefined", + #"D-loop" => "D_loop", + #"D_segment" => "D_gene", + #"GC_signal" => "GC_rich_region", + #"J_segment" => "undefined", + #"LTR" => "long_terminal_repeat", + #"N_region" => "undefined", + #"RBS" => "ribosome_entry_site", + #"STS" => "STS", + #"S_region" => "undefined", + #"TATA_signal" => "TATA_box", + #"V_region" => "undefined", + #"V_segment" => "undefined", + #"attenuator" => "attenuator", + #"conflict" => "undefined", + #"enhancer" => "enhancer", + #"exon" => "exon", + #"gap" => "gap", + #"gene" => "gene", + #"iDNA" => "iDNA", + #"intron" => "intron", + #"mRNA" => "mRNA", + #"mat_peptide" => "mature_protein_region", + #"mature_peptide" => "mature_protein_region", +## "misc_RNA" => "transcript", + #"misc_binding" => "binding_site", + #"misc_difference" => "sequence_difference", + #"misc_feature" => "region", + #"misc_recomb" => "recombination_feature", + #"misc_signal" => "regulatory_region", + #"misc_structure" => "sequence_secondary_structure", + #"modified_base" => "modified_base_site", + #"old_sequence" => "undefined", + #"operon" => "operon", + #"oriT" => "origin_of_transfer", + #"polyA_signal" => "polyA_signal_sequence", @@ Diff output truncated at 10000 characters. @@ From nml5566 at dev.open-bio.org Mon Feb 22 20:15:10 2010 From: nml5566 at dev.open-bio.org (Nathan Liles) Date: Mon, 22 Feb 2010 20:15:10 -0500 Subject: [Bioperl-guts-l] [16872] bioperl-live/trunk/scripts/Bio-DB-GFF/genbank2gff3.PLS: fixed id_validate() to work without needing so.obo file. Message-ID: <201002230115.o1N1FAnK031005@dev.open-bio.org> Revision: 16872 Author: nml5566 Date: 2010-02-22 20:15:09 -0500 (Mon, 22 Feb 2010) Log Message: ----------- fixed id_validate() to work without needing so.obo file. Also, fixed bug where converter tries to guess primary_tag without so.obo file Modified Paths: -------------- bioperl-live/trunk/scripts/Bio-DB-GFF/genbank2gff3.PLS Modified: bioperl-live/trunk/scripts/Bio-DB-GFF/genbank2gff3.PLS =================================================================== --- bioperl-live/trunk/scripts/Bio-DB-GFF/genbank2gff3.PLS 2010-02-23 00:31:03 UTC (rev 16871) +++ bioperl-live/trunk/scripts/Bio-DB-GFF/genbank2gff3.PLS 2010-02-23 01:15:09 UTC (rev 16872) @@ -222,7 +222,7 @@ use vars qw/$split @filter $zip $outdir $help $ethresh $ONTOLOGY %FEATURES %DESCENDANTS @RETURN $MANUAL @GFF_LINE_FEAT - $CONF $YAML $TYPE_MAP $SYN_MAP $noinfer $SOfile + $CONF $YAML $TYPE_MAP $SYN_MAP $noinfer $SO_FILE $file @files $dir $summary $nolump $source_type %proteinfa %exonpar $didheader $verbose $DEBUG $GFF_VERSION $gene_id $rna_id $tnum $ncrna_id $rnum %method %id %seen/; @@ -278,7 +278,7 @@ 's|summary' => \$summary, 'r|noinfer' => \$noinfer, 'i|conf=s' => \$CONF, - 'sofile=s' => \$SOfile, + 'sofile=s' => \$SO_FILE, 'm|manual' => \$MANUAL, 'o|outdir|output:s'=> \$outdir, 'x|filter:s'=> \@filter, @@ -321,7 +321,7 @@ my $FTSOmap; my $FTSOsynonyms; -if (defined($SOfile) && $SOfile eq 'live') { +if (defined($SO_FILE) && $SO_FILE eq 'live') { print "\nDownloading the latest SO file from ".SO_URL."\n\n"; use LWP::UserAgent; my $ua = LWP::UserAgent->new(timeout => 30); @@ -333,20 +333,20 @@ use File::Temp qw/ tempfile /; my ($fh, $fn) = tempfile(); print $fh $response->content; - $SOfile = $fn; + $SO_FILE = $fn; } else { print "Couldn't download SO file online...skipping validation.\n" . "HTTP Status was " . $response->status_line . "\n" - and undef $SOfile + and undef $SO_FILE } } -if ($SOfile) { +if ($SO_FILE) { my (%terms, %syn); - my $parser = Bio::OntologyIO->new( -format => "obo", -file => $SOfile ); + my $parser = Bio::OntologyIO->new( -format => "obo", -file => $SO_FILE ); $ONTOLOGY = $parser->next_ontology(); for ($ONTOLOGY->get_all_terms) { @@ -576,7 +576,7 @@ # dont like doing this after others; do after each new gene id? @to_print= print_held($out, $gffio, \@to_print); - gff_validate(@GFF_LINE_FEAT) if $SOfile; + gff_validate(@GFF_LINE_FEAT); for my $feature (@GFF_LINE_FEAT) { my $gff= $gffio->gff_string($feature); @@ -1262,7 +1262,7 @@ } } - if ( not defined($mtype) && $syn_map) { + if ( ! $mtype && $syn_map) { if ($feat->has_tag('note')) { my @all_matches; @@ -1769,8 +1769,10 @@ } } - while (my ($parentID, $aChildren) = each %parent2child) { - parent_validate($parentID, $aChildren, \%all_ids, \%descendants, \%reserved); + if ($SO_FILE) { + while (my ($parentID, $aChildren) = each %parent2child) { + parent_validate($parentID, $aChildren, \%all_ids, \%descendants, \%reserved); + } } id_validate(\%all_ids, \%reserved); From bugzilla-daemon at portal.open-bio.org Tue Feb 23 09:04:44 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 23 Feb 2010 09:04:44 -0500 Subject: [Bioperl-guts-l] [Bug 3015] New: Bug in regex parsing withrefm enzyme cutting site Message-ID: http://bugzilla.open-bio.org/show_bug.cgi?id=3015 Summary: Bug in regex parsing withrefm enzyme cutting site Product: BioPerl Version: 1.6 branch Platform: PC OS/Version: Linux Status: NEW Severity: major Priority: P2 Component: Unclassified AssignedTo: bioperl-guts-l at bioperl.org ReportedBy: tuco at pasteur.fr I've discovered that the regular expression that parses the enzyme cutting site ignores site such as 'ATGGCGT(-3/-3)' like '(-3/-3)ATGCGT'. It does not capture '-' 'minus' sign. This lead to a 'cut' and 'complemtary_cut' value to undef and also an 'overhang' to 'unknown'. I proposed to add into the regular expression the minus site support -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Tue Feb 23 09:05:56 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 23 Feb 2010 09:05:56 -0500 Subject: [Bioperl-guts-l] [Bug 3015] Bug in regex parsing withrefm enzyme cutting site In-Reply-To: Message-ID: <201002231405.o1NE5uCg026508@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3015 ------- Comment #1 from tuco at pasteur.fr 2010-02-23 09:05 EST ------- Created an attachment (id=1438) --> (http://bugzilla.open-bio.org/attachment.cgi?id=1438&action=view) Patch Just the patch showing mistaken regex -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Tue Feb 23 09:07:42 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 23 Feb 2010 09:07:42 -0500 Subject: [Bioperl-guts-l] [Bug 3015] Bug in regex parsing withrefm enzyme cutting site In-Reply-To: Message-ID: <201002231407.o1NE7gvM026666@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3015 ------- Comment #2 from tuco at pasteur.fr 2010-02-23 09:07 EST ------- Created an attachment (id=1439) --> (http://bugzilla.open-bio.org/attachment.cgi?id=1439&action=view) The test file that support the patch This test script, if used with old regex, fails It passes all the test with the new regex -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From bugzilla-daemon at portal.open-bio.org Tue Feb 23 09:56:34 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 23 Feb 2010 09:56:34 -0500 Subject: [Bioperl-guts-l] [Bug 2975] Network access despite network tests skipped. In-Reply-To: Message-ID: <201002231456.o1NEuY5D028211@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=2975 ------- Comment #1 from plessy at debian.org 2010-02-23 09:56 EST ------- Created an attachment (id=1440) --> (http://bugzilla.open-bio.org/attachment.cgi?id=1440&action=view) Adds -requires_networking => 1 where needed. This patch adds "-requires_networking => 1" in the test that display a http error in the build log linked in this bug. -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From kortsch at dev.open-bio.org Tue Feb 23 19:21:11 2010 From: kortsch at dev.open-bio.org (Dan Kortschak) Date: Tue, 23 Feb 2010 19:21:11 -0500 Subject: [Bioperl-guts-l] [16873] bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm: Follow the bowtie environment variable index location behaviour definition from bowtie manual Message-ID: <201002240021.o1O0LB0f005223@dev.open-bio.org> Revision: 16873 Author: kortsch Date: 2010-02-23 19:21:10 -0500 (Tue, 23 Feb 2010) Log Message: ----------- Follow the bowtie environment variable index location behaviour definition from bowtie manual Modified Paths: -------------- bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm Modified: bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm =================================================================== --- bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm 2010-02-23 01:15:09 UTC (rev 16872) +++ bioperl-run/trunk/lib/Bio/Tools/Run/Bowtie.pm 2010-02-24 00:21:10 UTC (rev 16873) @@ -196,6 +196,7 @@ use Bio::Tools::GuessSeqFormat; use Bio::Tools::Run::Samtools; use Bio::Seq; +use File::Basename; use base qw( Bio::Tools::Run::WrapperBase Bio::Tools::Run::AssemblerBase ); @@ -262,6 +263,11 @@ -seq, -seq2, -ind (bowtie index), -ref (fasta reference) and -out Note : gzipped inputs are allowed if IO::Uncompress::Gunzip is available + The behaviour for locating indexes follows the definition in + the bowtie manual - you may use the environment variable + BOWTIE_INDEXES to specify the index path or use an 'indexes' + directory under the directory where the bowtie executable + is located =cut @@ -320,7 +326,11 @@ # confirm index files exist $self->_validate_file_input( -ind => $index ) or - $self->throw("Incorrect filetype (expecting bowtie index) or absent file arg 2/-index"); + ($self->_validate_file_input( -ind => $self->io->catfile(dirname($self->executable),'indexes',$index)) and + $index = $self->io->catfile(dirname($self->executable),'indexes',$index)) or + ($self->_validate_file_input( -ind => $self->io->catfile($ENV{BOWTIE_INDEXES},$index)) and + $index = $self->io->catfile($ENV{BOWTIE_INDEXES},$index)) or + $self->throw("Incorrect filetype (expecting bowtie index) or absent file arg 2/-index"); # bowtie prepare the multiple input types $seq = $self->_prepare_input_sequences($seq); @@ -392,8 +402,13 @@ $index ||= $arg1; $out ||= $arg2; $index or $self->throw("Bowtie index required at arg 1"); + $self->_validate_file_input( -ind => $index ) or - $self->throw("'$index' doesn't look like a bowtie index or index component is missing at arg 1/-ind"); + ($self->_validate_file_input( -ind => $self->io->catfile(dirname($self->executable),'indexes',$index)) and + $index = $self->io->catfile(dirname($self->executable),'indexes',$index)) or + ($self->_validate_file_input( -ind => $self->io->catfile($ENV{BOWTIE_INDEXES},$index)) and + $index = $self->io->catfile($ENV{BOWTIE_INDEXES},$index)) or + $self->throw("'$index' doesn't look like a bowtie index or index component is missing at arg 1/-ind"); $arg3 && $self->throw("Second sequence input not wanted for command: $cmd"); # Inspect index From maj at dev.open-bio.org Tue Feb 23 19:36:34 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Tue, 23 Feb 2010 19:36:34 -0500 Subject: [Bioperl-guts-l] [16874] bioperl-live/trunk/Bio/Restriction/IO/withrefm.pm: bug 3015/ Emmanuel's fixes for negative cut sites Message-ID: <201002240036.o1O0aY1e005784@dev.open-bio.org> Revision: 16874 Author: maj Date: 2010-02-23 19:36:34 -0500 (Tue, 23 Feb 2010) Log Message: ----------- bug 3015/Emmanuel's fixes for negative cut sites Modified Paths: -------------- bioperl-live/trunk/Bio/Restriction/IO/withrefm.pm Modified: bioperl-live/trunk/Bio/Restriction/IO/withrefm.pm =================================================================== --- bioperl-live/trunk/Bio/Restriction/IO/withrefm.pm 2010-02-24 00:21:10 UTC (rev 16873) +++ bioperl-live/trunk/Bio/Restriction/IO/withrefm.pm 2010-02-24 00:36:34 UTC (rev 16874) @@ -140,7 +140,7 @@ # occurring against the variables set by # regexp matching (unless anyone has other ideas...) - my ($precut, $recog, $postcut) = ( $site =~ m/^(?:\((\w+\/\w+)\))?([\w^]+)(?:\((\w+\/\w+)\))?/ ); + my ($precut, $recog, $postcut) = ( $site =~ m/^(?:\((-?\w+\/-?\w+)\))?([\w^]+)(?:\((-?\w+\/-?\w+)\))?/ ); # From maj at dev.open-bio.org Tue Feb 23 19:37:09 2010 From: maj at dev.open-bio.org (Mark Allen Jensen) Date: Tue, 23 Feb 2010 19:37:09 -0500 Subject: [Bioperl-guts-l] [16875] bioperl-live/trunk/t/Restriction/Analysis-refac.t: added Emmanuel' s tests for bug3015 patch Message-ID: <201002240037.o1O0b92N005818@dev.open-bio.org> Revision: 16875 Author: maj Date: 2010-02-23 19:37:09 -0500 (Tue, 23 Feb 2010) Log Message: ----------- added Emmanuel's tests for bug3015 patch Modified Paths: -------------- bioperl-live/trunk/t/Restriction/Analysis-refac.t Modified: bioperl-live/trunk/t/Restriction/Analysis-refac.t =================================================================== --- bioperl-live/trunk/t/Restriction/Analysis-refac.t 2010-02-24 00:36:34 UTC (rev 16874) +++ bioperl-live/trunk/t/Restriction/Analysis-refac.t 2010-02-24 00:37:09 UTC (rev 16875) @@ -1,151 +1,270 @@ -#-*-perl-*- -# $Id$ -use strict; -use warnings; -use Bio::Root::Test; -use Bio::PrimarySeq; - -use lib '.'; - -test_begin(-tests => 29); - -use_ok( 'Bio::Restriction::IO' ); -use_ok( 'Bio::Restriction::Analysis' ); - -# recog sites (not nec. cut sites!) in lc - -my $seq = new Bio::PrimarySeq( - -seq => 'gtcGaagcttAGCAAACGGTTTCTACgacgttatcgtcATTCGGGgcaagcgTCGGCGATTCGGACGTGcacctgcAAAtGCGCGGCgTTAgcgaggtgGCGAgacttttatgtcCCCCTgaagcggttattggTTATATGGTGTTCGTgaccgaTCTAATCCATATTTATTTTTGGCAGTGCtgggtgTTACgacTCGCGA', - -primary_id => 'test', - -molecule => 'dna' -); - -# the test enzymes [rebase characterization]: -# nonambig intrasite cutter: HindIII [ A^AGCTT ] -# ambig intrasite cutter: AasI [ GACNNNN^NNGTC ] -# nonambig extrasite cutter: AarI [ CACCTGC(4/8) ] -# ambig extrasite cutter: BceSI [ SSAAGCG(27/27) ] -# ambig center cutter: AjuI [ (7/12)GAANNNNNNNTTGG(11/6) ] -# multi extrasite cutter: TaqII [ GACCGA(11/9),CACCCA(11/9) ] - -# the test sequence *cut* (not site) map (recog sites in lc) - -#+ AasI(circ) -#+ HindIII AasI -# 1 CTCGaagcttAGCAAACGGTTTCTACgacgttatcgtcATTCGGGgcaagcgTCGGCGAT 60 -#- IIIdniH IsaA - - -#+ BceSI AjuI -#+ AarI AasI -# 61 TCGGACGTGcacctgcAAATGCGCGGCgTTAgcgaggtgGCGAgacttttatgtcCCCCT 120 -#- IraA IsaA -#- ISecB IujA - -#+ IIqaT -#+ AjuI TaqII -# 121 gaagcggttattggTTATATGGTGTTCGTgaccgaTCTAATCCATATTTATTTTTGGCAG 180 -#- IujA IIqaT -#- TaqII - -#+ -# 181 TGCtgggtgTTACgacTCGCGA 202 -#- (cric)IsaA - -# so we have +/- cut sites (tpi's, not nt's), in positive strand -# coordinates: -# HindIII : (5, 9) -# AasI : (33, 31), (110,108) -# AasI : (200,202=0) when circularized -# BceSI : (79, 79) -# AarI : (80, 84) -# AjuI : (145, 140) / (113, 108) -# TaqII : (166, 164) / (174, 172) - -ok( my $rebase_io = Bio::Restriction::IO->new( - -file => test_input_file('withrefm.906'), - -format => 'withrefm', - ), 'read withrefm file'); - -ok( my $rebase_cln = $rebase_io->read, 'parse withrefm file'); - -# examples -# ambiguous, nonamibiguous X intrasite, extrasite -ok( my $ninz = $rebase_cln->get_enzyme('HindIII'), 'HindIII: nonambiguous intrasite cutter'); -ok( my $nexz = $rebase_cln->get_enzyme('AarI'), 'AarI: nonambiguous extrasite cutter'); -ok( my $ainz = $rebase_cln->get_enzyme('AasI'), 'AasI: ambiguous intrasite cutter' ); -ok( my $aexz = $rebase_cln->get_enzyme('BceSI'), 'BceSI: ambiguous extrasite cutter' ); -# central recognition site: (s/t)[site](m/n) -ok( my $cenz = $rebase_cln->get_enzyme('AjuI'), 'AjuI: cutter with central recog site'); -# multisite extrasite: -ok (my $menz = $rebase_cln->get_enzyme('TaqII'), 'TaqII: multi-extrasite cutter'); - -ok (my $examples = Bio::Restriction::EnzymeCollection->new( - -enzymes=>[$ninz,$ainz, $ainz, $aexz, $cenz, $menz] - ) ); - - -# build pretend analysis object to test internals - -my $an = {}; -bless($an, 'Bio::Restriction::Analysis'); -$an->seq($seq); - -my ($plus_sites, $minus_sites); -# intrasite cutters - -$plus_sites = $an->_make_cuts( $seq->seq, $ninz ); -$minus_sites = $an->_make_cuts( $seq->seq, $ninz,'COMP' ); -is_deeply( $plus_sites, [5], 'HindIII plus'); -is_deeply( $minus_sites, [9], 'HindIII minus'); - -$plus_sites = $an->_make_cuts( $seq->seq, $ainz ); -$minus_sites = $an->_make_cuts( $seq->seq, $ainz,'COMP' ); -is_deeply( $plus_sites, [33, 110], 'AasI plus'); -is_deeply( $minus_sites, [31, 108], 'AasI minus'); - -# extrasite cutters - -$plus_sites = $an->_make_cuts( $seq->seq, $nexz ); -$minus_sites = $an->_make_cuts( $seq->seq, $nexz, 'COMP'); -is_deeply( $plus_sites, [80], 'AarI plus'); -is_deeply( $minus_sites, [84], 'AarI minus'); - -$plus_sites = $an->_make_cuts( $seq->seq, $aexz ); -$minus_sites = $an->_make_cuts( $seq->seq, $aexz, 'COMP'); -is_deeply( $plus_sites, [79], 'BceSI plus'); -is_deeply( $minus_sites, [79], 'BceSI minus'); - -# central site cutter -$plus_sites = $an->_make_cuts( $seq->seq, $cenz ); -$minus_sites = $an->_make_cuts( $seq->seq, $cenz, 'COMP'); - -is_deeply( $plus_sites, [145, 113], 'AjuI plus'); -is_deeply( $minus_sites, [140, 108], 'AjuI minus'); - -# multisite extrasite cutter -$plus_sites = $an->_make_cuts( $seq->seq, $menz ); -$minus_sites = $an->_make_cuts( $seq->seq, $menz, 'COMP' ); - -is_deeply( $plus_sites, [166, 174], 'TaqII plus'); -is_deeply( $minus_sites, [164, 172], 'TaqII minus'); - -# real Analysis object -# start restriction analysis -ok( my $analysis = Bio::Restriction::Analysis->new( - -seq => $seq, - -enzymes => $rebase_cln - ), "build real B:R::Analysis object"); - -# retrieve fragment map -my @fm = $analysis->fragment_maps($examples); -is( @fm, 13, '13 fragments'); -# circularize -ok( $seq->is_circular(1), 'circularize'); -ok( $analysis->cut, 'recut'); - at fm = $analysis->fragment_maps($examples); -is_deeply( [$analysis->positions('AasI')], [33, 110, 200], 'circ: AasI -site at origin' ); -is( @fm, 13, 'circ: still 13 fragments (cut site at origin)'); - -1; +#-*-perl-*- +# $Id$ +use strict; +use warnings; +use Bio::Root::Test; +use Bio::PrimarySeq; + +use lib '.'; + +test_begin(-tests => 91); + +use_ok( 'Bio::Restriction::IO' ); +use_ok( 'Bio::Restriction::Analysis' ); +use_ok('Bio::Restriction::EnzymeCollection'); +use_ok('Bio::Restriction::Enzyme'); + +# recog sites (not nec. cut sites!) in lc + +my $seq = new Bio::PrimarySeq( + -seq => 'gtcGaagcttAGCAAACGGTTTCTACgacgttatcgtcATTCGGGgcaagcgTCGGCGATTCGGACGTGcacctgcAAAtGCGCGGCgTTAgcgaggtgGCGAgacttttatgtcCCCCTgaagcggttattggTTATATGGTGTTCGTgaccgaTCTAATCCATATTTATTTTTGGCAGTGCtgggtgTTACgacTCGCGA', + -primary_id => 'test', + -molecule => 'dna' +); + +# the test enzymes [rebase characterization]: +# nonambig intrasite cutter: HindIII [ A^AGCTT ] +# ambig intrasite cutter: AasI [ GACNNNN^NNGTC ] +# nonambig extrasite cutter: AarI [ CACCTGC(4/8) ] +# ambig extrasite cutter: BceSI [ SSAAGCG(27/27) ] +# ambig center cutter: AjuI [ (7/12)GAANNNNNNNTTGG(11/6) ] +# multi extrasite cutter: TaqII [ GACCGA(11/9),CACCCA(11/9) ] + +# the test sequence *cut* (not site) map (recog sites in lc) + +#+ AasI(circ) +#+ HindIII AasI +# 1 CTCGaagcttAGCAAACGGTTTCTACgacgttatcgtcATTCGGGgcaagcgTCGGCGAT 60 +#- IIIdniH IsaA + + +#+ BceSI AjuI +#+ AarI AasI +# 61 TCGGACGTGcacctgcAAATGCGCGGCgTTAgcgaggtgGCGAgacttttatgtcCCCCT 120 +#- IraA IsaA +#- ISecB IujA + +#+ IIqaT +#+ AjuI TaqII +# 121 gaagcggttattggTTATATGGTGTTCGTgaccgaTCTAATCCATATTTATTTTTGGCAG 180 +#- IujA IIqaT +#- TaqII + +#+ +# 181 TGCtgggtgTTACgacTCGCGA 202 +#- (cric)IsaA + +# so we have +/- cut sites (tpi's, not nt's), in positive strand +# coordinates: +# HindIII : (5, 9) +# AasI : (33, 31), (110,108) +# AasI : (200,202=0) when circularized +# BceSI : (79, 79) +# AarI : (80, 84) +# AjuI : (145, 140) / (113, 108) +# TaqII : (166, 164) / (174, 172) + +ok( my $rebase_io = Bio::Restriction::IO->new( + -file => test_input_file('withrefm.906'), + -format => 'withrefm', + ), 'read withrefm file'); + +ok( my $rebase_cln = $rebase_io->read, 'parse withrefm file'); + +# examples +# ambiguous, nonamibiguous X intrasite, extrasite +ok( my $ninz = $rebase_cln->get_enzyme('HindIII'), 'HindIII: nonambiguous intrasite cutter'); +ok( my $nexz = $rebase_cln->get_enzyme('AarI'), 'AarI: nonambiguous extrasite cutter'); +ok( my $ainz = $rebase_cln->get_enzyme('AasI'), 'AasI: ambiguous intrasite cutter' ); +ok( my $aexz = $rebase_cln->get_enzyme('BceSI'), 'BceSI: ambiguous extrasite cutter' ); +# central recognition site: (s/t)[site](m/n) +ok( my $cenz = $rebase_cln->get_enzyme('AjuI'), 'AjuI: cutter with central recog site'); +# multisite extrasite: +ok (my $menz = $rebase_cln->get_enzyme('TaqII'), 'TaqII: multi-extrasite cutter'); + +ok (my $examples = Bio::Restriction::EnzymeCollection->new( + -enzymes=>[$ninz,$ainz, $ainz, $aexz, $cenz, $menz] + ) ); + + +# build pretend analysis object to test internals + +my $an = {}; +bless($an, 'Bio::Restriction::Analysis'); +$an->seq($seq); + +my ($plus_sites, $minus_sites); +# intrasite cutters + +$plus_sites = $an->_make_cuts( $seq->seq, $ninz ); +$minus_sites = $an->_make_cuts( $seq->seq, $ninz,'COMP' ); +is_deeply( $plus_sites, [5], 'HindIII plus'); +is_deeply( $minus_sites, [9], 'HindIII minus'); + +$plus_sites = $an->_make_cuts( $seq->seq, $ainz ); +$minus_sites = $an->_make_cuts( $seq->seq, $ainz,'COMP' ); +is_deeply( $plus_sites, [33, 110], 'AasI plus'); +is_deeply( $minus_sites, [31, 108], 'AasI minus'); + +# extrasite cutters + +$plus_sites = $an->_make_cuts( $seq->seq, $nexz ); +$minus_sites = $an->_make_cuts( $seq->seq, $nexz, 'COMP'); +is_deeply( $plus_sites, [80], 'AarI plus'); +is_deeply( $minus_sites, [84], 'AarI minus'); + +$plus_sites = $an->_make_cuts( $seq->seq, $aexz ); @@ Diff output truncated at 10000 characters. @@ From bugzilla-daemon at portal.open-bio.org Tue Feb 23 19:37:54 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 23 Feb 2010 19:37:54 -0500 Subject: [Bioperl-guts-l] [Bug 3015] Bug in regex parsing withrefm enzyme cutting site In-Reply-To: Message-ID: <201002240037.o1O0bs6s012021@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=3015 maj at fortinbras.us changed: What |Removed |Added ---------------------------------------------------------------------------- Status|NEW |RESOLVED Resolution| |FIXED ------- Comment #3 from maj at fortinbras.us 2010-02-23 19:37 EST ------- patched and added tests at r16874/5. Thanks! MAJ -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From miraceti at dev.open-bio.org Tue Feb 23 22:00:00 2010 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Tue, 23 Feb 2010 22:00:00 -0500 Subject: [Bioperl-guts-l] [16876] bioperl-live/trunk/Bio/TreeIO/phyloxml.pm: bugfix provided by Ivica : print bootstrap and branchlength Message-ID: <201002240300.o1O300OS009778@dev.open-bio.org> Revision: 16876 Author: miraceti Date: 2010-02-23 22:00:00 -0500 (Tue, 23 Feb 2010) Log Message: ----------- bugfix provided by Ivica: print bootstrap and branchlength Modified Paths: -------------- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm =================================================================== --- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2010-02-24 00:37:09 UTC (rev 16875) +++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2010-02-24 03:00:00 UTC (rev 16876) @@ -345,7 +345,6 @@ } # check if rooted my ($b_rooted) = $tree->get_tag_values('rooted'); - print "b_rooted: $b_rooted\n" if $b_rooted; if ($b_rooted) { $attr_str .= " rooted=\"true\""; } @@ -483,12 +482,12 @@ $str .= $node->id; $str .= ""; } - elsif ($node->branch_length) { + if ($node->branch_length) { $str .= ""; $str .= $node->branch_length; $str .= ""; } - elsif ($node->bootstrap) { + if ($node->bootstrap) { $str .= ""; $str .= $node->bootstrap; $str .= ""; From bugzilla-daemon at portal.open-bio.org Wed Feb 24 15:55:47 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Wed, 24 Feb 2010 15:55:47 -0500 Subject: [Bioperl-guts-l] [Bug 2975] Network access despite network tests skipped. In-Reply-To: Message-ID: <201002242055.o1OKtl6S015927@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=2975 ------- Comment #2 from cjfields at bioperl.org 2010-02-24 15:55 EST ------- Charles, Would you happen to know what XML::SAX parser backend is being installed fpr these (XML::SAX::Expat, XML::SAX::ExpatXS, XML::LibXML, etc)? This sounds like a bug where the parser is attempting to validate the XML (thus needing net access); XML validation should be turned off by default in all cases, so shouldn't require networking. Seeing at least one CPAN Testers example of this, and it looks like a possibe bad XML::SAX backend: http://www.cpantesters.org/cpan/report/5516178 -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee. From nml5566 at dev.open-bio.org Thu Feb 25 19:51:12 2010 From: nml5566 at dev.open-bio.org (Nathan Liles) Date: Thu, 25 Feb 2010 19:51:12 -0500 Subject: [Bioperl-guts-l] [16877] bioperl-live/trunk/Bio/PrimarySeq.pm: patched Bio::PrimarySeq. pm to deal with new circular revision genbank spec Message-ID: <201002260051.o1Q0pCcx023375@dev.open-bio.org> Revision: 16877 Author: nml5566 Date: 2010-02-25 19:51:11 -0500 (Thu, 25 Feb 2010) Log Message: ----------- patched Bio::PrimarySeq.pm to deal with new circular revision genbank spec Modified Paths: -------------- bioperl-live/trunk/Bio/PrimarySeq.pm Modified: bioperl-live/trunk/Bio/PrimarySeq.pm =================================================================== --- bioperl-live/trunk/Bio/PrimarySeq.pm 2010-02-24 03:00:00 UTC (rev 16876) +++ bioperl-live/trunk/Bio/PrimarySeq.pm 2010-02-26 00:51:11 UTC (rev 16877) @@ -398,14 +398,24 @@ if( $start <= 0 ) { $self->throw("Bad start parameter ($start). Start must be positive."); } - if( $end > $self->length ) { - $self->throw("Bad end parameter ($end). End must be less than the total length of sequence (total=".$self->length.")"); - } # remove one from start, and then length is end-start $start--; my @ss_args = map { eval "defined $_" ? $_ : () } qw( $self->{seq} $start $end-$start $replace); my $seqstr = eval join( '', "substr(", join(',', at ss_args), ")"); + + if( $end > $self->length) { + if ($self->is_circular) { + my $start = 0; + my $end = $end - $self->length; + my @ss_args = map { eval "defined $_" ? $_ : () } qw( $self->{seq} $start $end-$start $replace); + my $appendstr = eval join( '', "substr(", join(',', at ss_args), ")"); + $seqstr .= $appendstr; + } else { + $self->throw("Bad end parameter ($end). End must be less than the total length of sequence (total=".$self->length.")") + } + } + $seqstr =~ s/[$GAP_SYMBOLS]//g if ($nogap); return $seqstr; From bugzilla-daemon at portal.open-bio.org Fri Feb 26 00:13:31 2010 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Fri, 26 Feb 2010 00:13:31 -0500 Subject: [Bioperl-guts-l] [Bug 2975] Network access despite network tests skipped. In-Reply-To: Message-ID: <201002260513.o1Q5DVxS005309@portal.open-bio.org> http://bugzilla.open-bio.org/show_bug.cgi?id=2975 ------- Comment #3 from plessy at debian.org 2010-02-26 00:13 EST ------- Very good point! Installing XML::SAX::ExpatXS before building BioPerl completely solved the problem. Many thanks for your help! -- Configure bugmail: http://bugzilla.open-bio.org/userprefs.cgi?tab=email ------- You are receiving this mail because: ------- You are the assignee for the bug, or are watching the assignee.