On 13 Apr 2009, at 11:20, Peter Corlett wrote:
[...]
So it looks like this still needs savepoints to do correctly. Of
course, one could always instead do a heroically complex bodge job
that looks really impressive but doesn't actually work.
And in the interests of STFUAWSC:
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 816b374..a8d501b 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -2103,13 +2103,43 @@ sub update_or_create {
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
my $cond = ref $_[0] eq 'HASH' ? shift : {...@_};
+ my $schema = $self->result_source->schema;
+
+ # Savepoints only work within a transaction, so we wrap ourselves
into a
+ # transaction to make sure.
+ $schema->txn_begin;
+
+ # Start a savepoint. This fails if the underlying storage doesn't
support
+ # savepoints, so we fall through to the previus implementation.
+ eval { $schema->svp_begin; };
+ unless($@) {
+ # now try an INSERT
+ my $row = eval { $self->create($cond); };
+ if($@) {
+ # If the INSERT failed, this suggests a failed constraint check
due to
+ # duplicate keys. So we rollback the savepoint and do a
+ # SELECT-modify-UPDATE instead. We add the SELECT ... FOR UPDATE
+ # option to block any parallel queries on the same row.
+ $schema->svp_rollback;
+ $row = $self->find($cond, { %$attrs, for => 'update'} )
+ or die "Atomic update_or_create failed";
+ $row->update($cond);
+ }
+ $schema->svp_release;
+ $schema->txn_commit;
+ return $row;
+ }
+
my $row = $self->find($cond, $attrs);
if (defined $row) {
$row->update($cond);
+ $schema->txn_commit;
return $row;
}
- return $self->create($cond);
+ $row = $self->create($cond);
+ $schema->txn_commit;
+ return $row;
}
=head2 get_cache
_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/[email protected]
