File Coverage

blib/lib/Class/MakeMethods/Evaled/Hash.pm
Criterion Covered Total %
statement 8 10 80.0
branch n/a
condition n/a
subroutine 4 6 66.6
pod 4 4 100.0
total 16 20 80.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Class::MakeMethods::Evaled::Hash - Typical hash methods
4              
5              
6             =head1 SYNOPSIS
7              
8             package MyObject;
9             use Class::MakeMethods::Evaled::Hash (
10             new => 'new',
11             scalar => [ 'foo', 'bar' ],
12             array => 'my_list',
13             hash => 'my_index',
14             );
15             ...
16            
17             # Constructor
18             my $obj = MyObject->new( foo => 'Foozle' );
19            
20             # Scalar Accessor
21             print $obj->foo();
22            
23             $obj->bar('Barbados');
24             print $obj->bar();
25            
26             # Array accessor
27             $obj->my_list(0 => 'Foozle', 1 => 'Bang!');
28             print $obj->my_list(1);
29            
30             # Hash accessor
31             $obj->my_index('broccoli' => 'Blah!', 'foo' => 'Fiddle');
32             print $obj->my_index('foo');
33              
34              
35             =head1 DESCRIPTION
36              
37             The Evaled::Hash subclass of MakeMethods provides a simple constructor and accessors for blessed-hash object instances.
38              
39             =head2 Calling Conventions
40              
41             When you C this package, the method names you provide
42             as arguments cause subroutines to be generated and installed in
43             your module.
44              
45             See L for a summary, or L for full details.
46              
47             =head2 Declaration Syntax
48              
49             To declare methods, pass in pairs of a method-type name followed
50             by one or more method names. Valid method-type names for this
51             package are listed in L<"METHOD GENERATOR TYPES">.
52              
53             See L for more
54             syntax information.
55              
56              
57             =cut
58              
59             package Class::MakeMethods::Evaled::Hash;
60              
61             $VERSION = 1.000;
62 1     1   10232 use strict;
  1         2  
  1         41  
63 1     1   756 use Class::MakeMethods::Evaled '-isasubclass';
  1         3  
  1         10  
