BioPerl
view release on metacpan or search on metacpan
Bio/DB/GFF/Adaptor/dbi/caching_handle.pm view on Meta::CPAN
100101102103104105106107108109110111112113114115116117118119120
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
153154155156157158159160161162163164165166167168169170171172173174175176# 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
787980818283848586878889909192939495969798test_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
269270271272273274275276277278279280281282283284285286287288289290291292# 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
331332333334335336337338339340341342343344345346347348349350351ok
$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
545556575859606162636465666768697071727374# 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 )