1 package DBIx::Class::Schema::Loader::RelBuilder;
6 use Carp::Clan qw/^DBIx::Class/;
7 use Lingua::EN::Inflect::Phrase ();
9 our $VERSION = '0.07000';
13 DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader
17 See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
21 This class builds relationships for L<DBIx::Class::Schema::Loader>. This
22 is module is not (yet) for external use.
28 Arguments: schema_class (scalar), inflect_plural, inflect_singular
30 C<$schema_class> should be a schema class name, where the source
31 classes have already been set up and registered. Column info, primary
32 key, and unique constraints will be drawn from this schema for all
33 of the existing source monikers.
35 Options inflect_plural and inflect_singular are optional, and are better documented
36 in L<DBIx::Class::Schema::Loader::Base>.
40 Arguments: local_moniker (scalar), fk_info (arrayref)
42 This generates the code for the relationships of a given table.
44 C<local_moniker> is the moniker name of the table which had the REFERENCES
45 statements. The fk_info arrayref's contents should take the form:
49 local_columns => [ 'col2', 'col3' ],
50 remote_columns => [ 'col5', 'col7' ],
51 remote_moniker => 'AnotherTableMoniker',
54 local_columns => [ 'col1', 'col4' ],
55 remote_columns => [ 'col1', 'col2' ],
56 remote_moniker => 'YetAnotherTableMoniker',
61 This method will return the generated relationships as a hashref keyed on the
62 class names. The values are arrayrefs of hashes containing method name and
66 'Some::Source::Class' => [
67 { method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
68 { method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
70 'Another::Source::Class' => [
79 my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_;
83 inflect_plural => $inflect_pl,
84 inflect_singular => $inflect_singular,
85 relationship_attrs => $rel_attrs,
88 # validate the relationship_attrs arg
89 if( defined $self->{relationship_attrs} ) {
90 ref($self->{relationship_attrs}) eq 'HASH'
91 or croak "relationship_attrs must be a hashref";
94 return bless $self => $class;
98 # pluralize a relationship name
100 my ($self, $relname) = @_;
102 return '' if !defined $relname || $relname eq '';
104 if( ref $self->{inflect_plural} eq 'HASH' ) {
105 return $self->{inflect_plural}->{$relname}
106 if exists $self->{inflect_plural}->{$relname};
108 elsif( ref $self->{inflect_plural} eq 'CODE' ) {
109 my $inflected = $self->{inflect_plural}->($relname);
110 return $inflected if $inflected;
113 return $self->_to_PL($relname);
116 # Singularize a relationship name
117 sub _inflect_singular {
118 my ($self, $relname) = @_;
120 return '' if !defined $relname || $relname eq '';
122 if( ref $self->{inflect_singular} eq 'HASH' ) {
123 return $self->{inflect_singular}->{$relname}
124 if exists $self->{inflect_singular}->{$relname};
126 elsif( ref $self->{inflect_singular} eq 'CODE' ) {
127 my $inflected = $self->{inflect_singular}->($relname);
128 return $inflected if $inflected;
131 return $self->_to_S($relname);
135 my ($self, $name) = @_;
138 my $plural = Lingua::EN::Inflect::Phrase::to_PL($name);
145 my ($self, $name) = @_;
148 my $singular = Lingua::EN::Inflect::Phrase::to_S($name);
149 $singular =~ s/ /_/g;
154 sub _default_relationship_attrs { +{
164 on_delete => 'CASCADE',
165 on_update => 'CASCADE',
166 # is_deferrable => 1,
170 # accessor for options to be passed to each generated relationship
171 # type. take single argument, the relationship type name, and returns
172 # either a hashref (if some options are set), or nothing
173 sub _relationship_attrs {
174 my ( $self, $reltype ) = @_;
175 my $r = $self->{relationship_attrs};
178 %{ $self->_default_relationship_attrs->{$reltype} || {} },
182 if( my $specific = $r->{$reltype} ) {
183 while( my ($k,$v) = each %$specific ) {
191 my ($self, $a, $b) = @_;
193 return unless @$a == @$b;
195 for (my $i = 0; $i < @$a; $i++) {
196 return unless $a->[$i] eq $b->[$i];
202 my ($self, $local_moniker, $local_cols) = @_;
204 # get our base set of attrs from _relationship_attrs, if present
205 my $attrs = $self->_relationship_attrs('belongs_to') || {};
207 # If the referring column is nullable, make 'belongs_to' an
208 # outer join, unless explicitly set by relationship_attrs
209 my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} } @$local_cols;
210 $attrs->{join_type} = 'LEFT' if $nullable && !defined $attrs->{join_type};
215 sub _normalize_name {
216 my ($self, $name) = @_;
218 my @words = split /(?<=[[:lower:]])[\W_]*(?=[[:upper:]])|[\W_]+/, $name;
220 return join '_', map lc, @words;
223 sub _remote_relname {
224 my ($self, $remote_table, $cond) = @_;
227 # for single-column case, set the remote relname to the column
228 # name, to make filter accessors work, but strip trailing _id
229 if(scalar keys %{$cond} == 1) {
230 my ($col) = values %{$cond};
231 $col = $self->_normalize_name($col);
233 $remote_relname = $self->_inflect_singular($col);
236 $remote_relname = $self->_inflect_singular($self->_normalize_name($remote_table));
239 return $remote_relname;
243 my ($self, $local_moniker, $rels, $uniqs) = @_;
247 my $local_class = $self->{schema}->class($local_moniker);
250 foreach my $rel (@$rels) {
251 next if !$rel->{remote_source};
252 $counters{$rel->{remote_source}}++;
255 foreach my $rel (@$rels) {
256 my $remote_moniker = $rel->{remote_source}
259 my $remote_class = $self->{schema}->class($remote_moniker);
260 my $remote_obj = $self->{schema}->source($remote_moniker);
261 my $remote_cols = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
263 my $local_cols = $rel->{local_columns};
265 if($#$local_cols != $#$remote_cols) {
266 croak "Column count mismatch: $local_moniker (@$local_cols) "
267 . "$remote_moniker (@$remote_cols)";
271 foreach my $i (0 .. $#$local_cols) {
272 $cond{$remote_cols->[$i]} = $local_cols->[$i];
275 my ( $local_relname, $remote_relname, $remote_method ) =
276 $self->_relnames_and_method( $local_moniker, $rel, \%cond, $uniqs, \%counters );
278 push(@{$all_code->{$local_class}},
279 { method => 'belongs_to',
280 args => [ $remote_relname,
283 $self->_remote_attrs($local_moniker, $local_cols),
288 my %rev_cond = reverse %cond;
289 for (keys %rev_cond) {
290 $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
291 delete $rev_cond{$_};
294 push(@{$all_code->{$remote_class}},
295 { method => $remote_method,
296 args => [ $local_relname,
299 $self->_relationship_attrs($remote_method),
308 sub _relnames_and_method {
309 my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
311 my $remote_moniker = $rel->{remote_source};
312 my $remote_obj = $self->{schema}->source( $remote_moniker );
313 my $remote_class = $self->{schema}->class( $remote_moniker );
314 my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond);
316 my $local_cols = $rel->{local_columns};
317 my $local_table = $self->{schema}->source($local_moniker)->from;
319 # If more than one rel between this pair of tables, use the local
320 # col names to distinguish
321 my ($local_relname, $local_relname_uninflected);
322 if ( $counters->{$remote_moniker} > 1) {
323 my $colnames = q{_} . $self->_normalize_name(join '_', @$local_cols);
324 $remote_relname .= $colnames if keys %$cond > 1;
326 $local_relname = $self->_normalize_name($local_table . $colnames);
327 $local_relname =~ s/_id$//;
329 $local_relname_uninflected = $local_relname;
330 $local_relname = $self->_inflect_plural($local_relname);
332 $local_relname_uninflected = $self->_normalize_name($local_table);
333 $local_relname = $self->_inflect_plural($self->_normalize_name($local_table));
336 my $remote_method = 'has_many';
338 # If the local columns have a UNIQUE constraint, this is a one-to-one rel
339 my $local_source = $self->{schema}->source($local_moniker);
340 if ($self->_array_eq([ $local_source->primary_columns ], $local_cols) ||
341 grep { $self->_array_eq($_->[1], $local_cols) } @$uniqs) {
342 $remote_method = 'might_have';
343 $local_relname = $self->_inflect_singular($local_relname_uninflected);
346 return ( $local_relname, $remote_relname, $remote_method );
351 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
355 This library is free software; you can redistribute it and/or modify it under
356 the same terms as Perl itself.
361 # vim:et sts=4 sw=4 tw=0: