view release on metacpan or  search on metacpan

lib/Activator/DB.pm  view on Meta::CPAN

package Activator::DB;
use strict;
use warnings;

use Activator::Log qw( :levels );
use Activator::Registry;
use DBI;
use Exception::Class::DBI;
use Exception::Class::TryCatch;
use Data::Dumper;
use Time::HiRes qw( gettimeofday tv_interval );
use Scalar::Util;
use base 'Class::StrongSingleton';

# constructor: implements singleton
sub new {
    my ( $pkg, $conn_alias ) = @_;

    my $self = bless( {}, $pkg);

    $self->_init_StrongSingleton();

    return $self;
}

# connect to a db alias
# initializes singleton object returned from new()
# Args:
#   $conn_alias => the alias to use as configured in the registry
sub connect {
    my ( $pkg, $conn_alias ) = @_;
    my $self = &new( @_ );

    $conn_alias ||= 'default';

    # first call
    # TODO: also look for a some sighup to reload this config
    if( !keys( %{ $self->{config} } ) ) {
	$self->_init();
    }

    # set the current alias for the object
    if ( $conn_alias !~ /^def(ault)?$/ ) {
	$self->{cur_alias} = $conn_alias;
    }
    else {
	$self->{last_alias} = $self->{cur_alias};
	$self->{cur_alias} = $self->{default}->{connection};
    }

    my $conn;
    try eval {
	$conn = $self->_get_cur_conn();
    };
    if ( catch my $e ) {
	$self->{cur_alias} = $self->{last_alias};
	$e->rethrow;
    }


    # est. the actual connection if it's not set
    if ( !$conn->{dbh} ) {
	try eval {
	    $self->_debug_connection( 2, "Connecting to alias $self->{cur_alias}" );
	    $self->_debug_connection( 2, 'Connect Parameters:');
	    $self->_debug_connection( 2, "   dsn  => $conn->{dsn}");
	    $self->_debug_connection( 2, "   user => $conn->{user}");
	    $self->_debug_connection( 2, '   pass => ' . ( $conn->{pass} || ''));
	    $self->_debug_connection( 2, Data::Dumper->Dump( [ $conn->{attr} ], [ '  attr' ] ) );

	    try eval {
		$conn->{dbh} = DBI->connect( $conn->{dsn},
					     $conn->{user} || '',
					     $conn->{pass} || '',
					     $conn->{attr}
					   );
	    };

	    if ( catch my $e ) {
		Activator::Exception::DB->throw( 'dbh',
						 'connect',
						 "$e " .
						 Data::Dumper->Dump( [ $conn ], [ 'connection' ] )
					       );
	    }

	    # TODO: do something more generic with this
	    # mysql_auto_reconnect now cannot be disconnected
	    if ( $conn->{dsn} =~ /mysql/i ) {
		$conn->{dbh}->{mysql_auto_reconnect} = $self->{config}->{mysql}->{auto_reconnect};
	    }
	    elsif ( my $search_path = $conn->{config}->{Pg}->{search_path} ) {
		$self->do("SET search_path TO ?", [ $search_path ]);
	    }
	    # test cur_alias $conn->{dbh}, may throw exception
	    $self->_ping();
	    $self->_debug_connection( 2, "alias '$conn->{alias}' db handle pinged and ready for action");
	};
	if ( catch my $e ) {
	    $e->rethrow;
	}

    }

    return $self;
}

