File Coverage

blib/lib/Config/General/Extended.pm
Criterion Covered Total %
statement 52 115 45.2
branch 18 60 30.0
condition 1 6 16.7
subroutine 13 20 65.0
pod 12 12 100.0
total 96 213 45.1


line stmt bran cond sub pod time code
1             #
2             # Config::General::Extended - special Class based on Config::General
3             #
4             # Copyright (c) 2000-2007 Thomas Linden <tlinden |AT| cpan.org>.
5             # All Rights Reserved. Std. disclaimer applies.
6             # Artificial License, same as perl itself. Have fun.
7             #
8              
9             # namespace
10             package Config::General::Extended;
11              
12             # yes we need the hash support of new() in 1.18 or higher!
13 1     1   14 use Config::General 1.18;
  1         80  
  1         18  
14              
15 1     1   17 use FileHandle;
  1         9  
  1         18  
16 1     1   18 use Carp;
  1         10  
  1         17  
17 1     1   16 use Exporter ();
  1         9  
  1         10  
18 1     1   15 use vars qw(@ISA @EXPORT);
  1         9  
  1         17  
19              
20             # inherit new() and so on from Config::General
21             @ISA = qw(Config::General Exporter);
22              
23 1     1   24 use strict;
  1         9  
  1         19  
24              
25              
26             $Config::General::Extended::VERSION = "2.02";
27              
28              
29             sub new {
30 0     0 1 0   croak "Deprecated method Config::General::Extended::new() called.\n"
31                    ."Use Config::General::new() instead and set the -ExtendedAccess flag.\n";
32             }
33              
34              
35             sub obj {
36             #
37             # returns a config object from a given key
38             # or from the current config hash if the $key does not exist
39             # or an empty object if the content of $key is empty.
40             #
41 4     4 1 39   my($this, $key) = @_;
42              
43             # just create the empty object, just in case
44 4         55   my $empty = $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => {}, %{$this->{Params}} );
  4         117  
