File Coverage

blib/lib/Class/MakeMethods/Basic/Global.pm
Criterion Covered Total %
statement 25 40 62.5
branch 7 14 50.0
condition n/a
subroutine 5 7 71.4
pod 3 3 100.0
total 40 64 62.5


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Class::MakeMethods::Basic::Global - Basic shared methods
4              
5             =head1 SYNOPSIS
6              
7             package MyObject;
8             use Class::MakeMethods::Basic::Global (
9             scalar => [ 'foo', 'bar' ],
10             array => 'my_list',
11             hash => 'my_index',
12             );
13             ....
14            
15             # Store and retrieve global values
16             MyObject->foo('Foobar');
17             print MyObject->foo();
18            
19             # All instances of your class access the same values
20             $my_object->bar('Barbados');
21             print $other_one->bar();
22            
23             # Array accessor
24             MyObject->my_list(0 => 'Foozle', 1 => 'Bang!');
25             print MyObject->my_list(1);
26            
27             # Hash accessor
28             MyObject->my_index('broccoli' => 'Blah!', 'foo' => 'Fiddle');
29             print MyObject->my_index('foo');
30              
31              
32             =head1 DESCRIPTION
33              
34             The Basic::Global subclass of MakeMethods provides basic accessors for data shared by an entire class, sometimes called "static" or "class data."
35              
36             =head2 Calling Conventions
37              
38             When you C this package, the method names you provide
39             as arguments cause subroutines to be generated and installed in
40             your module.
41              
42             See L for a summary, or L for full details.
43              
44             =head2 Declaration Syntax
45              
46             To declare methods, pass in pairs of a method-type name followed
47             by one or more method names. Valid method-type names for this
48             package are listed in L<"METHOD GENERATOR TYPES">.
49              
50             See L for more
51             syntax information.
52              
53             =cut
54              
55             package Class::MakeMethods::Basic::Global;
56              
57             $VERSION = 1.000;
58 2     2   19393 use Class::MakeMethods '-isasubclass';
  2         6  
  2         14  
