File Coverage

blib/lib/MooX/ReturnModifiers.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	6	6	100.0
condition	2	2	100.0
subroutine	14	14	100.0
pod	8	8	100.0
total	66	66	100.0

package MooX::ReturnModifiers;

use strict;
use warnings;
use Carp qw/croak/;

our $VERSION = '1.000002';

use Exporter 'import';

our @EXPORT = qw/return_modifiers/;
our @EXPORT_OK = qw/return_modifiers return_has return_with return_around return_extends return_before return_after return_sub/;

sub return_modifiers {
	my $target = shift;
	my %modifiers = ();
	$_[0] ||= [qw/has with around extends before after sub/];
	for ( @{ $_[0] } ) {
		if ($_ eq 'sub') {
			$modifiers{$_} = sub {
				my ($sub, $cb) = @_;
				no strict 'refs';
				*{"${target}::${sub}"} = $cb;
			};
			next;
		}
		unless ( $modifiers{$_} = $target->can($_) ) {
			croak "Can't find method <$_> in <$target>";
		}
	}
	return $_[1] ? \%modifiers : %modifiers;
}

sub return_has {return_modifiers($_[0], [qw/has/], 1)->{has}}

sub return_with {return_modifiers($_[0], [qw/with/], 1)->{with}}

sub return_after {return_modifiers($_[0], [qw/after/], 1)->{after}}

sub return_before {return_modifiers($_[0], [qw/before/], 1)->{before}}

sub return_around {return_modifiers($_[0], [qw/around/], 1)->{around}}

sub return_extends {return_modifiers($_[0], [qw/extends/], 1)->{extends}}

sub return_sub {return_modifiers($_[0], [qw/sub/], 1)->{sub}}

1;

__END__