[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / RelBuilder.pm

package DBIx::Class::Schema::Loader::RelBuilder;

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

our $VERSION = '0.05003';

=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), 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.

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

=head2 generate_code

Arguments: local_moniker (scalar), fk_info (arrayref)

This generates the code for the relationships of a given table.

C<local_moniker> is the moniker name of the table which had the REFERENCES
statements.  The fk_info arrayref's contents should take the form:

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

This method will return the generated relationships as a hashref keyed on the
class names.  The values are arrayrefs of hashes containing method name and
arguments, like so:

  {
      'Some::Source::Class' => [
          { method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
          { method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
      ],
      'Another::Source::Class' => [
          # ...
      ],
      # ...
  }

=cut

sub new {

    my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_;

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

    # validate the relationship_attrs arg
    if( defined $self->{relationship_attrs} ) {
	ref($self->{relationship_attrs}) eq 'HASH'
	    or croak "relationship_attrs must be a hashref";
    }

    return bless $self => $class;
}


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

    return '' if !defined $relname || $relname eq '';

    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 Lingua::EN::Inflect::Number::to_PL($relname);
}

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

    return '' if !defined $relname || $relname eq '';

    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 Lingua::EN::Inflect::Number::to_S($relname);
}

# accessor for options to be passed to each generated relationship
# type.  take single argument, the relationship type name, and returns
# either a hashref (if some options are set), or nothing
sub _relationship_attrs {
    my ( $self, $reltype ) = @_;
    my $r = $self->{relationship_attrs};
    return unless $r && ( $r->{all} || $r->{$reltype} );

    my %composite = %{ $r->{all} || {} };
    if( my $specific = $r->{$reltype} ) {
	while( my ($k,$v) = each %$specific ) {
	    $composite{$k} = $v;
	}
    }
    return \%composite;
}

sub _array_eq {
    my ($a, $b) = @_;

    return unless @$a == @$b;

    for (my $i = 0; $i < @$a; $i++) {
        return unless $a->[$i] eq $b->[$i];
    }
    return 1;
}

sub _remote_attrs {
	my ($self, $local_moniker, $local_cols) = @_;

	# get our base set of attrs from _relationship_attrs, if present
	my $attrs = $self->_relationship_attrs('belongs_to') || {};

	# If the referring column is nullable, make 'belongs_to' an
	# outer join, unless explicitly set by relationship_attrs
	my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} }
		@$local_cols;
	$attrs->{join_type} = 'LEFT'
	    if $nullable && !defined $attrs->{join_type};

	return $attrs;
}

sub _remote_relname {
    my ($self, $remote_table, $cond) = @_;

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

    return $remote_relname;
}

sub generate_code {
    my ($self, $local_moniker, $rels, $uniqs) = @_;

    my $all_code = {};

    my $local_class = $self->{schema}->class($local_moniker);

    my %counters;
    foreach my $rel (@$rels) {
        next if !$rel->{remote_source};
        $counters{$rel->{remote_source}}++;
    }

    foreach my $rel (@$rels) {
        my $remote_moniker = $rel->{remote_source}
            or next;

        my $remote_class   = $self->{schema}->class($remote_moniker);
        my $remote_obj     = $self->{schema}->source($remote_moniker);
        my $remote_cols    = $rel->{remote_columns} || [ $remote_obj->primary_columns ];

        my $local_cols     = $rel->{local_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];
        }

        my ( $local_relname, $remote_relname, $remote_method ) =
            $self->_relnames_and_method( $local_moniker, $rel, \%cond,  $uniqs, \%counters );

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

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

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

    return $all_code;
}

