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