File Coverage

blib/lib/DBIx/Lite/Schema.pm

Criterion	Covered	Total	%
statement	39	42	92.8
branch	8	14	57.1
condition	4	9	44.4
subroutine	7	7	100.0
pod	3	3	100.0
total	61	75	81.3

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

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

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

    my $self = {
        tables => {},
    };

    if (my $tables = delete $params{tables}) {
        foreach my $table_name (keys %$tables) {
            $tables->{$table_name}{name} = $table_name;
            $self->{tables}{$table_name} = DBIx::Lite::Schema::Table->new($tables->{$table_name});
        }
    }

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

    bless $self, $class;
    $self;
}

sub table {
    my $self = shift;
    my $table_name = shift;
    $self->{tables}{$table_name} ||= DBIx::Lite::Schema::Table->new(name => $table_name);
    return $self->{tables}{$table_name};
}

sub one_to_many {
    my $self = shift;
    my ($from, $to, $accessors) = @_;

    $from && $from =~ /^(.+)\.(.+)$/
        or croak "Relationship keys must be defined in table.column format";
    my $from_table = $self->table($1);
    my $from_key = $2;

    $to && $to =~ /^(.+)\.(.+)$/
        or croak "Relationship keys must be defined in table.column format";
    my $to_table = $self->table($1);
    my $to_key = $2;

    my $from_table_accessor = $to_table->{name};
    my $to_table_accessor;
    if ($accessors) {
        if (ref $accessors eq 'ARRAY') {
            ($from_table_accessor, $to_table_accessor) = @$accessors;
        } else {
            $to_table_accessor = $accessors;
        }
    }

    $from_table->{has_many}{ $from_table_accessor } = [ $to_table->{name}, { $from_key => $to_key } ];
    $to_table->{has_one}{ $to_table_accessor } = [ $from_table->{name}, { $to_key => $from_key } ]
        if $to_table_accessor;
}

1;

__END__