1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
package ListParser;
sub parse_mapping {
my ($input) = @_;
my $key, $value;
my $i = 0;
my $string_start, $string_end;
$string_start = $string_end = undef;
# Are we currently lexing inside a string literal?
my $is_string = 0;
# Currently parsing key or value?
my $is_key = 1;
while ($i < length($input)) {
my $c = substr($input, $i, 1);
my $lookahead = substr($input, $i+1, 1);
if ($is_string and $c eq "'") {
$is_string = 0;
$string_end = $i;
if (not $is_key) {
$value = substr($input, $string_start, $string_end - $string_start);
}
$i++;
next;
}
if (not $is_string) {
if ($c =~ /\s/) {
# allow whitespace
} elsif ($c eq "'") {
return { error => "Key/value must consist of single string",
column_start => $string_start,
column_end => $i } if defined $string_end;
$is_string = 1;
$string_start = $i + 1;
} elsif ($c eq "=") {
return { error => "Expected > after =, got $lookahead",
column_start => $i + 1,
column_end => $i + 1 } unless $lookahead eq ">";
return { error => "Unexpected '=>'.",
column_start => $i,
column_end => $i} unless $is_key;
$i++;
$key = substr($input, $string_start, $string_end - $string_start);
$string_start = $string_end = undef;
$is_key = 0;
} else {
return { error => "Unexpected $c",
column_start => $i,
column_end => $i };
}
}
$i++;
}
return { column_start => $i,
column_end => $i,
key => $key,
value => $value };
}
sub parse_list {
my ($input, $is_hash) = @_;
my $c_start = $is_hash ? "{" : "[";
my $c_end = $is_hash ? "}" : "]";
my %h_res;
my @a_res;
my $i = 0;
# Index of the start of the current item
my $item_i = 0;
# Level of nested lists, 1 being the minimum
my $nest = 1;
return { error => "Error: expected $c_start",
column_start => $i,
column_end => $i } unless substr($input, $i, 1) eq $c_start;
$i++;
$item_i = $i;
while ($nest != 0 && $i < length($input)) {
my $c = substr($input, $i, 1);
if ($c eq $c_start) {
$nest++;
} elsif ($c eq $c_end) {
$nest--;
}
if (($nest == 1 and $c eq ",") || ($nest == 0 and $c eq $c_end)) {
my $item = substr($input, $item_i, $i - $item_i);
$item =~ s/^\s+|\s+$//g;
if ($is_hash) {
my $mapping = parse_mapping($item);
$mapping{column_start} += $item_i;
$mapping{column_end} += $item_i;
return $mapping if $mapping->{error};
return { error => "Error: duplicate key \"$mapping->{key}\"",
column_start => $item_i,
column_end => $mapping->{column_end} } if grep {$_ eq $mapping->{key}} (keys %h_res);
$h_res{$mapping->{key}} = $mapping->{value};
} else {
push @a_res, $item;
}
$item_i = $i+1;
}
$i++;
}
return { error => "Error: expected $c_end, got end of line",
column_start => $i,
column_end => $i } unless $nest == 0;
if ($i != length($input)) {
return { error => "Error: unexpected item in the bagging area (after '$c_end')",
column_start => $i,
column_end => $i };
}
return { hash => \%h_res } if $is_hash;
return { array => \@a_res };
}
1;
|