diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-12-07 12:13:04 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-12-07 12:13:04 +0200 |
commit | ef681e30b137c2a43aab1bd48201da7e7646b692 (patch) | |
tree | 7d94553269494ab2f051427d5ff9a561d0bdf53b /lib/Apache/Config/Preproc/macro.pm | |
parent | 7a06349587e2fe0cb1b5c74185d2f507173409c4 (diff) | |
download | acpp-ef681e30b137c2a43aab1bd48201da7e7646b692.tar.gz acpp-ef681e30b137c2a43aab1bd48201da7e7646b692.tar.bz2 |
Implement macro expansion
* lib/Apache/Config/Preproc/macro.pm: New file.
* t/macro01.t: New file.
* t/macro02.t: New file.
Diffstat (limited to 'lib/Apache/Config/Preproc/macro.pm')
-rw-r--r-- | lib/Apache/Config/Preproc/macro.pm | 89 |
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; |