File Coverage

blib/lib/Validation/Class/Simple.pm
Criterion Covered Total %
statement 37 42 88.1
branch 0 2 0.0
condition 1 6 16.6
subroutine 12 14 85.7
pod 0 3 0.0
total 50 67 74.6


line stmt bran cond sub pod time code
1             # ABSTRACT: Simple Ad-Hoc Data Validation
2              
3             package Validation::Class::Simple;
4              
5 14     14   661885 use 5.10.0;
  14         148  
6 14     14   62 use strict;
  14         29  
  14         233  
7 14     14   51 use warnings;
  14         22  
  14         408  
8              
9 14     14   7731 use Validation::Class::Prototype;
  14         41  
  14         553  
10              
11 14     14   81 use Scalar::Util ('refaddr');
  14         27  
  14         566  
12 14     14   77 use Validation::Class::Util ('prototype_registry');
  14         22  
  14         51  
13 14     14   6809 use Validation::Class ();
  14         36  
  14         1224  
14              
15             our $VERSION = '7.900058'; # VERSION
16              
17              
18             sub new {
19              
20 14     14 0 919 my $class = shift;
21              
22 14   33     92 $class = ref $class || $class;
23              
24 14         41 my $self = bless {}, $class;
25 14         65 my $addr = refaddr $self;
26              
27 14         56 prototype_registry->add(
28             $addr => Validation::Class::Prototype->new(
29             package => $class # inside-out prototype
30             )
31             );
32              
33             # let Validation::Class handle arg processing
34 14         84 $self->Validation::Class::initialize_validator(@_);
35              
36 14         49 return $self;
37              
38             }
39              
40             {
41              
42 14     14   90 no strict 'refs';
  14         25  
  14         3350  
43              
44             # inject prototype class aliases unless exist
45              
46             my @aliases = Validation::Class::Prototype->proxy_methods;
47              
48             foreach my $alias (@aliases) {
49              
50             *{$alias} = sub {
51              
52 196     196   84325 my ($self, @args) = @_;
53              
54 196         586 $self->prototype->$alias(@args);
55              
56             };
57              
58             }
59              
60             # inject wrapped prototype class aliases unless exist
61              
62             my @wrapped_aliases = Validation::Class::Prototype->proxy_methods_wrapped;
63              
64             foreach my $alias (@wrapped_aliases) {
65              
66             *{$alias} = sub {
67              
68 180     180   881 my ($self, @args) = @_;
69              
70 180         350 $self->prototype->$alias($self, @args);
71              
72             };
73              
74             }
75              
76             }
77              
78 0     0 0 0 sub proto { goto &prototype } sub prototype {
79              
80 481     481 0 720 my $self = shift;
81 481         1002 my $addr = refaddr $self;
82              
83 481         1100 return prototype_registry->get($addr);
84              
85             }
86              
87             sub DESTROY {
88              
89 0     0     my $self = shift;
90 0           my $addr = refaddr $self;
91              
92 0 0 0       prototype_registry->delete($addr) if $self && prototype_registry;
93              
94 0           return;
95              
96             }
97              
98              
99             1;
100              
101             __END__