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

Daisuke Maki daisuke at endeworks.jp
Sat Jul 7 14:29:09 GMT 2007


This is just snippet of the entire patch, but here's my quick take on 
the refactoring DBIC::SQL::Abstract. if it looks more or less okay, I 
can go ahead and refactor the other storage types. let me know.

In DBIC::Storage::DBI::Pg:

+sub _rebless
+{
+    my $self = shift;
+    $self->sql_maker_class('DBIC::SQL::Abstract::Pg');
+    $self;
+}

And in DBIC::Storage::DBI

--- lib/DBIx/Class/Storage/DBI.pm       (revision 3567)
+++ lib/DBIx/Class/Storage/DBI.pm       (working copy)
@@ -14,7 +14,7 @@
  __PACKAGE__->mk_group_accessors('simple' =>
      qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
         _conn_pid _conn_tid disable_sth_caching cursor on_connect_do
-       transaction_depth unsafe/
+       transaction_depth unsafe sql_maker_class/
  );

  BEGIN {
@@ -314,6 +314,7 @@
    $new->cursor("DBIx::Class::Storage::DBI::Cursor");
    $new->transaction_depth(0);
    $new->_sql_maker_opts({});
+  $new->sql_maker_class('DBIC::SQL::Abstract');
    $new->{_in_dbh_do} = 0;
    $new->{_dbh_gen} = 0;

@@ -711,7 +712,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;
  }

Matt S Trout wrote:
> On Fri, Jul 06, 2007 at 10:38:48AM +0900, Daisuke Maki wrote:
>> 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.
> 
> Patch looks good in theory.
> 
> Strikes me we've got a number of sql_maker overrides that are purely to
> change the class name now, so lets factor that out.
> 
> Also, what other databases support FOR UPDATE ? Is it worth pushing that
> one down to DBIC::SQL::Abstract itself ?
> 
>> 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 :)
>>>
> 
>> Index: t/72pg.t
>> ===================================================================
>> --- t/72pg.t	(revision 3567)
>> +++ t/72pg.t	(working copy)
>> @@ -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 => 8;
>> +plan tests => 14;
>>  
>>  DBICTest::Schema->load_classes( 'Casecheck' );
>>  my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
>> @@ -87,6 +87,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
>> +            },
>> +            {
>> +                locking => '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 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' column is NOT dirty from second schema");
>> +    });
>> +}
>> +
>>  END {
>>      if($dbh) {
>>          $dbh->do("DROP TABLE testschema.artist;");
>> Index: lib/DBIx/Class/Storage/DBI/Pg.pm
>> ===================================================================
>> --- 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 = shift;
>> +  my ($sql, @rest) = $self->SUPER::select(@_);
>> +
>> +  $sql .= 
>> +    $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 = shift;
>> +
>> +  my $locking = delete $_[3]->{locking};
>> +  my $sql_maker = $self->sql_maker;
>> +  local $sql_maker->{locking} = $locking;
>> +  $self->next::method(@_);
>> +}
>> +
>>  sub _dbh_last_insert_id {
>>    my ($self, $dbh, $seq) = @_;
>>    $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
>> @@ -73,6 +106,18 @@
>>    }
>>  }
>>  
>> +sub sql_maker {
>> +  my ($self) = @_;
>> +
>> +  unless ($self->_sql_maker) {
>> +    $self->_sql_maker(
>> +      new DBIC::SQL::Abstract::Pg( $self->_sql_maker_args )
>> +    );
>> +  }
>> +
>> +  return $self->_sql_maker;
>> +}
>> +
>>  1;
>>  
>>  =head1 NAME
> 
>> _______________________________________________
>> List: http://lists.rawmode.org/cgi-bin/mailman/listinfo/dbix-class
>> Wiki: http://dbix-class.shadowcatsystems.co.uk/
>> IRC: irc.perl.org#dbix-class
>> SVN: http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class/
>> Searchable Archive: http://www.mail-archive.com/dbix-class@lists.rawmode.org/
> 




More information about the Dbix-class mailing list