Bio::Das::ProServer::SourceHydra::dbi - A database-backed implementation of B::D::P::SourceHydra

  my $dbiHydra = Bio::Das::ProServer::SourceHydra::dbi->new();

  Effectively returns the results of a SHOW TABLES LIKE '$basename%'
  query. In Oracle I guess this would need changing to table_name from
  all_tables where like '$basename%' or something.

  my @sources = $dbihydra->sources();

  $basename comes from $self->config->{'basename'};

  This routine caches results for $CACHE_TIMEOUT as show tables can be
  slow for a few thousand sources.

  Gets the most recent update time for any of the hydra's tables.
  Only knows how to do this for MySQL databases.

  my $unixtime = $dbihydra->last_modified();

  [mysimplehydra]
  adaptor   = simpledb           # SourceAdaptor to clone
  hydra     = dbi                # Hydra implementation to use
  transport = dbi
  basename  = hydra              # dbi: basename for db tables containing servable data
  dbname    = proserver
  dbhost    = mysql.example.com
  dbuser    = proserverro
  dbpass    = topsecret

#########
# Author:        rmp
# Maintainer:    rmp
# Created:       2003-12-12
# Last Modified: $Date: 2008-12-03 23:14:25 +0000 (Wed, 03 Dec 2008) $ $Author: zerojinx $
# Id:            $Id: dbi.pm 548 2008-12-03 23:14:25Z zerojinx $
# Source:        $Source: /nfs/team117/rmp/tmp/Bio-Das-ProServer/Bio-Das-ProServer/lib/Bio/Das/ProServer/SourceHydra/dbi.pm,v $
# $HeadURL: https://proserver.svn.sf.net/svnroot/proserver/trunk/lib/Bio/Das/ProServer/SourceHydra/dbi.pm $
#
# DBI-driven sourceadaptor broker
#
package Bio::Das::ProServer::SourceHydra::dbi;
use strict;
use warnings;
use English qw(-no_match_vars);
use Carp;
use base qw(Bio::Das::ProServer::SourceHydra);
use Readonly;

our $VERSION = do { my ($v) = (q$Revision: 548 $ =~ /\d+/mxg); $v; };
Readonly::Scalar our $CACHE_TIMEOUT => 30;

#########
# the purpose of this module:
#
sub sources {
  my ($self)   = @_;
  my $basename = $self->config->{'basename'};
  my $dsn      = $self->{'dsn'};
  my $now      = time;

  #########
  # flush the table cache *at most* once every $CACHE_TIMEOUT
  # This may need signal triggering to have immediate support
  #
  if($now > ($self->{'_tablecache_timestamp'} || 0)+$CACHE_TIMEOUT) {
    $self->{'debug'} and carp qq(Flushing table-cache for $dsn);
    delete $self->{'_tables'};
    $self->{'_tablecache_timestamp'} = $now;
  }

  #########
  # skip any management tables (which shouldn't begin with $basename!)
  #
  if(!exists $self->{'_tables'}) {
    $self->{'_tables'} = [];
    eval {
      my $l = length $basename;
      $self->{'debug'} and carp qq(Fetching tables like $basename%);

      my $sth = $self->transport->dbh->prepare(qq(SHOW TABLES LIKE "$basename%"));
      $sth->execute();

      $self->{'_tables'} = [map {
	$dsn.($_->[0] =~ /^.{$l}(.*)$/mx)[0];
      } @{$sth->fetchall_arrayref()}];

      $sth->finish();
      $self->{'debug'} and carp qq(@{[scalar @{$self->{'_tables'}}]} tables found);

    } or do {
      carp "Error scanning tables: $EVAL_ERROR";
      delete $self->{'_tables'};
    };
  }

  return @{$self->{'_tables'} || []};
}

sub last_modified {
  my $self = shift;

  if($self->transport->dbh->{Driver}->{Name} ne 'mysql') {
    return;
  }

  my $now      = time;
  my $basename = $self->config->{'basename'};

  #########
  # flush the timestamp cache *at most* once every $CACHE_TIMEOUT
  # This may need signal triggering to have immediate support
  #
  if($now > ($self->{'_lastmodified_timestamp'} || 0)+$CACHE_TIMEOUT) {
    $self->{'debug'} and carp qq(Flushing last-modified cache for hydra $self->{'dsn'});
    $self->{'_lastmodified_timestamp'} = $now;
    my $server_text = [sort { $b cmp $a } ## no critic
                     map { $_->{Update_time} }
                     @{ $self->transport()->query(q(SHOW TABLE STATUS),{Update_time=>1}) }
                    ]->[0]; # server local time
    my $server_unix = $self->transport()->query(q(SELECT UNIX_TIMESTAMP(?) as 'unix'), $server_text)->[0]{unix}; # sec since epoch
    $self->{'_lastmodified'} = $server_unix;
  }

  return $self->{'_lastmodified'};
}

1;
__END__