Acme-Sub-Parms
view release on metacpan or search on metacpan
examples/bench-parm-parsers-ci-novalid.pl view on Meta::CPAN
use strict;
use Acme::Sub::Parms qw(:no_validation :normalize);
use Class::ParmList qw (simple_parms parse_parms);
use Params::Validate qw (validate);
use Benchmark qw(cmpthese);
$Params::Validate::NO_VALIDATION = 1;
print "Bench case insensitive parameter parsing without validation\n";
cmpthese(500000, {
'bindparms' => sub { sub_parms_bind_parms( handle => 'Test', 'thing' => 'something')},
# 'std_args' => sub { standard_args( handle => 'Test', 'thing' => 'something')},
'caseflat_std_args' => sub { caseflat_standard_args( handle => 'Test', 'thing' => 'something')},
# 'one_step_args' => sub { one_step_args( handle => 'Test', 'thing' => 'something')},
'positional_args' => sub { positional_args( 'Test', 'something')},
'null_sub' => sub { null_sub( handle => 'Test', 'thing' => 'something')},
'simple_parms' => sub { simple_parms_args( handle => 'Test', 'thing' => 'something')},
'parse_parms' => sub { parse_parms_no_valid( handle => 'Test', 'thing' => 'something')},
'params_validate' => sub { params_validate( handle => 'Test', 'thing' => 'something')},
}
);
exit;
############################################################################
sub params_validate {
my ($handle, $thing) = @{(validate(@_, { handle => 1, thing => 1 }))}{'handle','thing'};
}
sub sub_parms_bind_parms {
BindParms : (
my $handle : handle;
my $thing : thing;
)
}
sub simple_parms_args {
my ($handle, $thing) = simple_parms(['handle','thing'], @_);
}
examples/bench-parm-parsers-ci.pl view on Meta::CPAN
use Class::ParmList qw (simple_parms);
use Params::Validate qw (validate validation_options validate_with);
validation_options(ignore_case => 1);
use Benchmark qw(cmpthese);
print "Bench case insensitive parameter parsing with validation (as applicable)\n";
cmpthese(500000, {
'bindparms' => sub { sub_parms_bind_parms( handle => 'Test', 'thing' => 'something')},
# 'std_args' => sub { standard_args( handle => 'Test', 'thing' => 'something')},
'caseflat_std_args' => sub { caseflat_standard_args( handle => 'Test', 'thing' => 'something')},
# 'one_step_args' => sub { one_step_args( handle => 'Test', 'thing' => 'something')},
'posistional_args' => sub { positional_args( 'Test', 'something')},
'null_sub' => sub { null_sub( handle => 'Test', 'thing' => 'something')},
'simple_parms' => sub { simple_parms_args( handle => 'Test', 'thing' => 'something')},
'params_validate' => sub { params_validate( handle => 'Test', 'thing' => 'something')},
'params_validate_with' => sub { params_validate_with( handle => 'Test', 'thing' => 'something')},
}
);
examples/bench-parm-parsers-ci.pl view on Meta::CPAN
my ($handle, $thing) = @{(validate(@_, { handle => 1, thing => 1 }))}{'handle','thing'};
}
sub params_validate_with {
my ($handle, $thing) = @{(validate_with(params => \@_,
spec => { handle => 1, thing => 1 },
normalize_keys => sub { lc $_[0] },
))}{'handle','thing'};
}
sub sub_parms_bind_parms {
BindParms : (
my $handle : handle;
my $thing : thing;
)
}
sub simple_parms_args {
my ($handle, $thing) = simple_parms(['handle','thing'], @_);
}
sub positional_args {
examples/bench-parm-parsers-cs-novalid.pl view on Meta::CPAN
use strict;
use Acme::Sub::Parms qw(:no_validation);
use Class::ParmList qw (simple_parms);
use Params::Validate qw (validate);
use Benchmark qw(cmpthese);
$Params::Validate::NO_VALIDATION = 1;
print "Bench case sensitive parameter parsing without validation (as applicable)\n";
cmpthese(1000000, {
'bindparms' => sub { sub_parms_bindparms( handle => 'Test', 'thing' => 'something')},
'std_args' => sub { std_args( handle => 'Test', 'thing' => 'something')},
# 'caseflat_args' => sub { caseflat_std_args( handle => 'Test', 'thing' => 'something')},
'one_step_args' => sub { one_step_args( handle => 'Test', 'thing' => 'something')},
'positional_args' => sub { positional_args( 'Test', 'something')},
'simple_parms (*)' => sub { simple_parms_args( handle => 'Test', 'thing' => 'something')},
'validate' => sub { params_validate( handle => 'Test', 'thing' => 'something')},
'null_sub' => sub { null_sub( handle => 'Test', 'thing' => 'something')},
# 'null_method' => sub { null_method( handle => 'Test', 'thing' => 'something')},
}
);
print "\n(*) case insensitive and validating\n";
exit;
############################################################################
sub params_validate {
my ($handle, $thing) = @{(validate(@_, { handle => 1, thing => 1 }))}{'handle','thing'};
}
sub sub_parms_bindparms {
BindParms : (
my $handle : handle;
my $thing : thing;
)
}
sub simple_parms_args {
my ($handle, $thing) = simple_parms(['handle','thing'], @_);
}
examples/bench-parm-parsers-cs.pl view on Meta::CPAN
package My;
use strict;
use Acme::Sub::Parms;
use Class::ParmList qw (simple_parms);
use Params::Validate qw (validate);
use Benchmark qw(cmpthese);
print "Bench case sensitive parameter parsing with validation (as applicable)\n";
cmpthese(1000000, {
'bindparms' => sub { sub_parms_bindparms( handle => 'Test', 'thing' => 'something')},
'std_args (*)' => sub { std_args( handle => 'Test', 'thing' => 'something')},
# 'caseflat_args' => sub { caseflat_std_args( handle => 'Test', 'thing' => 'something')},
'one_step_args (*)' => sub { one_step_args( handle => 'Test', 'thing' => 'something')},
'positional_args (*)' => sub { positional_args( 'Test', 'something')},
'simple_parms' => sub { simple_parms_args( handle => 'Test', 'thing' => 'something')},
'validate' => sub { params_validate( handle => 'Test', 'thing' => 'something')},
'null_sub' => sub { null_sub( handle => 'Test', 'thing' => 'something')},
}
);
print "'starred' entries are not performing validation\n";
exit;
############################################################################
sub params_validate {
my ($handle, $thing) = @{(validate(@_, { handle => 1, thing => 1 }))}{'handle','thing'};
}
sub sub_parms_bindparms {
BindParms : (
my $handle : handle;
my $thing : thing;
)
}
sub simple_parms_args {
my ($handle, $thing) = simple_parms(['handle','thing'], @_);
}
examples/dereferenced-anon-hash.pl view on Meta::CPAN
#!/usr/bin/perl
package My;
use strict;
use Acme::Sub::Parms qw(:no_validation :normalize);
my $parms = { 'handle' => 'hello', 'thing' => 'yes' };
bind1(%$parms);
bind2(%$parms);
bind3(%$parms);
exit;
##########################################
sub bind1 {
BindParms : (
my $handle : handle;
my $thing : thing;
)
}
##########################################
sub bind2 {
BindParms : ( # Testing
my $handle : handle;
my $thing : thing;
my $optional_parm : oparm [optional, default="something"];
)
}
##########################################
sub bind3 {
BindParms : ( # Testing
my $handle : handle [required, is_defined];
my $thing : thing;
)
}
##########################################
examples/line-warn.pl view on Meta::CPAN
#!/usr/bin/perl
package My;
use strict;
use Acme::Sub::Parms qw(:no_validation :normalize);
my @parms = ( 'handle' => 'hello', 'thing' => 'yes' );
bind1(@parms);
bind2(@parms);
bind3(@parms);
bind4(@parms);
bind5(@parms);
exit;
##########################################
sub bind1 {
BindParms : (
my $handle : handle;
my $thing : thing;
)
warn("Line 27: bind1");
}
##########################################
sub bind2 {
BindParms : ( # Testing
my $handle : handle;
my $thing : thing;
)
warn("Line 37: bind2");
}
##########################################
sub bind3 {
BindParms : ( # Testing
my $handle : handle;
my $thing : thing;
# Test
)
warn("Line 48: bind3");
}
##########################################
sub bind4 { warn("Line 52 (bind4)");
BindParms : ( # Testing
my $handle : handle[required, default="10"];
my $thing : thing;
# Test
)
warn("Line 59: bind4");
}
##########################################
sub bind5 { warn("Line 63 (bind5)");
BindParms : ( # Testing
my $handle : handle[required, default="10"];
my $thing : thing;
# Test
)
warn("Line 70: bind5");
}
lib/Acme/Sub/Parms.pm view on Meta::CPAN
};
foreach my $item (@_) {
if (not _legal_option($item)) {
my $package = __PACKAGE__;
require Carp;
Carp::croak("'$item' not a valid option for 'use $package'\n");
}
$options->{$item} = 1;
}
$Acme::Sub::Parms::line_counter = 0;
my $ref = {'options' => $options, 'bind_block' => 0 };
filter_add(bless $ref); # imported from Filter::Util::Call
}
####
sub _parse_bind_spec {
my ($self, $raw_spec) = @_;
my $spec = $raw_spec;
my $spec_tokens = {
'is_defined' => 0,
'required' => 1,
'optional' => 0,
};
while ($spec ne '') {
lib/Acme/Sub/Parms.pm view on Meta::CPAN
die("Syntax error in BindParms spec: $raw_spec\n");
}
} else {
die("Syntax error in BindParms spec: $raw_spec\n");
}
}
return $spec_tokens;
}
###############################################################################
# bind_spec is intentionally a a non-POD documented'public' method. It can be overridden in a sub-class
# to provide alternative features.
#
# It takes two parameters:
#
# $raw_spec - this is the content of the [....] block (not including the '[' and ']' block delimitters)
# $field_name - the hash key for the field being processed
#
# As each line of the BindParms block is processed the two parameters for each line are passed to the bind_spec
# method for evaluation. bind_spec should return a string containing any Perl code generated as a result of
# the bind specification.
#
# Good style dictates that the returned output should be *ONE* line (it could be a very *long* line)
# so that line numbering in the source file is preserved for any error messages.
#
sub bind_spec {
my $self = shift;
my ($raw_spec, $field_name) = @_;
my $options = $self->{'options'};
my $no_validation = $options->{_NO_VALIDATION()};
my $spec_tokens = $self->_parse_bind_spec($raw_spec);
my $has_side_effects = 0;
my $output = '';
my @spec_tokens_list = keys %$spec_tokens;
if ((0 == @spec_tokens_list) || ((1 == @spec_tokens_list) && ($spec_tokens->{'optional'}))) {
return;
}
######################
lib/Acme/Sub/Parms.pm view on Meta::CPAN
####
sub filter {
my $self = shift;
my $options = $self->{'options'};
my $dump_to_stdout = $options->{_DUMP()};
my $normalize = $options->{_NORMALIZE()};
my $no_validation = $options->{_NO_VALIDATION()};
my $bind_block = $self->{'bind_block'};
my $status;
if ($status = filter_read() > 0) { # imported from Filter::Util::Call
$Acme::Sub::Parms::line_counter++;
if (_DEBUG) {
print STDERR "input line $Acme::Sub::Parms::line_counter: $_";
}
#############################################
# If we are in a bind block, handle it
if ($bind_block) {
my $bind_entries = $self->{'bind_entries'};
my $simple_bind = $self->{'simple_bind'};
##############################
# Last line of the bind block? Generate the working code.
if (m/^\s*\)(\s*$|\s*#.*$)/) {
my $block_trailing_comment = $2;
$block_trailing_comment = defined($block_trailing_comment) ? $block_trailing_comment : '';
$block_trailing_comment =~ s/[\r\n]+$//s;
my $side_effects = 0;
my $args = 'local %Acme::Sub::Parms::args; '; # needed?
if ($normalize) {
$args .= '{ local $_; local %Acme::Sub::Parms::raw_args = @_; %Acme::Sub::Parms::args = map { lc($_) => $Acme::Sub::Parms::raw_args{$_} } keys %Acme::Sub::Parms::raw_args; }' . "\n";
} else {
$args .= '%Acme::Sub::Parms::args = @_;' . "\n";
}
# If we have validation or defaults, handle them
my $padding_lines = 0;
if (! $simple_bind) {
my @parm_declarations = ();
foreach my $entry (@$bind_entries) {
my $variable_decl = $entry->{'variable'};
my $field_name = $entry->{'field'};
my $spec = $entry->{'spec'};
my $trailing_comment = $entry->{'trailing_comment'};
if ( (! defined($spec)) || ($spec eq '')) {
# push(@parm_declarations, $trailing_comment);
next;
}
# The hard case. We have validation requirements.
my ($has_side_effects, $bind_spec_output) = $self->bind_spec($spec, $field_name);
$side_effects += $has_side_effects;
push (@parm_declarations, "$bind_spec_output$trailing_comment");
}
$args .= join("\n",@parm_declarations,'');
}
# Generate the actual parameter data binding
my @var_declarations = ();
my @hard_var_declarations = ();
my @field_declarations = ();
my @fields_list = ();
foreach my $entry (@$bind_entries) {
my $spec = $entry->{'spec'};
next if ((not defined $spec) || ($spec eq ''));
my $raw_var = $entry->{'variable'};
my $field_name = $entry->{'field'};
push (@fields_list, "'$field_name'");
my ($variable_name) = $raw_var =~ m/^my\s+(\S+)$/;
if (defined $variable_name) { # simple 'my $variable :' entries are special-cased for performance
push (@var_declarations, $variable_name);
push (@field_declarations, "'$field_name'");
} else { # Otherwise make a seperate entry for this binding
push (@hard_var_declarations, "$raw_var = \$Acme::Sub::Parms::args\{$field_name\};");
}
}
my $hard_args = join(' ',@hard_var_declarations);
my $arg_line = '';
if (0 < @var_declarations) {
if ($simple_bind && (! $normalize) && $no_validation && (0 == $side_effects) && (0 == @hard_var_declarations)) {
$args = "\n my (" . join(",", @var_declarations) . ') = @{{@_}}{' . join(',',@field_declarations) . '}; ';
} else {
$arg_line = 'my (' . join(",", @var_declarations) . ') = @Acme::Sub::Parms::args{' . join(',',@field_declarations) . '}; ';
}
}
my $unknown_parms_check = '';
unless ($no_validation) {
$unknown_parms_check = 'delete @Acme::Sub::Parms::args{' . join(',',@fields_list) . '}; if (0 < @Acme::Sub::Parms::args) { require Carp; Carp::croak(\'Unexpected parameters passed: \' . join(\', \',@Acme::Sub::Parms::args)); } ';
}
$self->{'bind_block'} = 0;
my $original_block_length = $Acme::Sub::Parms::line_counter - $self->{'line_block_start'};
my $new_block = $args . join(' ',$arg_line, $hard_args, $unknown_parms_check) . "$block_trailing_comment\n";
$new_block =~ s/\n+/\n/gs;
my $new_block_lines = $new_block =~ m/\n/gs;
my $additional_lines = $original_block_length - $new_block_lines;
#warn("Need $additional_lines extra lines\n---\n$new_block---\n");
if ($additional_lines > 0) {
$_ = $new_block . ("\n" x $additional_lines);
} else {
$_ = $new_block;
}
########################
# Bind block parameter line
} elsif (my($bind_var, $bind_field,$trailing_comment) = m/^\s*(\S.*?)\s+:\s+([^'"\s\[]+.*?)\s*(;\s*|;\s*#.*)$/) {
$trailing_comment = defined($trailing_comment) ? $trailing_comment : '';
$trailing_comment =~ s/[\r\n]+$//s;
$trailing_comment =~ s/^;//;
my $bind_entry = { 'variable' => $bind_var, 'field' => $bind_field, trailing_comment => $trailing_comment };
push (@$bind_entries, $bind_entry);
if ($bind_var !~ m/^my \$\S+$/) {
$self->{'simple_bind'} = 0;
}
if ($bind_field =~ m/^(\S+)\s*\[(.*)\]$/) { # Complex spec
$bind_entry->{'field'} = $1;
$bind_entry->{'spec'} = $2;
unless ($no_validation && ($bind_field !~ m/[\s\[,](default|callback)\s*=\s*/)) {
$self->{'simple_bind'} = 0;
}
} elsif ($bind_field =~ m/^\w+$/) { # my $thing : something;
$bind_entry->{'spec'} = 'required';
unless ($no_validation) {
$self->{'simple_bind'} = 0;
}
} else {
die("Failed to parse BindParms block line $Acme::Sub::Parms::line_counter: $_");
}
undef $trailing_comment;
undef $bind_var;
undef $bind_field;
$_ = '';
############################
# Blank and comment only lines
} elsif (m/^(\s*|\s*#.*)$/) {
my $trailing_comment = $1;
$trailing_comment = defined ($trailing_comment) ? $trailing_comment : '';
$trailing_comment =~ s/[\r\n]+$//s;
my $bind_entry = { spec => '', trailing_comment => $trailing_comment};
push (@$bind_entries, $bind_entry);
$_ = '';
} else {
die("Failed to parse BindParms block line $Acme::Sub::Parms::line_counter: $_");
}
} else { # Start of a bind block
if (m/^\s*BindParms\s+:\s+\((\s*#.*$|\s*$)/) {
$self->{'simple_bind'} = 1;
$self->{'bind_entries'} = [];
$self->{'bind_block'} = 1;
$self->{'line_block_start'} = $Acme::Sub::Parms::line_counter;
my $block_head_comment = $2;
$block_head_comment = defined ($block_head_comment) ? $block_head_comment : '';
$block_head_comment =~ s/[\r\n]+$//s;
$_ = $block_head_comment;
#######
# ################################
# # Invokation : $self;
# } elsif (my ($ihead,$ivar,$itail) = m/^(\s*)Invokation\s+:\s+(\S+.*?)\s*;(.*)$/) {
lib/Acme/Sub/Parms.pod view on Meta::CPAN
Acme::Sub::Parms - Provides simple, fast parsing of named subroutine parameters
=head1 SYNOPSIS
use Acme::Sub::Parms;
################
# A simple function with two required parameters
sub simple_bind_parms_function {
BindParms : (
my $handle : handle;
my $thing : thing;
)
#...
}
################
# A complex method interface with multiple parameters
# and validation requirements
sub complex_bind_parms_function {
my $self = shift;
BindParms : (
my $handle : handle [required, is_defined, can=param];
my $thing : thing [optional, isa=CGI::Minimal];
my $another_thing : another [optional, type=SCALAR, callback=_legal_thing];
my $yathing : yathing [optional, is_defined];
my $defaulted : dthing [optional, default="help me"];
)
lib/Acme/Sub/Parms.pod view on Meta::CPAN
A syntax is available to perform argument validation. This is both fast
and powerful, but has some caveats.
The basic format is as follows
BindParms : (
my $somevariable : parameter_name [required];
my $anothervariable : another_parameter_name [optional];
)
The format of each line of the binding declaration is formatted as:
<stuff being assigned to> : parameter_name [binding options];
The simplest possible binding is like the following:
BindParms : (
my $somevariable : parameter_name;
)
That declares that the required named parameter 'parameter_name' will
be bound to the lexical variable $somevariable.
parameter_name may B<NOT> contain whitespace, single or double quotes,
or a left bracket ('[') character. It must be a bare (unquoted) string.
Pretty much any expression that is legal to assign to may be used for
the left side. With the caveat that it B<CANNOT> contain the literal
string ' : ' (whitespace colon whitespace) as that will confuse the
line parser. This excludes the use of the trinary ( statement ? value : value)
conditional operator on the left side, but you shouldn't need it in this
context since there is sufficient power in the binding options to cover
the cases where you might want it.
If you need to use the " : " string in an embedded quoted literal
string, use backslash escaping on it:
Bad:
my $thing{" : "} : something [optional];
Good:
my $thing{" \: "} : something [optional];
Pretty much anything else you want to do on the left of the ':' binding
is fine as long as it is legal to be assigned to.
Ex.
BindParms : (
my Dog $rover : dog_record [required];
}
The options available for parameter binding are as follows:
=head1 Parameter Validation
=over 4
=item Optional/Required Parameters
Optional vs Required is flagged by either (surprise) B<optional> or
B<required> in the parameter options declaration.
lib/Acme/Sub/Parms.pod view on Meta::CPAN
# Optional parameter
BindParms : (
my $handle : handle [optional];
)
# Required parameter
BindParms : (
my $handle : handle [required];
)
'required' specifies validation code to the bind that verifies that the
'handle' parameter was in fact passed and causes a C<confess> at that
line if it was not passed. This does not ensure that the parameter has
a defined value - only that it was passed.
If neither 'required' or 'optional' is specified, then 'required' is defaulted.
Example of default required parameters:
sub a_subroutine {
BindParms : (
lib/Acme/Sub/Parms.pod view on Meta::CPAN
There is no support for method style calls, only ordinary function calls.
The callback function is called with three
parameters: ($field_name, $field_value, $arguments_anon_hash)
The $field_name and $field_value arguments are obvious,
the $arguments_anon_hash is a 'live' reference to a hash containing
all of the arguments being processed by BindParms block.
Because it is a 'live' hash reference, alterations to the hash will be
reflected in subsequent binding lines and in the final values bound.
This is a powerful, but simultaneously very dangerous feature. Use
this ability with caution.
The callback must return either a true or a false value (not the
literal words 'true' or 'false' but something that evaluates to
a true or false logical value) and a string with an error message
(if a false value was returned.)
Callback function example:
t/01_validating.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use lib ('./blib','./lib','../blib','../lib');
use Acme::Sub::Parms;
my @tests_list = (
{ -code => \&bind_parms_test, -desc => 'BindParms (validating, non-normalized) ' },
);
my $counter = 1;
my $do_tests = [];
my $test_subs = {};
foreach my $test (@tests_list) {
$test_subs->{$counter} = $test;
push (@$do_tests, $counter++);
}
t/01_validating.t view on Meta::CPAN
return 1;
}
sub _is_integer {
my ($field_name, $field_value, $args_hash) = @_;
unless (defined ($field_value)) { return (0, 'Not defined'); }
unless (int($field_value) eq $field_value) { return (0, 'Not an integer'); }
return 1;
}
sub bind_parms_test {
my $result = eval {
@_ = (
'handle' => Acme::Sub::Parms::TestObject->new,
'thing' => Acme::Sub::Parms::TestObject->new,
'another' => \"example",
'yathing' => 1,
);
BindParms : (
my $handle : handle [required, is_defined, can=param];
my $thing : thing [optional, isa=Acme::Sub::Parms::TestObject];
t/02_no_validation.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use lib ('./blib','./lib','../blib','../lib');
use Acme::Sub::Parms qw(:no_validation :dump_to_stdout);
my @tests_list = (
{ -code => \&bind_parms_test, -desc => 'BindParms (non-validating, non-normalized) ' },
);
my $counter = 1;
my $do_tests = [];
my $test_subs = {};
foreach my $test (@tests_list) {
$test_subs->{$counter} = $test;
push (@$do_tests, $counter++);
}
t/02_no_validation.t view on Meta::CPAN
return 1;
}
sub _is_integer {
my ($field_name, $field_value, $args_hash) = @_;
unless (defined ($field_value)) { return (0, 'Not defined'); }
unless (int($field_value) eq $field_value) { return (0, 'Not an integer'); }
return 1;
}
sub bind_parms_test {
my $result = eval {
@_ = (
'handle' => Acme::Sub::Parms::TestObject->new,
'thing' => Acme::Sub::Parms::TestObject->new,
'another' => \"example",
'yathing' => 1,
);
BindParms : (
my $handle : handle [required, is_defined, can=param];
my $thing : thing [optional, isa=Acme::Sub::Parms::TestObject];
t/03_normalized_validating.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use lib ('./blib','./lib','../blib','../lib');
use Acme::Sub::Parms qw(:normalize);
my @tests_list = (
{ -code => \&bind_parms_test, -desc => 'BindParms (validating, non-normalized) ' },
);
my $counter = 1;
my $do_tests = [];
my $test_subs = {};
foreach my $test (@tests_list) {
$test_subs->{$counter} = $test;
push (@$do_tests, $counter++);
}
t/03_normalized_validating.t view on Meta::CPAN
return 1;
}
sub _is_integer {
my ($field_name, $field_value, $args_hash) = @_;
unless (defined ($field_value)) { return (0, 'Not defined'); }
unless (int($field_value) eq $field_value) { return (0, 'Not an integer'); }
return 1;
}
sub bind_parms_test {
my $result = eval {
@_ = (
'Handle' => Acme::Sub::Parms::TestObject->new,
'Thing' => Acme::Sub::Parms::TestObject->new,
'Another' => \"example",
'Yathing' => 1,
);
BindParms : (
my $handle : handle [required, is_defined, can=param];
my $thing : thing [optional, isa=Acme::Sub::Parms::TestObject];
t/04_normalized_no_validation.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use lib ('./blib','./lib','../blib','../lib');
use Acme::Sub::Parms qw(:normalize :no_validation);
my @tests_list = (
{ -code => \&bind_parms_test, -desc => 'BindParms (non-validating, non-normalized) ' },
);
my $counter = 1;
my $do_tests = [];
my $test_subs = {};
foreach my $test (@tests_list) {
$test_subs->{$counter} = $test;
push (@$do_tests, $counter++);
}
t/04_normalized_no_validation.t view on Meta::CPAN
return 1;
}
sub _is_integer {
my ($field_name, $field_value, $args_hash) = @_;
unless (defined ($field_value)) { return (0, 'Not defined'); }
unless (int($field_value) eq $field_value) { return (0, 'Not an integer'); }
return 1;
}
sub bind_parms_test {
my $result = eval {
@_ = (
'Handle' => Acme::Sub::Parms::TestObject->new,
'Thing' => Acme::Sub::Parms::TestObject->new,
'Another' => \"example",
'Yathing' => 1,
);
BindParms : (
my $handle : handle [required, is_defined, can=param];
my $thing : thing [optional, isa=Acme::Sub::Parms::TestObject];
t/98_pod_coverage.t view on Meta::CPAN
}
eval {
require Test::Pod::Coverage;
};
if ($@ or (not defined $Test::Pod::Coverage::VERSION) or ($Test::Pod::Coverage::VERSION < 1.06)) {
Test::More::plan (skip_all => "Test::Pod::Coverage 1.06 required for testing POD coverage");
exit;
}
Test::More::plan (tests => 1);
Test::Pod::Coverage::pod_coverage_ok( 'Acme::Sub::Parms', { also_private => ['filter','bind_spec'] });
( run in 1.411 second using v1.01-cache-2.11-cpan-2398b32b56e )