t/DBQual.t

   1 BEGIN {
   2     use lib 't/lib';
   3     use BioperlTest;
   4
   5     test_begin( -tests => 38,
   6                 -requires_module => 'Bio::DB::Qual');
   7
   8     use_ok('Bio::Root::IO');
   9     use_ok('File::Copy');
  10 }
  11
  12 my $DEBUG = test_debug();
  13
  14 # this obfuscation is to deal with lockfiles by GDBM_File which can
  15 # only be created on local filesystems apparently so will cause test
  16 # to block and then fail when the testdir is on an NFS mounted system
  17
  18 my $io = Bio::Root::IO->new(-verbose => $DEBUG);
  19 my $tempdir = $io->tempdir('CLEANUP' => 1);
  20 my $test_dbdir = $io->catfile($tempdir, 'dbqual');
  21 mkdir($test_dbdir); # make the directory
  22 my $indir = test_input_file('dbqual');
  23 opendir(INDIR,$indir) || die("cannot open dir $indir");
  24 # effectively do a cp -r but only copy the files that are in there, no subdirs
  25 for my $file ( map { $io->catfile($indir,$_) } readdir(INDIR) ) {
  26     next unless (-f $file );
  27     copy($file, $test_dbdir);
  28 }
  29 closedir(INDIR);
  30
  31 # now use this temporary dir for the db file
  32 my $db = Bio::DB::Qual->new($test_dbdir, -reindex => 1);
  33 ok($db);
  34 my @ids = $db->ids;
  35 is(scalar(@ids), 15);
  36 @ids = sort {$a <=> $b} @ids;
  37 is($ids[0], '17601976');
  38 is($ids[14], '17601991');
  39 my $seqid = '17601979';
  40
  41 # direct indexed qual file database access
  42 is(ref($db->qual($seqid)), 'ARRAY');
  43 is($db->length($seqid), 14);
  44 is($db->length($seqid.':3,12'), 10);
  45 is($db->length($seqid, -1000, 1000), 14);
  46 ok($db->header($seqid));
  47
  48 # the bioperl  way
  49 my $obj = $db->get_Qual_by_id($seqid);
  50 ok(!defined $db->get_Qual_by_id('foobarbaz'));
  51 isa_ok($obj, 'Bio::Seq::PrimaryQual');
  52 is(ref($obj->qual($seqid)), 'ARRAY');
  53 is($obj->length, 14);
  54 ok($obj->id);
  55 ok($obj->display_id);
  56 ok($obj->accession_number);
  57 ok($obj->primary_id);
  58 is($obj->validate_qual($obj, (join ' ', @{$obj->qual($seqid)})), 1);
  59 is($obj->translate, 0);
  60 is($obj->qualat(12), 31);
  61 ok(!defined($obj->header));
  62 ok(!defined($obj->desc));
  63 my $truncobj = $obj->trunc(1,3);
  64 isa_ok($truncobj, 'Bio::Seq::PrimaryQual');
  65 is(ref($truncobj->qual($seqid)), 'ARRAY');
  66 is($truncobj->length, 3);
  67 my $revobj = $obj->revcom;
  68 isa_ok($revobj, 'Bio::Seq::PrimaryQual');
  69 is(ref($revobj->qual), 'ARRAY');
  70 is($revobj->length, 14);
  71 undef $obj;
  72 undef $truncobj;
  73 undef $revobj;
  74
  75 # using get_PrimaryQual_stream streaming
  76 my $stream  = $db->get_PrimaryQual_stream;
  77 ok($stream);
  78 my $streamqual = $stream->next_seq;
  79 isa_ok($streamqual, 'Bio::Seq::PrimaryQual');
  80
  81 # using newFh streaming
  82 my $fh = Bio::DB::Qual->newFh($test_dbdir);
  83 ok($fh);
  84 my $fhqual = <$fh>;
  85 isa_ok($fhqual, 'Bio::Seq::PrimaryQual');
  86 undef $fh;
  87
  88 # tied-hash access
  89 my (%h,$dna1,$dna2);
  90 ok(tie(%h,'Bio::DB::Qual',$test_dbdir));
  91 ok($h{$seqid});
  92 ok($dna1 = $h{"$seqid:1,10"});
  93 ok($dna2 = $h{"$seqid:10,1"});