package SQL::Translator::Filter::AutoCRUD::StorageEngine::DBIC::Relationships;
{
$SQL::Translator::Filter::AutoCRUD::StorageEngine::DBIC::Relationships::VERSION = '2.122460';
}
use strict;
use warnings FATAL => 'all';
use Lingua::EN::Inflect::Number;
use SQL::Translator::AutoCRUD::Utils;
sub add_to_fields_at {
my ($table, $data) = @_;
my $field = {
name => $data->{name},
extra => { rel_type => $data->{rel_type} },
data_type => 'text',
};
for (qw/ref_table ref_fields fields via/) {
$field->{extra}->{$_} = $data->{$_} if exists $data->{$_};
}
if ($data->{rel_type} =~ m/_many$/) {
$field->{extra}->{display_name} =
make_label(Lingua::EN::Inflect::Number::to_PL($data->{name}));
}
else {
$field->{extra}->{display_name} = make_label($data->{name});
}
if ($data->{rel_type} eq 'belongs_to') {
if (my $f = $table->get_field($field->{name})) {
# col already exists, so update metadata
$f->extra($_ => $field->{extra}->{$_})
for keys %{$field->{extra}};
$f->{is_foreign_key} = 1;
}
else {
# need to skip subsequent belongs_to where one has
# already been set - not really ideal but best we can do
return if
scalar grep {$table->get_field($_)->extra('ref_table')}
@{$field->{extra}->{fields}};
$table->get_field($_)->extra('masked_by' => $field->{name})
for @{$field->{extra}->{fields}};
my $f = $table->add_field(%$field);
$f->{is_foreign_key} = 1;
}
}
else {
$field->{extra}->{is_reverse} = 1;
my $f = $table->add_field(%$field);
$f->{is_foreign_key} = 1;
}
}
sub filter {
my ($sqlt, @args) = @_;
my $schema = shift @args;
my $rels = {};
foreach my $tbl_name ($schema->sources) {
my $source = $schema->source($tbl_name);
my $from = make_path($source);
my $sqlt_tbl = $sqlt->get_table($from)
or die "mismatched (rel) table name between SQLT and DBIC: [$from, $tbl_name]\n";
my $new_cols = $rels->{$from} ||= {};
foreach my $r ($source->relationships) {
my $rel_info = $source->relationship_info($r);
my $cond = $rel_info->{cond};
$new_cols->{$r} = { name => $r };
# only basic AND type clauses
if (ref $cond ne ref {}) {
delete $new_cols->{$r};
next;
}
# catch dangling rels and skip them
if (not eval{$source->related_source($r)}) {
delete $new_cols->{$r};
next;
}
$new_cols->{$r}->{ref_table} = make_path($source->related_source($r));
# sort means we keep a consistent order (with generated [pks])
foreach my $field (sort map {$_->name} $sqlt_tbl->get_fields) {
FOREIGN: foreach my $f (keys %$cond) {
if ($cond->{$f} eq "self.$field") {
(my $f_field = $f) =~ s/^foreign\.//;
push @{ $new_cols->{$r}->{ref_fields} }, $f_field;
push @{ $new_cols->{$r}->{fields} }, $field;
last FOREIGN;
}
}
};
if ($rel_info->{attrs}->{accessor} eq 'multi') {
$new_cols->{$r}->{rel_type} = 'has_many';
}
elsif (0 == scalar grep {not $sqlt_tbl->get_field($_)->is_foreign_key}
@{$new_cols->{$r}->{fields}}) {
$new_cols->{$r}->{rel_type} = 'belongs_to';
}
else {
$new_cols->{$r}->{rel_type} = 'might_have';
}
}
}
# second pass to install m2m rels
foreach my $tbl_name ($schema->sources) {
my $source = $schema->source($tbl_name);
my $from = make_path($source);
my $sqlt_tbl = $sqlt->get_table($from);
my $new_cols = $rels->{$from};
foreach my $r (keys %$new_cols) {
next unless $new_cols->{$r}->{rel_type} eq 'has_many';
my $link = $new_cols->{$r}->{ref_table};
next unless 2 == scalar keys %{$rels->{$link}}
and 2 == scalar grep {$_->{rel_type} eq 'belongs_to'}
values %{$rels->{$link}};
foreach my $lrel (keys %{$rels->{$link}}) {
next if $rels->{$link}->{$lrel}->{ref_table} eq $from;
my $name = $rels->{$link}->{$lrel}->{ref_table};
$name .= "_via_$link"
if exists $new_cols->{ $rels->{$link}->{$lrel}->{ref_table} };
$new_cols->{ $name } = {
name => $name,
rel_type => 'many_to_many',
via => [$r, $lrel],
};
last;
}
}
}
foreach my $tbl_name (keys %$rels) {
add_to_fields_at($sqlt->get_table($tbl_name), $_)
for values %{$rels->{$tbl_name}};
}
return;
} # sub filter
1;