X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FRelBuilder.pm;h=b802c8cf0d0cec707bb0d7f38d9dd40e14e2943b;hb=e42ec4ef998118c71f8bd66e765f597a6f74dd39;hp=35a50a837438f8c36e255ba50e5c2379975245bd;hpb=b97c2c1e790cc4c18370238fd98eddac4e7de2d8;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm index 35a50a8..b802c8c 100644 --- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm @@ -2,10 +2,11 @@ package DBIx::Class::Schema::Loader::RelBuilder; use strict; use warnings; +use Class::C3; use Carp::Clan qw/^DBIx::Class/; use Lingua::EN::Inflect::Number (); -our $VERSION = '0.03999_01'; +our $VERSION = '0.05003'; =head1 NAME @@ -75,17 +76,23 @@ arguments, like so: =cut sub new { - my ( $class, $schema, $inflect_pl, $inflect_singular ) = @_; + + my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_; my $self = { schema => $schema, inflect_plural => $inflect_pl, inflect_singular => $inflect_singular, + relationship_attrs => $rel_attrs, }; - bless $self => $class; + # validate the relationship_attrs arg + if( defined $self->{relationship_attrs} ) { + ref($self->{relationship_attrs}) eq 'HASH' + or croak "relationship_attrs must be a hashref"; + } - $self; + return bless $self => $class; } @@ -121,8 +128,86 @@ sub _inflect_singular { return Lingua::EN::Inflect::Number::to_S($relname); } +# accessor for options to be passed to each generated relationship +# type. take single argument, the relationship type name, and returns +# either a hashref (if some options are set), or nothing +sub _relationship_attrs { + my ( $self, $reltype ) = @_; + my $r = $self->{relationship_attrs}; + return unless $r && ( $r->{all} || $r->{$reltype} ); + + my %composite = %{ $r->{all} || {} }; + if( my $specific = $r->{$reltype} ) { + while( my ($k,$v) = each %$specific ) { + $composite{$k} = $v; + } + } + return \%composite; +} + +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 _uniq_fk_rel { + my ($self, $local_moniker, $local_relname, $local_cols, $uniqs) = @_; + + my $remote_method = 'has_many'; + + # If the local columns have a UNIQUE constraint, this is a one-to-one rel + my $local_source = $self->{schema}->source($local_moniker); + if (_array_eq([ $local_source->primary_columns ], $local_cols) || + grep { _array_eq($_->[1], $local_cols) } @$uniqs) { + $remote_method = 'might_have'; + $local_relname = $self->_inflect_singular($local_relname); + } + + return ($remote_method, $local_relname); +} + +sub _remote_attrs { + my ($self, $local_moniker, $local_cols) = @_; + + # get our base set of attrs from _relationship_attrs, if present + my $attrs = $self->_relationship_attrs('belongs_to') || {}; + + # If the referring column is nullable, make 'belongs_to' an + # outer join, unless explicitly set by relationship_attrs + my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} } + @$local_cols; + $attrs->{join_type} = 'LEFT' + if $nullable && !defined $attrs->{join_type}; + + return $attrs; +} + +sub _remote_relname { + my ($self, $remote_table, $cond) = @_; + + my $remote_relname; + # for single-column case, set the remote relname to the column + # name, to make filter accessors work, but strip trailing _id + if(scalar keys %{$cond} == 1) { + my ($col) = values %{$cond}; + $col =~ s/_id$//; + $remote_relname = $self->_inflect_singular($col); + } + else { + $remote_relname = $self->_inflect_singular(lc $remote_table); + } + + return $remote_relname; +} + sub generate_code { - my ($self, $local_moniker, $rels) = @_; + my ($self, $local_moniker, $rels, $uniqs) = @_; my $all_code = {}; @@ -155,29 +240,25 @@ sub generate_code { $cond{$remote_cols->[$i]} = $local_cols->[$i]; } - # If more than one rel between this pair of tables, use the - # local col name(s) as the relname in the foreign source, instead - # of the local table name. my $local_relname; + my $remote_relname = $self->_remote_relname($remote_table, \%cond); + + # If more than one rel between this pair of tables, use the local + # col names to distinguish if($counters{$remote_moniker} > 1) { - $local_relname = $self->_inflect_plural( - lc($local_table) . q{_} . join(q{_}, @$local_cols) + my $colnames = q{_} . join(q{_}, @$local_cols); + $remote_relname .= $colnames if keys %cond > 1; + + my $is_singular = + ($self->_uniq_fk_rel($local_moniker, 'dummy', $local_cols, $uniqs))[0] ne 'has_many'; + + $local_relname = $self->_multi_rel_local_relname( + $remote_class, $local_table, $local_cols, $is_singular ); } else { $local_relname = $self->_inflect_plural(lc $local_table); } - # for single-column case, set the relname to the column name, - # to make filter accessors work - my $remote_relname; - if(scalar keys %cond == 1) { - my ($col) = keys %cond; - $remote_relname = $self->_inflect_singular($cond{$col}); - } - else { - $remote_relname = $self->_inflect_singular(lc $remote_table); - } - my %rev_cond = reverse %cond; for (keys %rev_cond) { @@ -185,20 +266,26 @@ sub generate_code { delete $rev_cond{$_}; } + my ($remote_method); + + ($remote_method, $local_relname) = $self->_uniq_fk_rel($local_moniker, $local_relname, $local_cols, $uniqs); + push(@{$all_code->{$local_class}}, { method => 'belongs_to', args => [ $remote_relname, $remote_class, \%cond, + $self->_remote_attrs($local_moniker, $local_cols), ], } ); push(@{$all_code->{$remote_class}}, - { method => 'has_many', + { method => $remote_method, args => [ $local_relname, $local_class, \%rev_cond, + $self->_relationship_attrs($remote_method), ], } ); @@ -207,4 +294,35 @@ sub generate_code { return $all_code; } +sub _multi_rel_local_relname { + my ($self, $remote_class, $local_table, $local_cols, $is_singular) = @_; + + my $inflect = $is_singular ? '_inflect_singular' : '_inflect_plural'; + $inflect = $self->can($inflect); + + my $colnames = q{_} . join(q{_}, @$local_cols); + my $old_relname = #< TODO: remove me after 0.05003 release + my $local_relname = lc($local_table) . $colnames; + my $stripped_id = $local_relname =~ s/_id$//; #< strip off any trailing _id + $local_relname = $self->$inflect( $local_relname ); + + # TODO: remove me after 0.05003 release + $old_relname = $self->$inflect( $old_relname ); + warn __PACKAGE__." $VERSION: warning, stripping trailing _id from ${remote_class} relation '$old_relname', renaming to '$local_relname'. This behavior is new as of 0.05003.\n" + if $stripped_id; + + return $local_relname; +} + +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + 1;