lib/DBIx/Class/Schema/Loader/RelBuilder.pm

   1 package DBIx::Class::Schema::Loader::RelBuilder;
   2
   3 use strict;
   4 use warnings;
   5 use Class::C3;
   6 use Carp::Clan qw/^DBIx::Class/;
   7 use Lingua::EN::Inflect::Number ();
   8
   9 our $VERSION = '0.05002';
  10
  11 =head1 NAME
  12
  13 DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader
  14
  15 =head1 SYNOPSIS
  16
  17 See L<DBIx::Class::Schema::Loader>
  18
  19 =head1 DESCRIPTION
  20
  21 This class builds relationships for L<DBIx::Class::Schema::Loader>.  This
  22 is module is not (yet) for external use.
  23
  24 =head1 METHODS
  25
  26 =head2 new
  27
  28 Arguments: schema_class (scalar), inflect_plural, inflect_singular
  29
  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.
  34
  35 Options inflect_plural and inflect_singular are optional, and are better documented
  36 in L<DBIx::Class::Schema::Loader::Base>.
  37
  38 =head2 generate_code
  39
  40 Arguments: local_moniker (scalar), fk_info (arrayref)
  41
  42 This generates the code for the relationships of a given table.
  43
  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:
  46
  47     [
  48         {
  49             local_columns => [ 'col2', 'col3' ],
  50             remote_columns => [ 'col5', 'col7' ],
  51             remote_moniker => 'AnotherTableMoniker',
  52         },
  53         {
  54             local_columns => [ 'col1', 'col4' ],
  55             remote_columns => [ 'col1', 'col2' ],
  56             remote_moniker => 'YetAnotherTableMoniker',
  57         },
  58         # ...
  59     ],
  60
  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
  63 arguments, like so:
  64
  65   {
  66       'Some::Source::Class' => [
  67           { method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
  68           { method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
  69       ],
  70       'Another::Source::Class' => [
  71           # ...
  72       ],
  73       # ...
  74   }
  75
  76 =cut
  77
  78 sub new {
  79
  80     my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_;
  81
  82     my $self = {
  83         schema => $schema,
  84         inflect_plural => $inflect_pl,
  85         inflect_singular => $inflect_singular,
  86         relationship_attrs => $rel_attrs,
  87     };
  88
  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";
  93     }
  94
  95     return bless $self => $class;
  96 }
  97
  98
  99 # pluralize a relationship name
 100 sub _inflect_plural {
 101     my ($self, $relname) = @_;
 102
 103     if( ref $self->{inflect_plural} eq 'HASH' ) {
 104         return $self->{inflect_plural}->{$relname}
 105             if exists $self->{inflect_plural}->{$relname};
 106     }
 107     elsif( ref $self->{inflect_plural} eq 'CODE' ) {
 108         my $inflected = $self->{inflect_plural}->($relname);
 109         return $inflected if $inflected;
 110     }
 111
 112     return Lingua::EN::Inflect::Number::to_PL($relname);
 113 }
 114
 115 # Singularize a relationship name
 116 sub _inflect_singular {
 117     my ($self, $relname) = @_;
 118
 119     if( ref $self->{inflect_singular} eq 'HASH' ) {
 120         return $self->{inflect_singular}->{$relname}
 121             if exists $self->{inflect_singular}->{$relname};
 122     }
 123     elsif( ref $self->{inflect_singular} eq 'CODE' ) {
 124         my $inflected = $self->{inflect_singular}->($relname);
 125         return $inflected if $inflected;
 126     }
 127
 128     return Lingua::EN::Inflect::Number::to_S($relname);
 129 }
 130
 131 # accessor for options to be passed to each generated relationship
 132 # type.  take single argument, the relationship type name, and returns
 133 # either a hashref (if some options are set), or nothing
 134 sub _relationship_attrs {
 135     my ( $self, $reltype ) = @_;
 136     my $r = $self->{relationship_attrs};
 137     return unless $r && ( $r->{all} || $r->{$reltype} );
 138
 139     my %composite = %{ $r->{all} || {} };
 140     if( my $specific = $r->{$reltype} ) {
 141         while( my ($k,$v) = each %$specific ) {
 142             $composite{$k} = $v;
 143         }
 144     }
 145     return \%composite;
 146 }
 147
 148 sub _array_eq {
 149     my ($a, $b) = @_;
 150
 151     return unless @$a == @$b;
 152
 153     for (my $i = 0; $i < @$a; $i++) {
 154         return unless $a->[$i] eq $b->[$i];
 155     }
 156     return 1;
 157 }
 158
 159 sub _remote_attrs {
 160         my ($self, $local_moniker, $local_cols) = @_;
 161
 162         # get our base set of attrs from _relationship_attrs, if present
 163         my $attrs = $self->_relationship_attrs('belongs_to') || {};
 164
 165         # If the referring column is nullable, make 'belongs_to' an
 166         # outer join, unless explicitly set by relationship_attrs
 167         my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} }
 168                 @$local_cols;
 169         $attrs->{join_type} = 'LEFT'
 170             if $nullable && !defined $attrs->{join_type};
 171
 172         return $attrs;
 173 }
 174
 175 sub _remote_relname {
 176     my ($self, $remote_table, $cond) = @_;
 177
 178     my $remote_relname;
 179     # for single-column case, set the remote relname to the column
 180     # name, to make filter accessors work, but strip trailing _id
 181     if(scalar keys %{$cond} == 1) {
 182         my ($col) = values %{$cond};
 183         $col =~ s/_id$//;
 184         $remote_relname = $self->_inflect_singular($col);
 185     }
 186     else {
 187         $remote_relname = $self->_inflect_singular(lc $remote_table);
 188     }
 189
 190     return $remote_relname;
 191 }
 192
 193 sub generate_code {
 194     my ($self, $local_moniker, $rels, $uniqs) = @_;
 195
 196     my $all_code = {};
 197
 198     my $local_class = $self->{schema}->class($local_moniker);
 199
 200     my %counters;
 201     foreach my $rel (@$rels) {
 202         next if !$rel->{remote_source};
 203         $counters{$rel->{remote_source}}++;
 204     }
 205
 206     foreach my $rel (@$rels) {
 207         my $remote_moniker = $rel->{remote_source}
 208             or next;
 209
 210         my $remote_class   = $self->{schema}->class($remote_moniker);
 211         my $remote_obj     = $self->{schema}->source($remote_moniker);
 212         my $remote_cols    = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
 213
 214         my $local_cols     = $rel->{local_columns};
 215
 216         if($#$local_cols != $#$remote_cols) {
 217             croak "Column count mismatch: $local_moniker (@$local_cols) "
 218                 . "$remote_moniker (@$remote_cols)";
 219         }
 220
 221         my %cond;
 222         foreach my $i (0 .. $#$local_cols) {
 223             $cond{$remote_cols->[$i]} = $local_cols->[$i];
 224         }
 225
 226         my ( $local_relname, $remote_relname, $remote_method ) =
 227             $self->_relnames_and_methods( $local_moniker, $rel, \%cond,  $uniqs, \%counters );
 228
 229         push(@{$all_code->{$local_class}},
 230             { method => 'belongs_to',
 231               args => [ $remote_relname,
 232                         $remote_class,
 233                         \%cond,
 234                         $self->_remote_attrs($local_moniker, $local_cols),
 235               ],
 236             }
 237         );
 238
 239         my %rev_cond = reverse %cond;
 240         for (keys %rev_cond) {
 241             $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 242             delete $rev_cond{$_};
 243         }
 244
 245         push(@{$all_code->{$remote_class}},
 246             { method => $remote_method,
 247               args => [ $local_relname,
 248                         $local_class,
 249                         \%rev_cond,
 250                         $self->_relationship_attrs($remote_method),
 251               ],
 252             }
 253         );
 254     }
 255
 256     return $all_code;
 257 }
 258
 259 sub _relnames_and_methods {
 260     my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
 261
 262     my $remote_moniker = $rel->{remote_source};
 263     my $remote_obj     = $self->{schema}->source( $remote_moniker );
 264     my $remote_class   = $self->{schema}->class(  $remote_moniker );
 265     my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond);
 266
 267     my $local_cols  = $rel->{local_columns};
 268     my $local_table = $self->{schema}->source($local_moniker)->from;
 269
 270     # If more than one rel between this pair of tables, use the local
 271     # col names to distinguish
 272     my $local_relname;
 273     if ( $counters->{$remote_moniker} > 1) {
 274         my $colnames = q{_} . join(q{_}, @$local_cols);
 275         $remote_relname .= $colnames if keys %$cond > 1;
 276
 277         my $old_relname =       #< TODO: remove me after 0.05003 release
 278         $local_relname = lc($local_table) . $colnames;
 279         my $stripped_id = $local_relname =~ s/_id$//; #< strip off any trailing _id
 280         $local_relname = $self->_inflect_plural( $local_relname );
 281
 282         # TODO: remove me after 0.05003 release
 283         $old_relname = $self->_inflect_plural( $old_relname );
 284         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"
 285             if $stripped_id;
 286
 287     } else {
 288         $local_relname = $self->_inflect_plural(lc $local_table);
 289     }
 290
 291     my $remote_method = 'has_many';
 292
 293     # If the local columns have a UNIQUE constraint, this is a one-to-one rel
 294     my $local_source = $self->{schema}->source($local_moniker);
 295     if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
 296             grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
 297         $remote_method = 'might_have';
 298         $local_relname = $self->_inflect_singular($local_relname);
 299     }
 300
 301     return ( $local_relname, $remote_relname, $remote_method );
 302 }
 303
 304 =head1 AUTHOR
 305
 306 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 307
 308 =head1 LICENSE
 309
 310 This library is free software; you can redistribute it and/or modify it under
 311 the same terms as Perl itself.
 312
 313 =cut
 314
 315 1;