File: RelBuilder.pm

package info (click to toggle)
libdbix-class-schema-loader-perl 0.03009-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 252 kB
  • ctags: 102
  • sloc: perl: 1,636; makefile: 44
file content (217 lines) | stat: -rw-r--r-- 6,426 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
package DBIx::Class::Schema::Loader::RelBuilder;

use strict;
use warnings;
use Carp::Clan qw/^DBIx::Class/;
use Lingua::EN::Inflect ();
use Lingua::EN::Inflect::Number ();

=head1 NAME

DBIx::Class::Schema::Loader::RelBuilder - Builds relationships for DBIx::Class::Schema::Loader

=head1 SYNOPSIS

See L<DBIx::Class::Schema::Loader>

=head1 DESCRIPTION

This class builds relationships for L<DBIx::Class::Schema::Loader>.  This
is module is not (yet) for external use.

=head1 METHODS

=head2 new

Arguments: schema_class (scalar), fk_info (hashref), inflect_plural, inflect_singular

C<$schema_class> should be a schema class name, where the source
classes have already been set up and registered.  Column info, primary
key, and unique constraints will be drawn from this schema for all
of the existing source monikers.

The fk_info hashref's contents should take the form:

  {
      TableMoniker => [
          {
              local_columns => [ 'col2', 'col3' ],
              remote_columns => [ 'col5', 'col7' ],
              remote_moniker => 'AnotherTableMoniker',
          },
          # ...
      ],
      AnotherTableMoniker => [
          # ...
      ],
      # ...
  }

Options inflect_plural and inflect_singular are optional, and are better documented
in L<DBIx::Class::Schema::Loader::Base>.

=head2 generate_code

This method will return the generated relationships as a hashref per table moniker,
containing an arrayref of code strings which can be "eval"-ed in the context of
the source class, like:

  {
      'Some::Source::Class' => [
          "belongs_to( col1 => 'AnotherTableMoniker' )",
          "has_many( anothers => 'AnotherTableMoniker', 'col15' )",
      ],
      'Another::Source::Class' => [
          # ...
      ],
      # ...
  }

You might want to use this in building an on-disk source class file, by
adding each string to the appropriate source class file,
prefixed by C<__PACKAGE__-E<gt>>.

=cut

sub new {
    my ( $class, $schema, $fk_info, $inflect_pl, $inflect_singular ) = @_;

    my $self = {
        schema => $schema,
        fk_info => $fk_info,
        inflect_plural => $inflect_pl,
        inflect_singular => $inflect_singular,
    };

    bless $self => $class;

    $self;
}


# pluralize a relationship name
sub _inflect_plural {
    my ($self, $relname) = @_;

    if( ref $self->{inflect_plural} eq 'HASH' ) {
        return $self->{inflect_plural}->{$relname}
            if exists $self->{inflect_plural}->{$relname};
    }
    elsif( ref $self->{inflect_plural} eq 'CODE' ) {
        my $inflected = $self->{inflect_plural}->($relname);
        return $inflected if $inflected;
    }

    return $self->{legacy_default_inflections}
        ? Lingua::EN::Inflect::PL($relname)
        : Lingua::EN::Inflect::Number::to_PL($relname);
}

# Singularize a relationship name
sub _inflect_singular {
    my ($self, $relname) = @_;

    if( ref $self->{inflect_singular} eq 'HASH' ) {
        return $self->{inflect_singular}->{$relname}
            if exists $self->{inflect_singular}->{$relname};
    }
    elsif( ref $self->{inflect_singular} eq 'CODE' ) {
        my $inflected = $self->{inflect_singular}->($relname);
        return $inflected if $inflected;
    }

    return $self->{legacy_default_inflections}
        ? $relname
        : Lingua::EN::Inflect::Number::to_S($relname);
}

sub generate_code {
    my $self = shift;

    my $all_code = {};

    foreach my $local_moniker (keys %{$self->{fk_info}}) {
        my $local_table = $self->{schema}->source($local_moniker)->from;
        my $local_class = $self->{schema}->class($local_moniker);
        my $rels = $self->{fk_info}->{$local_moniker};
        
        my %counters;
        foreach my $rel (@$rels) {
            next if !$rel->{remote_source};
            $counters{$rel->{remote_source}}++;
        }

        foreach my $rel (@$rels) {
            next if !$rel->{remote_source};
            my $local_cols = $rel->{local_columns};
            my $remote_cols = $rel->{remote_columns};
            my $remote_moniker = $rel->{remote_source};
            my $remote_obj = $self->{schema}->source($remote_moniker);
            my $remote_class = $self->{schema}->class($remote_moniker);
            my $remote_table = $remote_obj->from;
            $remote_cols ||= [ $remote_obj->primary_columns ];

            if($#$local_cols != $#$remote_cols) {
                croak "Column count mismatch: $local_moniker (@$local_cols) "
                    . "$remote_moniker (@$remote_cols)";
            }

            my %cond;
            foreach my $i (0 .. $#$local_cols) {
                $cond{$remote_cols->[$i]} = $local_cols->[$i];
            }

            # If more than one rel between this pair of tables, use the
            #  local col name(s) as the relname in the foreign source, instead
            #  of the local table name.
            my $local_relname;
            if($counters{$remote_moniker} > 1) {
                $local_relname = $self->_inflect_plural(
                    lc($local_table) . q{_} . join(q{_}, @$local_cols)
                );
            } else {
                $local_relname = $self->_inflect_plural(lc $local_table);
            }

            # for single-column case, set the relname to the column name,
            # to make filter accessors work
            my $remote_relname;
            if(scalar keys %cond == 1) {
                my ($col) = keys %cond;
                $remote_relname = $self->_inflect_singular($cond{$col});
            }
            else {
                $remote_relname = $self->_inflect_singular(lc $remote_table);
            }

            my %rev_cond = reverse %cond;

            for (keys %rev_cond) {
                $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
                delete $rev_cond{$_};
            }

            push(@{$all_code->{$local_class}},
                { method => 'belongs_to',
                  args => [ $remote_relname,
                            $remote_class,
                            \%cond,
                  ],
                }
            );

            push(@{$all_code->{$remote_class}},
                { method => 'has_many',
                  args => [ $local_relname,
                            $local_class,
                            \%rev_cond,
                  ],
                }
            );
        }
    }

    return $all_code;
}

1;