File Coverage

blib/lib/Class/DBI/Frozen/301/Relationship.pm

Criterion	Covered	Total	%
statement	35	38	92.1
branch	3	4	75.0
condition			n/a
subroutine	10	12	83.3
pod	0	4	0.0
total	48	58	82.7

package Class::DBI::Relationship;

use strict;
use warnings;

use base 'Class::Accessor';

__PACKAGE__->mk_accessors(qw/name class accessor foreign_class args/);

sub set_up {
	my $proto = shift;
	my $self  = $proto->_init(@_);
	$self->_set_up_class_data;
	$self->_add_triggers;
	$self->_add_methods;
	$self;
}

sub _init {
	my $proto = shift;
	my $name  = shift;
	my ($class, $accessor, $foreign_class, $args) = $proto->remap_arguments(@_);
	return $proto->new({
			name          => $name,
			class         => $class,
			foreign_class => $foreign_class,
			accessor      => $accessor,
			args          => $args,
		});
}

sub remap_arguments {
	my $self = shift;
	return @_;
}

sub _set_up_class_data {
	my $self = shift;
	$self->class->_extend_meta($self->name => $self->accessor => $self);
}

sub triggers { () }

sub _add_triggers {
	my $self = shift;

	# need to treat as list in case there are multiples for the same point.
	my @triggers = $self->triggers or return;
	while (my ($point, $subref) = (splice @triggers, 0, 2)) {
		$self->class->add_trigger($point => $subref);
	}
}

sub methods { () }

sub _add_methods {
	my $self    = shift;
	my %methods = $self->methods or return;
	my $class   = $self->class;
	no strict 'refs';
	foreach my $method (keys %methods) {
		*{"$class\::$method"} = $methods{$method};
	}
}

1;

__END__