select results from the CPAN

select

Activator

view release on metacpan or search on metacpan

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

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

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

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

=item * Fix warning messages

If you create a script that uses this module (or some other activator
module that depends on this module), the warning messages are rather
arcane. This script:

  #!/usr/bin/perl
  use strict;
  use warnings;
  use Activator::DB;
  Activator::DB->getrow( 'select * from some_table', [],  connect->'default');

Run this way:

  ./test.pl

Produces this error:

  activator_db_config missing You must define the key "Activator::DB" or "Activator->DB" in your project configuration

Probably should say something about the fact that you should have run it like this:

t/DB.t view on Meta::CPAN


# create test dbs, users, tables
if ( $ENV{ACT_DB_TEST_ENGINE} eq 'mysql' ) {
    system( "cat $ENV{PWD}/t/data/DB-create-mysql-test.sql | mysql -u $ENV{ACT_DB_TEST_USER} -p$ENV{ACT_DB_TEST_PASSWORD}");
}
else {
    system( "psql template1 $ENV{ACT_DB_TEST_USER} < $ENV{PWD}/t/data/DB-create-Pg-test.sql");

}

# connect/select the old skool way
my $mysql_dsn = 'DBI:mysql:act_db_test1:localhost';
my $pg_dsn    = 'DBI:Pg:database=act_db_test1';
my $dsn = ( $ENV{ACT_DB_TEST_ENGINE} eq 'Pg' ? $pg_dsn : $mysql_dsn );

$dbh =  DBI->connect( $dsn, $ENV{ACT_DB_TEST_USER}, $ENV{ACT_DB_TEST_PASSWORD} );
ok( !$@, 'test old skool: DBI->connect without $@');
ok( !$DBI::err, 'no $DBI::err');
ok( !$DBI::errstr, 'no $DBI::errstr');
ok( $dbh, 'got dbh with DBI');
lives_ok { $dbh->ping() } 'ping $dbh with DBI';

# make sure we can do the basics with DBI
@row = $dbh->selectrow_array( 'select * from t1' );
ok( $row[0] eq '1' && $row[1] eq 'd1_t1_r1_c1' && $row[2] eq 'd1_t1_r1_c2', 'can select row with DBI');
lives_ok { $dbh->disconnect() } 'disconnect $dbh with DBI';

################################################################################
#
# connnect to the default db
#

# set up all the connections proppa
Activator::Registry->register('Activator::DB->connections->test1_mysql->user', $ENV{ACT_DB_TEST_USER});
Activator::Registry->register('Activator::DB->connections->test1_mysql->pass', $ENV{ACT_DB_TEST_PASSWORD});

t/DB.t view on Meta::CPAN

    $testdb1 = 'test1_pg';
    $testdb2 = 'test2_pg';
}

lives_ok {
    $db = Activator::DB->connect('default')
} 'new skool: no connect error on default db';
ok( defined( $db ) && $db->isa('Activator::DB'), 'valid default Activator::DB object');
ok( $db->{cur_alias} eq $testdb1, "alias set to testdb1");

