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