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
# Copyright (c) Philippe Verdret, 1995-1998
require 5.003;
use strict;
package Parse::Token;
my $old_next = \&next;
*next = sub { # add some actions before and after the routine call
my $self = $_[0];
if ($Parse::Token::trace) {
my $name = $self->name;
$self->context("try to find:\t$name");
my $reader = $self->reader;
my $pendingToken = $reader->[$Lex::PEND_TOKEN];
if ($pendingToken) {
if ($pendingToken->name eq 'EOI') {
$self->context("End of input at line $.");
return undef;
} else {
$self->context("pending token:\t", $pendingToken->name);
}
}
}
my $string = &$old_next(@_);
if ($Parse::Token::trace) {
if ($self->status) {
$self->context("token found: $string");
} else {
$self->context("token not found");
}
}
$string;
};
my $old_isnext = \&isnext;
*isnext = sub {
my $self = $_[0];
if ($Parse::Token::trace) {
my $name = $self->name;
$self->context("try to find:\t$name");
my $reader = $self->reader;
my $pendingToken = $reader->[$Lex::PEND_TOKEN];
if ($pendingToken) {
if ($pendingToken->name eq 'EOI') {
$self->context("End of input at line $.");
return undef;
} else {
$self->context("pending token:\t", $pendingToken->name);
}
}
}
my $status = &$old_isnext(@_);
if ($Parse::Token::trace) {
if ($self->status) {
$self->context("token found: ${$_[1]}");
} else {
$self->context("token not found");
}
}
$status;
};
1;
__END__