64              
65             ########################################################################
66              
67             =head1 METHOD GENERATOR TYPES
68              
69             =head2 new - Constructor
70              
71             For each method name passed, returns a subroutine with the following characteristics:
72              
73             =over 4
74              
75             =item *
76              
77             If called as a class method, makes a new hash and blesses it into that class.
78              
79             =item *
80              
81             If called on a hash-based instance, makes a copy of it and blesses the copy into the same class as the original instance.
82              
83             =item *
84              
85             If passed a list of key-value pairs, appends them to the new hash. These arguments override any copied values, and later arguments with the same name will override earlier ones.
86              
87             =item *
88              
89             Returns the new instance.
90              
91             =back
92              
93             Sample declaration and usage:
94              
95             package MyObject;
96             use Class::MakeMethods::Evaled::Hash (
97             new => 'new',
98             );
99             ...
100            
101             # Bare constructor
102             my $empty = MyObject->new();
103            
104             # Constructor with initial values
105             my $obj = MyObject->new( foo => 'Foozle', bar => 'Barbados' );
106            
107             # Copy with overriding value
108             my $copy = $obj->new( bar => 'Bob' );
109              
110             =cut
111              
112             sub new {
113 1     1 1 9 (shift)->evaled_methods( q{
114             sub __NAME__ {
115             my $callee = shift;
116             if ( ref $callee ) {
117             bless { %$callee, @_ }, ref $callee;
118             } else {
119             bless { @_ }, $callee;
120             }
121             }
122             }, @_ )
123             }
124              
125             ########################################################################
126              
127             =head2 scalar - Instance Accessor
128              
129             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
130              
131             =over 4
132              
133             =item *
134              
135             Must be called on a hash-based instance.
136              
137             =item *
138              
139             Uses the method name as a hash key to access the related value for each instance.
140              
141             =item *
142              
143             If called without any arguments returns the current value.
144              
145             =item *
146              
147             If called with an argument, stores that as the value, and returns it,
148              
149             =back
150              
151             Sample declaration and usage:
152              
153             package MyObject;
154             use Class::MakeMethods::Evaled::Hash (
155             scalar => 'foo',
156             );
157             ...
158            
159             # Store value
160             $obj->foo('Foozle');
161            
162             # Retrieve value
163             print $obj->foo;
164              
165             =cut
166              
167             sub scalar {
168 2     2 1 7 (shift)->evaled_methods( q{
169             sub __NAME__ {
170             my $self = shift;
171             if ( scalar @_ ) {
172             $self->{'__NAME__'} = shift;
173             } else {
174             $self->{'__NAME__'};
175             }
176             }
177             }, @_ )
178             }
179              
180             ########################################################################
181              
182             =head2 array - Instance Ref Accessor
183              
184             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
185              
186             =over 4
187              
188             =item *
189              
190             Must be called on a hash-based instance.
191              
192             =item *
193              
194             Uses the method name as a hash key to access the related value for each instance.
195              
196             =item *
197              
198             The value for each instance will be a reference to an array (or undef).
199              
200             =item *
201              
202             If called without any arguments, returns the current array-ref value (or undef).
203              
204             =item *
205              
206             If called with one argument, uses that argument as an index to retrieve from the referenced array, and returns that value (or undef).
207              
208             =item *
209              
210             If called with a list of index-value pairs, stores the value at the given index in the referenced array. If the instance's value was previously undefined, a new array is autovivified. The current value in each position will be overwritten, and later arguments with the same index will override earlier ones. Returns the current array-ref value.
211              
212             =back
213              
214             Sample declaration and usage:
215            
216             package MyObject;
217             use Class::MakeMethods::Evaled::Hash (
218             array => 'bar',
219             );
220             ...
221            
222             # Set values by position
223             $obj->bar(0 => 'Foozle', 1 => 'Bang!');
224            
225             # Positions may be overwritten, and in any order
226             $obj->bar(2 => 'And Mash', 1 => 'Blah!');
227            
228             # Retrieve value by position
229             print $obj->bar(1);
230            
231             # Direct access to referenced array
232             print scalar @{ $obj->bar() };
233            
234             # Reset the array contents to empty
235             @{ $obj->bar() } = ();
236              
237             =cut
238              
239             sub array {
240 0     0 1   (shift)->evaled_methods( q{
241             sub __NAME__ {
242             my $self = shift;
243             if ( scalar(@_) == 0 ) {
244             return $self->{'__NAME__'};
245             } elsif ( scalar(@_) == 1 ) {
246             $self->{'__NAME__'}->[ shift() ];
247             } elsif ( scalar(@_) % 2 ) {
248             Carp::croak "Odd number of items in assigment to __NAME__";
249             } else {
250             while ( scalar(@_) ) {
251             my $key = shift();
252             $self->{'__NAME__'}->[ $key ] = shift();
253             }
254             return $self->{'__NAME__'};
255             }
256             }
257             }, @_ )
258             }
259              
260             ########################################################################
261              
262             =head2 hash - Instance Ref Accessor
263              
264             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
265              
266             =over 4
267              
268             =item *
269              
270             Must be called on a hash-based instance.
271              
272             =item *
273              
274             Uses the method name as a hash key to access the related value for each instance.
275              
276             =item *
277              
278             The value for each instance will be a reference to a hash (or undef).
279              
280             =item *
281              
282             If called without any arguments, returns the current hash-ref value (or undef).
283              
284             =item *
285              
286             If called with one argument, uses that argument as an index to retrieve from the referenced hash, and returns that value (or undef).
287              
288             =item *
289              
290             If called with a list of key-value pairs, stores the value under the given key in the referenced hash. If the instance's value was previously undefined, a new hash is autovivified. The current value under each key will be overwritten, and later arguments with the same key will override earlier ones. Returns the current hash-ref value.
291              
292             =back
293              
294             Sample declaration and usage:
295            
296             package MyObject;
297             use Class::MakeMethods::Evaled::Hash (
298             hash => 'baz',
299             );
300             ...
301            
302             # Set values by key
303             $obj->baz('foo' => 'Foozle', 'bar' => 'Bang!');
304            
305             # Values may be overwritten, and in any order
306             $obj->baz('broccoli' => 'Blah!', 'foo' => 'Fiddle');
307            
308             # Retrieve value by key
309             print $obj->baz('foo');
310            
311             # Direct access to referenced hash
312             print keys %{ $obj->baz() };
313            
314             # Reset the hash contents to empty
315             @{ $obj->baz() } = ();
316              
317             =cut
318              
319             sub hash {
320 0     0 1   (shift)->evaled_methods( q{
321             sub __NAME__ {
322             my $self = shift;
323             if ( scalar(@_) == 0 ) {
324             return $self->{'__NAME__'};
325             } elsif ( scalar(@_) == 1 ) {
326             $self->{'__NAME__'}->{ shift() };
327             } elsif ( scalar(@_) % 2 ) {
328             Carp::croak "Odd number of items in assigment to '__NAME__'";
329             } else {
330             while ( scalar(@_) ) {
331             $self->{'__NAME__'}->{ shift() } = shift();
332             }
333             return $self->{'__NAME__'};
334             }
335             }
336             }, @_ )
337             }
338              
339             ########################################################################
340              
341             =head1 SEE ALSO
342              
343             See L for general information about this distribution.
344              
345             See L for more about this family of subclasses.
346              
347             =cut
348              
349             1;