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.08000';
  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 _strip__id {
 192     my ($self, $name) = @_;
 193
 194     $name =~ s/_(?:id|ref)\z//;
 195
 196     return $name;
 197 }
 198
 199 sub _array_eq {
 200     my ($self, $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 _sanitize_name {
 225     my ($self, $name) = @_;
 226
 227     if (ref $name) {
 228         # scalar ref for weird table name (like one containing a '.')
 229         ($name = $$name) =~ s/\W+/_/g;
 230     }
 231     else {
 232         # remove 'schema.' prefix if any
 233         $name =~ s/^[^.]+\.//;
 234     }
 235
 236     return $name;
 237 }
 238
 239 sub _normalize_name {
 240     my ($self, $name) = @_;
 241
 242     $name = $self->_sanitize_name($name);
 243
 244     my @words = split_name $name;
 245
 246     return join '_', map lc, @words;
 247 }
 248
 249 sub _remote_relname {
 250     my ($self, $remote_table, $cond) = @_;
 251
 252     my $remote_relname;
 253     # for single-column case, set the remote relname to the column
 254     # name, to make filter accessors work, but strip trailing _id
 255     if(scalar keys %{$cond} == 1) {
 256         my ($col) = values %{$cond};
 257         $col = $self->_normalize_name($col);
 258         $col = $self->_strip__id($col);
 259         $remote_relname = $self->_inflect_singular($col);
 260     }
 261     else {
 262         $remote_relname = $self->_inflect_singular($self->_normalize_name($remote_table));
 263     }
 264
 265     return $remote_relname;
 266 }
 267
 268 sub generate_code {
 269     my ($self, $local_moniker, $rels, $uniqs) = @_;
 270
 271     my $all_code = {};
 272
 273     my $local_class = $self->{schema}->class($local_moniker);
 274
 275     my %counters;
 276     foreach my $rel (@$rels) {
 277         next if !$rel->{remote_source};
 278         $counters{$rel->{remote_source}}++;
 279     }
 280
 281     foreach my $rel (@$rels) {
 282         my $remote_moniker = $rel->{remote_source}
 283             or next;
 284
 285         my $remote_class   = $self->{schema}->class($remote_moniker);
 286         my $remote_obj     = $self->{schema}->source($remote_moniker);
 287         my $remote_cols    = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
 288
 289         my $local_cols     = $rel->{local_columns};
 290
 291         if($#$local_cols != $#$remote_cols) {
 292             croak "Column count mismatch: $local_moniker (@$local_cols) "
 293                 . "$remote_moniker (@$remote_cols)";
 294         }
 295
 296         my %cond;
 297         foreach my $i (0 .. $#$local_cols) {
 298             $cond{$remote_cols->[$i]} = $local_cols->[$i];
 299         }
 300
 301         my ( $local_relname, $remote_relname, $remote_method ) =
 302             $self->_relnames_and_method( $local_moniker, $rel, \%cond,  $uniqs, \%counters );
 303
 304         push(@{$all_code->{$local_class}},
 305             { method => 'belongs_to',
 306               args => [ $remote_relname,
 307                         $remote_class,
 308                         \%cond,
 309                         $self->_remote_attrs($local_moniker, $local_cols),
 310               ],
 311             }
 312         );
 313
 314         my %rev_cond = reverse %cond;
 315         for (keys %rev_cond) {
 316             $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 317             delete $rev_cond{$_};
 318         }
 319
 320         push(@{$all_code->{$remote_class}},
 321             { method => $remote_method,
 322               args => [ $local_relname,
 323                         $local_class,
 324                         \%rev_cond,
 325                         $self->_relationship_attrs($remote_method),
 326               ],
 327             }
 328         );
 329     }
 330
 331     return $all_code;
 332 }
 333
 334 sub _relnames_and_method {
 335     my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
 336
 337     my $remote_moniker = $rel->{remote_source};
 338     my $remote_obj     = $self->{schema}->source( $remote_moniker );
 339     my $remote_class   = $self->{schema}->class(  $remote_moniker );
 340     my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond);
 341
 342     my $local_cols  = $rel->{local_columns};
 343     my $local_table = $self->{schema}->source($local_moniker)->from;
 344
 345     # If more than one rel between this pair of tables, use the local
 346     # col names to distinguish
 347     my ($local_relname, $local_relname_uninflected);
 348     if ( $counters->{$remote_moniker} > 1) {
 349         my $colnames = q{_} . $self->_normalize_name(join '_', @$local_cols);
 350         $remote_relname .= $colnames if keys %$cond > 1;
 351
 352         $local_relname = $self->_normalize_name($local_table . $colnames);
 353         $local_relname = $self->_strip__id($local_relname);
 354
 355         $local_relname_uninflected = $local_relname;
 356         $local_relname = $self->_inflect_plural($local_relname);
 357     } else {
 358         $local_relname_uninflected = $self->_normalize_name($local_table);
 359         $local_relname = $self->_inflect_plural($self->_normalize_name($local_table));
 360     }
 361
 362     my $remote_method = 'has_many';
 363
 364     # If the local columns have a UNIQUE constraint, this is a one-to-one rel
 365     my $local_source = $self->{schema}->source($local_moniker);
 366     if ($self->_array_eq([ $local_source->primary_columns ], $local_cols) ||
 367             grep { $self->_array_eq($_->[1], $local_cols) } @$uniqs) {
 368         $remote_method = 'might_have';
 369         $local_relname = $self->_inflect_singular($local_relname_uninflected);
 370     }
 371
 372     return ( $local_relname, $remote_relname, $remote_method );
 373 }
 374
 375 =head1 AUTHOR
 376
 377 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 378
 379 =head1 LICENSE
 380
 381 This library is free software; you can redistribute it and/or modify it under
 382 the same terms as Perl itself.
 383
 384 =cut
 385
 386 1;
 387 # vim:et sts=4 sw=4 tw=0: