File Coverage

lib/Apache/Config/Preproc/locus.pm

Criterion	Covered	Total	%
statement	82	85	96.4
branch	27	32	84.3
condition	4	5	80.0
subroutine	17	17	100.0
pod	2	9	22.2
total	132	148	89.1

package Apache::Config::Preproc::locus;
use parent 'Apache::Config::Preproc::Expand';
use strict;
use warnings;
use Text::Locus;

our $VERSION = '1.03';

sub new {
    my $class = shift;
    my $self = bless $class->SUPER::new(@_), $class;
    $self->{filename} = $self->conf->filename;
    $self->{line} = 0;
    $self->{context} = [];
    return $self;
}

sub filename { shift->{filename} }

sub context_push {
    my ($self,$file) = @_;
    push @{$self->{context}}, [ $self->filename, $self->{line} ];
    $self->{filename} = $file;
    $self->{line} = 0;
}

sub context_pop {
    my $self = shift;
    if (my $ctx = pop @{$self->{context}}) {
	($self->{filename}, $self->{line}) = @$ctx;
    }
}

sub expand {
    my ($self, $d, $repl) = @_;

    # Prevent recursion
    return 0 if $d->can('locus');

    # Handle context switches due to include statements.
    if ($d->type eq 'directive') {
	if ($d->name eq '$PUSH$') {
	    if ($d->value =~ /^\"(.+)\"/) {
		$self->context_push($1);
		return 0;
	    }
	} elsif ($d->name eq '$POP$') {
	    $self->context_pop();
	    return 0;
	}
    }

    # Compute and attach a locus object.
    $self->{line}++;
    my $locus = new Text::Locus($self->filename, $self->{line});
    if ($d->type eq 'section') {
	$self->lpush($locus);
    } elsif ($d->type eq 'directive') {
	if ((my $nl = ($d->{raw}) =~ tr/\n//) > 1) {
	    my $l = $self->{line}+1;
	    $self->{line} += $nl-1;
	    $locus->add($self->filename, ($l..$self->{line}));
	}
    } elsif ($d->type eq 'blank') {
        if ($d->{length} > 1) {
	    my $l = $self->{line}+1;
	    $self->{line} += $d->{length}-1;
	    $locus->add($self->filename, ($l..$self->{line}));
	}
    } elsif ($d->type eq 'comment') {
	if (my $nl = ($d->value//'') =~ tr/\n//) {
	    my $l = $self->{line}+1;
	    $self->{line} += $nl;
	    $locus->add($self->filename, ($l..$self->{line}));
	}
    }
    push @$repl, Apache::Config::Preproc::locus::node->derive($d, $locus);
    return 1;
}

sub lpush {
    my ($self,$locus) = @_;
    push @{$self->{postprocess}}, $locus;
}

sub lpop {
    my ($self) = @_;
    pop @{$self->{postprocess}}
}

sub lcheck {
    my ($self, $item) = @_;
    if ($self->{postprocess} && @{$self->{postprocess}}) {
	return ${$self->{postprocess}}[$#{$self->{postprocess}}]->format eq $item->locus->format;
    }
}

sub end_section {
    my ($self, $d) = @_;
    if ($self->lcheck($d)) {
	$self->lpop;
	$self->{line}++;
	if (my @lines = $d->locus->filelines($self->filename)) {
	    $d->locus->add($self->filename, (pop(@lines)+1..$self->{line}));
	}
    }
}

package Apache::Config::Preproc::locus::node;
use Apache::Admin::Config;
our @ISA = qw(Apache::Admin::Config::Tree);

sub derive {
    my ($class, $orig, $locus) = @_;
    my $self = bless $orig->clone;
    $self->{_locus} = $locus;
    return $self;
}

sub locus { shift->{_locus} }

sub clone {
    my ($self) = @_;
    my $clone = bless $self->SUPER::clone;
    $clone->{_locus} = $clone->{_locus}->clone();
    return $clone;
}

1;
__END__