# select default row
lives_ok {
    @row = $db->getrow( 'select * from t1' );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd1_t1_r1_c1' && $row[2] eq 'd1_t1_r1_c2', 'can select row');

# connnect to alt db
lives_ok {
    $db = Activator::DB->connect($testdb2);
} 'no connect error on test2_* db';
ok( defined( $db ) && $db->isa('Activator::DB'), 'valid test2 Activator::DB object');
ok( $db->{cur_alias} eq $testdb2, 'alias set to test2');

# select default row
lives_ok {
    @row = $db->getrow( 'select * from t1' );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd2_t1_r1_c1' && $row[2] eq 'd2_t1_r1_c2', 'can select row from other db');

# select something that returns nothing, make sure we get empty row(ref) back
lives_ok {
    @row = $db->getrow( "select * from t1 where id = '-42'" );
} "getrow doesn't die";

ok( @row == 0, 'got empty array when select returns no rows' );

lives_ok {
    $rowref = $db->getrow_arrayref( "select * from t1 where id = '-42'" );
} "getrow_arrayref doesn't die";
ok( @$rowref == 0, 'got empty arrayref when select returns no rows' );

lives_ok {
    $rowref = $db->getrow_hashref( "select * from t1 where id = '-42'" );
} "getrow_hashref doesn't die";
ok( keys %$rowref == 0, 'got empty hashref when select returns no rows' );

# go back to default db
lives_ok {
    $db->connect();
} 'no connect error';
ok( defined( $db ) && $db->isa('Activator::DB'), 'reverted to valid default Activator::DB object');
ok( $db->{cur_alias} eq $testdb1, "alias reset to $testdb1");

# select default row
lives_ok {
    @row = $db->getrow( 'select * from t1' );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd1_t1_r1_c1' && $row[2] eq 'd1_t1_r1_c2', 'can select row from orig db');

# select using "change_alias"
lives_ok {
    @row = $db->getrow( 'select * from t1', [], connect =>$testdb2 );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd2_t1_r1_c1' && $row[2] eq 'd2_t1_r1_c2', 'can select row from other db using connect');

# select staticly using connect
lives_ok {
    @row = Activator::DB->getrow( 'select * from t1', [], connect =>$testdb1 );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd1_t1_r1_c1' && $row[2] eq 'd1_t1_r1_c2', 'can select row from orig staticly');

# create a row
lives_ok {
    $id = Activator::DB->do_id( 'insert into t1 ( c1, c2) '.
				"values ( 'd1_t1_r2_c1', 'd1_t1_r2_c2')",
				[], 
				connect => 'def', # should go back to $testdb1
				seq => 't1_id_seq', # for Pg, ignored for mysql
			      );
} "do_id doesn't die";
ok( $id && $id == 2, 'can insert' );
ok( $db->{cur_alias} eq $testdb1, "alias set to $testdb1 using 'def'");

# select the new row
lives_ok {
    @row = Activator::DB->getrow( "select * from t1 where id='$id'", [], connect => 'def', debug => 1 );
} "getrow doesn't die";
ok( $row[0] eq '2' && $row[1] eq 'd1_t1_r2_c1' && $row[2] eq 'd1_t1_r2_c2', 'can select new row');

# test "do"
lives_ok {
    $res = $db->do( "delete from t1 where id='$id'" );
} "do doesn't die";
ok( $res == 1, 'do affects corect num of rows');
lives_ok {
    @row = $db->getrow( "select * from t1 where id='$id'" );
} "getrow doesn't die";
ok( @row == 0, 'do successfully deleted row');

# fail on static calls without connect string
throws_ok {
    @row = Activator::DB->getrow( "select * from t1 where id='$id'" );
} 'Activator::Exception::DB', 'static call dies without connect arg';

throws_ok {
    @row = Activator::DB->getrow( "sel  from foo", [], connect => 'def');
} 'Activator::Exception::DB', 'invalid sql throws Activator::Exception::DB';

throws_ok {
    @row = Activator::DB->getrow( "select * from t1", [], connect => 'defasdlkj');
} 'Activator::Exception::DB', 'invalid connect alias dies';

# get row as arrayref
lives_ok {
    $rowref = $db->getrow_arrayref( "select * from t1" );
} "getrow_arrayref doesn't die after invalid connect attempt";
ok( ref($rowref) eq 'ARRAY', 'getrow_arrayref returns arrayref');
ok( @$rowref[0] eq '1' && @$rowref[1] eq 'd1_t1_r1_c1' && @$rowref[2] eq 'd1_t1_r1_c2', 'getrow_arrayref returns expected data');

# get row as hashref
lives_ok {
    $rowref = $db->getrow_hashref( "select * from t1" );
} "getrow_hashref doesn't die";
ok( ref($rowref) eq 'HASH', 'getrow_hashref returns hashref');
ok( $rowref->{id} eq '1' && $rowref->{c1} eq 'd1_t1_r1_c1' && $rowref->{c2} eq 'd1_t1_r1_c2', 'getrow_hashref returns expected data');

my $db2 = Activator::DB->connect($testdb1);
my $db3 = Activator::DB->connect($testdb2);
ok( $db2 eq $db3, 'multiple db objects refer to the same pointer' );

# force reconnect
$db->connect( $testdb1);
delete $db->{connections}->{ $testdb1 }->{dbh};
lives_ok {
    @row = $db->getrow( 'select * from t1' );
} "getrow doesn't die";
ok( $row[0] eq '1' && $row[1] eq 'd1_t1_r1_c1' && $row[2] eq 'd1_t1_r1_c2', 'can select row when dbh is missing');


# TODO: test getall_*

# test aborting transaction
lives_ok {
    $db->connect($testdb1);
    $db->begin();
} "can begin transaction";

lives_ok {
    $db->do( 'update t1 set c1 = ?', [ 'broken' ]);
} "can update within transaction";

lives_ok {
    @row = $db->getrow( "select * from t1 where id ='1'" );
} "can select within transaction";

ok( $row[1] eq 'broken', 'value is set' );

lives_ok {
    $db->abort();
} "can abort transaction";

lives_ok {
    @row = $db->getrow( "select * from t1 where id ='1'" );
} "can select after transaction";

ok( $row[1] eq 'd1_t1_r1_c1', 'value reverts to pre-transaction state' );


# test atomic action now
lives_ok {
    $db->do( "update t1 set c1 = 'intermediate' where id='1'");
} "can update row outside transaction";

lives_ok {
    @row = $db->getrow( "select * from t1 where id ='1'" );
} "can select row outside transaction";

ok( $row[1] eq 'intermediate', 'value set outside transaction' );

# test committing transaction
lives_ok {
    $db->connect($testdb1);
    $db->begin();
} "can begin transaction";

lives_ok {
    $db->do( 'update t1 set c1 = ?', [ 'd1_t1_r1_c1_upd' ]);
} "can update within transaction";

lives_ok {
    $db->commit();
} "can commit transaction";

lives_ok {
    @row = $db->getrow( "select * from t1 where id ='1'" );
} "can select again outside commited transaction";

ok( $row[1] eq 'd1_t1_r1_c1_upd', 'transaction commited, value verified' );

# delete test dbs, users, tables
if ( $ENV{ACT_DB_TEST_ENGINE} eq 'mysql' ) {
    system( "cat $ENV{PWD}/t/data/DB-drop-mysql-test.sql | mysql -u root");
}
else {
    $db = Activator::DB->disconnect_all();
    system( "psql template1 $ENV{ACT_DB_TEST_USER} < $ENV{PWD}/t/data/DB-drop-Pg-test.sql ");

( run in 0.516 second using v1.01-cache-2.11-cpan-49f99fa48dc )