lib/DBIx/Class/Schema/Loader/RelBuilder.pm

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