Fey::FK - Represents a foreign key

  my $fk = Fey::FK->new( source => $user_id_from_user_table,
                         target => $user_id_from_department_table,
                       );

  User      Message
  -------   -------
  user_id   user_id

  The Artistic License 2.0 (GPL Compatible)

package Fey::FK;
BEGIN {
  $Fey::FK::VERSION = '0.40';
}

use strict;
use warnings;
use namespace::autoclean;

use Fey::Column;
use Fey::Exceptions qw(param_error);
use Fey::Types qw(  ArrayRef ArrayRefOfColumns Bool Column TableOrName );
use List::AllUtils qw( max uniq all pairwise );
use Scalar::Util qw( blessed );

use Moose;
use MooseX::Params::Validate qw( pos_validated_list );
use MooseX::SemiAffordanceAccessor;
use MooseX::StrictConstructor;
use Moose::Util::TypeConstraints;

has 'id' => (
    is         => 'ro',
    lazy_build => 1,
    init_arg   => undef,
);

has [qw( source_columns target_columns )] => (
    is       => 'ro',
    isa      => ArrayRefOfColumns,
    required => 1,
    coerce   => 1,
);

has [qw( source_table target_table )] => (
    is         => 'ro',
    does       => 'Fey::Role::TableLike',
    lazy_build => 1,
    init_arg   => undef,
);

has column_pairs => (
    is => 'ro',

    # really, the inner array refs must always contain 2 columns,
    # but we don't have structured constraints quite yet.
    isa        => ArrayRef[ArrayRef[Column]],
    lazy_build => 1,
    init_arg   => undef,
);

has is_self_referential => (
    is         => 'ro',
    isa        => Bool,
    lazy_build => 1,
    init_arg   => 1,
);

sub BUILD {
    my $self = shift;
    my $p    = shift;

    my @source = @{ $self->source_columns() };
    my @target = @{ $self->target_columns() };

    unless ( @source == @target ) {
        param_error(
                  "The source and target arrays passed to add_foreign_key()"
                . " must contain the same number of columns." );
    }

    if ( grep { !$_->table() } @source, @target ) {
        param_error
            "All columns passed to add_foreign_key() must have a table.";
    }

    for my $p ( [ source => \@source ], [ target => \@target ] ) {
        my ( $name, $array ) = @{$p};
        if ( uniq( map { $_->table() } @{$array} ) > 1 ) {
            param_error(
                      "Each column in the $name argument to add_foreign_key()"
                    . " must come from the same table." );
        }
    }

    return;
}

sub _build_id {
    my $self = shift;

    return join "\0",
        (
        sort
            map { $_->table()->name() . q{.} . $_->name() }
            @{ $self->source_columns() }, @{ $self->target_columns() }
        );
}

sub _build_column_pairs {
    my $self = shift;

    my @s = @{ $self->source_columns() };
    my @t = @{ $self->target_columns() };

    return [ pairwise { [ $a, $b ] } @s, @t ];
}

sub _build_source_table {
    my $self = shift;

    return $self->source_columns()->[0]->table();
}

sub _build_target_table {
    my $self = shift;

    return $self->target_columns()->[0]->table();
}

sub has_tables {
    my $self = shift;

    my ( $table1, $table2 ) = pos_validated_list(
        \@_,
        { isa => TableOrName },
        { isa => TableOrName },
    );

    my $name1 = blessed $table1 ? $table1->name() : $table1;
    my $name2 = blessed $table2 ? $table2->name() : $table2;

    my @looking_for = sort $name1, $name2;
    my @have
        = sort map { $_->name() } $self->source_table(),
        $self->target_table();

    return ( $looking_for[0] eq $have[0] && $looking_for[1] eq $have[1] );
}

sub has_column {
    my $self = shift;
    my ($col) = pos_validated_list( \@_, { isa => Column } );

    my $table_name = $col->table()->name();

    my @cols;
    for my $part (qw( source target )) {
        my $table_meth = $part . '_table';
        if ( $self->$table_meth()->name() eq $table_name ) {
            my $col_meth = $part . '_columns';
            @cols = @{ $self->$col_meth() };
        }
    }

    return 0 unless @cols;

    my $col_name = $col->name();

    return 1 if grep { $_->name() eq $col_name } @cols;

    return 0;
}

sub _build_is_self_referential {
    my $self = shift;

    return $self->source_table()->name() eq $self->target_table()->name();
}

sub pretty_print {
    my $self = shift;

    my @source_columns = @{ $self->source_columns() };
    my @target_columns = @{ $self->target_columns() };

    my $longest = max
        map { length $_->name() } $self->source_table(),
        $self->target_table(),
        @source_columns, @target_columns;

    $longest += 2;

    my $string = sprintf(
        "\%-${longest}s  \%-${longest}s\n",
        $self->source_table()->name(),
        $self->target_table()->name(),
    );
    $string .= ('-') x $longest;
    $string .= q{  };
    $string .= ('-') x $longest;
    $string .= "\n";

    $string .= (
        join '',
        pairwise {
            sprintf(
                "\%-${longest}s  \%-${longest}s\n",
                $a->name(), $b->name()
            );
        }
        @source_columns,
        @target_columns
    );

    return $string;
}

__PACKAGE__->meta()->make_immutable();

1;

# ABSTRACT: Represents a foreign key

__END__