--- /dev/null
+Build
+Build.bat
+Makefile
+_build/
+blib/
+t/var/
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.
*{"${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 }
);
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);
$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} };
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
: undef
);
- if (defined $where) {
+ if (defined $where and %$where) {
$new_attrs->{where} = (
defined $new_attrs->{where}
? { '-and' => [
}
: $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} = (
) 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);
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
--- /dev/null
+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
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);
}
}
[ 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;
'Producer',
'CD_to_Producer',
),
- qw/SelfRefAlias TreeLike TwoKeyTreeLike Event NoPrimaryKey/
+ qw/SelfRefAlias TreeLike TwoKeyTreeLike Event NoPrimaryKey/,
+ qw/Collection CollectionObject TypedObject/,
+ qw/Owners BooksInLibrary/
);
1;
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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;
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);