t/LocalDB/Qual.t

   1 BEGIN {
   2     use lib '.';
   3     use Bio::Root::Test;
   4
   5     test_begin( -tests => 56,
   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 {
  15
  16 my $test_dbdir = setup_temp_dir('dbqual');
  17
  18 # now use this temporary dir for the db file
  19 ok my $db = Bio::DB::Qual->new($test_dbdir, -reindex => 1);
  20 is $db->glob, '*.{qual,QUAL,qa,QA}';
  21 isa_ok $db, 'Bio::DB::Qual';
  22 ok my @ids = $db->ids;
  23 is scalar(@ids), 15;
  24 @ids = sort {$a <=> $b} @ids;
  25 is $ids[0] , '17601976';
  26 is $ids[14], '17601991';
  27 my $seqid = '17601979';
  28
  29 # direct indexed qual file database access
  30 is ref($db->qual($seqid)), 'ARRAY';
  31 is_deeply $db->qual($seqid), [23, 32, 24, 27, 26, 27, 27, 27, 28, 23, 28, 31, 23, 27];
  32 is $db->length($seqid), 14;
  33 is $db->length($seqid, -1000, 1000), 14; # length() ignores start and stop
  34 is $db->header($seqid), '17601979';
  35 is_deeply $db->qual($seqid, 2, 11), [32, 24, 27, 26, 27, 27, 27, 28, 23, 28];
  36 is_deeply $db->qual($seqid, 2, 11, 1), [32, 24, 27, 26, 27, 27, 27, 28, 23, 28];
  37 is_deeply $db->qual($seqid, 11, 2), [28, 23, 28, 27, 27, 27, 26, 27, 24, 32];
  38 is_deeply $db->qual($seqid, 2, 11, -1), [28, 23, 28, 27, 27, 27, 26, 27, 24, 32];
  39 is_deeply $db->qual($seqid, 11, 2, -1), [32, 24, 27, 26, 27, 27, 27, 28, 23, 28];
  40
  41 # the bioperl  way
  42 is $db->get_Qual_by_id('foobarbaz'), undef;
  43 ok my $obj = $db->get_Qual_by_id($seqid);
  44 isa_ok $obj, 'Bio::Seq::PrimaryQual::Qual';
  45 isa_ok $obj, 'Bio::Seq::QualI';
  46 is ref($obj->qual($seqid)), 'ARRAY';
  47 is $obj->length, 14;
  48 is $obj->id, '17601979';
  49 is $obj->display_id, '17601979';
  50 is $obj->accession_number, 'unknown';
  51 like $obj->primary_id, qr/^Bio::Seq::PrimaryQual::Qual=HASH/;
  52 is $obj->validate_qual( join(' ', @{$obj->qual($seqid)}) ), 1;
  53 is $obj->translate, 0;
  54 is $obj->qualat(12), 31;
  55 is_deeply $obj->subqual(2, 11), [32, 24, 27, 26, 27, 27, 27, 28, 23, 28];
  56 is $obj->header, undef;
  57 is $obj->desc, undef;
  58 ok my $truncobj = $obj->trunc(1,3);
  59 isa_ok $truncobj, 'Bio::Seq::PrimaryQual::Qual';
  60 isa_ok $obj, 'Bio::Seq::QualI';
  61 is ref($truncobj->qual($seqid)), 'ARRAY';
  62 is $truncobj->length, 3;
  63 ok my $revobj = $obj->revcom;
  64 isa_ok $revobj, 'Bio::Seq::PrimaryQual::Qual';
  65 isa_ok $revobj, 'Bio::Seq::PrimaryQual';
  66 is ref($revobj->qual), 'ARRAY';
  67 is $revobj->length, 14;
  68 undef $obj;
  69 undef $truncobj;
  70 undef $revobj;
  71
  72 # using get_PrimarySeq_stream streaming
  73 ok my $stream = $db->get_PrimaryQual_stream;
  74 ok $stream = $db->get_PrimarySeq_stream;
  75 isa_ok $stream, 'Bio::DB::Indexed::Stream';
  76 ok my $streamqual = $stream->next_seq;
  77 isa_ok $streamqual, 'Bio::Seq::PrimaryQual';
  78
  79 # using newFh streaming
  80 ok my $fh = Bio::DB::Qual->newFh($test_dbdir);
  81 my $fhqual = <$fh>;
  82 isa_ok $fhqual, 'Bio::Seq::PrimaryQual';
  83 undef $fh;
  84
  85 # tied-hash access
  86 my (%h,$dna1,$dna2);
  87 ok tie(%h,'Bio::DB::Qual',$test_dbdir);
  88 ok $h{$seqid};
  89 ok $dna1 = $h{"$seqid:1,10"};
  90 ok $dna2 = $h{"$seqid:10,1"};
  91
  92 }
  93
  94
  95
  96 sub setup_temp_dir {
  97     # this obfuscation is to deal with lockfiles by GDBM_File which can
  98     # only be created on local filesystems apparently so will cause test
  99     # to block and then fail when the testdir is on an NFS mounted system
 100
 101     my $data_dir = shift;
 102
 103     my $io = Bio::Root::IO->new();
 104     my $tempdir = test_output_dir();
 105     my $test_dbdir = $io->catfile($tempdir, $data_dir);
 106     mkdir($test_dbdir); # make the directory
 107     my $indir = test_input_file($data_dir);
 108     opendir(my $INDIR,$indir) || die("cannot open dir $indir");
 109     # effectively do a cp -r but only copy the files that are in there, no subdirs
 110     for my $file ( map { $io->catfile($indir,$_) } readdir($INDIR) ) {
 111         next unless (-f $file );
 112         copy($file, $test_dbdir);
 113     }
 114     closedir($INDIR);
 115     return $test_dbdir
 116 }