File: DBFasta.t

package info (click to toggle)
bioperl 1.6.1-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 40,768 kB
  • ctags: 12,005
  • sloc: perl: 174,299; xml: 13,923; sh: 1,941; lisp: 1,803; asm: 109; makefile: 53
file content (57 lines) | stat: -rw-r--r-- 1,701 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
# -*-Perl-*- Test Harness script for Bioperl
# $Id: DBFasta.t 15364 2009-01-13 17:18:10Z cjfields $


BEGIN {     
    use lib '.';
	use Bio::Root::Test;
	
	test_begin(-tests => 15,
			   -requires_module => 'Bio::DB::Fasta');
	
	use_ok('Bio::Root::IO');
	use_ok('File::Copy');
}

my $DEBUG = test_debug();

# this obfuscation is to deal with lockfiles by GDBM_File which can
# only be created on local filesystems apparently so will cause test
# to block and then fail when the testdir is on an NFS mounted system

my $io = Bio::Root::IO->new(-verbose => $DEBUG);
my $tempdir = test_output_dir();
my $test_dbdir = $io->catfile($tempdir, 'dbfa');
mkdir($test_dbdir); # make the directory
my $indir = test_input_file('dbfa'); 
opendir(INDIR,$indir) || die("cannot open dir $indir");
# effectively do a cp -r but only copy the files that are in there, no subdirs
for my $file ( map { $io->catfile($indir,$_) } readdir(INDIR) ) {
	next unless (-f $file );
	copy($file, $test_dbdir);
}
closedir(INDIR);

# now use this temporary dir for the db file
my $db = Bio::DB::Fasta->new($test_dbdir, -reindex => 1);
ok($db);
cmp_ok($db->length('CEESC13F'), '>', 0);
is(length $db->seq('CEESC13F:1,10'), 10);
is(length $db->seq('AW057119',1,10), 10);
my $primary_seq = $db->get_Seq_by_id('AW057119');
ok($primary_seq);
cmp_ok(length($primary_seq->seq), '>', 0);
is($primary_seq->trunc(1,10)->length, 10);
ok(!defined $db->get_Seq_by_id('foobarbaz'));
undef $db;
undef $primary_seq;

my (%h,$dna1,$dna2);
ok(tie(%h,'Bio::DB::Fasta',$test_dbdir));
ok($h{'AW057146'});
ok($dna1 = $h{'AW057146:1,10'});
ok($dna2 = $h{'AW057146:10,1'});

my $revcom = reverse $dna1;
$revcom =~ tr/gatcGATC/ctagCTAG/;
is($dna2, $revcom);