The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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;