[Dbix-class] unique constrains are ignored when using find_or_create

Daniel Westermann-Clark daniel at acceleration.net
Fri Apr 7 05:55:17 CEST 2006


Here's my second attempt.  The attached reimplements find to search on
all matching unique constraints by default, or a specific key if one
is provided.  Unfortunately it's not as clean as update_or_create due
to all the crap that find has to deal with; suggestions for
improvement would be greatly appreciated.

The update_or_create method uses the new find method.

Also, error handling is improved - we check to make sure the caller
specified a valid unique constraint instead of assuming one exists.
(Whoops.)

Tests pass here, except for t/cdbi-t/02-Film.t.  There is apparently a
mismatch in the case of column names between the ResultSource and what
the test passes in.  A simple lower case of the columns in the search
predicate caused problems with other tests.  Any ideas?

Other than that, I'm a little concerned about a corner case exposed by
t/{basicrels,helperrels}/18self_referencial.t:

  # Handle cases where the ResultSet already defines the query
  my $query = @unique_hashes ? \@unique_hashes : undef;

Without this, the third test case generates invalid SQL:

DBIx::Class::Relationship::Accessor::__ANON__(): no sth generated via
sql (near ")": syntax error(1) at dbdimp.c line 269): SELECT me.id,
me.name FROM self_ref me WHERE ( ( ( (  ) ) AND ( me.id = ? ) ) ) at
t/run/18self_referencial.tl line 31

Is my workaround kosher?

Finally - since this started out as a bugfix, I've been working
against trunk, but perhaps this belongs on a branch due to the
importance of find?

