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/
_______________________________________________
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/
