[Bast-commits] r3811 - in branches/DBIx-Class-Schema-Loader/current:
lib/DBIx/Class/Schema/Loader t/lib
ilmari at dev.catalyst.perl.org
ilmari at dev.catalyst.perl.org
Wed Oct 10 17:48:14 GMT 2007
Author: ilmari
Date: 2007-10-10 17:48:14 +0100 (Wed, 10 Oct 2007)
New Revision: 3811
Modified:
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
Log:
Generate one-to-one accessors for unique foreign keys
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2007-10-10 16:25:37 UTC (rev 3810)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2007-10-10 16:48:14 UTC (rev 3811)
@@ -666,9 +666,10 @@
$fkdef->{remote_source} =
$self->monikers->{delete $fkdef->{remote_table}};
}
+ my $tbl_uniq_info = $self->_table_uniq_info($table);
my $local_moniker = $self->monikers->{$table};
- my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info);
+ my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder.pm 2007-10-10 16:25:37 UTC (rev 3810)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/RelBuilder.pm 2007-10-10 16:48:14 UTC (rev 3811)
@@ -121,8 +121,19 @@
return Lingua::EN::Inflect::Number::to_S($relname);
}
+sub _array_eq {
+ my ($a, $b) = @_;
+
+ return unless @$a == @$b;
+
+ for (my $i = 0; $i < @$a; $i++) {
+ return unless $a->[$i] eq $b->[$i];
+ }
+ return 1;
+}
+
sub generate_code {
- my ($self, $local_moniker, $rels) = @_;
+ my ($self, $local_moniker, $rels, $uniqs) = @_;
my $all_code = {};
@@ -187,6 +198,16 @@
delete $rev_cond{$_};
}
+ my $remote_method = 'has_many';
+
+ # If the local columns have a UNIQUE constraint, this is a one-to-one rel
+ my $primary = [ $self->{schema}->source($local_moniker)->primary_columns ];
+ if (_array_eq($primary, $local_cols) ||
+ grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
+ $remote_method = 'might_have';
+ $local_relname = $self->_inflect_singular($local_relname);
+ }
+
push(@{$all_code->{$local_class}},
{ method => 'belongs_to',
args => [ $remote_relname,
@@ -197,7 +218,7 @@
);
push(@{$all_code->{$remote_class}},
- { method => 'has_many',
+ { method => $remote_method,
args => [ $local_relname,
$local_class,
\%rev_cond,
Modified: branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm 2007-10-10 16:25:37 UTC (rev 3810)
+++ branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm 2007-10-10 16:48:14 UTC (rev 3811)
@@ -43,7 +43,7 @@
sub run_tests {
my $self = shift;
- plan tests => 88;
+ plan tests => 97;
$self->create();
@@ -310,6 +310,18 @@
my $class26 = $classes->{loader_test26};
my $rsobj26 = $conn->resultset($moniker26);
+ my $moniker27 = $monikers->{loader_test27};
+ my $class27 = $classes->{loader_test27};
+ my $rsobj27 = $conn->resultset($moniker27);
+
+ my $moniker28 = $monikers->{loader_test28};
+ my $class28 = $classes->{loader_test28};
+ my $rsobj28 = $conn->resultset($moniker28);
+
+ my $moniker29 = $monikers->{loader_test29};
+ my $class29 = $classes->{loader_test29};
+ my $rsobj29 = $conn->resultset($moniker29);
+
isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
@@ -326,6 +338,9 @@
isa_ok( $rsobj22, "DBIx::Class::ResultSet" );
isa_ok( $rsobj25, "DBIx::Class::ResultSet" );
isa_ok( $rsobj26, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj27, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj28, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj29, "DBIx::Class::ResultSet" );
# basic rel test
my $obj4 = $rsobj4->find(123);
@@ -384,6 +399,20 @@
isa_ok($rs_rel26->first, $class26);
is($rs_rel26->first->id, 3);
+ # test one-to-one rels
+ my $obj27 = $rsobj27->find(1);
+ my $obj28 = $obj27->loader_test28;
+ isa_ok($obj28, $class28);
+ is($obj28->get_column('id'), 1);
+
+ my $obj29 = $obj27->loader_test29;
+ isa_ok($obj29, $class29);
+ is($obj29->id, 1);
+
+ $obj27 = $rsobj27->find(2);
+ is($obj27->loader_test28, undef);
+ is($obj27->loader_test29, undef);
+
# from Chisel's tests...
SKIP: {
if($self->{vendor} =~ /sqlite/i) {
@@ -758,6 +787,34 @@
q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (33,5,7) },
q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (3,42,42) },
+
+ qq{
+ CREATE TABLE loader_test27 (
+ id INTEGER NOT NULL PRIMARY KEY
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test27 (id) VALUES (1) },
+ q{ INSERT INTO loader_test27 (id) VALUES (2) },
+
+ qq{
+ CREATE TABLE loader_test28 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ FOREIGN KEY (id) REFERENCES loader_test27 (id)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test28 (id) VALUES (1) },
+
+ qq{
+ CREATE TABLE loader_test29 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ fk INTEGER UNIQUE,
+ FOREIGN KEY (fk) REFERENCES loader_test27 (id)
+ ) $self->{innodb}
+ },
+
+ q{ INSERT INTO loader_test29 (id,fk) VALUES (1,1) },
);
my @statements_advanced = (
@@ -884,6 +941,9 @@
loader_test21
loader_test26
loader_test25
+ loader_test28
+ loader_test29
+ loader_test27
/;
my @tables_advanced = qw/
More information about the Bast-commits
mailing list