Activator
8 results

 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;

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


  my $id = $db->do_id( $sql, $bind, @args )

=cut

1;

=head1 SEE ALSO

L<DBI>, L<Activator::Registry>, L<Activator::Log>, L<Activator::Exception>, L<Exception::Class::DBI>, L<Class::StrongSingleton>, L<Exception::Class::TryCatch>

=head1 AUTHOR

Karim A. Nassar

=head1 COPYRIGHT

Copyright (c) 2007 Karim A. Nassar <karim.nassar@acm.org>

You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.

=cut

__END__

################################################################################
## begin legacy

## =item B<getcol_arrayref>($sql, $bind, $colsref)
##
## Prepare and Execute a SQL statement on the default database, and
## get an arrayref of values back via DBI::selectcol_arrayref()
##
## Args:
##   $sql => sql statement
##   $bind => optional bind values arrayref for the sql statement
##   $colsref => optional arrayref containing the columns to return
##
## Returns:
##   an arrayref of values for each specified col of data from the query (default is the first column).  So each row of data from the query gives one or more sequential values in the output arrayref.
##   reference to an empty array when there is no matching data
##
##
## Usage example
##   my $ary_ref = getcol_arrayref("select id, name from table",{Columns=>[1,2]});
##   my %hash = @$ary_ref; # now $hash{$id} => $name
##
##   # to just get an arrayref of id values
##   my $ary_ref = getcol_arrayref("select id, name from table");
##
## Throws
##   connect.failure - on connect failure
##   dbi.failure - on failure of DBI::selectcol_arrayref
##
## =cut
##
## sub getcol_arrayref {
##     my ( $sql, $bind, $colsref ) = @_;
##
##     $self->{debug_start} = [ gettimeofday ];
##
##     my $colref;
##
##     my $dbh = &get_dbh();    # may throw connect.failure
##
##     eval {
## 	$colref
## 	    = $dbh->selectcol_arrayref( $sql, { Columns => $colsref },
## 	    @$bind );
##     };
##     if ( $@ ) {
## 	Activator::Exception::DB->throw( 'dbi', 'failure', $dbh->errstr || $@);
##     }
##
##     $self->_get_query_debug( 'getcol_arrayref', @_ );
##
##     return $colref;
## }
##
## =item B<getall_hr>($sql, $bind, $key_field)
##
## Prepare and Execute a SQL statement on the default database, and
## call DBI::fetchall_hashref(),
## returning a reference to a hash containing one hashref for each row.
##
## Args:
##   $sql => sql statement
##   $bind => optional bind values arrayref for the sql statement
##   $key_field => column name, column number or arrayref of colunm names/numbers
##                 column number starts at 1
## Returns:
##   a hashref of where each hash entry represents a row of data from the query.
##   The keys for the hash are the values in $key_field.
##   The values in the hash are hashrefs representing the rows in the form
##   returned by fetchrow_hashref.
##   Subsequent rows with the same key will replace previous ones.
##
##   Reference to an empty hash when there is no matching data
##
## Usage example
##   # for table with (id,name) values: ('goog', 'google'), (yhoo, 'yahoo')
##   my $hashref = getall_arrayrefs("select id, name from table",[], 'id'});
##   # $hashref = {
##   #             {goog} => {id=>'goog', name=>'google'},
##   #             {yhoo} => {id=>'yhoo', name=>'yahoo'}
##   #            }
##   my $hashref = getall_arrayrefs("select id, name from table",[]}, 2);
##   # $hashref = {
##   #             {google} => {id=>'goog', name=>'google'},
##   #             {yahoo}  => {id=>'yhoo', name=>'yahoo'}
##   #            }
##
## Throws
##   connect.failure - failure to connect to database
##   prepare.failure - failure to prepare a query for database
##   execute.failure - failure to execute a query on database
##   sth.failure - failure on fetch
##
## =cut
##
## sub getall_hr {
##     my ( $sql, $bind, $key_field ) = @_;
##
##     $self->{debug_start} = [ gettimeofday ];
##
##     my $sth = &_get_sth( $sql, $bind );
##
##     my $rv = $sth->fetchall_hashref( $key_field );
##
##     $sth->finish();
##
##     $self->_get_query_debug( 'getall_hr', @_ );
##
##     return $rv;
## }



( run in 0.622 second using v1.01-cache-2.11-cpan-39bf76dae61 )