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