File Coverage

blib/lib/Rope/Factory.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	14	16	87.5
condition			n/a
subroutine	11	11	100.0
pod			n/a
total	74	76	97.3

package Rope::Factory;

use strict; use warnings;
use Factory::Sub;
use Coerce::Types::Standard;
use Rope::Pro;

my (%PRO);

BEGIN {
	%PRO = Rope::Pro->new;
}

sub import {
	my ($caller, $pkg, @types) = (scalar caller, @_);
	if (@types) {
		Coerce::Types::Standard->import::into($caller, @types)
	}
	$PRO{keyword}($caller, 'factory', sub {
		my ($name, @factory) = @_;
		my ($meta, $ind, $fact, $exists, $extends) = (
			Rope->get_meta($caller),
			(! ref $factory[0] ? shift @factory : 0)
		);
		if ($meta->{properties}->{$name}) {
			if ($meta->{properties}->{$name}->{fact}->[$ind]) {
				$fact = $meta->{properties}->{$name}->{fact}->[$ind];
				$exists = 1;
			} else {
				$fact = Factory::Sub->new();
				$extends = 1;
			}
		} else {
			$fact = Factory::Sub->new();
		}
		while (@factory) {
			my ($check, $cb) = (shift(@factory), shift(@factory));
			if (ref $check eq 'CODE') {
				unshift @factory, $cb if $cb;
				$fact->add($check);
			} else {
				$fact->add(sub { $_[0];  }, @{$check}, $cb);
			}
		}
		if ($extends) {
			Rope->clear_property($caller, $name);
			my $prop = $meta->{properties}->{$name};
			push @{$prop->{fact}}, $fact;
			push @{$prop->{after}}, sub { $fact->(@_) };
			$caller->property($name, %{$prop});
		} elsif (!$exists) {
			$caller->property($name,
				value => sub { $fact->(@_) },
				initable => 0,
				enumerable => 0,
				writeable => 0,
				fact => [$fact]
			);
		}
	});
}

1;

__END__