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::Constants 'BY_CASE_TRANSITION';
   9
  10 our $VERSION = '0.07000';
  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 _normalize_name {
 217     my ($self, $name) = @_;
 218
 219     my @words = split BY_CASE_TRANSITION, $name;
 220
 221     return join '_', map lc, @words;
 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 = $self->_normalize_name($col);
 233         $col =~ s/_id$//;
 234         $remote_relname = $self->_inflect_singular($col);
 235     }
 236     else {
 237         $remote_relname = $self->_inflect_singular($self->_normalize_name($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 = $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, $local_relname_uninflected);
 323     if ( $counters->{$remote_moniker} > 1) {
 324         my $colnames = q{_} . $self->_normalize_name(join '_', @$local_cols);
 325         $remote_relname .= $colnames if keys %$cond > 1;
 326
 327         $local_relname = $self->_normalize_name($local_table . $colnames);
 328         $local_relname =~ s/_id$//;
 329
 330         $local_relname_uninflected = $local_relname;
 331         $local_relname = $self->_inflect_plural($local_relname);
 332     } else {
 333         $local_relname_uninflected = $self->_normalize_name($local_table);
 334         $local_relname = $self->_inflect_plural($self->_normalize_name($local_table));
 335     }
 336
 337     my $remote_method = 'has_many';
 338
 339     # If the local columns have a UNIQUE constraint, this is a one-to-one rel
 340     my $local_source = $self->{schema}->source($local_moniker);
 341     if ($self->_array_eq([ $local_source->primary_columns ], $local_cols) ||
 342             grep { $self->_array_eq($_->[1], $local_cols) } @$uniqs) {
 343         $remote_method = 'might_have';
 344         $local_relname = $self->_inflect_singular($local_relname_uninflected);
 345     }
 346
 347     return ( $local_relname, $remote_relname, $remote_method );
 348 }
 349
 350 =head1 AUTHOR
 351
 352 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 353
 354 =head1 LICENSE
 355
 356 This library is free software; you can redistribute it and/or modify it under
 357 the same terms as Perl itself.
 358
 359 =cut
 360
 361 1;
 362 # vim:et sts=4 sw=4 tw=0: