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