view release on metacpan or  search on metacpan

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

package Alzabo::Runtime::Row;

use strict;
use vars qw($VERSION);

use Alzabo;

use Alzabo::Exceptions ( abbr => [ qw( logic_exception no_such_row_exception
                                       params_exception storable_exception ) ] );

use Alzabo::Runtime;
use Alzabo::Runtime::RowState::Deleted;
use Alzabo::Runtime::RowState::Live;
use Alzabo::Runtime::RowState::Potential;
use Alzabo::Utils;

use Params::Validate qw( validate validate_with UNDEF SCALAR HASHREF BOOLEAN );
Params::Validate::validation_options
    ( on_fail => sub { params_exception join '', @_ } );

use Storable ();

$VERSION = 2.0;

BEGIN
{
    no strict 'refs';
    foreach my $meth ( qw( select select_hash update refresh delete
                           id_as_string is_live is_potential is_deleted ) )
    {
        *{ __PACKAGE__ . "::$meth" } =
            sub { my $s = shift;
                  $s->{state}->$meth( $s, @_ ) };
    }
}

use constant NEW_SPEC => { table => { isa => 'Alzabo::Runtime::Table' },
                           pk    => { type => SCALAR | HASHREF,
                                      optional => 1,
                                    },
                           prefetch => { type => UNDEF | HASHREF,
                                         optional => 1,
                                       },
                           state => { type => SCALAR,
                                      default => 'Alzabo::Runtime::RowState::Live',
                                    },
                           potential_row => { isa => 'Alzabo::Runtime::Row',
                                              optional => 1,
                                            },
                           values => { type => HASHREF,
                                       default => {},
                                     },
                           no_cache => { type => BOOLEAN, default => 0 },
                         };

sub new
{
    my $proto = shift;
    my $class = ref $proto || $proto;

    my %p =
        validate( @_, NEW_SPEC );

    my $self = $p{potential_row} ? $p{potential_row} : {};

    bless $self, $class;

    $self->{table} = $p{table};
    $self->{state} = $p{state};

    $self->{state}->_init($self, @_) or return;

    return $self;
}

sub table
{
    my $self = shift;

    return $self->{table};
}

sub schema
{
    my $self = shift;

    return $self->table->schema;
}

sub set_state { $_[0]->{state} = $_[1] };

use constant ROWS_BY_FOREIGN_KEY_SPEC => { foreign_key => { isa => 'Alzabo::ForeignKey' } };

sub rows_by_foreign_key
{
    my $self = shift;
    my %p = validate_with( params => \@_,
                           spec   => ROWS_BY_FOREIGN_KEY_SPEC,
                           allow_extra => 1,
                         );

    my $fk = delete $p{foreign_key};

    if ($p{where})
    {
        $p{where} = [ $p{where} ] unless Alzabo::Utils::is_arrayref( $p{where}[0] );
    }

    push @{ $p{where} },
        map { [ $_->[1], '=', $self->select( $_->[0]->name ) ] } $fk->column_pairs;

    # if the relationship is not 1..n, then only one row can be
    # returned (or referential integrity has been hosed in the
    # database).
    return $fk->is_one_to_many ? $fk->table_to->rows_where(%p) : $fk->table_to->one_row(%p);
}

# class method
sub id_as_string_ext
{
    my $class = shift;
    my %p = @_;
    my $id_hash = $class->_make_id_hash(%p);

    local $^W; # weirdly, enough there are code paths that can
    # lead here that'd lead to $id_hash having some
    # values that are undef
    return join ';:;_;:;', ( $p{table}->schema->name,
                             $p{table}->name,
                             map { $_, $id_hash->{$_} } sort keys %$id_hash );
}

sub _make_id_hash
{
    my $self = shift;
    my %p = @_;

    return $p{pk} if ref $p{pk};

    return { ($p{table}->primary_key)[0]->name => $p{pk} };
}

sub _update_pk_hash
{
    my $self = shift;

    my @pk = keys %{ $self->{pk} };

    @{ $self->{pk} }{ @pk } = @{ $self->{data} }{ @pk };

    delete $self->{id_string};
}

sub make_live
{
    my $self = shift;