[SearchBuilder-devel] [RFC] transactions handling changes and
tests
Jesse Vincent
jesse at bestpractical.com
Thu Dec 29 21:48:42 EST 2005
On Fri, Dec 30, 2005 at 01:52:24AM +0300, Ruslan Zakirov wrote:
> changes:
> * "EndTransaction [action] [force]" method that generalize commit and
> rollback behaviour.
> * don't import methods(functions) from external modules
> * per $dbh transaction depth
> * delete $DEBUG global var, too many ways for reporting problems
I'd rather split out the totally uncontroversial stuff (imports, DEBUG,
trans depth) and get those in right away and see the EndTxn as its own
patch without source reformattings, so I can see what it's actually
doing. You've included a whole lot of minor cleanups that make it really
hard to see your functionality changes.
Jesse
>
> tests:
> * transactions tests
> * joins tests, two test fails and marked as TODO, I've hit this
> behaviour when was writing
>
> if patch would be approved then I'll update docs and commit it.
>
> --
> Best regards, Ruslan.
> === t/02searches_joins.t
> ==================================================================
> --- t/02searches_joins.t (revision 2817)
> +++ t/02searches_joins.t (local)
> @@ -0,0 +1,298 @@
> +#!/usr/bin/perl -w
> +
> +use strict;
> +use File::Spec;
> +use Test::More;
> +
> +BEGIN { require "t/utils.pl" }
> +our (@AvailableDrivers);
> +
> +use constant TESTS_PER_DRIVER => 17;
> +
> +my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
> +plan tests => $total;
> +
> +foreach my $d ( @AvailableDrivers ) {
> +SKIP: {
> + unless( has_schema( 'TestApp', $d ) ) {
> + skip "No schema for '$d' driver", TESTS_PER_DRIVER;
> + }
> + unless( should_test( $d ) ) {
> + skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
> + }
> +
> + my $handle = get_handle( $d );
> + connect_handle( $handle );
> + isa_ok($handle->dbh, 'DBI::db');
> +
> + my $ret = init_schema( 'TestApp', $handle );
> + isa_ok($ret, 'DBI::st', "Inserted the schema. got a statement handle back");
> +
> + my $count_users = init_data( 'TestApp::User', $handle );
> + ok( $count_users, "init users data" );
> + my $count_groups = init_data( 'TestApp::Group', $handle );
> + ok( $count_groups, "init groups data" );
> + my $count_us2gs = init_data( 'TestApp::UsersToGroup', $handle );
> + ok( $count_us2gs, "init users&groups relations data" );
> +
> + # simple JOIN
> + my $users_obj = TestApp::Users->new( $handle );
> + ok( !$users_obj->_isJoined, "new object isn't joined");
> + my $alias = $users_obj->Join( FIELD1 => 'id',
> + TABLE2 => 'UsersToGroups',
> + FIELD2 => 'UserId' );
> + ok( $alias, "Join returns alias" );
> + TODO: {
> + local $TODO = "is joined doesn't mean is limited, count returns 0";
> + is( $users_obj->Count, 3, "three users are members of the groups" );
> + }
> + # fake limit to check if join actually joins
> + $users_obj->Limit( FIELD => 'id', OPERATOR => 'IS NOT', VALUE => 'NULL' );
> + is( $users_obj->Count, 3, "three users are members of the groups" );
> +
> + # LEFT JOIN
> + $users_obj->CleanSlate;
> + ok( !$users_obj->_isJoined, "new object isn't joined");
> + $alias = $users_obj->Join( TYPE => 'LEFT',
> + FIELD1 => 'id',
> + TABLE2 => 'UsersToGroups',
> + FIELD2 => 'UserId' );
> + ok( $alias, "Join returns alias" );
> + $users_obj->Limit( ALIAS => $alias, FIELD => 'id', OPERATOR => 'IS', VALUE => 'NULL' );
> + is( $users_obj->Count, 1, "user is not member of any group" );
> + is( $users_obj->First->id, 3, "correct user id" );
> +
> + # JOIN via existan alias
> + $users_obj->CleanSlate;
> + ok( !$users_obj->_isJoined, "new object isn't joined");
> + $alias = $users_obj->NewAlias( 'UsersToGroups' );
> + ok( $alias, "new alias" );
> + ok($users_obj->Join( TYPE => 'LEFT',
> + FIELD1 => 'id',
> + ALIAS2 => $alias,
> + FIELD2 => 'UserId' ),
> + "joined table"
> + );
> + $users_obj->Limit( ALIAS => $alias, FIELD => 'id', OPERATOR => 'IS', VALUE => 'NULL' );
> + TODO: {
> + local $TODO = "JOIN with ALIAS2 is broken";
> + is( $users_obj->Count, 1, "user is not member of any group" );
> + }
> +
> +
> + cleanup_schema( 'TestApp', $handle );
> +
> +}} # SKIP, foreach blocks
> +
> +1;
> +
> +
> +package TestApp;
> +sub schema_sqlite {
> +[
> +q{
> +CREATE TABLE Users (
> + id integer primary key,
> + Login varchar(36)
> +) },
> +q{
> +CREATE TABLE UsersToGroups (
> + id integer primary key,
> + UserId integer,
> + GroupId integer
> +) },
> +q{
> +CREATE TABLE Groups (
> + id integer primary key,
> + Name varchar(36)
> +) },
> +]
> +}
> +
> +sub schema_mysql {
> +[
> +q{
> +CREATE TEMPORARY TABLE Users (
> + id integer primary key AUTO_INCREMENT,
> + Login varchar(36)
> +) },
> +q{
> +CREATE TEMPORARY TABLE UsersToGroups (
> + id integer primary key AUTO_INCREMENT,
> + UserId integer,
> + GroupId integer
> +) },
> +q{
> +CREATE TEMPORARY TABLE Groups (
> + id integer primary key AUTO_INCREMENT,
> + Name varchar(36)
> +) },
> +]
> +}
> +
> +sub schema_pg {
> +[
> +q{
> +CREATE TEMPORARY TABLE Users (
> + id serial primary key,
> + Login varchar(36)
> +) },
> +q{
> +CREATE TEMPORARY TABLE UsersToGroups (
> + id serial primary key,
> + UserId integer,
> + GroupId integer
> +) },
> +q{
> +CREATE TEMPORARY TABLE Groups (
> + id serial primary key,
> + Name varchar(36)
> +) },
> +]
> +}
> +
> +package TestApp::User;
> +
> +use base qw/DBIx::SearchBuilder::Record/;
> +
> +sub _Init {
> + my $self = shift;
> + my $handle = shift;
> + $self->Table('Users');
> + $self->_Handle($handle);
> +}
> +
> +sub _ClassAccessible {
> + {
> +
> + id =>
> + {read => 1, type => 'int(11)'},
> + Login =>
> + {read => 1, write => 1, type => 'varchar(36)'},
> +
> + }
> +}
> +
> +sub init_data {
> + return (
> + [ 'Login' ],
> +
> + [ 'ivan' ],
> + [ 'john' ],
> + [ 'bob' ],
> + [ 'aurelia' ],
> + );
> +}
> +
> +package TestApp::Users;
> +
> +use base qw/DBIx::SearchBuilder/;
> +
> +sub _Init {
> + my $self = shift;
> + $self->SUPER::_Init( Handle => shift );
> + $self->Table('Users');
> +}
> +
> +sub NewItem
> +{
> + my $self = shift;
> + return TestApp::User->new( $self->_Handle );
> +}
> +
> +1;
> +
> +package TestApp::Group;
> +
> +use base qw/DBIx::SearchBuilder::Record/;
> +
> +sub _Init {
> + my $self = shift;
> + my $handle = shift;
> + $self->Table('Groups');
> + $self->_Handle($handle);
> +}
> +
> +sub _ClassAccessible {
> + {
> + id =>
> + {read => 1, type => 'int(11)'},
> + Name =>
> + {read => 1, write => 1, type => 'varchar(36)'},
> + }
> +}
> +
> +sub init_data {
> + return (
> + [ 'Name' ],
> +
> + [ 'Developers' ],
> + [ 'Sales' ],
> + [ 'Support' ],
> + );
> +}
> +
> +package TestApp::Groups;
> +
> +use base qw/DBIx::SearchBuilder/;
> +
> +sub _Init {
> + my $self = shift;
> + $self->SUPER::_Init( Handle => shift );
> + $self->Table('Groups');
> +}
> +
> +sub NewItem { return TestApp::Group->new( (shift)->_Handle ) }
> +
> +1;
> +
> +package TestApp::UsersToGroup;
> +
> +use base qw/DBIx::SearchBuilder::Record/;
> +
> +sub _Init {
> + my $self = shift;
> + my $handle = shift;
> + $self->Table('UsersToGroups');
> + $self->_Handle($handle);
> +}
> +
> +sub _ClassAccessible {
> + {
> +
> + id =>
> + {read => 1, type => 'int(11)'},
> + UserId =>
> + {read => 1, type => 'int(11)'},
> + GroupId =>
> + {read => 1, type => 'int(11)'},
> + }
> +}
> +
> +sub init_data {
> + return (
> + [ 'GroupId', 'UserId' ],
> +# dev group
> + [ 1, 1 ],
> + [ 1, 2 ],
> + [ 1, 4 ],
> +# sales
> +# [ 2, 0 ],
> +# support
> + [ 3, 1 ],
> + );
> +}
> +
> +package TestApp::UsersToGroups;
> +
> +use base qw/DBIx::SearchBuilder/;
> +
> +sub _Init {
> + my $self = shift;
> + $self->Table('UsersToGroups');
> + return $self->SUPER::_Init( Handle => shift );
> +}
> +
> +sub NewItem { return TestApp::UsersToGroup->new( (shift)->_Handle ) }
> +
> +1;
> === t/03transactions.t
> ==================================================================
> --- t/03transactions.t (revision 2817)
> +++ t/03transactions.t (local)
> @@ -0,0 +1,178 @@
> +#!/usr/bin/perl -w
> +
> +
> +use strict;
> +use warnings;
> +use File::Spec;
> +use Test::More;
> +BEGIN { require "t/utils.pl" }
> +our (@AvailableDrivers);
> +
> +use constant TESTS_PER_DRIVER => 42;
> +
> +my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
> +plan tests => $total;
> +
> +foreach my $d ( @AvailableDrivers ) {
> +SKIP: {
> + unless( has_schema( 'TestApp::Address', $d ) ) {
> + skip "No schema for '$d' driver", TESTS_PER_DRIVER;
> + }
> + unless( should_test( $d ) ) {
> + skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
> + }
> +
> + my $handle = get_handle( $d );
> + isa_ok($handle, 'DBIx::SearchBuilder::Handle');
> + { # clear PrevHandle
> + no warnings 'once';
> + $DBIx::SearchBuilder::Handle::PrevHandle = undef;
> + }
> +
> +diag("disconnected handle") if $ENV{'TEST_VERBOSE'};
> + is($handle->TransactionDepth, undef, "undefined transaction depth");
> + is($handle->BeginTransaction, undef, "couldn't begin transaction");
> + is($handle->TransactionDepth, undef, "still undefined transaction depth");
> + ok($handle->EndTransaction(1,'force'), "force commit success silently");
> + ok($handle->Commit('force'), "force commit success silently");
> + ok($handle->EndTransaction(0,'force'), "force rollback success silently");
> + ok($handle->Rollback('force'), "force rollback success silently");
> + # XXX: ForceRollback function should deprecated
> + ok($handle->ForceRollback, "force rollback success silently");
> + {
> + my $warn = 0;
> + local $SIG{__WARN__} = sub{ $_[0] =~ /transaction with none in progress/? $warn++: warn @_ };
> + ok(!$handle->Rollback, "not forced rollback returns false");
> + is($warn, 1, "not forced rollback fires warning");
> + ok(!$handle->Commit, "not forced commit returns false");
> + is($warn, 2, "not forced commit fires warning");
> + }
> +
> + connect_handle( $handle );
> + isa_ok($handle->dbh, 'DBI::db');
> +
> +diag("connected handle without transaction") if $ENV{'TEST_VERBOSE'};
> + is($handle->TransactionDepth, 0, "transaction depth is 0");
> + ok($handle->Commit('force'), "force commit success silently");
> + ok($handle->Rollback('force'), "force rollback success silently");
> + {
> + my $warn = 0;
> + local $SIG{__WARN__} = sub{ $_[0] =~ /transaction with none in progress/? $warn++: warn @_ };
> + ok(!$handle->Rollback, "not forced rollback returns false");
> + is($warn, 1, "not forced rollback fires warning");
> + ok(!$handle->Commit, "not forced commit returns false");
> + is($warn, 2, "not forced commit fires warning");
> + }
> +
> +diag("begin and commit empty transaction") if $ENV{'TEST_VERBOSE'};
> + ok($handle->BeginTransaction, "begin transaction");
> + is($handle->TransactionDepth, 1, "transaction depth is 1");
> + ok($handle->Commit, "commit successed");
> + is($handle->TransactionDepth, 0, "transaction depth is 0");
> +
> +diag("begin and rollback empty transaction") if $ENV{'TEST_VERBOSE'};
> + ok($handle->BeginTransaction, "begin transaction");
> + is($handle->TransactionDepth, 1, "transaction depth is 1");
> + ok($handle->Rollback, "rollback successed");
> + is($handle->TransactionDepth, 0, "transaction depth is 0");
> +
> +diag("nested empty transactions") if $ENV{'TEST_VERBOSE'};
> + ok($handle->BeginTransaction, "begin transaction");
> + is($handle->TransactionDepth, 1, "transaction depth is 1");
> + ok($handle->BeginTransaction, "begin nested transaction");
> + is($handle->TransactionDepth, 2, "transaction depth is 2");
> + ok($handle->Commit, "commit successed");
> + is($handle->TransactionDepth, 1, "transaction depth is 1");
> + ok($handle->Commit, "commit successed");
> + is($handle->TransactionDepth, 0, "transaction depth is 0");
> +
> +diag("init schema in transaction and commit") if $ENV{'TEST_VERBOSE'};
> + # MySQL doesn't support transactions for CREATE TABLE
> + # so it's fake transactions test
> + ok($handle->BeginTransaction, "begin transaction");
> + is($handle->TransactionDepth, 1, "transaction depth is 1");
> + my $ret = init_schema( 'TestApp::Address', $handle );
> + isa_ok($ret, 'DBI::st', "Inserted the schema. got a statement handle back");
> + ok($handle->Commit, "commit successed");
> + is($handle->TransactionDepth, 0, "transaction depth is 0");
> +
> + cleanup_schema( 'TestApp::Address', $handle );
> +}} # SKIP, foreach blocks
> +
> +1;
> +
> +
> +
> +package TestApp::Address;
> +
> +use base qw/DBIx::SearchBuilder::Record/;
> +
> +sub _Init {
> + my $self = shift;
> + my $handle = shift;
> + $self->Table('Address');
> + $self->_Handle($handle);
> +}
> +
> +sub ValidateName
> +{
> + my ($self, $value) = @_;
> + return 0 if $value =~ /invalid/i;
> + return 1;
> +}
> +
> +sub _ClassAccessible {
> +
> + {
> +
> + id =>
> + {read => 1, type => 'int(11)', default => ''},
> + Name =>
> + {read => 1, write => 1, type => 'varchar(14)', default => ''},
> + Phone =>
> + {read => 1, write => 1, type => 'varchar(18)', length => 18, default => ''},
> + EmployeeId =>
> + {read => 1, write => 1, type => 'int(8)', default => ''},
> +
> +}
> +
> +}
> +
> +sub schema_mysql {
> +<<EOF;
> +CREATE TEMPORARY TABLE Address (
> + id integer AUTO_INCREMENT,
> + Name varchar(36),
> + Phone varchar(18),
> + EmployeeId int(8),
> + PRIMARY KEY (id)) TYPE='InnoDB'
> +EOF
> +
> +}
> +
> +sub schema_pg {
> +<<EOF;
> +CREATE TEMPORARY TABLE Address (
> + id serial PRIMARY KEY,
> + Name varchar,
> + Phone varchar,
> + EmployeeId integer
> +)
> +EOF
> +
> +}
> +
> +sub schema_sqlite {
> +
> +<<EOF;
> +CREATE TABLE Address (
> + id integer primary key,
> + Name varchar(36),
> + Phone varchar(18),
> + EmployeeId int(8))
> +EOF
> +
> +}
> +
> +1;
> +
> === SearchBuilder/Handle.pm
> ==================================================================
> --- SearchBuilder/Handle.pm (revision 2817)
> +++ SearchBuilder/Handle.pm (local)
> @@ -1,15 +1,13 @@
> # $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle.pm,v 1.21 2002/01/28 06:11:37 jesse Exp $
> package DBIx::SearchBuilder::Handle;
> use strict;
> -use Carp qw(croak cluck);
> -use DBI;
> -use Class::ReturnValue;
> -use Encode;
> +use Carp ();
> +use DBI ();
> +use Class::ReturnValue ();
> +use Encode ();
>
> -use vars qw($VERSION @ISA %DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
> +use vars qw($VERSION @ISA %DBIHandle $PrevHandle %TRANSDEPTH);
>
> -$TRANSDEPTH = 0;
> -
> $VERSION = '$Version$';
>
>
> @@ -105,7 +103,7 @@
>
> # Only connect if we're not connected to this source already
> if ((! $self->dbh ) || (!$self->dbh->ping) || ($self->DSN ne $dsn) ) {
> - my $handle = DBI->connect($self->DSN, $args{'User'}, $args{'Password'}) || croak "Connect Failed $DBI::errstr\n" ;
> + my $handle = DBI->connect($self->DSN, $args{'User'}, $args{'Password'}) || Carp::croak "Connect Failed $DBI::errstr\n";
>
> #databases do case conversion on the name of columns returned.
> #actually, some databases just ignore case. this smashes it to something consistent
> @@ -302,8 +300,6 @@
> }
>
>
> -
> -
> =head2 Disconnect
>
> Disconnect from your DBI datasource
> @@ -336,7 +332,7 @@
> #If we are setting the database handle, set it.
> $DBIHandle{$self} = $PrevHandle = shift if (@_);
>
> - return($DBIHandle{$self} ||= $PrevHandle);
> + return ($DBIHandle{$self} ||= $PrevHandle);
> }
>
>
> @@ -447,74 +443,54 @@
> sub SimpleQuery {
> my $self = shift;
> my $QueryString = shift;
> - my @bind_values;
> - @bind_values = (@_) if (@_);
> + my @bind_values = @_;
>
> my $sth = $self->dbh->prepare($QueryString);
> unless ($sth) {
> - if ($DEBUG) {
> - die "$self couldn't prepare the query '$QueryString'"
> - . $self->dbh->errstr . "\n";
> - }
> - else {
> - warn "$self couldn't prepare the query '$QueryString'"
> - . $self->dbh->errstr . "\n";
> - my $ret = Class::ReturnValue->new();
> - $ret->as_error(
> - errno => '-1',
> - message => "Couldn't prepare the query '$QueryString'."
> - . $self->dbh->errstr,
> - do_backtrace => undef
> - );
> - return ( $ret->return_value );
> - }
> + Carp::cluck "$self couldn't prepare the query '$QueryString': "
> + . $self->dbh->errstr . "\n";
> + my $ret = Class::ReturnValue->new();
> + $ret->as_error(
> + errno => '-1',
> + message => "Couldn't prepare the query '$QueryString'."
> + . $self->dbh->errstr,
> + do_backtrace => undef
> + );
> + return ( $ret->return_value );
> }
>
> # Check @bind_values for HASH refs
> - for ( my $bind_idx = 0 ; $bind_idx < scalar @bind_values ; $bind_idx++ ) {
> - if ( ref( $bind_values[$bind_idx] ) eq "HASH" ) {
> - my $bhash = $bind_values[$bind_idx];
> - $bind_values[$bind_idx] = $bhash->{'value'};
> - delete $bhash->{'value'};
> - $sth->bind_param( $bind_idx + 1, undef, $bhash );
> + for ( my $i = 0 ; $i < @bind_values ; $i++ ) {
> + my $attrs;
> + if ( ref $bind_values[$i] eq "HASH" ) {
> + $attrs = $bind_values[$i];
> + $bind_values[$i] = delete $attrs->{'value'};
> }
> # Some databases, such as Oracle fail to cope if it's a perl utf8
> # string. they desperately want bytes.
> - Encode::_utf8_off($bind_values[$bind_idx]);
> + Encode::_utf8_off( $bind_values[$i] );
> + $sth->bind_param( $i + 1, $bind_values[$i], $attrs );
> }
>
> my $basetime;
> - if ( $self->LogSQLStatements ) {
> - $basetime = Time::HiRes::time();
> - }
> - my $executed;
> - {
> - no warnings 'uninitialized' ; # undef in bind_values makes DBI sad
> - eval { $executed = $sth->execute(@bind_values) };
> - }
> - if ( $self->LogSQLStatements ) {
> + $basetime = Time::HiRes::time() if $self->LogSQLStatements;
> + my $executed = $sth->execute;
> + if ( defined $basetime ) {
> $self->_LogSQLStatement( $QueryString, Time::HiRes::time() - $basetime, @bind_values );
> }
>
> - if ( $@ or !$executed ) {
> - if ($DEBUG) {
> - die "$self couldn't execute the query '$QueryString'"
> - . $self->dbh->errstr . "\n";
> + unless ( $executed ) {
> + Carp::cluck "$self couldn't execute the query '$QueryString'";
>
> - }
> - else {
> - cluck "$self couldn't execute the query '$QueryString'";
> + my $ret = Class::ReturnValue->new();
> + $ret->as_error(
> + errno => '-1',
> + message => "Couldn't execute the query '$QueryString'"
> + . $self->dbh->errstr,
> + do_backtrace => undef
> + );
> + return ( $ret->return_value );
>
> - my $ret = Class::ReturnValue->new();
> - $ret->as_error(
> - errno => '-1',
> - message => "Couldn't execute the query '$QueryString'"
> - . $self->dbh->errstr,
> - do_backtrace => undef
> - );
> - return ( $ret->return_value );
> - }
> -
> }
> return ($sth);
>
> @@ -532,16 +508,10 @@
> =cut
>
> sub FetchResult {
> - my $self = shift;
> - my $query = shift;
> - my @bind_values = @_;
> - my $sth = $self->SimpleQuery($query, @bind_values);
> - if ($sth) {
> + my $self = shift;
> + my $sth = $self->SimpleQuery(@_);
> + return $sth unless $sth;
> return ($sth->fetchrow);
> - }
> - else {
> - return($sth);
> - }
> }
>
>
> @@ -553,12 +523,10 @@
> =cut
>
> sub BinarySafeBLOBs {
> - my $self = shift;
> - return(1);
> + return 1;
> }
>
>
> -
> =head2 KnowsBLOBs
>
> Returns 1 if the current database supports inserts of BLOBs automatically.
> @@ -567,12 +535,10 @@
> =cut
>
> sub KnowsBLOBs {
> - my $self = shift;
> - return(1);
> + return 1;
> }
>
>
> -
> =head2 BLOBParams FIELD_NAME FIELD_TYPE
>
> Returns a hash ref for the bind_param call to identify BLOB types used by
> @@ -581,13 +547,11 @@
> =cut
>
> sub BLOBParams {
> - my $self = shift;
> # Don't assign to key 'value' as it is defined later.
> - return ( {} );
> + return {};
> }
>
>
> -
> =head2 DatabaseVersion
>
> Returns the database's version. The base implementation uses a "SELECT VERSION"
> @@ -615,13 +579,10 @@
>
> sub CaseSensitive {
> my $self = shift;
> - return(1);
> + return 1;
> }
>
>
> -
> -
> -
> =head2 _MakeClauseCaseInsensitive FIELD OPERATOR VALUE
>
> Takes a field, operator and value. performs the magic necessary to make
> @@ -638,15 +599,13 @@
> my $value = shift;
>
> if ($value !~ /^\d+$/) { # don't downcase integer values
> - $field = "lower($field)";
> + $field = "LOWER($field)";
> $value = lc($value);
> }
> - return ($field, $operator, $value,undef);
> + return ($field, $operator, $value, undef);
> }
>
>
> -
> -
> =head2 BeginTransaction
>
> Tells DBIx::SearchBuilder to begin a new SQL transaction. This will
> @@ -658,16 +617,45 @@
>
> sub BeginTransaction {
> my $self = shift;
> - $TRANSDEPTH++;
> - if ($TRANSDEPTH > 1 ) {
> - return ($TRANSDEPTH);
> +
> + my $depth = $self->TransactionDepth;
> + return unless defined $depth;
> +
> + $self->TransactionDepth(++$depth);
> + return 1 if $depth > 1;
> +
> + return $self->dbh->begin_work;
> +}
> +
> +sub EndTransaction {
> + my $self = shift;
> + my $action = shift;
> + $action = 1 unless defined $action;
> + my $force = shift;
> +
> + my $depth = $self->TransactionDepth || 0;
> + unless ( $depth ) {
> + unless( $force ) {
> + Carp::cluck(
> + 'Attempted to '
> + .($action? 'commit': 'rollback')
> + .' a transaction with none in progress'
> + );
> + return 0;
> + }
> + return 1;
> } else {
> - return($self->dbh->begin_work);
> + $depth--;
> }
> + $depth = 0 if $force;
> +
> + $self->TransactionDepth( $depth );
> + return 1 if $depth;
> + return $self->dbh->rollback unless $action;
> + return $self->dbh->commit;
> }
>
>
> -
> =head2 Commit
>
> Tells DBIx::SearchBuilder to commit the current SQL transaction.
> @@ -677,18 +665,10 @@
>
> sub Commit {
> my $self = shift;
> - unless ($TRANSDEPTH) {Carp::confess("Attempted to commit a transaction with none in progress")};
> - $TRANSDEPTH--;
> -
> - if ($TRANSDEPTH == 0 ) {
> - return($self->dbh->commit);
> - } else { #we're inside a transaction
> - return($TRANSDEPTH);
> - }
> + $self->EndTransaction(1, @_);
> }
>
>
> -
> =head2 Rollback [FORCE]
>
> Tells DBIx::SearchBuilder to abort the current SQL transaction.
> @@ -700,26 +680,7 @@
>
> sub Rollback {
> my $self = shift;
> - my $force = shift;
> -
> - my $dbh = $self->dbh;
> - unless( $dbh ) {
> - $TRANSDEPTH = 0;
> - return;
> - }
> -
> - #unless ($TRANSDEPTH) {Carp::confess("Attempted to rollback a transaction with none in progress")};
> - if ($force) {
> - $TRANSDEPTH = 0;
> - return($dbh->rollback);
> - }
> -
> - $TRANSDEPTH-- if ($TRANSDEPTH >= 1);
> - if ($TRANSDEPTH == 0 ) {
> - return($dbh->rollback);
> - } else { #we're inside a transaction
> - return($TRANSDEPTH);
> - }
> + $self->EndTransaction(0, @_);
> }
>
>
> @@ -743,11 +704,22 @@
>
> sub TransactionDepth {
> my $self = shift;
> - return ($TRANSDEPTH);
> -}
>
> + my $dbh = $self->dbh;
> + return undef unless $dbh && $dbh->ping;
>
> + if ( @_ ) {
> + my $depth = shift;
> + if ( $depth ) {
> + $TRANSDEPTH{"$dbh"} = $depth;
> + } else {
> + delete $TRANSDEPTH{"$dbh"};
> + }
> + }
> + return $TRANSDEPTH{"$dbh"} || 0;
> +}
>
> +
> =head2 ApplyLimits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
>
> takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
> @@ -806,8 +778,6 @@
> @_
> );
>
> - my $string;
> -
> my $alias;
>
> #If we're handed in an ALIAS2, we need to go remove it from the Aliases array.
> @@ -860,24 +830,17 @@
> }
> $args{'SearchBuilder'}->{'aliases'} = \@new_aliases;
> }
> -
> else {
> $alias = $args{'SearchBuilder'}->_GetAlias( $args{'TABLE2'} );
>
> }
>
> - if ( $args{'TYPE'} =~ /LEFT/i ) {
> -
> - $string = " LEFT JOIN " . $args{'TABLE2'} . " $alias ";
> -
> + my $string = '';
> + if ( $args{'TYPE'} =~ /(LEFT|RIGHT)/i ) {
> + $string .= " $1";
> }
> - else {
> + $string .= " JOIN $args{'TABLE2'} $alias ";
>
> - $string = " JOIN " . $args{'TABLE2'} . " $alias ";
> -
> - }
> -
> -
> my $criterion;
> if ($args{'EXPRESSION'}) {
> $criterion = $args{'EXPRESSION'};
> @@ -1044,9 +1007,12 @@
>
>
> sub DESTROY {
> - my $self = shift;
> - $self->Disconnect if $self->{'DisconnectHandleOnDestroy'};
> - delete $DBIHandle{$self};
> + my $self = shift;
> + if( $self->{'DisconnectHandleOnDestroy'} ) {
> + $self->TransactionDepth(0);
> + $self->Disconnect;
> + }
> + delete $DBIHandle{$self};
> }
>
>
>
> _______________________________________________
> SearchBuilder-devel mailing list
> SearchBuilder-devel at bestpractical.com
> http://lists.bestpractical.com/cgi-bin/mailman/listinfo/searchbuilder-devel
--
More information about the SearchBuilder-devel
mailing list