File Coverage

blib/lib/Apache/ConfigParser/Directive.pm
Criterion Covered Total %
statement 191 229 83.4
branch 83 120 69.1
condition 19 36 52.7
subroutine 35 35 100.0
pod 18 21 85.7
total 346 441 78.4


line stmt bran cond sub pod time code
1             # Apache::ConfigParser::Directive: A single Apache directive or start context.
2             #
3             # $HeadURL: http://www.orcaware.com/svn/repos/perl_apache_configparser/tags/1.01/lib/Apache/ConfigParser/Directive.pm $
4             # $LastChangedRevision: 511 $
5             # $LastChangedDate: 2005-11-22 20:42:24 -0800 (Tue, 22 Nov 2005) $
6             # $LastChangedBy: blair@orcaware.com $
7             #
8             # Copyright (C) 2001-2005 Blair Zajac. All rights reserved.
9              
10             package Apache::ConfigParser::Directive;
11              
12             require 5.004_05;
13              
14 2     2   24206 use strict;
  2         5  
  2         78  
15 2     2   12 use Exporter;
  2         2  
  2         96  
16 2     2   11 use Carp;
  2         16  
  2         195  
17 2     2   18 use File::Spec 0.82;
  2         50  
  2         52  
18 2     2   3103 use Tree::DAG_Node 1.04;
  2         77344  
  2         104  
19              
20 2     2   27 use vars qw(@EXPORT_OK @ISA $VERSION);
  2         5  
  2         239  
21             @ISA = qw(Tree::DAG_Node Exporter);
22             $VERSION = '1.01';
23              
24             # Determine if the filenames are case sensitive.
25 2     2   13 use constant CASE_SENSITIVE_PATH => (! File::Spec->case_tolerant);
  2         6  
  2         349  
26              
27             # This is a utility subroutine to determine if the specified path is
28             # the /dev/null equivalent on this operating system.
29 2     2   12 use constant DEV_NULL => File::Spec->devnull;
  2         3  
  2         114  
30 2     2   10 use constant DEV_NULL_LC => lc(File::Spec->devnull);
  2         4  
  2         284  
31             sub is_dev_null {
32 2474     2474 1 2489 if (CASE_SENSITIVE_PATH) {
33 2474         7477 return $_[0] eq DEV_NULL;
34             } else {
35             return lc($_[0]) eq DEV_NULL_LC;
36             }
37             }
38             push(@EXPORT_OK, qw(DEV_NULL DEV_NULL_LC is_dev_null));
39              
40             # This constant is used throughout the module.
41             my $INCORRECT_NUMBER_OF_ARGS = "passed incorrect number of arguments.\n";
42              
43             # These are declared now but defined and documented below.
44 2         8364 use vars qw(%directive_value_takes_abs_path
45             %directive_value_takes_rel_path
46 2     2   11 %directive_value_path_element_pos);
  2         5  
