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