Bio-BPWrapper

 view release on metacpan or  search on metacpan

lib/Bio/BPWrapper.pm  view on Meta::CPAN

=head2 Common Subroutines

=head3 print_version $program_name

Show program name and version and exit

=cut


sub print_version($)
{
    my $program = shift;
    say "${program}, version $Bio::BPWrapper::VERSION";
    exit;
}

use Pod::Usage;

=head3 common_opts $opts

lib/Bio/BPWrapper.pm  view on Meta::CPAN

Show usage help

=item C<--man>

Show a manual page via L<Pod::Usage>

=back

=cut

sub common_opts($)
{
    my $opts = shift;
    pod2usage(1) if $opts->{"help"};
    pod2usage(-exitstatus => 0, -verbose => 2) if $opts->{"man"};
}


unless (caller) {
    print "Pssst... this is a module. Invoke via bioaln, bioseq, biopop, or biotree.\n";
}

lib/Bio/BPWrapper/AlnManipulations.pm  view on Meta::CPAN

    # This passes option name to all functions
    $opt_dispatch{$option}->($option)
}

=head2 write_out_paml()

Writes output in PAML format.

=cut

sub write_out_paml() {
    my @seq;
    my $ct=0;

    foreach my $seq ($aln->each_seq()) {
        my $id = $seq->display_id();
        if ($seq->seq() =~ /^-+$/) { print STDERR "all gaps: $file\t$id\n"; next }
        $ct++;
        push @seq, $seq
    }

lib/Bio/BPWrapper/AlnManipulations.pm  view on Meta::CPAN

Performs the bulk of the alignment actions actions set via
L<C<initialize(\%opts)>|/initialize> and calls
L<C<$AlignIO-E<gt>write_aln()>|https://metacpan.org/pod/Bio::AlignIO#write_aln>
or L<C<write_out_paml()>|/write_out_paml>.

Call this after calling C<#initialize(\%opts)>.

=cut

sub write_out($) {

    my $opts = shift;
    for my $option (keys %{$opts}) {
	next if ($option eq 'input') || ($option eq 'output') || ($option eq 'noflatname') || ($option eq 'binary'); # Don't process these options: they are for AlignIO

	if (can_handle($option)) { handle_opt($option) } # If there is a function to handle the current option, execute it
	else { warn "Missing handler for: $option\n" }
    }

lib/Bio/BPWrapper/AlnManipulations.pm  view on Meta::CPAN

}

=head2 get_unique()

Extract the alignment of unique sequences. Wraps
L<Bio::SimpleAlign-E<gt>uniq_seq()|https://metacpan.org/pod/Bio::SimpleAlign#uniq_seq>.

=cut


sub get_unique() {
    $aln->verbose(1);
    $aln = $aln->uniq_seq();
}

sub _has_gap {
    my $ref = shift;
    foreach (@$ref) {
	return 1 if $_ eq '-';
    }
    return 0;

t/Helper.pm  view on Meta::CPAN

require Exporter;
our (@ISA, @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(run_bio_program run_bio_program_nocheck test_file_name
             test_no_arg_opts test_one_arg_opts);

my $debug = $^W;

my $dirname = dirname(__FILE__);

sub test_file_name($)
{
    File::Spec->catfile($dirname, '..', 'test-files', shift)
}

# Runs bio program in a subshell. 0 is returned if everything went okay.
# nonzero if something went wrong. We check the results against
# $check_filename. Filenames are expanded to the proper locations
# in directories.
sub run_bio_program($$$$;$)
{
    my ($bio_program, $data_filename, $run_opts, $check_filename,
	$other_opts) = @_;
    $other_opts = {} unless defined $other_opts;
    $other_opts->{do_test} = 1 unless exists $other_opts->{do_test};

    my $full_data_filename = '';
    if ($data_filename ne '/dev/null') {
	$full_data_filename = test_file_name($data_filename);
    }

t/Helper.pm  view on Meta::CPAN

	    # code means some sort of failure.
	    $output = `diff $check_filename $got_filename 2>&1`
		if ($rc > 1) || ($rc < 0) ;
	    Test::More::diag($output);
	    return 1;
	}
    }
}

# Runs a bioprogram but skips output checking
sub run_bio_program_nocheck($$$;$)
{
    my ($bio_program, $data_filename, $run_opts, $other_opts) = @_;
    $other_opts = {} unless defined $other_opts;
    $other_opts->{do_test} = 1 unless exists $other_opts->{do_test};

    my $full_data_filename = '';
    if ($data_filename ne '/dev/null') {
	$full_data_filename = test_file_name($data_filename);
    }

t/Helper.pm  view on Meta::CPAN

    my $rc = $CHILD_ERROR >> 8;
    my $test_rc = $other_opts->{exitcode} || 0;
    if ($other_opts->{do_test}) {
	Test::More::note("testing " . $other_opts->{note}) if $other_opts->{note};
	Test::More::note( "running $bio_program $run_opts $full_data_filename" );
	Test::More::is($rc, $test_rc, "command ${bio_program} executed giving exit code $test_rc");
    }
    return $rc;
}

sub test_no_arg_opts($$$) {
    my ($bio_program, $data_filename, $notes) = @_;
    Test::More::note( "Testing ${bio_program} single-letter options on ${data_filename}" );
    for my $opt (keys %$notes) {
	run_bio_program($bio_program, $data_filename, "--${opt}", "opt-${opt}.right",
			{note=>$notes->{$opt}});
    }
}


sub test_one_arg_opts($$$) {
    my ($bio_program, $data_filename, $opts) = @_;

    for my $tup (@$opts) {
	my ($opt, $arg, $note) = @$tup;
	Test::More::note( "Testing ${bio_program} option-value options on ${data_filename}" );

	run_bio_program($bio_program, $data_filename, "--$opt $arg",
			"opt-$opt.right", {note=>$note});
    }
}