Skip to content

Commit

Permalink
Properly handle complex foreign key associations.
Browse files Browse the repository at this point in the history 
The previous commit didn't properly handle the case where a table
had multiple foreign key associations (with and without cascades)
to one or more tables.

The new logic implements the following rules:

* a table which has fk cascades to more than one table must be an
  Association

* a table which has multiple fk cascades to a single table (even if it
  has fk non-cascades) is a Composition.

* a table with multiple fk cascades to a single ref table combines
  those cascades into a single Composition

* a table with fk cascades and non-cascades to a single ref table
  splits the cascades into a Composition and the non-cascades to an
  Association

Associations and Compositions are merged if possible.
  • Loading branch information
@djerius
djerius committed Aug 13, 2015
1 parent a2b09b0 commit 33d50f9
Show file tree
Hide file tree
Showing 2 changed files with 196 additions and 27 deletions.
99 changes: 80 additions & 19 deletions lib/DBIx/DataModel/Schema/Generator.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -294,27 +294,87 @@ sub perl_code {
or croak "can't generate schema: no data. "
. "Call parse_DBI() or parse_DBIx_Class() before";

# make sure there is no duplicate role on the same table

# if a table has multiple cascaded foreign keys make it part of an
# Association, not a Composition, as a table can't be part of
# multiple Compositions.
my @relationship = qw( Association Composition );

my %seen_role;
my %relationship;
foreach my $assoc (@{$self->{assoc}}) {
my $count;
$count = ++$seen_role{$assoc->[0]{table}}{$assoc->[1]{role}};
$assoc->[1]{role} .= "_$count" if $count > 1;
$count = ++$seen_role{$assoc->[1]{table}}{$assoc->[0]{role}};
$assoc->[0]{role} .= "_$count" if $count > 1;
# make sure there is no duplicate role on the same table
# handle complex fk cascades

$relationship{ $assoc->[1]{table} }{ $assoc->[1]{is_cascade} ? 'Composition' : 'Association' }++;
my %tblassoc;
foreach my $assoc (@{$self->{assoc}}) {
my ( $t0, $t1 ) = @{ $assoc };

# separate cascades from non cascades, group by tables
# $tblassoc{t1}[is_cascade ? 0 : 1 ]{t0}[ @assocs ];
my $tassoc =
(
(
$tblassoc{ $t1->{table} } ||= [ ]
)->[ !!$t1->{is_cascade} || 0 ] ||= {}
)->{ $t0->{table} } ||= [];

push @{ $tassoc }, $assoc;
}

# an association which has more than one Composition reverts to an Association.
$_ = $_->{Association} || $_->{Composition} != 1 ? 'Association' : 'Composition'
for values %relationship;
# [1] a table which has fk cascades to more than one table must be an
# Association

# [2] a table which has multiple fk cascades to a single table (even
# if it has fk non-cascades) is a Composition.

# [3] a table with multiple fk cascades to a single ref table combines
# those cascades into a single Composition


my @relationships = ( 'Association', 'Composition' );

my @associations; # final list of associations;
my %seen_role; # ensure role names are unique;

for my $t1 ( values %tblassoc ) {

# [1]
my $cascades = $t1->[1];

if ( keys %$cascades > 1 ) {

# make them all Associations
while( my ( $t0, $assocs ) = each %{$cascades } ) {

push @{ $t1->[0]{$t0} }, @$assocs;

}

$t1->[1] = {};
}

# Merge multiple associations between two tables. Assumes that
# multiplicities are the same for the associations.

for my $ridx ( 0..1 ) {

my $rel = $t1->[$ridx];

while( my ( $t0, $assocs ) = each %{ $rel } ) {

# use the first association as a template
my $assoc = $assocs->[0];

for my $tidx ( 0..1 ) {

# combine columns
$assoc->[$tidx]->{col} = join( ' ', map { $_->[$tidx]{col} } @$assocs );

my $count = ++$seen_role{$assoc->[$tidx]->{table}}{$assoc->[1-$tidx]->{role}};
$assoc->[1-$tidx]->{role} .= "_$count" if $count > 1;
}

# add it to the final list of associations
push @associations, [ $relationships[$ridx], $assoc ];

}
}
}

# compute max length of various fields (for prettier source alignment)
my %l;
Expand Down Expand Up @@ -372,7 +432,10 @@ __END_OF_CODE__
$code .= sprintf("# $colsizes\n", qw/Class Role Mult Join/)
. sprintf("# $colsizes", qw/===== ==== ==== ====/);

foreach my $a (@{$self->{assoc}}) {
foreach my $assoc (@associations) {

my ( $relationship, $a ) = @$assoc;


# for prettier output, make sure that multiplicity "1" is first
@$a = reverse @$a if $a->[1]{mult_max} eq "1"
Expand All @@ -385,8 +448,6 @@ __END_OF_CODE__
$a->[$i]{mult} = {"0..*" => "*", "1..1" => "1"}->{$mult} || $mult;
}

my $relationship = $relationship{$a->[1]{table}};

$code .= "\n->$relationship(\n"
. sprintf($format, @{$a->[0]}{qw/table role mult col/})
. ",\n"
Expand Down
124 changes: 116 additions & 8 deletions t/v2_generator.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,8 @@ use warnings;

use DBIx::DataModel::Schema::Generator;

use constant NTESTS => 7;
use constant NTESTS => 17;

use Test::More tests => NTESTS;


Expand Down Expand Up @@ -45,6 +46,26 @@ SKIP: {
emp_id INTEGER NOT NULL REFERENCES employee(emp_id),
status_name TEXT
);
-- two foreign keys to one reftable, one cascades
CREATE TABLE fk_reftable_1 (
emp_id_status INTEGER NOT NULL REFERENCES employee_status(emp_id_status),
emp_id INTEGER NOT NULL REFERENCES employee_status(emp_id) ON DELETE CASCADE
);
-- two foreign keys to one reftable, both cascade
CREATE TABLE fk_reftable_2 (
emp_id_status INTEGER NOT NULL REFERENCES employee_status(emp_id_status) ON DELETE CASCADE,
emp_id INTEGER NOT NULL REFERENCES employee_status(emp_id) ON DELETE CASCADE
);
-- two foreign keys to two reftables, both cascade
CREATE TABLE fk_reftable_3 (
emp_id_status INTEGER NOT NULL REFERENCES employee_status(emp_id_status) ON DELETE CASCADE,
emp_id INTEGER NOT NULL REFERENCES employee(emp_id) ON DELETE CASCADE
);
});

my $generator = DBIx::DataModel::Schema::Generator->new(
Expand All @@ -54,11 +75,98 @@ SKIP: {
$generator->parse_DBI($dbh);
my $perl_code = $generator->perl_code;

like($perl_code, qr{Table\(qw/Activity}, "Table Activity");
like($perl_code, qr{Table\(qw/ActivityEvent}, "Table ActivityEvent");
like($perl_code, qr{Composition.*?activity_events}s, "Composition");
like($perl_code, qr{Association.*?activit(ie|y)s}s, "Association");
like($perl_code, qr{employee_2}s, "avoid duplicate associations");
sub match_entry {

# $type, [ $class, @etc ], [ ... ], $msg
my $msg = pop;
my $type = quotemeta(shift);

# match start and end of an line, depends if there are one or two lines per entry
my ( $start, $end ) = ( @_ > 1) ? ( qr{\[qw/\s*}, qr{\s*/\]} ) : ( qr{qw/\s*}, qr{\s*/} ) ;

my $re = join('',
qr{$type\s*\(\s*},
join( qr{\s*,\s*}, # join multiple lines
map {
join( '',
$start,
join( qr/\s+/,
map { defined($_) ? quotemeta( $_ ) # so multiplicity of '*' passes through
: qr{[^)]*?} # undef means match to end of line (matches any char except right paren)
} @{$_},
),
$end,
)
} @_ # iterate over lines
),
);


like( $perl_code, qr/$re/, $msg );
}

# ensure Tables are created
match_entry( 'Table', [ $_, undef ], "created Table $_" )
foreach qw[ Activity ActivityEvent Department Employee EmployeeStatus FkReftable1 ];

match_entry( 'Association',
[ qw( Employee employee 1 emp_id emp_id ) ],
[ qw( Activity activities * supervisor emp_id ) ],
'Merged Association',
);


match_entry( 'Association',
[ qw( Department department 1 dpt_id ) ],
[ qw( Activity activities * dpt_id ) ],
'Association: Department, Activity',
);


match_entry( 'Composition',
[ qw( Activity activity 1 act_id ) ],
[ qw( ActivityEvent activity_events * act_id ) ],
'Composition Activity, ActivityEvent'
);

match_entry( 'Association',
[ qw( Employee employee 1 emp_id ) ],
[ qw( EmployeeStatus employee_statuses * emp_id ) ],
'Association: Employee, EmployeeStatus',
);

match_entry( 'Association',
[ qw( EmployeeStatus employee_status 1 emp_id_status ) ],
[ qw( FkReftable1 fk_reftable_1s * emp_id_status ) ],
'Association: two foreign keys to one reftable, one cascades',
);

# checks for duplicate role as well.
match_entry( 'Composition',
[ qw( EmployeeStatus employee_status_2 1 emp_id ) ],
[ qw( FkReftable1 fk_reftable_1s_2 * emp_id ) ],
'Composition: two foreign keys to one reftable, one cascades',
);

match_entry( 'Composition',
[ qw( EmployeeStatus employee_status 1 emp_id emp_id_status ) ],
[ qw( FkReftable2 fk_reftable_2s * emp_id emp_id_status ) ],
'Merged Composition: two foreign keys to one reftable, both cascade',
);

match_entry( 'Association',
[ qw( EmployeeStatus employee_status 1 emp_id_status ) ],
[ qw( FkReftable3 fk_reftable_3s * emp_id_status ) ],
'Forced Association: two foreign keys to two reftables, both cascade (1)',
);


match_entry( 'Association',
[ qw( Employee employee 1 emp_id ) ],
[ qw( FkReftable3 fk_reftable_3s * emp_id ) ],
'Forced Association: two foreign keys to two reftables, both cascade (2)',
);


# diag($perl_code);

Expand All @@ -78,8 +186,8 @@ SKIP: {
);
$generator->parse_DBI($dbh);
$perl_code = $generator->perl_code;
like($perl_code, qr{Table\(qw/Foo}, "Table foo");
like($perl_code, qr{Table\(qw/Bar}, "Table bar");
like($perl_code, qr{Table\(qw/Foo}, "created Table foo");
like($perl_code, qr{Table\(qw/Bar}, "created Table bar");
}


0 comments on commit 33d50f9

Please sign in to comment.