sub _init {
    my ( $self ) = @_;
    $self->_start_timer();
    my $setup = Activator::Registry->get( 'Activator::DB' );
    if (!keys %$setup ) {
	$setup = Activator::Registry->get( 'Activator->DB' );
	if (!keys %$setup ) {
	    Activator::Exception::DB->throw( 'activator_db_config', 'missing', 'You must define the key "Activator::DB" or "Activator->DB" in your project configuration' );
	}
    }

    # module defaults
    $self->{config} = { debug            => 0,
			debug_connection => 0,
			debug_attr       => 0,
			reconn_att       => 3,
			reconn_sleep     => 1,
			mysql => { auto_reconnect => 1 },
			Pg    => { search_path => 'public' },
		      };
    $self->{attr} = {   RaiseError   => 0,
			PrintError   => 0,
			HandleError  => Exception::Class::DBI->handler,
			AutoCommit   => 1,
		    };
    $self->{connections} = {};

    # setup the current alias key
    $self->{cur_alias} =
      $self->{default}->{connection} =
	$setup->{default}->{connection} ||
	  Activator::Exception::DB->throw( 'connect',
					   'config',
					   'default: connection not set!'
					 );

    # setup default attributes. NOTE: even though we only support
    # AutoCommit, this block can easily be extended for other
    # attributes.
    foreach my $key ( 'AutoCommit' ) {
	my $value = $setup->{default}->{attr}->{ $key };
	$self->{ $key } =
	  defined( $value ) ? $value : $self->{attr}->{ $key };
    }

    # setup default config
    foreach my $key( keys %{ $setup->{default}->{config} } ) {
    	if ( exists ( $self->{config}->{ $key } ) ) {
    	    $self->{config}->{ $key } = $setup->{default}->{config}->{ $key };
    	}
    	else {
    	    WARN( "Ignoring default->config->$key: unsupported config option" );
    	}
    }

#    Activator::Log::set_level( $self->{config}->{debug}
#			    ? $Activator::Log::$self->_debug
#			    : $Activator::Log::WARN );

    # setup connection strings
    my ( $host, $db, $user, $pass );
    my $conns = $setup->{connections};

    foreach my $alias ( keys( %$conns ) ) {
	my $engine;
	$engine = 'mysql' if $conns->{ $alias }->{dsn} =~ /mysql/;
	$engine = 'Pg'    if $conns->{ $alias }->{dsn} =~ /Pg/;
	$self->{connections}->{ $alias }  =
	  {
	   dsn    => $conns->{ $alias }->{dsn},
	   user   => $conns->{ $alias }->{user},
	   pass   => $conns->{ $alias }->{pass},
	   attr   =>
	   {
	    RaiseError  => $self->{attr}->{RaiseError},
	    PrintError  => $self->{attr}->{PrintError},
	    HandleError => $self->{attr}->{HandleError},
	    AutoCommit  => $conns->{ $alias }->{attr}->{AutoCommit} ||
                     	    $self->{attr}->{AutoCommit},
	   },
	   config => $self->{config},
	   alias => $alias,
           engine => $engine,
	  };

	# 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 {

lib/Activator/DB.pm  view on Meta::CPAN

    my ( $self ) = @_;
    $self->begin();
}

sub begin {
    my ( $self ) = @_;
    my $conn = $self->_get_cur_conn();
    $conn->{dbh}->{AutoCommit} = 0;
}

sub commit {
    my ( $self ) = @_;
    my $conn = $self->_get_cur_conn();
    $conn->{dbh}->commit;
    $conn->{dbh}->{AutoCommit} = 1;
}

sub abort {
    my ( $self ) = @_;
    $self->rollback();
}

sub rollback {
    my ( $self ) = @_;
    my $conn = $self->_get_cur_conn();
    try eval {
	$conn->{dbh}->rollback;
    };
    catch my $e;
    $conn->{dbh}->{AutoCommit} = 1;
    if ( $e ) {
        $e->rethrow;
    }
}

sub as_string {
    my ( $pkg, $sql, $bind ) = @_;
    return Activator::DB->_get_sql( $sql, $bind );
}

sub _start_timer {
    my ( $self ) = @_;
    $self->{debug_timer} = [gettimeofday];
}

sub _debug_sql {
    my ( $self, $depth, $sql, $bind, $args ) = @_;

    if ( $sql =~ /foo/ ) {
	warn Dumper( $args );
    }
    my $conn = $self->_get_cur_conn();
    if ( $args->{debug} ||
	 $self->{config}->{debug} ||
	 $conn->{config}->{debug} ) {
	local $Log::Log4perl::caller_depth;
	$Log::Log4perl::caller_depth += $depth;
	my $str = $self->_get_sql( $sql, $bind );
	DEBUG( tv_interval( $self->{debug_timer}, [ gettimeofday ] ). " $str".
	       ( $self->{config}->{debug_attr} ? "\n\t" .
	       Data::Dumper->Dump( [ $conn->{attr} ], [ 'attr' ] ) : '' )
	     );
    }
}

sub _debug_connection {
    my ( $self, $depth, $msg, $args ) = @_;
    if ( $self->{config}->{debug_connection} ) {
	local $Log::Log4perl::caller_depth;
	$Log::Log4perl::caller_depth += $depth;
	DEBUG( $msg );
    }
}

sub _debug {
    my ( $self, $depth, $msg ) = @_;
    if ( $self->{config}->{debug} ) {
	local $Log::Log4perl::caller_depth;
	$Log::Log4perl::caller_depth += $depth;
	DEBUG( $msg );
    }
}

sub begin_debug {
    my ( $self ) = @_;
    $self->{config}->{debug} = 1;
}

sub end_debug {
    my ( $self ) = @_;
    $self->{config}->{debug} = 0;
}

=head1 NAME

Activator::DB - Wrap DBI with convenience subroutines and consistant
access accross all programs in a project.

=head1 Synopsis

  use Activator::DB;
  my $db = Activator::DB->connect('default'); # connect to default db

=over

=item *

Get a single row:

    my @row     = $db->getrow( $sql, $bind, @args );
    my $rowref  = $db->getrow_arrayref( $sql, $bind, @args );

=item *

Get hashref of col->value pairs:

    my $hashref = $db->getrow_hashref( $sql, $bind, @args );

=item *

Get all rows arrayref (these are identical):