[Bast-commits] r4773 - in DBIx-Class/0.08/trunk: . lib/DBIx/Class
lib/DBIx/Class/Relationship t t/lib t/lib/DBICTest
t/lib/DBICTest/Schema
matthewt at dev.catalyst.perl.org
matthewt at dev.catalyst.perl.org
Tue Aug 26 02:36:09 BST 2008
Author: matthewt
Date: 2008-08-26 02:36:09 +0100 (Tue, 26 Aug 2008)
New Revision: 4773
Modified:
DBIx-Class/0.08/trunk/Changes
DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSource.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Row.pm
DBIx-Class/0.08/trunk/t/60core.t
DBIx-Class/0.08/trunk/t/66relationship.t
DBIx-Class/0.08/trunk/t/77prefetch.t
DBIx-Class/0.08/trunk/t/91debug.t
DBIx-Class/0.08/trunk/t/93single_accessor_object.t
DBIx-Class/0.08/trunk/t/96multi_create.t
DBIx-Class/0.08/trunk/t/99dbic_sqlt_parser.t
DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema.pm
DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/CD.pm
DBIx-Class/0.08/trunk/t/lib/sqlite.sql
Log:
fix related resultsets and multi-create
Modified: DBIx-Class/0.08/trunk/Changes
===================================================================
--- DBIx-Class/0.08/trunk/Changes 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/Changes 2008-08-26 01:36:09 UTC (rev 4773)
@@ -1,4 +1,6 @@
Revision history for DBIx::Class
+
+ - Fixed up related resultsets and multi-create
- Fixed superfluous connection in ODBC::_rebless
- Fixed undef PK for first insert in ODBC::Microsoft_SQL_Server
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm 2008-08-26 01:36:09 UTC (rev 4773)
@@ -190,11 +190,18 @@
$rel_obj->{cond}, $rel, $self
);
if (ref $cond eq 'ARRAY') {
- $cond = [ map { my $hash;
- foreach my $key (keys %$_) {
- my $newkey = $key =~ /\./ ? "me.$key" : $key;
- $hash->{$newkey} = $_->{$key};
- }; $hash } @$cond ];
+ $cond = [ map {
+ if (ref $_ eq 'HASH') {
+ my $hash;
+ foreach my $key (keys %$_) {
+ my $newkey = $key =~ /\./ ? "me.$key" : $key;
+ $hash->{$newkey} = $_->{$key};
+ }
+ $hash;
+ } else {
+ $_;
+ }
+ } @$cond ];
} else {
foreach my $key (grep { ! /\./ } keys %$cond) {
$cond->{"me.$key"} = delete $cond->{$key};
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSource.pm 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSource.pm 2008-08-26 01:36:09 UTC (rev 4773)
@@ -768,6 +768,49 @@
}
}
+=head2 pk_depends_on
+
+=over 4
+
+=item Arguments: $relname, $rel_data
+
+=back
+
+Determines whether a relation is dependent on an object from this source
+having already been inserted. Takes the name of the relationship and a
+hashref of columns of the related object.
+
+=cut
+
+sub pk_depends_on {
+ my ($self, $relname, $rel_data) = @_;
+ my $cond = $self->relationship_info($relname)->{cond};
+
+ return 0 unless ref($cond) eq 'HASH';
+
+ # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
+
+ my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
+
+ # assume anything that references our PK probably is dependent on us
+ # rather than vice versa, unless the far side is (a) defined or (b)
+ # auto-increment
+
+ my $rel_source = $self->related_source($relname);
+
+ foreach my $p ($self->primary_columns) {
+ if (exists $keyhash->{$p}) {
+ unless (defined($rel_data->{$keyhash->{$p}})
+ || $rel_source->column_info($keyhash->{$p})
+ ->{is_auto_increment}) {
+ return 0;
+ }
+ }
+ }
+
+ return 1;
+}
+
=head2 resolve_condition
=over 4
@@ -796,7 +839,14 @@
$self->throw_exception("Invalid rel cond val ${v}");
if (ref $for) { # Object
#warn "$self $k $for $v";
- $ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
+ unless ($for->has_column_loaded($v)) {
+ if ($for->in_storage) {
+ $self->throw_exception("Column ${v} not loaded on ${for} trying to reolve relationship");
+ }
+ return [ \'1 = 0' ];
+ }
+ $ret{$k} = $for->get_column($v);
+ #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
#warn %ret;
} elsif (!defined $for) { # undef, i.e. "no object"
$ret{$k} = undef;
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Row.pm 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Row.pm 2008-08-26 01:36:09 UTC (rev 4773)
@@ -46,6 +46,37 @@
## check Relationship::CascadeActions and Relationship::Accessor for compat
## tests!
+sub __new_related_find_or_new_helper {
+ my ($self, $relname, $data) = @_;
+ if ($self->__their_pk_needs_us($relname, $data)) {
+ return $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->new_result($data);
+ }
+ if ($self->result_source->pk_depends_on($relname, $data)) {
+ return $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->find_or_new($data);
+ }
+ return $self->find_or_new_related($relname, $data);
+}
+
+sub __their_pk_needs_us { # this should maybe be in resultsource.
+ my ($self, $relname, $data) = @_;
+ my $source = $self->result_source;
+ my $reverse = $source->reverse_relationship_info($relname);
+ my $rel_source = $source->related_source($relname);
+ my $us = { $self->get_columns };
+ foreach my $key (keys %$reverse) {
+ # if their primary key depends on us, then we have to
+ # just create a result and we'll fill it out afterwards
+ return 1 if $rel_source->pk_depends_on($key, $us);
+ }
+ return 0;
+}
+
sub new {
my ($class, $attrs) = @_;
$class = ref $class if ref $class;
@@ -58,7 +89,9 @@
if (my $handle = delete $attrs->{-source_handle}) {
$new->_source_handle($handle);
}
- if (my $source = delete $attrs->{-result_source}) {
+
+ my $source;
+ if ($source = delete $attrs->{-result_source}) {
$new->result_source($source);
}
@@ -73,18 +106,19 @@
foreach my $key (keys %$attrs) {
if (ref $attrs->{$key}) {
## Can we extract this lot to use with update(_or .. ) ?
- my $info = $class->relationship_info($key);
+ confess "Can't do multi-create without result source" unless $source;
+ my $info = $source->relationship_info($key);
if ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'single')
{
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
- $rel_obj = $new->find_or_new_related($key, $rel_obj);
+ $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
$new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
- $new->set_from_related($key, $rel_obj);
+ $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
$related->{$key} = $rel_obj;
next;
} elsif ($info && $info->{attrs}{accessor}
@@ -93,11 +127,11 @@
my $others = delete $attrs->{$key};
foreach my $rel_obj (@$others) {
if(!Scalar::Util::blessed($rel_obj)) {
- $rel_obj = $new->new_related($key, $rel_obj);
- $new->{_rel_in_storage} = 0;
+ $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
$new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+ $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
}
$related->{$key} = $others;
next;
@@ -107,9 +141,9 @@
## 'filter' should disappear and get merged in with 'single' above!
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
- $rel_obj = $new->find_or_new_related($key, $rel_obj);
- $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+ $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
+ $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
$inflated->{$key} = $rel_obj;
next;
} elsif ($class->has_column($key)
@@ -181,28 +215,10 @@
next REL unless (Scalar::Util::blessed($rel_obj)
&& $rel_obj->isa('DBIx::Class::Row'));
- my $cond = $source->relationship_info($relname)->{cond};
+ next REL unless $source->pk_depends_on(
+ $relname, { $rel_obj->get_columns }
+ );
- next REL unless ref($cond) eq 'HASH';
-
- # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
-
- my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
-
- # assume anything that references our PK probably is dependent on us
- # rather than vice versa, unless the far side is (a) defined or (b)
- # auto-increment
-
- foreach my $p (@pri) {
- if (exists $keyhash->{$p}) {
- unless (defined($rel_obj->get_column($keyhash->{$p}))
- || $rel_obj->column_info($keyhash->{$p})
- ->{is_auto_increment}) {
- next REL;
- }
- }
- }
-
$rel_obj->insert();
$self->set_from_related($relname, $rel_obj);
delete $related_stuff{$relname};
@@ -231,6 +247,9 @@
$self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
}
+ $self->{_dirty_columns} = {};
+ $self->{related_resultsets} = {};
+
if(!$self->{_rel_in_storage}) {
## Now do the has_many rels, that need $selfs ID.
foreach my $relname (keys %related_stuff) {
@@ -246,7 +265,12 @@
my $reverse = $source->reverse_relationship_info($relname);
foreach my $obj (@cands) {
$obj->set_from_related($_, $self) for keys %$reverse;
- $obj->insert() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count);
+ my $them = { $obj->get_columns };
+ if ($self->__their_pk_needs_us($relname, $them)) {
+ $obj = $self->find_or_create_related($relname, $them);
+ } else {
+ $obj->insert();
+ }
}
}
}
@@ -254,8 +278,6 @@
}
$self->in_storage(1);
- $self->{_dirty_columns} = {};
- $self->{related_resultsets} = {};
undef $self->{_orig_ident};
return $self;
}
@@ -723,7 +745,8 @@
=cut
-*insert_or_update = \&update_or_insert;
+sub insert_or_update { shift->update_or_insert(@_) }
+
sub update_or_insert {
my $self = shift;
return ($self->in_storage ? $self->update : $self->insert);
Modified: DBIx-Class/0.08/trunk/t/60core.t
===================================================================
--- DBIx-Class/0.08/trunk/t/60core.t 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/60core.t 2008-08-26 01:36:09 UTC (rev 4773)
@@ -153,7 +153,7 @@
my $cd = $schema->resultset("CD")->find(1);
my %cols = $cd->get_columns;
-cmp_ok(keys %cols, '==', 4, 'get_columns number of columns ok');
+cmp_ok(keys %cols, '==', 5, 'get_columns number of columns ok');
is($cols{title}, 'Spoonful of bees', 'get_columns values ok');
@@ -169,7 +169,7 @@
# check whether ResultSource->columns returns columns in order originally supplied
my @cd = $schema->source("CD")->columns;
-is_deeply( \@cd, [qw/cdid artist title year/], 'column order');
+is_deeply( \@cd, [qw/cdid artist title year genreid/], 'column order');
$cd = $schema->resultset("CD")->search({ title => 'Spoonful of bees' }, { columns => ['title'] })->next;
is($cd->title, 'Spoonful of bees', 'subset of columns returned correctly');
@@ -335,9 +335,9 @@
# test remove_columns
{
- is_deeply([$schema->source('CD')->columns], [qw/cdid artist title year/]);
+ is_deeply([$schema->source('CD')->columns], [qw/cdid artist title year genreid/]);
$schema->source('CD')->remove_columns('year');
- is_deeply([$schema->source('CD')->columns], [qw/cdid artist title/]);
+ is_deeply([$schema->source('CD')->columns], [qw/cdid artist title genreid/]);
ok(! exists $schema->source('CD')->_columns->{'year'}, 'year still exists in _columns');
}
Modified: DBIx-Class/0.08/trunk/t/66relationship.t
===================================================================
--- DBIx-Class/0.08/trunk/t/66relationship.t 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/66relationship.t 2008-08-26 01:36:09 UTC (rev 4773)
@@ -212,7 +212,7 @@
my $undef_artist_cd = $schema->resultset("CD")->new_result({ 'title' => 'badgers', 'year' => 2007 });
is($undef_artist_cd->has_column_loaded('artist'), '', 'FK not loaded');
-is($undef_artist_cd->search_related('artist')->count, 3, 'open search on undef FK');
+is($undef_artist_cd->search_related('artist')->count, 0, '0=1 search when FK does not exist and object not yet in db');
my $def_artist_cd = $schema->resultset("CD")->new_result({ 'title' => 'badgers', 'year' => 2007, artist => undef });
is($def_artist_cd->has_column_loaded('artist'), 1, 'FK loaded');
Modified: DBIx-Class/0.08/trunk/t/77prefetch.t
===================================================================
--- DBIx-Class/0.08/trunk/t/77prefetch.t 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/77prefetch.t 2008-08-26 01:36:09 UTC (rev 4773)
@@ -69,7 +69,7 @@
# test for partial prefetch via columns attr
my $cd = $schema->resultset('CD')->find(1,
{
- columns => [qw/title artist.name/],
+ columns => [qw/title artist artist.name/],
join => { 'artist' => {} }
}
);
Modified: DBIx-Class/0.08/trunk/t/91debug.t
===================================================================
--- DBIx-Class/0.08/trunk/t/91debug.t 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/91debug.t 2008-08-26 01:36:09 UTC (rev 4773)
@@ -55,7 +55,7 @@
my @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } );
like(
$sql,
- qr/\QSELECT me.cdid, me.artist, me.title, me.year FROM cd me WHERE ( artist = ? AND cdid BETWEEN ? AND ? ): '1', '1', '3'\E/,
+ qr/\QSELECT me.cdid, me.artist, me.title, me.year, me.genreid FROM cd me WHERE ( artist = ? AND cdid BETWEEN ? AND ? ): '1', '1', '3'\E/,
'got correct SQL with all bind parameters'
);
}
Modified: DBIx-Class/0.08/trunk/t/93single_accessor_object.t
===================================================================
--- DBIx-Class/0.08/trunk/t/93single_accessor_object.t 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/93single_accessor_object.t 2008-08-26 01:36:09 UTC (rev 4773)
@@ -2,12 +2,13 @@
use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
my $schema = DBICTest->init_schema();
-plan tests => 7;
+plan tests => 10;
# Test various uses of passing an object to find, create, and update on a single
# rel accessor
@@ -40,3 +41,24 @@
$track->update({ disc => $another_cd });
is($track->get_column('cd'), $another_cd->cdid, 'track matches another CD after update');
}
+
+$schema = DBICTest->init_schema();
+
+{
+ my $artist = $schema->resultset('Artist')->create({ artistid => 666, name => 'bad religion' });
+ my $cd = $schema->resultset('CD')->create({ cdid => 187, artist => 1, title => 'how could hell be any worse?', year => 1982, genreid => undef });
+
+ ok(!defined($cd->genreid), 'genreid is NULL');
+ ok(!defined($cd->genre), 'genre accessor returns undef');
+}
+
+$schema = DBICTest->init_schema();
+
+{
+ my $artist = $schema->resultset('Artist')->create({ artistid => 666, name => 'bad religion' });
+ my $genre = $schema->resultset('Genre')->create({ name => 'disco' });
+ my $cd = $schema->resultset('CD')->create({ cdid => 187, artist => 1, title => 'how could hell be any worse?', year => 1982 });
+
+ dies_ok { $cd->genre } 'genre accessor throws without column';
+}
+
Modified: DBIx-Class/0.08/trunk/t/96multi_create.t
===================================================================
--- DBIx-Class/0.08/trunk/t/96multi_create.t 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/96multi_create.t 2008-08-26 01:36:09 UTC (rev 4773)
@@ -51,16 +51,16 @@
is($newartist2->name, 'Fred 3', 'Created new artist with cds via find_or_create');
-my $artist2 = $schema->resultset('Artist')->create({ artistid => 1000,
+my $artist2 = $schema->resultset('Artist')->create({
name => 'Fred 3',
cds => [
- { artist => 1000,
+ {
title => 'Music to code by',
year => 2007,
},
],
cds_unordered => [
- { artist => 1000,
+ {
title => 'Music to code by',
year => 2007,
},
@@ -202,7 +202,7 @@
eval {
$schema->resultset("CD")->create({
cdid => 28,
- title => 'Boogie Wiggle',
+ title => 'Boogie Wiggle',
year => '2007',
artist => { artistid => 18, name => 'larry' }
});
@@ -211,9 +211,9 @@
# Make sure exceptions from errors in created rels propogate
eval {
- my $t = $schema->resultset("Track")->new({});
- $t->cd($t->new_related('cd', { artist => undef } ) );
- $t->{_rel_in_storage} = 0;
+ my $t = $schema->resultset("Track")->new({ cd => { artist => undef } });
+ #$t->cd($t->new_related('cd', { artist => undef } ) );
+ #$t->{_rel_in_storage} = 0;
$t->insert;
};
like($@, qr/cd.artist may not be NULL/, "Exception propogated properly");
Modified: DBIx-Class/0.08/trunk/t/99dbic_sqlt_parser.t
===================================================================
--- DBIx-Class/0.08/trunk/t/99dbic_sqlt_parser.t 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/99dbic_sqlt_parser.t 2008-08-26 01:36:09 UTC (rev 4773)
@@ -9,7 +9,7 @@
eval "use DBD::mysql; use SQL::Translator 0.09;";
plan $@
? ( skip_all => 'needs SQL::Translator 0.09 for testing' )
- : ( tests => 99 );
+ : ( tests => 102 );
}
my $schema = DBICTest->init_schema();
Modified: DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/CD.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/CD.pm 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/CD.pm 2008-08-26 01:36:09 UTC (rev 4773)
@@ -20,6 +20,9 @@
data_type => 'varchar',
size => 100,
},
+ 'genreid' => {
+ data_type => 'integer'
+ }
);
__PACKAGE__->set_primary_key('cdid');
__PACKAGE__->add_unique_constraint([ qw/artist title/ ]);
@@ -49,4 +52,11 @@
{ order_by => 'producer.name' },
);
+__PACKAGE__->belongs_to('genre', 'DBICTest::Schema::Genre', { 'foreign.genreid' => 'self.genreid' });
+
+#__PACKAGE__->add_relationship('genre', 'DBICTest::Schema::Genre',
+# { 'foreign.genreid' => 'self.genreid' },
+# { 'accessor' => 'single' }
+#);
+
1;
Modified: DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema.pm 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema.pm 2008-08-26 01:36:09 UTC (rev 4773)
@@ -11,6 +11,7 @@
Employee
CD
FileColumn
+ Genre
Link
Bookmark
#dummy
Modified: DBIx-Class/0.08/trunk/t/lib/sqlite.sql
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/sqlite.sql 2008-08-25 21:53:29 UTC (rev 4772)
+++ DBIx-Class/0.08/trunk/t/lib/sqlite.sql 2008-08-26 01:36:09 UTC (rev 4773)
@@ -90,10 +90,19 @@
cdid INTEGER PRIMARY KEY NOT NULL,
artist integer NOT NULL,
title varchar(100) NOT NULL,
- year varchar(100) NOT NULL
+ year varchar(100) NOT NULL,
+ genreid integer
);
--
+-- Table: genre
+--
+CREATE TABLE genre (
+ genreid INTEGER PRIMARY KEY NOT NULL,
+ name varchar(100) NOT NULL
+);
+
+--
-- Table: bookmark
--
CREATE TABLE bookmark (
More information about the Bast-commits
mailing list