Revision history for Perl extension DBIx::Class::Schema::Loader
+ - support coderefs for relationship_attrs
+
0.07031 2012-09-06 15:07:08
- fix 02pod.t failure due to lack of =encoding utf8 statement (patch by
Marcel Gruenauer) (RT#79481)
=head2 relationship_attrs
-Hashref of attributes to pass to each generated relationship, listed
-by type. Also supports relationship type 'all', containing options to
-pass to all generated relationships. Attributes set for more specific
-relationship types override those set in 'all'.
+Hashref of attributes to pass to each generated relationship, listed by type.
+Also supports relationship type 'all', containing options to pass to all
+generated relationships. Attributes set for more specific relationship types
+override those set in 'all', and any attributes specified by this option
+override the introspected attributes of the foreign key if any.
For example:
relationship_attrs => {
- belongs_to => { is_deferrable => 0 },
+ has_many => { cascade_delete => 1, cascade_copy => 1 },
},
-use this to turn off DEFERRABLE on your foreign key constraints.
+use this to turn L<DBIx::Class> cascades to on on your
+L<has_many|DBIx::Class::Relationship/has_many> relationships, they default to
+off.
+
+Can also be a coderef, for more precise control, in which case the coderef gets
+this hash of parameters:
+
+ rel_name # the name of the relationship
+ local_source # the DBIx::Class::ResultSource object for the source the rel is *from*
+ remote_source # the DBIx::Class::ResultSource object for the source the rel is *to*
+ local_table # a DBIx::Class::Schema::Loader::Table object for the table of the source the rel is from
+ local_cols # an arrayref of column names of columns used in the rel in the source it is from
+ remote_table # a DBIx::Class::Schema::Loader::Table object for the table of the source the rel is to
+ remote_cols # an arrayref of column names of columns used in the rel in the source it is to
+ attrs # the attributes that would be set
+
+it should return the new hashref of attributes, or nothing for no changes.
+
+For example:
+
+ relationship_attrs => sub {
+ my %p = @_;
+
+ say "the relationship name is: $p{rel_name}";
+ say "the local class is: ", $p{local_source}->result_class;
+ say "the remote class is: ", $p{remote_source}->result_class;
+ say "the local table is: ", $p{local_table}->sql_name;
+ say "the rel columns in the local table are: ", (join ", ", @{$p{local_cols}});
+ say "the remote table is: ", $p{remote_table}->sql_name;
+ say "the rel columns in the remote table are: ", (join ", ", @{$p{remote_cols}});
+
+ if ($p{local_table} eq 'dogs' && @{$p{local_cols}} == 1 && $p{local_cols}[0] eq 'name') {
+ $p{attrs}{could_be_snoopy} = 1;
+
+ reutrn $p{attrs};
+ }
+ },
=head2 debug
/);
use overload
- '""' => sub { $_[0]->name };
+ '""' => sub { $_[0]->name },
+ fallback => 1;
=head2 new
# validate the relationship_attrs arg
if( defined $self->relationship_attrs ) {
- ref $self->relationship_attrs eq 'HASH'
- or croak "relationship_attrs must be a hashref";
+ (ref $self->relationship_attrs eq 'HASH' || ref $self->relationship_attrs eq 'CODE')
+ or croak "relationship_attrs must be a hashref or coderef";
}
return $self;
# The attributes from the database override the default attributes, which in
# turn are overridden by user supplied attributes.
sub _relationship_attrs {
- my ( $self, $reltype, $db_attrs ) = @_;
+ my ( $self, $reltype, $db_attrs, $params ) = @_;
my $r = $self->relationship_attrs;
my %composite = (
%{ $self->_default_relationship_attrs->{$reltype} || {} },
%{ $db_attrs || {} },
- %{ $r->{all} || {} },
- %{ $r->{$reltype} || {} },
+ (
+ ref $r eq 'HASH' ? (
+ %{ $r->{all} || {} },
+ %{ $r->{$reltype} || {} },
+ )
+ :
+ ()
+ ),
);
+ if (ref $r eq 'CODE') {
+ $params->{attrs} = \%composite;
+
+ my %ret = %{ $r->(%$params) || {} };
+
+ %composite = %ret if %ret;
+ }
+
return %composite ? \%composite : undef;
}
}
sub _remote_attrs {
- my ($self, $local_moniker, $local_cols, $fk_attrs) = @_;
+ my ($self, $local_moniker, $local_cols, $fk_attrs, $params) = @_;
# get our set of attrs from _relationship_attrs, which uses the FK attrs if available
- my $attrs = $self->_relationship_attrs('belongs_to', $fk_attrs) || {};
+ my $attrs = $self->_relationship_attrs('belongs_to', $fk_attrs, $params) || {};
# If any referring column is nullable, make 'belongs_to' an
# outer join, unless explicitly set by relationship_attrs
$remote_relname = $self->_resolve_relname_collision($local_moniker, $local_cols, $remote_relname);
$local_relname = $self->_resolve_relname_collision($remote_moniker, $remote_cols, $local_relname);
+ my $rel_attrs_params = {
+ rel_name => $remote_relname,
+ local_source => $self->schema->source($local_moniker),
+ remote_source => $self->schema->source($remote_moniker),
+ local_table => $rel->{local_table},
+ local_cols => $local_cols,
+ remote_table => $rel->{remote_table},
+ remote_cols => $remote_cols,
+ };
+
push(@{$all_code->{$local_class}},
{ method => $local_method,
args => [ $remote_relname,
$remote_class,
\%cond,
- $self->_remote_attrs($local_moniker, $local_cols, $rel->{attrs}),
+ $self->_remote_attrs($local_moniker, $local_cols, $rel->{attrs}, $rel_attrs_params),
],
extra => {
local_class => $local_class,
delete $rev_cond{$_};
}
+ $rel_attrs_params = {
+ rel_name => $local_relname,
+ local_source => $self->schema->source($remote_moniker),
+ remote_source => $self->schema->source($local_moniker),
+ local_table => $rel->{remote_table},
+ local_cols => $remote_cols,
+ remote_table => $rel->{local_table},
+ remote_cols => $local_cols,
+ };
+
push(@{$all_code->{$remote_class}},
{ method => $remote_method,
args => [ $local_relname,
$local_class,
\%rev_cond,
- $self->_relationship_attrs($remote_method),
+ $self->_relationship_attrs($remote_method, {}, $rel_attrs_params),
],
extra => {
local_class => $remote_class,
use strict;
-use Test::More tests => 12;
+use Test::More;
use Test::Exception;
+use Try::Tiny;
use lib qw(t/lib);
use make_dbictest_db;
# test relationship_attrs
throws_ok {
schema_with( relationship_attrs => 'laughably invalid!!!' );
-} qr/relationship_attrs/, 'throws error for invalid relationship_attrs';
+} qr/relationship_attrs/, 'throws error for invalid (scalar) relationship_attrs';
+throws_ok {
+ schema_with( relationship_attrs => [qw/laughably invalid/] );
+} qr/relationship_attrs/, 'throws error for invalid (arrayref) relationship_attrs';
{
my $nodelete = schema_with( relationship_attrs =>
);
}
+# test relationship_attrs coderef
+{
+ my $relationship_attrs_coderef_invoked = 0;
+ my $schema;
+
+ lives_ok {
+ $schema = schema_with(relationship_attrs => sub {
+ my %p = @_;
+
+ $relationship_attrs_coderef_invoked++;
+
+ if ($p{rel_name} eq 'bars') {
+ is $p{local_table}, 'foo', 'correct local_table';
+ is_deeply $p{local_cols}, [ 'fooid' ], 'correct local_cols';
+ is $p{remote_table}, 'bar', 'correct remote_table';
+ is_deeply $p{remote_cols}, [ 'fooref' ], 'correct remote_cols';
+ is_deeply $p{attrs}, {
+ cascade_delete => 0,
+ cascade_copy => 0,
+ }, "got default rel attrs for $p{rel_name} in $p{local_table}";
+
+ like $p{local_source}->result_class,
+ qr/^DBICTest::Schema::\d+::Result::Foo\z/,
+ 'correct local source';
+
+ like $p{remote_source}->result_class,
+ qr/^DBICTest::Schema::\d+::Result::Bar\z/,
+ 'correct remote source';
+
+ $p{attrs}{snoopy} = 1;
+
+ return $p{attrs};
+ }
+ elsif ($p{rel_name} eq 'fooref') {
+ is $p{local_table}, 'bar', 'correct local_table';
+ is_deeply $p{local_cols}, [ 'fooref' ], 'correct local_cols';
+ is $p{remote_table}, 'foo', 'correct remote_table';
+ is_deeply $p{remote_cols}, [ 'fooid' ], 'correct remote_cols';
+ is_deeply $p{attrs}, {
+ on_delete => 'NO ACTION',
+ on_update => 'NO ACTION',
+ is_deferrable => 0,
+ }, "got correct rel attrs for $p{rel_name} in $p{local_table}";
+
+ like $p{local_source}->result_class,
+ qr/^DBICTest::Schema::\d+::Result::Bar\z/,
+ 'correct local source';
+
+ like $p{remote_source}->result_class,
+ qr/^DBICTest::Schema::\d+::Result::Foo\z/,
+ 'correct remote source';
+
+ $p{attrs}{scooby} = 1;
+
+ return $p{attrs};
+ }
+ else {
+ fail "unknown rel $p{rel_name} in $p{local_table}";
+ }
+ });
+ } 'dumping schema with coderef relationship_attrs survived';
+
+ is $relationship_attrs_coderef_invoked, 2,
+ 'relationship_attrs coderef was invoked correct number of times';
+
+ is ((try { $schema->source('Foo')->relationship_info('bars')->{attrs}{snoopy} }) || undef, 1,
+ "correct relationship attributes for 'bars' in 'Foo'");
+
+ is ((try { $schema->source('Bar')->relationship_info('fooref')->{attrs}{scooby} }) || undef, 1,
+ "correct relationship attributes for 'fooref' in 'Bar'");
+}
+
+done_testing;
+
#### generates a new schema with the given opts every time it's called
sub schema_with {
$schema_counter++;