File Coverage

blib/lib/Alzabo/Runtime/ForeignKey.pm

Criterion	Covered	Total	%
statement	18	66	27.2
branch	0	22	0.0
condition	0	24	0.0
subroutine	6	12	50.0
pod	3	4	75.0
total	27	128	21.0

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 } ];
            push @one_to_one_vals, $pair->[0]->name . ' = ' . $vals{ $pair->[0]->name };
        }
    }

    if ( $self->is_one_to_one && ! $has_nulls )
    {
        if ( @one_to_one_where &&
             $self->table_from->row_count( where => \@one_to_one_where ) )
        {
            my $err = '(' . (join ', ', @one_to_one_vals) . ') already exists in the ' . $self->table_from->name . ' table';
            Alzabo::Exception::ReferentialIntegrity->throw( error => $err );
        }
    }
}

sub _check_existence
{
    my $self = shift;
    my ($col, $val) = @_;

    unless ( $self->table_to->row_count( where => [ $col, '=', $val ] ) )
    {
        Alzabo::Exception::ReferentialIntegrity->throw( error => 'Foreign key must exist in foreign table.  No rows in ' . $self->table_to->name . ' where ' . $col->name . " = $val" );
    }
}

sub register_delete
{
    my $self = shift;
    my $row = shift;

    my @update = grep { $_->nullable } $self->columns_to;

    return unless $self->to_is_dependent || @update;

    # Find the rows in the other table that are related to the row
    # being deleted.
    my @where = map { [ $_->[1], '=', $row->select( $_->[0]->name ) ] } $self->column_pairs;
    my $cursor = $self->table_to->rows_where( where => \@where );

    while ( my $related_row = $cursor->next )
    {
        # This is a class variable so that multiple foreign key
        # objects don't try to delete the same rows
        next if $DELETED{ $related_row->id_as_string };

        if ($self->to_is_dependent)
        {
            local %DELETED = %DELETED;
            $DELETED{ $related_row->id_as_string } = 1;
            # dependent relationship so delete other row (may begin a
            # chain reaction!)
            $related_row->delete;
        }
        elsif (@update)
        {
            # not dependent so set the column(s) to null
            $related_row->update( map { $_->name => undef } @update );
        }
    }
}

__END__