File Coverage

blib/lib/Term/Choose/ValidateOptions.pm
Criterion Covered Total %
statement 27 32 84.3
branch 16 28 57.1
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 49 67 73.1


line stmt bran cond sub pod time code
1             package Term::Choose::ValidateOptions;
2              
3 3     3   28 use warnings;
  3         13  
  3         212  
4 3     3   38 use strict;
  3         12  
  3         124  
5 3     3   72 use 5.10.0;
  3         14  
6              
7             our $VERSION = '1.761';
8              
9 3     3   23 use Exporter qw( import );
  3         13  
  3         245  
10              
11             our @EXPORT_OK = qw( validate_options );
12              
13 3     3   38 use Carp qw( croak );
  3         18  
  3         1751  
14              
15              
16             sub validate_options {
17 113     113 0 254 my ( $valid, $opt, $caller ) = @_;
18 113 50       238 return if ! defined $opt; #
19 113 50       194 if ( ! defined $caller ) { #
20 0         0 $caller = '';
21             };
22 113         367 for my $key ( keys %$opt ) {
23 152 50       321 if ( ! exists $valid->{$key} ) {
24 0         0 croak "$caller: '$key' is not a valid option name";
25             }
26 152 100       322 next if ! defined $opt->{$key};
27 115 100       1229 if ( $valid->{$key} =~ /^Array/ ) {
    50          
    50          
    100          
    50          
28 16 50       45 croak "$caller: option '$key' => the passed value has to be an ARRAY reference." if ref $opt->{$key} ne 'ARRAY';
29 16 50       35 if ( $valid->{$key} eq 'Array_Int' ) {
30 16         39 for ( @{$opt->{$key}} ) {
  16         38  
31 28 50       51 defined or croak "$caller: option '$key' => undefined array element";
32 28 50       119 /^[0-9]+\z/ or croak "$caller: option '$key' => $_ is an invalid array element";
33             }
34             }
35             }
36             elsif ( $valid->{$key} =~ /^Regexp/ ) {
37 0 0         croak "$caller: option '$key' => the passed value has to be a regex quoted with the 'qr' operator." if ref $opt->{$key} ne 'Regexp';
38             }
39             elsif ( ref $opt->{$key} ) {
40 0           croak "$caller: option '$key' => a reference is not a valid value.";
41             }
42             elsif ( $valid->{$key} eq 'Str' ) {
43             }
44             elsif ( $opt->{$key} !~ m/^$valid->{$key}\z/x ) {
45 0           croak "$caller: option '$key' => '$opt->{$key}' is not a valid value.";
46             }
47             }
48             }
49              
50              
51              
52              
53              
54              
55             1;