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

   1 package DBIx::Class::Schema::Loader::RelBuilder;
   2
   3 use strict;
   4 use warnings;
   5 use Carp::Clan qw/^DBIx::Class/;
   6 use Lingua::EN::Inflect ();
   7 use Lingua::EN::Inflect::Number ();
   8
   9 =head1 NAME
  10
  11 DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader
  12
  13 =head1 SYNOPSIS
  14
  15 See L<DBIx::Class::Schema::Loader>
  16
  17 =head1 DESCRIPTION
  18
  19 This class builds relationships for L<DBIx::Class::Schema::Loader>.  This
  20 is module is not (yet) for external use.
  21
  22 =head1 METHODS
  23
  24 =head2 new
  25
  26 Arguments: schema_class (scalar), fk_info (hashref), inflect_plural, inflect_singular
  27
  28 C<$schema_class> should be a schema class name, where the source
  29 classes have already been set up and registered.  Column info, primary
  30 key, and unique constraints will be drawn from this schema for all
  31 of the existing source monikers.
  32
  33 The fk_info hashref's contents should take the form:
  34
  35   {
  36       TableMoniker => [
  37           {
  38               local_columns => [ 'col2', 'col3' ],
  39               remote_columns => [ 'col5', 'col7' ],
  40               remote_moniker => 'AnotherTableMoniker',
  41           },
  42           # ...
  43       ],
  44       AnotherTableMoniker => [
  45           # ...
  46       ],
  47       # ...
  48   }
  49
  50 Options inflect_plural and inflect_singular are optional, and are better documented
  51 in L<DBIx::Class::Schema::Loader::Base>.
  52
  53 =head2 generate_code
  54
  55 This method will return the generated relationships as a hashref per table moniker,
  56 containing an arrayref of code strings which can be "eval"-ed in the context of
  57 the source class, like:
  58
  59   {
  60       'Some::Source::Class' => [
  61           "belongs_to( col1 => 'AnotherTableMoniker' )",
  62           "has_many( anothers => 'AnotherTableMoniker', 'col15' )",
  63       ],
  64       'Another::Source::Class' => [
  65           # ...
  66       ],
  67       # ...
  68   }
  69
  70 You might want to use this in building an on-disk source class file, by
  71 adding each string to the appropriate source class file,
  72 prefixed by C<__PACKAGE__-E<gt>>.
  73
  74 =cut
  75
  76 sub new {
  77     my ( $class, $schema, $fk_info, $inflect_pl, $inflect_singular ) = @_;
  78
  79     my $self = {
  80         schema => $schema,
  81         fk_info => $fk_info,
  82         inflect_plural => $inflect_pl,
  83         inflect_singular => $inflect_singular,
  84     };
  85
  86     bless $self => $class;
  87
  88     $self;
  89 }
  90
  91
  92 # pluralize a relationship name
  93 sub _inflect_plural {
  94     my ($self, $relname) = @_;
  95
  96     if( ref $self->{inflect_plural} eq 'HASH' ) {
  97         return $self->{inflect_plural}->{$relname}
  98             if exists $self->{inflect_plural}->{$relname};
  99     }
 100     elsif( ref $self->{inflect_plural} eq 'CODE' ) {
 101         my $inflected = $self->{inflect_plural}->($relname);
 102         return $inflected if $inflected;
 103     }
 104
 105     return $self->{legacy_default_inflections}
 106         ? Lingua::EN::Inflect::PL($relname)
 107         : Lingua::EN::Inflect::Number::to_PL($relname);
 108 }
 109
 110 # Singularize a relationship name
 111 sub _inflect_singular {
 112     my ($self, $relname) = @_;
 113
 114     if( ref $self->{inflect_singular} eq 'HASH' ) {
 115         return $self->{inflect_singular}->{$relname}
 116             if exists $self->{inflect_singular}->{$relname};
 117     }
 118     elsif( ref $self->{inflect_singular} eq 'CODE' ) {
 119         my $inflected = $self->{inflect_singular}->($relname);
 120         return $inflected if $inflected;
 121     }
 122
 123     return $self->{legacy_default_inflections}
 124         ? $relname
 125         : Lingua::EN::Inflect::Number::to_S($relname);
 126 }
 127
 128 sub generate_code {
 129     my $self = shift;
 130
 131     my $all_code = {};
 132
 133     foreach my $local_moniker (keys %{$self->{fk_info}}) {
 134         my $local_table = $self->{schema}->source($local_moniker)->from;
 135         my $local_class = $self->{schema}->class($local_moniker);
 136         my $rels = $self->{fk_info}->{$local_moniker};
 137
 138         my %counters;
 139         foreach my $rel (@$rels) {
 140             next if !$rel->{remote_source};
 141             $counters{$rel->{remote_source}}++;
 142         }
 143
 144         foreach my $rel (@$rels) {
 145             next if !$rel->{remote_source};
 146             my $local_cols = $rel->{local_columns};
 147             my $remote_cols = $rel->{remote_columns};
 148             my $remote_moniker = $rel->{remote_source};
 149             my $remote_obj = $self->{schema}->source($remote_moniker);
 150             my $remote_class = $self->{schema}->class($remote_moniker);
 151             my $remote_table = $remote_obj->from;
 152             $remote_cols ||= [ $remote_obj->primary_columns ];
 153
 154             if($#$local_cols != $#$remote_cols) {
 155                 croak "Column count mismatch: $local_moniker (@$local_cols) "
 156                     . "$remote_moniker (@$remote_cols)";
 157             }
 158
 159             my %cond;
 160             foreach my $i (0 .. $#$local_cols) {
 161                 $cond{$remote_cols->[$i]} = $local_cols->[$i];
 162             }
 163
 164             my $local_relname;
 165             my $remote_relname;
 166
 167             # for single-column case, set the remote relname to the column
 168             # name, to make filter accessors work
 169             if(scalar keys %cond == 1) {
 170                 my ($col) = keys %cond;
 171                 $remote_relname = $self->_inflect_singular($cond{$col});
 172             }
 173             else {
 174                 $remote_relname = $self->_inflect_singular(lc $remote_table);
 175             }
 176
 177             # If more than one rel between this pair of tables, use the local
 178             # col names to distinguish
 179             if($counters{$remote_moniker} > 1) {
 180                 my $colnames = q{_} . join(q{_}, @$local_cols);
 181                 $local_relname = $self->_inflect_plural(
 182                     lc($local_table) . $colnames
 183                 );
 184                 $remote_relname .= $colnames if keys %cond > 1;
 185             } else {
 186                 $local_relname = $self->_inflect_plural(lc $local_table);
 187             }
 188
 189             my %rev_cond = reverse %cond;
 190
 191             for (keys %rev_cond) {
 192                 $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
 193                 delete $rev_cond{$_};
 194             }
 195
 196             push(@{$all_code->{$local_class}},
 197                 { method => 'belongs_to',
 198                   args => [ $remote_relname,
 199                             $remote_class,
 200                             \%cond,
 201                   ],
 202                 }
 203             );
 204
 205             push(@{$all_code->{$remote_class}},
 206                 { method => 'has_many',
 207                   args => [ $local_relname,
 208                             $local_class,
 209                             \%rev_cond,
 210                   ],
 211                 }
 212             );
 213         }
 214     }
 215
 216     return $all_code;
 217 }
 218
 219 1;