Params::Validate::Micro - Validate parameters concisely

  use Params::Validate::Micro qw(:all);
  use Params::Validate::Micro qw(micro_validate micro_translate);

  my %spec = micro_translate($string, $extra);

  my $arg = micro_validate(\%arg,  $string, $extra);
  my $arg = micro_validate(\@args, $string, $extra);

  micro_validate({ a => 1 }, q{$a; $b});
  micro_validate([ 1 ], q{$a; $b});

  { a => 1 }

package Params::Validate::Micro;

use strict;
use warnings;
use Params::Validate qw(:all);
use Scalar::Util qw(reftype);
use Carp qw(croak confess);

require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
  all => [qw(micro_validate micro_translate)],
);
our @EXPORT_OK = (@{ $EXPORT_TAGS{all} });

our $VERSION = '0.032';

my $BARE_VAR  = qr/[a-z_]\w*/i;

my $SIGIL_VAR = qr/[%\$\@]?$BARE_VAR/i;

my $EXTRACT_VARS = qr/\A 
                                            (
                                                (?: \s* ; \s*)?
                                                $SIGIL_VAR
                                                (?: 
                                                    (?: \s* ; )? 
                                                    \s+ $SIGIL_VAR
                                                )*
                                            )?
                                            \z/x;

my %PVSPEC = (
  '%' => {
    type => HASHREF,
  },
  '@' => {
    type => ARRAYREF,
  },
  '$' => {
    type => SCALAR | OBJECT,
  },
);

my ($SIGIL) = map { qr/$_/ } '[' . join("", keys %PVSPEC) . ']';

sub micro_translate {
  my ($string, $extra) = @_;
  $string =~ s/^\s*//;
  $string =~ s/\s*$//;
  croak "'$string' does not appear to be a micro-spec"
    unless $string =~ $EXTRACT_VARS;

  # maybe they want to say "no args at all"
  return unless defined $1;

  my @vspecs = grep {
    length($_)
  } map {
    # make sure that semicolons are their own 'word'
    s/;/ ; /g;
    split /\s+/;
  } $string =~ $EXTRACT_VARS;

  my $optional;
  my @spec;
  for my $vspec (@vspecs) {
    if ($vspec eq ';') {
      if ($optional++) {
        croak "micro-spec '$string' contains multiple semicolons";
      }
      next;
    }
    my $vname = $vspec;
    my $spart = {};
    while ($vname =~ s/^($SIGIL)//) {
      my $sigil = $1;
      $spart = { %$spart, %{$PVSPEC{$sigil} || {}} };
    }
    unless ($vname =~ /\A$BARE_VAR\z/) {
      croak "illegal parameter name: '$vname'";
    }
    if ($optional) {
      $spart->{optional} = 1;
    }
    if ($extra->{$vname}) {
      # as of now, the only things that may be already set in $spart are 'type'
      # and 'optional'.  it is therefore safe to naively join the hashes, since
      # we don't need to worry about more complex cases like merging nested
      # 'callbacks' entries.  re-evaluate this if more complex specs are
      # being generated automatically.  -- hdp, 2007-04-10
      %$spart = (%$spart, %{$extra->{$vname}});
    }
    unless (%$spart) {
      $spart = 1;
    }
    push @spec, $vname => $spart;
  }

  return @spec;
}

sub _pos_to_named {
  my ($string, $args, $spec) = @_;
  my @tmpspec = @$spec;
  my @tmpargs = @$args;
  my $return = {};
  while (my ($key, $val) = splice @tmpspec, 0, 2) {
    unless (@tmpargs) {
      if (ref($val) eq 'HASH' and $val->{optional}) {
        last;
      } else {
        confess "not enough arguments for '$string' (only got @$args)";
      }
    }
    $return->{$key} = shift(@tmpargs);
  }
  if (@tmpargs) {
    confess "too many arguments for '$string' (leftover: @tmpargs)";
  }
  return $return;
}

sub micro_validate {
  my ($args, $string, $extra) = @_;
  $args   ||= {};
  $string ||= "";
  $extra  ||= {};

  my $spec = [ micro_translate($string, $extra) ];

  if ($args and reftype($args) eq 'ARRAY') {
    $args = _pos_to_named($string, $args, $spec);
  }
  unless ($args and reftype($args) eq 'HASH') {
    croak "first argument to micro_validate must be hashref or arrayref";
  }

  return {
    validate_with(
      params => $args,
      spec   => { @$spec },
    )
  };
}

1; # End of Params::Validate::Micro