Activator
view release on metacpan or search on metacpan
lib/Activator/DB.pm view on Meta::CPAN
# setup default config
foreach my $key ( keys %{ $conns->{ $alias }->{config} } ) {
if ( exists ( $self->{config}->{ $key } ) ) {
$self->{connections}->{ $alias }->{config}->{ $key } =
$conns->{ $alias }->{config}->{ $key };
} else {
WARN( "Ignoring ${alias}->config->${key}: unsupported config option" );
}
}
$self->_debug_connection( 2, "Initialized connection ".
Data::Dumper->Dump( [ $self->{connections}->{$alias} ],
[ $alias ] ) );
}
$self->_debug_connection( 2, 'Activator::DB initialization successful');
}
# _ping>($conn)
#
# Test a database handle and attempt to reconnect if it is done
#
# Args:
# $conn_alias => connection alias to check
#
# Throws:
# connection.failure - failure to ping connection
#
sub _ping {
my ( $self ) = @_;
my $conn = $self->_get_cur_conn();
my $dbh = $conn->{dbh};
local $dbh->{RaiseError} = 1;
my $reconn_att =
$conn->{config}->{reconn_att} ||
$self->{config}->{reconn_att};
my $reconn_sleep =
$conn->{config}->{reconn_sleep} ||
$self->{config}->{reconn_sleep};
while ( $reconn_att > 0 ) {
try eval { $dbh->ping(); };
if ( catch my $e ) {
$reconn_att--;
sleep $reconn_sleep;
$reconn_sleep *= 2;
} else {
return 1;
}
}
ERROR( "connection to $conn->{alias} appears to be dead" );
Activator::Exception::DB->throw( 'ping', 'failure' );
}
# _get_cur_conn
#
# return the internal connection hash for the current connection alias
sub _get_cur_conn {
my ( $self ) = @_;
if ( exists( $self->{connections}->{ $self->{cur_alias} } ) ) {
my $conn = $self->{connections}->{ $self->{cur_alias} };
# # set the log level to this connection
# LEVEL( $conn->{config}->{debug}
# ? $Log::Log4perl::$self->_debug
# : $Log::Log4perl::WARN );
return $conn;
}
Activator::Exception::DB->throw('alias', 'invalid', $self->{cur_alias} )
}
# explode args for a db query sub
sub _explode {
my ( $pkg, $bindref, $args ) = @_;
my $bind = $bindref || [];
my $self = $pkg;
my $connect_to = $args->{connect};
# handle static calls
if ( !( Scalar::Util::blessed($self) && $self->isa( 'Activator::DB') ) ) {
if ( $connect_to ) {
$self = Activator::DB->connect( $connect_to );
}
else {
Activator::Exception::DB->throw( 'connect', 'missing');
}
}
# static or OO, respect the connect
if ( $connect_to ) {
$self->{cur_alias} = $connect_to;
}
# This next line insures that $self refers to the singleton object
$self = $self->connect( $self->{cur_alias} );
my $conn = $self->_get_cur_conn()
or Activator::Exception::DB->throw( 'connection',
'failure',
"_explode couldn't get connection for alias '$self->{cur_alias}'");
my $attr = $args->{attr} || {};
return ( $self, $bind, $attr );
}
# This can never die, so we jump through hoops to return some valid scalar.
# * replace undef values with NULL, since this is how dbi will do it
# * If $bind is of wrong type, don't do substitutions.
# * shift @vals to handle the case of '?' in the bind values
# * @vals? in the regexp is to handle fewer args on the right than the left
# TODO: support attrs in debug
sub _get_sql {
my ( $pkg, $sql, $bind ) = @_;
$sql ||= '';
$bind ||= [];
if ( ref( $bind ) eq 'ARRAY' ) {
my @vals = @$bind;
map {
if ( !defined($_) ) {
$_ = 'NULL';
}
lib/Activator/DB.pm view on Meta::CPAN
$sql =~ s/\?/@vals? (shift @vals) : '?'/egos;
return $sql;
}
else {
if ( $bind ) {
return "[SQL] ${sql} [BIND VARS] $bind";
}
return $sql;
}
}
# returns sth, unless you want the result of the execute,
sub _get_sth {
my ( $self, $sql, $bind, $attr, $want_exec_result ) = @_;
my $conn = $self->_get_cur_conn();
my $sth;
try eval {
$sth = $conn->{dbh}->prepare_cached( $sql, $attr );
};
if ( catch my $e ) {
$self->_ping();
try eval {
$sth = $conn->{dbh}->prepare_cached( $sql, $attr );
};
if ( catch my $e ) {
Activator::Exception::DB->throw( 'sth',
'prepare',
$e . " SQL: " .
$self->_get_sql( $sql, $bind )
);
}
}
my $res;
try eval {
$res = $sth->execute( @$bind );
};
if ( catch my $e ) {
Activator::Exception::DB->throw( 'sth',
'execute',
$e . " SQL: " .
$self->_get_sql( $sql, $bind )
);
}
if ( $want_exec_result ) {
$sth->finish();
return $res;
}
return $sth;
}
################################################################################
# getrow subs
#
# Note that we jump through some hoops ( return array of everything )
# to consolidate these 3 functions, and still log from the appropriate
# function.
#
sub getrow {
my ($self, $sql, $bind, $args, @ret) = &_fetch( 'getrow', @_);
return @ret;
}
sub getrow_arrayref {
my ($self, $sql, $bind, $args, $ret) = &_fetch( 'getrow_arrayref', @_);
return $ret;
}
sub getrow_hashref {
my ($self, $sql, $bind, $args, $ret) = &_fetch( 'getrow_hashref', @_);
return $ret;
}
sub getall {
my ($self, $sql, $bind, $args, $ret) = &_fetch( 'getall', @_);
return $ret;
}
sub getall_arrayrefs {
my ($self, $sql, $bind, $args, $ret) = &_fetch( 'getall_arrayrefs', @_);
return $ret;
}
sub getall_hashrefs {
my ($self, $sql, $bind, $args, $ret) = &_fetch( 'getall_hashrefs', @_);
return $ret;
}
sub _fetch {
my ( $fn, $pkg, $sql, $bindref, %args ) = @_;
my ( $self, $bind, $attr ) = $pkg->_explode( $bindref, \%args );
$self->_start_timer();
my $conn = $self->_get_cur_conn();
my ( $sth, $e );
try eval {
$sth = $self->_get_sth( $sql, $bind, $attr );
};
if ( catch my $e ) {
$e->rethrow;
}
my ( @row, $row, $rows );
if ( $fn eq 'getrow') {
try eval {
@row = $sth->fetchrow_array();
$sth->finish();
};
}
elsif ( $fn eq 'getrow_arrayref' ) {
try eval {
$row = $sth->fetchrow_arrayref();
$sth->finish();
};
lib/Activator/DB.pm view on Meta::CPAN
typing for the common cases, and remove worrying about connections.
This module is a wrapper for DBI providing these advantages:
=over
=item *
Provides connect string aliases centrally configured.
=item *
Provide consistent arguments handling to all query functions.
=item *
Provides connection caching without Apache::DBI -- this allows use of
your model layer code in crons, daemons AND website.
=item *
Connection and query debug dumps using your project or module level
C<Activator::Log> config, or on a per-query basis.
=item *
Allows all code in your project/team/company to access the db in a
consistent fashion.
=item *
By default, dies on all errors enforcing try/catch programming
=item *
Implemented as a singleton so each process is guranteed to be using no
more than one connection to each database from the pool.
=back
Disadvantages:
=over
=item *
If you know DBI, you don't necessarily know C<Activator::DB>
=item *
NOT THREAD SAFE
=item *
Only tested with MySql and PostgreSQL
=back
=head1 CONFIGURATION
This module uses L<Activator::Registry> to automatically choose default
databases, and L<Activator::Log> to log warnings and errors.
=head2 Registry Setup (from Activator::Registry)
This module expects an environment variable ACT_REG_YAML_FILE to be
set. If you are utilizing this module from apache, this directive must
be in your httpd configuration:
SetEnv ACT_REG_YAML_FILE '/path/to/config.yml'
If you are using this module from a script, you need to insure that
the environment is properly set using a BEGIN block:
BEGIN{
$ENV{ACT_REG_YAML_FILE} ||= '/path/to/config.yml'
}
=head2 Registry Configuration
Add an C<Activator::DB> section to your project YAML configuration file:
'Activator::Registry':
log4perl<.conf>: # Log4perl config file or definition
# See Logging Configuration below
'Activator::DB':
default: # default configuration for all connections
connection: <conn_alias>
## Optional default attributes and config for all connections
config:
debug: 0/1 # default: 0, affects all queries, all aliases
reconn_att: <int> # attempt reconnects this many times. default: 3
reconn_sleep: <int> # initial sleep seconds between reconnect attempts.
# doubles every attempt. default: 1
attr: # connection attributes. Only AutoCommit at this time
AutoCommit: 0/1 # default: 1
## You must define at least one connection alias
connections:
<conn_alias>:
user: <user>
pass: <password>
dsn: '<DSN>' # MySql Example: DBI:mysql:<DBNAME>:<DBHOST>
# PostgreSQL Example: DBI:Pg:dbname=<DBNAME>
# see: perldoc DBI, perldoc DBD::Pg, perldoc DBD::mysql
# for descriptions of valid DSNs
## These attributes and config are all optional, and use the default from above
attr:
AutoCommit: 0/1
config:
debug: 0/1 # only affects this connection
=head1 USAGE
This module can be used either pseudo-OO or static on multiple
databases. I say pseudo-OO, because you don't call new: this module
auto-vivicates a singleton object whenever you connect for the first
time.
=over
=item ## pseudo-OO example:
my $db = Activator::DB->connect( 'db_alias' );
$db->query_method( $sql, $bind, @args );
$db->connect( 'alt_db_alias' );
$db->query_method( $sql, $bind, @args );
$db->connect( 'db_alias' );
$db->query_method( $sql, $bind, @args );
=item ## Static formatted calls require that you dictate the connection for
every request. So, the above can also be done as:
Activator::DB->query_method( $sql, $bind, connect => 'db_alias', @args );
Activator::DB->query_method( $sql, $bind, connect => 'alt_db_alias', @args );
Activator::DB->query_method( $sql, $bind, connect => 'db_alias', @args );
=item ## However, the common use case for this module is:
my $db = Activator::DB->connect( 'db_alias' );
$db->query_method( $sql, $bind, @args );
( run in 1.672 second using v1.01-cache-2.11-cpan-39bf76dae61 )