Implement macro expansion

* lib/Apache/Config/Preproc/macro.pm: New file.
* t/macro01.t: New file.
* t/macro02.t: New file.

1 files changed, 89 insertions, 0 deletions

diff --git a/lib/Apache/Config/Preproc/macro.pm b/lib/Apache/Config/Preproc/macro.pm
new file mode 100644
index 0000000..9c7a9df
--- /dev/null
+++ b/lib/Apache/Config/Preproc/macro.pm
@@ -0,0 +1,89 @@
+package Apache::Config::Preproc::macro;
+use strict;
+use warnings;
+use Text::ParseWords;
+
+sub new {
+    bless {}, shift
+}
+
+sub macro {
+    my ($self, $name) = @_;
+    return $self->{macro}{$name};
+}
+
+sub install_macro {
+    my ($self, $defn) = @_;
+    $self->{macro}{$defn->name} = $defn;
+}
+
+sub expand {
+    my ($self, $tree, $d, $repl) = @_;
+    if ($d->type eq 'section' && lc($d->name) eq 'macro') {
+	$self->install_macro(Apache::Config::Preproc::macro::defn->new($d));
+	return 1;
+    } 
+    if ($d->type eq 'directive' && lc($d->name) eq 'use') {
+	my ($name,@args) = parse_line(qr/\s+/, 0, $d->value);
+	if (my $defn = $self->macro($name)) {
+	    push @$repl, $defn->expand(@args);
+	    return 1;
+	}
+    }
+    return 0;
+}
+
+package Apache::Config::Preproc::macro::defn;
+use strict;
+use warnings;
+use Text::ParseWords;
+
+sub new {
+    my $class = shift;
+    my $d = shift;
+    my ($name, @params) = parse_line(qr/\s+/, 0, $d->value);
+    bless {
+	name => $name,
+	params => [ @params ],
+	code => [$d->select]
+    }, $class;
+}
+
+sub name { shift->{name} }
+sub params { @{shift->{params}} }
+sub code { @{shift->{code}} }
+
+sub expand {
+    my ($self, @args) = @_;
+    
+    my @rxlist = map {
+	my $r = shift @args // '';
+	my $q = quotemeta($_);
+	[ qr($q), $r ]
+    } $self->params;
+    map { $self->_node_expand($_->clone, @rxlist) } $self->code;
+}
+
+sub _node_expand {
+    my ($self, $d, @rxlist) = @_;
+
+    if ($d->type eq 'directive') {
+	$d->value($self->_repl($d->value, @rxlist));
+    } elsif ($d->type eq 'section') {
+	$d->value($self->_repl($d->value, @rxlist));
+	foreach my $st ($d->select) {
+	    $self->_node_expand($st, @rxlist);
+	}
+    }
+    return $d;
+}
+
+sub _repl {
+    my ($self, $v, @rxlist) = @_;
+    foreach my $rx (@rxlist) {
+	$v =~ s{$rx->[0]}{$rx->[1]}g;
+    }
+    return $v
+}
+
+1;