File Coverage

blib/lib/Alzabo/Runtime/Row.pm

Criterion	Covered	Total	%
statement	46	132	34.8
branch	1	30	3.3
condition	1	15	6.6
subroutine	16	30	53.3
pod	4	9	44.4
total	68	216	31.4

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;

    logic_exception "Can only call make_live on potential rows"
        unless $self->{state}->is_potential;

    my %p = @_;

    my %values;
    foreach ( $self->table->columns )
    {
        next unless exists $p{values}->{ $_->name } || exists $self->{data}->{ $_->name };
        $values{ $_->name } = ( exists $p{values}->{ $_->name } ?
                                $p{values}->{ $_->name } :
                                $self->{data}->{ $_->name } );
    }

    my $table = $self->table;
    delete @{ $self }{keys %$self}; # clear out everything

    $table->insert( @_,
                    potential_row => $self,
                    %values ? ( values => \%values ) : (),
                  );
}

sub _cached_data_is_same
{
    my $self = shift;
    my ( $key, $val ) = @_;

    # The convolutions here are necessary to avoid avoid treating
    # undef as being equal to 0 or ''.  Stupid NULLs.
    return 1
        if ( exists $self->{data}{$key} &&
             ( ( ! defined $val && ! defined $self->{data}{$key} ) ||
               ( defined $val &&
                 defined $self->{data}{$key} &&
                 ( $val eq $self->{data}{$key} )
               )
             )
           );

    return 0;
}

sub _no_such_row_error
{
    my $self = shift;

    my $err = 'Unable to find a row in ' . $self->table->name . ' where ';
    my @vals;
    while ( my( $k, $v ) = each %{ $self->{pk} } )
    {
        $v = '' unless defined $v;
        my $val = "$k = $v";
        push @vals, $val;
    }
    $err .= join ', ', @vals;

    no_such_row_exception $err;
}

sub STORABLE_freeze
{
    my $self = shift;
    my $cloning = shift;

    my %data = %$self;

    my $table = delete $data{table};

    $data{schema} = $table->schema->name;
    $data{table_name} = $table->name;

    my $ser = eval { Storable::nfreeze(\%data) };

    storable_exception $@ if $@;

    return $ser;
}

sub STORABLE_thaw
{
    my ( $self, $cloning, $ser ) = @_;

    my $data = eval { Storable::thaw($ser) };

    storable_exception $@ if $@;

    %$self = %$data;

    my $s = Alzabo::Runtime::Schema->load_from_file( name => delete $self->{schema} );
    $self->{table} = $s->table( delete $self->{table_name} );

    return $self;
}

BEGIN
{
    # dumb hack to fix bugs in Storable 2.00 - 2.03 w/ a non-threaded
    # Perl
    #
    # Basically, Storable somehow screws up the hooks business the
    # _first_ time an object from a class with hooks is stored.  So
    # we'll just _force_ it do it once right away.
    if ( $Storable::VERSION >= 2 && $Storable::VERSION <= 2.03 )
    {
        eval <<'EOF';
        { package ___name; sub name { 'foo' } }
        { package ___table;  @table::ISA = '___name'; sub schema { bless {}, '___name' } }
        my $row = bless { table => bless {}, '___table' }, __PACKAGE__;
        Storable::thaw(Storable::nfreeze($row));
EOF
    }
}


1;

__END__