BioPerl

 view release on metacpan or  search on metacpan

Bio/DB/GFF/Adaptor/dbi/caching_handle.pm  view on Meta::CPAN

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
  my $self = shift;
  my $d = $self->{debug};
  $self->{debug} = shift if @_;
  $d;
}
 
sub prepare {
  my $self  = shift;
  my $query = shift;
 
  # find a non-busy dbh
  my $dbh = $self->dbh || $self->throw("Can't connect to database: " . DBI->errstr);
 
  warn "Using prepare_cache\n" if $self->debug;
  my $sth = $dbh->prepare_cached($query, {}, 3) || $self->throw("Couldn't prepare query $query:\n ".DBI->errstr."\n");
  return $sth;
}
 
sub do_query {
  my $self = shift;
  my ($query,@args) = @_;

t/LocalDB/Taxonomy/sqlite.t  view on Meta::CPAN

153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
# check that the result is the same as if we are retrieving from the same DB
# flatfile
my $h_flat = $db_flatfile->get_taxon(-name => 'Homo');
my $h_flat2 = $db_flatfile->get_taxon(-name => 'Homo sapiens');
ok my $tree_functions = Bio::Tree::Tree->new();
is $tree_functions->get_lca($h_flat, $h_flat2)->scientific_name, 'Homo', 'get_lca() within flatfile db';
 
# entrez
#my $h_entrez;
#eval { $h_entrez = $db_entrez->get_taxon(-name => 'Homo sapiens');};
#skip "Unable to connect to entrez database; no network or server busy?", 7 if $@;
#my $h_entrez2;
#eval { $h_entrez2 = $db_entrez->get_taxon(-name => 'Homo');};
#skip "Unable to connect to entrez database; no network or server busy?", 7 if $@;
#ok $tree_functions = Bio::Tree::Tree->new();
#is $tree_functions->get_lca($h_entrez, $h_entrez2)->scientific_name, 'Homo', 'get_lca() within entrez db';
 
#ok $tree_functions = Bio::Tree::Tree->new();
# mixing entrez and flatfile
#TODO:{
#    local $TODO = 'Mixing databases for get_lca() not working, see bug #3416';
#    is $tree_functions->get_lca($h_flat, $h_entrez)->scientific_name, 'Homo', 'get_lca() mixing flatfile and remote db';
#}
# even though the species taxa for Homo sapiens from list and flat databases

t/RemoteDB/Taxonomy.t  view on Meta::CPAN

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
test_skip(-tests => 46, -requires_networking => 1) if $db eq $db_entrez;
my $id;
 
if ($db eq $db_entrez) {
   cmp_ok $db->get_num_taxa, '>', 880_000; # 886,907 as of 08-May-2012
} else {
   is $db->get_num_taxa, 189;
}
 
eval { $id = $db->get_taxonid('Homo sapiens');};
skip "Unable to connect to entrez database; no network or server busy?", 38 if $@;
 
is $id, 9606;
 
# easy test on human, try out the main Taxon methods
ok $n = $db->get_taxon(9606);
is $n->id, 9606;
is $n->object_id, $n->id;
is $n->ncbi_taxid, $n->id;
is $n->parent_id, 9605;
is $n->rank, 'species';

t/RemoteDB/Taxonomy.t  view on Meta::CPAN

269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
# check that the result is the same as if we are retrieving from the same DB
# flatfile
$h_flat = $db_flatfile->get_taxon(-name => 'Homo');
my $h_flat2 = $db_flatfile->get_taxon(-name => 'Homo sapiens');
ok my $tree_functions = Bio::Tree::Tree->new();
is $tree_functions->get_lca($h_flat, $h_flat2)->scientific_name, 'Homo', 'get_lca() within flatfile db';
 
# entrez
my $h_entrez;
eval { $h_entrez = $db_entrez->get_taxon(-name => 'Homo sapiens');};
skip "Unable to connect to entrez database; no network or server busy?", 7 if $@;
my $h_entrez2;
eval { $h_entrez2 = $db_entrez->get_taxon(-name => 'Homo');};
skip "Unable to connect to entrez database; no network or server busy?", 7 if $@;
ok $tree_functions = Bio::Tree::Tree->new();
is $tree_functions->get_lca($h_entrez, $h_entrez2)->scientific_name, 'Homo', 'get_lca() within entrez db';
 
ok $tree_functions = Bio::Tree::Tree->new();
# mixing entrez and flatfile
TODO:{
    local $TODO = 'Mixing databases for get_lca() not working, see bug #3416';
    is $tree_functions->get_lca($h_flat, $h_entrez)->scientific_name, 'Homo', 'get_lca() mixing flatfile and remote db';
}
# even though the species taxa for Homo sapiens from list and flat databases

t/RemoteDB/Taxonomy.t  view on Meta::CPAN

331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
ok $node = $db_list->get_taxon(-name => 'Homo erectus');
ok $tree->merge_lineage($node);
for my $name ('Eukaryota', 'Mammalia', 'Homo', 'Homo erectus') {
   ok $node = $tree->find_node(-scientific_name => $name);
}
 
# we can recursively fetch all descendents of a taxon
SKIP: {
    test_skip(-tests => 1, -requires_networking => 1);
    eval {$db_entrez->get_taxon(10090);};
    skip "Unable to connect to entrez database; no network or server busy?", 1 if $@;
 
    my $lca = $db_entrez->get_taxon(314146);
    my @descs = $db_entrez->get_all_Descendents($lca);
    cmp_ok @descs, '>=', 17;
}
 
# bug 2461
$db_list = Bio::DB::Taxonomy->new(-source => 'list',
                                  -names => [
(split(/,\s+/, "cellular organisms, Eukaryota, Fungi/Metazoa group,

t/Species.t  view on Meta::CPAN

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
# We can make a species object from just an id an db handle
SKIP: {
    test_skip(-tests => 5,
              -requires_module     => 'LWP::UserAgent',
              -requires_networking => 1);
     
    $species = Bio::Species->new(-id => 51351);
    my $taxdb = Bio::DB::Taxonomy->new(-source => 'entrez');
    eval {$species->db_handle($taxdb);};
    skip "Unable to connect to entrez database; no network or server busy?", 5 if $@;
    is $species->binomial, 'Brassica rapa subsp.';
    is $species->binomial('FULL'), 'Brassica rapa subsp. pekinensis';
    is $species->genus, 'Brassica';
    is $species->species, 'rapa subsp.';
    is $species->sub_species, 'pekinensis';
}
 
SKIP: {
    skip("Test::Memory::Cycle not installed, skipping", 3) if !$CYCLE;
    # this sub leaks, should return true



( run in 0.370 second using v1.01-cache-2.11-cpan-8d75d55dd25 )