File Coverage

blib/lib/MooX/ValidateSubs.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	24	24	100.0
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	91	91	100.0

package MooX::ValidateSubs;

use strict;
use warnings;

use MooX::ReturnModifiers;
use B;
our $VERSION = '1.012010';

sub import {
	my $target	= caller;
	my %modifiers = return_modifiers($target, [qw/has with around sub/]);

	my $raise_context_error = sub {
		my ($error, $c) = @_;
		if (ref $error) {
			my $gv = B::svref_2object($c)->GV;
			$error->{context}->{file} = $gv->FILE . '::' . $gv->NAME;
			$error->{context}->{line} = $gv->LINE;
		}
		die $error;
	};

	my $validate_subs = sub {
		my @attr = @_;
		while (@attr) {
			my @names = ref $attr[0] eq 'ARRAY' ? @{ shift @attr } : shift @attr;
			my $spec = shift @attr;
			for my $name (@names) {
				my $store_spec = sprintf '%s_spec', $name;
				$modifiers{has}->( $store_spec => ( is => 'ro', default => sub { $spec } ) );
				unless ( $name =~ m/^\+/ ) {
					$modifiers{around}->(
						$name,
						sub {
							my ( $orig, $self, @params ) = @_;
							my @caller = caller;

							if (! ref $self) {
								$self = $self->new;
							}

							my $current_spec = $self->$store_spec;

							if ( my $param_spec = $current_spec->{params} ) {
								@params = eval { $self->_validate_sub(
									$name, 'params', $param_spec, @params
								) };
								if ($@) {
									$raise_context_error->($@, $orig);
								}
							}

							if (my $keys = $current_spec->{keys}) {
								my $hash = scalar @params > 1 ? { @params } : $params[0];
								@params = map { $hash->{$_} } @{ $keys };
							}

							@params = $self->$orig(@params);

							if ( my $param_spec = $current_spec->{returns} ) {
								@params = eval { $self->_validate_sub(
									$name, 'returns', $param_spec, @params
								) };
								if ($@) {
									$raise_context_error->($@, $orig);
								}
							}

							return wantarray ? @params : shift @params;
						}
					);
				}
			}
		}
	};

	$target->can('_validate_sub') or $modifiers{with}->('MooX::ValidateSubs::Role');

	$modifiers{sub}->('validate_subs', $validate_subs);

	return 1;
}

1;

__END__