BioPerl

 view release on metacpan or  search on metacpan

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

  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

    # 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

        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

    # 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

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

# 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