view release on metacpan or  search on metacpan

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

    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';
 	    }
 	    else {
 		$_ =  "'$_'";
 	    } } @vals;
 	$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;
}

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

     # rethrow, throw a new error, print something, AKA: handle it!
  }

Errors Thrown:

  connection failure         - could not connect to database
  sql missing                - query sub called without 'sql=>' argument
  connect missing            - static call without 'connect=>' argument
  prepare failure            - failure to $dbh->prepare
  execute failure            - failure to $dbh->execute
  alias_config missing       - connection alias has no configuration
  activator_db error         - sub _warn_or_die() died without error args passed in
  fetch failure              - $sth->fetch* call failed
  do failure                 - $dbh->do call failed

=head1 METHODS

=head2 getrow

=head2 getrow_arrayref

=head2 getrow_hashref

Prepare and Execute a SQL statement and get a the result of values
back via DBI::fetchrow_array(), DBI::fetchrow_arrayref(),
DBI::fetchrow_hashref() respectively. NOTE: Unlike DBI, these return
empty array/arrayref/hashref (like DBI::fetchall_arrayref does,
instead of undef) when there are no results.

Usage:

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

=head2 getall

=head2 getall_arrayrefs

=head2 getall_hashrefs

Prepare and Execute a SQL statement, and return a reference to the
result obtained by DBI::fetchall_arrayref(). Returns an empty arrayref
if no rows returned for the query.

=over

=item *

C<getall()> is an alias for C<getall_arrayrefs()> and they both return an
arrayref of arrayrefs, one arrayref of values for each row of data
from the query.

  $rowrefs is [ [ row1_col1_val, row1_col2_val ],
                [ row2_col1_val, row2_col2_val ],
              ];

=item *

C<getall_hashrefs()> returns an arrayref of of rows represented by
hashrefs of column name => value mappings.

  $rowrefs is [ { col1 => val, col2 => val },
                { col1 => val, col2 => val },
              ];

=back

  my $rowref = $db->getall( $sql, $bind, @args )
  my $rowref = $db->getall_arrayrefs( $sql, $bind, @args )
  my $rowref = $db->getall_hashrefs( $sql, $bind, @args )

=head2 do

Execute a SQL statement and return the number of rows affected. Dies
on failure.

Usage:

  my $res = $db->do( $sql, $bind, @args )

=head2 do_id

Execute a SQL statement that generates an id and return the id. Dies
on failure.

Usage:

  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()
##