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.05003';
  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, $method) = @_;
 102
 103     return '' if !defined $relname || $relname eq '';
 104
 105     if( ref $self->{inflect_plural} eq 'HASH' ) {
 106         return $self->{inflect_plural}->{$relname}
 107             if exists $self->{inflect_plural}->{$relname};
 108     }
 109     elsif( ref $self->{inflect_plural} eq 'CODE' ) {
 110         my $inflected = $self->{inflect_plural}->($relname);
 111         return $inflected if $inflected;
 112     }
 113
 114     $method ||= '_to_PL';
 115
 116     return $self->$method($relname);
 117 }
 118
 119 # Singularize a relationship name
 120 sub _inflect_singular {
 121     my ($self, $relname) = @_;
 122
 123     return '' if !defined $relname || $relname eq '';
 124
 125     if( ref $self->{inflect_singular} eq 'HASH' ) {
 126         return $self->{inflect_singular}->{$relname}
 127             if exists $self->{inflect_singular}->{$relname};
 128     }
 129     elsif( ref $self->{inflect_singular} eq 'CODE' ) {
 130         my $inflected = $self->{inflect_singular}->($relname);
 131         return $inflected if $inflected;
 132     }
 133
 134     return $self->_to_S($relname);
 135 }
 136
 137 sub _to_PL {
 138     my ($self, $name) = @_;
 139
 140     $name =~ s/_/ /g;
 141     my $plural = Lingua::EN::Inflect::Number::to_PL($name);
 142     $plural =~ s/ /_/g;
 143
 144     return $plural;
 145 }
 146
 147 sub _old_to_PL {
 148     my ($self, $name) = @_;
 149
 150     return Lingua::EN::Inflect::Number::to_PL($name);
 151 }
 152
 153 sub _to_S {
 154     my ($self, $name) = @_;
 155
 156     return Lingua::EN::Inflect::Number::to_S($name);
 157 }
 158
 159 # accessor for options to be passed to each generated relationship
 160 # type.  take single argument, the relationship type name, and returns
 161 # either a hashref (if some options are set), or nothing
 162 sub _relationship_attrs {
 163     my ( $self, $reltype ) = @_;
 164     my $r = $self->{relationship_attrs};
 165     return unless $r && ( $r->{all} || $r->{$reltype} );
 166
 167     my %composite = %{ $r->{all} || {} };
 168     if( my $specific = $r->{$reltype} ) {
 169         while( my ($k,$v) = each %$specific ) {
 170             $composite{$k} = $v;
 171         }
 172     }
 173     return \%composite;
 174 }
 175
 176 sub _array_eq {
 177     my ($a, $b) = @_;
 178
 179     return unless @$a == @$b;
 180
 181     for (my $i = 0; $i < @$a; $i++) {
 182         return unless $a->[$i] eq $b->[$i];
 183     }
 184     return 1;
 185 }
 186
 187 sub _remote_attrs {
 188     my ($self, $local_moniker, $local_cols) = @_;
 189
 190     # get our base set of attrs from _relationship_attrs, if present
 191     my $attrs = $self->_relationship_attrs('belongs_to') || {};
 192
 193     # If the referring column is nullable, make 'belongs_to' an
 194     # outer join, unless explicitly set by relationship_attrs
 195     my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} } @$local_cols;
 196     $attrs->{join_type} = 'LEFT' if $nullable && !defined $attrs->{join_type};
 197
 198     return $attrs;
 199 }
 200
 201 sub _remote_relname {
 202     my ($self, $remote_table, $cond) = @_;
 203
 204     my $remote_relname;
 205     # for single-column case, set the remote relname to the column
 206     # name, to make filter accessors work, but strip trailing _id
 207     if(scalar keys %{$cond} == 1) {
 208         my ($col) = values %{$cond};
 209         $col = lc $col;
 210         $col =~ s/_id$//;
 211         $remote_relname = $self->_inflect_singular($col);
 212     }
 213     else {
 214         $remote_relname = $self->_inflect_singular(lc $remote_table);
 215     }
 216
 217     return $remote_relname;
 218 }
 219
 220 sub generate_code {
 221     my ($self, $local_moniker, $rels, $uniqs) = @_;
 222
 223     my $all_code = {};
 224
 225     my $local_class = $self->{schema}->class($local_moniker);
 226
 227     my %counters;
 228     foreach my $rel (@$rels) {
 229         next if !$rel->{remote_source};
 230         $counters{$rel->{remote_source}}++;
 231     }
 232
 233     foreach my $rel (@$rels) {
 234         my $remote_moniker = $rel->{remote_source}
 235             or next;
 236
 237         my $remote_class   = $self->{schema}->class($remote_moniker);
 238         my $remote_obj     = $self->{schema}->source($remote_moniker);
 239         my $remote_cols    = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
 240
 241         my $local_cols     = $rel->{local_columns};
 242
 243         if($#$local_cols != $#$remote_cols) {
 244             croak "Column count mismatch: $local_moniker (@$local_cols) "
 245                 . "$remote_moniker (@$remote_cols)";
 246         }
 247
 248         my %cond;
 249         foreach my $i (0 .. $#$local_cols) {
 250             $cond{$remote_cols->[$i]} = $local_cols->[$i];
 251         }
 252
 253         my ( $local_relname, $remote_relname, $remote_method ) =
 254             $self->_relnames_and_method( $local_moniker, $rel, \%cond,  $uniqs, \%counters );
 255
 256         push(@{$all_code->{$local_class}},
 257             { method => 'belongs_to',
 258               args => [ $remote_relname,
 259                         $remote_class,
 260                         \%cond,
 261                         $self->_remote_attrs($local_moniker, $local_cols),
 262               ],
 263             }
 264         );
 265
 266         my %rev_cond = reverse %cond;
 267         for (keys %rev_cond) {
 268             $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 269             delete $rev_cond{$_};
 270         }
 271
 272         push(@{$all_code->{$remote_class}},
 273             { method => $remote_method,
 274               args => [ $local_relname,
 275                         $local_class,
 276                         \%rev_cond,
 277                         $self->_relationship_attrs($remote_method),
 278               ],
 279             }
 280         );
 281     }
 282
 283     return $all_code;
 284 }
 285
 286 sub _relnames_and_method {
 287     my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
 288
 289     my $remote_moniker = $rel->{remote_source};
 290     my $remote_obj     = $self->{schema}->source( $remote_moniker );
 291     my $remote_class   = $self->{schema}->class(  $remote_moniker );
 292     my $remote_relname = lc $self->_remote_relname( $remote_obj->from, $cond);
 293
 294     my $local_cols  = $rel->{local_columns};
 295     my $local_table = $self->{schema}->source($local_moniker)->from;
 296
 297     # If more than one rel between this pair of tables, use the local
 298     # col names to distinguish
 299     my ($local_relname, $old_local_relname, $local_relname_uninflected, $old_local_relname_uninflected);
 300     if ( $counters->{$remote_moniker} > 1) {
 301         my $colnames = lc(q{_} . join(q{_}, @$local_cols));
 302         $remote_relname .= $colnames if keys %$cond > 1;
 303
 304         $local_relname = lc($local_table) . $colnames;
 305         $local_relname =~ s/_id$//;
 306
 307         $local_relname_uninflected = $local_relname;
 308         $local_relname = $self->_inflect_plural( $local_relname );
 309
 310         $old_local_relname_uninflected = lc($local_table) . $colnames;
 311         $old_local_relname = $self->_inflect_plural( lc($local_table) . $colnames, '_old_to_PL' );
 312
 313     } else {
 314         $local_relname_uninflected = lc $local_table;
 315         $local_relname = $self->_inflect_plural(lc $local_table);
 316
 317         $old_local_relname_uninflected = lc $local_table;
 318         $old_local_relname = $self->_inflect_plural(lc $local_table, '_old_to_PL');
 319     }
 320
 321     my $remote_method = 'has_many';
 322
 323     # If the local columns have a UNIQUE constraint, this is a one-to-one rel
 324     my $local_source = $self->{schema}->source($local_moniker);
 325     if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
 326             grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
 327         $remote_method = 'might_have';
 328         $local_relname = $self->_inflect_singular($local_relname_uninflected);
 329         $old_local_relname = $self->_inflect_singular($old_local_relname_uninflected);
 330     }
 331
 332     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;
 333
 334     return ( $local_relname, $remote_relname, $remote_method );
 335 }
 336
 337 =head1 AUTHOR
 338
 339 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 340
 341 =head1 LICENSE
 342
 343 This library is free software; you can redistribute it and/or modify it under
 344 the same terms as Perl itself.
 345
 346 =cut
 347
 348 1;