Commit | Line | Data |
3fea05b9 |
1 | #============================================================================ |
2 | # |
3 | # AppConfig::State.pm |
4 | # |
5 | # Perl5 module in which configuration information for an application can |
6 | # be stored and manipulated. AppConfig::State objects maintain knowledge |
7 | # about variables; their identities, options, aliases, targets, callbacks |
8 | # and so on. This module is used by a number of other AppConfig::* modules. |
9 | # |
10 | # Written by Andy Wardley <abw@wardley.org> |
11 | # |
12 | # Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved. |
13 | # Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. |
14 | # |
15 | #---------------------------------------------------------------------------- |
16 | # |
17 | # TODO |
18 | # |
19 | # * Change varlist() to varhash() and provide another varlist() method |
20 | # which returns a list. Multiple parameters passed implies a hash |
21 | # slice/list grep, a single parameter should indicate a regex. |
22 | # |
23 | # * Perhaps allow a callback to be installed which is called *instead* of |
24 | # the get() and set() methods (or rather, is called by them). |
25 | # |
26 | # * Maybe CMDARG should be in there to specify extra command-line only |
27 | # options that get added to the AppConfig::GetOpt alias construction, |
28 | # but not applied in config files, general usage, etc. The GLOBAL |
29 | # CMDARG might be specified as a format, e.g. "-%c" where %s = name, |
30 | # %c = first character, %u - first unique sequence(?). Will |
31 | # GetOpt::Long handle --long to -l application automagically? |
32 | # |
33 | # * ..and an added thought is that CASE sensitivity may be required for the |
34 | # command line (-v vs -V, -r vs -R, for example), but not for parsing |
35 | # config files where you may wish to treat "Name", "NAME" and "name" alike. |
36 | # |
37 | #============================================================================ |
38 | |
39 | package AppConfig::State; |
40 | use strict; |
41 | use warnings; |
42 | |
43 | our $VERSION = '1.65'; |
44 | our $DEBUG = 0; |
45 | our $AUTOLOAD; |
46 | |
47 | # need access to AppConfig::ARGCOUNT_* |
48 | use AppConfig ':argcount'; |
49 | |
50 | # internal per-variable hashes that AUTOLOAD should provide access to |
51 | my %METHVARS; |
52 | @METHVARS{ qw( EXPAND ARGS ARGCOUNT ) } = (); |
53 | |
54 | # internal values that AUTOLOAD should provide access to |
55 | my %METHFLAGS; |
56 | @METHFLAGS{ qw( PEDANTIC ) } = (); |
57 | |
58 | # variable attributes that may be specified in GLOBAL; |
59 | my @GLOBAL_OK = qw( DEFAULT EXPAND VALIDATE ACTION ARGS ARGCOUNT ); |
60 | |
61 | |
62 | #------------------------------------------------------------------------ |
63 | # new(\%config, @vars) |
64 | # |
65 | # Module constructor. A reference to a hash array containing |
66 | # configuration options may be passed as the first parameter. This is |
67 | # passed off to _configure() for processing. See _configure() for |
68 | # information about configurarion options. The remaining parameters |
69 | # may be variable definitions and are passed en masse to define() for |
70 | # processing. |
71 | # |
72 | # Returns a reference to a newly created AppConfig::State object. |
73 | #------------------------------------------------------------------------ |
74 | |
75 | sub new { |
76 | my $class = shift; |
77 | |
78 | my $self = { |
79 | # internal hash arrays to store variable specification information |
80 | VARIABLE => { }, # variable values |
81 | DEFAULT => { }, # default values |
82 | ALIAS => { }, # known aliases ALIAS => VARIABLE |
83 | ALIASES => { }, # reverse alias lookup VARIABLE => ALIASES |
84 | ARGCOUNT => { }, # arguments expected |
85 | ARGS => { }, # specific argument pattern (AppConfig::Getopt) |
86 | EXPAND => { }, # variable expansion (AppConfig::File) |
87 | VALIDATE => { }, # validation regexen or functions |
88 | ACTION => { }, # callback functions for when variable is set |
89 | GLOBAL => { }, # default global settings for new variables |
90 | |
91 | # other internal data |
92 | CREATE => 0, # auto-create variables when set |
93 | CASE => 0, # case sensitivity flag (1 = sensitive) |
94 | PEDANTIC => 0, # return immediately on parse warnings |
95 | EHANDLER => undef, # error handler (let's hope we don't need it!) |
96 | ERROR => '', # error message |
97 | }; |
98 | |
99 | bless $self, $class; |
100 | |
101 | # configure if first param is a config hash ref |
102 | $self->_configure(shift) |
103 | if ref($_[0]) eq 'HASH'; |
104 | |
105 | # call define(@_) to handle any variables definitions |
106 | $self->define(@_) |
107 | if @_; |
108 | |
109 | return $self; |
110 | } |
111 | |
112 | |
113 | #------------------------------------------------------------------------ |
114 | # define($variable, \%cfg, [$variable, \%cfg, ...]) |
115 | # |
116 | # Defines one or more variables. The first parameter specifies the |
117 | # variable name. The following parameter may reference a hash of |
118 | # configuration options for the variable. Further variables and |
119 | # configuration hashes may follow and are processed in turn. If the |
120 | # parameter immediately following a variable name isn't a hash reference |
121 | # then it is ignored and the variable is defined without a specific |
122 | # configuration, although any default parameters as specified in the |
123 | # GLOBAL option will apply. |
124 | # |
125 | # The $variable value may contain an alias/args definition in compact |
126 | # format, such as "Foo|Bar=1". |
127 | # |
128 | # A warning is issued (via _error()) if an invalid option is specified. |
129 | #------------------------------------------------------------------------ |
130 | |
131 | sub define { |
132 | my $self = shift; |
133 | my ($var, $args, $count, $opt, $val, $cfg, @names); |
134 | |
135 | while (@_) { |
136 | $var = shift; |
137 | $cfg = ref($_[0]) eq 'HASH' ? shift : { }; |
138 | |
139 | # variable may be specified in compact format, 'foo|bar=i@' |
140 | if ($var =~ s/(.+?)([!+=:].*)/$1/) { |
141 | |
142 | # anything coming after the name|alias list is the ARGS |
143 | $cfg->{ ARGS } = $2 |
144 | if length $2; |
145 | } |
146 | |
147 | # examine any ARGS option |
148 | if (defined ($args = $cfg->{ ARGS })) { |
149 | ARGGCOUNT: { |
150 | $count = ARGCOUNT_NONE, last if $args =~ /^!/; |
151 | $count = ARGCOUNT_LIST, last if $args =~ /@/; |
152 | $count = ARGCOUNT_HASH, last if $args =~ /%/; |
153 | $count = ARGCOUNT_ONE; |
154 | } |
155 | $cfg->{ ARGCOUNT } = $count; |
156 | } |
157 | |
158 | # split aliases out |
159 | @names = split(/\|/, $var); |
160 | $var = shift @names; |
161 | $cfg->{ ALIAS } = [ @names ] if @names; |
162 | |
163 | # variable name gets folded to lower unless CASE sensitive |
164 | $var = lc $var unless $self->{ CASE }; |
165 | |
166 | # activate $variable (so it does 'exist()') |
167 | $self->{ VARIABLE }->{ $var } = undef; |
168 | |
169 | # merge GLOBAL and variable-specific configurations |
170 | $cfg = { %{ $self->{ GLOBAL } }, %$cfg }; |
171 | |
172 | # examine each variable configuration parameter |
173 | while (($opt, $val) = each %$cfg) { |
174 | $opt = uc $opt; |
175 | |
176 | # DEFAULT, VALIDATE, EXPAND, ARGS and ARGCOUNT are stored as |
177 | # they are; |
178 | $opt =~ /^DEFAULT|VALIDATE|EXPAND|ARGS|ARGCOUNT$/ && do { |
179 | $self->{ $opt }->{ $var } = $val; |
180 | next; |
181 | }; |
182 | |
183 | # CMDARG has been deprecated |
184 | $opt eq 'CMDARG' && do { |
185 | $self->_error("CMDARG has been deprecated. " |
186 | . "Please use an ALIAS if required."); |
187 | next; |
188 | }; |
189 | |
190 | # ACTION should be a code ref |
191 | $opt eq 'ACTION' && do { |
192 | unless (ref($val) eq 'CODE') { |
193 | $self->_error("'$opt' value is not a code reference"); |
194 | next; |
195 | }; |
196 | |
197 | # store code ref, forcing keyword to upper case |
198 | $self->{ ACTION }->{ $var } = $val; |
199 | |
200 | next; |
201 | }; |
202 | |
203 | # ALIAS creates alias links to the variable name |
204 | $opt eq 'ALIAS' && do { |
205 | |
206 | # coerce $val to an array if not already so |
207 | $val = [ split(/\|/, $val) ] |
208 | unless ref($val) eq 'ARRAY'; |
209 | |
210 | # fold to lower case unless CASE sensitivity set |
211 | unless ($self->{ CASE }) { |
212 | @$val = map { lc } @$val; |
213 | } |
214 | |
215 | # store list of aliases... |
216 | $self->{ ALIASES }->{ $var } = $val; |
217 | |
218 | # ...and create ALIAS => VARIABLE lookup hash entries |
219 | foreach my $a (@$val) { |
220 | $self->{ ALIAS }->{ $a } = $var; |
221 | } |
222 | |
223 | next; |
224 | }; |
225 | |
226 | # default |
227 | $self->_error("$opt is not a valid configuration item"); |
228 | } |
229 | |
230 | # set variable to default value |
231 | $self->_default($var); |
232 | |
233 | # DEBUG: dump new variable definition |
234 | if ($DEBUG) { |
235 | print STDERR "Variable defined:\n"; |
236 | $self->_dump_var($var); |
237 | } |
238 | } |
239 | } |
240 | |
241 | |
242 | #------------------------------------------------------------------------ |
243 | # get($variable) |
244 | # |
245 | # Returns the value of the variable specified, $variable. Returns undef |
246 | # if the variable does not exists or is undefined and send a warning |
247 | # message to the _error() function. |
248 | #------------------------------------------------------------------------ |
249 | |
250 | sub get { |
251 | my $self = shift; |
252 | my $variable = shift; |
253 | my $negate = 0; |
254 | my $value; |
255 | |
256 | # _varname returns variable name after aliasing and case conversion |
257 | # $negate indicates if the name got converted from "no<var>" to "<var>" |
258 | $variable = $self->_varname($variable, \$negate); |
259 | |
260 | # check the variable has been defined |
261 | unless (exists($self->{ VARIABLE }->{ $variable })) { |
262 | $self->_error("$variable: no such variable"); |
263 | return undef; |
264 | } |
265 | |
266 | # DEBUG |
267 | print STDERR "$self->get($variable) => ", |
268 | defined $self->{ VARIABLE }->{ $variable } |
269 | ? $self->{ VARIABLE }->{ $variable } |
270 | : "<undef>", |
271 | "\n" |
272 | if $DEBUG; |
273 | |
274 | # return variable value, possibly negated if the name was "no<var>" |
275 | $value = $self->{ VARIABLE }->{ $variable }; |
276 | |
277 | return $negate ? !$value : $value; |
278 | } |
279 | |
280 | |
281 | #------------------------------------------------------------------------ |
282 | # set($variable, $value) |
283 | # |
284 | # Assigns the value, $value, to the variable specified. |
285 | # |
286 | # Returns 1 if the variable is successfully updated or 0 if the variable |
287 | # does not exist. If an ACTION sub-routine exists for the variable, it |
288 | # will be executed and its return value passed back. |
289 | #------------------------------------------------------------------------ |
290 | |
291 | sub set { |
292 | my $self = shift; |
293 | my $variable = shift; |
294 | my $value = shift; |
295 | my $negate = 0; |
296 | my $create; |
297 | |
298 | # _varname returns variable name after aliasing and case conversion |
299 | # $negate indicates if the name got converted from "no<var>" to "<var>" |
300 | $variable = $self->_varname($variable, \$negate); |
301 | |
302 | # check the variable exists |
303 | if (exists($self->{ VARIABLE }->{ $variable })) { |
304 | # variable found, so apply any value negation |
305 | $value = $value ? 0 : 1 if $negate; |
306 | } |
307 | else { |
308 | # auto-create variable if CREATE is 1 or a pattern matching |
309 | # the variable name (real name, not an alias) |
310 | $create = $self->{ CREATE }; |
311 | if (defined $create |
312 | && ($create eq '1' || $variable =~ /$create/)) { |
313 | $self->define($variable); |
314 | |
315 | print STDERR "Auto-created $variable\n" if $DEBUG; |
316 | } |
317 | else { |
318 | $self->_error("$variable: no such variable"); |
319 | return 0; |
320 | } |
321 | } |
322 | |
323 | # call the validate($variable, $value) method to perform any validation |
324 | unless ($self->_validate($variable, $value)) { |
325 | $self->_error("$variable: invalid value: $value"); |
326 | return 0; |
327 | } |
328 | |
329 | # DEBUG |
330 | print STDERR "$self->set($variable, ", |
331 | defined $value |
332 | ? $value |
333 | : "<undef>", |
334 | ")\n" |
335 | if $DEBUG; |
336 | |
337 | |
338 | # set the variable value depending on its ARGCOUNT |
339 | my $argcount = $self->{ ARGCOUNT }->{ $variable }; |
340 | $argcount = AppConfig::ARGCOUNT_ONE unless defined $argcount; |
341 | |
342 | if ($argcount eq AppConfig::ARGCOUNT_LIST) { |
343 | # push value onto the end of the list |
344 | push(@{ $self->{ VARIABLE }->{ $variable } }, $value); |
345 | } |
346 | elsif ($argcount eq AppConfig::ARGCOUNT_HASH) { |
347 | # insert "<key>=<value>" data into hash |
348 | my ($k, $v) = split(/\s*=\s*/, $value, 2); |
349 | # strip quoting |
350 | $v =~ s/^(['"])(.*)\1$/$2/ if defined $v; |
351 | $self->{ VARIABLE }->{ $variable }->{ $k } = $v; |
352 | } |
353 | else { |
354 | # set simple variable |
355 | $self->{ VARIABLE }->{ $variable } = $value; |
356 | } |
357 | |
358 | |
359 | # call any ACTION function bound to this variable |
360 | return &{ $self->{ ACTION }->{ $variable } }($self, $variable, $value) |
361 | if (exists($self->{ ACTION }->{ $variable })); |
362 | |
363 | # ...or just return 1 (ok) |
364 | return 1; |
365 | } |
366 | |
367 | |
368 | #------------------------------------------------------------------------ |
369 | # varlist($criteria, $filter) |
370 | # |
371 | # Returns a hash array of all variables and values whose real names |
372 | # match the $criteria regex pattern passed as the first parameter. |
373 | # If $filter is set to any true value, the keys of the hash array |
374 | # (variable names) will have the $criteria part removed. This allows |
375 | # the caller to specify the variables from one particular [block] and |
376 | # have the "block_" prefix removed, for example. |
377 | # |
378 | # TODO: This should be changed to varhash(). varlist() should return a |
379 | # list. Also need to consider specification by list rather than regex. |
380 | # |
381 | #------------------------------------------------------------------------ |
382 | |
383 | sub varlist { |
384 | my $self = shift; |
385 | my $criteria = shift; |
386 | my $strip = shift; |
387 | |
388 | $criteria = "" unless defined $criteria; |
389 | |
390 | # extract relevant keys and slice out corresponding values |
391 | my @keys = grep(/$criteria/, keys %{ $self->{ VARIABLE } }); |
392 | my @vals = @{ $self->{ VARIABLE } }{ @keys }; |
393 | my %set; |
394 | |
395 | # clean off the $criteria part if $strip is set |
396 | @keys = map { s/$criteria//; $_ } @keys if $strip; |
397 | |
398 | # slice values into the target hash |
399 | @set{ @keys } = @vals; |
400 | return %set; |
401 | } |
402 | |
403 | |
404 | #------------------------------------------------------------------------ |
405 | # AUTOLOAD |
406 | # |
407 | # Autoload function called whenever an unresolved object method is |
408 | # called. If the method name relates to a defined VARIABLE, we patch |
409 | # in $self->get() and $self->set() to magically update the varaiable |
410 | # (if a parameter is supplied) and return the previous value. |
411 | # |
412 | # Thus the function can be used in the folowing ways: |
413 | # $state->variable(123); # set a new value |
414 | # $foo = $state->variable(); # get the current value |
415 | # |
416 | # Returns the current value of the variable, taken before any new value |
417 | # is set. Prints a warning if the variable isn't defined (i.e. doesn't |
418 | # exist rather than exists with an undef value) and returns undef. |
419 | #------------------------------------------------------------------------ |
420 | |
421 | sub AUTOLOAD { |
422 | my $self = shift; |
423 | my ($variable, $attrib); |
424 | |
425 | |
426 | # splat the leading package name |
427 | ($variable = $AUTOLOAD) =~ s/.*:://; |
428 | |
429 | # ignore destructor |
430 | $variable eq 'DESTROY' && return; |
431 | |
432 | |
433 | # per-variable attributes and internal flags listed as keys in |
434 | # %METHFLAGS and %METHVARS respectively can be accessed by a |
435 | # method matching the attribute or flag name in lower case with |
436 | # a leading underscore_ |
437 | if (($attrib = $variable) =~ s/_//g) { |
438 | $attrib = uc $attrib; |
439 | |
440 | if (exists $METHFLAGS{ $attrib }) { |
441 | return $self->{ $attrib }; |
442 | } |
443 | |
444 | if (exists $METHVARS{ $attrib }) { |
445 | # next parameter should be variable name |
446 | $variable = shift; |
447 | $variable = $self->_varname($variable); |
448 | |
449 | # check we've got a valid variable |
450 | # $self->_error("$variable: no such variable or method"), |
451 | # return undef |
452 | # unless exists($self->{ VARIABLE }->{ $variable }); |
453 | |
454 | # return attribute |
455 | return $self->{ $attrib }->{ $variable }; |
456 | } |
457 | } |
458 | |
459 | # set a new value if a parameter was supplied or return the old one |
460 | return defined($_[0]) |
461 | ? $self->set($variable, shift) |
462 | : $self->get($variable); |
463 | } |
464 | |
465 | |
466 | |
467 | #======================================================================== |
468 | # ----- PRIVATE METHODS ----- |
469 | #======================================================================== |
470 | |
471 | #------------------------------------------------------------------------ |
472 | # _configure(\%cfg) |
473 | # |
474 | # Sets the various configuration options using the values passed in the |
475 | # hash array referenced by $cfg. |
476 | #------------------------------------------------------------------------ |
477 | |
478 | sub _configure { |
479 | my $self = shift; |
480 | my $cfg = shift || return; |
481 | |
482 | # construct a regex to match values which are ok to be found in GLOBAL |
483 | my $global_ok = join('|', @GLOBAL_OK); |
484 | |
485 | foreach my $opt (keys %$cfg) { |
486 | |
487 | # GLOBAL must be a hash ref |
488 | $opt =~ /^GLOBALS?$/i && do { |
489 | unless (ref($cfg->{ $opt }) eq 'HASH') { |
490 | $self->_error("\U$opt\E parameter is not a hash ref"); |
491 | next; |
492 | } |
493 | |
494 | # we check each option is ok to be in GLOBAL, but we don't do |
495 | # any error checking on the values they contain (but should?). |
496 | foreach my $global ( keys %{ $cfg->{ $opt } } ) { |
497 | |
498 | # continue if the attribute is ok to be GLOBAL |
499 | next if ($global =~ /(^$global_ok$)/io); |
500 | |
501 | $self->_error( "\U$global\E parameter cannot be GLOBAL"); |
502 | } |
503 | $self->{ GLOBAL } = $cfg->{ $opt }; |
504 | next; |
505 | }; |
506 | |
507 | # CASE, CREATE and PEDANTIC are stored as they are |
508 | $opt =~ /^CASE|CREATE|PEDANTIC$/i && do { |
509 | $self->{ uc $opt } = $cfg->{ $opt }; |
510 | next; |
511 | }; |
512 | |
513 | # ERROR triggers $self->_ehandler() |
514 | $opt =~ /^ERROR$/i && do { |
515 | $self->_ehandler($cfg->{ $opt }); |
516 | next; |
517 | }; |
518 | |
519 | # DEBUG triggers $self->_debug() |
520 | $opt =~ /^DEBUG$/i && do { |
521 | $self->_debug($cfg->{ $opt }); |
522 | next; |
523 | }; |
524 | |
525 | # warn about invalid options |
526 | $self->_error("\U$opt\E is not a valid configuration option"); |
527 | } |
528 | } |
529 | |
530 | |
531 | #------------------------------------------------------------------------ |
532 | # _varname($variable, \$negated) |
533 | # |
534 | # Variable names are treated case-sensitively or insensitively, depending |
535 | # on the value of $self->{ CASE }. When case-insensitive ($self->{ CASE } |
536 | # != 0), all variable names are converted to lower case. Variable values |
537 | # are not converted. This function simply converts the parameter |
538 | # (variable) to lower case if $self->{ CASE } isn't set. _varname() also |
539 | # expands a variable alias to the name of the target variable. |
540 | # |
541 | # Variables with an ARGCOUNT of ARGCOUNT_ZERO may be specified as |
542 | # "no<var>" in which case, the intended value should be negated. The |
543 | # leading "no" part is stripped from the variable name. A reference to |
544 | # a scalar value can be passed as the second parameter and if the |
545 | # _varname() method identified such a variable, it will negate the value. |
546 | # This allows the intended value or a simple negate flag to be passed by |
547 | # reference and be updated to indicate any negation activity taking place. |
548 | # |
549 | # The (possibly modified) variable name is returned. |
550 | #------------------------------------------------------------------------ |
551 | |
552 | sub _varname { |
553 | my $self = shift; |
554 | my $variable = shift; |
555 | my $negated = shift; |
556 | |
557 | # convert to lower case if case insensitive |
558 | $variable = $self->{ CASE } ? $variable : lc $variable; |
559 | |
560 | # get the actual name if this is an alias |
561 | $variable = $self->{ ALIAS }->{ $variable } |
562 | if (exists($self->{ ALIAS }->{ $variable })); |
563 | |
564 | # if the variable doesn't exist, we can try to chop off a leading |
565 | # "no" and see if the remainder matches an ARGCOUNT_ZERO variable |
566 | unless (exists($self->{ VARIABLE }->{ $variable })) { |
567 | # see if the variable is specified as "no<var>" |
568 | if ($variable =~ /^no(.*)/) { |
569 | # see if the real variable (minus "no") exists and it |
570 | # has an ARGOUNT of ARGCOUNT_NONE (or no ARGCOUNT at all) |
571 | my $novar = $self->_varname($1); |
572 | if (exists($self->{ VARIABLE }->{ $novar }) |
573 | && ! $self->{ ARGCOUNT }->{ $novar }) { |
574 | # set variable name and negate value |
575 | $variable = $novar; |
576 | $$negated = ! $$negated if defined $negated; |
577 | } |
578 | } |
579 | } |
580 | |
581 | # return the variable name |
582 | $variable; |
583 | } |
584 | |
585 | |
586 | #------------------------------------------------------------------------ |
587 | # _default($variable) |
588 | # |
589 | # Sets the variable specified to the default value or undef if it doesn't |
590 | # have a default. The default value is returned. |
591 | #------------------------------------------------------------------------ |
592 | |
593 | sub _default { |
594 | my $self = shift; |
595 | my $variable = shift; |
596 | |
597 | # _varname returns variable name after aliasing and case conversion |
598 | $variable = $self->_varname($variable); |
599 | |
600 | # check the variable exists |
601 | if (exists($self->{ VARIABLE }->{ $variable })) { |
602 | # set variable value to the default scalar, an empty list or empty |
603 | # hash array, depending on its ARGCOUNT value |
604 | my $argcount = $self->{ ARGCOUNT }->{ $variable }; |
605 | $argcount = AppConfig::ARGCOUNT_ONE unless defined $argcount; |
606 | |
607 | if ($argcount == AppConfig::ARGCOUNT_NONE) { |
608 | return $self->{ VARIABLE }->{ $variable } |
609 | = $self->{ DEFAULT }->{ $variable } || 0; |
610 | } |
611 | elsif ($argcount == AppConfig::ARGCOUNT_LIST) { |
612 | my $deflist = $self->{ DEFAULT }->{ $variable }; |
613 | return $self->{ VARIABLE }->{ $variable } = |
614 | [ ref $deflist eq 'ARRAY' ? @$deflist : ( ) ]; |
615 | |
616 | } |
617 | elsif ($argcount == AppConfig::ARGCOUNT_HASH) { |
618 | my $defhash = $self->{ DEFAULT }->{ $variable }; |
619 | return $self->{ VARIABLE }->{ $variable } = |
620 | { ref $defhash eq 'HASH' ? %$defhash : () }; |
621 | } |
622 | else { |
623 | return $self->{ VARIABLE }->{ $variable } |
624 | = $self->{ DEFAULT }->{ $variable }; |
625 | } |
626 | } |
627 | else { |
628 | $self->_error("$variable: no such variable"); |
629 | return 0; |
630 | } |
631 | } |
632 | |
633 | |
634 | #------------------------------------------------------------------------ |
635 | # _exists($variable) |
636 | # |
637 | # Returns 1 if the variable specified exists or 0 if not. |
638 | #------------------------------------------------------------------------ |
639 | |
640 | sub _exists { |
641 | my $self = shift; |
642 | my $variable = shift; |
643 | |
644 | |
645 | # _varname returns variable name after aliasing and case conversion |
646 | $variable = $self->_varname($variable); |
647 | |
648 | # check the variable has been defined |
649 | return exists($self->{ VARIABLE }->{ $variable }); |
650 | } |
651 | |
652 | |
653 | #------------------------------------------------------------------------ |
654 | # _validate($variable, $value) |
655 | # |
656 | # Uses any validation rules or code defined for the variable to test if |
657 | # the specified value is acceptable. |
658 | # |
659 | # Returns 1 if the value passed validation checks, 0 if not. |
660 | #------------------------------------------------------------------------ |
661 | |
662 | sub _validate { |
663 | my $self = shift; |
664 | my $variable = shift; |
665 | my $value = shift; |
666 | my $validator; |
667 | |
668 | |
669 | # _varname returns variable name after aliasing and case conversion |
670 | $variable = $self->_varname($variable); |
671 | |
672 | # return OK unless there is a validation function |
673 | return 1 unless defined($validator = $self->{ VALIDATE }->{ $variable }); |
674 | |
675 | # |
676 | # the validation performed is based on the validator type; |
677 | # |
678 | # CODE ref: code executed, returning 1 (ok) or 0 (failed) |
679 | # SCALAR : a regex which should match the value |
680 | # |
681 | |
682 | # CODE ref |
683 | ref($validator) eq 'CODE' && do { |
684 | # run the validation function and return the result |
685 | return &$validator($variable, $value); |
686 | }; |
687 | |
688 | # non-ref (i.e. scalar) |
689 | ref($validator) || do { |
690 | # not a ref - assume it's a regex |
691 | return $value =~ /$validator/; |
692 | }; |
693 | |
694 | # validation failed |
695 | return 0; |
696 | } |
697 | |
698 | |
699 | #------------------------------------------------------------------------ |
700 | # _error($format, @params) |
701 | # |
702 | # Checks for the existence of a user defined error handling routine and |
703 | # if defined, passes all variable straight through to that. The routine |
704 | # is expected to handle a string format and optional parameters as per |
705 | # printf(3C). If no error handler is defined, the message is formatted |
706 | # and passed to warn() which prints it to STDERR. |
707 | #------------------------------------------------------------------------ |
708 | |
709 | sub _error { |
710 | my $self = shift; |
711 | my $format = shift; |
712 | |
713 | # user defined error handler? |
714 | if (ref($self->{ EHANDLER }) eq 'CODE') { |
715 | &{ $self->{ EHANDLER } }($format, @_); |
716 | } |
717 | else { |
718 | warn(sprintf("$format\n", @_)); |
719 | } |
720 | } |
721 | |
722 | |
723 | #------------------------------------------------------------------------ |
724 | # _ehandler($handler) |
725 | # |
726 | # Allows a new error handler to be installed. The current value of |
727 | # the error handler is returned. |
728 | # |
729 | # This is something of a kludge to allow other AppConfig::* modules to |
730 | # install their own error handlers to format error messages appropriately. |
731 | # For example, AppConfig::File appends a message of the form |
732 | # "at $file line $line" to each error message generated while parsing |
733 | # configuration files. The previous handler is returned (and presumably |
734 | # stored by the caller) to allow new error handlers to chain control back |
735 | # to any user-defined handler, and also restore the original handler when |
736 | # done. |
737 | #------------------------------------------------------------------------ |
738 | |
739 | sub _ehandler { |
740 | my $self = shift; |
741 | my $handler = shift; |
742 | |
743 | # save previous value |
744 | my $previous = $self->{ EHANDLER }; |
745 | |
746 | # update internal reference if a new handler vas provide |
747 | if (defined $handler) { |
748 | # check this is a code reference |
749 | if (ref($handler) eq 'CODE') { |
750 | $self->{ EHANDLER } = $handler; |
751 | |
752 | # DEBUG |
753 | print STDERR "installed new ERROR handler: $handler\n" if $DEBUG; |
754 | } |
755 | else { |
756 | $self->_error("ERROR handler parameter is not a code ref"); |
757 | } |
758 | } |
759 | |
760 | return $previous; |
761 | } |
762 | |
763 | |
764 | #------------------------------------------------------------------------ |
765 | # _debug($debug) |
766 | # |
767 | # Sets the package debugging variable, $AppConfig::State::DEBUG depending |
768 | # on the value of the $debug parameter. 1 turns debugging on, 0 turns |
769 | # debugging off. |
770 | # |
771 | # May be called as an object method, $state->_debug(1), or as a package |
772 | # function, AppConfig::State::_debug(1). Returns the previous value of |
773 | # $DEBUG, before any new value was applied. |
774 | #------------------------------------------------------------------------ |
775 | |
776 | sub _debug { |
777 | # object reference may not be present if called as a package function |
778 | my $self = shift if ref($_[0]); |
779 | my $newval = shift; |
780 | |
781 | # save previous value |
782 | my $oldval = $DEBUG; |
783 | |
784 | # update $DEBUG if a new value was provided |
785 | $DEBUG = $newval if defined $newval; |
786 | |
787 | # return previous value |
788 | $oldval; |
789 | } |
790 | |
791 | |
792 | #------------------------------------------------------------------------ |
793 | # _dump_var($var) |
794 | # |
795 | # Displays the content of the specified variable, $var. |
796 | #------------------------------------------------------------------------ |
797 | |
798 | sub _dump_var { |
799 | my $self = shift; |
800 | my $var = shift; |
801 | |
802 | return unless defined $var; |
803 | |
804 | # $var may be an alias, so we resolve the real variable name |
805 | my $real = $self->_varname($var); |
806 | if ($var eq $real) { |
807 | print STDERR "$var\n"; |
808 | } |
809 | else { |
810 | print STDERR "$real ('$var' is an alias)\n"; |
811 | $var = $real; |
812 | } |
813 | |
814 | # for some bizarre reason, the variable VALUE is stored in VARIABLE |
815 | # (it made sense at some point in time) |
816 | printf STDERR " VALUE => %s\n", |
817 | defined($self->{ VARIABLE }->{ $var }) |
818 | ? $self->{ VARIABLE }->{ $var } |
819 | : "<undef>"; |
820 | |
821 | # the rest of the values can be read straight out of their hashes |
822 | foreach my $param (qw( DEFAULT ARGCOUNT VALIDATE ACTION EXPAND )) { |
823 | printf STDERR " %-12s => %s\n", $param, |
824 | defined($self->{ $param }->{ $var }) |
825 | ? $self->{ $param }->{ $var } |
826 | : "<undef>"; |
827 | } |
828 | |
829 | # summarise all known aliases for this variable |
830 | print STDERR " ALIASES => ", |
831 | join(", ", @{ $self->{ ALIASES }->{ $var } }), "\n" |
832 | if defined $self->{ ALIASES }->{ $var }; |
833 | } |
834 | |
835 | |
836 | #------------------------------------------------------------------------ |
837 | # _dump() |
838 | # |
839 | # Dumps the contents of the Config object and all stored variables. |
840 | #------------------------------------------------------------------------ |
841 | |
842 | sub _dump { |
843 | my $self = shift; |
844 | my $var; |
845 | |
846 | print STDERR "=" x 71, "\n"; |
847 | print STDERR |
848 | "Status of AppConfig::State (version $VERSION) object:\n\t$self\n"; |
849 | |
850 | |
851 | print STDERR "- " x 36, "\nINTERNAL STATE:\n"; |
852 | foreach (qw( CREATE CASE PEDANTIC EHANDLER ERROR )) { |
853 | printf STDERR " %-12s => %s\n", $_, |
854 | defined($self->{ $_ }) ? $self->{ $_ } : "<undef>"; |
855 | } |
856 | |
857 | print STDERR "- " x 36, "\nVARIABLES:\n"; |
858 | foreach $var (keys %{ $self->{ VARIABLE } }) { |
859 | $self->_dump_var($var); |
860 | } |
861 | |
862 | print STDERR "- " x 36, "\n", "ALIASES:\n"; |
863 | foreach $var (keys %{ $self->{ ALIAS } }) { |
864 | printf(" %-12s => %s\n", $var, $self->{ ALIAS }->{ $var }); |
865 | } |
866 | print STDERR "=" x 72, "\n"; |
867 | } |
868 | |
869 | |
870 | |
871 | 1; |
872 | |
873 | __END__ |
874 | |
875 | =head1 NAME |
876 | |
877 | AppConfig::State - application configuration state |
878 | |
879 | =head1 SYNOPSIS |
880 | |
881 | use AppConfig::State; |
882 | |
883 | my $state = AppConfig::State->new(\%cfg); |
884 | |
885 | $state->define("foo"); # very simple variable definition |
886 | $state->define("bar", \%varcfg); # variable specific configuration |
887 | $state->define("foo|bar=i@"); # compact format |
888 | |
889 | $state->set("foo", 123); # trivial set/get examples |
890 | $state->get("foo"); |
891 | |
892 | $state->foo(); # shortcut variable access |
893 | $state->foo(456); # shortcut variable update |
894 | |
895 | =head1 OVERVIEW |
896 | |
897 | AppConfig::State is a Perl5 module to handle global configuration variables |
898 | for perl programs. It maintains the state of any number of variables, |
899 | handling default values, aliasing, validation, update callbacks and |
900 | option arguments for use by other AppConfig::* modules. |
901 | |
902 | AppConfig::State is distributed as part of the AppConfig bundle. |
903 | |
904 | =head1 DESCRIPTION |
905 | |
906 | =head2 USING THE AppConfig::State MODULE |
907 | |
908 | To import and use the AppConfig::State module the following line should |
909 | appear in your Perl script: |
910 | |
911 | use AppConfig::State; |
912 | |
913 | The AppConfig::State module is loaded automatically by the new() |
914 | constructor of the AppConfig module. |
915 | |
916 | AppConfig::State is implemented using object-oriented methods. A |
917 | new AppConfig::State object is created and initialised using the |
918 | new() method. This returns a reference to a new AppConfig::State |
919 | object. |
920 | |
921 | my $state = AppConfig::State->new(); |
922 | |
923 | This will create a reference to a new AppConfig::State with all |
924 | configuration options set to their default values. You can initialise |
925 | the object by passing a reference to a hash array containing |
926 | configuration options: |
927 | |
928 | $state = AppConfig::State->new( { |
929 | CASE => 1, |
930 | ERROR => \&my_error, |
931 | } ); |
932 | |
933 | The new() constructor of the AppConfig module automatically passes all |
934 | parameters to the AppConfig::State new() constructor. Thus, any global |
935 | configuration values and variable definitions for AppConfig::State are |
936 | also applicable to AppConfig. |
937 | |
938 | The following configuration options may be specified. |
939 | |
940 | =over 4 |
941 | |
942 | =item CASE |
943 | |
944 | Determines if the variable names are treated case sensitively. Any non-zero |
945 | value makes case significant when naming variables. By default, CASE is set |
946 | to 0 and thus "Variable", "VARIABLE" and "VaRiAbLe" are all treated as |
947 | "variable". |
948 | |
949 | =item CREATE |
950 | |
951 | By default, CREATE is turned off meaning that all variables accessed via |
952 | set() (which includes access via shortcut such as |
953 | C<$state-E<gt>variable($value)> which delegates to set()) must previously |
954 | have been defined via define(). When CREATE is set to 1, calling |
955 | set($variable, $value) on a variable that doesn't exist will cause it |
956 | to be created automatically. |
957 | |
958 | When CREATE is set to any other non-zero value, it is assumed to be a |
959 | regular expression pattern. If the variable name matches the regex, the |
960 | variable is created. This can be used to specify configuration file |
961 | blocks in which variables should be created, for example: |
962 | |
963 | $state = AppConfig::State->new( { |
964 | CREATE => '^define_', |
965 | } ); |
966 | |
967 | In a config file: |
968 | |
969 | [define] |
970 | name = fred # define_name gets created automatically |
971 | |
972 | [other] |
973 | name = john # other_name doesn't - warning raised |
974 | |
975 | Note that a regex pattern specified in CREATE is applied to the real |
976 | variable name rather than any alias by which the variables may be |
977 | accessed. |
978 | |
979 | =item PEDANTIC |
980 | |
981 | The PEDANTIC option determines what action the configuration file |
982 | (AppConfig::File) or argument parser (AppConfig::Args) should take |
983 | on encountering a warning condition (typically caused when trying to set an |
984 | undeclared variable). If PEDANTIC is set to any true value, the parsing |
985 | methods will immediately return a value of 0 on encountering such a |
986 | condition. If PEDANTIC is not set, the method will continue to parse the |
987 | remainder of the current file(s) or arguments, returning 0 when complete. |
988 | |
989 | If no warnings or errors are encountered, the method returns 1. |
990 | |
991 | In the case of a system error (e.g. unable to open a file), the method |
992 | returns undef immediately, regardless of the PEDANTIC option. |
993 | |
994 | =item ERROR |
995 | |
996 | Specifies a user-defined error handling routine. When the handler is |
997 | called, a format string is passed as the first parameter, followed by |
998 | any additional values, as per printf(3C). |
999 | |
1000 | =item DEBUG |
1001 | |
1002 | Turns debugging on or off when set to 1 or 0 accordingly. Debugging may |
1003 | also be activated by calling _debug() as an object method |
1004 | (C<$state-E<gt>_debug(1)>) or as a package function |
1005 | (C<AppConfig::State::_debug(1)>), passing in a true/false value to |
1006 | set the debugging state accordingly. The package variable |
1007 | $AppConfig::State::DEBUG can also be set directly. |
1008 | |
1009 | The _debug() method returns the current debug value. If a new value |
1010 | is passed in, the internal value is updated, but the previous value is |
1011 | returned. |
1012 | |
1013 | Note that any AppConfig::File or App::Config::Args objects that are |
1014 | instantiated with a reference to an App::State will inherit the |
1015 | DEBUG (and also PEDANTIC) values of the state at that time. Subsequent |
1016 | changes to the AppConfig::State debug value will not affect them. |
1017 | |
1018 | =item GLOBAL |
1019 | |
1020 | The GLOBAL option allows default values to be set for the DEFAULT, ARGCOUNT, |
1021 | EXPAND, VALIDATE and ACTION options for any subsequently defined variables. |
1022 | |
1023 | $state = AppConfig::State->new({ |
1024 | GLOBAL => { |
1025 | DEFAULT => '<undef>', # default value for new vars |
1026 | ARGCOUNT => 1, # vars expect an argument |
1027 | ACTION => \&my_set_var, # callback when vars get set |
1028 | } |
1029 | }); |
1030 | |
1031 | Any attributes specified explicitly when a variable is defined will |
1032 | override any GLOBAL values. |
1033 | |
1034 | See L<DEFINING VARIABLES> below which describes these options in detail. |
1035 | |
1036 | =back |
1037 | |
1038 | =head2 DEFINING VARIABLES |
1039 | |
1040 | The C<define()> function is used to pre-declare a variable and specify |
1041 | its configuration. |
1042 | |
1043 | $state->define("foo"); |
1044 | |
1045 | In the simple example above, a new variable called "foo" is defined. A |
1046 | reference to a hash array may also be passed to specify configuration |
1047 | information for the variable: |
1048 | |
1049 | $state->define("foo", { |
1050 | DEFAULT => 99, |
1051 | ALIAS => 'metavar1', |
1052 | }); |
1053 | |
1054 | Any variable-wide GLOBAL values passed to the new() constructor in the |
1055 | configuration hash will also be applied. Values explicitly specified |
1056 | in a variable's define() configuration will override the respective GLOBAL |
1057 | values. |
1058 | |
1059 | The following configuration options may be specified |
1060 | |
1061 | =over 4 |
1062 | |
1063 | =item DEFAULT |
1064 | |
1065 | The DEFAULT value is used to initialise the variable. |
1066 | |
1067 | $state->define("drink", { |
1068 | DEFAULT => 'coffee', |
1069 | }); |
1070 | |
1071 | print $state->drink(); # prints "coffee" |
1072 | |
1073 | =item ALIAS |
1074 | |
1075 | The ALIAS option allows a number of alternative names to be specified for |
1076 | this variable. A single alias should be specified as a string. Multiple |
1077 | aliases can be specified as a reference to an array of alternatives or as |
1078 | a string of names separated by vertical bars, '|'. e.g.: |
1079 | |
1080 | # either |
1081 | $state->define("name", { |
1082 | ALIAS => 'person', |
1083 | }); |
1084 | |
1085 | # or |
1086 | $state->define("name", { |
1087 | ALIAS => [ 'person', 'user', 'uid' ], |
1088 | }); |
1089 | |
1090 | # or |
1091 | $state->define("name", { |
1092 | ALIAS => 'person|user|uid', |
1093 | }); |
1094 | |
1095 | $state->user('abw'); # equivalent to $state->name('abw'); |
1096 | |
1097 | =item ARGCOUNT |
1098 | |
1099 | The ARGCOUNT option specifies the number of arguments that should be |
1100 | supplied for this variable. By default, no additional arguments are |
1101 | expected for variables (ARGCOUNT_NONE). |
1102 | |
1103 | The ARGCOUNT_* constants can be imported from the AppConfig module: |
1104 | |
1105 | use AppConfig ':argcount'; |
1106 | |
1107 | $state->define('foo', { ARGCOUNT => ARGCOUNT_ONE }); |
1108 | |
1109 | or can be accessed directly from the AppConfig package: |
1110 | |
1111 | use AppConfig; |
1112 | |
1113 | $state->define('foo', { ARGCOUNT => AppConfig::ARGCOUNT_ONE }); |
1114 | |
1115 | The following values for ARGCOUNT may be specified. |
1116 | |
1117 | =over 4 |
1118 | |
1119 | =item ARGCOUNT_NONE (0) |
1120 | |
1121 | Indicates that no additional arguments are expected. If the variable is |
1122 | identified in a confirguration file or in the command line arguments, it |
1123 | is set to a value of 1 regardless of whatever arguments follow it. |
1124 | |
1125 | =item ARGCOUNT_ONE (1) |
1126 | |
1127 | Indicates that the variable expects a single argument to be provided. |
1128 | The variable value will be overwritten with a new value each time it |
1129 | is encountered. |
1130 | |
1131 | =item ARGCOUNT_LIST (2) |
1132 | |
1133 | Indicates that the variable expects multiple arguments. The variable |
1134 | value will be appended to the list of previous values each time it is |
1135 | encountered. |
1136 | |
1137 | =item ARGCOUNT_HASH (3) |
1138 | |
1139 | Indicates that the variable expects multiple arguments and that each |
1140 | argument is of the form "key=value". The argument will be split into |
1141 | a key/value pair and inserted into the hash of values each time it |
1142 | is encountered. |
1143 | |
1144 | =back |
1145 | |
1146 | =item ARGS |
1147 | |
1148 | The ARGS option can also be used to specify advanced command line options |
1149 | for use with AppConfig::Getopt, which itself delegates to Getopt::Long. |
1150 | See those two modules for more information on the format and meaning of |
1151 | these options. |
1152 | |
1153 | $state->define("name", { |
1154 | ARGS => "=i@", |
1155 | }); |
1156 | |
1157 | =item EXPAND |
1158 | |
1159 | The EXPAND option specifies how the AppConfig::File processor should |
1160 | expand embedded variables in the configuration file values it reads. |
1161 | By default, EXPAND is turned off (EXPAND_NONE) and no expansion is made. |
1162 | |
1163 | The EXPAND_* constants can be imported from the AppConfig module: |
1164 | |
1165 | use AppConfig ':expand'; |
1166 | |
1167 | $state->define('foo', { EXPAND => EXPAND_VAR }); |
1168 | |
1169 | or can be accessed directly from the AppConfig package: |
1170 | |
1171 | use AppConfig; |
1172 | |
1173 | $state->define('foo', { EXPAND => AppConfig::EXPAND_VAR }); |
1174 | |
1175 | The following values for EXPAND may be specified. Multiple values should |
1176 | be combined with vertical bars , '|', e.g. C<EXPAND_UID | EXPAND_VAR>). |
1177 | |
1178 | =over 4 |
1179 | |
1180 | =item EXPAND_NONE |
1181 | |
1182 | Indicates that no variable expansion should be attempted. |
1183 | |
1184 | =item EXPAND_VAR |
1185 | |
1186 | Indicates that variables embedded as $var or $(var) should be expanded |
1187 | to the values of the relevant AppConfig::State variables. |
1188 | |
1189 | =item EXPAND_UID |
1190 | |
1191 | Indicates that '~' or '~uid' patterns in the string should be |
1192 | expanded to the current users ($<), or specified user's home directory. |
1193 | In the first case, C<~> is expanded to the value of the C<HOME> |
1194 | environment variable. In the second case, the C<getpwnam()> method |
1195 | is used if it is available on your system (which it isn't on Win32). |
1196 | |
1197 | =item EXPAND_ENV |
1198 | |
1199 | Inidicates that variables embedded as ${var} should be expanded to the |
1200 | value of the relevant environment variable. |
1201 | |
1202 | =item EXPAND_ALL |
1203 | |
1204 | Equivalent to C<EXPAND_VARS | EXPAND_UIDS | EXPAND_ENVS>). |
1205 | |
1206 | =item EXPAND_WARN |
1207 | |
1208 | Indicates that embedded variables that are not defined should raise a |
1209 | warning. If PEDANTIC is set, this will cause the read() method to return 0 |
1210 | immediately. |
1211 | |
1212 | =back |
1213 | |
1214 | =item VALIDATE |
1215 | |
1216 | Each variable may have a sub-routine or regular expression defined which |
1217 | is used to validate the intended value for a variable before it is set. |
1218 | |
1219 | If VALIDATE is defined as a regular expression, it is applied to the |
1220 | value and deemed valid if the pattern matches. In this case, the |
1221 | variable is then set to the new value. A warning message is generated |
1222 | if the pattern match fails. |
1223 | |
1224 | VALIDATE may also be defined as a reference to a sub-routine which takes |
1225 | as its arguments the name of the variable and its intended value. The |
1226 | sub-routine should return 1 or 0 to indicate that the value is valid |
1227 | or invalid, respectively. An invalid value will cause a warning error |
1228 | message to be generated. |
1229 | |
1230 | If the GLOBAL VALIDATE variable is set (see GLOBAL in L<DESCRIPTION> |
1231 | above) then this value will be used as the default VALIDATE for each |
1232 | variable unless otherwise specified. |
1233 | |
1234 | $state->define("age", { |
1235 | VALIDATE => '\d+', |
1236 | }); |
1237 | |
1238 | $state->define("pin", { |
1239 | VALIDATE => \&check_pin, |
1240 | }); |
1241 | |
1242 | =item ACTION |
1243 | |
1244 | The ACTION option allows a sub-routine to be bound to a variable as a |
1245 | callback that is executed whenever the variable is set. The ACTION is |
1246 | passed a reference to the AppConfig::State object, the name of the |
1247 | variable and the value of the variable. |
1248 | |
1249 | The ACTION routine may be used, for example, to post-process variable |
1250 | data, update the value of some other dependant variable, generate a |
1251 | warning message, etc. |
1252 | |
1253 | Example: |
1254 | |
1255 | $state->define("foo", { ACTION => \&my_notify }); |
1256 | |
1257 | sub my_notify { |
1258 | my $state = shift; |
1259 | my $var = shift; |
1260 | my $val = shift; |
1261 | |
1262 | print "$variable set to $value"; |
1263 | } |
1264 | |
1265 | $state->foo(42); # prints "foo set to 42" |
1266 | |
1267 | Be aware that calling C<$state-E<gt>set()> to update the same variable |
1268 | from within the ACTION function will cause a recursive loop as the |
1269 | ACTION function is repeatedly called. |
1270 | |
1271 | =item |
1272 | |
1273 | =back |
1274 | |
1275 | =head2 DEFINING VARIABLES USING THE COMPACT FORMAT |
1276 | |
1277 | Variables may be defined in a compact format which allows any ALIAS and |
1278 | ARGS values to be specified as part of the variable name. This is designed |
1279 | to mimic the behaviour of Johan Vromans' Getopt::Long module. |
1280 | |
1281 | Aliases for a variable should be specified after the variable name, |
1282 | separated by vertical bars, '|'. Any ARGS parameter should be appended |
1283 | after the variable name(s) and/or aliases. |
1284 | |
1285 | The following examples are equivalent: |
1286 | |
1287 | $state->define("foo", { |
1288 | ALIAS => [ 'bar', 'baz' ], |
1289 | ARGS => '=i', |
1290 | }); |
1291 | |
1292 | $state->define("foo|bar|baz=i"); |
1293 | |
1294 | =head2 READING AND MODIFYING VARIABLE VALUES |
1295 | |
1296 | AppConfig::State defines two methods to manipulate variable values: |
1297 | |
1298 | set($variable, $value); |
1299 | get($variable); |
1300 | |
1301 | Both functions take the variable name as the first parameter and |
1302 | C<set()> takes an additional parameter which is the new value for the |
1303 | variable. C<set()> returns 1 or 0 to indicate successful or |
1304 | unsuccessful update of the variable value. If there is an ACTION |
1305 | routine associated with the named variable, the value returned will be |
1306 | passed back from C<set()>. The C<get()> function returns the current |
1307 | value of the variable. |
1308 | |
1309 | Once defined, variables may be accessed directly as object methods where |
1310 | the method name is the same as the variable name. i.e. |
1311 | |
1312 | $state->set("verbose", 1); |
1313 | |
1314 | is equivalent to |
1315 | |
1316 | $state->verbose(1); |
1317 | |
1318 | Without parameters, the current value of the variable is returned. If |
1319 | a parameter is specified, the variable is set to that value and the |
1320 | result of the set() operation is returned. |
1321 | |
1322 | $state->age(29); # sets 'age' to 29, returns 1 (ok) |
1323 | |
1324 | =head2 INTERNAL METHODS |
1325 | |
1326 | The interal (private) methods of the AppConfig::State class are listed |
1327 | below. |
1328 | |
1329 | They aren't intended for regular use and potential users should consider |
1330 | the fact that nothing about the internal implementation is guaranteed to |
1331 | remain the same. Having said that, the AppConfig::State class is |
1332 | intended to co-exist and work with a number of other modules and these |
1333 | are considered "friend" classes. These methods are provided, in part, |
1334 | as services to them. With this acknowledged co-operation in mind, it is |
1335 | safe to assume some stability in this core interface. |
1336 | |
1337 | The _varname() method can be used to determine the real name of a variable |
1338 | from an alias: |
1339 | |
1340 | $varname->_varname($alias); |
1341 | |
1342 | Note that all methods that take a variable name, including those listed |
1343 | below, can accept an alias and automatically resolve it to the correct |
1344 | variable name. There is no need to call _varname() explicitly to do |
1345 | alias expansion. The _varname() method will fold all variables names |
1346 | to lower case unless CASE sensititvity is set. |
1347 | |
1348 | The _exists() method can be used to check if a variable has been |
1349 | defined: |
1350 | |
1351 | $state->_exists($varname); |
1352 | |
1353 | The _default() method can be used to reset a variable to its default value: |
1354 | |
1355 | $state->_default($varname); |
1356 | |
1357 | The _expand() method can be used to determine the EXPAND value for a |
1358 | variable: |
1359 | |
1360 | print "$varname EXPAND: ", $state->_expand($varname), "\n"; |
1361 | |
1362 | The _argcount() method returns the value of the ARGCOUNT attribute for a |
1363 | variable: |
1364 | |
1365 | print "$varname ARGCOUNT: ", $state->_argcount($varname), "\n"; |
1366 | |
1367 | The _validate() method can be used to determine if a new value for a variable |
1368 | meets any validation criteria specified for it. The variable name and |
1369 | intended value should be passed in. The methods returns a true/false value |
1370 | depending on whether or not the validation succeeded: |
1371 | |
1372 | print "OK\n" if $state->_validate($varname, $value); |
1373 | |
1374 | The _pedantic() method can be called to determine the current value of the |
1375 | PEDANTIC option. |
1376 | |
1377 | print "pedantic mode is ", $state->_pedantic() ? "on" ; "off", "\n"; |
1378 | |
1379 | The _debug() method can be used to turn debugging on or off (pass 1 or 0 |
1380 | as a parameter). It can also be used to check the debug state, |
1381 | returning the current internal value of $AppConfig::State::DEBUG. If a |
1382 | new debug value is provided, the debug state is updated and the previous |
1383 | state is returned. |
1384 | |
1385 | $state->_debug(1); # debug on, returns previous value |
1386 | |
1387 | The _dump_var($varname) and _dump() methods may also be called for |
1388 | debugging purposes. |
1389 | |
1390 | $state->_dump_var($varname); # show variable state |
1391 | $state->_dump(); # show internal state and all vars |
1392 | |
1393 | =head1 AUTHOR |
1394 | |
1395 | Andy Wardley, E<lt>abw@wardley.orgE<gt> |
1396 | |
1397 | =head1 COPYRIGHT |
1398 | |
1399 | Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved. |
1400 | |
1401 | Copyright (C) 1997,1998 Canon Research Centre Europe Ltd. |
1402 | |
1403 | This module is free software; you can redistribute it and/or modify it |
1404 | under the same terms as Perl itself. |
1405 | |
1406 | =head1 SEE ALSO |
1407 | |
1408 | AppConfig, AppConfig::File, AppConfig::Args, AppConfig::Getopt |
1409 | |
1410 | =cut |