[Dbix-class] Re: SELECT .. FOR ... (and other db-specific clauses).

Daisuke Maki daisuke at endeworks.jp
Fri Jul 6 02:38:48 GMT 2007


Matt,

per your suggestion, attatched is the revised patch. Basically the same =

logic, but this time the logic is stuffed into DBIC::SQL::Abstract::Pg, =

instead of the storage class.

Let me know if there any other problems :)

Regards,
--d

Matt S Trout wrote:
> On Thu, Jul 05, 2007 at 02:45:23PM +0900, Daisuke Maki wrote:
>> good to know that you're aware of these problems. thanks.
>>
>> I guess I'll just locally patch my DBIC for now.
>> I only use Pg, so it does the job for me.
> =

> If you can redo the patch so it adds the feature via an SQLA subclass ala
> the way the Oracle WhereJoins subclass works, I'd be willing to accept it
> for the moment.
> =

> The thing I disliked is that you were putting SQL in storage.
> =

>> meanwhile, is the SQL::Abstract discussion carried on elsewhere? I'd =

>> love to at least poke around see what I can contribute.
> =

> I'm going to get the ball rolling on this list soon - don't see the point
> in starting another one, we've got a load of ORM authors and interested
> people on here already :)
> =


-------------- next part --------------
Index: t/72pg.t
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- t/72pg.t	(revision 3567)
+++ t/72pg.t	(working copy)
@@ -27,7 +27,7 @@
 plan skip_all =3D> '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 =3D> 8;
+plan tests =3D> 14;
 =

 DBICTest::Schema->load_classes( 'Casecheck' );
 my $schema =3D DBICTest::Schema->connect($dsn, $user, $pass);
@@ -87,6 +87,83 @@
 my $uc_name_info =3D $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 =3D 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 =3D DBICTest::Schema->connect($dsn, $user, $pass);
+    $schema2->source("Artist")->name("testschema.artist");
+
+    $schema->txn_do( sub {
+        my $artist =3D $schema->resultset('Artist')->search(
+            {
+                artistid =3D> 1
+            },
+            {
+                locking =3D> 'update'
+            }
+        )->first;
+        is($artist->artistid, 1, "select for update returns artistid =3D 1=
");
+
+        my $artist_from_schema2;
+        my $error_ok =3D 0;
+        eval {
+            my $h =3D set_sig_handler( 'ALRM', sub { die "DBICTestTimeout"=
 } );
+            alarm(2);
+            $artist_from_schema2 =3D $schema2->resultset('Artist')->find(1=
);
+            $artist_from_schema2->name('fooey');
+            $artist_from_schema2->update;
+            alarm(0);
+        };
+        if (my $e =3D $@) {
+            $error_ok =3D $e =3D~ /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 =3D DBICTest::Schema->connect($dsn, $user, $pass);
+    $schema2->source("Artist")->name("testschema.artist");
+
+    $schema->txn_do( sub {
+        my $artist =3D $schema->resultset('Artist')->search(
+            {
+                artistid =3D> 1
+            },
+        )->first;
+        is($artist->artistid, 1, "select for update returns artistid =3D 1=
");
+
+        my $artist_from_schema2;
+        my $error_ok =3D 0;
+        eval {
+            my $h =3D set_sig_handler( 'ALRM', sub { die "DBICTestTimeout"=
 } );
+            alarm(2);
+            $artist_from_schema2 =3D $schema2->resultset('Artist')->find(1=
);
+            $artist_from_schema2->name('fooey');
+            $artist_from_schema2->update;
+            alarm(0);
+        };
+        if (my $e =3D $@) {
+            $error_ok =3D $e =3D~ /DBICTestTimeout/;
+        }
+
+        # Make sure that an error was raised, and that the update failed
+        ok(! $error_ok, "update from second schema DOES NOT timeout");
+        ok(! $artist_from_schema2->is_column_changed('name'), "'name' colu=
mn is NOT dirty from second schema");
+    });
+}
+
 END {
     if($dbh) {
         $dbh->do("DROP TABLE testschema.artist;");
Index: lib/DBIx/Class/Storage/DBI/Pg.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- lib/DBIx/Class/Storage/DBI/Pg.pm	(revision 3567)
+++ lib/DBIx/Class/Storage/DBI/Pg.pm	(working copy)
@@ -1,18 +1,51 @@
 package DBIx::Class::Storage::DBI::Pg;
-
 use strict;
 use warnings;
-
 use DBD::Pg qw(:pg_types);
-
 use base qw/DBIx::Class::Storage::DBI/;
 =

+BEGIN
+{
+
+# Temporary hack until we can fix SQL::Abstract
+package DBIC::SQL::Abstract::Pg;
+use strict;
+use base qw/DBIC::SQL::Abstract/;
+
+sub select {
+  my $self =3D shift;
+  my ($sql, @rest) =3D $self->SUPER::select(@_);
+
+  $sql .=3D =

+    $self->{locking} ?
+    (
+      $self->{locking} eq 'update' ? 'FOR UPDATE' :
+      $self->{locking} eq 'share'  ? 'FOR SHARE'  :
+      ''
+    ) :
+    ''
+  ;
+  return wantarray ? ($sql, @rest) : $sql;
+}
+
+}
+
+
 # __PACKAGE__->load_components(qw/PK::Auto/);
 =

 # Warn about problematic versions of DBD::Pg
 warn "DBD::Pg 1.49 is strongly recommended"
   if ($DBD::Pg::VERSION < 1.49);
 =

+sub _select {
+  my $self =3D shift;
+
+  my $locking =3D delete $_[3]->{locking};
+  my $sql_maker =3D $self->sql_maker;
+  local $sql_maker->{locking} =3D $locking;
+  $self->next::method(@_);
+}
+
 sub _dbh_last_insert_id {
   my ($self, $dbh, $seq) =3D @_;
   $dbh->last_insert_id(undef, undef, undef, undef, {sequence =3D> $seq});
@@ -73,6 +106,18 @@
   }
 }
 =

+sub sql_maker {
+  my ($self) =3D @_;
+
+  unless ($self->_sql_maker) {
+    $self->_sql_maker(
+      new DBIC::SQL::Abstract::Pg( $self->_sql_maker_args )
+    );
+  }
+
+  return $self->_sql_maker;
+}
+
 1;
 =

 =3Dhead1 NAME


More information about the Dbix-class mailing list