File Coverage

blib/lib/Sidekick/Check.pm

Criterion	Covered	Total	%
statement	15	27	55.5
branch	0	6	0.0
condition			n/a
subroutine	5	8	62.5
pod	3	3	100.0
total	23	44	52.2

#!/usr/bin/perl
package Sidekick::Check;
{
  $Sidekick::Check::VERSION = '0.0.1';
}

use v5.10;

use strict;
use warnings;

use Module::Pluggable::Object ();

my $package = __PACKAGE__;

# for internal functions
my $parse_args;

sub new { return $package; }

sub is { return 0 + !( shift->errors( @_ ) ); }

sub errors {
    my $self   = shift;
    my $value  = shift;
    my @checks = @_;
    my @errors;

    for my $check ( @checks ) {
        my ($method, $name, @args) = $check->$parse_args( $value );
        next if $self->$method( @args );
        push @errors, $name;
        last unless wantarray;
    }

    return wantarray ? @errors : shift @errors;
}

# dinamically add is_* methods based on plugins
my $finder = Module::Pluggable::Object->new(
        'package' => $package, 'require' => 1,
    );

{
    no strict 'refs';
    for my $plugin ( $finder->plugins ) {
        my $check = $plugin->can('check')
            || next;
        my $method = join( '::', ( split '::', lc $plugin )[3,] );
        *{ sprintf '%s::is_%s', $package, $method } = $check;
    }
}

# internal functions

$parse_args = sub {
    my $method = shift;
    my $value  = shift;
    my $name   = shift;
    my @args;

    given ( ref $method ) {
        when ( 'ARRAY' ) {
            ($method, @args) = @{ $method };
            return $method->$parse_args( $value, undef, @args );
        }
        when ( 'HASH' ) {
            ($method, $name, my $args) = @{ $method }{ qw(is name args) };
            return $method->$parse_args( $value, $name, $args || ()  );
        }
        when ( 'CODE'  ) { }
        when ( '' ) {
            $name   ||= $method;
            $method   = join( '_', 'is', $method );
        }
        default {
            die 'unssupported'
        }
    }

    return ( $method, $name, $value, @args );
};

1;
# ABSTRACT: Plugin based validation mechanism
# vim:ts=4:sw=4:syn=perl

__END__