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   19 use warnings;
  3         5  
  3         294  
4 3     3   17 use strict;
  3         4  
  3         91  
5 3     3   33 use 5.10.1;
  3         9  
6              
7             our $VERSION = '1.780';
8              
9 3     3   16 use Exporter qw( import );
  3         41  
  3         141  
10              
11             our @EXPORT_OK = qw( validate_options );
12              
13 3     3   12 use Carp qw( croak );
  3         10  
  3         1633  
14              
15              
16             sub validate_options {
17 113     113 0 198 my ( $valid, $opt, $caller ) = @_;
18 113 50       202 return if ! defined $opt; #
19 113 50       167 if ( ! defined $caller ) { #
20 0         0 $caller = '';
21             };
22 113         246 for my $key ( keys %$opt ) {
23 152 50       320 if ( ! exists $valid->{$key} ) {
24 0         0 croak "$caller: '$key' is not a valid option name";
25             }
26 152 100       280 next if ! defined $opt->{$key};
27 115 100       1757 if ( $valid->{$key} =~ /^Array/ ) {
    50          
    50          
    100          
    50          
28 16 50       40 croak "$caller: option '$key' => the passed value has to be an ARRAY reference." if ref $opt->{$key} ne 'ARRAY';
29 16 50       59 if ( $valid->{$key} eq 'Array_Int' ) {
30 16         16 for ( @{$opt->{$key}} ) {
  16         37  
31 28 50       42 defined or croak "$caller: option '$key' => undefined array element";
32 28 50       117 /^[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;