view release on metacpan or  search on metacpan

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

    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};

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

    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();
	};
    }
    elsif ( $fn eq 'getrow_hashref' ) {
	try eval {
	    $row = $sth->fetchrow_hashref();
	    $sth->finish();
	};
    }
    elsif ( $fn eq 'getall_arrayrefs' || $fn eq 'getall' ) {
	try eval {
	    $row = $sth->fetchall_arrayref();
	    $sth->finish();
	};
    }
    elsif ( $fn eq 'getall_hashrefs' ) {
	try eval {
	    $row = $sth->fetchall_arrayref( {} );
	    $sth->finish();
	};
    }

    if ( catch my $e ) {
	Activator::Exception::DB->throw( 'sth',
					 'fetch',
					 $e .
					 $self->_get_sql( $sql, $bind )
				       );
    }


    # clean up return value for total consistency.
    if ( !defined( $row ) ) {
	if ( $fn eq 'getrow_hashref' ) {
	    $row = {};
	}
	else {
	    $row = [];
	}
    }
    $self->_debug_sql( 5, $sql, $bind, \%args);

    if ( $fn eq 'getrow' ) {
	return ( $self, $sql, $bind, \%args, @row );
    }

    return ( $self, $sql, $bind, \%args, $row );
}

sub do_id {
    my ( $pkg, $sql, $bindref, %args ) = @_;
    my ( $self, $bind, $attr ) = $pkg->_explode( $bindref, \%args );
    my $conn = $self->_get_cur_conn();

    $self->_start_timer();

    my $res;
    try eval {
	$res = $self->_get_sth( $sql, $bind, $attr, 'want_exec_result' );
    };
    if ( catch my $e ) {
	$e->rethrow;
    }

    $self->_debug_sql( 4, $sql, $bind, \%args );

    if ( $res == 1 ) {
	if ( $conn->{engine} eq 'mysql' ) {
	    return $conn->{dbh}->{mysql_insertid};
	}
	elsif ( $conn->{engine} eq 'Pg' ) {
	    my $row = $self->getrow_arrayref( "SELECT currval('$args{seq}')" );
	    return @$row[0];
	}
    } else {
	Activator::Exception::DB->throw('execute',
					'failure',
					$self->_get_sql( $sql, $bind ) .
					" did not cause an insert"
				       );
    }
}

sub do {
    my ( $pkg, $sql, $bindref, %args ) = @_;
    my ( $self, $bind, $attr, $alt_error ) = $pkg->_explode( $bindref, \%args );
    my $conn = $self->_get_cur_conn();

    $self->_start_timer();

    my $res;
    try eval {
	$res = $conn->{dbh}->do( $sql, $attr, @$bind );
    };
    if ( catch my $e ) {
	$e->rethrow;
    }

    $self->_debug_sql( 4, $sql, $bind, \%args );

    if ( $res eq '0E0' ) {
	return 0;
    }
    return $res;
}

# allow diconnection before DESTROY is called
sub disconnect_all {
    my ( $pkg ) = @_;
    my $self = $pkg->connect('default');
    foreach my $conn ( keys %{ $self->{connections} } ) {
	if ( exists( $self->{connections}->{ $conn }->{dbh} ) ) {
	    $self->{connections}->{ $conn }->{dbh}->disconnect();
	}
    }
}

# Transaction support
sub begin_work {
    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 *