File Coverage

blib/lib/Class/AlzaboWrapper.pm

Criterion	Covered	Total	%
statement	27	101	26.7
branch	1	24	4.1
condition	0	6	0.0
subroutine	9	24	37.5
pod	11	11	100.0
total	48	166	28.9

package Class::AlzaboWrapper;

use strict;

use vars qw($VERSION);

$VERSION = '0.14';

use Class::AlzaboWrapper::Cursor;

use Exception::Class ( qw( Class::AlzaboWrapper::Exception Class::AlzaboWrapper::Exception::Params ) );
Class::AlzaboWrapper::Exception->Trace(1);
Class::AlzaboWrapper::Exception::Params->Trace(1);

use Params::Validate qw( validate validate_pos validate_with SCALAR UNDEF ARRAYREF HASHREF );
Params::Validate::validation_options
    ( on_fail =>
      sub { Class::AlzaboWrapper::Exception::Params->throw
                ( message => join '', @_ ) } );

my %TableToClass;
my %ClassToTable;
my %ClassAttributes;

BEGIN
{
    foreach my $meth ( qw( select update delete is_live ) )
    {
        my $sub = sub { shift->row_object->$meth(@_) };

        no strict 'refs';
        *{ __PACKAGE__ . "::$meth" } = $sub;
    }
}

sub import
{
    my $class = shift;

    # called via 'use base'
    return unless @_;

    my %p =
        validate_with( params => \@_,
                       spec   =>
                       { caller => { type    => SCALAR,
                                     default => (caller(0))[0] },
                         base   => { type    => SCALAR,
                                     default => __PACKAGE__ },
                       },
                       allow_extra => 1,
                     );

    my $base = delete $p{base};
    eval "package $p{caller}; use base '$base'";

    $class->_make_methods(%p);
}

sub _make_methods
{
    my $class = shift;

    my %p = validate( @_,
                      { skip   => { type => SCALAR | ARRAYREF, default => [] },
                        table  => { isa => 'Alzabo::Table' },
                        caller => { type => SCALAR, default => $class },
                      }
                    );

    my $caller = delete $p{caller};

    $caller->SetAlzaboTable( delete $p{table} );
    $caller->MakeColumnMethods(%p);
}

sub SetAlzaboTable
{
    my $class = shift;
    my ($table) = validate_pos( @_, { isa => 'Alzabo::Table' } );

    $TableToClass{ $table->name } = $class;
    $ClassToTable{$class} = $table;
}

sub Table
{
    my $class = ref $_[0] || $_[0];

    Class::AlzaboWrapper::Exception->throw
        ( error => "Must call SetTable() before calling Table() on $class" )
            unless $ClassToTable{$class};

    return $ClassToTable{$class};

}
# deprecated
*table = \&Table;

sub MakeColumnMethods
{
    my $class = shift;
    my %p = validate( @_,
                      { skip   => { type => SCALAR | ARRAYREF, default => [] },
                      }
                    );

    my %skip = map { $_ => 1 } ref $p{skip} ? @{ $p{skip} } : $p{skip};

    my $table = $class->Table;
    foreach my $name ( map { $_->name } $table->columns )
    {
        next if $skip{$name};

        $class->_RecordAttributeCreation( $class => $name );

        my $cache_key = '__cache__' . $name;

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

                        return $self->{$cache_key}
                            if exists $self->{$cache_key};

                        $self->{$cache_key} = $self->row_object->select($name);
                      };

        no strict 'refs';
        *{"$class\::$name"} = $sub;
    }
}

sub _RecordAttributeCreation { push @{ $ClassAttributes{ $_[1] } }, $_[2] }
# deprecated
*_record_attribute_creation = \&_RecordAttributeCreation;

sub new
{
    my $class = shift;

    my @pk = $class->table->primary_key;

    my @pk_spec =
        map { $_->name => { type => SCALAR | UNDEF, optional => 1 } } @pk;

    my %p =
        validate_with( params => \@_,
                       spec =>
                       { object =>
                         { isa => 'Alzabo::Runtime::Row', optional => 1 },
                         @pk_spec,
                       },
                       allow_extra => 1,
                     );

    my %pk;
    foreach my $col (@pk)
    {
        if ( exists $p{ $col->name } )
        {
            $pk{ $col->name } = $p{ $col->name };
        }
    }

    my $row;
    if ( keys %pk == @pk )
    {
        $row = eval { $class->table->row_by_pk( pk => \%pk ) };
    }
    elsif ( exists $p{object} )
    {
        $row = $p{object};
    }
    else
    {
        $row = $class->_new_row(%p) if $class->can('_new_row');
    }

    return unless $row;

    my $self = bless { row => $row }, $class;

    $self->_init(%p) if $self->can('_init');

    return $self;
}

sub create
{
    my $class = shift;
    my %p = @_;

    my %values;

    for my $c ( map { $_->name } $class->table->columns )
    {
        $values{$c} = delete $p{$c} if exists $p{$c};
    }

    my $row =
        $class->table->insert
            ( values => \%values );

    return $class->new( object => $row, %p );
}

sub potential
{
    my $class = shift;

    return
        $class->new( object => $class->table->potential_row( values => {@_} ) );
}

sub Columns { shift->table->columns(@_) }
*Column = \&Columns;
# deprecated
*columns = \&Columns;
*column = \&Columns;

sub NewCursor
{
    my $self = shift;
    my $cursor = shift;

    return
        Class::AlzaboWrapper::Cursor->new
            ( cursor => $cursor );
}
# deprecated
*cursor = \&NewCursor;


sub TableToClass { $TableToClass{ $_[1]->name } }
# deprecated
*table_to_class = \&TableToClass;

sub AlzaboAttributes
{
    my $class = ref $_[0] || $_[0];

    @{ $ClassAttributes{$class} };
}
# deprecated
*alzabo_attributes = \&AlzaboAttributes;

sub row_object { $_[0]->{row} }


1;

__END__