sub _relnames_and_method {
    my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;

    my $remote_moniker = $rel->{remote_source};
    my $remote_obj     = $self->{schema}->source( $remote_moniker );
    my $remote_class   = $self->{schema}->class(  $remote_moniker );
    my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond);

    my $local_cols  = $rel->{local_columns};
    my $local_table = $self->{schema}->source($local_moniker)->from;

    # If more than one rel between this pair of tables, use the local
    # col names to distinguish
    my $local_relname;
    my $old_multirel_name; #< TODO: remove me
    if ( $counters->{$remote_moniker} > 1) {
        my $colnames = q{_} . join(q{_}, @$local_cols);
        $remote_relname .= $colnames if keys %$cond > 1;

        $local_relname = lc($local_table) . $colnames;
        $local_relname =~ s/_id$//
            #< TODO: remove me
            and $old_multirel_name = $self->_inflect_plural( lc($local_table) . $colnames );
        $local_relname = $self->_inflect_plural( $local_relname );

    } else {
        $local_relname = $self->_inflect_plural(lc $local_table);
    }

    my $remote_method = 'has_many';

    # If the local columns have a UNIQUE constraint, this is a one-to-one rel
    my $local_source = $self->{schema}->source($local_moniker);
    if (_array_eq([ $local_source->primary_columns ], $local_cols) ||
            grep { _array_eq($_->[1], $local_cols) } @$uniqs) {
        $remote_method = 'might_have';
        $local_relname = $self->_inflect_singular($local_relname);
        #< TODO: remove me
        $old_multirel_name = $self->_inflect_singular($old_multirel_name);
    }

    # TODO: remove me after 0.05003 release
    $old_multirel_name
        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";

    return ( $local_relname, $remote_relname, $remote_method );
}

=head1 AUTHOR

See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;
Commit	Line	Data
996be9ee	1	package DBIx::Class::Schema::Loader::RelBuilder;
	2
	3	use strict;
	4	use warnings;
7824616e	5	use Class::C3;
fa994d3c	6	use Carp::Clan qw/^DBIx::Class/;
996be9ee	7	use Lingua::EN::Inflect::Number ();
996be9ee	8
e42ec4ef	9	our $VERSION = '0.05003';
32f784fc	10
996be9ee	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
e8ad6491	28	Arguments: schema_class (scalar), inflect_plural, inflect_singular
996be9ee	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
996be9ee	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
e8ad6491	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:
996be9ee	64
	65	{
	66	'Some::Source::Class' => [
b97c2c1e	67	{ method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
b97c2c1e	68	{ method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
996be9ee	69	],
	70	'Another::Source::Class' => [
	71	# ...
	72	],
	73	# ...
	74	}
8f9d7ce5	75
996be9ee	76	=cut
	77
	78	sub new {
c8c27020	79
c8c27020	80	my ( $class, $schema, $inflect_pl, $inflect_singular, $rel_attrs ) = @_;
996be9ee	81
	82	my $self = {
	83	schema => $schema,
996be9ee	84	inflect_plural => $inflect_pl,
996be9ee	85	inflect_singular => $inflect_singular,
c8c27020	86	relationship_attrs => $rel_attrs,
996be9ee	87	};
996be9ee	88
c8c27020	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	}
996be9ee	94
c8c27020	95	return bless $self => $class;
996be9ee	96	}
	97
	98
	99	# pluralize a relationship name
	100	sub _inflect_plural {
	101	my ($self, $relname) = @_;
	102
39ef3bfe	103	return '' if !defined $relname \|\| $relname eq '';
39ef3bfe	104
996be9ee	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
d3af7a07	114	return Lingua::EN::Inflect::Number::to_PL($relname);
996be9ee	115	}
	116
	117	# Singularize a relationship name
	118	sub _inflect_singular {
	119	my ($self, $relname) = @_;
	120
39ef3bfe	121	return '' if !defined $relname \|\| $relname eq '';
39ef3bfe	122
996be9ee	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
d3af7a07	132	return Lingua::EN::Inflect::Number::to_S($relname);
996be9ee	133	}
996be9ee	134
c8c27020	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
26f1c8c9	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
c39e403e	163	sub _remote_attrs {
	164	my ($self, $local_moniker, $local_cols) = @_;
	165
c8c27020	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
c39e403e	171	my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} }
c39e403e	172	@$local_cols;
c8c27020	173	$attrs->{join_type} = 'LEFT'
c8c27020	174	if $nullable && !defined $attrs->{join_type};
c39e403e	175
c8c27020	176	return $attrs;
c39e403e	177	}
c39e403e	178
f2fc8d01	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
996be9ee	197	sub generate_code {
26f1c8c9	198	my ($self, $local_moniker, $rels, $uniqs) = @_;
996be9ee	199
	200	my $all_code = {};
	201
e8ad6491	202	my $local_class = $self->{schema}->class($local_moniker);
057fbb08	203
e8ad6491	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) {
057fbb08	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};
e8ad6491	219
	220	if($#$local_cols != $#$remote_cols) {
	221	croak "Column count mismatch: $local_moniker (@$local_cols) "
	222	. "$remote_moniker (@$remote_cols)";
996be9ee	223	}
996be9ee	224
e8ad6491	225	my %cond;
	226	foreach my $i (0 .. $#$local_cols) {
	227	$cond{$remote_cols->[$i]} = $local_cols->[$i];
	228	}