-- 
Daniel Westermann-Clark
-------------- next part --------------
Auto-merging (0, 8360) /local/DBIx-Class to /mirror/bast/trunk/DBIx-Class (base /mirror/bast/trunk/DBIx-Class:8352).
Patching locally against mirror source http://dev.catalyst.perl.org/repos/bast.
U   t/run/20unique.tl
U   lib/DBIx/Class/ResultSet.pm
U   Changes
==== Patch <-> level 1
Source: 20164c6d-cd09-0410-925d-b4c4e616b846:/local/DBIx-Class:8360
Target: bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:1420
        (http://dev.catalyst.perl.org/repos/bast)
Log:
Reimplement find to search unique constraints like update_or_create
=== t/run/20unique.tl
==================================================================
--- t/run/20unique.tl	(revision 1420)
+++ t/run/20unique.tl	(patch - level 1)
@@ -1,7 +1,7 @@
 sub run_tests {
 my $schema = shift;
 
-plan tests => 18;
+plan tests => 26;
 
 my $artistid = 1;
 my $title    = 'UNIQUE Constraint';
@@ -69,6 +69,35 @@
 is($cd5->title, $cd2->title, 'title is correct');
 is($cd5->year, 2005, 'updated year is correct');
 
+my $cd6 = $schema->resultset('CD')->find_or_create(
+  {
+    artist => $artistid,
+    title  => $title,
+    year   => 2010,
+  },
+  { key => 'artist_title' }
+);
+
+is($cd6->cdid, $cd1->cdid, 'find or create by specific key: cdid is correct');
+is($cd6->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
+is($cd6->title, $cd1->title, 'title is correct');
+is($cd6->year, $cd1->year, 'year is correct');
+
+my $artist = $schema->resultset('Artist')->find($artistid);
+my $cd7 = $artist->find_or_create_related('cds',
+  {
+    artist => $artistid,
+    title  => $title,
+    year   => 2020,
+  },
+  { key => 'artist_title' }
+);
+
+is($cd7->cdid, $cd1->cdid, 'find or create related by specific key: cdid is correct');
+is($cd7->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
+is($cd7->title, $cd1->title, 'title is correct');
+is($cd7->year, $cd1->year, 'year is correct');
+
 }
 
 1;
=== lib/DBIx/Class/ResultSet.pm
==================================================================
--- lib/DBIx/Class/ResultSet.pm	(revision 1420)
+++ lib/DBIx/Class/ResultSet.pm	(patch - level 1)
@@ -286,6 +286,11 @@
     { key => 'artist_title' }
   );
 
+If no C<key> is specified, it searches on all unique constraints defined on the
+source, including the primary key.
+
+If the C<key> is specified as C<primary>, it searches only on the primary key.
+
 See also L</find_or_create> and L</update_or_create>.
 
 =cut
@@ -294,40 +299,55 @@
   my ($self, @vals) = @_;
   my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
 
-  my @cols = $self->result_source->primary_columns;
-  if (exists $attrs->{key}) {
-    my %uniq = $self->result_source->unique_constraints;
-    $self->throw_exception(
-      "Unknown key $attrs->{key} on '" . $self->result_source->name . "'"
-    ) unless exists $uniq{$attrs->{key}};
-    @cols = @{ $uniq{$attrs->{key}} };
-  }
-  #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
+  my %unique_constraints = $self->result_source->unique_constraints;
+  my @constraint_names   = (exists $attrs->{key}
+                            ? ($attrs->{key})
+                            : keys %unique_constraints);
   $self->throw_exception(
     "Can't find unless a primary key or unique constraint is defined"
-  ) unless @cols;
+  ) unless @constraint_names;
 
-  my $query;
-  if (ref $vals[0] eq 'HASH') {
-    $query = { %{$vals[0]} };
-  } elsif (@cols == @vals) {
-    $query = {};
-    @{$query}{@cols} = @vals;
-  } else {
-    $query = {@vals};
+  my @unique_hashes;
+  foreach my $name (@constraint_names) {
+    $self->throw_exception(
+      "Unknown key $name on '" . $self->result_source->name . "'"
+    ) unless exists $unique_constraints{$name};
+
+    my @unique_cols = @{ $unique_constraints{$name} };
+    my %unique_hash;
+    if (ref $vals[0] eq 'HASH') {
+      %unique_hash =
+        map  { $_ => $vals[0]->{$_} }
+        grep { exists $vals[0]->{$_} }
+        @unique_cols;
+    }
+    elsif (scalar @unique_cols == scalar @vals) {
+      # Assume the argument order corresponds to the constraint definition
+      @unique_hash{@unique_cols} = @vals;
+    }
+    elsif (scalar @vals % 2 == 0) {
+      # Fix for CDBI calling with a hash
+      %unique_hash = @vals;
+    }
+
+    foreach my $key (grep { ! m/\./ } keys %unique_hash) {
+      $unique_hash{"$self->{attrs}{alias}.$key"} = delete $unique_hash{$key};
+    }
+
+    #use Data::Dumper; warn Dumper \@vals, \@unique_cols, \%unique_hash;
+    push @unique_hashes, \%unique_hash if %unique_hash;
   }
-  foreach my $key (grep { ! m/\./ } keys %$query) {
-    $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
-  }
-  #warn Dumper($query);
-  
+
+  # Handle cases where the ResultSet already defines the query
+  my $query = @unique_hashes ? \@unique_hashes : undef;
+
   if (keys %$attrs) {
-      my $rs = $self->search($query,$attrs);
-      return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
+    my $rs = $self->search($query, $attrs);
+    return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
   } else {
-      return keys %{$self->{collapse}} ?
-        $self->search($query)->next :
-        $self->single($query);
+    return keys %{$self->{collapse}}
+      ? $self->search($query)->next
+      : $self->single($query);
   }
 }
 
@@ -1127,32 +1147,13 @@
   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
   my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
 
-  my %unique_constraints = $self->result_source->unique_constraints;
-  my @constraint_names   = (exists $attrs->{key}
-                            ? ($attrs->{key})
-                            : keys %unique_constraints);
-
-  my @unique_hashes;
-  foreach my $name (@constraint_names) {
-    my @unique_cols = @{ $unique_constraints{$name} };
-    my %unique_hash =
-      map  { $_ => $hash->{$_} }
-      grep { exists $hash->{$_} }
-      @unique_cols;
-
-    push @unique_hashes, \%unique_hash
-      if (scalar keys %unique_hash == scalar @unique_cols);
+  my $row = $self->find($hash, $attrs);
+  if (defined $row) {
+    $row->set_columns($hash);
+    $row->update;
+    return $row;
   }
 
-  if (@unique_hashes) {
-    my $row = $self->single(\@unique_hashes);
-    if (defined $row) {
-      $row->set_columns($hash);
-      $row->update;
-      return $row;
-    }
-  }
-
   return $self->create($hash);
 }
 
=== Changes
==================================================================
--- Changes	(revision 1420)
+++ Changes	(patch - level 1)
@@ -6,15 +6,16 @@
         - slice now uses search directly
         - fixes for update() on resultset
         - bugfix to Cursor to avoid error during DESTROY
+        - rework ResultSet::find() to search unique constraints
 
-0.06000
+0.06000 2006-03-25 11:35:00
         - Lots of documentation improvements
         - Minor tweak to related_resultset to prevent it storing a searched rs
         - Fixup to columns_info_for when database returns type(size)
         - Made do_txn respect void context (on the off-chance somebody cares)
         - Fix exception text for nonexistent key in ResultSet::find()
 
-0.05999_04
+0.05999_04 2006-03-18 13:35:00
         - Fix for delete on full-table resultsets
         - Removed caching on count() and added _count for pager()
         - ->connection does nothing if ->storage defined and no args

==== BEGIN SVK PATCH BLOCK ====
Version: svk 1.07 (linux)

eJytV82LHMcVn2NYB0LAp4BJZdWbmQ2a3f7unlk0GlkrW8YQjCWFkNgM1VXVO832dre6qrU7nh7Q
LiQGB5xLyH/i+OYcQiAkh0BOvvh/yauqno9ejXYtsFg01VXv/d7vfdSrqvfKp0djqx6NzNqwzPrJ
bz4cDj/Cgkz3LLc2/JrRROSl4dUpe8FSw6nT/MRw6wyfMVjleVUSORC4PGFCDhJyysRoZAFcqOEe
KYglrEKNsMgzbgwU/ESUjBlWPRgDgbEj/yaGNag5gyWFOynZi4QneQaWQ8c3QQLkLdDPC5ZNyjwX
sGK5tjW2pa5ZkzTnbCLRx2499qS4bYBHSp4mJSNAaQazQgE1ykrO2yIHbifRK5KDJYE4SZkR1A+n
ODthfFNOueI1dDbtSqYaxdliz6vFYVllivVtSPYKyW3xsQINcmibVZY8r9iBSJW52wAdDahWcVGk
s4lgF4KyVGBlxLHrgcNMG2MzjC0ndrAzCB2PDljEAju2ghgy4wWQ/F93On/+yV/ffuvzX37V+fKp
9/KPz3/2ZcWrCAEtAOWCo/nO2QwZnEzZGUb3EJ8msTja2SlSnCEtcW+EbF8KEeqDRCPbH5WMV6mA
Iul1Hx539/ujOMnoJC8npGRYsN4OAnAE/3ApEi4kjqGHCb2rFkQiUobUghrq2RnDJVKztmmZcm4h
/5ujUzaTs10NMlEqXbTY2Qe+Ce9Jfv0RoYAuuVrLcVfyQnmJNC8UzRAvGEnihEjIIZJiKOGI5KVM
QhfwVnCy+EmeVmdZr7Hb3V/Cb19rhq8D1I42CM1HVwfiNRoyHksFPe6qELXFVRqXkd6apAcNRZ2o
3ioXoKyzG0hFPXs9mdAAUvihvS6hvHv3h0it/WapDb5PahuWb5Di4IdOcfDGKQ62phja5kYj1Q1F
733L910SYS+wiWWFnul7bkSo6QeeH5Ew8lbtyN/S2ELZSA+P3/3gQnXa21rRGizY1r3dFdrhwxRz
rozehumvMMNWv7SDa2iHH6vifcLEQXGmKNwGHdzYOUPVOVlsWaaHqcti4lBKHRJQShwHB1EYD1xQ
dZrWefW3H199nf3qTx90vik6ncunl/8lnUvj7zD87eX/Putk/3jn5RcfdS6/cP71/stZ57vjy28f
Z1yUOMnERJ7PHIoXIdhbY93/J1PMp3IWoTiHgiVTuWhIUdQbk7ytvN9sMYOzNIY6mpb5+YRdEFYI
OIh7ag2h3WfZaZafZ2oHaag8Q91ddLBU1B1gom8K/ZESOUC73V2FsI+qLGWcI3aRyGZvNFTXbPhc
wS6UMy13YGPA6YDG8xu00OJoqba3EQU9mcSoV7IYGS9wyn9vforYc9R9/ODJ4+7SedTSQveaScDD
hewbxkS1mEa/P5obEzC5kjopWQFSS99eJ7bpkGam11jKJUVOcAp9q+02HJXNtERd872DHnBeQYzF
lEF7PIFhJqBFUVbqrc+LPKMciVxJrCOGKINulsjk7rRpSdfnm9YXMurS7A1k5TLaQ7Zkam7Sey+5
kOWHHsJGQyCcJtkJOk/EFGEkLW2Ne9uc+tksYVl8vSbYv0Bnh58cHKKFLEnewlnTMDZd220qdY6F
KPlijtME88WBRN2VrsL+ZdDcWzpycdHic6fiDB1jgYfD4+qsYOUROsdlhvQH+kR5cBd+NwIJn69W
ZVGBx+0te01OFu51PcXiDnqMMwp9nmDOODqfslIXwqqTIZxC2OhMZxtk5CrglDPdKgw1lgFvEUD3
18SbmSHsXABR21ImXkfbUDFcBloCllzdB1SEOZwtZNrTRuDA0cLa7ZKJqsyapM1BDRICMUpxwdli
AQTUVAb9FEyrMYfKSZlyXlYfa4xeA2pyu4ZqSuD+VlL72kQjMzSg6a3p63uL9L/FXXqvw0mRVFh1
ThhL+OURzrVu469erQoKN4ZWBOTC0dbjVx0gLLbhXurazPRIFJvYD2nkEwxTfoAjG994BA0kgu8T
N3J96noOxUHgx5HLBnHom7YThg6Dd44T6hPo35/+59FPs87Vzzsvf9e5Ild7f+n889kffrTsW32g
fJ6Xp+vyGg5VjPZle9FxRbpqNhoN39kxD0zfNE24hZl+33T6tocsa+h4w9WMFSLLkTOmuTUUyhGL
DXDALMcMQxsPPCt2se9EHg2xCYeq76mHmB/UH7PkrEiZ6oTqxnYTO5QmpwzpvKwvoADVH43s2rBt
/ah9qh6mw+GzLHnBSo7TPb+G+0GBxRRei/BehY+qSqh8hh2mOTQ6dbPo63uKfsYajl9DLuE65dM+
XKEGfdO1zP7A9mg/conLfMuPQtcf7dv1TfACnlOnbXgoEAUf0RBuG4z1zTgOIbAAD8EK+nHkxLYX
+cHAp4Y3+F40hq/4MZRe/B/dnCZ3
==== END SVK PATCH BLOCK ====


More information about the Dbix-class mailing list