File Coverage

blib/lib/Config/Apachish/Base.pm
Criterion Covered Total %
statement 65 89 73.0
branch 21 38 55.2
condition 5 9 55.5
subroutine 11 12 91.6
pod 3 3 100.0
total 105 151 69.5


line stmt bran cond sub pod time code
1             package Config::Apachish::Base;
2              
3             our $DATE = '2015-12-11'; # DATE
4             our $VERSION = '0.01'; # VERSION
5              
6 1     1   579 use 5.010001;
  1         4  
7 1     1   5 use strict;
  1         2  
  1         19  
8 1     1   5 use warnings;
  1         1  
  1         995  
9             #use Carp; # avoided to shave a bit of startup time
10              
11             sub new {
12 1     1 1 38341 my ($class, %attrs) = @_;
13             #$attrs{process_include} //= 0;
14 1         6 bless \%attrs, $class;
15             }
16              
17             # borrowed from Parse::CommandLine. differences: returns arrayref. return undef
18             # on error (instead of dying).
19             sub _parse_command_line {
20 48     48   92 my ($self, $str) = @_;
21              
22 48         97 $str =~ s/\A\s+//ms;
23 48         93 $str =~ s/\s+\z//ms;
24              
25 48         61 my @argv;
26             my $buf;
27 0         0 my $escaped;
28 0         0 my $double_quoted;
29 0         0 my $single_quoted;
30              
31 48         223 for my $char (split //, $str) {
32 431 50       750 if ($escaped) {
33 0         0 $buf .= $char;
34 0         0 $escaped = undef;
35 0         0 next;
36             }
37              
38 431 50       821 if ($char eq '\\') {
39 0 0       0 if ($single_quoted) {
40 0         0 $buf .= $char;
41             }
42             else {
43 0         0 $escaped = 1;
44             }
45 0         0 next;
46             }
47              
48 431 100       966 if ($char =~ /\s/) {
49 36 100 66     134 if ($single_quoted || $double_quoted) {
50 13         17 $buf .= $char;
51             }
52             else {
53 23 50       62 push @argv, $buf if defined $buf;
54 23         32 undef $buf;
55             }
56 36         58 next;
57             }
58              
59 395 100       759 if ($char eq '"') {
60 30 50       64 if ($single_quoted) {
61 0         0 $buf .= $char;
62 0         0 next;
63             }
64 30         41 $double_quoted = !$double_quoted;
65 30         42 next;
66             }
67              
68 365 50       673 if ($char eq "'") {
69 0 0       0 if ($double_quoted) {
70 0         0 $buf .= $char;
71 0         0 next;
72             }
73 0         0 $single_quoted = !$single_quoted;
74 0         0 next;
75             }
76              
77 365         509 $buf .= $char;
78             }
79 48 50       181 push @argv, $buf if defined $buf;
80              
81 48 100 33     316 if ($escaped || $single_quoted || $double_quoted) {
      66        
82 2         9 return undef;
83             }
84              
85 46         152 \@argv;
86             }
87              
88             sub _err {
89 11     11   20 my ($self, $msg) = @_;
90             die join(
91             "",
92 11 50       15 @{ $self->{_include_stack} } ? "$self->{_include_stack}[0] " : "",
  11         251  
93             "line $self->{_linum}: ",
94             $msg
95             );
96             }
97              
98             sub _push_include_stack {
99 17     17   121 require Cwd;
100              
101 17         34 my ($self, $path) = @_;
102              
103             # included file's path is based on the main (topmost) file
104 17 50       26 if (@{ $self->{_include_stack} }) {
  17         73  
105 0         0 require File::Spec;
106             my ($vol, $dir, $file) =
107 0         0 File::Spec->splitpath($self->{_include_stack}[-1]);
108 0         0 $path = File::Spec->rel2abs($path, File::Spec->catpath($vol, $dir));
109             }
110              
111 17 50       1171 my $abs_path = Cwd::abs_path($path) or return [400, "Invalid path name"];
112             return [409, "Recursive", $abs_path]
113 17 50       26 if grep { $_ eq $abs_path } @{ $self->{_include_stack} };
  0         0  
  17         76  
114 17         24 push @{ $self->{_include_stack} }, $abs_path;
  17         40  
115 17         57 return [200, "OK", $abs_path];
116             }
117              
118             sub _pop_include_stack {
119 6     6   10 my $self = shift;
120              
121             die "BUG: Overpopped _pop_include_stack"
122 6 50       8 unless @{$self->{_include_stack}};
  6         20  
123 6         8 pop @{ $self->{_include_stack} };
  6         17  
124             }
125              
126             sub _init_read {
127 17     17   27 my $self = shift;
128              
129 17         58 $self->{_include_stack} = [];
130             }
131              
132             sub _read_file {
133 23     23   66 my ($self, $filename) = @_;
134 23 50       921 open my $fh, "<", $filename
135             or die "Can't open file '$filename': $!";
136 23         150 binmode($fh, ":utf8");
137 23         81 local $/;
138 23         1294 return ~~<$fh>;
139             }
140              
141             sub read_file {
142 17     17 1 57922 my ($self, $filename) = @_;
143 17         70 $self->_init_read;
144 17         102 my $res = $self->_push_include_stack($filename);
145 17 50       52 die "Can't read '$filename': $res->[1]" unless $res->[0] == 200;
146 17         52 $res =
147             $self->_read_string($self->_read_file($filename));
148 6         31 $self->_pop_include_stack;
149 6         17 $res;
150             }
151              
152             sub read_string {
153 0     0 1   my ($self, $str) = @_;
154 0           $self->_init_read;
155 0           $self->_read_string($str);
156             }
157              
158             1;
159             # ABSTRACT: Base class for Config::Apachish and Config::Apachish::Reader
160              
161             __END__