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   261350 use 5.10.0;
  14         51  
6 14     14   77 use strict;
  14         27  
  14         299  
7 14     14   81 use warnings;
  14         25  
  14         408  
8              
9 14     14   13166 use Validation::Class::Prototype;
  14         43  
  14         604  
10              
11 14     14   96 use Scalar::Util ('refaddr');
  14         28  
  14         892  
12 14     14   74 use Validation::Class::Util ('prototype_registry');
  14         28  
  14         99  
13 14     14   11719 use Validation::Class ();
  14         43  
  14         1786  
14              
15             our $VERSION = '7.900057'; # VERSION
16              
17              
18             sub new {
19              
20 14     14 0 214 my $class = shift;
21              
22 14   33     143 $class = ref $class || $class;
23              
24 14         48 my $self = bless {}, $class;
25 14         117 my $addr = refaddr $self;
26              
27 14         83 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         117 $self->Validation::Class::initialize_validator(@_);
35              
36 14         59 return $self;
37              
38             }
39              
40             {
41              
42 14     14   87 no strict 'refs';
  14         26  
  14         4109  
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   76918 my ($self, @args) = @_;
53              
54 196         654 $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   845 my ($self, @args) = @_;
69              
70 180         457 $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 722 my $self = shift;
81 481         1178 my $addr = refaddr $self;
82              
83 481         1382 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__