File Coverage

blib/lib/Kelp/Module/ValidateTiny.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	14	22	63.6
condition	12	15	80.0
subroutine	11	11	100.0
pod	1	1	100.0
total	100	111	90.0

{
package Kelp::Module::ValidateTiny;

use Kelp::Base 'Kelp::Module';

use Validate::Tiny;

use Class::Load;
use Sub::Install;

our $VERSION = '0.04';

# These are Validate::Tiny functions that we
# forward into the application namespace

my @forward_ok = qw{
    filter
    is_required
    is_required_if
    is_equal
    is_long_between
    is_long_at_least
    is_long_at_most
    is_a
    is_like
    is_in
};

sub build {

    my ($self, %args) = @_;

    my @import;
    # Imported from Validate::Tiny?
    if (%args &&
        exists $args{subs}) {

            @import = @{$args{subs}};
        }

    @import = @forward_ok if (@import && $import[0] eq ':all');

    # Namespaces to import into (default is our App)
    # If our App name is Kelp, we are probably running
    # from a standalone script and our classname is main

    my $class = ref $self->app;
    $class = 'main' if ($class eq 'Kelp');
    my @into = ($class);

    if (%args &&
        exists $args{into}) {

            push @into, @{$args{into}};
        }

    # Import!
    foreach (@into) {

        my $class = $_;

        Class::Load::load_class($class)
          unless Class::Load::is_class_loaded($class);

        foreach (@import) {

            Sub::Install::install_sub({
                code => Validate::Tiny->can($_),
                from => 'Validate::Tiny',
                into => $class,
            });
        }
    }

    # Register a single method - self->validate
    $self->register(
        validate => \&_validate
    );
}

sub _validate {

    my $self = shift;
    my $rules = shift;
    my %args = @_;

    # Combine all params
    # TODO: check if mixed can be avoided
    # on the Hash::Multivalue "parameters"

    my $input = {
        %{$self->req->parameters->mixed},
        %{$self->req->named}
    };

    my $result = Validate::Tiny->new($input, $rules);

    return $result if (
       $result->success || (!(%args && exists $args{on_error}))
    );

    # There are errors and a template is passed

    my $data = $result->data;
    $data->{error} = $result->error;

    if (exists $args{data}) {
        $data = {
            %$data,
            %{$args{data}},
        };
    }

    return Validate::Tiny::PlackResponse->new(
        $result,
        $self->res->template($args{on_error}, $data)
    );
}

}


{
	package Validate::Tiny::PlackResponse;

	use parent Validate::Tiny;
	use Scalar::Util qw{blessed refaddr};

	my %_response;

	sub new {

		my ($class, $obj, $response) = @_;

        die "Incorrect Parent Class. Not an instance of Validate::Tiny"
          unless blessed($obj) eq 'Validate::Tiny';

        $_response{refaddr $obj} = $response;

        bless $obj, $class;

        return $obj;
	}

	sub response {

		my $self = shift;
        die "Incorrect Parent Class. Not an instance of Validate::Tiny::PlackResponse"
          unless blessed($self) eq 'Validate::Tiny::PlackResponse';

        return $_response{refaddr $self};
	}

	sub DESTROY {

		my $self = shift;

		my $key = refaddr $self;
		delete $_response{$key} if exists $_response{$key};

        $self->SUPER::DESTROY if $self->SUPER::can(DESTROY);
	}
}

1;
__END__