File Coverage

blib/lib/SmokeRunner/Multi/Validate.pm
Criterion Covered Total %
statement 59 59 100.0
branch 2 4 50.0
condition n/a
subroutine 15 15 100.0
pod n/a
total 76 78 97.4


line stmt bran cond sub pod time code
1             package SmokeRunner::Multi::Validate;
2             our $AUTHORITY = 'cpan:YANICK';
3             #ABSTRACT: Wrapper around Params::Validate for SmokeRunner::Multi
4             $SmokeRunner::Multi::Validate::VERSION = '0.21';
5 8     8   41 use strict;
  8         16  
  8         199  
6 8     8   55 use warnings;
  8         14  
  8         215  
7              
8 8     8   41 use base 'Exporter';
  8         14  
  8         795  
9              
10 8     8   6602 use Params::Validate qw(:types);
  8         72953  
  8         1677  
11 8     8   61 use Scalar::Util qw( blessed );
  8         13  
  8         2261  
12              
13              
14             my %Types;
15             BEGIN
16             {
17             %Types =
18             (
19             DIR_TYPE => { type => SCALAR,
20 48         1692 callbacks => { 'is a dir' => sub { -d $_[0] } },
21             },
22              
23 8     8   1318 TEST_SET_TYPE => { type => OBJECT,
24             isa => 'SmokeRunner::Multi::TestSet',
25             },
26              
27             RUNNER_TYPE => { type => OBJECT,
28             isa => 'SmokeRunner::Multi::Runner',
29             },
30             );
31              
32 8         22 for my $t ( grep {/^[A-Z]+$/} @Params::Validate::EXPORT_OK )
  128         334  
33             {
34 88         170 my $name = $t . '_TYPE';
35 88         3934 $Types{$name} = { type => eval $t };
36             }
37              
38 8         40 for my $t ( keys %Types )
39             {
40 112         131 my %t = %{ $Types{$t} };
  112         335  
41              
42 48 50   48   176 my $sub = sub { die "Invalid additional args for $t: [@_]" if @_ % 2;
43 48         289 return { %t, @_ };
44 112         422 };
45              
46 8     8   42 no strict 'refs';
  8         16  
  8         464  
47 112         145 *{$t} = $sub;
  112         2351  
48             }
49             }
50              
51             our %EXPORT_TAGS = ( types => [ keys %Types ] );
52             our @EXPORT_OK = keys %Types;
53              
54             my %MyExports = map { $_ => 1 }
55             @EXPORT_OK,
56             map { ":$_" } keys %EXPORT_TAGS;
57              
58             sub import
59             {
60 29     29   64 my $class = shift;
61              
62 29         66 my $caller = caller;
63              
64 29         78 my @pv_export = grep { !$MyExports{$_} } @_;
  77         249  
65              
66             {
67 8     8   47 eval <<"EOF";
  8     8   11  
  8     6   290  
  8     4   43  
  8     2   28  
  8     1   319  
  6         36  
  6         12  
  6         256  
  4         22  
  4         6  
  4         165  
  2         13  
  2         5  
  2         145  
  1         12  
  1         2  
  1         47  
  29         53  
  29         2118  
68             package $caller;
69              
70             use Params::Validate qw(@pv_export);
71             EOF
72              
73 29 50       149 die $@ if $@;
74             }
75              
76 29         64 $class->export_to_level( 1, undef, grep { $MyExports{$_} } @_ );
  77         4485  
77             }
78              
79              
80             1;
81              
82             __END__