t/LocalDB/DBFasta.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4
   5 BEGIN {
   6     use lib '.';
   7         use Bio::Root::Test;
   8
   9     test_begin(-tests => 17,
  10                -requires_modules => [qw(Bio::DB::Fasta Bio::SeqIO)]);
  11 }
  12 use strict;
  13 use warnings;
  14 use Bio::Root::Root;
  15 use File::Copy;
  16 my $DEBUG = test_debug();
  17
  18 {
  19
  20 my $test_dbdir = setup_temp_dir('dbfa');
  21
  22 # now use this temporary dir for the db file
  23 my $db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1);
  24 ok($db);
  25 cmp_ok($db->length('CEESC13F'), '>', 0);
  26 is(length $db->seq('CEESC13F:1,10'), 10);
  27 is(length $db->seq('AW057119',1,10), 10);
  28 my $primary_seq = $db->get_Seq_by_id('AW057119');
  29 ok($primary_seq);
  30 cmp_ok(length($primary_seq->seq), '>', 0);
  31 is($primary_seq->trunc(1,10)->length, 10);
  32 is($primary_seq->description, 'test description', 'bug 3126');
  33 ok(!defined $db->get_Seq_by_id('foobarbaz'));
  34 undef $db;
  35 undef $primary_seq;
  36
  37 my (%h,$dna1,$dna2);
  38 ok(tie(%h,'Bio::DB::Fasta',$test_dbdir));
  39 ok($h{'AW057146'});
  40 ok($dna1 = $h{'AW057146:1,10'});
  41 ok($dna2 = $h{'AW057146:10,1'});
  42
  43 my $revcom = reverse $dna1;
  44 $revcom =~ tr/gatcGATC/ctagCTAG/;
  45 is($dna2, $revcom);
  46
  47 # test out writing the Bio::PrimarySeq::Fasta objects with SeqIO
  48
  49 $db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1);
  50 my $out = Bio::SeqIO->new(-format => 'genbank',
  51               -file  => '>'.test_output_file());
  52 $primary_seq = Bio::Seq->new(-primary_seq => $db->get_Seq_by_acc('AW057119'));
  53 eval {
  54     #warn(ref($primary_seq),"\n");
  55     $out->write_seq($primary_seq)
  56 };
  57 ok(!$@);
  58
  59 $out = Bio::SeqIO->new(-format => 'embl', -file  => '>'.test_output_file());
  60
  61 eval {
  62     $out->write_seq($primary_seq)
  63 };
  64 ok(!$@);
  65
  66 # Issue 3172
  67
  68 {
  69     # squash warnings locally
  70     local $SIG{__WARN__} = sub {};
  71     $test_dbdir = setup_temp_dir('bad_dbfa');
  72     throws_ok {$db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1)}
  73         qr/FASTA header doesn't match/;
  74 }
  75
  76 exit;
  77
  78 }
  79
  80 sub setup_temp_dir {
  81     # this obfuscation is to deal with lockfiles by GDBM_File which can
  82     # only be created on local filesystems apparently so will cause test
  83     # to block and then fail when the testdir is on an NFS mounted system
  84
  85     my $data_dir = shift;
  86
  87     my $io = Bio::Root::IO->new();
  88     my $tempdir = test_output_dir();
  89     my $test_dbdir = $io->catfile($tempdir, $data_dir);
  90     mkdir($test_dbdir); # make the directory
  91     my $indir = test_input_file($data_dir);
  92     opendir(my $INDIR,$indir) || die("cannot open dir $indir");
  93     # effectively do a cp -r but only copy the files that are in there, no subdirs
  94     for my $file ( map { $io->catfile($indir,$_) } readdir($INDIR) ) {
  95         next unless (-f $file );
  96         copy($file, $test_dbdir);
  97     }
  98     closedir($INDIR);
  99     return $test_dbdir
 100 }
 101