Support for relationship attributes in many_to_many accessors.
Michael Leuchtenburg [Thu, 10 Aug 2006 18:22:05 +0000 (18:22 +0000)]
Merge new where condition, old where condition, cond in ResultSet::search_rs
Collapse cond in ResultSet::new_result so that it doesn't try to create columns with names like "-and".
Add a bunch of tests for the where condition things, which also happen to require the cond collapsing.
Create supporting classes and associated tables for these tests.

13 files changed:
.gitignore [new file with mode: 0644]
lib/DBIx/Class.pm
lib/DBIx/Class/Relationship/ManyToMany.pm
lib/DBIx/Class/ResultSet.pm
t/46where_attribute.t [new file with mode: 0644]
t/lib/DBICTest.pm
t/lib/DBICTest/Schema.pm
t/lib/DBICTest/Schema/BooksInLibrary.pm [new file with mode: 0644]
t/lib/DBICTest/Schema/Collection.pm [new file with mode: 0644]
t/lib/DBICTest/Schema/CollectionObject.pm [new file with mode: 0644]
t/lib/DBICTest/Schema/Owners.pm [new file with mode: 0644]
t/lib/DBICTest/Schema/TypedObject.pm [new file with mode: 0644]
t/lib/sqlite.sql

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..b0be36a
--- /dev/null
@@ -0,0 +1,6 @@
+Build
+Build.bat
+Makefile
+_build/
+blib/
+t/var/
index 1b8b4e3..54d5b64 100644 (file)
@@ -234,6 +234,8 @@ wdh: Will Hawes
 
 gphat: Cory G Watson <gphat@cpan.org>
 
+dyfrgi: Michael Leuchtenmurg <michael@slashhome.org>
+
 =head1 LICENSE
 
 You may distribute this code under the same terms as Perl itself.
index 23b971e..ea004e3 100644 (file)
@@ -17,6 +17,7 @@ sub many_to_many {
     *{"${class}::${meth}"} = sub {
       my $self = shift;
       my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
+      my @args = ($f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs });
       $self->search_related($rel)->search_related(
         $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }
       );
