line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package dotconfig; |
2
|
14
|
|
|
14
|
|
38220
|
use strict; |
|
14
|
|
|
|
|
29
|
|
|
14
|
|
|
|
|
395
|
|
3
|
14
|
|
|
14
|
|
67
|
use warnings; |
|
14
|
|
|
|
|
23
|
|
|
14
|
|
|
|
|
298
|
|
4
|
14
|
|
|
14
|
|
64
|
use Carp (); |
|
14
|
|
|
|
|
28
|
|
|
14
|
|
|
|
|
184
|
|
5
|
14
|
|
|
14
|
|
12118
|
use Encode (); |
|
14
|
|
|
|
|
164056
|
|
|
14
|
|
|
|
|
352
|
|
6
|
14
|
|
|
14
|
|
101
|
use Exporter 'import'; |
|
14
|
|
|
|
|
30
|
|
|
14
|
|
|
|
|
4061
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
8
|
|
|
|
|
|
|
our @EXPORT = qw( load_config decode_config ); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub load_config { |
11
|
0
|
|
|
0
|
|
|
my ($path, $option) = @_; |
12
|
0
|
0
|
|
|
|
|
open my $fh, "<", $path or Carp::croak $!; |
13
|
0
|
|
|
|
|
|
my $text = Encode::decode_utf8(do { local $/; <$fh> }); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
14
|
0
|
|
|
|
|
|
decode_config($text, $option); |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new { |
18
|
0
|
|
|
0
|
|
|
my ($class, %option) = @_; |
19
|
0
|
|
|
|
|
|
bless { |
20
|
|
|
|
|
|
|
option => { %option }, |
21
|
|
|
|
|
|
|
}, $class; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub decode { |
25
|
0
|
|
|
0
|
|
|
my ($self, $text) = @_; |
26
|
0
|
|
|
|
|
|
decode_config($text, $self->{option}); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub decode_config { |
30
|
0
|
|
|
0
|
|
|
my ($text, $option) = @_; |
31
|
0
|
|
|
|
|
|
my $decoder = dotconfig::Decoder->new($text, $option); |
32
|
0
|
0
|
|
|
|
|
if (my $config = $decoder->config) { |
33
|
0
|
|
|
|
|
|
return $$config; |
34
|
|
|
|
|
|
|
} else { |
35
|
0
|
|
|
|
|
|
die "No value found in the config"; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# sub encode { |
40
|
|
|
|
|
|
|
# my ($self, $value) = @_; |
41
|
|
|
|
|
|
|
# } |
42
|
|
|
|
|
|
|
# |
43
|
|
|
|
|
|
|
# sub encode_config { |
44
|
|
|
|
|
|
|
# } |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
package |
47
|
|
|
|
|
|
|
dotconfig::Decoder; |
48
|
14
|
|
|
14
|
|
77
|
use strict; |
|
14
|
|
|
|
|
25
|
|
|
14
|
|
|
|
|
432
|
|
49
|
14
|
|
|
14
|
|
69
|
use warnings; |
|
14
|
|
|
|
|
36
|
|
|
14
|
|
|
|
|
428
|
|
50
|
14
|
|
|
14
|
|
23038
|
use Math::BigInt; |
|
14
|
|
|
|
|
379373
|
|
|
14
|
|
|
|
|
68
|
|
51
|
14
|
|
|
14
|
|
1014764
|
use Math::BigFloat; |
|
14
|
|
|
|
|
317654
|
|
|
14
|
|
|
|
|
85
|
|
52
|
14
|
|
|
14
|
|
32750
|
use JSON (); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
use constant { |
54
|
|
|
|
|
|
|
DC_SPACE => ' ', |
55
|
|
|
|
|
|
|
DC_TAB => "\t", |
56
|
|
|
|
|
|
|
DC_LF => "\n", |
57
|
|
|
|
|
|
|
DC_CR => "\r", |
58
|
|
|
|
|
|
|
DC_FALSE => 'false', |
59
|
|
|
|
|
|
|
DC_TRUE => 'true', |
60
|
|
|
|
|
|
|
DC_NULL => 'null', |
61
|
|
|
|
|
|
|
DC_BEGIN_ARRAY => '[', |
62
|
|
|
|
|
|
|
DC_END_ARRAY => ']', |
63
|
|
|
|
|
|
|
DC_BEGIN_MAP => '{', |
64
|
|
|
|
|
|
|
DC_END_MAP => '}', |
65
|
|
|
|
|
|
|
DC_NAME_SEPARATOR => ':', |
66
|
|
|
|
|
|
|
DC_VALUE_SEPARATOR => ',', |
67
|
|
|
|
|
|
|
DC_QUOTATION_MARK => '"', |
68
|
|
|
|
|
|
|
DC_ESCAPE => '\\', |
69
|
|
|
|
|
|
|
DC_SOLIDUS => '/', |
70
|
|
|
|
|
|
|
DC_BACKSPACE => "\b", |
71
|
|
|
|
|
|
|
DC_FORM_FEED => "\f", |
72
|
|
|
|
|
|
|
}; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub new { |
75
|
|
|
|
|
|
|
my ($class, $text, $option) = @_; |
76
|
|
|
|
|
|
|
bless { |
77
|
|
|
|
|
|
|
tape => $text, |
78
|
|
|
|
|
|
|
index => 0, |
79
|
|
|
|
|
|
|
option => { |
80
|
|
|
|
|
|
|
allow_bigint => 1, |
81
|
|
|
|
|
|
|
%{$option // {}}, |
82
|
|
|
|
|
|
|
}, |
83
|
|
|
|
|
|
|
}, $class; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub _peek { |
87
|
|
|
|
|
|
|
my ($self, $next) = @_; |
88
|
|
|
|
|
|
|
my $eos_pos = $self->{index} + ($next // 0) + 1; |
89
|
|
|
|
|
|
|
if (length $self->{tape} >= $eos_pos) { |
90
|
|
|
|
|
|
|
return substr $self->{tape}, $self->{index} + $next // 0, 1; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub _match_str { |
95
|
|
|
|
|
|
|
my ($self, $str) = @_; |
96
|
|
|
|
|
|
|
my $next = substr $self->{tape}, $self->{index}, length $str; |
97
|
|
|
|
|
|
|
if (length $next == length $str and $str eq $next) { |
98
|
|
|
|
|
|
|
return 1; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub _consume { |
103
|
|
|
|
|
|
|
my ($self, $length) = @_; |
104
|
|
|
|
|
|
|
$self->{index} += $length // 1; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub _consume_if { |
108
|
|
|
|
|
|
|
my ($self, $expected) = @_; |
109
|
|
|
|
|
|
|
if ($self->_match_str($expected)) { |
110
|
|
|
|
|
|
|
$self->{index} += length $expected; |
111
|
|
|
|
|
|
|
return 1; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _consume_if_space { |
116
|
|
|
|
|
|
|
my ($self, $char) = @_; |
117
|
|
|
|
|
|
|
if ( $char eq DC_SPACE |
118
|
|
|
|
|
|
|
or $char eq DC_TAB |
119
|
|
|
|
|
|
|
or $char eq DC_LF |
120
|
|
|
|
|
|
|
or $char eq DC_CR |
121
|
|
|
|
|
|
|
) { |
122
|
|
|
|
|
|
|
$self->{index} += 1; |
123
|
|
|
|
|
|
|
return 1; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub config { |
128
|
|
|
|
|
|
|
my ($self, $config) = @_; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
while (1) { |
131
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
132
|
|
|
|
|
|
|
next if $self->_consume_if_space($char); |
133
|
|
|
|
|
|
|
if ($char eq DC_BEGIN_MAP) { |
134
|
|
|
|
|
|
|
return $self->config(\$self->map); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
elsif ($char eq DC_BEGIN_ARRAY) { |
137
|
|
|
|
|
|
|
return $self->config(\$self->array); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
elsif ($char eq DC_QUOTATION_MARK) { |
140
|
|
|
|
|
|
|
return $self->config(\$self->string); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
elsif ($char eq "<" and $self->_match_str("<<")) { |
143
|
|
|
|
|
|
|
return $self->config(\$self->heredoc); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
elsif ($char =~ /[0-9\-]/) { |
146
|
|
|
|
|
|
|
if ($self->_match_str("0x")) { |
147
|
|
|
|
|
|
|
return $self->config(\$self->hex); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
elsif ($self->_match_str("0b")) { |
150
|
|
|
|
|
|
|
return $self->config(\$self->binary); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
elsif ($self->_match_str("0o")) { |
153
|
|
|
|
|
|
|
return $self->config(\$self->octal); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
else { |
156
|
|
|
|
|
|
|
return $self->config(\$self->number); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
elsif (my $false = $self->false) { |
160
|
|
|
|
|
|
|
return $self->config($false); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
elsif (my $true = $self->true) { |
163
|
|
|
|
|
|
|
return $self->config($true); |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
elsif (my $null = $self->null) { |
166
|
|
|
|
|
|
|
return $self->config($null); |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
elsif ($char eq DC_SOLIDUS) { |
169
|
|
|
|
|
|
|
if ($self->_match_str("//") or $self->_match_str("/*")) { |
170
|
|
|
|
|
|
|
$self->comment; |
171
|
|
|
|
|
|
|
next; |
172
|
|
|
|
|
|
|
} else { |
173
|
|
|
|
|
|
|
die "Unexpected charcter `/`"; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
else { |
177
|
|
|
|
|
|
|
return $config; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
} else { |
180
|
|
|
|
|
|
|
last; # EOF |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
return $config; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub false { shift->_consume_if(DC_FALSE) ? \JSON::false : undef } |
188
|
|
|
|
|
|
|
sub true { shift->_consume_if(DC_TRUE) ? \JSON::true : undef } |
189
|
|
|
|
|
|
|
sub null { shift->_consume_if(DC_NULL) ? \JSON::null : undef } |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub number { |
192
|
|
|
|
|
|
|
my $self = shift; |
193
|
|
|
|
|
|
|
my $string = ""; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# minus |
196
|
|
|
|
|
|
|
if ($self->_consume_if("-")) { |
197
|
|
|
|
|
|
|
$string .= "-"; |
198
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
199
|
|
|
|
|
|
|
unless ($char =~ /[0-9]/) { |
200
|
|
|
|
|
|
|
die "Unexpected number format (found `$char` after `-`)"; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
} else { |
203
|
|
|
|
|
|
|
die "Unexpected number format (no number after `-`)"; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# int |
208
|
|
|
|
|
|
|
if ($self->_consume_if("0")) { |
209
|
|
|
|
|
|
|
$string .= "0"; |
210
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
211
|
|
|
|
|
|
|
if ($char =~ /[0-9]/) { |
212
|
|
|
|
|
|
|
die "Unexpected number format (found `$char` after `0`)"; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
} else { |
215
|
|
|
|
|
|
|
return $string + 0; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
while (1) { |
220
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
221
|
|
|
|
|
|
|
if ($char =~ /[0-9.]/) { # `.` for frac |
222
|
|
|
|
|
|
|
$string .= $char; |
223
|
|
|
|
|
|
|
$self->_consume; |
224
|
|
|
|
|
|
|
next; |
225
|
|
|
|
|
|
|
} else { |
226
|
|
|
|
|
|
|
last; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} else { |
229
|
|
|
|
|
|
|
last; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# exp |
234
|
|
|
|
|
|
|
if ($self->_consume_if("e") or $self->_consume_if("E")) { |
235
|
|
|
|
|
|
|
$string .= "e"; |
236
|
|
|
|
|
|
|
if ($self->_consume_if("+")) { |
237
|
|
|
|
|
|
|
$string .= "+"; |
238
|
|
|
|
|
|
|
} elsif ($self->_consume_if("-")) { |
239
|
|
|
|
|
|
|
$string .= "-"; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
my $digit_after_exp; |
243
|
|
|
|
|
|
|
while (1) { |
244
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
245
|
|
|
|
|
|
|
if ($char =~ /[1-9]/) { |
246
|
|
|
|
|
|
|
$string .= $char; |
247
|
|
|
|
|
|
|
$self->_consume; |
248
|
|
|
|
|
|
|
$digit_after_exp = 1; |
249
|
|
|
|
|
|
|
} else { |
250
|
|
|
|
|
|
|
last; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
} else { |
253
|
|
|
|
|
|
|
last; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
unless ($digit_after_exp) { |
258
|
|
|
|
|
|
|
die "Unexpected number format (no digit after exp)"; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
if ($string =~ /[.eE]/) { # is float |
263
|
|
|
|
|
|
|
return $self->{option}{allow_bigint} ? Math::BigFloat->new($string) : $string; |
264
|
|
|
|
|
|
|
} else { # is integer |
265
|
|
|
|
|
|
|
if (($string + 0) =~ /[.eE]/) { |
266
|
|
|
|
|
|
|
return $self->{option}{allow_bigint} ? Math::BigInt->new($string) : $string; |
267
|
|
|
|
|
|
|
} else { |
268
|
|
|
|
|
|
|
return $string + 0; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub hex { |
274
|
|
|
|
|
|
|
my $self = shift; |
275
|
|
|
|
|
|
|
my $prefix = "0x"; |
276
|
|
|
|
|
|
|
$self->_consume_if($prefix) |
277
|
|
|
|
|
|
|
or die "Expected `$prefix`"; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
my $string = ""; |
280
|
|
|
|
|
|
|
while (1) { |
281
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
282
|
|
|
|
|
|
|
if ($char =~ /[A-F0-9]/i) { |
283
|
|
|
|
|
|
|
$string .= $char; |
284
|
|
|
|
|
|
|
$self->_consume; |
285
|
|
|
|
|
|
|
next; |
286
|
|
|
|
|
|
|
} else { |
287
|
|
|
|
|
|
|
return oct "$prefix$string"; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
} else { |
290
|
|
|
|
|
|
|
return oct "$prefix$string"; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub binary { |
296
|
|
|
|
|
|
|
my $self = shift; |
297
|
|
|
|
|
|
|
my $prefix = "0b"; |
298
|
|
|
|
|
|
|
$self->_consume_if($prefix) |
299
|
|
|
|
|
|
|
or die "Expected `$prefix`"; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
my $string = ""; |
302
|
|
|
|
|
|
|
while (1) { |
303
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
304
|
|
|
|
|
|
|
if ($char =~ /[01]/i) { |
305
|
|
|
|
|
|
|
$string .= $char; |
306
|
|
|
|
|
|
|
$self->_consume; |
307
|
|
|
|
|
|
|
next; |
308
|
|
|
|
|
|
|
} else { |
309
|
|
|
|
|
|
|
return oct "$prefix$string"; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
} else { |
312
|
|
|
|
|
|
|
return oct "$prefix$string"; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub octal { |
318
|
|
|
|
|
|
|
my $self = shift; |
319
|
|
|
|
|
|
|
my $prefix = "0o"; |
320
|
|
|
|
|
|
|
$self->_consume_if($prefix) |
321
|
|
|
|
|
|
|
or die "Expected `$prefix`"; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
my $string = ""; |
324
|
|
|
|
|
|
|
while (1) { |
325
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
326
|
|
|
|
|
|
|
if ($char =~ /[0-7]/i) { |
327
|
|
|
|
|
|
|
$string .= $char; |
328
|
|
|
|
|
|
|
$self->_consume; |
329
|
|
|
|
|
|
|
next; |
330
|
|
|
|
|
|
|
} else { |
331
|
|
|
|
|
|
|
return oct "0$string"; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
} else { |
334
|
|
|
|
|
|
|
return oct "0$string"; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
sub comment { |
340
|
|
|
|
|
|
|
my $self = shift; |
341
|
|
|
|
|
|
|
if ($self->_match_str("//")) { |
342
|
|
|
|
|
|
|
$self->inline_comment; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
elsif ($self->_match_str("/*")) { |
345
|
|
|
|
|
|
|
$self->block_comment; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
else { |
348
|
|
|
|
|
|
|
die "Unexpected charcter `/`"; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub inline_comment { |
353
|
|
|
|
|
|
|
my $self = shift; |
354
|
|
|
|
|
|
|
$self->_consume_if(DC_SOLIDUS . DC_SOLIDUS) |
355
|
|
|
|
|
|
|
or die "Expected `" . DC_SOLIDUS . DC_SOLIDUS . "`"; |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
while (1) { |
358
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
359
|
|
|
|
|
|
|
$self->_consume; |
360
|
|
|
|
|
|
|
if ($char eq DC_LF) { |
361
|
|
|
|
|
|
|
return; |
362
|
|
|
|
|
|
|
} else { |
363
|
|
|
|
|
|
|
next; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} else { |
366
|
|
|
|
|
|
|
$self->_consume; |
367
|
|
|
|
|
|
|
return; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub block_comment { |
373
|
|
|
|
|
|
|
my $self = shift; |
374
|
|
|
|
|
|
|
$self->_consume_if("/*") |
375
|
|
|
|
|
|
|
or die "Expected `/*`"; |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
while (1) { |
378
|
|
|
|
|
|
|
if ($self->_match_str("//")) { |
379
|
|
|
|
|
|
|
$self->inline_comment; |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
elsif ($self->_match_str("/*")) { |
382
|
|
|
|
|
|
|
$self->block_comment; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
elsif ($self->_match_str("*/")) { |
385
|
|
|
|
|
|
|
$self->_consume(2); |
386
|
|
|
|
|
|
|
return; |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
else { |
389
|
|
|
|
|
|
|
$self->_consume; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub string { |
396
|
|
|
|
|
|
|
my $self = shift; |
397
|
|
|
|
|
|
|
$self->_consume_if(DC_QUOTATION_MARK) |
398
|
|
|
|
|
|
|
or die "Expected `" . DC_QUOTATION_MARK . "`"; |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
my $string = ""; |
401
|
|
|
|
|
|
|
while (1) { |
402
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
403
|
|
|
|
|
|
|
if ($char eq DC_ESCAPE) { |
404
|
|
|
|
|
|
|
if (defined(my $next_char = $self->_peek(1))) { |
405
|
|
|
|
|
|
|
my $escapes = { |
406
|
|
|
|
|
|
|
DC_QUOTATION_MARK() => DC_QUOTATION_MARK, |
407
|
|
|
|
|
|
|
DC_ESCAPE() => DC_ESCAPE, |
408
|
|
|
|
|
|
|
DC_SOLIDUS() => DC_SOLIDUS, |
409
|
|
|
|
|
|
|
"b" => DC_BACKSPACE, |
410
|
|
|
|
|
|
|
"f" => DC_FORM_FEED, |
411
|
|
|
|
|
|
|
"n" => DC_LF, |
412
|
|
|
|
|
|
|
"r" => DC_CR, |
413
|
|
|
|
|
|
|
"t" => DC_TAB, |
414
|
|
|
|
|
|
|
}; |
415
|
|
|
|
|
|
|
if (my $ch = $escapes->{$next_char}) { |
416
|
|
|
|
|
|
|
$string .= $ch; |
417
|
|
|
|
|
|
|
$self->_consume(2); |
418
|
|
|
|
|
|
|
next; |
419
|
|
|
|
|
|
|
} elsif ($next_char eq 'u') { # TODO UTF-16 support? |
420
|
|
|
|
|
|
|
my $utf = ""; |
421
|
|
|
|
|
|
|
for (1..4) { |
422
|
|
|
|
|
|
|
my $char = $self->_peek(1 + $_); |
423
|
|
|
|
|
|
|
if (defined $char && $char =~ /[A-F0-9]/i) { |
424
|
|
|
|
|
|
|
$utf .= $char; |
425
|
|
|
|
|
|
|
} else { |
426
|
|
|
|
|
|
|
die "Unexpected end of escaped UTF string"; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
$self->_consume(6); |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
if ((my $hex = CORE::hex $utf) > 127) { |
432
|
|
|
|
|
|
|
$string .= pack U => $hex; |
433
|
|
|
|
|
|
|
} else { |
434
|
|
|
|
|
|
|
$string .= chr $hex; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
} else { |
437
|
|
|
|
|
|
|
die "Unexpected escape sequence"; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
} else { |
440
|
|
|
|
|
|
|
die "Unexpected end of string literal"; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
} elsif ($char eq DC_QUOTATION_MARK) { |
444
|
|
|
|
|
|
|
if ($self->_peek(-1) eq DC_ESCAPE) { |
445
|
|
|
|
|
|
|
$string .= $char; |
446
|
|
|
|
|
|
|
$self->_consume; |
447
|
|
|
|
|
|
|
next; |
448
|
|
|
|
|
|
|
} else { |
449
|
|
|
|
|
|
|
$self->_consume; |
450
|
|
|
|
|
|
|
return $string; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
} else { |
453
|
|
|
|
|
|
|
$string .= $char; |
454
|
|
|
|
|
|
|
$self->_consume; |
455
|
|
|
|
|
|
|
next; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
} else { |
458
|
|
|
|
|
|
|
die "Unterminated string"; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
sub heredoc { |
464
|
|
|
|
|
|
|
my $self = shift; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
$self->_consume_if("<<") |
467
|
|
|
|
|
|
|
or die "Expected `<<`"; |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
my $strip_space = $self->_consume_if("-") ? 1 : 0; |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
my $delimiter = ""; |
472
|
|
|
|
|
|
|
while (1) { |
473
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
474
|
|
|
|
|
|
|
$self->_consume; |
475
|
|
|
|
|
|
|
if ($char eq DC_SPACE or $char eq DC_TAB) { |
476
|
|
|
|
|
|
|
next; |
477
|
|
|
|
|
|
|
} elsif ($char eq DC_LF) { |
478
|
|
|
|
|
|
|
last; |
479
|
|
|
|
|
|
|
} else { |
480
|
|
|
|
|
|
|
$delimiter .= $char; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
} else { |
483
|
|
|
|
|
|
|
die "Unexpected end of heredoc"; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
my $string = ""; |
488
|
|
|
|
|
|
|
while (1) { |
489
|
|
|
|
|
|
|
last if $self->_consume_if($delimiter); |
490
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
491
|
|
|
|
|
|
|
$self->_consume; |
492
|
|
|
|
|
|
|
$string .= $char; |
493
|
|
|
|
|
|
|
next; |
494
|
|
|
|
|
|
|
} else { |
495
|
|
|
|
|
|
|
die "Unexpected end of heredoc"; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
chomp $string; |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
if ($strip_space) { |
501
|
|
|
|
|
|
|
my @lines = split /\n/, $string; |
502
|
|
|
|
|
|
|
my $last_line = pop @lines; |
503
|
|
|
|
|
|
|
my $indent = 0; |
504
|
|
|
|
|
|
|
for (split //, $last_line) { |
505
|
|
|
|
|
|
|
$indent++ if $_ eq DC_SPACE |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
$string = join DC_LF, map { substr $_, $indent } @lines; |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
return $string; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
sub array { |
515
|
|
|
|
|
|
|
my $self = shift; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
$self->_consume_if(DC_BEGIN_ARRAY) |
518
|
|
|
|
|
|
|
or die "Expected `" . DC_BEGIN_ARRAY . "`"; |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
my $array = []; |
521
|
|
|
|
|
|
|
while (1) { |
522
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
523
|
|
|
|
|
|
|
if ($self->_consume_if(DC_END_ARRAY)) { |
524
|
|
|
|
|
|
|
return $array; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
elsif ($self->_consume_if(DC_VALUE_SEPARATOR)) { |
527
|
|
|
|
|
|
|
next; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
else { |
530
|
|
|
|
|
|
|
if (defined(my $value = $self->config)) { |
531
|
|
|
|
|
|
|
push @$array, $$value; |
532
|
|
|
|
|
|
|
} else { |
533
|
|
|
|
|
|
|
next; # trailing comma is valid |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
} else { |
537
|
|
|
|
|
|
|
return $array; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
sub map { |
543
|
|
|
|
|
|
|
my $self = shift; |
544
|
|
|
|
|
|
|
$self->_consume_if(DC_BEGIN_MAP) |
545
|
|
|
|
|
|
|
or die "Expected `" . DC_BEGIN_MAP . "`"; |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
my $map = []; |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
while (1) { |
550
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
551
|
|
|
|
|
|
|
next if $self->_consume_if_space($char); |
552
|
|
|
|
|
|
|
if ($self->_match_str("//") or $self->_match_str("/*")) { |
553
|
|
|
|
|
|
|
$self->comment; |
554
|
|
|
|
|
|
|
next; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
elsif ($self->_consume_if(DC_END_MAP)) { |
557
|
|
|
|
|
|
|
last; |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
else { |
560
|
|
|
|
|
|
|
$self->map_members($map); |
561
|
|
|
|
|
|
|
last; |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
} else { |
564
|
|
|
|
|
|
|
last; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
return { @$map }; |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
sub map_members { |
572
|
|
|
|
|
|
|
use constant { map { ($_ => $_) } qw/ |
573
|
|
|
|
|
|
|
STATE_KEY |
574
|
|
|
|
|
|
|
STATE_KEY_SEPARATOR |
575
|
|
|
|
|
|
|
STATE_VALUE |
576
|
|
|
|
|
|
|
STATE_VALUE_SEPARATOR |
577
|
|
|
|
|
|
|
/ }; |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
my $self = shift; |
580
|
|
|
|
|
|
|
my $members = shift; |
581
|
|
|
|
|
|
|
my $state = shift // STATE_KEY; |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
while (1) { |
584
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
585
|
|
|
|
|
|
|
next if $self->_consume_if_space($char); |
586
|
|
|
|
|
|
|
if ($self->_match_str("//") or $self->_match_str("/*")) { |
587
|
|
|
|
|
|
|
$self->comment; |
588
|
|
|
|
|
|
|
next; |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
elsif ($self->_consume_if(DC_END_MAP)) { |
591
|
|
|
|
|
|
|
return; |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
else { |
594
|
|
|
|
|
|
|
if ($state eq STATE_KEY) { |
595
|
|
|
|
|
|
|
if (defined(my $key = $self->map_key)) { |
596
|
|
|
|
|
|
|
push @$members, $key; |
597
|
|
|
|
|
|
|
$self->map_members($members, STATE_KEY_SEPARATOR); |
598
|
|
|
|
|
|
|
return; |
599
|
|
|
|
|
|
|
} else { |
600
|
|
|
|
|
|
|
die "Unexpected member key name in map"; |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
elsif ($state eq STATE_KEY_SEPARATOR) { |
604
|
|
|
|
|
|
|
if ($self->_consume_if(DC_NAME_SEPARATOR)) { |
605
|
|
|
|
|
|
|
$self->map_members($members, STATE_VALUE); |
606
|
|
|
|
|
|
|
return; |
607
|
|
|
|
|
|
|
} else { |
608
|
|
|
|
|
|
|
die "Expected `" . DC_NAME_SEPARATOR . "` but got unexpected char at " . $self->{index}; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
elsif ($state eq STATE_VALUE) { |
612
|
|
|
|
|
|
|
if (defined(my $value = $self->config)) { |
613
|
|
|
|
|
|
|
push @$members, $$value; |
614
|
|
|
|
|
|
|
$self->map_members($members, STATE_VALUE_SEPARATOR); |
615
|
|
|
|
|
|
|
return; |
616
|
|
|
|
|
|
|
} else { |
617
|
|
|
|
|
|
|
die "Invalid value"; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
elsif ($state eq STATE_VALUE_SEPARATOR) { |
621
|
|
|
|
|
|
|
if ($self->_consume_if(DC_VALUE_SEPARATOR)) { |
622
|
|
|
|
|
|
|
$self->map_members($members, STATE_KEY); |
623
|
|
|
|
|
|
|
return; |
624
|
|
|
|
|
|
|
} else { |
625
|
|
|
|
|
|
|
die "Expected `" . DC_VALUE_SEPARATOR . "` but got `$char` at " . $self->{index}; |
626
|
|
|
|
|
|
|
return; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
else { |
630
|
|
|
|
|
|
|
die "Unexpected state: `$state`"; |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
} else { |
634
|
|
|
|
|
|
|
return; |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
sub map_key { |
640
|
|
|
|
|
|
|
my $self = shift; |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
use constant { map { ($_ => $_) } qw/ |
643
|
|
|
|
|
|
|
MODE_MAP_KEY_NAKED |
644
|
|
|
|
|
|
|
MODE_MAP_KEY_QUOTED |
645
|
|
|
|
|
|
|
/ }; |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
my $mode = $self->_match_str(DC_QUOTATION_MARK) |
648
|
|
|
|
|
|
|
? MODE_MAP_KEY_QUOTED |
649
|
|
|
|
|
|
|
: MODE_MAP_KEY_NAKED; |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
my $string = ""; |
652
|
|
|
|
|
|
|
while (1) { |
653
|
|
|
|
|
|
|
if (defined(my $char = $self->_peek(0))) { |
654
|
|
|
|
|
|
|
if ($mode eq MODE_MAP_KEY_QUOTED) { |
655
|
|
|
|
|
|
|
return $self->string; |
656
|
|
|
|
|
|
|
} else { |
657
|
|
|
|
|
|
|
if ($self->_consume_if_space($char)) { |
658
|
|
|
|
|
|
|
next; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
elsif ($self->_match_str("//") or $self->_match_str("/*")) { |
661
|
|
|
|
|
|
|
$self->comment; |
662
|
|
|
|
|
|
|
next; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
elsif ($self->_match_str(DC_NAME_SEPARATOR)) { |
665
|
|
|
|
|
|
|
return $string; |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
else { |
668
|
|
|
|
|
|
|
$string .= $char; |
669
|
|
|
|
|
|
|
$self->_consume; |
670
|
|
|
|
|
|
|
next; |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
} else { |
674
|
|
|
|
|
|
|
die "Unterminated string"; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
1; |
680
|
|
|
|
|
|
|
__END__ |