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 109     109   659 use strict;
  109         200  
  109         2791  
9 109     109   522 use warnings;
  109         211  
  109         2682  
10              
11 109     109   506 use Validation::Class::Util '!has';
  109         199  
  109         605  
12 109     109   43442 use Hash::Flatten ();
  109         420619  
  109         2441  
13 109     109   776 use Carp;
  109         232  
  109         7065  
14              
15             our $VERSION = '7.900058'; # VERSION
16              
17 109     109   669 use base 'Validation::Class::Mapping';
  109         202  
  109         10750  
18              
19 109     109   632 use Validation::Class::Mapping;
  109         216  
  109         1717  
20 109     109   40467 use Validation::Class::Field;
  109         330  
  109         39458  
21              
22             sub add {
23              
24 825     825 1 8731 my $self = shift;
25              
26 825         2033 my $arguments = $self->build_args(@_);
27 825         1362 my @suspects = sort keys %{$arguments};
  825         2514  
28              
29 825 50       3696 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 825         1363 while (my ($key, $value) = each %{$arguments}) {
  1377         3501  
40              
41             # never overwrite
42 552 100       1407 unless (defined $self->{$key}) {
43 546 100       1391 if (isa_hashref($value)) {
44 233         546 $value->{name} = $key;
45             }
46 546         1017 $self->{$key} = $value; # accept an object as a value
47             $self->{$key} = Validation::Class::Field->new($value) unless
48 546 100       2259 "Validation::Class::Field" eq ref $self->{$key}; # unless obj
49             }
50              
51             }
52              
53 825         1969 return $self;
54              
55             }
56              
57             sub AUTOLOAD {
58              
59 8     8   49 (my $routine = $Validation::Class::Fields::AUTOLOAD) =~ s/.*:://;
60              
61 8         20 my ($self) = @_;
62              
63 8 50       18 if ($routine) {
64              
65 8 100       21 if ($self->has($routine)) {
66 7         17 return $self->get($routine);
67             }
68              
69             }
70              
71 1   0     189 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;