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