The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -T
################################################################################
# some tests for helper functions
#
################################################################################

################################################################################

BEGIN{
    use Test::More;
    use Test::NoWarnings;
    use lib 't';
    use BioGrepSkip;
    my ($skip,$msg) = BioGrepSkip::skip_all( );
    plan skip_all => $msg if $skip;
}
plan tests => 30;

use BioGrepTest;

use Scalar::Util qw/tainted/;
use Cwd;

my @paths = ( '', '/', '/usr/local/bin' );

my $sbe = Bio::Grep->new();

my $result = Bio::Grep::SearchResult->new();

# todo make this platform independent
is( $sbe->_cat_path_filename( $paths[0], 't.txt' ), 't.txt', 'concat path' );

my $tainted_word    = 'bla' . substr( cwd, 0, 0 );
my $tainted_integer = '1' . substr( cwd,   0, 0 );
my $tainted_real    = '1.1' . substr( cwd, 0, 0 );

ok( tainted $tainted_word,    $tainted_word . ' tainted' );
ok( tainted $tainted_integer, $tainted_integer . ' tainted' );
ok( tainted $tainted_real,    $tainted_real . ' tainted' );

my $not_tainted_integer = $sbe->is_integer($tainted_integer);
ok( !tainted $not_tainted_integer, $not_tainted_integer . ' not tainted' );
my $not_tainted_word = $sbe->is_word($tainted_word);
ok( !tainted $not_tainted_word, $not_tainted_word . ' not tainted' );

is( $sbe->is_integer('1234'), 1234 );
eval { $sbe->is_integer('1234.5'); };
ok($EVAL_ERROR);
eval { $sbe->is_integer('10 && ls *'); };
ok($EVAL_ERROR);
is( $sbe->is_integer(undef), undef );


is( $sbe->is_word('1234'),           1234 );
is( $sbe->is_word('1234-valid.txt'), '1234-valid.txt' );
is( $sbe->is_word('1234-valid.txt_'), '1234-valid.txt_' );
eval { $sbe->is_word('valid && ls *'); };
ok($EVAL_ERROR);

eval { $sbe->is_arrayref_of_size('',2) };
cmp_ok($EVAL_ERROR, '=~', qr{Argument is not an array reference}, 
    'not an aref' );
eval { $sbe->is_arrayref_of_size({},2) };
cmp_ok($EVAL_ERROR, '=~', qr{Argument is not an array reference}, 
    'not an aref' );
eval { $sbe->is_arrayref_of_size([],2) };
cmp_ok($EVAL_ERROR, '=~', qr{Size of argument is too small}, 
    'Size of argument is too small' );

eval { $sbe->is_arrayref_of_size([ 'a', 'b', 'c' ],2) };
ok(!$EVAL_ERROR, 'ok' ) || diag $EVAL_ERROR;

no warnings;
eval {$sbe->_check_variable()};
cmp_ok($EVAL_ERROR, '=~', qr{Missing arguments: require hash with keys},
    "Exception with missing argument") || diag $EVAL_ERROR;
use warnings;
eval {$sbe->_check_variable( bla => 1 )};
cmp_ok($EVAL_ERROR, '=~', qr{Missing arguments: require hash with keys},
    "Exception with missing argument") || diag $EVAL_ERROR;

eval {$sbe->_check_variable( variable => 'bla',  regex => 'real' )};
cmp_ok($EVAL_ERROR, '=~', qr{Unknown regex},
    "Exception with unknown regex");

eval {$sbe->is_path('C:\My Programs', 'windows') };
ok(!$EVAL_ERROR, 'windows path ok') || diag $EVAL_ERROR;

$sbe=Bio::Grep->new('GUUGle');

ok($sbe->_rnas_match('agcua','agcua'), 'rna matching function');
ok(!$sbe->_rnas_match('agcuag','agcua'), 'rna matching function');
ok($sbe->_rnas_match('uguggu','cgcgau'), 'rna matching function');
ok($sbe->_rnas_match('uguggu','ugcggu'), 'rna matching function');
ok($sbe->_rnas_match('uguggu','cguggu'), 'rna matching function');
ok(!$sbe->_rnas_match('uguggu','cgcguu'), 'rna matching function');

my $tmp = $sbe->settings->tmppath;
$sbe->settings->datapath('data');
$sbe->settings->database('Test_DB_Big.fasta');
$sbe->settings->reverse_complement(1);

my $settings_dump =<<EOT
\$VAR1 = bless( {                               
                 'datapath' => 'data',
                 'no_alignments' => 0,
                 'execpath' => '',
                 'database' => 'Test_DB_Big.fasta',
                 'deletions' => '0',
                 'upstream' => '0',
                 'insertions' => '0',
                 'reverse_complement' => 1,
                 'direct_and_rev_com' => '',
                 'tmppath' => '$tmp',
                 'mismatches' => '',
                 'downstream' => '0',
                 'gumismatches' => 0
               }, 'Bio::Grep::SearchSettings' );
EOT
;

is_deeply(d2h($sbe->settings->to_string), d2h($settings_dump), 'Settings dump ok');
sub d2h {
    my ( $dump ) = @_;
    my %h;
    while ( $dump =~ m{ ^ \s+ '(.*?)' .*? > \s (.*?) [,]* $ }xmsg ) {
        my ($v1, $v2) = ($1, $2);
        $v2 =~ s/\'//g;
        $v2 = '' if !$v2;
        chomp $v2;
        $h{$v1} = $v2;
    }
    return \%h;
}

# vim: ft=perl sw=4 ts=4 expandtab