view release on metacpan or  search on metacpan

t/Root/IO.t  view on Meta::CPAN

# -*-Perl-*- Test Harness script for Bioperl

use strict;
use warnings;

BEGIN {
    use lib '.';
    use Bio::Root::Test;
    test_begin(-tests => 154);
    use_ok 'Bio::Root::IO';
}


ok my $obj = Bio::Root::IO->new();
isa_ok $obj, 'Bio::Root::IO';


#############################################
# tests for exceptions/debugging/verbosity
#############################################

throws_ok { $obj->throw('Testing throw') } qr/Testing throw/, 'Throw';

$obj->verbose(-1);
throws_ok { $obj->throw('Testing throw') } qr/Testing throw/;

eval { $obj->warn('Testing warn') };
ok !$@, 'Warn';

$obj->verbose(1);
throws_ok { $obj->throw('Testing throw') } qr/Testing throw/;

ok my @stack = $obj->stack_trace(), 'Stack trace';
is scalar @stack, 2;

ok my $verbobj = Bio::Root::IO->new( -verbose => 1, -strict => 1 ), 'Verbosity';
is $verbobj->verbose(), 1;

ok $obj->verbose(-1);


#############################################
# tests for finding executables
#############################################

ok my $io = Bio::Root::IO->new();

# An executable file
my $out_file = 'test_file.txt';
my $out_fh;
open  $out_fh, '>', $out_file or die "Could not write file '$out_file': $!\n";
print $out_fh 'test';
close $out_fh;
# -X test file will fail in Windows regardless of chmod,
# because it looks for the executable suffix (like ".exe")
if ($^O =~ m/mswin/i) {
    # An executable file
    my $exec_file = 'test_exec.exe';
    open my $exe_fh, '>', $exec_file or die "Could not write file '$exec_file': $!\n";
    close $exe_fh;
    ok $obj->exists_exe($exec_file), 'executable file';
    unlink $exec_file or die "Could not delete file '$exec_file': $!\n";

    # A not executable file
    ok (! $obj->exists_exe($out_file), 'non-executable file');
    unlink $out_file  or die "Could not delete file '$out_file': $!\n";
}
else {
    # An executable file
    chmod 0777, $out_file or die "Could not change permission of file '$out_file': $!\n";
    ok $obj->exists_exe($out_file), 'executable file';

    # A not executable file
    chmod 0444, $out_file or die "Could not change permission of file '$out_file': $!\n";
    ok (! $obj->exists_exe($out_file), 'non-executable file');
    unlink $out_file or die "Could not delete file '$out_file': $!\n";
}

# An executable dir
my $out_dir = 'test_dir';
mkdir $out_dir or die "Could not write dir '$out_dir': $!\n";
chmod 0777, $out_dir or die "Could not change permission of dir '$out_dir': $!\n";
ok (! $obj->exists_exe($out_dir), 'executable dir');
rmdir $out_dir or die "Could not delete dir '$out_dir': $!\n";


#############################################
# tests for handle read and write abilities
#############################################

# Test catfile

ok my $in_file = Bio::Root::IO->catfile(qw(t data test.waba));
is $in_file, test_input_file('test.waba');

ok my $in_file_2 = Bio::Root::IO->catfile(qw(t data test.txt));

$out_file = test_output_file();


# Test with files

ok my $rio = Bio::Root::IO->new( -input => $in_file ), 'Read from file';
is $rio->file, $in_file;
is_deeply [$rio->cleanfile], [undef, $in_file];
is $rio->mode, 'r';
ok $rio->close;

ok $rio = Bio::Root::IO->new( -file => '<'.$in_file );
is $rio->file, '<'.$in_file;
is_deeply [$rio->cleanfile], ['<', $in_file];
1 while $rio->_readline; # read entire file content
is $rio->mode, 'r';
ok $rio->close;

ok my $wio = Bio::Root::IO->new( -file => ">$out_file" ), 'Write to file';
is $wio->file, ">$out_file";
is_deeply [$wio->cleanfile], ['>', $out_file];
is $wio->mode, 'w';
ok $wio->close;

ok $rio = Bio::Root::IO->new( -file => "+>$out_file" ), 'Read+write to file';
is $rio->file, "+>$out_file";
is_deeply [$rio->cleanfile], ['+>', $out_file];
is $rio->mode, 'rw';
ok $rio->close;


# Test with handles

my $in_fh;
open $in_fh , '<', $in_file  or die "Could not read file '$in_file': $!\n", 'Read from GLOB handle';
ok $rio = Bio::Root::IO->new( -fh => $in_fh );
is $rio->_fh, $in_fh;
is $rio->mode, 'r';
close $in_fh;

open $out_fh, '>', $out_file or die "Could not write file '$out_file': $!\n", 'Write to GLOB handle';
ok $wio = Bio::Root::IO->new( -fh => $out_fh );
is $wio->_fh, $out_fh;
is $wio->mode, 'w';
close $out_fh;