67
bless {
68
parser => $parser,
69
buff => $s,
70
+ lineno => 1,
71
heretags => []
72
} => $class;
73
}
98
sub scan_sqstring {
99
my $self = shift @_;
100
${$self->{buff}} =~ /\G([^']*'|.*\z)/sgc;
100
- return "'" . $1;
101
+ my $s = $1;
102
+ $self->{lineno} += () = $s =~ /\n/sg;
103
+ return "'" . $s;
104
}
105
106
sub scan_dqstring {
118
if ($c eq '\\') {
119
$s .= '\\', last unless $$b =~ /\G(.)/sgc;
120
$c = $1;
118
- next if $c eq "\n"; # line splice
121
+ $self->{lineno}++, next if $c eq "\n"; # line splice
122
# backslash escapes only $, `, ", \ in dq-string
123
$s .= '\\' unless $c =~ /^[\$`"\\]$/;
124
$s .= $c;
126
}
127
die("internal error scanning dq-string '$c'\n");
128
}
129
+ $self->{lineno} += () = $s =~ /\n/sg;
130
return $s;
131
}
132
141
$depth--;
142
last if $depth == 0;
143
}
144
+ $self->{lineno} += () = $s =~ /\n/sg;
145
return $s;
146
}
147
168
my $b = $self->{buff};
169
my $tags = $self->{heretags};
170
while (my $tag = shift @$tags) {
171
+ my $start = pos($$b);
172
my $indent = $tag =~ s/^\t// ? '\\s*' : '';
173
$$b =~ /(?:\G|\n)$indent\Q$tag\E(?:\n|\z)/gc;
174
+ my $body = substr($$b, $start, pos($$b) - $start);
175
+ $self->{lineno} += () = $body =~ /\n/sg;
176
}
177
}
178
180
my $self = shift @_;
181
my $b = $self->{buff};
182
my $token = '';
175
- my $start;
183
+ my ($start, $startln);
184
RESTART:
185
+ $startln = $self->{lineno};
186
$$b =~ /\G[ \t]+/gc; # skip whitespace (but not newline)
187
$start = pos($$b) || 0;
179
- return ["\n", $start, pos($$b)] if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment
188
+ $self->{lineno}++, return ["\n", $start, pos($$b), $startln, $startln] if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment
189
while (1) {
190
# slurp up non-special characters
191
$token .= $1 if $$b =~ /\G([^\\;&|<>(){}'"\$\s]+)/gc;
197
$token .= $self->scan_sqstring(), next if $c eq "'";
198
$token .= $self->scan_dqstring(), next if $c eq '"';
199
$token .= $c . $self->scan_dollar(), next if $c eq '$';
191
- $self->swallow_heredocs(), $token = $c, last if $c eq "\n";
200
+ $self->{lineno}++, $self->swallow_heredocs(), $token = $c, last if $c eq "\n";
201
$token = $self->scan_op($c), last if $c =~ /^[;&|<>]$/;
202
$token = $c, last if $c =~ /^[(){}]$/;
203
if ($c eq '\\') {
204
$token .= '\\', last unless $$b =~ /\G(.)/sgc;
205
$c = $1;
197
- next if $c eq "\n" && length($token); # line splice
198
- goto RESTART if $c eq "\n"; # line splice
206
+ $self->{lineno}++, next if $c eq "\n" && length($token); # line splice
207
+ $self->{lineno}++, goto RESTART if $c eq "\n"; # line splice
208
$token .= '\\' . $c;
209
next;
210
}
211
die("internal error scanning character '$c'\n");
212
}
204
- return length($token) ? [$token, $start, pos($$b)] : undef;
213
+ return length($token) ? [$token, $start, pos($$b), $startln, $self->{lineno}] : undef;
214
}
215
216
# ShellParser parses POSIX shell scripts (with minor extensions for Bash). It