t/RemoteDB/BioFetch.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10     test_begin(-tests               => 36,
  11                -requires_modules    => [qw(IO::String
  12                                            LWP::UserAgent)],
  13                -requires_networking => 1);
  14
  15     use_ok('Bio::DB::BioFetch');
  16 }
  17
  18 my $verbose = test_debug();
  19
  20 my $dbwarn = "Warning: Couldn't connect to EMBL with Bio::DB::BioFetch!\n";
  21
  22 my ($db,$db2,$seq,$seqio);
  23
  24 SKIP :{
  25     # get a single seq
  26     ok defined($db = Bio::DB::BioFetch->new(-verbose => $verbose));
  27     # get a RefSeq entry
  28     ok $db->db('refseq');
  29     eval {
  30         $seq = $db->get_Seq_by_acc('NM_006732'); # RefSeq VERSION
  31     };
  32     skip($dbwarn, 4) if $@;
  33     isa_ok($seq, 'Bio::SeqI');
  34     is($seq->accession_number,'NM_006732');
  35     is($seq->accession_number,'NM_006732');
  36     is( $seq->length, 3776);
  37 }
  38
  39 SKIP: {
  40     # EMBL
  41     $db->db('embl');
  42     eval {
  43         $seq = $db->get_Seq_by_acc('J02231');
  44     };
  45     skip($dbwarn, 3) if $@;
  46     isa_ok($seq, 'Bio::SeqI');
  47     is($seq->id, 'J02231');
  48     is($seq->length, 200);
  49 }
  50
  51 SKIP: {
  52     eval {
  53         $seqio = $db->get_Stream_by_id(['AEE33958']);
  54     };
  55     skip($dbwarn, 3) if $@;
  56     undef $db; # testing to see if we can remove gb
  57     $seq = $seqio->next_seq();
  58     isa_ok($seqio, 'Bio::SeqIO');
  59     isa_ok($seq, 'Bio::SeqI');
  60     cmp_ok( $seq->length, '>=', 1);
  61 }
  62
  63 SKIP: {
  64     #swissprot
  65     ok $db2 = Bio::DB::BioFetch->new(-db => 'swissprot');
  66     eval {
  67         $seq = $db2->get_Seq_by_id('YNB3_YEAST');
  68     };
  69     skip($dbwarn, 5) if $@;
  70     isa_ok($seq, 'Bio::SeqI');
  71     is($seq->length, 125);
  72     is($seq->division, 'YEAST');
  73     $db2->request_format('fasta');
  74     eval {
  75         $seq = $db2->get_Seq_by_acc('P43780');
  76     };
  77     skip($dbwarn, 2) if $@;
  78     isa_ok($seq, 'Bio::SeqI');
  79     is($seq->length,103);
  80 }
  81
  82 $seq = $seqio = undef;
  83
  84 SKIP: {
  85     ok $db = Bio::DB::BioFetch->new(-retrievaltype => 'tempfile',
  86                                     -format        => 'fasta',
  87                                     -verbose       => $verbose
  88                                     );
  89     $db->db('embl');
  90     eval {
  91         $seqio = $db->get_Stream_by_id('J00522 AF303112 J02231');
  92     };
  93     skip($dbwarn, 7) if $@;
  94     my %seqs;
  95     # don't assume anything about the order of the sequences
  96     while ( my $s = $seqio->next_seq ) {
  97         isa_ok($s, 'Bio::SeqI');
  98         my ($type,$x,$name) = split(/\|/,$s->display_id);
  99         $seqs{$x} = $s->length;
 100     }
 101     isa_ok($seqio, 'Bio::SeqIO');
 102     is($seqs{'J00522'},408);
 103     is($seqs{'AF303112'},1611);
 104     is($seqs{'J02231'},200);
 105 }
 106
 107 SKIP: {
 108     ok $db = Bio::DB::BioFetch->new(-db      => 'embl',
 109                                     -verbose => $verbose ? $verbose : -1);
 110
 111     # check contig warning (WebDBSeqI)
 112     eval {
 113         $seq = $db->get_Seq_by_acc('NT_006732');
 114     };
 115     like($@, qr{contigs are whole chromosome files}, 'contig warning');
 116     eval {
 117         $seq = $db->get_Seq_by_acc('NM_006732');
 118     };
 119     skip($dbwarn, 2) if $@;
 120     isa_ok($seq, 'Bio::SeqI');
 121     is($seq->length,3776);
 122 }
 123
 124 # unisave
 125 SKIP: {
 126     ok $db = Bio::DB::BioFetch->new(-db      => 'unisave',
 127                                     -verbose => $verbose ? $verbose : -1);
 128     eval {
 129         $seq = $db->get_Seq_by_acc('P14733');
 130     };
 131     skip($dbwarn, 4) if $@;
 132     isa_ok($seq, 'Bio::SeqI');
 133     is($seq->display_id, 'LMNB1_MOUSE');
 134     is($seq->accession, 'P14733');
 135     is($seq->length, 588);
 136 }