File Coverage

blib/lib/SmokeRunner/Multi/Validate.pm
Criterion Covered Total %
statement 60 60 100.0
branch 2 4 50.0
condition n/a
subroutine 16 16 100.0
pod n/a
total 78 80 97.5


line stmt bran cond sub pod time code
1             package SmokeRunner::Multi::Validate;
2             BEGIN {
3 9     9   335 $SmokeRunner::Multi::Validate::AUTHORITY = 'cpan:YANICK';
4             }
5             {
6             $SmokeRunner::Multi::Validate::VERSION = '0.19';
7             }
8             #ABSTRACT: Wrapper around Params::Validate for SmokeRunner::Multi
9              
10 9     9   53 use strict;
  9         12  
  9         272  
11 9     9   50 use warnings;
  9         17  
  9         393  
12              
13 9     9   48 use base 'Exporter';
  9         17  
  9         811  
14              
15 9     9   9606 use Params::Validate qw(:types);
  9         106179  
  9         2338  
16 9     9   88 use Scalar::Util qw( blessed );
  9         19  
  9         2978  
17              
18              
19             my %Types;
20             BEGIN
21             {
22             %Types =
23             (
24             DIR_TYPE => { type => SCALAR,
25 49         1725 callbacks => { 'is a dir' => sub { -d $_[0] } },
26             },
27              
28 9     9   122 TEST_SET_TYPE => { type => OBJECT,
29             isa => 'SmokeRunner::Multi::TestSet',
30             },
31              
32             RUNNER_TYPE => { type => OBJECT,
33             isa => 'SmokeRunner::Multi::Runner',
34             },
35             );
36              
37 9         29 for my $t ( grep {/^[A-Z]+$/} @Params::Validate::EXPORT_OK )
  144         362  
38             {
39 99         188 my $name = $t . '_TYPE';
40 99         4421 $Types{$name} = { type => eval $t };
41             }
42              
43 9         50 for my $t ( keys %Types )
44             {
45 126         139 my %t = %{ $Types{$t} };
  126         426  
46              
47 55 50   55   225 my $sub = sub { die "Invalid additional args for $t: [@_]" if @_ % 2;
48 55         380 return { %t, @_ };
49 126         496 };
50              
51 9     9   78 no strict 'refs';
  9         14  
  9         550  
52 126         143 *{$t} = $sub;
  126         3030  
53             }
54             }
55              
56             our %EXPORT_TAGS = ( types => [ keys %Types ] );
57             our @EXPORT_OK = keys %Types;
58              
59             my %MyExports = map { $_ => 1 }
60             @EXPORT_OK,
61             map { ":$_" } keys %EXPORT_TAGS;
62              
63             sub import
64             {
65 34     34   88 my $class = shift;
66              
67 34         80 my $caller = caller;
68              
69 34         77 my @pv_export = grep { !$MyExports{$_} } @_;
  90         274  
70              
71             {
72 9     9   59 eval <<"EOF";
  9     9   18  
  9     7   369  
  9     5   55  
  9     3   19  
  9     1   387  
  7         44  
  7         13  
  7         343  
  5         26  
  5         10  
  5         176  
  3         18  
  3         6  
  3         127  
  1         4  
  1         2  
  1         37  
  34         60  
  34         2745  
73             package $caller;
74              
75             use Params::Validate qw(@pv_export);
76             EOF
77              
78 34 50       164 die $@ if $@;
79             }
80              
81 34         83 $class->export_to_level( 1, undef, grep { $MyExports{$_} } @_ );
  90         5828  
82             }
83              
84              
85             1;
86              
87             __END__