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


line stmt bran cond sub pod time code
1             package Apache::Config::Preproc::locus;
2 7     7   50 use parent 'Apache::Config::Preproc::Expand';
  7         11  
  7         45  
3 7     7   350 use strict;
  7         11  
  7         128  
4 7     7   32 use warnings;
  7         12  
  7         154  
5 7     7   3569 use Text::Locus;
  7         35208  
  7         6362  
6              
7             our $VERSION = '1.03';
8              
9             sub new {
10 9     9 0 21 my $class = shift;
11 9         61 my $self = $class->SUPER::new(@_);
12 9         45 $self->{filename} = $self->conf->filename;
13 9         19 $self->{line} = 0;
14 9         23 $self->{context} = [];
15 9         50 return $self;
16             }
17              
18 136     136 0 413 sub filename { shift->{filename} }
19              
20             sub context_push {
21 2     2 0 7 my ($self,$file) = @_;
22 2         4 push @{$self->{context}}, [ $self->filename, $self->{line} ];
  2         5  
23 2         4 $self->{filename} = $file;
24 2         3 $self->{line} = 0;
25             }
26              
27             sub context_pop {
28 2     2 0 3 my $self = shift;
29 2 50       2 if (my $ctx = pop @{$self->{context}}) {
  2         6  
30 2         6 ($self->{filename}, $self->{line}) = @$ctx;
31             }
32             }
33              
34             sub expand {
35 215     215 1 313 my ($self, $d, $repl) = @_;
36              
37             # Prevent recursion
38 215 100       714 return 0 if $d->can('locus');
39              
40             # Handle context switches due to include statements.
41 102 100       215 if ($d->type eq 'directive') {
42 63 100       303 if ($d->name eq '$PUSH$') {
    100          
43 2 50       9 if ($d->value =~ /^\"(.+)\"/) {
44 2         19 $self->context_push($1);
45 2         6 return 0;
46             }
47             } elsif ($d->name eq '$POP$') {
48 2         14 $self->context_pop();
49 2         6 return 0;
50             }
51             }
52              
53             # Compute and attach a locus object.
54 98         557 $self->{line}++;
55 98         179 my $locus = new Text::Locus($self->filename, $self->{line});
56 98 100       2621 if ($d->type eq 'section') {
    100          
    100          
    50          
57 17         157 $self->lpush($locus);
58             } elsif ($d->type eq 'directive') {
59 59 50       461 if ((my $nl = ($d->{raw}) =~ tr/\n//) > 1) {
60 0         0 my $l = $self->{line}+1;
61 0         0 $self->{line} += $nl-1;
62 0         0 $locus->add($self->filename, ($l..$self->{line}));
63             }
64             } elsif ($d->type eq 'blank') {
65 10 100       100 if ($d->{length} > 1) {
66 1         2 my $l = $self->{line}+1;
67 1         2 $self->{line} += $d->{length}-1;
68 1         7 $locus->add($self->filename, ($l..$self->{line}));
69             }
70             } elsif ($d->type eq 'comment') {
71 12 100 50     237 if (my $nl = ($d->value//'') =~ tr/\n//) {
72 1         8 my $l = $self->{line}+1;
73 1         2 $self->{line} += $nl;
74 1         2 $locus->add($self->filename, ($l..$self->{line}));
75             }
76             }
77 98         328 push @$repl, Apache::Config::Preproc::locus::node->derive($d, $locus);
78 98         238 return 1;
79             }
80              
81             sub lpush {
82 17     17 0 40 my ($self,$locus) = @_;
83 17         21 push @{$self->{postprocess}}, $locus;
  17         41  
84             }
85              
86             sub lpop {
87 17     17 0 24 my ($self) = @_;
88 17         19 pop @{$self->{postprocess}}
  17         34  
89             }
90              
91             sub lcheck {
92 28     28 0 50 my ($self, $item) = @_;
93 28 100 100     113 if ($self->{postprocess} && @{$self->{postprocess}}) {
  26         138  
94 17         40 return ${$self->{postprocess}}[$#{$self->{postprocess}}]->format eq $item->locus->format;
  17         64  
  17         31  
95             }
96             }
97              
98             sub end_section {
99 28     28 1 54 my ($self, $d) = @_;
100 28 100       89 if ($self->lcheck($d)) {
101 17         200 $self->lpop;
102 17         41 $self->{line}++;
103 17 50       38 if (my @lines = $d->locus->filelines($self->filename)) {
104 17         234 $d->locus->add($self->filename, (pop(@lines)+1..$self->{line}));
105             }
106             }
107             }
108              
109             package Apache::Config::Preproc::locus::node;
110 7     7   74 use Apache::Admin::Config;
  7         15  
  7         1309  
111             our @ISA = qw(Apache::Admin::Config::Tree);
112              
113             sub derive {
114 98     98   174 my ($class, $orig, $locus) = @_;
115 98         219 my $self = bless $orig->clone;
116 98         6362 $self->{_locus} = $locus;
117 98         186 return $self;
118             }
119              
120 111     111   15024 sub locus { shift->{_locus} }
121              
122             sub clone {
123 1     1   3 my ($self) = @_;
124 1         6 my $clone = bless $self->SUPER::clone;
125 1         36 $clone->{_locus} = $clone->{_locus}->clone();
126 1         31 return $clone;
127             }
128              
129             1;
130             __END__