view release on metacpan or  search on metacpan

lib/Alzabo/Runtime/ForeignKey.pm  view on Meta::CPAN

package Alzabo::Runtime::ForeignKey;

use strict;
use vars qw( $VERSION %DELETED );

use Alzabo::Runtime;
use Alzabo::Exceptions ( abbr => 'params_exception' );

use Params::Validate qw( validate ARRAYREF OBJECT );
Params::Validate::validation_options
    ( on_fail => sub { params_exception join '', @_ } );

use base qw(Alzabo::ForeignKey);

$VERSION = 2.0;

1;

# FIXME - needs docs
sub new
{
    my $proto = shift;
    my $class = ref $proto || $proto;

    validate( @_, { columns_from => { type => ARRAYREF | OBJECT },
                    columns_to   => { type => ARRAYREF | OBJECT },
                  } );
    my %p = @_;

    my $self = bless {}, $class;

    # XXX - needs a little more validation, like that both "sides"
    # have the same number of columns
    $self->{columns_from} = $p{columns_from};
    $self->{columns_to}   = $p{columns_to};

    return $self;
}

sub register_insert
{
    shift->_insert_or_update( 'insert', @_ );
}

sub register_update
{
    shift->_insert_or_update( 'update', @_ );
}

sub _insert_or_update
{
    my $self = shift;
    my $type = shift;
    my %vals = @_;

    my $driver = $self->table_from->schema->driver;

    my @one_to_one_where;
    my @one_to_one_vals;

    my $has_nulls = grep { ! defined } values %vals;

    foreach my $pair ( $self->column_pairs )
    {
        # if we're inserting into a table we don't check if its primary
        # key exists elsewhere, no matter what the cardinality of the
        # relation.  Otherwise, we end up in cycles where it is impossible
        # to insert things into the table.
        next if $type eq 'insert' && $pair->[0]->is_primary_key;

        # A table is always allowed to make updates to its own primary
        # key columns ...
        if ( ( $type eq 'update' || $pair->[1]->is_primary_key )
             && ! $pair->[0]->is_primary_key )
        {
            $self->_check_existence( $pair->[1] => $vals{ $pair->[0]->name } )
                if defined $vals{ $pair->[0]->name };
        }

        # Except when the PK has a one-to-one relationship to some
        # other table, and the update would cause a duplication in the
        # other table.
        if ( $self->is_one_to_one && ! $has_nulls )
        {
            push @one_to_one_where, [ $pair->[0], '=', $vals{ $pair->[0]->name } ];