File Coverage

blib/lib/Validation/Class/Fields.pm
Criterion Covered Total %
statement 43 43 100.0
branch 10 12 83.3
condition 0 2 0.0
subroutine 10 11 90.9
pod 1 1 100.0
total 64 69 92.7


line stmt bran cond sub pod time code
1             # Container Class for Validation::Class::Field Objects
2              
3             # Validation::Class::Fields is a container class for L
4             # objects and is derived from the L class.
5              
6             package Validation::Class::Fields;
7              
8 108     108   532 use strict;
  108         191  
  108         2752  
9 108     108   511 use warnings;
  108         205  
  108         2906  
10              
11 108     108   521 use Validation::Class::Util '!has';
  108         202  
  108         730  
12 108     108   80686 use Hash::Flatten ();
  108         512925  
  108         2416  
13 108     108   696 use Carp;
  108         259  
  108         8387  
14              
15             our $VERSION = '7.900057'; # VERSION
16              
17 108     108   547 use base 'Validation::Class::Mapping';
  108         243  
  108         8624  
18              
19 108     108   584 use Validation::Class::Mapping;
  108         222  
  108         2050  
20 108     108   60470 use Validation::Class::Field;
  108         335  
  108         44307  
21              
22             sub add {
23              
24 817     817 1 7475 my $self = shift;
25              
26 817         2493 my $arguments = $self->build_args(@_);
27 817         1355 my @suspects = sort keys %{$arguments};
  817         2886  
28              
29 817 50       3701 confess
30              
31             "Illegal field names detected, possible attempt to define validation " .
32             "rules for a parameter containing an array of nested structures on " .
33             "the following fields: " . join ", ", @suspects
34              
35             if grep /(:.*:|:\d+.)/, @suspects
36              
37             ;
38              
39 817         1244 while (my ($key, $value) = each %{$arguments}) {
  1365         4529  
40              
41             # never overwrite
42 548 100       1785 unless (defined $self->{$key}) {
43 542 100       1697 if (isa_hashref($value)) {
44 232         567 $value->{name} = $key;
45             }
46 542         1122 $self->{$key} = $value; # accept an object as a value
47             $self->{$key} = Validation::Class::Field->new($value) unless
48 542 100       3104 "Validation::Class::Field" eq ref $self->{$key}; # unless obj
49             }
50              
51             }
52              
53 817         2616 return $self;
54              
55             }
56              
57             sub AUTOLOAD {
58              
59 8     8   53 (my $routine = $Validation::Class::Fields::AUTOLOAD) =~ s/.*:://;
60              
61 8         21 my ($self) = @_;
62              
63 8 50       24 if ($routine) {
64              
65 8 100       30 if ($self->has($routine)) {
66 7         22 return $self->get($routine);
67             }
68              
69             }
70              
71 1   0     220 croak sprintf q(Can't locate object method "%s" via package "%s"),
72             $routine, ((ref $_[0] || $_[0]) || 'main')
73             ;
74              
75             }
76              
77       0     sub DESTROY {}
78              
79             1;