996be9ee	229
057fbb08	230	my ( $local_relname, $remote_relname, $remote_method ) =
39ef3bfe	231	$self->_relnames_and_method( $local_moniker, $rel, \%cond, $uniqs, \%counters );
7dba7c70	232
e8ad6491	233	push(@{$all_code->{$local_class}},
	234	{ method => 'belongs_to',
	235	args => [ $remote_relname,
	236	$remote_class,
	237	\%cond,
c39e403e	238	$self->_remote_attrs($local_moniker, $local_cols),
e8ad6491	239	],
996be9ee	240	}
e8ad6491	241	);
e8ad6491	242
057fbb08	243	my %rev_cond = reverse %cond;
	244	for (keys %rev_cond) {
	245	$rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
	246	delete $rev_cond{$_};
	247	}
	248
e8ad6491	249	push(@{$all_code->{$remote_class}},
26f1c8c9	250	{ method => $remote_method,
e8ad6491	251	args => [ $local_relname,
	252	$local_class,
	253	\%rev_cond,
c8c27020	254	$self->_relationship_attrs($remote_method),
e8ad6491	255	],
	256	}
	257	);
996be9ee	258	}
	259
	260	return $all_code;
	261	}
	262
39ef3bfe	263	sub _relnames_and_method {
057fbb08	264	my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
e9c09ed9	265
057fbb08	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);
fa6f8d4e	270
057fbb08	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;
684f9580	277	my $old_multirel_name; #< TODO: remove me
057fbb08	278	if ( $counters->{$remote_moniker} > 1) {
	279	my $colnames = q{_} . join(q{_}, @$local_cols);
	280	$remote_relname .= $colnames if keys %$cond > 1;
	281
ff098bf3	282	$local_relname = lc($local_table) . $colnames;
684f9580	283	$local_relname =~ s/_id$//
	284	#< TODO: remove me
	285	and $old_multirel_name = $self->_inflect_plural( lc($local_table) . $colnames );
057fbb08	286	$local_relname = $self->_inflect_plural( $local_relname );
057fbb08	287
057fbb08	288	} else {
	289	$local_relname = $self->_inflect_plural(lc $local_table);
	290	}
fa6f8d4e	291
057fbb08	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);
256fd0c3	300	#< TODO: remove me
256fd0c3	301	$old_multirel_name = $self->_inflect_singular($old_multirel_name);
057fbb08	302	}
fa6f8d4e	303
fa6f8d4e	304	# TODO: remove me after 0.05003 release
684f9580	305	$old_multirel_name
684f9580	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";
fa6f8d4e	307
057fbb08	308	return ( $local_relname, $remote_relname, $remote_method );
fa6f8d4e	309	}
fa6f8d4e	310
be80bba7	311	=head1 AUTHOR
be80bba7	312
9cc8e7e1	313	See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
be80bba7	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
996be9ee	322	1;