[Bioperl-guts-l] bioperl-run/Bio/Tools/Run RNAMotif.pm,1.3,1.4
Christopher John Fields
cjfields at dev.open-bio.org
Wed Feb 7 08:03:59 EST 2007
Update of /home/repository/bioperl/bioperl-run/Bio/Tools/Run
In directory dev.open-bio.org:/tmp/cvs-serv22369
Modified Files:
RNAMotif.pm
Log Message:
updates and small tweaks
Index: RNAMotif.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-run/Bio/Tools/Run/RNAMotif.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** RNAMotif.pm 5 Feb 2007 03:07:24 -0000 1.3
--- RNAMotif.pm 7 Feb 2007 13:03:57 -0000 1.4
***************
*** 28,33 ****
);
! my $factory = Bio::Tools::Run::RNAMotif->new('program' =>'rnamotif',
! 'prune' => 1,
@params);
--- 28,33 ----
);
! my $factory = Bio::Tools::Run::RNAMotif->new(-program =>'rnamotif',
! -prune => 1,
@params);
***************
*** 35,40 ****
# Returns a Bio::SearchIO object
! my $search = $factory->run($seq);
! my @feat;
while (my $result = $searchio->next_result){
while(my $hit = $result->next_hit){
--- 35,40 ----
# Returns a Bio::SearchIO object
! #my $searchio = $factory->run("B_sub.gb");
! my $searchio = $factory->run($seq);
while (my $result = $searchio->next_result){
while(my $hit = $result->next_hit){
***************
*** 67,71 ****
Wrapper module for Tom Macke and David Cases's RNAMotif suite of programs. This
allows running of rnamotif, rmprune, rm2ct, and rmfmt. Binaries are available at
! http://www.scripps.edu/mb/case/casegr-sh-3.5.html
This wrapper allows for one to save output to an optional named file or tempfile
--- 67,71 ----
Wrapper module for Tom Macke and David Cases's RNAMotif suite of programs. This
allows running of rnamotif, rmprune, rm2ct, and rmfmt. Binaries are available at
! http://www.scripps.edu/mb/case/casegr-sh-3.5.html.
This wrapper allows for one to save output to an optional named file or tempfile
***************
*** 76,79 ****
--- 76,89 ----
parsing (or output to STDERR, for rm2ct which requires '-verbose' set to 1).
+ WARNING: At this time, there is very little checking of parameter settings, so
+ one could have an error if setting the worng parameter for a program. Future
+ versions will likely add some error checking.
+
+ =head1 NOTES ON PROGRAM PARAMETERS
+
+ All program parameters are currently supported. Of note, the 'D' parameter, used
+ for setting the value of a variable to a value, is changed to 'set_var' to avoid
+ name collisions with 'd' (used for dumping internal data structures).
+
=head1 FEEDBACK
***************
*** 121,131 ****
use base qw(Bio::Root::Root Bio::Tools::Run::WrapperBase);
! my %RNAMOTIF_PROGS = map {$_ => 1} qw(rnamotif rm2ct rmfmt rmprune);
my %RNAMOTIF_SWITCHES = map {$_ => 1} qw(c d h p s v l a la context sh);
# order is important here
! my @RNAMOTIF_PARAMS=qw(c sh N d h p s v context setvar On I xdfname pre post
! descr xdescr fmt fmap l a la program db prune t);
=head2 new
--- 131,148 ----
use base qw(Bio::Root::Root Bio::Tools::Run::WrapperBase);
! # will move parameters to each program, use this for _set_params
! my %RNAMOTIF_PROGS =(
! rnamotif => [qw(c d h N O p s v context sh setvar I xdfname pre post
! descr xdescr fmt fmap )],
! rm2ct => [qw(t)],
! rmfmt => [qw(a l la smax td)],
! rmprune => [] # no params
! );
my %RNAMOTIF_SWITCHES = map {$_ => 1} qw(c d h p s v l a la context sh);
# order is important here
! my @RNAMOTIF_PARAMS=qw(program prune c sh N d h p s v context setvar O I
! xdfname pre post descr xdescr fmt fmap l a la t);
=head2 new
***************
*** 136,139 ****
--- 153,159 ----
Returns: Bio::Tools::Run::RNAMotif
Args : list of parameters
+ -tempfile => set tempfile flag (default 0)
+ -outfile_name => set file to send output to (default none)
+ -prune => set rmprune postprocess flag (default 0)
=cut
***************
*** 204,227 ****
my ($self) = @_;
return undef unless $self->executable;
! my $string = `rnamotif -v`;
my $v;
! if ($string =~ m{(\d+)}) {
$v = $1;
}
! return $v || $string;
}
=head2 run
! Title : run
! Usage : $obj->run($seqFile)
! Function: Runs HMMER and returns Bio::SearchIO
! Returns : A Bio::SearchIO
! Args : A Bio::PrimarySeqI or file name
=cut
! sub run{
my ($self, at seq) = @_;
if (ref $seq[0] && $seq[0]->isa("Bio::PrimarySeqI") ){# it is an object
my $infile1 = $self->_writeSeqFile(@seq);
--- 224,258 ----
my ($self) = @_;
return undef unless $self->executable;
! return $self->{'_progversion'} if $self->{'_progversion'};
! my $string = `rnamotif -v 2>&1`;
my $v;
! if ($string =~ m{([\d.]+)}) {
$v = $1;
}
! return $self->{'_progversion'} = $v || $string;
}
=head2 run
! Title : run
! Usage : $obj->run($seqFile)
! Function: Runs RNAMotif programs, returns Bio::SearchIO/Bio::AlignIO
! Returns : Depends on program:
! 'rnamotif' - returns Bio::SearchIO
! 'rmfmt -a' - returns Bio::AlignIO
! all others - sends output to outfile, tempfile, STDERR
!
! Use search() (for Bio::SearchIO stream) or get_AlignIO() (for
! Bio::AlignIO stream) for a uniform Bioperl object interface.
!
! Args : A Bio::PrimarySeqI or file name
! Note : This runs any RNAMotif program set via program()
=cut
! sub run {
my ($self, at seq) = @_;
+ $self->throw ("Must pass a file name or a list of Bio::PrimarySeqI objects")
+ if (!@seq);
if (ref $seq[0] && $seq[0]->isa("Bio::PrimarySeqI") ){# it is an object
my $infile1 = $self->_writeSeqFile(@seq);
***************
*** 232,235 ****
--- 263,343 ----
}
+ =head2 search
+
+ Title : search
+ Usage : $searchio = $obj->search($seqFile)
+ Function: Runs 'rnamotif' on seqs, returns Bio::SearchIO
+ Returns : A Bio::SearchIO
+ Args : A Bio::PrimarySeqI or file name
+ Note : Runs 'rnamotif' only, regardless of program setting; all other
+ parameters loaded
+
+ =cut
+
+ sub search {
+ my ($self, at seq) = @_;
+ $self->throw ("Must pass a file name or a list of Bio::PrimarySeqI objects")
+ if (!@seq);
+ if (ref $seq[0] && $seq[0]->isa("Bio::PrimarySeqI") ){# it is an object
+ my $infile1 = $self->_writeSeqFile(@seq);
+ return $self->_run($infile1);
+ } else {
+ return $self->_run(@seq);
+ }
+ }
+
+ =head2 get_AlignIO
+
+ Title : get_AlignIO
+ Usage : $aln = $obj->get_AlignIO($seqFile)
+ Function: Runs 'rmfmt -a' on file, returns Bio::AlignIO
+ Returns : A Bio::AlignIO
+ Args : File name
+ Note : Runs 'rmfmt -a' only, regardless of program setting; only file
+ name and outfile (if any) are set
+
+ =cut
+
+ sub get_AlignIO {
+ my ($self, at seq) = @_;
+ $self->throw ("Must pass a file name")
+ if (!@seq && ref($seq[0]));
+ return $self->_run(@seq);
+ }
+
+ =head2 tempfile
+
+ Title : tempfile
+ Usage : $obj->tempfile(1)
+ Function: Set tempfile flag. When set, writes output to a tempfile; this
+ is overridden by outfile_name() if set
+ Returns : Boolean setting (or undef if not set)
+ Args : [OPTIONAL] Boolean
+
+ =cut
+
+ sub tempfile {
+ my $self = shift;
+ return $self->{'_tempfile'} = shift if @_;
+ return $self->{'_tempfile'};
+ }
+
+ =head2 prune
+
+ Title : prune
+ Usage : $obj->prune(1)
+ Function: Set rmprune flag. When set, follows any searches with a call to
+ rmprune (this deletes some redundant sequence hits)
+ Returns : Boolean setting (or undef if not set)
+ Args : [OPTIONAL] Boolean
+
+ =cut
+
+ sub prune {
+ my $self = shift;
+ return $self->{'_prune'} = shift if @_;
+ return $self->{'_prune'};
+ }
+
=head2 _run
***************
*** 237,241 ****
Usage : $obj->_run()
Function: Internal(not to be used directly)
! Returns : An array of Bio::SeqFeature::Generic objects
Args :
--- 345,349 ----
Usage : $obj->_run()
Function: Internal(not to be used directly)
! Returns :
Args :
***************
*** 243,296 ****
sub _run {
! my ($self,$file)= @_;
return unless $self->executable;
my ($str, $progname, $outfile) =
! ($self->executable, $self->program_name, $self->outfile_name);
my $param_str = $self->_setparams($file);
$str .= " $param_str";
$self->debug("RNAMotif command: $str\n");
! if($progname eq 'rnamotif' || $progname eq 'rmprune' ||
! ($progname eq 'rmfmt' && $self->can('a') && $self->a)) {
! if ($outfile) {
! my $status = system($str);
! if( !-e $outfile || -z $outfile ) {
! $self->warn( "RNAMotif call crashed: $! \n[command $str]\n");
! return undef;
! }
! if ( $progname eq 'rnamotif' || $progname eq 'rmprune') {
! return Bio::SearchIO->new(-file => $outfile,
! -verbose => $self->verbose,
! -format => "rnamotif")
! } else {
! return Bio::AlignIO->new(-file => $outfile,
! -verbose => $self->verbose,
! -format =>'fasta');
! }
! } else {
! open(my $fh,"$str |") || $self->throw("RNAMotif call ($str) crashed: $!\n");
! if ( $progname eq 'rnamotif' || $progname eq 'rmprune') {
! return Bio::SearchIO->new(-fh => $fh,
! -verbose => $self->verbose,
! -format => "rnamotif");
! } else {
! return Bio::AlignIO->new(-fh => $fh,
! -verbose => $self->verbose,
! -format =>'fasta');
! }
}
! } else {
! # for rm2ct, possibly SeqIO-based?
! my $status = open(my $OUT,"$str | ");
! my $io;
! while(<$OUT>) {
! $io .= $_;
}
! close($OUT);
! $self->debug($io) if $self->verbose > 0;
! unless( $status ) {
! $self->throw("RNAMotif call ($str) crashed: $?\n") unless $status==1;
}
- return 1;
}
}
--- 351,412 ----
sub _run {
! my ($self,$file,$prog)= @_;
return unless $self->executable;
+ $self->io->_io_cleanup();
my ($str, $progname, $outfile) =
! ($prog || $self->executable, $self->program_name, $self->outfile_name);
my $param_str = $self->_setparams($file);
+ my $descr = ($self->can('descr')) ? $self->descr :
+ ($self->can('xdescr')) ? $self->xdescr :
+ $self->throw("Must have a descriptor present!");
$str .= " $param_str";
$self->debug("RNAMotif command: $str\n");
!
! # rnamotif => SearchIO object
! # rmfmt -a => AlignIO object
! # all others sent to outfile, tempfile, or STDERR (upon verbose = 1)
!
! my $obj = ($progname eq 'rnamotif' || $progname eq 'rmprune' ) ?
! Bio::SearchIO->new(-verbose => $self->verbose,
! -format => "rnamotif",
! -version => $self->version,
! -database => $file,
! -model => $descr) :
! ($progname eq 'rmfmt' && $self->can('a') && $self->a) ?
! Bio::AlignIO->new(-verbose => $self->verbose, -format =>'fasta') :
! undef;
!
! my @args;
! # file-based
! if ($outfile) {
! my $status = system($str);
! if($status || !-e $outfile || -z $outfile ) {
! my $error = ($!) ? "$! Status: $status" : "Status: $status";
! $self->throw( "RNAMotif call crashed: $error \n[command $str]\n");
! return undef;
}
! if ($obj && ref($obj)) {
! $obj->file($outfile);
! @args = (-file => $outfile);
}
! # fh-based
! } else {
! open(my $fh,"$str |") || $self->throw("RNAMotif call ($str) crashed: $?\n");
! if ($obj && ref($obj)) {
! $obj->fh($fh);
! @args = (-fh => $fh);
! } else {
! # dump to debugging
! my $io;
! while(<$fh>) {$io .= $_;}
! close($fh);
! $self->debug($io);
! return 1;
}
}
+ # initialize SearchIO/AlignIO...um...IO
+ # (since file/fh set post obj construction)
+ $obj->_initialize_io(@args) if $obj && ref($obj);
+ return $obj || 1;
}
***************
*** 370,378 ****
}
- sub tempfile {
- my $self = shift;
- return $self->{'_tempfile'} = shift if @_;
- return $self->{'_tempfile'};
- }
-
1;
--- 486,488 ----
More information about the Bioperl-guts-l
mailing list