45              
46 4 50       48   if (exists $this->{config}->{$key}) {
47 4 50       59     if (!$this->{config}->{$key}) {
    50          
    50          
48             # be cool, create an empty object!
49 0         0       return $empty
50                 }
51                 elsif (ref($this->{config}->{$key}) eq "ARRAY") {
52 0         0       my @objlist;
53 0         0       foreach my $element (@{$this->{config}->{$key}}) {
  0         0  
54 0 0       0 if (ref($element) eq "HASH") {
55 0         0 push @objlist,
56             $this->SUPER::new( -ExtendedAccess => 1,
57             -ConfigHash     => $element,
58 0         0 %{$this->{Params}} );
59             }
60             else {
61 0 0       0 if ($this->{StrictObjects}) {
62 0         0 croak "element in list \"$key\" does not point to a hash reference!\n";
63             }
64             # else: skip this element
65             }
66                   }
67 0         0       return \@objlist;
68                 }
69                 elsif (ref($this->{config}->{$key}) eq "HASH") {
70 4         70       return $this->SUPER::new( -ExtendedAccess => 1,
71 4         43 -ConfigHash => $this->{config}->{$key}, %{$this->{Params}} );
72                 }
73                 else {
74             # nothing supported
75 0 0       0       if ($this->{StrictObjects}) {
76 0         0 croak "key \"$key\" does not point to a hash reference!\n";
77                   }
78                   else {
79             # be cool, create an empty object!
80 0         0 return $empty;
81                   }
82                 }
83               }
84               else {
85             # even return an empty object if $key does not exist
86 0         0     return $empty;
87               }
88             }
89              
90              
91             sub value {
92             #
93             # returns a value of the config hash from a given key
94             # this can be a hashref or a scalar
95             #
96 3     3 1 28   my($this, $key, $value) = @_;
97 3 50       29   if (defined $value) {
98 0         0     $this->{config}->{$key} = $value;
99               }
100               else {
101 3 50       32     if (exists $this->{config}->{$key}) {
102 3         35       return $this->{config}->{$key};
103                 }
104                 else {
105 0 0       0       if ($this->{StrictObjects}) {
106 0         0 croak "Key \"$key\" does not exist within current object\n";
107                   }
108                   else {
109 0         0 return "";
110                   }
111                 }
112               }
113             }
114              
115              
116             sub hash {
117             #
118             # returns a value of the config hash from a given key
119             # as hash
120             #
121 0     0 1 0   my($this, $key) = @_;
122 0 0       0   if (exists $this->{config}->{$key}) {
123 0         0     return %{$this->{config}->{$key}};
  0         0  
124               }
125               else {
126 0 0       0     if ($this->{StrictObjects}) {
127 0         0       croak "Key \"$key\" does not exist within current object\n";
128                 }
129                 else {
130 0         0       return ();
131                 }
132               }
133             }
134              
135              
136             sub array {
137             #
138             # returns a value of the config hash from a given key
139             # as array
140             #
141 0     0 1 0   my($this, $key) = @_;
142 0 0       0   if (exists $this->{config}->{$key}) {
143 0         0     return @{$this->{config}->{$key}};
  0         0  
144               }
145 0 0       0   if ($this->{StrictObjects}) {
146 0         0       croak "Key \"$key\" does not exist within current object\n";
147                 }
148               else {
149 0         0     return ();
150               }
151             }
152              
153              
154              
155             sub is_hash {
156             #
157             # return true if the given key contains a hashref
158             #
159 3     3 1 29   my($this, $key) = @_;
160 3 50       34   if (exists $this->{config}->{$key}) {
161 3 100       33     if (ref($this->{config}->{$key}) eq "HASH") {
162 1         13       return 1;
163                 }
164                 else {
165 2         26       return;
166                 }
167               }
168               else {
169 0         0     return;
170               }
171             }
172              
173              
174              
175             sub is_array {
176             #
177             # return true if the given key contains an arrayref
178             #
179 2     2 1 18   my($this, $key) = @_;
180 2 50       58   if (exists $this->{config}->{$key}) {
181 2 50       22     if (ref($this->{config}->{$key}) eq "ARRAY") {
182 0         0       return 1;
183                 }
184                 else {
185 2         21       return;
186                 }
187               }
188               else {
189 0         0     return;
190               }
191             }
192              
193              
194             sub is_scalar {
195             #
196             # returns true if the given key contains a scalar(or number)
197             #
198 0     0 1 0   my($this, $key) = @_;
199 0 0 0     0   if (exists $this->{config}->{$key} && !ref($this->{config}->{$key})) {
200 0         0     return 1;
201               }
202 0         0   return;
203             }
204              
205              
206              
207             sub exists {
208             #
209             # returns true if the key exists
210             #
211 0     0 1 0   my($this, $key) = @_;
212 0 0       0   if (exists $this->{config}->{$key}) {
213 0         0     return 1;
214               }
215               else {
216 0         0     return;
217               }
218             }
219              
220              
221             sub keys {
222             #
223             # returns all keys under in the hash of the specified key, if
224             # it contains keys (so it must be a hash!)
225             #
226 3     3 1 30   my($this, $key) = @_;
227 3 50 33     56   if (!$key) {
    50          
228 0 0       0     if (ref($this->{config}) eq "HASH") {
229 0         0       return map { $_ } keys %{$this->{config}};
  0         0  
  0         0  
230                 }
231                 else {
232 0         0       return ();
233                 }
234               }
235               elsif (exists $this->{config}->{$key} && ref($this->{config}->{$key}) eq "HASH") {
236 3         25     return map { $_ } keys %{$this->{config}->{$key}};
  5         54  
  3         36  
237               }
238               else {
239 0         0     return ();
240               }
241             }
242              
243              
244             sub delete {
245             #
246             # delete the given key from the config, if any
247             # and return what is deleted (just as 'delete $hash{key}' does)
248             #
249 0     0 1 0   my($this, $key) = @_;
250 0 0       0   if (exists $this->{config}->{$key}) {
251 0         0     return delete $this->{config}->{$key};
252               }
253               else {
254 0         0     return undef;
255               }
256             }
257              
258              
259             #
260             # removed, use save() of General.pm now
261             # sub save {
262             # #
263             # # save the config back to disk
264             # #
265             # my($this,$file) = @_;
266             # my $fh = new FileHandle;
267             #
268             # if (!$file) {
269             # $file = $this->{configfile};
270             # }
271             #
272             # $this->save_file($file);
273             # }
274              
275              
276             sub configfile {
277             #
278             # sets or returns the config filename
279             #
280 0     0 1 0   my($this,$file) = @_;
281 0 0       0   if ($file) {
282 0         0     $this->{configfile} = $file;
283               }
284 0         0   return $this->{configfile};
285             }
286              
287              
288              
289             sub AUTOLOAD {
290             #
291             # returns the representing value, if it is a scalar.
292             #
293 4     4   37   my($this, $value) = @_;
294 4         35   my $key = $Config::General::Extended::AUTOLOAD; # get to know how we were called
295 4         41   $key =~ s/.*:://; # remove package name!
296              
297 4 100       42   if ($value) {
    50          
298             # just set $key to $value!
299 2         23     $this->{config}->{$key} = $value;
300               }
301               elsif (exists $this->{config}->{$key}) {
302 2 50       21     if ($this->is_hash($key)) {
    50          
303 0         0       croak "Key \"$key\" points to a hash and cannot be automatically accessed\n";
304                 }
305                 elsif ($this->is_array($key)) {
306 0         0       croak "Key \"$key\" points to an array and cannot be automatically accessed\n";
307                 }
308                 else {
309 2         25       return $this->{config}->{$key};
310                 }
311               }
312               else {
313 0 0       0     if ($this->{StrictObjects}) {
314 0         0       croak "Key \"$key\" does not exist within current object\n";
315                 }
316                 else {
317             # be cool
318 0         0       return "";
319                 }
320               }
321             }
322              
323             sub DESTROY {
324 11     11   117   my $this = shift;
325 11         94   $this = ();
326             }
327              
328             # keep this one
329             1;
330              
331              
332              
333              
334              
335             =head1 NAME
336            
337             Config::General::Extended - Extended access to Config files
338            
339            
340             =head1 SYNOPSIS
341            
342             use Config::General;
343            
344             $conf = new Config::General(
345             -ConfigFile => 'configfile',
346             -ExtendedAccess => 1
347             );
348            
349             =head1 DESCRIPTION
350            
351             This is an internal module which makes it possible to use object
352             oriented methods to access parts of your config file.
353            
354             Normally you don't call it directly.
355            
356             =head1 METHODS
357            
358             =over
359            
360       &n