[Bioperl-guts-l] bioperl-run/Bio/Tools/Run RNAMotif.pm,1.2,1.3
Christopher John Fields
cjfields at dev.open-bio.org
Sun Feb 4 22:07:26 EST 2007
Update of /home/repository/bioperl/bioperl-run/Bio/Tools/Run
In directory dev.open-bio.org:/tmp/cvs-serv13369
Modified Files:
RNAMotif.pm
Log Message:
Allow outfile or tempfile (for downstream work)
Index: RNAMotif.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-run/Bio/Tools/Run/RNAMotif.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** RNAMotif.pm 4 Feb 2007 23:59:13 -0000 1.2
--- RNAMotif.pm 5 Feb 2007 03:07:24 -0000 1.3
***************
*** 65,71 ****
=head1 DESCRIPTION
! 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
=head1 FEEDBACK
--- 65,78 ----
=head1 DESCRIPTION
! 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
! using the '-outfile_name' or '-tempfile' parameters; this is primarily for
! saving output from the rm2ct program, which currently does not have a parser
! available. If both a named output file and tempfile flag are set, the output
! file name is used. The default setting is piping output into a filehandle for
! parsing (or output to STDERR, for rm2ct which requires '-verbose' set to 1).
=head1 FEEDBACK
***************
*** 120,124 ****
# 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);
=head2 new
--- 127,131 ----
# 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
***************
*** 135,146 ****
my ($class, at args) = @_;
my $self = $class->SUPER::new(@args);
! my ($outfile) = $self->_rearrange([qw(OUTFILE_NAME)], @args);
! $outfile && $self->outfile_name($outfile);
$self->io->_initialize_io();
$self->_set_from_args(\@args,
-methods => [@RNAMOTIF_PARAMS],
-create => 1
);
-
return $self;
}
--- 142,161 ----
my ($class, at args) = @_;
my $self = $class->SUPER::new(@args);
! my ($out, $tf) = $self->_rearrange([qw(OUTFILE_NAME TEMPFILE)], @args);
$self->io->_initialize_io();
+ if ($tf && !$out) {
+ my ($tfh, $outfile) = $self->io->tempfile(-dir=>$self->tempdir());
+ close($tfh);
+ undef $tfh;
+ $self->outfile_name($outfile);
+ } else {
+ $out ||= '';
+ $self->outfile_name($out);
+ }
+ $tf && $self->tempfile($tf);
$self->_set_from_args(\@args,
-methods => [@RNAMOTIF_PARAMS],
-create => 1
);
return $self;
}
***************
*** 229,257 ****
sub _run {
my ($self,$file)= @_;
! my $str = $self->executable;
! my $outfile = $self->outfile_name;
! #$self->debug("Params:",$self->_setparams,"\n");
! my $param_str = $self->arguments." ".$self->_setparams;
! $str .= "$param_str ".$file;
!
! my $progname = $self->program_name;
! if ($self->prune && $progname eq 'rnamotif') {
! $str .= ' | rmprune';
! }
$self->debug("RNAMotif command: $str\n");
! # small sanity check
! $self->throw("Unknown program: $progname") if (!exists $RNAMOTIF_PROGS{$progname} );
! if($progname eq 'rnamotif' || $progname eq 'rmprune' ){
! my $fh;
! open($fh,"$str |") || $self->throw("RNAMotif call ($str) crashed: $?\n");
! return Bio::SearchIO->new(-fh => $fh,
-verbose => $self->verbose,
! -format => "rnamotif");
! } elsif ($progname eq 'rmfmt' && $self->can('a') && $self->a) {
! my $fh;
! open($fh,"$str |") || $self->throw("RNAMotif call ($str) crashed: $?\n");
! return Bio::AlignIO->new(-fh => $fh,
-verbose => $self->verbose,
-format =>'fasta');
} else {
# for rm2ct, possibly SeqIO-based?
--- 244,282 ----
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?
***************
*** 282,289 ****
sub _setparams {
! my ($self) = @_;
my $param_string;
my @params;
! foreach my $attr (@RNAMOTIF_PARAMS){
next if ($attr =~/PROGRAM|DB|PRUNE/i);
my $value = $self->$attr();
--- 307,321 ----
sub _setparams {
! my ($self, $file) = @_;
! my $progname = $self->program_name;
! # small sanity check
! $self->throw("Unknown program: $progname") if
! (!exists $RNAMOTIF_PROGS{$progname} );
!
my $param_string;
+ my $outfile = ($self->outfile_name) ? ' > '.$self->outfile_name : '';
+
my @params;
! foreach my $attr (@RNAMOTIF_PARAMS) {
next if ($attr =~/PROGRAM|DB|PRUNE/i);
my $value = $self->$attr();
***************
*** 300,304 ****
--- 332,345 ----
}
}
+
$param_string = join ' ', @params;
+ $param_string .= ' '.$file;
+
+ if ($self->prune && $self->program_name eq 'rnamotif') {
+ $param_string .= ' | rmprune';
+ }
+
+ $param_string .= $outfile;
+
return $param_string;
}
***************
*** 329,331 ****
--- 370,378 ----
}
+ sub tempfile {
+ my $self = shift;
+ return $self->{'_tempfile'} = shift if @_;
+ return $self->{'_tempfile'};
+ }
+
1;
More information about the Bioperl-guts-l
mailing list