File Coverage

blib/lib/Nefarious.pm

Criterion	Covered	Total	%
statement	69	69	100.0
branch	16	18	88.8
condition	5	5	100.0
subroutine	20	20	100.0
pod	0	4	0.0
total	110	116	94.8

package Nefarious;
use 5.006; use strict; use warnings;
use Factory::Sub; use Tie::IxHash; our %META;
our $VERSION = '0.04';

BEGIN {
	tie %META, 'Tie::IxHash';
}

sub import {
	my ($pkg, $nefarious) = @_;
	nefarious($nefarious);
}

sub nefarious {
	my ($nefarious) = @_;
	for my $package ( keys %{ $nefarious }) {
		parse_meta($package, $nefarious->{$package});
	}
	create_packages();
}

sub parse_meta {
	my ($name, $package) = @_;
	$META{$name} = {} if (! $META{$name} );
	for my $key (keys %{ $package }) {
		my $ref = ref $package->{$key};
		if (!$ref) {
			if ($key eq 'EXTENDS') {
				$META{$name}{$key} = $package->{$key};
			} else {
				$META{$name}{$key} = sub { $package->{$key} };
			}
		} elsif ($ref eq 'CODE') {
			$META{$name}{$key} = $package->{$key};
		} elsif ($ref eq 'ARRAY') {
			my $factory = Factory::Sub->new();
			for my $fact (reverse @{ $package->{$key} }) {
				$factory->add(sub { return $_[0]; }, (ref $fact eq 'ARRAY' ? @{ $fact } : $fact));
			}
			$META{$name}{$key} = sub { return $factory->(@_) };
		} elsif ($ref eq 'HASH') {
			$package->{$key}->{EXTENDS} = $name;
			parse_meta($key, $package->{$key});
		}
	}
}

sub create_packages {
	for my $pkg ( keys %META ) {
		create_package($pkg, $META{$pkg});
	}
}


sub create_package {
	my ($name, $package) = @_;
	my $extends = delete $package->{EXTENDS} || "";
	$extends = qq|use base '$extends';| if ($extends);
	$package->{new} = sub { bless {}, shift } if (! $package->{new} && ! $extends);
	my $p = qq|
		package $name;
		use strict;
		use warnings;
		$extends
		1;
	|;
	eval $p;
	no strict 'refs';
	no warnings 'redefine';
	for my $method (keys %{$package}) {
		*{"${name}::$method"} = sub { $package->{$method}->(@_) }
	}
}

1;

__END__