File Coverage

blib/lib/Data/Domain/Dependencies.pm
Criterion Covered Total %
statement 42 42 100.0
branch 7 10 70.0
condition 3 6 50.0
subroutine 13 13 100.0
pod 3 3 100.0
total 68 74 91.8


line stmt bran cond sub pod time code
1             package Data::Domain::Dependencies;
2              
3 5     5   491491 use strict;
  5         12  
  5         1395  
4 5     5   28 use warnings;
  5         8  
  5         306  
5              
6 5     5   422 use Params::Validate::Dependencies qw(:_of exclusively);
  5         10  
  5         37  
7 5     5   36 use Scalar::Util qw(blessed);
  5         9  
  5         322  
8 5     5   32 use Exporter qw(import);
  5         23  
  5         223  
9              
10 5     5   37 use base qw(Data::Domain);
  5         19  
  5         3684  
11              
12 5     5   1193094 use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
  5         15  
  5         1656  
13             $VERSION = '2.00';
14              
15             @EXPORT = ();
16             @EXPORT_OK = (
17             @{$Params::Validate::Dependencies::EXPORT_TAGS{_of}},
18             qw(exclusively Dependencies)
19             );
20             %EXPORT_TAGS = (all => \@EXPORT_OK);
21              
22             =head1 NAME
23              
24             Data::Domain::Dependencies - give Data::Domain the same magic as Params::Validate::Dependencies
25              
26             =head1 DESCRIPTION
27              
28             A sub-class of Data::Domain which provides functions and objects
29             to let Data::Domain use the same
30             functions as Params::Validate::Dependencies.
31              
32             NB now this only works on perl 5.18 and higher as Data::Domain uses
33             some features of more modern perls.
34              
35             =head1 INCOMPATIBLE CHANGES
36              
37             As of version 2.00, Data::Domain::Dependencies no longer has the
38             C method. This is because of incompatible
39             changes in the L API. If you need this method then
40             you should use Data::Domain::Dependencies version 1.41, and
41             Data::Domain version 1.13.
42              
43             See L
44              
45             =head1 SYNOPSIS
46              
47             This creates a domain which, when passed a hashref to inspect, will
48             check that it contains at least one of an 'alpha' or 'beta' key, or
49             both of 'foo' and 'bar'.
50              
51             use Data::Domain::Dependencies qw(:all);
52              
53             my $domain = Dependencies(
54             any_of(
55             qw(alpha beta),
56             all_of(qw(foo bar))
57             )
58             );
59              
60             my $errors = $domain->inspect(\%somehash);
61              
62             =head1 SUBROUTINES and EXPORTS
63              
64             Nothing is exported by default, but you can export any of the *_of
65             functions of Params::Validate::Dependencies, and the 'Dependencies'
66             and 'exclusively' functions. They are all available under the 'all' tag.
67              
68             =head2 Dependencies
69              
70             This takes a code-ref argument as returned by the *_of functions.
71              
72             It returns an object which is a sub-class of Data::Domain::Dependencies
73             and so has an 'inspect' method that you can use to check for errors
74             when passing it a hash-ref.
75              
76             =cut
77              
78             sub Dependencies {
79 5     5 1 329 my $sub = shift;
80 5         29 __PACKAGE__->new($sub);
81             }
82              
83             =head2 new
84              
85             'Dependencies' above is really just a thin wrapper around this
86             constructor. You are encouraged to not call this directly.
87              
88             =cut
89              
90             sub new {
91 5     5 1 24 my($class, $sub) = @_;
92 5 50 33     73 die("$class constructor must be passed a Params::Validate::Dependencies object or a code-ref\n")
      66        
93             unless(ref($sub) =~ /CODE/ || (blessed($sub) && $sub->isa('Params::Validate::Dependencies::Documenter')));
94 5 100       28 if(blessed($sub)) {
95 4         25 my $target_class = "${class}::".$sub->name();
96 5     5   44 no strict 'refs';
  5         12  
  5         1793  
97 4 50       18 unless(@{"${target_class}::ISA"}) {
  4         64  
98             # multiple inheritance so we can get at Data::Domain->inspect()
99             # and Params::Validate::Dependencies::Documenter->_document()
100 4         12 @{"${target_class}::ISA"} = (
  4         95  
101             'Data::Domain::Dependencies',
102             blessed($sub)
103             );
104             }
105 4     10   58 return bless sub { $sub->(@_) }, $target_class;
  10         41  
106             } else {
107 1     2   8 return bless sub { $sub->(@_) }, $class;
  2         8  
108             }
109             }
110              
111             # this is where the magic happens ...
112             sub inspect {
113 12     12 1 113 my $sub = shift;
114 12         26 my $data = shift;
115 12 50       87 return __PACKAGE__." can only inspect hashrefs\n"
116             unless(ref($data) =~ /HASH/i);
117              
118 12 100       399 return $sub->($data) ? () : __PACKAGE__.": validation failed";
119             }
120              
121             =head1 LIES
122              
123             Some of the above is incorrect. If you really want to know what's
124             going on, look at L.
125              
126             =head1 BUGS, LIMITATIONS, and FEEDBACK
127              
128             I like to know who's using my code. All comments, including constructive
129             criticism, are welcome.
130              
131             Please report any bugs either by email
132             or at L.
133              
134             Bug reports should contain enough detail that I can replicate the
135             problem and write a test. The best bug reports have those details
136             in the form of a .t file. If you also include a patch I will love
137             you for ever.
138              
139             =head1 SEE ALSO
140              
141             L
142              
143             L
144              
145             =head1 SOURCE CODE REPOSITORY
146              
147             L
148              
149             L
150              
151             =head1 COPYRIGHT and LICENCE
152              
153             Copyright 2024 David Cantrell EFE
154              
155             This software is free-as-in-speech software, and may be used, distributed, and modified under the terms of either the GNU General Public Licence version 2 or the Artistic Licence. It's up to you which one you use. The full text of the licences can be found in the files GPL2.txt and ARTISTIC.txt, respectively.
156              
157             =head1 CONSPIRACY
158              
159             This module is also free-as-in-mason.
160              
161             =cut
162              
163             1;