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 =~ s/_id$//;
 188         $remote_relname = $self->_inflect_singular($col);
 189     }
 190     else {
 191         $remote_relname = $self->_inflect_singular(lc $remote_table);
 192     }
 193
 194     return $remote_relname;
 195 }
 196
 197 sub generate_code {
 198     my ($self, $local_moniker, $rels, $uniqs) = @_;
 199
 200     my $all_code = {};
 201
 202     my $local_class = $self->{schema}->class($local_moniker);
 203
 204     my %counters;
 205     foreach my $rel (@$rels) {
 206         next if !$rel->{remote_source};
 207         $counters{$rel->{remote_source}}++;
 208     }
 209
 210     foreach my $rel (@$rels) {
 211         my $remote_moniker = $rel->{remote_source}
 212             or next;
 213
 214         my $remote_class   = $self->{schema}->class($remote_moniker);
 215         my $remote_obj     = $self->{schema}->source($remote_moniker);
 216         my $remote_cols    = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
 217
 218         my $local_cols     = $rel->{local_columns};
 219
 220         if($#$local_cols != $#$remote_cols) {
 221             croak "Column count mismatch: $local_moniker (@$local_cols) "
 222                 . "$remote_moniker (@$remote_cols)";
 223         }
 224
 225         my %cond;
 226         foreach my $i (0 .. $#$local_cols) {
 227             $cond{$remote_cols->[$i]} = $local_cols->[$i];
 228         }
 229
 230         my ( $local_relname, $remote_relname, $remote_method ) =
 231             $self->_relnames_and_method( $local_moniker, $rel, \%cond,  $uniqs, \%counters );
 232
 233         push(@{$all_code->{$local_class}},
 234             { method => 'belongs_to',
 235               args => [ $remote_relname,
 236                         $remote_class,
 237                         \%cond,
 238                         $self->_remote_attrs($local_moniker, $local_cols),
 239               ],
 240             }
 241         );
 242
 243         my %rev_cond = reverse %cond;
 244         for (keys %rev_cond) {
 245             $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 246             delete $rev_cond{$_};
 247         }
 248
 249         push(@{$all_code->{$remote_class}},
 250             { method => $remote_method,
 251               args => [ $local_relname,
 252                         $local_class,
 253                         \%rev_cond,
 254                         $self->_relationship_attrs($remote_method),
 255               ],
 256             }
 257         );
 258     }
 259
 260     return $all_code;
 261 }
 262
 263 sub _relnames_and_method {
 264     my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
 265
 266     my $remote_moniker = $rel->{remote_source};
 267     my $remote_obj     = $self->{schema}->source( $remote_moniker );
 268     my $remote_class   = $self->{schema}->class(  $remote_moniker );
 269     my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond);
 270
 271     my $local_cols  = $rel->{local_columns};
 272     my $local_table = $self->{schema}->source($local_moniker)->from;
 273
 274     # If more than one rel between this pair of tables, use the local
 275     # col names to distinguish
 276     my $local_relname;
 277     my $old_multirel_name; #< TODO: remove me
 278     if ( $counters->{$remote_moniker} > 1) {
 279         my $colnames = q{_} . join(q{_}, @$local_cols);
 280         $remote_relname .= $colnames if keys %$cond > 1;
 281
 282         $local_relname = lc($local_table) . $colnames;
 283         $local_relname =~ s/_id$//
 284             #< TODO: remove me
 285             and $old_multirel_name = $self->_inflect_plural( lc($local_table) . $colnames );
 286         $local_relname = $self->_inflect_plural( $local_relname );
 287
 288     } else {
 289         $local_relname = $self->_inflect_plural(lc $local_table);
 290     }
 291
 292     my $remote_method = 'has_many';
 293
 294     # If the local columns have a UNIQUE constraint, this is a one-to-one rel
 295     my $local_source = $self->{schema}->source($local_moniker);
 296     if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
 297             grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
 298         $remote_method = 'might_have';
 299         $local_relname = $self->_inflect_singular($local_relname);
 300         #< TODO: remove me
 301         $old_multirel_name = $self->_inflect_singular($old_multirel_name);
 302     }
 303
 304     # TODO: remove me after 0.05003 release
 305     $old_multirel_name
 306         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";
 307
 308     return ( $local_relname, $remote_relname, $remote_method );
 309 }
 310
 311 =head1 AUTHOR
 312
 313 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 314
 315 =head1 LICENSE
 316
 317 This library is free software; you can redistribute it and/or modify it under
 318 the same terms as Perl itself.
 319
 320 =cut
 321
 322 1;