47             push(@EXPORT_OK, qw(%directive_value_takes_abs_path
48             %directive_value_takes_rel_path
49             %directive_value_path_element_pos));
50              
51             =head1 NAME
52              
53             Apache::ConfigParser::Directive - An Apache directive or start context
54              
55             =head1 SYNOPSIS
56              
57             use Apache::ConfigParser::Directive;
58              
59             # Create a new empty directive.
60             my $d = Apache::ConfigParser::Directive->new;
61              
62             # Make it a ServerRoot directive.
63             # ServerRoot /etc/httpd
64             $d->name('ServerRoot');
65             $d->value('/etc/httpd');
66              
67             # A more complicated directive. Value automatically splits the
68             # argument into separate elements. It treats elements in "'s as a
69             # single element.
70             # LogFormat "%h %l %u %t \"%r\" %>s %b" common
71             $d->name('LogFormat');
72             $d->value('"%h %l %u %t \"%r\" %>s %b" common');
73              
74             # Get a string form of the name.
75             # Prints 'logformat'.
76             print $d->name, "\n";
77              
78             # Get a string form of the value.
79             # Prints '"%h %l %u %t \"%r\" %>s %b" common'.
80             print $d->value, "\n";
81              
82             # Get the values separated into individual elements. Whitespace
83             # separated elements that are enclosed in "'s are treated as a
84             # single element. Protected quotes, \", are honored to not begin or
85             # end a value element. In this form protected "'s, \", are no
86             # longer protected.
87             my @value = $d->get_value_array;
88             scalar @value == 2; # There are two elements in this array.
89             $value[0] eq '%h %l %u %t \"%r\" %>s %b';
90             $value[1] eq 'common';
91              
92             # The array form can also be set. Change style of LogFormat from a
93             # common to a referer style log.
94             $d->set_value_array('%{Referer}i -> %U', 'referer');
95              
96             # This is equivalent.
97             $d->value('"%{Referer}i -> %U" referer');
98              
99             # There are also an equivalent pair of values that are called
100             # 'original' that can be accessed via orig_value,
101             # get_orig_value_array and set_orig_value_array.
102             $d->orig_value('"%{User-agent}i" agent');
103             $d->set_orig_value_array('%{User-agent}i', 'agent');
104             @value = $d->get_orig_value_array;
105             scalar @value == 2; # There are two elements in this array.
106             $value[0] eq '%{User-agent}i';
107             $value[1] eq 'agent';
108              
109             # You can set undef values for the strings.
110             $d->value(undef);
111              
112             =head1 DESCRIPTION
113              
114             The C module is a subclass of
115             C, which provides methods to represents nodes in a
116             tree. Each node is a single Apache configuration directive or root
117             node for a context, such as or . All of the
118             methods in that module are available here. This module adds some
119             additional methods that make it easier to represent Apache directives
120             and contexts.
121              
122             This module holds a directive or context:
123              
124             name
125             value in string form
126             value in array form
127             a separate value termed 'original' in string form
128             a separate value termed 'original' in array form
129             the filename where the directive was set
130             the line number in the filename where the directive was set
131              
132             The 'original' value is separate from the non-'original' value and the
133             methods to operate on the two sets of values have distinct names. The
134             'original' value can be used to store the original value of a
135             directive while the non-'directive' value can be a modified form, such
136             as changing the CustomLog filename to make it absolute. The actual
137             use of these two distinct values is up to the caller as this module
138             does not link the two in any way.
139              
140             =head1 METHODS
141              
142             The following methods are available:
143              
144             =over
145              
146             =cut
147              
148             =item $d = Apache::ConfigParser::Directive->new;
149              
150             This creates a brand new C object.
151              
152             It is not recommended to pass any arguments to C to set the
153             internal state and instead use the following methods.
154              
155             There actually is no C method in the
156             C module. Instead, due to
157             C being a subclass of
158             C, C will be used.
159              
160             =cut
161              
162             # The Apache::ConfigParser::Directive object still needs to be
163             # initialized. This is done here. Tree::DAG_Node->new calls
164             # Apache::ConfigParser::Directive->_init, which will call
165             # Tree::DAG_Node->_init.
166             sub _init {
167 1235     1235   15364 my $self = shift;
168 1235         3662 $self->SUPER::_init;
169 1235         29275 $self->{name} = '';
170 1235         1839 $self->{value} = '';
171 1235         2204 $self->{value_array} = [];
172 1235         1891 $self->{orig_value} = '';
173 1235         3289 $self->{orig_value_array} = [];
174 1235         2110 $self->{filename} = '';
175 1235         3182 $self->{line_number} = -1;
176             }
177              
178             =item $d->name
179              
180             =item $d->name($name)
181              
182             In the first form get the directive or context's name. In the second
183             form set the new name of the directive or context to the lowercase
184             version of I<$name> and return the original name.
185              
186             =cut
187              
188             sub name {
189 5161 50   5161 1 29016 unless (@_ < 3) {
190 0         0 confess "$0: Apache::ConfigParser::Directive::name ",
191             $INCORRECT_NUMBER_OF_ARGS;
192             }
193              
194 5161         16171 my $self = shift;
195 5161 100       9344 if (@_) {
196 1267         1697 my $old = $self->{name};
197 1267         2148 $self->{name} = lc($_[0]);
198 1267         2601 return $old;
199             } else {
200 3894         13113 return $self->{name};
201             }
202             }
203              
204             =item $d->value
205              
206             =item $d->value($value)
207              
208             In the first form get the directive's value in string form. In the
209             second form, return the previous directive value in string form and
210             set the new directive value to I<$value>. I<$value> can be set to
211             undef.
212              
213             If the value is being set, then I<$value> is saved so another call to
214             C will return I<$value>. If I<$value> is defined, then
215             I<$value> is also parsed into an array of elements that can be
216             retrieved with the C or C methods.
217             The parser separates elements by whitespace, unless whitespace
218             separated elements are enclosed by "'s. Protected quotes, \", are
219             honored to not begin or end a value element.
220              
221             =item $d->orig_value
222              
223             =item $d->orig_value($value)
224              
225             Identical behavior as C, except that this applies to a the
226             'original' value. Use C or C to
227             get the value elements.
228              
229             =cut
230              
231             # This function manages getting and setting the string value for
232             # either the 'value' or 'orig_value' hash keys.
233             sub _get_set_value_string {
234 2654 50 33 2654   10712 unless (@_ > 1 and @_ < 4) {
235 0         0 confess "$0: Apache::ConfigParser::Directive::_get_set_value_string ",
236             $INCORRECT_NUMBER_OF_ARGS;
237             }
238              
239 2654         3797 my $self = shift;
240 2654         2889 my $string_var_name = pop;
241 2654         4152 my $old_value = $self->{$string_var_name};
242 2654 100       5099 unless (@_) {
243 8         48 return $old_value;
244             }
245              
246 2646         3033 my $value = shift;
247 2646         4168 my $array_var_name = "${string_var_name}_array";
248              
249 2646 100       4252 if (defined $value) {
250             # Keep the value as a string and also create an array of values.
251             # Keep content inside " as a single value and also protect \".
252 2637         2434 my @values;
253 2637 100       4830 if (length $value) {
254 2636         3041 my $v = $value;
255 2636         3762 $v =~ s/\\"/\200/g;
256 2636   100     11741 while (defined $v and length $v) {
257 4875 100       8794 if ($v =~ s/^"//) {
258 211         350 my $quote_index = index($v, '"');
259 211 50       337 if ($quote_index < 0) {
260 0         0 $v =~ s/\200/"/g;
261 0         0 push(@values, $v);
262 0         0 last;
263             } else {
264 211         391 my $v1 = substr($v, 0, $quote_index, '');
265 211         457 $v =~ s/^"\s*//;
266 211         331 $v1 =~ s/\200/"/g;
267 211         1197 push(@values, $v1);
268             }
269             } else {
270 4664         29613 my ($v1, $v2) = $v =~ /^(\S+)(?:\s+(.*))?$/;
271 4664         7661 $v = $v2;
272 4664         6304 $v1 =~ s/\200/"/g;
273 4664         21755 push(@values, $v1);
274             }
275             }
276             }
277 2637         4462 $self->{$string_var_name} = $value;
278 2637         5203 $self->{$array_var_name} = \@values;
279             } else {
280 9         18 $self->{$string_var_name} = undef;
281 9         17 $self->{$array_var_name} = undef;
282             }
283              
284 2646         8227 $old_value;
285             }
286              
287             sub value {
288 1329 50 33 1329 1 7316 unless (@_ and @_ < 3) {
289 0         0 confess "$0: Apache::ConfigParser::Directive::value ",
290             $INCORRECT_NUMBER_OF_ARGS;
291             }
292              
293 1329         2557 return _get_set_value_string(@_, 'value');
294             }
295              
296             sub orig_value {
297 1325 50 33 1325 1 6698 unless (@_ and @_ < 3) {
298 0         0 confess "$0: Apache::ConfigParser::Directive::orig_value ",
299             $INCORRECT_NUMBER_OF_ARGS;
300             }
301              
302 1325         2369 return _get_set_value_string(@_, 'orig_value');
303             }
304              
305             =item $d->value_array_ref
306              
307             =item $d->value_array_ref(\@array)
308              
309             In the first form get a reference to the value array. This can return
310             an undefined value if an undefined value was passed to C or an
311             undefined reference was passed to C. In the second
312             form C sets the value array and value string. Both
313             forms of C return the original array reference.
314              
315             If you modify the value array reference after getting it and do not
316             use C C to set the value, then the
317             string returned from C will not be consistent with the array.
318              
319             =item $d->orig_value_array_ref
320              
321             =item $d->orig_value_array_ref(\@array)
322              
323             Identical behavior as C, except that this applies to
324             the 'original' value.
325              
326             =cut
327              
328             # This is a utility function that takes the hash key name to place the
329             # value elements into, saves the array and creates a value string
330             # suitable for placing into an Apache configuration file.
331             sub _set_value_array {
332 1418 50   1418   6192 unless (@_ > 1) {
333 0         0 confess "$0: Apache::ConfigParser::Directive::_set_value_array ",
334             $INCORRECT_NUMBER_OF_ARGS;
335             }
336              
337 1418         1520 my $self = shift;
338 1418         1533 my $string_var_name = pop;
339 1418         2221 my $array_var_name = "${string_var_name}_array";
340 1418         2937 my @values = @_;
341              
342 1418         3148 my $value = '';
343 1418         7918 foreach my $s (@values) {
344 2728 50       5585 next unless length $s;
345              
346 2728 100       6436 $value .= ' ' if length $value;
347              
348             # Make a copy of the string so that the regex doesn't modify the
349             # contents of @values.
350 2728         3125 my $substring = $s;
351 2728         4350 $substring =~ s/(["\\])/\\$1/g;
352 2728 100       6377 if ($substring =~ /\s/) {
353 206         612 $value .= "\"$substring\"";
354             } else {
355 2522         5388 $value .= $substring;
356             }
357             }
358              
359 1418         2789 my $old_array_ref = $self->{$array_var_name};
360              
361 1418         2368 $self->{$string_var_name} = $value;
362 1418         2570 $self->{$array_var_name} = \@values;
363              
364 1418 100       7565 $old_array_ref ? @$old_array_ref : ();
365             }
366              
367             sub value_array_ref {
368 6 50 33 6 1 2227 unless (@_ and @_ < 3) {
369 0         0 confess "$0: Apache::ConfigParser::Directive::value_array_ref ",
370             $INCORRECT_NUMBER_OF_ARGS;
371             }
372              
373 6         11 my $self = shift;
374              
375 6         9 my $old = $self->{value_array};
376              
377 6 100       16 if (@_) {
378 1         3 my $ref = shift;
379 1 50       4 if (defined $ref) {
380 0         0 $self->_set_value_array(@$ref, 'value');
381             } else {
382 1         2 $self->{value} = undef;
383 1         2 $self->{value_array} = undef;
384             }
385             }
386              
387 6         29 $old;
388             }
389              
390             sub orig_value_array_ref {
391 3 50 33 3 1 1618 unless (@_ and @_ < 3) {
392 0         0 confess "$0: Apache::ConfigParser::Directive::orig_value_array_ref ",
393             $INCORRECT_NUMBER_OF_ARGS;
394             }
395              
396 3         5 my $self = shift;
397              
398 3         6 my $old = $self->{orig_value_array};
399              
400 3 50       11 if (@_) {
401 0         0 my $ref = shift;
402 0 0       0 if (defined $ref) {
403 0         0 $self->_set_value_array(@$ref, 'orig_value');
404             } else {
405 0         0 $self->{value} = undef;
406 0         0 $self->{value_array} = undef;
407             }
408             }
409              
410 3         13 $old;
411             }
412              
413             =item $d->get_value_array
414              
415             Get the value array elements. If the value was set to an undefined
416             value using C, then C will return an empty
417             list in a list context, an undefined value in a scalar context, or
418             nothing in a void context.
419              
420             =item $d->get_orig_value_array
421              
422             This has the same behavior of C except that it
423             operates on the 'original' value.
424              
425             =cut
426              
427             sub get_value_array {
428 1046 50   1046 1 2036 unless (@_ == 1) {
429 0         0 confess "$0: Apache::ConfigParser::Directive::get_value_array ",
430             $INCORRECT_NUMBER_OF_ARGS;
431             }
432              
433 1046         1481 my $ref = shift->{value_array};
434              
435 1046 100       1802 if ($ref) {
436 1044         4365 return @$ref;
437             } else {
438 2         9 return;
439             }
440             }
441              
442             sub get_orig_value_array {
443 4 50   4 1 640 unless (@_ == 1) {
444 0         0 confess "$0: Apache::ConfigParser::Directive::get_orig_value_array ",
445             $INCORRECT_NUMBER_OF_ARGS;
446             }
447              
448 4         8 my $ref = shift->{orig_value_array};
449              
450 4 50       10 if ($ref) {
451 4         16 return @$ref;
452             } else {
453 0         0 return;
454             }
455             }
456              
457             =item $d->set_value_array(@values)
458              
459             Set the value array elements. If no elements are passed in, then the
460             value will be defined but empty and a following call to
461             C will return an empty array. This returns the value
462             of the array before this method was called.
463              
464             After setting the value elements with this method, the string returned
465             from calling C is a concatenation of each of the elements so
466             that the output could be used for an Apache configuration file. If
467             any elements contain whitespace, then the "'s are placed around the
468             element as the element is being concatenated into the value string and
469             if any elements contain a " or a \, then a copy of the element is made
470             and the character is protected, i.e. \" or \\, and then copied into
471             the value string.
472              
473             =item $d->set_orig_value_array(@values)
474              
475             This has the same behavior as C except that it
476             operates on the 'original' value.
477              
478             =cut
479              
480             sub set_value_array {
481 1352     1352 1 2826 return _set_value_array(@_, 'value');
482             }
483              
484             sub set_orig_value_array {
485 66     66 1 30841 return _set_value_array(@_, 'orig_value');
486             }
487              
488             =item Note on $d->value_is_path, $d->value_is_abs_path,
489             $d->value_is_rel_path, $d->orig_value_is_path,
490             $d->orig_value_is_abs_path and $d->orig_value_is_rel_path
491              
492             These six methods are very similar. They all check if the directive
493             can take a file or directory path value argument in the appropriate
494             index in the value array and then check the value. For example, the
495             C directive, i.e.
496              
497             =over 4
498              
499             LoadModule cgi_module libexec/mod_cgi.so
500              
501             =back
502              
503             does not take a path element in its first (index 0) value array
504             element.
505              
506             If there is no argument supplied to the method call, then the
507             directive checks the first element of the value array that can legally
508             contain path. For C, it would check element 1. You could
509             pass 0 to the method to check the first indexed value of
510             C, but it would always return false, because index 0 does
511             not contain a path.
512              
513             These are the differences between the methods:
514              
515             =over 4
516              
517             1) The methods beginning with the string 'value_is' apply to the
518             current value in the directive while the methods beginning with the
519             string 'orig_value_is' apply to the original value of the directive.
520              
521             2) The methods '*value_is_path' test if the directive value is a path,
522             either absolute or relative. The methods '*value_is_abs_path' test if
523             the path if an absolute path, and the methods '*value_is_rel_path'
524             test if the path is not an absolute path.
525              
526             =back
527              
528             =item $d->value_is_path
529              
530             =item $d->value_is_path($index_into_value_array)
531              
532             Returns true if C<$d>'s directive can take a file or directory path in
533             the specified value array element (indexed by $index_into_value_array
534             or the first path element for the particular directive if
535             $index_into_value_array is not provided) and if the value is either an
536             absolute or relative file or directory path. Both the directive name
537             and the value is checked, because some directives such as ErrorLog,
538             can take values that are not paths (i.e. a piped command or
539             syslog:facility). The /dev/null equivalent for the operating system
540             is not treated as a path, since on some operating systems the
541             /dev/null equivalent is not a file, such as nul on Windows.
542              
543             The method actually does not check if its value is a path, rather it
544             checks if the value does not match all of the other possible non-path
545             values for the specific directive because different operating systems
546             have different path formats, such as Unix, Windows and Macintosh.
547              
548             =cut
549              
550             # Define these constant subroutines as the different types of paths to
551             # check for in _value_is_path_or_abs_path_or_rel_path.
552             sub CHECK_TYPE_ABS () { 'abs' }
553             sub CHECK_TYPE_REL () { 'rel' }
554             sub CHECK_TYPE_ABS_OR_REL () { 'abs_or_rel' }
555              
556             # This is a function that does the work for value_is_path,
557             # orig_value_is_path, value_is_abs_path, orig_value_is_abs_path,
558             # value_is_rel_path and orig_value_is_rel_path.
559             sub _value_is_path_or_abs_path_or_rel_path {
560 1369 50   1369   3293 unless (@_ == 4) {
561 0         0 confess "$0: Apache::ConfigParser::Directive::",
562             "_value_is_path_or_abs_path_or_rel_path ",
563             $INCORRECT_NUMBER_OF_ARGS;
564             }
565              
566 1369         3241 my ($self,
567             $check_type,
568             $array_var_name,
569             $value_path_index) = @_;
570              
571 1369 50 100     9741 unless ($check_type eq CHECK_TYPE_ABS or
      66        
572             $check_type eq CHECK_TYPE_REL or
573             $check_type eq CHECK_TYPE_ABS_OR_REL) {
574 0         0 confess "$0: Apache::ConfigParser::Directive::",
575             "_value_is_path_or_abs_path_or_rel_path ",
576             "passed invalid check_type value '$check_type'.\n";
577             }
578              
579 1369 50 66     4712 if (defined $value_path_index and $value_path_index !~ /^\d+$/) {
580 0         0 confess "$0: Apache::ConfigParser::Directive::",
581             "_value_is_path_or_abs_path_or_rel_path ",
582             "passed invalid value_path_index value '$value_path_index'.\n";
583             }
584              
585 1369         2649 my $array_ref = $self->{$array_var_name};
586              
587 1369 50       2972 unless ($array_ref) {
588 0         0 return 0;
589             }
590              
591 1369         2788 my $directive_name = $self->name;
592              
593 1369 50 33     6357 unless (defined $directive_name and length $directive_name) {
594 0         0 return 0;
595             }
596              
597             # Check if there is an index into the value array that can take a
598             # path.
599 1369         2210 my $first_value_path_index =
600             $directive_value_path_element_pos{$directive_name};
601 1369 100 66     7376 unless (defined $first_value_path_index and length $first_value_path_index) {
602 27         423 return 0;
603             }
604              
605             # If the index into the value array was specified, then check if the
606             # value in the index can take a path. If the index was not
607             # specified, then use the first value index that can contain a path.
608 1342 100       2782 if (defined $value_path_index) {
609 263 100       546 if (substr($first_value_path_index, 0, 1) eq '-') {
610 3 50       9 return 0 if $value_path_index < abs($first_value_path_index);
611             } else {
612 260 50       676 return 0 if $value_path_index != $first_value_path_index;
613             }
614             } else {
615 1079         1819 $value_path_index = abs($first_value_path_index);
616             }
617 1342         2362 my $path = $array_ref->[$value_path_index];
618              
619 1342 50 33     7161 unless (defined $path and length $path) {
620 0         0 return 0;
621             }
622              
623 1342 100       2706 if (is_dev_null($path)) {
624 93         723 return 0;
625             }
626              
627             # Get the subroutine that will check if the directive value is a
628             # path. If there is no subroutine for the directive, then it
629             # doesn't take a path.
630 1249         1856 my $sub_ref;
631 1249 100       3190 if ($check_type eq CHECK_TYPE_ABS) {
    100          
    50          
632 248         494 $sub_ref = $directive_value_takes_abs_path{$directive_name};
633             } elsif ($check_type eq CHECK_TYPE_REL) {
634 477         942 $sub_ref = $directive_value_takes_rel_path{$directive_name};
635             } elsif ($check_type eq CHECK_TYPE_ABS_OR_REL) {
636 524         969 $sub_ref = $directive_value_takes_abs_path{$directive_name};
637 524 50       9752 unless (defined $sub_ref) {
638 0         0 $sub_ref = $directive_value_takes_rel_path{$directive_name};
639             }
640             } else {
641 0         0 confess "$0: internal error: check_type case '$check_type' not handled.\n";
642             }
643              
644 1249 100       3012 unless ($sub_ref) {
645 117         1851 return 0;
646             }
647              
648 1132         3142 my $result = &$sub_ref($path);
649 1132 100       3423 if ($result) {
650 1093 100       4525 return 1 if $check_type eq CHECK_TYPE_ABS_OR_REL;
651              
652 586 100       1253 if ($check_type eq CHECK_TYPE_ABS) {
    50          
653 236 100       2800 return File::Spec->file_name_is_absolute($path) ? 1 : 0;
654             } elsif ($check_type eq CHECK_TYPE_REL) {
655 350 100       3938 return File::Spec->file_name_is_absolute($path) ? 0 : 1;
656             } else {
657 0         0 confess "$0: internal error: check_type case ",
658             "'$check_type' not handled.\n";
659             }
660             } else {
661 39         271 return 0;
662             }
663             }
664              
665             sub value_is_path {
666 436 50   436 1 19803 unless (@_ < 3) {
667 0         0 confess "$0: Apache::ConfigParser::Directive::value_is_path ",
668             $INCORRECT_NUMBER_OF_ARGS;
669             }
670              
671 436         2841 _value_is_path_or_abs_path_or_rel_path($_[0],
672             CHECK_TYPE_ABS_OR_REL,
673             'value_array',
674             $_[1]);
675             }
676              
677             =item $d->orig_value_is_path
678              
679             =item $d->orig_value_is_path($index_into_value_array)
680              
681             This has the same behavior as C<$d->value_is_path> except the results
682             are applicable to C<$d>'s 'original' value array.
683              
684             =cut
685              
686             sub orig_value_is_path {
687 128 50   128 1 440 unless (@_ < 3) {
688 0         0 confess "$0: Apache::ConfigParser::Directive::orig_value_is_path ",
689             $INCORRECT_NUMBER_OF_ARGS;
690             }
691              
692 128         648 _value_is_path_or_abs_path_or_rel_path($_[0],
693             CHECK_TYPE_ABS_OR_REL,
694             'orig_value_array',
695             $_[1]);
696             }
697              
698             =item $d->value_is_abs_path
699              
700             =item $d->value_is_abs_path($index_into_value_array)
701              
702             Returns true if C<$d>'s directive can take a file or directory path in
703             the specified value array element (indexed by $index_into_value_array
704             or the first path element for the particular directive if
705             $index_into_value_array is not provided) and if the value is an
706             absolute file or directory path. Both the directive name and the
707             value is checked, because some directives such as ErrorLog, can take
708             values that are not paths (i.e. a piped command or syslog:facility).
709             The /dev/null equivalent for the operating system is not treated as a
710             path, since on some operating systems the /dev/null equivalent is not
711             a file, such as nul on Windows.
712              
713             The method actually does not check if its value is a path, rather it
714             checks if the value does not match all of the other possible non-path
715             values for the specific directive because different operating systems
716             have different path formats, such as Unix, Windows and Macintosh.
717              
718             =cut
719              
720             sub value_is_abs_path {
721 160 50   160 1 507 unless (@_ < 3) {
722 0         0 confess "$0: Apache::ConfigParser::Directive::value_is_abs_path ",
723             $INCORRECT_NUMBER_OF_ARGS;
724             }
725              
726 160         549 _value_is_path_or_abs_path_or_rel_path($_[0],
727             CHECK_TYPE_ABS,
728             'value_array',
729             $_[1]);
730             }
731              
732             =item $d->orig_value_is_abs_path
733              
734             =item $d->orig_value_is_abs_path($index_into_value_array)
735              
736             This has the same behavior as C<$d->value_is_abs_path> except the
737             results are applicable to C<$d>'s 'original' value array.
738              
739             =cut
740              
741             sub orig_value_is_abs_path {
742 128 50   128 1 404 unless (@_ < 3) {
743 0         0 confess "$0: Apache::ConfigParser::Directive::orig_value_is_abs_path ",
744             $INCORRECT_NUMBER_OF_ARGS;
745             }
746              
747 128         505 _value_is_path_or_abs_path_or_rel_path($_[0],
748             CHECK_TYPE_ABS,
749             'orig_value_array',
750             $_[1]);
751             }
752              
753             =item $d->value_is_rel_path
754              
755             =item $d->value_is_rel_path($index_into_value_array)
756              
757             Returns true if C<$d>'s directive can take a file or directory path in
758             the specified value array element (indexed by $index_into_value_array
759             or the first path element for the particular directive if
760             $index_into_value_array is not provided) and if the value is a
761             relative file or directory path. Both the directive name and the
762             value is checked, because some directives such as ErrorLog, can take
763             values that are not paths (i.e. a piped command or syslog:facility).
764             The /dev/null equivalent for the operating system is not treated as a
765             path, since on some operating systems the /dev/null equivalent is not
766             a file, such as nul on Windows.
767              
768             The method actually does not check if its value is a path, rather it
769             checks if the value does not match all of the other possible non-path
770             values for the specific directive because different operating systems
771             have different path formats, such as Unix, Windows and Macintosh.
772              
773             =cut
774              
775             sub value_is_rel_path {
776 389 50   389 1 1104 unless (@_ < 3) {
777 0         0 confess "$0: Apache::ConfigParser::Directive::value_is_rel_path ",
778             $INCORRECT_NUMBER_OF_ARGS;
779             }
780              
781 389         1305 _value_is_path_or_abs_path_or_rel_path($_[0],
782             CHECK_TYPE_REL,
783             'value_array',
784             $_[1]);
785             }
786              
787             =item $d->orig_value_is_rel_path
788              
789             =item $d->orig_value_is_rel_path($index_into_value_array)
790              
791             This has the same behavior as C<$d->value_is_rel_path> except the
792             results are applicable to C<$d>'s 'original' value array.
793              
794             =cut
795              
796             sub orig_value_is_rel_path {
797 128 50   128 1 417 unless (@_ < 3) {
798 0         0 confess "$0: Apache::ConfigParser::Directive::orig_value_is_rel_path ",
799             $INCORRECT_NUMBER_OF_ARGS;
800             }
801              
802 128         520 _value_is_path_or_abs_path_or_rel_path($_[0],
803             CHECK_TYPE_REL,
804             'orig_value_array',
805             $_[1]);
806             }
807              
808             =item $d->filename
809              
810             =item $d->filename($filename)
811              
812             In the first form get the filename where this particular directive or
813             context appears. In the second form set the new filename of the
814             directive or context and return the original filename.
815              
816             =cut
817              
818             sub filename {
819 1228 50   1228 1 4444 unless (@_ < 3) {
820 0         0 confess "$0: Apache::ConfigParser::Directive::filename ",
821             $INCORRECT_NUMBER_OF_ARGS;
822             }
823              
824 1228         1340 my $self = shift;
825 1228 100       2125 if (@_) {
826 1226         1835 my $old = $self->{filename};
827 1226         1909 $self->{filename} = $_[0];
828 1226         2886 return $old;
829             } else {
830 2         10 return $self->{filename};
831             }
832             }
833              
834             =item $d->line_number
835              
836             =item $d->line_number($line_number)
837              
838             In the first form get the line number where the directive or context
839             appears in a filename. In the second form set the new line number of
840             the directive or context and return the original line number.
841              
842             =cut
843              
844             sub line_number {
845 1228 50   1228 1 2401 unless (@_ < 3) {
846 0         0 confess "$0: Apache::ConfigParser::Directive::line_number ",
847             $INCORRECT_NUMBER_OF_ARGS;
848             }
849              
850 1228         1328 my $self = shift;
851 1228 100       2249 if (@_) {
852 1226         1546 my $old = $self->{line_number};
853 1226         2929 $self->{line_number} = $_[0];
854 1226         2541 return $old;
855             } else {
856 2         8 return $self->{line_number};
857             }
858             }
859              
860             =back
861              
862             =head1 EXPORTED VARIABLES
863              
864             The following variables are exported via C<@EXPORT_OK>.
865              
866             =over 4
867              
868             =item DEV_NULL
869              
870             The string representation of the null device on this operating system.
871              
872             =item DEV_NULL_LC
873              
874             The lowercase version of DEV_NULL.
875              
876             =item is_dev_null($path)
877              
878             On a case sensitive system, compares $path to DEV_NULL and on a case
879             insensitive system, compares lc($path) to DEV_NULL_LC.
880              
881             =item %directive_value_takes_abs_path
882              
883             This hash is keyed by the lowercase version of a directive name. This
884             hash is keyed by all directives that accept a file or directory path
885             value as its first value array element. The hash value is a subroutine
886             reference to pass the value array element containing the file,
887             directory, pipe or syslog entry to. If a hash entry exists for a
888             particular entry, then the directive name can take either a relative
889             or absolute path to either a file or directory. The hash does not
890             distinguish between directives that take only filenames, only
891             directories or both, and it does not distinguish if the directive
892             takes only absolute, only relative or both types of paths.
893              
894             The hash value for the lowercase directive name is a subroutine
895             reference. The subroutine returns 1 if its only argument is a path
896             and 0 otherwise. The /dev/null equivalent (Cdevnull>)
897             for the operating system being used is not counted as a path, since on
898             some operating systems the /dev/null equivalent is not a filename,
899             such as nul on Windows.
900              
901             The subroutine actually does not check if its argument is a path,
902             rather it checks if the argument does not match one of the other
903             possible non-path values for the specific directive because different
904             operating systems have different path formats, such as Unix, Windows
905             and Macintosh. For example, ErrorLog can take a filename, such as
906              
907             ErrorLog /var/log/httpd/error_log
908              
909             or a piped command, such as
910              
911             ErrorLog "| cronolog /var/log/httpd/%Y/%m/%d/error.log"
912              
913             or a syslog entry of the two forms:
914              
915             ErrorLog syslog
916             ErrorLog syslog:local7
917              
918             The particular subroutine for ErrorLog checks if the value is not
919             equal to Cdevnull>, does not begin with a | or does not
920             match syslog(:[a-zA-Z0-9]+)?.
921              
922             These subroutines do not remove any "'s before checking on the type of
923             value.
924              
925             This hash is used by C and C.
926              
927             This is a list of directives and any special values to check for as of
928             Apache 1.3.20.
929              
930             AccessConfig
931             AgentLog check for "| prog"
932             AuthDBGroupFile
933             AuthDBMGroupFile
934             AuthDBMUserFile
935             AuthDBUserFile
936             AuthDigestFile
937             AuthGroupFile
938             AuthUserFile
939             CacheRoot
940             CookieLog
941             CoreDumpDirectory
942             CustomLog check for "| prog"
943             Directory
944             DocumentRoot
945             ErrorLog check for "| prog", or syslog or syslog:facility
946             Include
947             LoadFile
948             LoadModule
949             LockFile
950             MimeMagicFile
951             MMapFile
952             PidFile
953             RefererLog check for "| prog"
954             ResourceConfig
955             RewriteLock
956             ScoreBoardFile
957             ScriptLog
958             ServerRoot
959             TransferLog check for "| prog"
960             TypesConfig
961              
962             =item %directive_value_takes_rel_path
963              
964             This hash is keyed by the lowercase version of a directive name. This
965             hash contains only those directive names that can accept both relative
966             and absolute file or directory names. The hash value is a subroutine
967             reference to pass the value array element containing the file,
968             directory, pipe or syslog entry to. The hash does not distinguish
969             between directives that take only filenames, only directories or both.
970              
971             The hash value for the lowercase directive name is a subroutine
972             reference. The subroutine returns 1 if its only argument is a path
973             and 0 otherwise. The /dev/null equivalent (Cdevnull>)
974             for the operating system being used is not counted as a path, since on
975             some operating systems the /dev/null equivalent is not a filename,
976             such as nul on Windows.
977              
978             The subroutine actually does not check if its argument is a path,
979             rather it checks if the argument does not match one of the other
980             possible non-path values for the specific directive because different
981             operating systems have different path formats, such as Unix, Windows
982             and Macintosh. For example, ErrorLog can take a filename, such as
983              
984             ErrorLog /var/log/httpd/error_log
985              
986             or a piped command, such as
987              
988             ErrorLog "| cronolog /var/log/httpd/%Y/%m/%d/error.log"
989              
990             or a syslog entry of the two forms:
991              
992             ErrorLog syslog
993             ErrorLog syslog:local7
994              
995             The particular subroutine for ErrorLog checks if the value is not
996             equal to Cdevnull>, does not begin with a | or does not
997             match syslog(:[a-zA-Z0-9]+)?.
998              
999             These subroutines do not remove any "'s before checking on the type of
1000             value.
1001              
1002             This hash is used by C and
1003             C.
1004              
1005             This is a list of directives and any special values to check for as of
1006             Apache 1.3.20.
1007              
1008             AccessConfig
1009             AuthGroupFile
1010             AuthUserFile
1011             CookieLog
1012             CustomLog check for "| prog"
1013             ErrorLog check for "| prog", or syslog or syslog:facility
1014             Include
1015             LoadFile
1016             LoadModule
1017             LockFile
1018             MimeMagicFile
1019             PidFile
1020             RefererLog check for "| prog"
1021             ResourceConfig
1022             ScoreBoardFile
1023             ScriptLog
1024             TransferLog check for "| prog"
1025             TypesConfig
1026              
1027             =item %directive_value_path_element_pos
1028              
1029             This hash holds the indexes into the directive value array for the
1030             value or values that can contain either absolute or relative file or
1031             directory paths. This hash is keyed by the lowercase version of a
1032             directive name. The hash value is a string representing an integer.
1033             The string can take two forms:
1034              
1035             /^\d+$/ The directive has only one value element indexed by \d+
1036             that takes a file or directory path.
1037              
1038             /^-\d+$/ The directive takes any number of file or directory path
1039             elements beginning with the abs(\d+) element.
1040              
1041             For example:
1042              
1043             # CustomLog logs/access_log common
1044             $directive_value_path_element_pos{customlog} eq '0';
1045              
1046             # LoadFile modules/mod_env.so libexec/mod_mime.so
1047             $directive_value_path_element_pos{loadfile} eq '-0';
1048              
1049             # LoadModule env_module modules/mod_env.so
1050             $directive_value_path_element_pos{loadmodule} eq '1';
1051              
1052             # PidFile logs/httpd.pid
1053             $directive_value_path_element_pos{pidfile} eq '0';
1054              
1055             =back
1056              
1057             =cut
1058              
1059             sub directive_value_is_not_dev_null {
1060 885     885 0 1788 !is_dev_null($_[0]);
1061             }
1062              
1063             sub directive_value_is_not_dev_null_and_pipe {
1064 161 50   161 0 307 if (is_dev_null($_[0])) {
1065 0         0 return 0;
1066             }
1067              
1068 161         527 return $_[0] !~ /^\s*\|/;
1069             }
1070              
1071             sub directive_value_is_not_dev_null_and_pipe_and_syslog {
1072 86 50   86 0 178 if (is_dev_null($_[0])) {
1073 0         0 return 0;
1074             }
1075              
1076 86         334 return $_[0] !~ /^\s*(?:(?:\|)|(?:syslog(?::[a-zA-Z0-9]+)?))/;
1077             }
1078              
1079             # This is a hash keyed by directive name and the value is an array
1080             # reference. The array element are
1081             # array array
1082             # index value
1083             # 0 A string containing an integer that describes the element
1084             # position(s) that contains the file or directory path.
1085             # string =~ /^\d+/ a single element that contains a path
1086             # string =~ /^-\d+/ multiple elements, first is abs(\d+)
1087             # 1 1 if the paths the directive accepts can be absolute and
1088             # relative, 0 if they can only be absolute
1089             # 2 a subroutine reference to directive_value_is_not_dev_null,
1090             # directive_value_is_not_dev_null_and_pipe or
1091             # directive_value_is_not_dev_null_and_pipe_and_syslog.
1092              
1093             my %directive_info = (
1094             AccessConfig => ['0',
1095             1,
1096             \&directive_value_is_not_dev_null],
1097             AuthDBGroupFile => ['0',
1098             0,
1099             \&directive_value_is_not_dev_null],
1100             AuthDBMGroupFile => ['0',
1101             0,
1102             \&directive_value_is_not_dev_null],
1103             AuthDBMUserFile => ['0',
1104             0,
1105             \&directive_value_is_not_dev_null],
1106             AuthDBUserFile => ['0',
1107             0,
1108             \&directive_value_is_not_dev_null],
1109             AuthDigestFile => ['0',
1110             0,
1111             \&directive_value_is_not_dev_null],
1112             AgentLog => ['0',
1113             0,
1114             \&directive_value_is_not_dev_null_and_pipe],
1115             AuthGroupFile => ['0',
1116             1,
1117             \&directive_value_is_not_dev_null],
1118             AuthUserFile => ['0',
1119             1,
1120             \&directive_value_is_not_dev_null],
1121             CacheRoot => ['0',
1122             0,
1123             \&directive_value_is_not_dev_null],
1124             CookieLog => ['0',
1125             1,
1126             \&directive_value_is_not_dev_null],
1127             CoreDumpDirectory => ['0',
1128             0,
1129             \&directive_value_is_not_dev_null],
1130             CustomLog => ['0',
1131             1,
1132             \&directive_value_is_not_dev_null_and_pipe],
1133             Directory => ['0',
1134             0,
1135             \&directive_value_is_not_dev_null],
1136             DocumentRoot => ['0',
1137             0,
1138             \&directive_value_is_not_dev_null],
1139             ErrorLog => ['0',
1140             1,
1141             \&directive_value_is_not_dev_null_and_pipe_and_syslog],
1142             Include => ['0',
1143             1,
1144             \&directive_value_is_not_dev_null],
1145             LoadFile => ['-0',
1146             1,
1147             \&directive_value_is_not_dev_null],
1148             LoadModule => ['1',
1149             1,
1150             \&directive_value_is_not_dev_null],
1151             LockFile => ['0',
1152             1,
1153             \&directive_value_is_not_dev_null],
1154             MMapFile => ['0',
1155             0,
1156             \&directive_value_is_not_dev_null],
1157             MimeMagicFile => ['0',
1158             1,
1159             \&directive_value_is_not_dev_null],
1160             PidFile => ['0',
1161             1,
1162             \&directive_value_is_not_dev_null],
1163             RefererLog => ['0',
1164             1,
1165             \&directive_value_is_not_dev_null_and_pipe],
1166             ResourceConfig => ['0',
1167             1,
1168             \&directive_value_is_not_dev_null],
1169             RewriteLock => ['0',
1170             0,
1171             \&directive_value_is_not_dev_null],
1172             ScoreBoardFile => ['0',
1173             1,
1174             \&directive_value_is_not_dev_null],
1175             ScriptLog => ['0',
1176             1,
1177             \&directive_value_is_not_dev_null],
1178             ServerRoot => ['0',
1179             0,
1180             \&directive_value_is_not_dev_null],
1181             TransferLog => ['0',
1182             1,
1183             \&directive_value_is_not_dev_null_and_pipe],
1184             TypesConfig => ['0',
1185             1,
1186             \&directive_value_is_not_dev_null]);
1187              
1188             # Set up the three exported hashes using the information in
1189             # %directive_info. Use lowercase directive names.
1190             foreach my $key (keys %directive_info) {
1191             my $ref = $directive_info{$key};
1192             my $lc_key = lc($key);
1193             my ($index, $abs_and_rel, $sub_ref) = @$ref;
1194             if ($abs_and_rel) {
1195             $directive_value_takes_rel_path{$lc_key} = $sub_ref;
1196             }
1197             $directive_value_takes_abs_path{$lc_key} = $sub_ref;
1198             $directive_value_path_element_pos{$lc_key} = $index;
1199             }
1200              
1201             =head1 SEE ALSO
1202              
1203             L and L.
1204              
1205             =head1 AUTHOR
1206              
1207             Blair Zajac .
1208              
1209             =head1 COPYRIGHT
1210              
1211             Copyright (C) 2001-2005 Blair Zajac. All rights reserved. This
1212             program is free software; you can redistribute it and/or modify it
1213             under the same terms as Perl itself.
1214              
1215             =cut
1216              
1217             1;