File Coverage

blib/lib/Class/MakeMethods/Basic/Hash.pm
Criterion Covered Total %
statement 21 46 45.6
branch 4 16 25.0
condition n/a
subroutine 6 10 60.0
pod 4 4 100.0
total 35 76 46.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Class::MakeMethods::Basic::Hash - Basic hash methods
4              
5              
6             =head1 SYNOPSIS
7              
8             package MyObject;
9             use Class::MakeMethods::Basic::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 Basic::Hash subclass of MakeMethods provides a basic 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::Basic::Hash;
60              
61             $VERSION = 1.000;
62 1     1   8598 use strict;
  1         2  
  1         44  
63 1     1   824 use Class::MakeMethods '-isasubclass';
  1         3  
  1         7  
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::Basic::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 2 my $class = shift;
114 1         2 map {
115 1         3 my $name = $_;
116             $name => sub {
117 4     4   1227 my $callee = shift;
118 4 100       14 if ( ref $callee ) {
119 1         131 bless { %$callee, @_ }, ref $callee;
120             } else {
121 3         23 bless { @_ }, $callee;
122             }
123             }
124 1         10 } @_;
125             }
126              
127             ########################################################################
128              
129             =head2 scalar - Instance Accessor
130              
131             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
132              
133             =over 4
134              
135             =item *
136              
137             Must be called on a hash-based instance.
138              
139             =item *
140              
141             Uses the method name as a hash key to access the related value for each instance.
142              
143             =item *
144              
145             If called without any arguments returns the current value.
146              
147             =item *
148              
149             If called with an argument, stores that as the value, and returns it,
150              
151             =back
152              
153             Sample declaration and usage:
154              
155             package MyObject;
156             use Class::MakeMethods::Basic::Hash (
157             scalar => 'foo',
158             );
159             ...
160            
161             # Store value
162             $obj->foo('Foozle');
163            
164             # Retrieve value
165             print $obj->foo;
166              
167             =cut
168              
169             sub scalar {
170 2     2 1 4 my $class = shift;
171 3         3 map {
172 2         4 my $name = $_;
173             $name => sub {
174 15 100   15   63 if ( scalar @_ > 1 ) {
175 2         14 $_[0]->{$name} = $_[1];
176             } else {
177 13         59 $_[0]->{$name};
178             }
179             }
180 3         16 } @_;
181             }
182              
183             ########################################################################
184              
185             =head2 array - Instance Ref Accessor
186              
187             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
188              
189             =over 4
190              
191             =item *
192              
193             Must be called on a hash-based instance.
194              
195             =item *
196              
197             Uses the method name as a hash key to access the related value for each instance.
198              
199             =item *
200              
201             The value for each instance will be a reference to an array (or undef).
202              
203             =item *
204              
205             If called without any arguments, returns the current array-ref value (or undef).
206              
207             =item *
208              
209             If called with one argument, uses that argument as an index to retrieve from the referenced array, and returns that value (or undef).
210              
211             =item *
212              
213             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.
214              
215             =back
216              
217             Sample declaration and usage:
218            
219             package MyObject;
220             use Class::MakeMethods::Basic::Hash (
221             array => 'bar',
222             );
223             ...
224            
225             # Set values by position
226             $obj->bar(0 => 'Foozle', 1 => 'Bang!');
227            
228             # Positions may be overwritten, and in any order
229             $obj->bar(2 => 'And Mash', 1 => 'Blah!');
230            
231             # Retrieve value by position
232             print $obj->bar(1);
233            
234             # Direct access to referenced array
235             print scalar @{ $obj->bar() };
236            
237             # Reset the array contents to empty
238             @{ $obj->bar() } = ();
239              
240             =cut
241              
242             sub array {
243 0     0 1   my $class = shift;
244 0           map {
245 0           my $name = $_;
246             $name => sub {
247 0     0     my $self = shift;
248 0 0         if ( scalar(@_) == 0 ) {
    0          
    0          
249 0           return $self->{$name};
250             } elsif ( scalar(@_) == 1 ) {
251 0           $self->{$name}->[ shift() ];
252             } elsif ( scalar(@_) % 2 ) {
253 0           Carp::croak "Odd number of items in assigment to $name";
254             } else {
255 0           while ( scalar(@_) ) {
256 0           my $key = shift();
257 0           $self->{$name}->[ $key ] = shift();
258             }
259 0           return $self->{$name};
260             }
261             }
262 0           } @_;
263             }
264              
265             ########################################################################
266              
267             =head2 hash - Instance Ref Accessor
268              
269             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
270              
271             =over 4
272              
273             =item *
274              
275             Must be called on a hash-based instance.
276              
277             =item *
278              
279             Uses the method name as a hash key to access the related value for each instance.
280              
281             =item *
282              
283             The value for each instance will be a reference to a hash (or undef).
284              
285             =item *
286              
287             If called without any arguments, returns the current hash-ref value (or undef).
288              
289             =item *
290              
291             If called with one argument, uses that argument as an index to retrieve from the referenced hash, and returns that value (or undef).
292              
293             =item *
294              
295             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.
296              
297             =back
298              
299             Sample declaration and usage:
300            
301             package MyObject;
302             use Class::MakeMethods::Basic::Hash (
303             hash => 'baz',
304             );
305             ...
306            
307             # Set values by key
308             $obj->baz('foo' => 'Foozle', 'bar' => 'Bang!');
309            
310             # Values may be overwritten, and in any order
311             $obj->baz('broccoli' => 'Blah!', 'foo' => 'Fiddle');
312            
313             # Retrieve value by key
314             print $obj->baz('foo');
315            
316             # Direct access to referenced hash
317             print keys %{ $obj->baz() };
318            
319             # Reset the hash contents to empty
320             @{ $obj->baz() } = ();
321              
322             =cut
323              
324             sub hash {
325 0     0 1   my $class = shift;
326 0           map {
327 0           my $name = $_;
328             $name => sub {
329 0     0     my $self = shift;
330 0 0         if ( scalar(@_) == 0 ) {
    0          
    0          
331 0           return $self->{$name};
332             } elsif ( scalar(@_) == 1 ) {
333 0           $self->{$name}->{ shift() };
334             } elsif ( scalar(@_) % 2 ) {
335 0           Carp::croak "Odd number of items in assigment to $name";
336             } else {
337 0           while ( scalar(@_) ) {
338 0           $self->{$name}->{ shift() } = shift();
339             }
340 0           return $self->{$name};
341             }
342             }
343 0           } @_;
344             }
345              
346             ########################################################################
347              
348             =head1 SEE ALSO
349              
350             See L for general information about this distribution.
351              
352             See L for more about this family of subclasses.
353              
354             See L for equivalent functionality
355             based on blessed arrays. If all access to your object is through
356             constructors and accessors declared using this package, and your
357             class will not be extensively subclassed, consider switching to
358             Basic::Array to minimize resource consumption.
359              
360             =cut
361              
362             1;