1 package DBIx::Class::Schema::Loader::RelBuilder;
6 use Carp::Clan qw/^DBIx::Class/;
7 use Lingua::EN::Inflect::Phrase ();
8 use DBIx::Class::Schema::Loader::Utils 'split_name';
10 our $VERSION = '0.08000';
14 DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader
18 See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
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' => [
80 my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_;
84 inflect_plural => $inflect_pl,
85 inflect_singular => $inflect_singular,
86 relationship_attrs => $rel_attrs,
89 # validate the relationship_attrs arg
90 if( defined $self->{relationship_attrs} ) {
91 ref($self->{relationship_attrs}) eq 'HASH'
92 or croak "relationship_attrs must be a hashref";
95 return bless $self => $class;
99 # pluralize a relationship name
100 sub _inflect_plural {
101 my ($self, $relname) = @_;
103 return '' if !defined $relname || $relname eq '';
105 if( ref $self->{inflect_plural} eq 'HASH' ) {
106 return $self->{inflect_plural}->{$relname}
107 if exists $self->{inflect_plural}->{$relname};
109 elsif( ref $self->{inflect_plural} eq 'CODE' ) {
110 my $inflected = $self->{inflect_plural}->($relname);
111 return $inflected if $inflected;
114 return $self->_to_PL($relname);
117 # Singularize a relationship name
118 sub _inflect_singular {
119 my ($self, $relname) = @_;
121 return '' if !defined $relname || $relname eq '';
123 if( ref $self->{inflect_singular} eq 'HASH' ) {
124 return $self->{inflect_singular}->{$relname}
125 if exists $self->{inflect_singular}->{$relname};
127 elsif( ref $self->{inflect_singular} eq 'CODE' ) {
128 my $inflected = $self->{inflect_singular}->($relname);
129 return $inflected if $inflected;
132 return $self->_to_S($relname);
136 my ($self, $name) = @_;
139 my $plural = Lingua::EN::Inflect::Phrase::to_PL($name);
146 my ($self, $name) = @_;
149 my $singular = Lingua::EN::Inflect::Phrase::to_S($name);
150 $singular =~ s/ /_/g;
155 sub _default_relationship_attrs { +{
165 on_delete => 'CASCADE',
166 on_update => 'CASCADE',
171 # accessor for options to be passed to each generated relationship
172 # type. take single argument, the relationship type name, and returns
173 # either a hashref (if some options are set), or nothing
174 sub _relationship_attrs {
175 my ( $self, $reltype ) = @_;
176 my $r = $self->{relationship_attrs};
179 %{ $self->_default_relationship_attrs->{$reltype} || {} },
183 if( my $specific = $r->{$reltype} ) {
184 while( my ($k,$v) = each %$specific ) {
192 my ($self, $name) = @_;
194 $name =~ s/_(?:id|ref)\z//;
200 my ($self, $a, $b) = @_;
202 return unless @$a == @$b;
204 for (my $i = 0; $i < @$a; $i++) {
205 return unless $a->[$i] eq $b->[$i];
211 my ($self, $local_moniker, $local_cols) = @_;
213 # get our base set of attrs from _relationship_attrs, if present
214 my $attrs = $self->_relationship_attrs('belongs_to') || {};
216 # If the referring column is nullable, make 'belongs_to' an
217 # outer join, unless explicitly set by relationship_attrs
218 my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} } @$local_cols;
219 $attrs->{join_type} = 'LEFT' if $nullable && !defined $attrs->{join_type};
225 my ($self, $name) = @_;
228 # scalar ref for weird table name (like one containing a '.')
229 ($name = $$name) =~ s/\W+/_/g;
232 # remove 'schema.' prefix if any
233 $name =~ s/^[^.]+\.//;
239 sub _normalize_name {
240 my ($self, $name) = @_;
242 $name = $self->_sanitize_name($name);
244 my @words = split_name $name;
246 return join '_', map lc, @words;
249 sub _remote_relname {
250 my ($self, $remote_table, $cond) = @_;
253 # for single-column case, set the remote relname to the column
254 # name, to make filter accessors work, but strip trailing _id
255 if(scalar keys %{$cond} == 1) {
256 my ($col) = values %{$cond};
257 $col = $self->_normalize_name($col);
258 $col = $self->_strip__id($col);
259 $remote_relname = $self->_inflect_singular($col);
262 $remote_relname = $self->_inflect_singular($self->_normalize_name($remote_table));
265 return $remote_relname;
269 my ($self, $local_moniker, $rels, $uniqs) = @_;
273 my $local_class = $self->{schema}->class($local_moniker);
276 foreach my $rel (@$rels) {
277 next if !$rel->{remote_source};
278 $counters{$rel->{remote_source}}++;
281 foreach my $rel (@$rels) {
282 my $remote_moniker = $rel->{remote_source}
285 my $remote_class = $self->{schema}->class($remote_moniker);
286 my $remote_obj = $self->{schema}->source($remote_moniker);
287 my $remote_cols = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
289 my $local_cols = $rel->{local_columns};
291 if($#$local_cols != $#$remote_cols) {
292 croak "Column count mismatch: $local_moniker (@$local_cols) "
293 . "$remote_moniker (@$remote_cols)";
297 foreach my $i (0 .. $#$local_cols) {
298 $cond{$remote_cols->[$i]} = $local_cols->[$i];
301 my ( $local_relname, $remote_relname, $remote_method ) =
302 $self->_relnames_and_method( $local_moniker, $rel, \%cond, $uniqs, \%counters );
304 push(@{$all_code->{$local_class}},
305 { method => 'belongs_to',
306 args => [ $remote_relname,
309 $self->_remote_attrs($local_moniker, $local_cols),
314 my %rev_cond = reverse %cond;
315 for (keys %rev_cond) {
316 $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
317 delete $rev_cond{$_};
320 push(@{$all_code->{$remote_class}},
321 { method => $remote_method,
322 args => [ $local_relname,
325 $self->_relationship_attrs($remote_method),
334 sub _relnames_and_method {
335 my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
337 my $remote_moniker = $rel->{remote_source};
338 my $remote_obj = $self->{schema}->source( $remote_moniker );
339 my $remote_class = $self->{schema}->class( $remote_moniker );
340 my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond);
342 my $local_cols = $rel->{local_columns};
343 my $local_table = $self->{schema}->source($local_moniker)->from;
345 # If more than one rel between this pair of tables, use the local
346 # col names to distinguish
347 my ($local_relname, $local_relname_uninflected);
348 if ( $counters->{$remote_moniker} > 1) {
349 my $colnames = q{_} . $self->_normalize_name(join '_', @$local_cols);
350 $remote_relname .= $colnames if keys %$cond > 1;
352 $local_relname = $self->_normalize_name($local_table . $colnames);
353 $local_relname = $self->_strip__id($local_relname);
355 $local_relname_uninflected = $local_relname;
356 $local_relname = $self->_inflect_plural($local_relname);
358 $local_relname_uninflected = $self->_normalize_name($local_table);
359 $local_relname = $self->_inflect_plural($self->_normalize_name($local_table));
362 my $remote_method = 'has_many';
364 # If the local columns have a UNIQUE constraint, this is a one-to-one rel
365 my $local_source = $self->{schema}->source($local_moniker);
366 if ($self->_array_eq([ $local_source->primary_columns ], $local_cols) ||
367 grep { $self->_array_eq($_->[1], $local_cols) } @$uniqs) {
368 $remote_method = 'might_have';
369 $local_relname = $self->_inflect_singular($local_relname_uninflected);
372 return ( $local_relname, $remote_relname, $remote_method );
377 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
381 This library is free software; you can redistribute it and/or modify it under
382 the same terms as Perl itself.
387 # vim:et sts=4 sw=4 tw=0: