File Coverage

blib/lib/Config/Apple/Profile/Payload/Tie/Dict.pm
Criterion Covered Total %
statement 41 42 97.6
branch 3 4 75.0
condition n/a
subroutine 14 14 100.0
pod n/a
total 58 60 96.6


line stmt bran cond sub pod time code
1             # This is the code for Config::Apple::Profile::Payload::Tie::Dict.
2             # For Copyright, please see the bottom of the file.
3              
4             package Config::Apple::Profile::Payload::Tie::Dict;
5              
6 15     15   124 use 5.10.1;
  15         36  
  15         516  
7 15     15   58 use strict;
  15         17  
  15         391  
8 15     15   52 use warnings FATAL => 'all';
  15         24  
  15         820  
9              
10             our $VERSION = '0.87';
11              
12 15     15   62 use Scalar::Util qw(blessed);
  15         26  
  15         799  
13 15     15   141 use Tie::Hash; # Also gives us Tie::StdHash
  15         21  
  15         4842  
14              
15              
16             =encoding utf8
17              
18             =head1 NAME
19              
20             Config::Apple::Profile::Payload::Tie::Dict - Tying class for dictionaries
21             of things.
22              
23             =head1 DESCRIPTION
24              
25             This class is used to store a dictionary (a I) of I. Exactly
26             what I are being stored is specified at the time the tie is made.
27              
28             There are several payload types that contain dicts of things. For example,
29             if you have a Wi-Fi network that uses WPA- or WPA2-Enterprise, then some form
30             of EAP will be used, and the EAP parameters are stored in a dictionary.
31              
32             This class is used by payload classes to represent a dictionary.
33              
34             =cut
35              
36             =head2 "CLASS" METHODS
37              
38             =head3 tie %hash, 'Config::Apple::Profile::Payload::Tie::Dict', $validator
39              
40             When this class is tied to an hash, C will be called, with the class
41             name as the first argument.
42              
43             C<$validator> is a reference to a function that will be able to validate
44             values that are stored in the dict. The validator will be passed the value as
45             the only parameter, and an untained value is expected as the return value.
46             If C is returned by the validator, then the value was invalid, and the
47             store attempt will fail.
48              
49             It is suggested that the functions from
50             L be used.
51              
52             If C<$validator> is not a valid coderef then an exception will be thrown.
53              
54             =cut
55              
56             sub TIEHASH {
57 22     22   27 my ($class, $validator) = @_;
58            
59             # This is what we'll eventually return
60 22         25 my %object;
61            
62             # We'll still have an array, for convenience
63 22         66 $object{dict} = {};
64            
65             # We don't accept refs, only scalars
66 22 50       71 if (ref $validator ne 'CODE') {
67 0         0 die "Validator must be a function reference";
68             }
69 22         31 $object{validator} = $validator;
70              
71 22         91 return bless \%object, $class;
72             }
73              
74              
75             =head3 FETCH
76              
77             Works as one would expect with a Perl hash. Returns the entry matching the
78             specified key.
79              
80             =cut
81              
82             sub FETCH {
83 87     87   224 my ($self, $key) = @_;
84            
85 87         305 return $self->{hash}->{$key};
86             }
87              
88              
89             =head3 STORE
90              
91             Works almost as one would expect with a Perl hash. Stores a value at the
92             specified key. The value will only be stored if it is valid; otherwise an
93             exception will be thrown. C is not a valid value to store.
94              
95             =cut
96              
97             sub STORE {
98 41     41   5266 my ($self, $key, $value) = @_;
99            
100             # Call the validation routine
101             # If the validated value is undef, it was invalid
102 41         124 my $validated_value = $self->{validator}->($value);
103 40 100       315 if (!defined $validated_value) {
104 9         80 die "Attempting to insert invalid value";
105             }
106            
107 31         99 $self->{hash}->{$key} = $self->{validator}->($validated_value);
108             }
109              
110              
111             =head3 delete
112              
113             Works as one would expect with a Perl hash. Deletes the specified key from
114             the hash.
115              
116             =cut
117              
118             sub DELETE {
119 4     4   761 my ($self, $key) = @_;
120 4         18 delete $self->{hash}->{$key};
121             }
122              
123              
124             =head3 clear
125              
126             Works as one would expect with a Perl hash. Deletes all keys from the hash.
127              
128             =cut
129              
130             sub CLEAR {
131 1     1   356 my ($self) = @_;
132 1         13 $self->{hash} = {};
133             }
134              
135              
136             =head3 exists
137              
138             Works as expected for a Perl hash. Returns true if the specified key exists
139             in the hash.
140              
141             =cut
142              
143             sub EXISTS {
144 16     16   4990 my ($self, $key) = @_;
145 16         68 return exists $self->{hash}->{$key};
146             }
147              
148              
149             =head3 FIRSTKEY
150              
151             Used as part of C and C. Works as expected for a Perl hash.
152             Returns the first key in the hash.
153              
154             =cut
155              
156             sub FIRSTKEY {
157 23     23   18743 my ($self) = @_;
158             # Let's defer to Tie::StdHash for this.
159 23         77 return Tie::StdHash::FIRSTKEY($self->{hash});
160             }
161              
162              
163             =head3 NEXTKEY
164              
165             Used as part of C and C. Works as expected for a Perl hash.
166             Returns the next key in the hash.
167              
168             =cut
169              
170             sub NEXTKEY {
171 227     227   11863 my ($self, $lastkey) = @_;
172             # Let's defer to Tie::StdHash for this.
173 227         373 return Tie::StdHash::NEXTKEY($self->{hash});
174             }
175              
176              
177             =head3 scalar
178              
179             Works as expected, returning the number of keys in the hash.
180              
181             =cut
182              
183             sub SCALAR {
184 1     1   299 my ($self) = @_;
185 1         2 return scalar %{$self->{hash}};
  1         4  
186             }
187              
188              
189             =head1 ACKNOWLEDGEMENTS
190              
191             Refer to L for acknowledgements.
192              
193             =head1 AUTHOR
194              
195             A. Karl Kornel, C<< >>
196              
197             =head1 COPYRIGHT AND LICENSE
198              
199             Copyright © 2014 A. Karl Kornel.
200              
201             This program is free software; you can redistribute it and/or modify it
202             under the terms of either: the GNU General Public License as published
203             by the Free Software Foundation; or the Artistic License.
204              
205             See L for more information.
206              
207             =cut
208              
209             1;