File Coverage

blib/lib/Eixo/Base/Util.pm
Criterion Covered Total %
statement 50 58 86.2
branch 19 28 67.8
condition 2 9 22.2
subroutine 12 12 100.0
pod 0 1 0.0
total 83 108 76.8


line stmt bran cond sub pod time code
1             package Eixo::Base::Util;
2              
3 10     10   132435 use strict;
  10         47  
  10         292  
4 10     10   57 use warnings;
  10         20  
  10         309  
5              
6 10     10   55 use Scalar::Util;
  10         39  
  10         650  
7              
8 10     10   5584 use Attribute::Handlers;
  10         49634  
  10         50  
9              
10             #
11             # Signature-based validation
12             #
13             my $EQUIVALENCES = {
14              
15             i => 'integer',
16             f => 'float',
17             s => 'string',
18             b => 'boolean',
19             o => 'object',
20             };
21              
22             #
23             # Signature of the subroutine
24             #
25             sub UNIVERSAL::Sig :ATTR(CODE){
26              
27 3     3 0 6564 my ($pkg, $sym, $code, $attr_name, $data) = @_;
28              
29 3 100       12 unless(ref($data)){
30              
31 1         6 $data = [split(/\s*\,\s*/, $data)];
32            
33             }
34              
35 3         9 my @e = @$data;
36              
37 3         4 my @validators;
38              
39 3         3 my $arg_n = 0;
40              
41 3         7 foreach my $e (@e){
42              
43 8         14 my ($n, $expected_value) = ($arg_n++, $e);
44              
45 8 50       17 if($e =~ /^([\d|\*]+)\:(.+)$/){
46 0         0 ($n, $expected_value) = ($1, $2);
47             }
48              
49 8         14 push @validators, [&__createValidator($n, $expected_value, $pkg), $expected_value, $n];
50              
51             }
52              
53             my $f_v = sub {
54              
55 4     4   17 foreach my $validator (@validators){
56            
57 9 100       30 unless($validator->[0]->(\@_)){
58              
59 2   66     13 my $expected_value = $EQUIVALENCES->{$validator->[1]} || $validator->[1];
60              
61 2         4 die(*{$sym}{NAME} . ': expected value \'' . $expected_value . '\' in arg (' . $validator->[2] . ')');
  2         24  
62              
63             }
64             }
65              
66 3         20 };
67              
68 10     10   3328 no warnings 'redefine';
  10         26  
  10         983  
69            
70 3         12 *{$sym} = sub {
71            
72 4     4   1109 $f_v->(@_);
73            
74 2         7 $code->(@_);
75              
76             }
77              
78 10     10   77 }
  10         21  
  10         47  
  3         10  
79              
80             sub __createValidator{
81 8     8   11 my ($dim, $expected_value, $pkg) = @_;
82              
83             sub {
84 9     9   13 my $args = $_[0];
85              
86 9 50       20 if($dim eq '*') {
87            
88 0         0 foreach(@$args){
89              
90 0 0       0 return unless(&__v($_, $expected_value));
91             }
92              
93 0         0 return 1;
94              
95             }
96             else{
97              
98 9         24 &__v($args->[$dim], $expected_value, $pkg);
99             }
100             }
101              
102 8         35 }
103              
104              
105             my $PERL_REFS_REG = qr/^(SCALAR|ARRAY|HASH|CODE|GLOB|RegExp)$/o;
106              
107             sub __v{
108 9     9   31 my ($v, $e, $pkg) = @_;
109              
110 9 50       59 if($e eq 'b'){
    100          
    100          
    50          
    100          
    50          
    100          
    50          
111 0   0     0 return !defined($v) || $v == 1
112             }
113             elsif(!defined($v)){
114 1         3 return undef;
115             }
116             elsif($e eq 'i'){
117 4         38 return $v =~ /^(\-)?\d+$/;
118             }
119             elsif($e eq 'f'){
120 0         0 return $v =~ /^(\-)?\d+\.\d+$/;
121             }
122             elsif($e eq 's'){
123 1         4 return !ref($v)
124             }
125             elsif($e eq 'o'){
126 0         0 return &Scalar::Util::blessed($v);
127             }
128             elsif($e eq 'self'){
129              
130 1 50       23 &Scalar::Util::blessed($v) && $v->isa($pkg)
131              
132             }
133             elsif($e =~ $PERL_REFS_REG){
134 2         9 return ref($v) eq $e;
135             }
136             else{
137              
138 0   0       return ref($v)
139              
140             && ref($v) !~ $PERL_REFS_REG
141              
142             && $v->isa($e);
143              
144             }
145              
146             }
147              
148             1;
149