view release on metacpan or  search on metacpan

t/BEDTools.t  view on Meta::CPAN

                is( $bedtoolsfac->columns('2,3,5,6'), '2,3,5,6',
                    "can set parameter -columns => '2,3,5,6' " );
                ok( my $result = $bedtoolsfac->run( -bed => $bedpe1_file, ),
                    "can run command '$command'" );
                last;
            };
            m/^b12_to_b6$/ && do {
                ok( my $result = $bedtoolsfac->run( -bed => $bed12_file, ),
                    "can run command '$command'" );
                last;
            };
            m/^group_by$/ && do {
                is( $bedtoolsfac->group(1), 1,
                    "can set parameter -group => 1 " );
                is( $bedtoolsfac->columns('2,2,3,3'), '2,2,3,3',
                    "can set parameter -columns => '2,2,3,3' " );
                is( $bedtoolsfac->operations('min,max,min,max'), 'min,max,min,max',
                    "can set parameter -operations => 'min,max,min,max' " );
                ok( my $result = $bedtoolsfac->run( -bed => $bed3_file ),
                    "can run command '$command'" );
                last;
            };
            m/^graph_union$/ && do {
                ok( my $result = $bedtoolsfac->run( -bg => [$bg1_file, $bg2_file, $bg2_file] ),
                    "can run command '$command'" );
                last;
            };
            do {
                # we should never get here - internal test
                fail( "all commands tested - missed '$_'");
            };
        }

        $v && diag(" check file has been written");
        ok( eval { (-e $bedtoolsfac->result && -r _) }, "result files exists for command '$command'");
        $v && diag(" check can get internal result format description and confirm it");
        ok( my $format = $bedtoolsfac->result( -want => 'format' ),
            "can return output format for command '$command'" );
        like( $format, qr/(?:$format_lookup{$command})/,
            "result claims to be in correct format for command '$command'" );
        $v && diag(" check can get internal result file name value");
        ok( my $file = $bedtoolsfac->result(-want=>'raw'),
            "can return output file for command '$command'" );
        if ($command eq 'links') {
            $v && diag(" check result file is html and correct size");
            ok eval { (-e $file)&&(-r _) }, "make readable output";
            open (FILE, $file);
            my $lines =(my $first_line)= <FILE>;
            close FILE;
            like( $first_line, qr/\<html\>/, " - html tag line");
            is( $lines, $result_lookup{$command}, " - number of lines");
        } elsif ($command eq 'genome_coverage') {
            $v && diag(" check result file is correct size");
            ok eval { (-e $file)&&(-r _) }, "make readable output";
            open (FILE, $file);
            my $lines =()= <FILE>;
            close FILE;
            is( $lines, $result_lookup{$command}, " - number of lines");
        } else {
            $v && diag(" check can get internal result format matches result file");
            my $guesser = Bio::Tools::GuessSeqFormat->new( -file => $file );
            for ($format_lookup{$command}) {
                m/^(?:bed|bedpe|tab)$/ && do {
                    is( $guesser->guess, 'tab', "file format of '$file' consistent with claim for '$command'" );
                    last;
                };
                m/^fasta$/ && do {
                    is( $guesser->guess, 'fasta', "file format consistent with claim for '$command'" );
                }
            }
        }
        $v && diag(" check can get and set wanted result type");
        is( $bedtoolsfac->want('Bio::Root::IO'), 'Bio::Root::IO',
            "can set want to IO object for command '$command'" );
        $v && diag(" check can get a Bio::Root::IO object");
        ok( my $objres = $bedtoolsfac->result, "can get the basic object result for command '$command'" );
        $v && diag(" - check can it is actually a Bio::Root::IO object");
        isa_ok( $objres, 'Bio::Root::IO', "returned object is correct for command '$command'" );
        for ($format_lookup{$command}) {
            $v && diag(" check can can get format-specific result object if supported");
            m/(?:bed|bedpe)/ && do {
                $v && diag(" - Bio::SeqFeature::Collection");
                ok( my $objres = $bedtoolsfac->result( -want => 'Bio::SeqFeature::Collection' ),
                    "can get the specific object result for command '$command'" );
                isa_ok( $objres, 'Bio::SeqFeature::Collection',
                    "returned object is correct for command '$command'" );
                $v && diag(" - correct number of features");
                is( scalar $objres->get_all_features, $result_lookup{$command},
                    "correct number of features for command '$command'" );
                last;
            };
            m/^fasta$/ && do {
                $v && diag(" - Bio::SeqIO");
                ok( my $objres = $bedtoolsfac->result( -want => 'Bio::SeqIO' ),
                    "can get the specific object result for command '$command'" );
                isa_ok( $objres, 'Bio::SeqIO',
                    "returned object is correct for command '$command'" );
                my $seq_count = 0;
                while( my $seq = $objres->next_seq ) {
                    $seq_count++;
                }
                $v && diag(" - correct number of sequences");
                is( $seq_count, $result_lookup{$command}, "correct number of sequences for command '$command'" );
            }
        }
    }
}

1;