@@ -32,10 +33,19 @@ sub many_to_many {
       my $rel_source_name = $source->relationship_info($rel)->{source};
       my $rel_source = $schema->resultset($rel_source_name)->result_source;
       my $f_rel_source_name = $rel_source->relationship_info($f_rel)->{source};
-      my $f_rel_rs = $schema->resultset($f_rel_source_name);
-      my $obj = ref $_[0]
-        ? ( ref $_[0] eq 'HASH' ? $f_rel_rs->create($_[0]) : $_[0] )
-        : ( $f_rel_rs->create({@_}) );
+      my $f_rel_rs = $schema->resultset($f_rel_source_name)->search({}, $rel_attrs||{});
+
+      my $obj;
+      if (ref $_[0]) {
+        if (ref $_[0] eq 'HASH') {
+          $obj = $f_rel_rs->create($_[0]);
+        } else {
+          $obj = $_[0];
+        }
+      } else {
+        $obj = $f_rel_rs->create({@_});
+      }
+
       my $link_vals = @_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {};
       my $link = $self->search_related($rel)->new_result({});
       $link->set_from_related($f_rel, $obj);
index a5a6406..fdf5867 100644 (file)
@@ -171,6 +171,7 @@ sub search_rs {
   $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
   my $our_attrs = { %{$self->{attrs}} };
   my $having = delete $our_attrs->{having};
+  my $where = delete $our_attrs->{where};
 
   my $new_attrs = { %{$our_attrs}, %{$attrs} };
 
@@ -179,8 +180,8 @@ sub search_rs {
     next unless exists $attrs->{$key};
     $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
   }
-  
-  my $where = (@_
+
+  my $cond = (@_
     ? (
         (@_ == 1 || ref $_[0] eq "HASH")
           ? shift
@@ -193,7 +194,7 @@ sub search_rs {
     : undef
   );
 
-  if (defined $where) {
+  if (defined $where and %$where) {
     $new_attrs->{where} = (
       defined $new_attrs->{where}
         ? { '-and' => [
@@ -204,6 +205,17 @@ sub search_rs {
           }
         : $where);
   }
+  if (defined $cond and %$cond) {
+    $new_attrs->{where} = (
+      defined $new_attrs->{where}
+        ? { '-and' => [
+              map {
+                ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_
+              } $cond, $new_attrs->{where}
+            ]
+          }
+        : $cond);
+  }
 
   if (defined $having) {
     $new_attrs->{having} = (
@@ -1211,9 +1223,10 @@ sub new_result {
   ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
 
   my $alias = $self->{attrs}{alias};
+  my $collapsed_cond = $self->{cond} ? $self->_collapse_cond($self->{cond}) : {};
   my %new = (
     %{ $self->_remove_alias($values, $alias) },
-    %{ $self->_remove_alias($self->{cond}, $alias) },
+    %{ $self->_remove_alias($collapsed_cond, $alias) },
   );
 
   my $obj = $self->result_class->new(\%new);
@@ -1221,6 +1234,41 @@ sub new_result {
   return $obj;
 }
 
+# _collapse_cond
+#
+# Recursively collapse the condition.
+
+sub _collapse_cond {
+  my ($self, $cond, $collapsed) = @_;
+
+  $collapsed ||= {};
+
+  if (ref $cond eq 'ARRAY') {
+    foreach my $subcond (@$cond) {
+      next unless ref $subcond;  # -or
+#      warn "ARRAY: " . Dumper $subcond;
+      $collapsed = $self->_collapse_cond($subcond, $collapsed);
+    }
+  }
+  elsif (ref $cond eq 'HASH') {
+    if (keys %$cond and (keys %$cond)[0] eq '-and') {
+      foreach my $subcond (@{$cond->{-and}}) {
+#        warn "HASH: " . Dumper $subcond;
+        $collapsed = $self->_collapse_cond($subcond, $collapsed);
+      }
+    }
+    else {
+#      warn "LEAF: " . Dumper $cond;
+      foreach my $col (keys %$cond) {
+        my $value = $cond->{$col};
+        $collapsed->{$col} = $value;
+      }
+    }
+  }
+
+  return $collapsed;
+}
+
 # _remove_alias
 #
 # Remove the specified alias from the specified query hash. A copy is made so
diff --git a/t/46where_attribute.t b/t/46where_attribute.t
new file mode 100644 (file)
index 0000000..764d7cc
--- /dev/null
@@ -0,0 +1,68 @@
+use strict;\r
+use warnings;\r
+\r
+use Test::More;\r
+use Data::Dumper;\r
+use lib qw(t/lib);\r
+use DBICTest;\r
+my $schema = DBICTest->init_schema();\r
+\r
+plan tests => 14;\r
+\r
+# select from a class with resultset_attributes\r
+my $resultset = $schema->resultset('BooksInLibrary');\r
+is($resultset, 3, "select from a class with resultset_attributes okay");\r
+\r
+# now test out selects through a resultset\r
+my $owner = $schema->resultset('Owners')->find({name => "Newton"});\r
+my $programming_perl = $owner->books->find_or_create({ title => "Programming Perl" });\r
+is($programming_perl->id, 1, 'select from a resultset with find_or_create for existing entry ok');\r
+\r
+# and inserts?\r
+my $see_spot;\r
+$see_spot = eval { $owner->books->find_or_create({ title => "See Spot Run" }) };\r
+if ($@) { print $@ }\r
+ok(!$@, 'find_or_create on resultset with attribute for non-existent entry did not throw');\r
+ok(defined $see_spot, 'successfully did insert on resultset with attribute for non-existent entry');\r
+\r
+# many_to_many tests\r
+my $collection = $schema->resultset('Collection')->search({collectionid => 1});\r
+my $pointy_objects = $collection->search_related('collection_object')->search_related('object', { type => "pointy"});\r
+my $pointy_count = $pointy_objects->count();\r
+is($pointy_count, 2, 'many_to_many explicit query through linking table with query starting from resultset count correct');\r
+\r
+$collection = $schema->resultset('Collection')->find(1);\r
+$pointy_objects = $collection->search_related('collection_object')->search_related('object', { type => "pointy"});\r
+$pointy_count = $pointy_objects->count();\r
+is($pointy_count, 2, 'many_to_many explicit query through linking table with query starting from row count correct');\r
+\r
+# use where on many_to_many query\r
+$collection = $schema->resultset('Collection')->find(1);\r
+$pointy_objects = $collection->search_related('collection_object')->search_related('object', {}, { where => { 'object.type' => 'pointy' } });\r
+is($pointy_objects->count(), 2, 'many_to_many explicit query through linking table with where starting from row count correct');\r
+\r
+$collection = $schema->resultset('Collection')->find(1);\r
+$pointy_objects = $collection->pointy_objects();\r
+$pointy_count = $pointy_objects->count();\r
+is($pointy_count, 2, 'many_to_many resultset with where in resultset attrs count correct');\r
+\r
+# add_to_$rel on many_to_many with where containing a required field\r
+eval {$collection->add_to_pointy_objects({ value => "Nail" }) };\r
+if ($@) { print $@ }\r
+ok( !$@, 'many_to_many add_to_$rel($hash) with where in relationship attrs did not throw');\r
+is($pointy_objects->count, $pointy_count+1, 'many_to_many add_to_$rel($hash) with where in relationship attrs count correct');\r
+$pointy_count = $pointy_objects->count();\r
+\r
+my $pen = $schema->resultset('TypedObject')->create({ value => "Pen", type => "pointy"});\r
+eval {$collection->add_to_pointy_objects($pen)};\r
+if ($@) { print $@ }\r
+ok( !$@, 'many_to_many add_to_$rel($object) with where in relationship attrs did not throw');\r
+is($pointy_objects->count, $pointy_count+1, 'many_to_many add_to_$rel($object) with where in relationship attrs count correct');\r
+$pointy_count = $pointy_objects->count();\r
+\r
+my $round_objects = $collection->round_objects();\r
+my $round_count = $round_objects->count();\r
+eval {$collection->add_to_objects({ value => "Wheel", type => "round" })};\r
+if ($@) { print $@ }\r
+ok( !$@, 'many_to_many add_to_$rel($hash) did not throw');\r
+is($round_objects->count, $round_count+1, 'many_to_many add_to_$rel($hash) count correct');\r
index a050862..97855cb 100755 (executable)
@@ -87,7 +87,7 @@ sub deploy_schema {
         my $sql;
         { local $/ = undef; $sql = <IN>; }
         close IN;
-        $schema->storage->dbh->do($_) for split(/;\n/, $sql);
+        ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n") for split(/;\n/, $sql);
     }
 }
 
@@ -233,6 +233,43 @@ sub populate_schema {
         [ qw/id link/ ],
         [ 1, 1 ]
     ]);
+
+    $schema->populate('Collection', [
+        [ qw/collectionid name/ ],
+        [ 1, "Tools" ],
+        [ 2, "Body Parts" ],
+    ]);
+
+    $schema->populate('CollectionObject', [
+        [ qw/collection object/ ],
+        [ 1, 1 ],
+        [ 1, 2 ],
+        [ 1, 3 ],
+        [ 2, 4 ],
+        [ 2, 5 ],
+    ]);
+
+    $schema->populate('TypedObject', [
+        [ qw/objectid type value/ ],
+        [ 1, "pointy", "Awl" ],
+        [ 2, "round", "Bearing" ],
+        [ 3, "pointy", "Knife" ],
+        [ 4, "pointy", "Tooth" ],
+        [ 5, "round", "Head" ],
+    ]);
+
+    $schema->populate('Owners', [
+        [ qw/ownerid name/ ],
+        [ 1, "Newton" ],
+        [ 2, "Waltham" ],
+    ]);
+
+    $schema->populate('BooksInLibrary', [
+        [ qw/id owner title source/ ],
+        [ 1, 1, "Programming Perl", "Library" ],
+        [ 2, 1, "Dynamical Systems", "Library" ],
+        [ 3, 2, "Best Recipe Cookbook", "Library" ],
+    ]);
 }
 
 1;
index 8e7597d..f8b2cd9 100644 (file)
@@ -33,7 +33,9 @@ __PACKAGE__->load_classes(qw/
     'Producer',
     'CD_to_Producer',
   ),
-  qw/SelfRefAlias TreeLike TwoKeyTreeLike Event NoPrimaryKey/
+  qw/SelfRefAlias TreeLike TwoKeyTreeLike Event NoPrimaryKey/,
+  qw/Collection CollectionObject TypedObject/,
+  qw/Owners BooksInLibrary/
 );
 
 1;
diff --git a/t/lib/DBICTest/Schema/BooksInLibrary.pm b/t/lib/DBICTest/Schema/BooksInLibrary.pm
new file mode 100644 (file)
index 0000000..ba6f94d
--- /dev/null
@@ -0,0 +1,28 @@
+package # hide from PAUSE \r
+    DBICTest::Schema::BooksInLibrary;\r
+\r
+use base qw/DBIx::Class::Core/;\r
+\r
+__PACKAGE__->table('books');\r
+__PACKAGE__->add_columns(\r
+  'id' => {\r
+    data_type => 'integer',\r
+    is_auto_increment => 1,\r
+  },\r
+  'source' => {\r
+    data_type => 'varchar',\r
+    size      => '100',\r
+  },\r
+  'owner' => {\r
+    data_type => 'integer',\r
+  },\r
+  'title' => {\r
+    data_type => 'varchar',\r
+    size      => '100',\r
+  },\r
+);\r
+__PACKAGE__->set_primary_key('id');\r
+\r
+__PACKAGE__->resultset_attributes({where => { source => "Library" } });\r
+\r
+1;\r
diff --git a/t/lib/DBICTest/Schema/Collection.pm b/t/lib/DBICTest/Schema/Collection.pm
new file mode 100644 (file)
index 0000000..d9e4a5a
--- /dev/null
@@ -0,0 +1,30 @@
+package # hide from PAUSE \r
+    DBICTest::Schema::Collection;\r
+\r
+use base qw/DBIx::Class::Core/;\r
+\r
+__PACKAGE__->table('collection');\r
+__PACKAGE__->add_columns(\r
+  'collectionid' => {\r
+    data_type => 'integer',\r
+    is_auto_increment => 1,\r
+  },\r
+  'name' => {\r
+    data_type => 'varchar',\r
+    size      => 100,\r
+  },\r
+);\r
+__PACKAGE__->set_primary_key('collectionid');\r
+\r
+__PACKAGE__->has_many( collection_object => "DBICTest::Schema::CollectionObject",\r
+                       { "foreign.collection" => "self.collectionid" }\r
+                     );\r
+__PACKAGE__->many_to_many( objects => collection_object => "object" );\r
+__PACKAGE__->many_to_many( pointy_objects => collection_object => "object",\r
+                           { where => { "type" => "pointy" } } \r
+                         );\r
+__PACKAGE__->many_to_many( round_objects => collection_object => "object",\r
+                           { where => { "type" => "round" } } \r
+                         );\r
+\r
+1;\r
diff --git a/t/lib/DBICTest/Schema/CollectionObject.pm b/t/lib/DBICTest/Schema/CollectionObject.pm
new file mode 100644 (file)
index 0000000..d05ae5d
--- /dev/null
@@ -0,0 +1,24 @@
+package # hide from PAUSE \r
+    DBICTest::Schema::CollectionObject;\r
+\r
+use base qw/DBIx::Class::Core/;\r
+\r
+__PACKAGE__->table('collection_object');\r
+__PACKAGE__->add_columns(\r
+  'collection' => {\r
+    data_type => 'integer',\r
+  },\r
+  'object' => {\r
+    data_type => 'integer',\r
+  },\r
+);\r
+__PACKAGE__->set_primary_key(qw/collection object/);\r
+\r
+__PACKAGE__->belongs_to( collection => "DBICTest::Schema::Collection",\r
+                         { "foreign.collectionid" => "self.collection" }\r
+                       );\r
+__PACKAGE__->belongs_to( object => "DBICTest::Schema::TypedObject",\r
+                         { "foreign.objectid" => "self.object" }\r
+                       );\r
+\r
+1;\r
diff --git a/t/lib/DBICTest/Schema/Owners.pm b/t/lib/DBICTest/Schema/Owners.pm
new file mode 100644 (file)
index 0000000..acaf5ed
--- /dev/null
@@ -0,0 +1,21 @@
+package # hide from PAUSE \r
+    DBICTest::Schema::Owners;\r
+\r
+use base qw/DBIx::Class::Core/;\r
+\r
+__PACKAGE__->table('owners');\r
+__PACKAGE__->add_columns(\r
+  'ownerid' => {\r
+    data_type => 'integer',\r
+    is_auto_increment => 1,\r
+  },\r
+  'name' => {\r
+    data_type => 'varchar',\r
+    size      => '100',\r
+  },\r
+);\r
+__PACKAGE__->set_primary_key('ownerid');\r
+\r
+__PACKAGE__->has_many(books => "DBICTest::Schema::BooksInLibrary", "owner");\r
+\r
+1;\r
diff --git a/t/lib/DBICTest/Schema/TypedObject.pm b/t/lib/DBICTest/Schema/TypedObject.pm
new file mode 100644 (file)
index 0000000..6498add
--- /dev/null
@@ -0,0 +1,28 @@
+package # hide from PAUSE 
+    DBICTest::Schema::TypedObject;
+
+use base qw/DBIx::Class::Core/;
+
+__PACKAGE__->table('typed_object');
+__PACKAGE__->add_columns(
+  'objectid' => {
+    data_type => 'integer',
+    is_auto_increment => 1,
+  },
+  'type' => {
+    data_type => 'varchar',
+    size      => '100',
+  },
+  'value' => {
+    data_type => 'varchar',
+    size      => 100,
+  },
+);
+__PACKAGE__->set_primary_key('objectid');
+
+__PACKAGE__->has_many( collection_object => "DBICTest::Schema::CollectionObject",
+                       { "foreign.object" => "self.objectid" }
+                     );
+__PACKAGE__->many_to_many( collections => collection_object => "collection" );
+
+1;
index 228e448..2ce5dad 100644 (file)
@@ -210,6 +210,50 @@ CREATE TABLE onekey (
   cd integer NOT NULL
 );
 
+--
+-- Table: typed_object
+--
+CREATE TABLE typed_object (
+  objectid INTEGER PRIMARY KEY NOT NULL,
+  type VARCHAR(100) NOT NULL,
+  value VARCHAR(100)
+);
+
+--
+-- Table: collection
+--
+CREATE TABLE collection (
+  collectionid INTEGER PRIMARY KEY NOT NULL,
+  name VARCHAR(100)
+);
+
+--
+-- Table: collection_object
+--
+CREATE TABLE collection_object (
+  collection INTEGER NOT NULL,
+  object INTEGER NOT NULL
+);
+
+--
+-- Table: owners
+--
+CREATE TABLE owners (
+  ownerid INTEGER PRIMARY KEY NOT NULL,
+  name varchar(100)
+);
+
+--
+-- Table: books
+--
+CREATE TABLE books (
+  id INTEGER PRIMARY KEY NOT NULL,
+  owner INTEGER,
+  source varchar(100),
+  title varchar(100)
+);
+
+
 CREATE UNIQUE INDEX tktlnameunique_twokeytreelike on twokeytreelike (name);
 CREATE UNIQUE INDEX cd_artist_title_cd on cd (artist, title);
 CREATE UNIQUE INDEX track_cd_position_track on track (cd, position);