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 sub _default_relationship_attrs { +{
 160     has_many => {
 161         cascade_delete => 0,
 162         cascade_copy   => 0,
 163     },
 164     might_have => {
 165         cascade_delete => 0,
 166         cascade_copy   => 0,
 167     },
 168     belongs_to => {
 169         on_delete => 'CASCADE',
 170         on_update => 'CASCADE',
 171     },
 172 } }
 173
 174 # accessor for options to be passed to each generated relationship
 175 # type.  take single argument, the relationship type name, and returns
 176 # either a hashref (if some options are set), or nothing
 177 sub _relationship_attrs {
 178     my ( $self, $reltype ) = @_;
 179     my $r = $self->{relationship_attrs};
 180
 181     my %composite = (
 182         %{ $self->_default_relationship_attrs->{$reltype} || {} },
 183         %{ $r->{all} || {} }
 184     );
 185
 186     if( my $specific = $r->{$reltype} ) {
 187         while( my ($k,$v) = each %$specific ) {
 188             $composite{$k} = $v;
 189         }
 190     }
 191     return \%composite;
 192 }
 193
 194 sub _array_eq {
 195     my ($a, $b) = @_;
 196
 197     return unless @$a == @$b;
 198
 199     for (my $i = 0; $i < @$a; $i++) {
 200         return unless $a->[$i] eq $b->[$i];
 201     }
 202     return 1;
 203 }
 204
 205 sub _remote_attrs {
 206     my ($self, $local_moniker, $local_cols) = @_;
 207
 208     # get our base set of attrs from _relationship_attrs, if present
 209     my $attrs = $self->_relationship_attrs('belongs_to') || {};
 210
 211     # If the referring column is nullable, make 'belongs_to' an
 212     # outer join, unless explicitly set by relationship_attrs
 213     my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} } @$local_cols;
 214     $attrs->{join_type} = 'LEFT' if $nullable && !defined $attrs->{join_type};
 215
 216     return $attrs;
 217 }
 218
 219 sub _remote_relname {
 220     my ($self, $remote_table, $cond) = @_;
 221
 222     my $remote_relname;
 223     # for single-column case, set the remote relname to the column
 224     # name, to make filter accessors work, but strip trailing _id
 225     if(scalar keys %{$cond} == 1) {
 226         my ($col) = values %{$cond};
 227         $col = lc $col;
 228         $col =~ s/_id$//;
 229         $remote_relname = $self->_inflect_singular($col);
 230     }
 231     else {
 232         $remote_relname = $self->_inflect_singular(lc $remote_table);
 233     }
 234
 235     return $remote_relname;
 236 }
 237
 238 sub generate_code {
 239     my ($self, $local_moniker, $rels, $uniqs) = @_;
 240
 241     my $all_code = {};
 242
 243     my $local_class = $self->{schema}->class($local_moniker);
 244
 245     my %counters;
 246     foreach my $rel (@$rels) {
 247         next if !$rel->{remote_source};
 248         $counters{$rel->{remote_source}}++;
 249     }
 250
 251     foreach my $rel (@$rels) {
 252         my $remote_moniker = $rel->{remote_source}
 253             or next;
 254
 255         my $remote_class   = $self->{schema}->class($remote_moniker);
 256         my $remote_obj     = $self->{schema}->source($remote_moniker);
 257         my $remote_cols    = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
 258
 259         my $local_cols     = $rel->{local_columns};
 260
 261         if($#$local_cols != $#$remote_cols) {
 262             croak "Column count mismatch: $local_moniker (@$local_cols) "
 263                 . "$remote_moniker (@$remote_cols)";
 264         }
 265
 266         my %cond;
 267         foreach my $i (0 .. $#$local_cols) {
 268             $cond{$remote_cols->[$i]} = $local_cols->[$i];
 269         }
 270
 271         my ( $local_relname, $remote_relname, $remote_method ) =
 272             $self->_relnames_and_method( $local_moniker, $rel, \%cond,  $uniqs, \%counters );
 273
 274         push(@{$all_code->{$local_class}},
 275             { method => 'belongs_to',
 276               args => [ $remote_relname,
 277                         $remote_class,
 278                         \%cond,
 279                         $self->_remote_attrs($local_moniker, $local_cols),
 280               ],
 281             }
 282         );
 283
 284         my %rev_cond = reverse %cond;
 285         for (keys %rev_cond) {
 286             $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 287             delete $rev_cond{$_};
 288         }
 289
 290         push(@{$all_code->{$remote_class}},
 291             { method => $remote_method,
 292               args => [ $local_relname,
 293                         $local_class,
 294                         \%rev_cond,
 295                         $self->_relationship_attrs($remote_method),
 296               ],
 297             }
 298         );
 299     }
 300
 301     return $all_code;
 302 }
 303
 304 sub _relnames_and_method {
 305     my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
 306
 307     my $remote_moniker = $rel->{remote_source};
 308     my $remote_obj     = $self->{schema}->source( $remote_moniker );
 309     my $remote_class   = $self->{schema}->class(  $remote_moniker );
 310     my $remote_relname = lc $self->_remote_relname( $remote_obj->from, $cond);
 311
 312     my $local_cols  = $rel->{local_columns};
 313     my $local_table = $self->{schema}->source($local_moniker)->from;
 314
 315     # If more than one rel between this pair of tables, use the local
 316     # col names to distinguish
 317     my ($local_relname, $old_local_relname, $local_relname_uninflected, $old_local_relname_uninflected);
 318     if ( $counters->{$remote_moniker} > 1) {
 319         my $colnames = lc(q{_} . join(q{_}, @$local_cols));
 320         $remote_relname .= $colnames if keys %$cond > 1;
 321
 322         $local_relname = lc($local_table) . $colnames;
 323         $local_relname =~ s/_id$//;
 324
 325         $local_relname_uninflected = $local_relname;
 326         $local_relname = $self->_inflect_plural( $local_relname );
 327
 328         $old_local_relname_uninflected = lc($local_table) . $colnames;
 329         $old_local_relname = $self->_inflect_plural( lc($local_table) . $colnames, '_old_to_PL' );
 330
 331     } else {
 332         $local_relname_uninflected = lc $local_table;
 333         $local_relname = $self->_inflect_plural(lc $local_table);
 334
 335         $old_local_relname_uninflected = lc $local_table;
 336         $old_local_relname = $self->_inflect_plural(lc $local_table, '_old_to_PL');
 337     }
 338
 339     my $remote_method = 'has_many';
 340
 341     # If the local columns have a UNIQUE constraint, this is a one-to-one rel
 342     my $local_source = $self->{schema}->source($local_moniker);
 343     if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
 344             grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
 345         $remote_method = 'might_have';
 346         $local_relname = $self->_inflect_singular($local_relname_uninflected);
 347         $old_local_relname = $self->_inflect_singular($old_local_relname_uninflected);
 348     }
 349
 350     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;
 351
 352     return ( $local_relname, $remote_relname, $remote_method );
 353 }
 354
 355 =head1 AUTHOR
 356
 357 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 358
 359 =head1 LICENSE
 360
 361 This library is free software; you can redistribute it and/or modify it under
 362 the same terms as Perl itself.
 363
 364 =cut
 365
 366 1;