File Coverage

blib/lib/Data/InputMonster.pm
Criterion Covered Total %
statement 54 54 100.0
branch 22 30 73.3
condition 13 24 54.1
subroutine 6 6 100.0
pod 2 2 100.0
total 97 116 83.6


line stmt bran cond sub pod time code
1 1     1   63082 use strict;
  1         9  
  1         30  
2 1     1   4 use warnings;
  1         1  
  1         53  
3             package Data::InputMonster 0.011;
4             # ABSTRACT: consume data from multiple sources, best first; om nom nom!
5              
6             #pod =head1 DESCRIPTION
7             #pod
8             #pod This module lets you describe a bunch of input fields you expect. For each
9             #pod field, you can specify validation, a default, and multiple places to look for a
10             #pod value. The first valid value found is accepted and returned in the results.
11             #pod
12             #pod =cut
13              
14 1     1   6 use Carp ();
  1         2  
  1         544  
15              
16             #pod =method new
17             #pod
18             #pod my $monster = Data::InputMonster->new({
19             #pod fields => {
20             #pod field_name => \%field_spec,
21             #pod ...
22             #pod },
23             #pod });
24             #pod
25             #pod This builds a new monster. For more information on the C<%field_spec>
26             #pod parameters, see below.
27             #pod
28             #pod =cut
29              
30             sub new {
31 1     1 1 142 my ($class, $arg) = @_;
32            
33             Carp::confess("illegal parameters to Data::InputMonster constructor")
34 1 50 33     11 unless $arg and (keys %$arg == 1) and exists $arg->{fields};
      33        
35              
36 1         3 my $fields = $arg->{fields};
37              
38 1         6 $class->_assert_field_spec_ok($_) for values %$fields;
39              
40 1         3 bless { fields => $fields } => $class;
41             }
42              
43             sub _assert_field_spec_ok {
44 3     3   5 my ($self, $spec) = @_;
45              
46             Carp::confess("illegal or missing sources")
47 3 50 33     12 unless $spec->{sources} and ref $spec->{sources} eq 'ARRAY';
48              
49             Carp::confess("if given, filter must be a coderef")
50 3 50 66     13 if $spec->{filter} and ref $spec->{filter} ne 'CODE';
51              
52             Carp::confess("if given, check must be a coderef")
53 3 50 33     11 if $spec->{check} and ref $spec->{check} ne 'CODE';
54              
55             Carp::confess("if given, store must be a coderef")
56 3 50 66     9 if $spec->{store} and ref $spec->{store} ne 'CODE';
57              
58             Carp::confess("defaults that are references must be wrapped in code")
59 3 50 50     13 if ((ref $spec->{default})||'CODE') ne 'CODE';
60             }
61              
62             #pod =method consume
63             #pod
64             #pod my $result = $monster->consume($input, \%arg);
65             #pod
66             #pod This method processes the given input and returns a hashref of the finally
67             #pod accepted values. C<$input> can be anything; it is up to the field definitions
68             #pod to expect and handle the data you plan to feed the monster.
69             #pod
70             #pod Valid arguments are:
71             #pod
72             #pod no_default_for - a field name or arrayref of field names for which to NOT
73             #pod fall back to default values
74             #pod
75             #pod =cut
76              
77             sub consume {
78 4     4 1 2078 my ($self, $input, $arg) = @_;
79 4   100     13 $arg ||= {};
80              
81             my %no_default_for
82             = (! $arg->{no_default_for}) ? ()
83 1         4 : (ref $arg->{no_default_for}) ? (map {$_=>1} @{$arg->{no_default_for}})
  1         3  
84 4 100       15 : ($arg->{no_default_for} => 1);
    100          
85              
86 4         9 my $field = $self->{fields};
87 4         5 my %output;
88              
89 4         12 FIELD: for my $field_name (keys %$field) {
90 12         16 my $spec = $field->{$field_name};
91              
92 12         12 my $checker = $spec->{check};
93 12         34 my $filter = $spec->{filter};
94 12         13 my $storer = $spec->{store};
95              
96 12         14 my @sources = @{ $spec->{sources} };
  12         24  
97              
98 12 100       20 if (ref $sources[0]) {
99 4         6 my $i = 1;
100 4         6 @sources = map { ("source_" . $i++) => $_ } @sources;
  4         15  
101             }
102              
103 12         24 my $input_arg = { field_name => $field_name };
104              
105 12         21 SOURCE: for (my $i = 0; $i < @sources; $i += 2) {
106 23         47 my ($name, $getter) = @sources[ $i, $i + 1 ];
107 23         54 my $value = $getter->($self, $input, $input_arg);
108 23 100       119 next unless defined $value;
109 6 100       12 if ($filter) { $filter->() for $value; }
  1         4  
110 6 50 100     17 if ($checker) { $checker->() or next SOURCE for $value; }
  6         13  
111            
112 5         37 $output{ $field_name } = $value;
113 5 100       11 if ($storer) {
114 4         15 $storer->(
115             $self,
116             {
117             input => $input,
118             source => $name,
119             value => $value,
120             field_name => $field_name,
121             },
122             );
123             }
124              
125 5         30 next FIELD;
126             }
127              
128 7 100       15 my $default = $no_default_for{ $field_name } ? undef : $spec->{default};
129 7 50       20 $output{ $field_name } = ref $default ? $default->() : $default;
130             }
131              
132 4         11 return \%output;
133             }
134              
135             #pod =head1 FIELD DEFINITIONS
136             #pod
137             #pod Each field is defined by a hashref with the following entries:
138             #pod
139             #pod sources - an arrayref of sources; see below; required
140             #pod filter - a coderef to preprocess candidate values
141             #pod check - a coderef to validate candidate values
142             #pod store - a coderef to store accepted values
143             #pod default - a value to use if no source provides an acceptable value
144             #pod
145             #pod Sources may be given in one of two formats:
146             #pod
147             #pod [ source_name => $source, ... ]
148             #pod [ $source_1, $source_2, ... ]
149             #pod
150             #pod In the second form, sources will be assigned unique names.
151             #pod
152             #pod The source value is a coderef which, handed the C<$input> argument to the
153             #pod C method, returns a candidate value (or undef). It is also handed a
154             #pod hashref of relevant information, most importantly C.
155             #pod
156             #pod A filter is a coderef that works by altering C<$_>.
157             #pod
158             #pod If given, check must be a coderef that inspects C<$_> and returns a true if the
159             #pod value is acceptable.
160             #pod
161             #pod Store is called if a value is accepted. It is passed the monster and a hashref
162             #pod with the following entries:
163             #pod
164             #pod value - the value accepted
165             #pod source - the name of the source from which the value was accepted
166             #pod input - the input given to the consume method
167             #pod field_name - the field name
168             #pod
169             #pod If default is given, it must be a simple scalar (in which case that is the
170             #pod default) or a coderef that will be called to provide a default value as needed.
171             #pod
172             #pod =cut
173              
174             "OM NOM NOM I EAT DATA";
175              
176             __END__