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

[Matt S Trout]

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/

-- 
      Matt S Trout       Need help with your Catalyst or DBIx::Class project?
   Technical Director    Want a managed development or deployment platform?
 Shadowcat Systems Ltd.  Contact mst (at) shadowcatsystems.co.uk for a quote
http://chainsawblues.vox.com/             http://www.shadowcatsystems.co.uk/