59              
60             ########################################################################
61              
62             =head1 METHOD GENERATOR TYPES
63              
64             =head2 scalar - Shared Accessor
65              
66             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
67              
68             =over 4
69              
70             =item *
71              
72             May be called as a class method, or equivalently, on any object instance.
73              
74             =item *
75              
76             Stores a global value accessible only through this method.
77              
78             =item *
79              
80             If called without any arguments returns the current value.
81              
82             =item *
83              
84             If called with an argument, stores that as the value, and returns it,
85              
86             =back
87              
88             Sample declaration and usage:
89              
90             package MyObject;
91             use Class::MakeMethods::Basic::Hash (
92             scalar => 'foo',
93             );
94             ...
95            
96             # Store value
97             MyObject->foo('Foozle');
98            
99             # Retrieve value
100             print MyObject->foo;
101              
102             =cut
103              
104             sub scalar {
105 2     2 1 6 my $class = shift;
106 3         6 map {
107 2         3 my $name = $_;
108             $name => sub {
109 22     22   133 my $self = shift;
110 22 100       44 if ( scalar @_ ) {
111 6         23 $value = shift;
112             } else {
113 16         62 $value;
114             }
115             }
116 3         31 } @_;
117             }
118              
119             ########################################################################
120              
121             =head2 array - Shared Ref Accessor
122              
123             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
124              
125             =over 4
126              
127             =item *
128              
129             May be called as a class method, or equivalently, on any object instance.
130              
131             =item *
132              
133             Stores a global value accessible only through this method.
134              
135             =item *
136              
137             The value will be a reference to an array (or undef).
138              
139             =item *
140              
141             If called without any arguments, returns the current array-ref value (or undef).
142              
143             =item *
144              
145             If called with one argument, uses that argument as an index to retrieve from the referenced array, and returns that value (or undef). If the single argument is an array ref, then a slice of the referenced array is returned.
146              
147             =item *
148              
149             If called with a list of index-value pairs, stores the value at the given index in the referenced array. If the 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.
150              
151             =back
152              
153             Sample declaration and usage:
154              
155             package MyObject;
156             use Class::MakeMethods::Basic::Hash (
157             array => 'bar',
158             );
159             ...
160            
161             # Set values by position
162             $obj->bar(0 => 'Foozle', 1 => 'Bang!');
163            
164             # Positions may be overwritten, and in any order
165             $obj->bar(2 => 'And Mash', 1 => 'Blah!');
166            
167             # Retrieve value by position
168             print $obj->bar(1);
169            
170             # Retrieve slice of values by position
171             print join(', ', $obj->bar( [0, 2] ) );
172            
173             # Direct access to referenced array
174             print scalar @{ $obj->bar() };
175            
176             # Reset the array contents to empty
177             @{ $obj->bar() } = ();
178              
179             =cut
180              
181             sub array {
182 0     0 1 0 my $class = shift;
183 0         0 map {
184 0         0 my $name = $_;
185 0         0 my $value = [];
186             $name => sub {
187 0     0   0 my $self = shift;
188 0 0       0 if ( scalar(@_) == 1 ) {
    0          
189 0         0 my $index = shift;
190 0 0       0 ref($index) ? @{$value}[ @$index ] : $value->[ $index ];
  0         0  
191             } elsif ( scalar(@_) % 2 ) {
192 0         0 Carp::croak "Odd number of items in assigment to $name";
193             } else {
194 0         0 while ( scalar(@_) ) {
195 0         0 $value->[ shift() ] = shift();
196             }
197 0         0 return $value;
198             }
199             }
200 0         0 } @_;
201             }
202              
203             ########################################################################
204              
205             =head2 hash - Shared Ref Accessor
206              
207             For each method name passed, uses a closure to generate a subroutine with the following characteristics:
208              
209             =over 4
210              
211             =item *
212              
213             May be called as a class method, or equivalently, on any object instance.
214              
215             =item *
216              
217             Stores a global value accessible only through this method.
218              
219             =item *
220              
221             The value will be a reference to a hash (or undef).
222              
223             =item *
224              
225             If called without any arguments, returns the current hash-ref value (or undef).
226              
227             =item *
228              
229             If called with one argument, uses that argument as an index to retrieve from the referenced hash, and returns that value (or undef). If the single argument is an array ref, then a slice of the referenced hash is returned.
230              
231             =item *
232              
233             If called with a list of key-value pairs, stores the value under the given key in the referenced hash. If the 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.
234              
235             =back
236              
237             Sample declaration and usage:
238              
239             package MyObject;
240             use Class::MakeMethods::Basic::Hash (
241             hash => 'baz',
242             );
243             ...
244            
245             # Set values by key
246             $obj->baz('foo' => 'Foozle', 'bar' => 'Bang!');
247            
248             # Values may be overwritten, and in any order
249             $obj->baz('broccoli' => 'Blah!', 'foo' => 'Fiddle');
250            
251             # Retrieve value by key
252             print $obj->baz('foo');
253            
254             # Retrieve slice of values by position
255             print join(', ', $obj->baz( ['foo', 'bar'] ) );
256            
257             # Direct access to referenced hash
258             print keys %{ $obj->baz() };
259            
260             # Reset the hash contents to empty
261             @{ $obj->baz() } = ();
262              
263             =cut
264              
265             sub hash {
266 1     1 1 2 my $class = shift;
267 2         3 map {
268 1         2 my $name = $_;
269 2         3 my $value = {};
270             $name => sub {
271 15     15   2331 my $self = shift;
272 15 100       56 if ( scalar(@_) == 1 ) {
    50          
273 4         6 my $index = shift;
274 4 100       41 ref($index) ? @{$value}{ @$index } : $value->{ $index };
  1         6  
275             } elsif ( scalar(@_) % 2 ) {
276 0         0 Carp::croak "Odd number of items in assigment to $name";
277             } else {
278 11         28 while ( scalar(@_) ) {
279 6         9 my $key = shift;
280 6         20 $value->{ $key } = shift();
281             }
282 11         54 $value;
283             }
284             }
285 2         16 } @_;
286             }
287              
288             ########################################################################
289              
290             =head1 SEE ALSO
291              
292             See L for general information about this distribution.
293              
294             See L for more about this family of subclasses.
295              
296             =cut
297              
298             1;