1 package DBIx::Class::Schema::Loader::RelBuilder;
6 use Carp::Clan qw/^DBIx::Class/;
7 use Lingua::EN::Inflect::Number ();
8 use Lingua::EN::Inflect::Phrase ();
10 our $VERSION = '0.05003';
14 DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader
18 See L<DBIx::Class::Schema::Loader>
22 This class builds relationships for L<DBIx::Class::Schema::Loader>. This
23 is module is not (yet) for external use.
29 Arguments: schema_class (scalar), inflect_plural, inflect_singular
31 C<$schema_class> should be a schema class name, where the source
32 classes have already been set up and registered. Column info, primary
33 key, and unique constraints will be drawn from this schema for all
34 of the existing source monikers.
36 Options inflect_plural and inflect_singular are optional, and are better documented
37 in L<DBIx::Class::Schema::Loader::Base>.
41 Arguments: local_moniker (scalar), fk_info (arrayref)
43 This generates the code for the relationships of a given table.
45 C<local_moniker> is the moniker name of the table which had the REFERENCES
46 statements. The fk_info arrayref's contents should take the form:
50 local_columns => [ 'col2', 'col3' ],
51 remote_columns => [ 'col5', 'col7' ],
52 remote_moniker => 'AnotherTableMoniker',
55 local_columns => [ 'col1', 'col4' ],
56 remote_columns => [ 'col1', 'col2' ],
57 remote_moniker => 'YetAnotherTableMoniker',
62 This method will return the generated relationships as a hashref keyed on the
63 class names. The values are arrayrefs of hashes containing method name and
67 'Some::Source::Class' => [
68 { method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
69 { method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
71 'Another::Source::Class' => [
81 my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_;
85 inflect_plural => $inflect_pl,
86 inflect_singular => $inflect_singular,
87 relationship_attrs => $rel_attrs,
90 # validate the relationship_attrs arg
91 if( defined $self->{relationship_attrs} ) {
92 ref($self->{relationship_attrs}) eq 'HASH'
93 or croak "relationship_attrs must be a hashref";
96 return bless $self => $class;
100 # pluralize a relationship name
101 sub _inflect_plural {
102 my ($self, $relname, $method) = @_;
104 return '' if !defined $relname || $relname eq '';
106 if( ref $self->{inflect_plural} eq 'HASH' ) {
107 return $self->{inflect_plural}->{$relname}
108 if exists $self->{inflect_plural}->{$relname};
110 elsif( ref $self->{inflect_plural} eq 'CODE' ) {
111 my $inflected = $self->{inflect_plural}->($relname);
112 return $inflected if $inflected;
115 $method ||= '_to_PL';
117 return $self->$method($relname);
120 # Singularize a relationship name
121 sub _inflect_singular {
122 my ($self, $relname, $method) = @_;
124 return '' if !defined $relname || $relname eq '';
126 if( ref $self->{inflect_singular} eq 'HASH' ) {
127 return $self->{inflect_singular}->{$relname}
128 if exists $self->{inflect_singular}->{$relname};
130 elsif( ref $self->{inflect_singular} eq 'CODE' ) {
131 my $inflected = $self->{inflect_singular}->($relname);
132 return $inflected if $inflected;
137 return $self->$method($relname);
141 my ($self, $name) = @_;
144 my $plural = Lingua::EN::Inflect::Phrase::to_PL($name);
151 my ($self, $name) = @_;
153 return Lingua::EN::Inflect::Number::to_PL($name);
157 my ($self, $name) = @_;
160 my $singular = Lingua::EN::Inflect::Phrase::to_S($name);
161 $singular =~ s/ /_/g;
167 my ($self, $name) = @_;
169 return Lingua::EN::Inflect::Number::to_S($name);
172 sub _default_relationship_attrs { +{
182 on_delete => 'CASCADE',
183 on_update => 'CASCADE',
188 # accessor for options to be passed to each generated relationship
189 # type. take single argument, the relationship type name, and returns
190 # either a hashref (if some options are set), or nothing
191 sub _relationship_attrs {
192 my ( $self, $reltype ) = @_;
193 my $r = $self->{relationship_attrs};
196 %{ $self->_default_relationship_attrs->{$reltype} || {} },
200 if( my $specific = $r->{$reltype} ) {
201 while( my ($k,$v) = each %$specific ) {
211 return unless @$a == @$b;
213 for (my $i = 0; $i < @$a; $i++) {
214 return unless $a->[$i] eq $b->[$i];
220 my ($self, $local_moniker, $local_cols) = @_;
222 # get our base set of attrs from _relationship_attrs, if present
223 my $attrs = $self->_relationship_attrs('belongs_to') || {};
225 # If the referring column is nullable, make 'belongs_to' an
226 # outer join, unless explicitly set by relationship_attrs
227 my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} } @$local_cols;
228 $attrs->{join_type} = 'LEFT' if $nullable && !defined $attrs->{join_type};
233 sub _remote_relname {
234 my ($self, $remote_table, $cond) = @_;
237 # for single-column case, set the remote relname to the column
238 # name, to make filter accessors work, but strip trailing _id
239 if(scalar keys %{$cond} == 1) {
240 my ($col) = values %{$cond};
243 $remote_relname = $self->_inflect_singular($col);
246 $remote_relname = $self->_inflect_singular(lc $remote_table);
249 return $remote_relname;
253 my ($self, $local_moniker, $rels, $uniqs) = @_;
257 my $local_class = $self->{schema}->class($local_moniker);
260 foreach my $rel (@$rels) {
261 next if !$rel->{remote_source};
262 $counters{$rel->{remote_source}}++;
265 foreach my $rel (@$rels) {
266 my $remote_moniker = $rel->{remote_source}
269 my $remote_class = $self->{schema}->class($remote_moniker);
270 my $remote_obj = $self->{schema}->source($remote_moniker);
271 my $remote_cols = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
273 my $local_cols = $rel->{local_columns};
275 if($#$local_cols != $#$remote_cols) {
276 croak "Column count mismatch: $local_moniker (@$local_cols) "
277 . "$remote_moniker (@$remote_cols)";
281 foreach my $i (0 .. $#$local_cols) {
282 $cond{$remote_cols->[$i]} = $local_cols->[$i];
285 my ( $local_relname, $remote_relname, $remote_method ) =
286 $self->_relnames_and_method( $local_moniker, $rel, \%cond, $uniqs, \%counters );
288 push(@{$all_code->{$local_class}},
289 { method => 'belongs_to',
290 args => [ $remote_relname,
293 $self->_remote_attrs($local_moniker, $local_cols),
298 my %rev_cond = reverse %cond;
299 for (keys %rev_cond) {
300 $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
301 delete $rev_cond{$_};
304 push(@{$all_code->{$remote_class}},
305 { method => $remote_method,
306 args => [ $local_relname,
309 $self->_relationship_attrs($remote_method),
318 sub _relnames_and_method {
319 my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
321 my $remote_moniker = $rel->{remote_source};
322 my $remote_obj = $self->{schema}->source( $remote_moniker );
323 my $remote_class = $self->{schema}->class( $remote_moniker );
324 my $remote_relname = lc $self->_remote_relname( $remote_obj->from, $cond);
326 my $local_cols = $rel->{local_columns};
327 my $local_table = $self->{schema}->source($local_moniker)->from;
329 # If more than one rel between this pair of tables, use the local
330 # col names to distinguish
331 my ($local_relname, $old_local_relname, $local_relname_uninflected, $old_local_relname_uninflected);
332 if ( $counters->{$remote_moniker} > 1) {
333 my $colnames = lc(q{_} . join(q{_}, @$local_cols));
334 $remote_relname .= $colnames if keys %$cond > 1;
336 $local_relname = lc($local_table) . $colnames;
337 $local_relname =~ s/_id$//;
339 $local_relname_uninflected = $local_relname;
340 $local_relname = $self->_inflect_plural( $local_relname );
342 $old_local_relname_uninflected = lc($local_table) . $colnames;
343 $old_local_relname = $self->_inflect_plural( lc($local_table) . $colnames, '_old_to_PL' );
346 $local_relname_uninflected = lc $local_table;
347 $local_relname = $self->_inflect_plural(lc $local_table);
349 $old_local_relname_uninflected = lc $local_table;
350 $old_local_relname = $self->_inflect_plural(lc $local_table, '_old_to_PL');
353 my $remote_method = 'has_many';
355 # If the local columns have a UNIQUE constraint, this is a one-to-one rel
356 my $local_source = $self->{schema}->source($local_moniker);
357 if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
358 grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
359 $remote_method = 'might_have';
360 $local_relname = $self->_inflect_singular($local_relname_uninflected);
361 $old_local_relname = $self->_inflect_singular($old_local_relname_uninflected, '_old_to_S');
364 warn __PACKAGE__." $VERSION: renaming ${remote_class} relation '$old_local_relname' to '$local_relname'. This behavior is new as of 0.05003.\n" if $old_local_relname && $local_relname ne $old_local_relname;
366 return ( $local_relname, $remote_relname, $remote_method );
371 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
375 This library is free software; you can redistribute it and/or modify it under
376 the same terms as Perl itself.