Compensate for the deficiences of Apache::Admin::Config 0.95

* lib/Apache/Config/Preproc.pm: Provide optimized implementation
of the _preproc_section method.
* t/TestPreproc.pm (import): Pass options to the Apache::Config::Preproc
import from the environment variable APACHE_CONFIG_PREPROC.
* t/05ifdefine00.t: Fix redefinition of a lexical-scoped variable.

3 files changed, 159 insertions, 9 deletions

diff --git a/lib/Apache/Config/Preproc.pm b/lib/Apache/Config/Preproc.pm
index 5b85ce1..418bad9 100644
--- a/lib/Apache/Config/Preproc.pm
+++ b/lib/Apache/Config/Preproc.pm
@@ -3,9 +3,27 @@ use parent 'Apache::Admin::Config';
 use strict;
 use warnings;
 use Carp;
+use version 0.77;
 
 our $VERSION = '1.03';
 
+sub import {
+    my $class = shift;
+    if (defined(my $kw = shift)) {
+	if ($kw eq ':default') {
+	    install_preproc_default()
+	} elsif ($kw eq ':optimized') {
+	    install_preproc_optimized()
+	} else {
+	    croak "Unrecognized import parameter: $kw"
+	}
+    }
+    if (@_) {
+	croak "Too many import parameters";
+    }
+    $class->SUPER::import();
+}
+
 sub new {
     my $class = shift;
     my $file = shift;
@@ -17,7 +35,7 @@ sub new {
     $self->{_options} = \@_;
 
     eval {
-	return unless $self->_preproc($explist);
+	$self->_preproc($explist);
     };
     if ($@) {
 	$Apache::Admin::Config::ERROR = $@;
@@ -40,9 +58,7 @@ sub options { shift->{_options} }
 sub _preproc {
     my ($self, $explist) = @_;
 
-    return 1 unless @$explist;
-    
-    return $self->_preproc_section($self,
+    $self->_preproc_section($self,
 			  [ map {
 			      my ($mod,@arg);
 			      if (ref($_) eq 'HASH') {
@@ -61,11 +77,43 @@ sub _preproc {
 			    } @$explist ]);
 }
 
-sub _preproc_section {
+# As of version 0.95, the Apache::Admin::Config package provides no
+# methods for iterating over all configuration file statements, excepting
+# the select method with the -which => N argument, which returns Nth
+# statement or undef if N is out of range.  This method has two drawbacks:
+#
+#   1. It iterates over entire statement tree no matter what arguments are
+#      given (see Apache/Admin/Config.pm, lines 417-439)
+#   2. It makes unnecessary memory allocations (ibid., line 437).
+#   3. When N is out of range, the following warning is emitted
+#      in -w mode:
+#         Use of uninitialized value $_[0] in string at
+#         /usr/share/perl5/overload.pm line 119
+#      That's because it unreferences the undefined value and passes it
+#      to the overload::StrVal method (ibid., line 443).
+#
+# This means that time complexity of the code below is O(N**2).  This is
+# further aggravated by the fact that no method is provided for inline
+# modification of the source tree, except for the 'add' method, which again
+# iterates over entire tree in order to locate the element, after which
+# the new one should be inserted.
+#
+# Thus, the following default implementation of the _preproc_section function
+# is highly inefficient:
+
+sub _preproc_section_default {
     my ($self, $section, $modlist) = @_;
 
+    return unless @$modlist;
+
   OUTER:
-    for (my $i = 0; defined(my $d = $section->select(-which => $i)); ) {
+    for (my $i = 0;
+	 defined(my $d = do {
+	     local $SIG{__WARN__} = sub {
+		 my $msg = shift;
+		 warn "$msg" unless $msg =~ /uninitialized/;
+	     };
+	     $section->select(-which => $i) }); ) {
 	foreach my $mod (@$modlist) {
 	    my @repl;
 	    if ($mod->expand($d, \@repl)) {
@@ -77,7 +125,7 @@ sub _preproc_section {
 		next OUTER;
 	    }
 	    if ($d->type eq 'section') {
-		$self->_preproc_section($d, $modlist);
+		$self->_preproc_section_default($d, $modlist);
 	    }
 	}
 	$i++;
@@ -85,6 +133,83 @@ sub _preproc_section {
     return 1;
 }
 
+# In attempt to fix the above problems I resort to a kludgy solution,
+# which directly modifies the Apache::Admin::Config::Tree namespace
+# and defines two missing functions in it: get_nth(N), which returns
+# the Nth statement or undef if N is greater than the source tree
+# length, and replace_inplace(N, A), which replaces the Nth statement
+# with statements from the array A.  With these two methods at hand,
+# the following implementation is used:
+sub _preproc_section_optimized {
+    my ($self, $section, $modlist) = @_;
+
+    return unless @$modlist;
+
+  OUTER:
+    for (my $i = 0; defined(my $d = $section->get_nth($i)); ) {
+	foreach my $mod (@$modlist) {
+	    my @repl;
+	    if ($mod->expand($d, \@repl)) {
+		$section->replace_inplace($i, @repl);
+		next OUTER;
+	    }
+	    if ($d->type eq 'section') {
+		$self->_preproc_section_optimized($d, $modlist);
+	    }
+	}
+	$i++;
+    }
+}
+
+# The _preproc_section method upon its first invocation selects the
+# right implementation to use.  If the version of the Apache::Admin::Config
+# module is 0.95 or if the object has attribute {tree}{children} and it is
+# a list reference, the function installs the two new methods in the
+# Apache::Admin::Config::Tree namespace and selects the optimized
+# implementation.  Otherwise, the default implementation is used.
+#
+# The decision can be forced when requiring the module.  To select the
+# default implementation, do
+#
+#   use Apache::Config::Preproc qw(:default);
+#
+# To select the optimized implementation:
+#
+#   use Apache::Config::Preproc qw(:optimized);
+#
+sub _preproc_section {
+    my $self = shift;
+    unless ($self->can('_preproc_section_internal')) {
+	if ((version->parse($Apache::Admin::Config::VERSION) == version->parse('0.95')
+	    || (exists($self->{children}) && ref($self->{tree}{children}) eq 'ARRAY'))) {
+	    install_preproc_optimized()
+	} else {
+	    install_preproc_default()
+	}
+    }
+    $self->_preproc_section_internal(@_);
+}
+
+sub install_preproc_optimized {
+    no warnings 'once';
+    *{Apache::Admin::Config::Tree::get_nth} = sub {
+	my ($self, $n) = @_;
+	if ($n < @{$self->{children}}) {
+	    return $self->{children}[$n];
+	}
+	return undef
+    };
+    *{Apache::Admin::Config::Tree::replace_inplace} = sub {
+	my ($self, $n, @items) = @_;
+	splice @{$self->{children}}, $n, 1, @items;
+    };
+
+    *{_preproc_section_internal} = \&_preproc_section_optimized;
+}
+
+sub install_preproc_default {
+    *{_preproc_section_internal} = \&_preproc_section_default;
+}
 
 1;
 __END__
@@ -149,6 +274,26 @@ used:
     
 The rest of methods is inherited from B<Apache::Admin::Config>.
 
+=head1 IMPORT
+
+The package provides two implementations of the main preprocessing
+method.  The default implementation uses only the documented methods
+of the base B<Apache::Admin::Config> class and due to its deficiences
+shows the O(N**2) time complexity.  The optimized implementations does
+some introspection into the internals of the base class, which allow it
+to reduce the time complexity to O(N).  Whenever possible, the optimized
+implementation is selected.  You can, however, force using the particular
+implementation by supplying keywords to the C<use> statement.  To
+select the default implementation:
+
+    use Apache::Config::Preproc qw(:default);
+
+To select the optimized implementation:
+
+    use Apache::Config::Preproc qw(:optimized);
+
+See the source code for details.
+
 =head1 CONSTRUCTOR
 
 =head2 new
diff --git a/t/05ifdefine00.t b/t/05ifdefine00.t
index e488101..f54d62b 100644
--- a/t/05ifdefine00.t
+++ b/t/05ifdefine00.t
@@ -9,10 +9,10 @@ use TestPreproc;
 my $obj = new TestPreproc -expand => ['ifdefine'];
 ok($obj->dump_raw, $obj->dump_expect);
 
-my $obj = new TestPreproc -expand => [ { ifdefine => [qw(VAR)] } ];
+$obj = new TestPreproc -expand => [ { ifdefine => [qw(VAR)] } ];
 ok($obj->dump_raw, $obj->dump_expect);
 
-my $obj = new TestPreproc -expand => ['ifdefine'];
+$obj = new TestPreproc -expand => ['ifdefine'];
 ok($obj->dump_raw, $obj->dump_expect);
 
 __DATA__
diff --git a/t/TestPreproc.pm b/t/TestPreproc.pm
index 9de5fe2..41d6e24 100644
--- a/t/TestPreproc.pm
+++ b/t/TestPreproc.pm
@@ -9,6 +9,11 @@ use File::Spec;
 use File::Path qw /make_path/;
 use autodie;
 
+sub import {
+    my $class = shift;
+    $class->SUPER::import($ENV{APACHE_CONFIG_PREPROC});
+}
+
 sub new {
     my $class = shift;
     my $expect_fail;