t/LocalDB/Index/BlastTable.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id: Blast.t 16293 2009-10-27 20:03:02Z cjfields $
   3
   4 use strict;
   5
   6 BEGIN {
   7         use lib '.';
   8         use Bio::Root::Test;
   9
  10         test_begin(-tests => 27,
  11                 -requires_module => 'IO::String');
  12
  13         use_ok('Cwd');
  14         use_ok('Bio::SearchIO');
  15         use_ok('Bio::Index::BlastTable');
  16 }
  17
  18                        # -m 9                -m 8
  19 my @test_cases = qw(multi.blast.m9      multi.blast.m8);
  20
  21 for my $file (@test_cases) {
  22     my $index = Bio::Index::BlastTable->new(-filename => 'Wibbl',
  23                                         -write_flag => 1);
  24     ok($index);
  25     $index->id_parser(\&my_id_parser);
  26     $index->make_index(test_input_file($file));
  27     ($index->dbm_package eq 'SDBM_File') ?
  28         (ok(-e "Wibbl.pag" && -e "Wibbl.dir")) :
  29         (ok(-e "Wibbl"));
  30
  31     foreach my $id ( qw(SP130_MOUSE IKZF1_MOUSE) ) {
  32         my $fh = $index->get_stream($id);
  33         ok($fh);
  34         ok( ! eof($fh) );
  35         my $report = Bio::SearchIO->new(-noclose => 1,
  36                        -format  => 'blasttable',
  37                        -fh      => $fh);
  38         my $result = $report->next_result;
  39         like($result->query_name, qr/$id/);
  40         ok( $result->next_hit);
  41
  42         like( $index->fetch_report($id)->query_name, qr/$id/);
  43     }
  44     # ActivePerl will not allow deletion if the tie-hash is still active
  45     $index->DESTROY;
  46     unlink qw( Wibbl Wibbl.pag Wibbl.dir Wibbl.index);
  47 }
  48
  49 # test id_parser
  50 sub my_id_parser {
  51     if ($_[0] =~ /^\S+\|(\S+)/) {
  52         return $1;
  53     } else {
  54         return;
  55     }
  56 }