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

Daisuke Maki daisuke at endeworks.jp
Sat Jul 7 16:42:52 GMT 2007


> Yeah, although (re your outline patch) I think it should be done as an
> 'inherited' type group accessor; that way the default can be set per-class
> without having to add the _rebless hook.

Oh, *that's* how you use this accessor system...
grepping for 'inherited', I think I get it.
I was wondering about that.

Okay, so I've now done the following:
   * Add sql_maker_class to DBIC::Storage::DBI as an inherited accessor
   * Change DBIC::Storage::DBI->sql_maker so that it uses
     sql_maker_class() to choose which class to instantiate

   * Refactored Storage::DBI::Oracle::WhereJoins's sql_maker()
     method (UNTESTED)

   * Add support for "locking" attribute to DBIC::SQL::Abstract
     (NOT DBIC::Storage::Pg), since we've identified Pg, mysql,
     Oracle, and DB2 supporting this syntax.

I've only tested Pg, though. Hopefully somebody more knowledgeable and =

with access to the other DBs can help me out here.

--d
-------------- 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.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.pm	(revision 3567)
+++ lib/DBIx/Class/Storage/DBI.pm	(working copy)
@@ -17,6 +17,9 @@
        transaction_depth unsafe/
 );
 =

+__PACKAGE__->mk_group_accessors('inherited' =3D> qw/sql_maker_class/);
+__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract');
+
 BEGIN {
 =

 package DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't repl=
y :(
@@ -81,6 +84,15 @@
   my ($sql, @ret) =3D $self->SUPER::select(
     $table, $self->_recurse_fields($fields), $where, $order, @rest
   );
+  $sql .=3D =

+    $self->{locking} ?
+    (
+      $self->{locking} eq 'update' ? 'FOR UPDATE' :
+      $self->{locking} eq 'share'  ? 'FOR SHARE'  :
+      ''
+    ) :
+    ''
+  ;
   return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
 }
 =

@@ -711,7 +723,8 @@
 sub sql_maker {
   my ($self) =3D @_;
   unless ($self->_sql_maker) {
-    $self->_sql_maker(new DBIC::SQL::Abstract( $self->_sql_maker_args ));
+    my $sql_maker_class =3D $self->sql_maker_class;
+    $self->_sql_maker($sql_maker_class->new( $self->_sql_maker_args ));
   }
   return $self->_sql_maker;
 }
@@ -1003,9 +1016,15 @@
 sub _select {
   my ($self, $ident, $select, $condition, $attrs) =3D @_;
   my $order =3D $attrs->{order_by};
+
   if (ref $condition eq 'SCALAR') {
     $order =3D $1 if $$condition =3D~ s/ORDER BY (.*)$//i;
   }
+
+  my $locking =3D delete $attrs->{locking};
+  my $sql_maker =3D $self->sql_maker;
+  local $sql_maker->{locking} =3D $locking;
+
   if (exists $attrs->{group_by} || $attrs->{having}) {
     $order =3D {
       group_by =3D> $attrs->{group_by},
@@ -1023,6 +1042,7 @@
       if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
     push @args, $attrs->{rows}, $attrs->{offset};
   }
+
   return $self->_execute(@args);
 }
 =

Index: lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.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/Oracle/WhereJoins.pm	(revision 3567)
+++ lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm	(working copy)
@@ -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) =3D @_;
-
-  unless ($self->_sql_maker) {
-    $self->_sql_maker(
-      new DBIC::SQL::Abstract::Oracle( $self->_sql_maker_args )
-    );
-  }
-
-  return $self->_sql_maker;
-}
-
 1;
 =

 __END__


More information about the Dbix-class mailing list