t/Root/Utilities.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4
   5 use strict;
   6
   7 BEGIN {
   8     use lib '.';
   9     use Bio::Root::Test;
  10
  11     test_begin(-tests => 56);
  12
  13     use_ok('Bio::Root::Utilities');
  14 }
  15
  16 # Object creation
  17 my $u = Bio::Root::Utilities->new();
  18 isa_ok($u, 'Bio::Root::Utilities') ;
  19
  20 # month2num() and num2month()
  21
  22 my @month = qw(XXX Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  23 for my $i (1 .. 12) {
  24   is $u->month2num($month[$i]), $i;
  25   is $u->num2month($i), $month[$i];
  26 }
  27
  28 # untaint()
  29
  30 is $u->untaint(''), '';
  31 is $u->untaint('nice string'), 'nice string';
  32 is $u->untaint('bad *?&^$! string'), 'bad ';
  33 is $u->untaint( q{100% relaxed&;''\"|*?!~<>^()[]{}$}, 1 ), '100% relaxed';
  34
  35 # mean_stdev()
  36
  37 my($mu,$sd);
  38
  39 ($mu,$sd) = $u->mean_stdev();
  40 is $mu, undef;
  41 is $sd, undef;
  42
  43 ($mu,$sd) = $u->mean_stdev(42);
  44 is $mu, 42;
  45 is $sd, undef;
  46
  47 ($mu,$sd) = $u->mean_stdev(-1,0,1);
  48 is $mu, 0;
  49 is $sd, 1;
  50
  51 # file_date(), file_flavor(), date_format()
  52
  53 my $file = test_input_file('test.txt');
  54 my $file2 = test_input_file('test 2.txt');
  55 my $fdate = $u->file_date($file);
  56 like $fdate ,  qr/\d{4}-\d{2}-\d{2}/, 'file_date()';
  57 ok $u->file_flavor($file), 'unix (\n or 012 or ^J)';
  58
  59 my $date = $u->date_format();
  60 like $date, qr/\d{4}-\d{2}-\d{2}/, 'date format';
  61 my $date2 = $u->date_format('yyyy-mmm-dd', $date);
  62 like $date2 , qr/\d{4}-[a-z]{3}-\d{2}/i, 'date format';
  63 my $date3 = $u->date_format('mdhms');
  64 like $date3 , qr/[a-z]{3}\d{1,2} \d{1,2}:\d{1,2}:\d{1,2}/, 'date format';
  65 my $date4 = $u->date_format('d-m-y', '11/22/60');
  66 like $date4 , qr/\d{1,2}-[a-z]{3}-\d{4}/i, 'date format';
  67 my $date5 = $u->date_format('mdy', '1/5/01');
  68 like $date5 , qr/[a-z]{3} \d{1,2}, \d{4}/i, 'date format';
  69
  70 # External executable-related functions.
  71
  72 my $exe = $u->find_exe('some-weird-thing-no-one-will-have');
  73 ok ! defined $exe ;
  74
  75 # compress() and uncompress() using gzip.
  76 SKIP: {
  77     my $gzip = $u->find_exe('gzip');
  78     skip "gzip not found, skipping gzip tests", 12 unless $gzip;
  79     ok -x $gzip;
  80
  81     # test compression/decompression of a simple file
  82     my $zfile = $u->compress($file);
  83
  84     # In Windows, the folder separator '\' may brake
  85     # the following qr{}, so change it to '/'
  86     $zfile =~ s'\\'/'g;
  87     $file  =~ s'\\'/'g;
  88
  89     like $zfile, qr/$file.gz|tmp.bioperl.gz/;
  90     ok -s $zfile;
  91     if ($zfile =~ /tmp.bioperl.gz/) {
  92         ok -e $file;
  93     }
  94     else {
  95         ok ! -e $file;
  96     }
  97     my $unzfile = $u->uncompress($zfile);
  98     ok ! -e $zfile;
  99     ok -e $file;
 100
 101     # test compression/decompression of a filename with spaces keeping the original intact
 102     my $zfile2 = $file2.'.gz';
 103     my $return = $u->compress(-file => $file2, -outfile => $zfile2, -tmp => 1);
 104     is $return, $zfile2;
 105     ok -e $zfile2;
 106     ok -e $file2;
 107     unlink $file2 or die "Problem deleting $file2: $!\n";
 108     $return = $u->uncompress(-file => $zfile2, -outfile => $file2, -tmp => 1);
 109     is $return, $file2;
 110     ok -e $file2;
 111     ok -e $zfile2;
 112     unlink $zfile2 or die "Problem deleting $zfile2: $!\n";
 113 }
 114
 115 # send_mail()
 116
 117 # $u->send_mail(-to=>'sac@bioperl.org',  # <--- your address here!
 118 #               -subj=>'Root-Utilities.t',
 119 #               -msg=>'Hey, your send_mail() method works!');