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.04999_12';
  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     my ( $class, $schema, $inflect_pl, $inflect_singular ) = @_;
  80
  81     my $self = {
  82         schema => $schema,
  83         inflect_plural => $inflect_pl,
  84         inflect_singular => $inflect_singular,
  85     };
  86
  87     bless $self => $class;
  88
  89     $self;
  90 }
  91
  92
  93 # pluralize a relationship name
  94 sub _inflect_plural {
  95     my ($self, $relname) = @_;
  96
  97     if( ref $self->{inflect_plural} eq 'HASH' ) {
  98         return $self->{inflect_plural}->{$relname}
  99             if exists $self->{inflect_plural}->{$relname};
 100     }
 101     elsif( ref $self->{inflect_plural} eq 'CODE' ) {
 102         my $inflected = $self->{inflect_plural}->($relname);
 103         return $inflected if $inflected;
 104     }
 105
 106     return Lingua::EN::Inflect::Number::to_PL($relname);
 107 }
 108
 109 # Singularize a relationship name
 110 sub _inflect_singular {
 111     my ($self, $relname) = @_;
 112
 113     if( ref $self->{inflect_singular} eq 'HASH' ) {
 114         return $self->{inflect_singular}->{$relname}
 115             if exists $self->{inflect_singular}->{$relname};
 116     }
 117     elsif( ref $self->{inflect_singular} eq 'CODE' ) {
 118         my $inflected = $self->{inflect_singular}->($relname);
 119         return $inflected if $inflected;
 120     }
 121
 122     return Lingua::EN::Inflect::Number::to_S($relname);
 123 }
 124
 125 sub _array_eq {
 126     my ($a, $b) = @_;
 127
 128     return unless @$a == @$b;
 129
 130     for (my $i = 0; $i < @$a; $i++) {
 131         return unless $a->[$i] eq $b->[$i];
 132     }
 133     return 1;
 134 }
 135
 136 sub _uniq_fk_rel {
 137     my ($self, $local_moniker, $local_relname, $local_cols, $uniqs) = @_;
 138
 139     my $remote_method = 'has_many';
 140
 141     # If the local columns have a UNIQUE constraint, this is a one-to-one rel
 142     my $local_source = $self->{schema}->source($local_moniker);
 143     if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
 144             grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
 145         $remote_method = 'might_have';
 146         $local_relname = $self->_inflect_singular($local_relname);
 147     }
 148
 149     return ($remote_method, $local_relname);
 150 }
 151
 152 sub _remote_attrs {
 153         my ($self, $local_moniker, $local_cols) = @_;
 154
 155         # If the referring column is nullable, make 'belongs_to' an outer join:
 156         my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} }
 157                 @$local_cols;
 158
 159         return $nullable ? { join_type => 'LEFT' } : ();
 160 }
 161
 162 sub _remote_relname {
 163     my ($self, $remote_table, $cond) = @_;
 164
 165     my $remote_relname;
 166     # for single-column case, set the remote relname to the column
 167     # name, to make filter accessors work, but strip trailing _id
 168     if(scalar keys %{$cond} == 1) {
 169         my ($col) = values %{$cond};
 170         $col =~ s/_id$//;
 171         $remote_relname = $self->_inflect_singular($col);
 172     }
 173     else {
 174         $remote_relname = $self->_inflect_singular(lc $remote_table);
 175     }
 176
 177     return $remote_relname;
 178 }
 179
 180 sub generate_code {
 181     my ($self, $local_moniker, $rels, $uniqs) = @_;
 182
 183     my $all_code = {};
 184
 185     my $local_table = $self->{schema}->source($local_moniker)->from;
 186     my $local_class = $self->{schema}->class($local_moniker);
 187
 188     my %counters;
 189     foreach my $rel (@$rels) {
 190         next if !$rel->{remote_source};
 191         $counters{$rel->{remote_source}}++;
 192     }
 193
 194     foreach my $rel (@$rels) {
 195         next if !$rel->{remote_source};
 196         my $local_cols = $rel->{local_columns};
 197         my $remote_cols = $rel->{remote_columns};
 198         my $remote_moniker = $rel->{remote_source};
 199         my $remote_obj = $self->{schema}->source($remote_moniker);
 200         my $remote_class = $self->{schema}->class($remote_moniker);
 201         my $remote_table = $remote_obj->from;
 202         $remote_cols ||= [ $remote_obj->primary_columns ];
 203
 204         if($#$local_cols != $#$remote_cols) {
 205             croak "Column count mismatch: $local_moniker (@$local_cols) "
 206                 . "$remote_moniker (@$remote_cols)";
 207         }
 208
 209         my %cond;
 210         foreach my $i (0 .. $#$local_cols) {
 211             $cond{$remote_cols->[$i]} = $local_cols->[$i];
 212         }
 213
 214         my $local_relname;
 215         my $remote_relname = $self->_remote_relname($remote_table, \%cond);
 216
 217         # If more than one rel between this pair of tables, use the local
 218         # col names to distinguish
 219         if($counters{$remote_moniker} > 1) {
 220             my $colnames = q{_} . join(q{_}, @$local_cols);
 221             $local_relname = $self->_inflect_plural(
 222                 lc($local_table) . $colnames
 223             );
 224             $remote_relname .= $colnames if keys %cond > 1;
 225         } else {
 226             $local_relname = $self->_inflect_plural(lc $local_table);
 227         }
 228
 229         my %rev_cond = reverse %cond;
 230
 231         for (keys %rev_cond) {
 232             $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 233             delete $rev_cond{$_};
 234         }
 235
 236         my ($remote_method);
 237
 238         ($remote_method, $local_relname) = $self->_uniq_fk_rel($local_moniker, $local_relname, $local_cols, $uniqs);
 239
 240         push(@{$all_code->{$local_class}},
 241             { method => 'belongs_to',
 242               args => [ $remote_relname,
 243                         $remote_class,
 244                         \%cond,
 245                         $self->_remote_attrs($local_moniker, $local_cols),
 246               ],
 247             }
 248         );
 249
 250         push(@{$all_code->{$remote_class}},
 251             { method => $remote_method,
 252               args => [ $local_relname,
 253                         $local_class,
 254                         \%rev_cond,
 255               ],
 256             }
 257         );
 258     }
 259
 260     return $all_code;
 261 }
 262
 263 =head1 AUTHOR
 264
 265 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 266
 267 =head1 LICENSE
 268
 269 This library is free software; you can redistribute it and/or modify it under
 270 the same terms as Perl itself.
 271
 272 =cut
 273
 274 1;