From 34802f2665991b4abe000c87defaf16f5f41a2cc Mon Sep 17 00:00:00 2001 From: Michael Grubb Date: Fri, 17 Sep 2004 16:50:03 +0000 Subject: [PATCH] Enhanced Variable substitution and added some more test cases for it. --- Changes | 10 +++++ META.yml | 2 +- lib/Config/ApacheExtended.pm | 67 ++++++++++++++++++++++++---- lib/Config/ApacheExtended/Grammar.pm | 38 ++++++++-------- t/006_expandvars.t | 8 +++- t/expandvars.conf | 1 + 6 files changed, 96 insertions(+), 30 deletions(-) diff --git a/Changes b/Changes index 21b890b..3124b16 100644 --- a/Changes +++ b/Changes @@ -31,3 +31,13 @@ Revision history for Perl module Config::ApacheExtended construct to perl_quotelike. So I had to replace perl_quotelike directive in the grammar with a regular expression. This means that only ' & " are considered as quote characters. + +1.16 Fri Sep 17 10:48:40 CDT 2004 + - Changed variable substitution + The change involved not "joining" the list of substituted + values with the "$LIST_SEPARATOR" value when the "@" is used + as the prefix. Now when "@" prefix is used it will insert the + referenced values as a list. The $v[x] syntax is still supported, + and if no index is given then the first value is still used. + - Added the long missing VARIABLE SUBSTITUTION section. (I thought it was there + honest) diff --git a/META.yml b/META.yml index f10780b..c34aaca 100644 --- a/META.yml +++ b/META.yml @@ -14,4 +14,4 @@ requires: Text::Balanced: 1.89 distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 +generated_by: ExtUtils::MakeMaker version 6.20 diff --git a/lib/Config/ApacheExtended.pm b/lib/Config/ApacheExtended.pm index 7433afe..cfb4919 100644 --- a/lib/Config/ApacheExtended.pm +++ b/lib/Config/ApacheExtended.pm @@ -405,7 +405,7 @@ sub _substituteValues while( my $varspec = extract_variable($newval, qr/(?:.*?)(?=[\$\@])/) ) { my($type,$var,$idx) = $varspec =~ m/^([\$\@])(.*?)(?:\[(\d+)\])?$/; -# $idx ||= 0; + $idx ||= 0; my $pattern; ($pattern = $varspec) =~ s/([^\w\s])/\\$1/g; $var = $self->{_ignore_case} ? lc $var : $var; @@ -416,18 +416,20 @@ sub _substituteValues last; } - if ( $type eq '$' && defined($idx) ) + if ( $type eq '$' ) { $data->{$key}->[$i] =~ s/$pattern/$lval[$idx]/g; } - elsif ( $type eq '$' ) - { - $data->{$key}->[$i] =~ s/$pattern/join($", @lval)/eg; - } elsif ( $type eq '@' ) { - splice(@{$data->{$key}}, $i, 1, @lval); -# $data->{$key}->[$i] =~ s/$pattern/join($", @lval)/eg; + if ( $data->{$key}->[$i] =~ m/^$pattern$/ ) + { + splice(@{$data->{$key}}, $i, 1, @lval); + } + else + { + $data->{$key}->[$i] =~ s/$pattern/join($", @lval)/eg; + } } } } @@ -630,6 +632,55 @@ sub _createBlock 1; +=head1 VARIABLE SUBSTITUTION + +It just occured to me that this section has been omitted for some time. Sorry. +Variable substitution is supported in one of three ways. Given the configuration: + + ValList1 myval1 myval2 + ValList2 myval3 myval4 + + MyVal @ValList1 @ValList2 + OddVal thatval1 @ValList1 thatval2 + Stringification "The (@ValList1) is a list of two values" + AnotherVal $ValList1 + YetAnotherVal $ValList2[1] + +Retrieving C will yield a list with 4 values namely: I. +Retrieving C will also yield a list with 4 values: I. +Retrieving C will yeild I. Retrieving C will yield: I. +Retrieving C will yield the string: I. + +So this leads to the conclusion that: + +=over 4 + +=item * + +The "$" prefix substitutes the first/only value of another directive. + +=item * + +The "$" prefix used with the index I after the directive name will substitute the Nth value of the other directive. +Indexes are zero indexed just as Perl array indexes are. + +=item * + +The "@" prefix substitutes the entire value list of the other directive in place. + +=item * + +The "@" prefix will substitute the entire value list joined on the C<$LIST_SEPARATOR> if it occurs within a quoted string. +B That C<"@SomeVal"> will not cause stringification of the list. I'm working on this. + +=back + +This behaviour has only slightly changed from 1.15 to 1.16. The difference is that the "@" prefix now causes the entire list +to be substituted rather than having the values joined with the C<$LIST_SEPARATOR> character. +Also note that substitution B occur inside single quotes. This is a limitation of the current implementation, +as I do not have enough hints at substitution time to know whether the values where inside single or double quotes. +I welcome patches/suggestions to fix this. + =head1 BUGS This not really a bug, more of a Todo, however This module does not currently provide diff --git a/lib/Config/ApacheExtended/Grammar.pm b/lib/Config/ApacheExtended/Grammar.pm index 4c44f25..80a8ddf 100644 --- a/lib/Config/ApacheExtended/Grammar.pm +++ b/lib/Config/ApacheExtended/Grammar.pm @@ -4310,7 +4310,7 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'description' => '/\\\\n/', 'lookahead' => 0, 'rdelim' => '/', - 'line' => 46, + 'line' => 45, 'mod' => '', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ) @@ -4320,7 +4320,7 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { ], 'name' => 'eol', 'vars' => '', - 'line' => 46 + 'line' => 45 }, 'Parse::RecDescent::Rule' ), 'skipline' => bless( { 'impcount' => 0, @@ -4655,7 +4655,7 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Subrule' ) ], 'line' => undef @@ -4675,10 +4675,10 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Subrule' ) ], - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Production' ), bless( { 'number' => '2', @@ -4695,10 +4695,10 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Subrule' ) ], - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Production' ), bless( { 'number' => '3', @@ -4715,10 +4715,10 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Subrule' ) ], - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Production' ), bless( { 'number' => '4', @@ -4735,10 +4735,10 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Subrule' ) ], - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Production' ), bless( { 'number' => '5', @@ -4755,10 +4755,10 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Subrule' ) ], - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Production' ), bless( { 'number' => '6', @@ -4775,15 +4775,15 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'implicit' => undef, 'argcode' => undef, 'lookahead' => 0, - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Subrule' ) ], - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Production' ) ], 'name' => '_alternation_1_of_production_1_of_rule_statement', 'vars' => '', - 'line' => 48 + 'line' => 47 }, 'Parse::RecDescent::Rule' ), 'hereto_line' => bless( { 'impcount' => 0, @@ -4845,7 +4845,7 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'description' => '/\\\\S+/', 'lookahead' => 0, 'rdelim' => '/', - 'line' => 45, + 'line' => 44, 'mod' => '', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ) @@ -5256,7 +5256,7 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { 'description' => '/^\\\\z/', 'lookahead' => 0, 'rdelim' => '/', - 'line' => 47, + 'line' => 46, 'mod' => '', 'ldelim' => '/' }, 'Parse::RecDescent::Token' ) @@ -5266,7 +5266,7 @@ package Config::ApacheExtended::Grammar; sub new { my $self = bless( { ], 'name' => 'eof', 'vars' => '', - 'line' => 47 + 'line' => 46 }, 'Parse::RecDescent::Rule' ), 'block_end' => bless( { 'impcount' => 0, diff --git a/t/006_expandvars.t b/t/006_expandvars.t index 93127f1..a19f9c8 100644 --- a/t/006_expandvars.t +++ b/t/006_expandvars.t @@ -2,7 +2,7 @@ # t/006_expandvars.t - Tests the variable expansion feature -use Test::More tests => 17; +use Test::More tests => 19; use Config::ApacheExtended; use English; my $conf = Config::ApacheExtended->new( @@ -22,6 +22,7 @@ my $block = $conf->block( FooBar => 'baz test' ); my @boom = $block->get('Boom'); my $blat = $block->get('Blat'); my $idxtest = $conf->get('SomeIdxTest'); +my $arstrtest = $conf->get('ArrayStringTest'); my $cstr = join($LIST_SEPARATOR, @bar); ok($foo); # test 3 @@ -38,7 +39,10 @@ is(scalar(@boom), scalar(@bar)); # test 11 is($boom[0], $bar[0]); # test 12 is($boom[1], $bar[1]); # test 13 ok($blat); # test 14 -is($blat, $cstr); # test 15 +is($blat, $bar[0]); # test 15 ok($idxtest); # test 16 is($idxtest, $bar[1]); # test 17 + +ok($arstrtest); # test 18 +is($arstrtest, "Batman, $cstr, Joker."); # test 19 diff --git a/t/expandvars.conf b/t/expandvars.conf index 1556064..cbc2291 100644 --- a/t/expandvars.conf +++ b/t/expandvars.conf @@ -8,6 +8,7 @@ NoVal SomeIdxTest $Bar[1] +ArrayStringTest "Batman, @Bar, Joker." MultilineTest Multi \ values \