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