File Coverage

blib/lib/DBIx/Lite/Schema/Table.pm

Criterion	Covered	Total	%
statement	68	73	93.1
branch	16	28	57.1
condition	1	2	50.0
subroutine	13	13	100.0
pod	5	5	100.0
total	103	121	85.1

package DBIx::Lite::Schema::Table;
$DBIx::Lite::Schema::Table::VERSION = '0.36';
use strict;
use warnings;

use Carp qw(croak);
$Carp::Internal{$_}++ for __PACKAGE__;

sub new {
    my $class = shift;
    my (%params) = @_;

    my $self = {
        class           => undef,
        resultset_class => undef,
        pk              => delete $params{pk} || [],
        has_many        => {},
        has_one         => {},
    };

    for (qw(name)) {
        $self->{$_} = delete $params{$_} or croak "$_ argument needed";
    }

    if ($self->{autopk} = delete $params{autopk}) {
        !ref $self->{autopk} or croak "autopk only accepts a single column";
        $self->{pk} = [$self->{autopk}];
    }

    !%params
        or croak "Unknown options: " . join(', ', keys %params);

    bless $self, $class;
    $self;
}

sub pk {
    my $self = shift;
    my @cols = @_;

    if (@cols) {
        $self->{pk} = [
            grep defined $_,
                map { (ref $_ eq 'ARRAY') ? @$_ : $_ } @cols
        ];
        return $self;
    }
    return @{$self->{pk}};
}

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

    if ($val) {
        $self->{autopk} = $val;
        $self->{pk} = [$val];
        return $self;
    }
    return $self->{autopk};
}

sub class {
    my ($self, $class, $constructor, $storage) = @_;

    $self->{class} = $class;
    $self->{class_constructor} = $constructor;
    $self->{class_storage} = $storage;

    return undef if !$class;

    # make the custom class inherit from our base
    if (!$class->isa('DBIx::Lite::Row')) {
        no strict 'refs';
        push @{"${class}::ISA"}, 'DBIx::Lite::Row';
    }

    # install the storage provider
    if ($storage) {
        no strict 'refs';
        no warnings 'redefine';
        *{ "${class}::__dbix_lite_row_storage" } = sub {
            my ($row) = @_;

            croak "$class does not provide a $storage method"
                if !$row->can($storage);

            return $row->$storage;
        };
    }

    return $class;
}

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

    if ($class) {
        $self->{resultset_class} = $class;
        return $self;
    }

    $class =  $self->{resultset_class};
    return undef if !$class;

    # make the custom class inherit from our base
    if (!$class->isa('DBIx::Lite::ResultSet')) {
        no strict 'refs';
        push @{"${class}::ISA"}, 'DBIx::Lite::ResultSet';
    }

    return $class;
}

1;

__END__