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 use Lingua::EN::Inflect::Phrase ();
   9
  10 our $VERSION = '0.05003';
  11
  12 =head1 NAME
  13
  14 DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader
  15
  16 =head1 SYNOPSIS
  17
  18 See L<DBIx::Class::Schema::Loader>
  19
  20 =head1 DESCRIPTION
  21
  22 This class builds relationships for L<DBIx::Class::Schema::Loader>.  This
  23 is module is not (yet) for external use.
  24
  25 =head1 METHODS
  26
  27 =head2 new
  28
  29 Arguments: schema_class (scalar), inflect_plural, inflect_singular
  30
  31 C<$schema_class> should be a schema class name, where the source
  32 classes have already been set up and registered.  Column info, primary
  33 key, and unique constraints will be drawn from this schema for all
  34 of the existing source monikers.
  35
  36 Options inflect_plural and inflect_singular are optional, and are better documented
  37 in L<DBIx::Class::Schema::Loader::Base>.
  38
  39 =head2 generate_code
  40
  41 Arguments: local_moniker (scalar), fk_info (arrayref)
  42
  43 This generates the code for the relationships of a given table.
  44
  45 C<local_moniker> is the moniker name of the table which had the REFERENCES
  46 statements.  The fk_info arrayref's contents should take the form:
  47
  48     [
  49         {
  50             local_columns => [ 'col2', 'col3' ],
  51             remote_columns => [ 'col5', 'col7' ],
  52             remote_moniker => 'AnotherTableMoniker',
  53         },
  54         {
  55             local_columns => [ 'col1', 'col4' ],
  56             remote_columns => [ 'col1', 'col2' ],
  57             remote_moniker => 'YetAnotherTableMoniker',
  58         },
  59         # ...
  60     ],
  61
  62 This method will return the generated relationships as a hashref keyed on the
  63 class names.  The values are arrayrefs of hashes containing method name and
  64 arguments, like so:
  65
  66   {
  67       'Some::Source::Class' => [
  68           { method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
  69           { method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
  70       ],
  71       'Another::Source::Class' => [
  72           # ...
  73       ],
  74       # ...
  75   }
  76
  77 =cut
  78
  79 sub new {
  80
  81     my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_;
  82
  83     my $self = {
  84         schema => $schema,
  85         inflect_plural => $inflect_pl,
  86         inflect_singular => $inflect_singular,
  87         relationship_attrs => $rel_attrs,
  88     };
  89
  90     # validate the relationship_attrs arg
  91     if( defined $self->{relationship_attrs} ) {
  92         ref($self->{relationship_attrs}) eq 'HASH'
  93             or croak "relationship_attrs must be a hashref";
  94     }
  95
  96     return bless $self => $class;
  97 }
  98
  99
 100 # pluralize a relationship name
 101 sub _inflect_plural {
 102     my ($self, $relname, $method) = @_;
 103
 104     return '' if !defined $relname || $relname eq '';
 105
 106     if( ref $self->{inflect_plural} eq 'HASH' ) {
 107         return $self->{inflect_plural}->{$relname}
 108             if exists $self->{inflect_plural}->{$relname};
 109     }
 110     elsif( ref $self->{inflect_plural} eq 'CODE' ) {
 111         my $inflected = $self->{inflect_plural}->($relname);
 112         return $inflected if $inflected;
 113     }
 114
 115     $method ||= '_to_PL';
 116
 117     return $self->$method($relname);
 118 }
 119
 120 # Singularize a relationship name
 121 sub _inflect_singular {
 122     my ($self, $relname) = @_;
 123
 124     return '' if !defined $relname || $relname eq '';
 125
 126     if( ref $self->{inflect_singular} eq 'HASH' ) {
 127         return $self->{inflect_singular}->{$relname}
 128             if exists $self->{inflect_singular}->{$relname};
 129     }
 130     elsif( ref $self->{inflect_singular} eq 'CODE' ) {
 131         my $inflected = $self->{inflect_singular}->($relname);
 132         return $inflected if $inflected;
 133     }
 134
 135     return $self->_to_S($relname);
 136 }
 137
 138 sub _to_PL {
 139     my ($self, $name) = @_;
 140
 141     $name =~ s/_/ /g;
 142     my $plural = Lingua::EN::Inflect::Phrase::to_PL($name);
 143     $plural =~ s/ /_/g;
 144
 145     return $plural;
 146 }
 147
 148 sub _old_to_PL {
 149     my ($self, $name) = @_;
 150
 151     return Lingua::EN::Inflect::Number::to_PL($name);
 152 }
 153
 154 sub _to_S {
 155     my ($self, $name) = @_;
 156
 157     $name =~ s/_/ /g;
 158     my $singular = Lingua::EN::Inflect::Phrase::to_S($name);
 159     $singular =~ s/ /_/g;
 160
 161     return $singular;
 162 }
 163
 164 sub _default_relationship_attrs { +{
 165     has_many => {
 166         cascade_delete => 0,
 167         cascade_copy   => 0,
 168     },
 169     might_have => {
 170         cascade_delete => 0,
 171         cascade_copy   => 0,
 172     },
 173     belongs_to => {
 174         on_delete => 'CASCADE',
 175         on_update => 'CASCADE',
 176     },
 177 } }
 178
 179 # accessor for options to be passed to each generated relationship
 180 # type.  take single argument, the relationship type name, and returns
 181 # either a hashref (if some options are set), or nothing
 182 sub _relationship_attrs {
 183     my ( $self, $reltype ) = @_;
 184     my $r = $self->{relationship_attrs};
 185
 186     my %composite = (
 187         %{ $self->_default_relationship_attrs->{$reltype} || {} },
 188         %{ $r->{all} || {} }
 189     );
 190
 191     if( my $specific = $r->{$reltype} ) {
 192         while( my ($k,$v) = each %$specific ) {
 193             $composite{$k} = $v;
 194         }
 195     }
 196     return \%composite;
 197 }
 198
 199 sub _array_eq {
 200     my ($a, $b) = @_;
 201
 202     return unless @$a == @$b;
 203
 204     for (my $i = 0; $i < @$a; $i++) {
 205         return unless $a->[$i] eq $b->[$i];
 206     }
 207     return 1;
 208 }
 209
 210 sub _remote_attrs {
 211     my ($self, $local_moniker, $local_cols) = @_;
 212
 213     # get our base set of attrs from _relationship_attrs, if present
 214     my $attrs = $self->_relationship_attrs('belongs_to') || {};
 215
 216     # If the referring column is nullable, make 'belongs_to' an
 217     # outer join, unless explicitly set by relationship_attrs
 218     my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} } @$local_cols;
 219     $attrs->{join_type} = 'LEFT' if $nullable && !defined $attrs->{join_type};
 220
 221     return $attrs;
 222 }
 223
 224 sub _remote_relname {
 225     my ($self, $remote_table, $cond) = @_;
 226
 227     my $remote_relname;
 228     # for single-column case, set the remote relname to the column
 229     # name, to make filter accessors work, but strip trailing _id
 230     if(scalar keys %{$cond} == 1) {
 231         my ($col) = values %{$cond};
 232         $col = lc $col;
 233         $col =~ s/_id$//;
 234         $remote_relname = $self->_inflect_singular($col);
 235     }
 236     else {
 237         $remote_relname = $self->_inflect_singular(lc $remote_table);
 238     }
 239
 240     return $remote_relname;
 241 }
 242
 243 sub generate_code {
 244     my ($self, $local_moniker, $rels, $uniqs) = @_;
 245
 246     my $all_code = {};
 247
 248     my $local_class = $self->{schema}->class($local_moniker);
 249
 250     my %counters;
 251     foreach my $rel (@$rels) {
 252         next if !$rel->{remote_source};
 253         $counters{$rel->{remote_source}}++;
 254     }
 255
 256     foreach my $rel (@$rels) {
 257         my $remote_moniker = $rel->{remote_source}
 258             or next;
 259
 260         my $remote_class   = $self->{schema}->class($remote_moniker);
 261         my $remote_obj     = $self->{schema}->source($remote_moniker);
 262         my $remote_cols    = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
 263
 264         my $local_cols     = $rel->{local_columns};
 265
 266         if($#$local_cols != $#$remote_cols) {
 267             croak "Column count mismatch: $local_moniker (@$local_cols) "
 268                 . "$remote_moniker (@$remote_cols)";
 269         }
 270
 271         my %cond;
 272         foreach my $i (0 .. $#$local_cols) {
 273             $cond{$remote_cols->[$i]} = $local_cols->[$i];
 274         }
 275
 276         my ( $local_relname, $remote_relname, $remote_method ) =
 277             $self->_relnames_and_method( $local_moniker, $rel, \%cond,  $uniqs, \%counters );
 278
 279         push(@{$all_code->{$local_class}},
 280             { method => 'belongs_to',
 281               args => [ $remote_relname,
 282                         $remote_class,
 283                         \%cond,
 284                         $self->_remote_attrs($local_moniker, $local_cols),
 285               ],
 286             }
 287         );
 288
 289         my %rev_cond = reverse %cond;
 290         for (keys %rev_cond) {
 291             $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 292             delete $rev_cond{$_};
 293         }
 294
 295         push(@{$all_code->{$remote_class}},
 296             { method => $remote_method,
 297               args => [ $local_relname,
 298                         $local_class,
 299                         \%rev_cond,
 300                         $self->_relationship_attrs($remote_method),
 301               ],
 302             }
 303         );
 304     }
 305
 306     return $all_code;
 307 }
 308
 309 sub _relnames_and_method {
 310     my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
 311
 312     my $remote_moniker = $rel->{remote_source};
 313     my $remote_obj     = $self->{schema}->source( $remote_moniker );
 314     my $remote_class   = $self->{schema}->class(  $remote_moniker );
 315     my $remote_relname = lc $self->_remote_relname( $remote_obj->from, $cond);
 316
 317     my $local_cols  = $rel->{local_columns};
 318     my $local_table = $self->{schema}->source($local_moniker)->from;
 319
 320     # If more than one rel between this pair of tables, use the local
 321     # col names to distinguish
 322     my ($local_relname, $old_local_relname, $local_relname_uninflected, $old_local_relname_uninflected);
 323     if ( $counters->{$remote_moniker} > 1) {
 324         my $colnames = lc(q{_} . join(q{_}, @$local_cols));
 325         $remote_relname .= $colnames if keys %$cond > 1;
 326
 327         $local_relname = lc($local_table) . $colnames;
 328         $local_relname =~ s/_id$//;
 329
 330         $local_relname_uninflected = $local_relname;
 331         $local_relname = $self->_inflect_plural( $local_relname );
 332
 333         $old_local_relname_uninflected = lc($local_table) . $colnames;
 334         $old_local_relname = $self->_inflect_plural( lc($local_table) . $colnames, '_old_to_PL' );
 335
 336     } else {
 337         $local_relname_uninflected = lc $local_table;
 338         $local_relname = $self->_inflect_plural(lc $local_table);
 339
 340         $old_local_relname_uninflected = lc $local_table;
 341         $old_local_relname = $self->_inflect_plural(lc $local_table, '_old_to_PL');
 342     }
 343
 344     my $remote_method = 'has_many';
 345
 346     # If the local columns have a UNIQUE constraint, this is a one-to-one rel
 347     my $local_source = $self->{schema}->source($local_moniker);
 348     if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
 349             grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
 350         $remote_method = 'might_have';
 351         $local_relname = $self->_inflect_singular($local_relname_uninflected);
 352         $old_local_relname = $self->_inflect_singular($old_local_relname_uninflected);
 353     }
 354
 355     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;
 356
 357     return ( $local_relname, $remote_relname, $remote_method );
 358 }
 359
 360 =head1 AUTHOR
 361
 362 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 363
 364 =head1 LICENSE
 365
 366 This library is free software; you can redistribute it and/or modify it under
 367 the same terms as Perl itself.
 368
 369 =cut
 370
 371 1;