bind results from the CPAN

bind

Activator

view release on metacpan or search on metacpan

#	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');

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


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

################################################################################

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

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

	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 ) = @_;

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

	$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} ) {

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


  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):

    my $rowsref = $db->getall( $sql, $bind, @args );
    my $rowsref = $db->getall_arrayrefs( $sql, $bind, @args );

=item *

Get all rows ref: with each row a hashref of cols->value pairs:

    my $rowsref = $db->getall_hashrefs( $sql, $bind, @args );

=item *

C<do> any query ( usually INSERT, DELETE, UPDATE ):

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

=item *

C<do> query, but return id instead of success.:

    my $id = $db->do_id( $sql, $bind, @args );
   ( NOTE: this is very mysql dependant at the moment)

=item *

Get data from a different db for a while:

    $db->connect('alt'); # connect to alternate db
    # do something

    $db->connect('def'); # reset to default connection

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

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 );
    ### do some perl
  $db->query_method( $sql, $bind, @args );
    ### do some perl
  $db->query_method( $sql, $bind, @args );
    ### do some perl
  ... etc.

=back

=head2 connect() Usage

  my $db = Activator::DB->connect('my_db');   # connect to my_db
  my $db->connect('default'); # connect to default db
  my $db->connect('def');     # shortcut to default db
  my $db->connect();          # shortercut to default db

=head2 connect() Caveat

Note that C<connect()> always returns the singleton object, which in some
usage patterns could cause some confusion:

  my $db1->connect('db1');           # connect to db1
  $db1->query( $sql, $bind, @args ); # acts on db1
  my $db2->connect('db2');           # connect to db2
  $db2->query( $sql, $bind, @args ); # acts on db2
  $db1->query( $sql, $bind, @args ); # still acts on db2!

For this reason, it is highly recommended that you always use the same
variable name (probably C<$db>) for the Activator::DB object.

=head2 Query Methods Usage

Every query function takes named arguments in the format of:

  Activator::DB->$query_method( $sql, $bind, opt_arg => <opt_value> );

Mandatory Arguments:

 sql   : sql statement string
 bind  : bind values arrayref

Optional Arguments:
 conn  => alias of the db connection (default is 'default')
          NOTE: this changes the connection alias for all future queries
 attr  => hashref of attributes to use for ONLY THIS QUERY
          Supported: AutoCommit
 debug => pretty print sql debugging lines

 # NOT YET SUPPORTED
 slice     => possible future support for DBI::getall_hashref

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

Examples:

=over

=item ## Simple query:

    my @row = $db->getrow( $sql );

=item ## Needy query:

    my $res = $db->do( $sql, $bind,
          connect => 'altdb', # changes the alias for future connections!
          attr => { AutoCommit => 0, },
          debug => 1,
     );

=back

=head2 Query Failures & Errors

All query methods die on failure, and must be wrapped in a try/catch block.

  eval {
    Activator::DB->query_method( $sql, $bind, @args );
  };
  if ($@) {
    # catch the error
  }

We highly recommend (and use extensively)
L<Exception::Class::TryCatch> which allows this syntactic sugar:

  try eval {
    Activator::DB->query_method( $sql, $bind, @args );
  };
  if ( catch my $e ) {
     # 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

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

=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.

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


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

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

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

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

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

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

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

share/apache2/conf/httpd.conf.tt view on Meta::CPAN

<IfModule worker.c>
StartServers         2
MaxClients         150
MinSpareThreads     25
MaxSpareThreads     75 
ThreadsPerChild     25
MaxRequestsPerChild  0
</IfModule>

#
# Listen: Allows you to bind Apache to specific IP addresses and/or
# ports, in addition to the default. See also the <VirtualHost>
# directive.
#
# Change this to Listen on specific IP addresses as shown below to 
# prevent Apache from glomming onto all bound IP addresses (0.0.0.0)
#

Listen [% apache2.Listen %]:[% apache2.ListenPort %]

#

( run in 1.580 second using v1.01-cache-2.11-cpan-2398b32b56e )