view release on metacpan or  search on metacpan

lib/Bio/Tools/Run/Infernal.pm  view on Meta::CPAN

        push @{$args{'param'}}, "-o $outfile" if $outfile;
    } elsif ($prog eq 'cmbuild') {
        $self->throw('cmbuild requires one alignment file') if
            !defined($aligns);
        if ($model) {
            push @{$args{'input'}}, ($model, @$aligns);
            push @{$args{'redirect'}}, "> $outfile" if $outfile;
        } else {
            push @{$args{'input'}}, ($outfile, @$aligns);
        }
    } elsif ($prog eq 'cmemit') {
        if (!$outfile) {
            $self->throw('cmemit requires an outfile_name; tempfile support not implemented yet');
        } else {
            push @{$args{'input'}}, ($model, ,$outfile);
        }
    }
    
    # quiet!
    if ($self->quiet && $prog ne 'cmsearch') {
        if ($prog eq 'cmalign') {
            push @{$args{switch}}, '-q' if !exists $params{q};
        } else {
            my $null = ($^O =~ m/mswin/i) ? 'NUL' : '/dev/null';
            push @{$args{redirect}}, "> $null";
        }
    }
    
    my $string = "$exe ".join(' ',(@{$args{switch}},
                                   @{$args{param}},
                                   @{$args{input}},
                                   @{$args{redirect}}));

    $string;
}

############### PRIVATE ###############

#=head2 _run
#
# Title   :   _run
# Usage   :   $obj->_run()
# Function:   Internal(not to be used directly)
# Returns :   
# Args    :
#
#=cut

{
    my %ALLOWED = map {$_ => 1} qw(run cmsearch cmalign cmemit cmbuild
    cmcalibrate cmstat cmscore);

sub _run {
    my ($self)= shift;
    
    my ($prog, $model, $out, $version) = ($self->program,
                                          $self->model_file,
                                          $self->outfile_name,
                                          $self->version);
    
    if (my $caller = (caller(1))[3]) {
        $caller =~ s{.*::(\w+)$}{$1};
        $self->throw("Calling _run() from disallowed method") unless exists $ALLOWED{$caller};
    } else {
        $self->throw("Can't call _run directly");
    }
    
    # a model and a file must be defined for all but cmemit; cmemit must have a
    # file or model defined (using $file if both are defined)
    
    # relevant files are passed on to the string builder
    my $str = $self->to_exe_string(@_);
    $self->debug("Infernal command: $str\n");
    
    my %has = $self->get_parameters('valid');
    
    my $obj =
        ($prog eq 'cmsearch') ? Bio::SearchIO->new(-format => 'infernal',
                                                -version => $version,
                                                -model => $model) :
        ($prog eq 'cmalign' )                              ? Bio::AlignIO->new(-format => 'stockholm') :
        ($prog eq 'cmemit' && $has{a}) ? Bio::AlignIO->new(-format => 'stockholm') :
        ($prog eq 'cmemit') ? Bio::SeqIO->new(-format => 'fasta') :
              undef;
    my @args;
    # file output
    if ($out) {
        my $status = system($str);
        if($status || !-e $out || -z $out ) {
            my $error = ($!) ? "$! Status: $status" : "Status: $status";
            $self->throw( "Infernal call crashed: $error \n[command $str]\n");
            return undef;
        }
        if ($obj && ref($obj)) {
            $obj->file($out);
            @args = (-file => $out);
        }
    # fh-based (no outfile)
    } else {
        open(my $fh,"$str |") || $self->throw("Infernal 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) if $io;
            return 1;
        }
    }
    $obj->_initialize_io(@args) if $obj && ref($obj);
    return $obj || 1;
}

}

=head2 _writeSeqFile

 Title   :   _writeSeqFile