view release on metacpan or  search on metacpan

lib/Apache/Config/Preproc/macro.pm  view on Meta::CPAN

package Apache::Config::Preproc::macro;
use parent 'Apache::Config::Preproc::Expand';
use strict;
use warnings;
use Text::ParseWords;
use Carp;

our $VERSION = '1.03';

sub new {
    my $class = shift;
    my $conf = shift;
    my $self = $class->SUPER::new($conf);
    $self->{keep} = {};
    croak "bad number of arguments: @_" if @_ % 2;
    local %_ = @_;
    my $v;
    if ($v = delete $_{keep}) {
	if (ref($v)) {
	    croak "keep argument must be a scalar or listref"
		unless ref($v) eq 'ARRAY';
	} else {
	    $v = [$v];
	}
	@{$self->{keep}}{@$v} = @$v;
    }
    croak "unrecognized arguments" if keys(%_);
    return $self;
}

sub macro {
    my ($self, $name) = @_;
    return $self->{macro}{$name};
}

sub install_macro {
    my ($self, $defn) = @_;
    return 0 if $self->{keep}{$defn->name};
    $self->{macro}{$defn->name} = $defn;
    return 1;
}

sub expand {
    my ($self, $d, $repl) = @_;
    if ($d->type eq 'section' && lc($d->name) eq 'macro') {
	return $self->install_macro(Apache::Config::Preproc::macro::defn->new($d));
    } 
    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;
}