[Bast-commits] r3796 - in DBIx-Class/0.08/trunk:
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI/Oracle t
wreis at dev.catalyst.perl.org
wreis at dev.catalyst.perl.org
Sat Sep 29 01:35:56 GMT 2007
Author: wreis
Date: 2007-09-29 01:35:55 +0100 (Sat, 29 Sep 2007)
New Revision: 3796
Modified:
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
DBIx-Class/0.08/trunk/t/72pg.t
Log:
select for patch from justin
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm 2007-09-28 07:51:40 UTC (rev 3795)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm 2007-09-29 00:35:55 UTC (rev 3796)
@@ -5,6 +5,8 @@
use strict;
use warnings;
+__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract::Oracle');
+
BEGIN {
package DBIC::SQL::Abstract::Oracle;
@@ -91,18 +93,6 @@
}
}
-sub sql_maker {
- my ($self) = @_;
-
- unless ($self->_sql_maker) {
- $self->_sql_maker(
- new DBIC::SQL::Abstract::Oracle( $self->_sql_maker_args )
- );
- }
-
- return $self->_sql_maker;
-}
-
1;
__END__
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2007-09-28 07:51:40 UTC (rev 3795)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2007-09-29 00:35:55 UTC (rev 3796)
@@ -19,6 +19,9 @@
__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
+__PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class/);
+__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract');
+
BEGIN {
package DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
@@ -83,6 +86,15 @@
my ($sql, @ret) = $self->SUPER::select(
$table, $self->_recurse_fields($fields), $where, $order, @rest
);
+ $sql .=
+ $self->{for} ?
+ (
+ $self->{for} eq 'update' ? ' FOR UPDATE' :
+ $self->{for} eq 'shared' ? ' FOR SHARE' :
+ ''
+ ) :
+ ''
+ ;
return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
}
@@ -745,7 +757,8 @@
sub sql_maker {
my ($self) = @_;
unless ($self->_sql_maker) {
- $self->_sql_maker(new DBIC::SQL::Abstract( $self->_sql_maker_args ));
+ my $sql_maker_class = $self->sql_maker_class;
+ $self->_sql_maker($sql_maker_class->new( $self->_sql_maker_args ));
}
return $self->_sql_maker;
}
@@ -1085,9 +1098,15 @@
sub _select {
my ($self, $ident, $select, $condition, $attrs) = @_;
my $order = $attrs->{order_by};
+
if (ref $condition eq 'SCALAR') {
$order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
}
+
+ my $for = delete $attrs->{for};
+ my $sql_maker = $self->sql_maker;
+ local $sql_maker->{for} = $for;
+
if (exists $attrs->{group_by} || $attrs->{having}) {
$order = {
group_by => $attrs->{group_by},
@@ -1105,6 +1124,7 @@
if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
push @args, $attrs->{rows}, $attrs->{offset};
}
+
return $self->_execute(@args);
}
Modified: DBIx-Class/0.08/trunk/t/72pg.t
===================================================================
--- DBIx-Class/0.08/trunk/t/72pg.t 2007-09-28 07:51:40 UTC (rev 3795)
+++ DBIx-Class/0.08/trunk/t/72pg.t 2007-09-29 00:35:55 UTC (rev 3796)
@@ -27,7 +27,7 @@
plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
. ' (note: creates and drops tables named artist and casecheck!)' unless ($dsn && $user);
-plan tests => 10;
+plan tests => 16;
DBICTest::Schema->load_classes( 'Casecheck' );
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -99,6 +99,83 @@
my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' );
is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" );
+# Test SELECT ... FOR UPDATE
+my $HaveSysSigAction = eval "require Sys::SigAction" && !$@;
+if ($HaveSysSigAction) {
+ Sys::SigAction->import( 'set_sig_handler' );
+}
+
+SKIP: {
+ skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
+ # create a new schema
+ my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
+ $schema2->source("Artist")->name("testschema.artist");
+
+ $schema->txn_do( sub {
+ my $artist = $schema->resultset('Artist')->search(
+ {
+ artistid => 1
+ },
+ {
+ for => 'update'
+ }
+ )->first;
+ is($artist->artistid, 1, "select for update returns artistid = 1");
+
+ my $artist_from_schema2;
+ my $error_ok = 0;
+ eval {
+ my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
+ alarm(2);
+ $artist_from_schema2 = $schema2->resultset('Artist')->find(1);
+ $artist_from_schema2->name('fooey');
+ $artist_from_schema2->update;
+ alarm(0);
+ };
+ if (my $e = $@) {
+ $error_ok = $e =~ /DBICTestTimeout/;
+ }
+
+ # Make sure that an error was raised, and that the update failed
+ ok($error_ok, "update from second schema times out");
+ ok($artist_from_schema2->is_column_changed('name'), "'name' column is still dirty from second schema");
+ });
+}
+
+SKIP: {
+ skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
+ # create a new schema
+ my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
+ $schema2->source("Artist")->name("testschema.artist");
+
+ $schema->txn_do( sub {
+ my $artist = $schema->resultset('Artist')->search(
+ {
+ artistid => 1
+ },
+ )->first;
+ is($artist->artistid, 1, "select for update returns artistid = 1");
+
+ my $artist_from_schema2;
+ my $error_ok = 0;
+ eval {
+ my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
+ alarm(2);
+ $artist_from_schema2 = $schema2->resultset('Artist')->find(1);
+ $artist_from_schema2->name('fooey');
+ $artist_from_schema2->update;
+ alarm(0);
+ };
+ if (my $e = $@) {
+ $error_ok = $e =~ /DBICTestTimeout/;
+ }
+
+ # Make sure that an error was NOT raised, and that the update succeeded
+ ok(! $error_ok, "update from second schema DOES NOT timeout");
+ ok(! $artist_from_schema2->is_column_changed('name'), "'name' column is NOT dirty from second schema");
+ });
+}
+
END {
if($dbh) {
$dbh->do("DROP TABLE testschema.artist;");
More information about the Bast-commits
mailing list