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   45 use warnings;
  3         14  
  3         329  
4 3     3   52 use strict;
  3         28  
  3         171  
5 3     3   91 use 5.10.0;
  3         25  
6              
7             our $VERSION = '1.760';
8              
9 3     3   37 use Exporter qw( import );
  3         9  
  3         356  
10              
11             our @EXPORT_OK = qw( validate_options );
12              
13 3     3   51 use Carp qw( croak );
  3         27  
  3         2520  
14              
15              
16             sub validate_options {
17 113     113 0 224 my ( $valid, $opt, $caller ) = @_;
18 113 50       239 return if ! defined $opt; #
19 113 50       200 if ( ! defined $caller ) { #
20 0         0 $caller = '';
21             };
22 113         348 for my $key ( keys %$opt ) {
23 152 50       338 if ( ! exists $valid->{$key} ) {
24 0         0 croak "$caller: '$key' is not a valid option name";
25             }
26 152 100       326 next if ! defined $opt->{$key};
27 115 100       1277 if ( $valid->{$key} =~ /^Array/ ) {
    50          
    50          
    100          
    50          
28 16 50       64 croak "$caller: option '$key' => the passed value has to be an ARRAY reference." if ref $opt->{$key} ne 'ARRAY';
29 16 50       37 if ( $valid->{$key} eq 'Array_Int' ) {
30 16         38 for ( @{$opt->{$key}} ) {
  16         37  
31 28 50       53 defined or croak "$caller: option '$key' => undefined array element";
32 28 50       116 /^[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;