line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
################################################################################ |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# MODULE: Devel::Tokenizer::C |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
################################################################################ |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# DESCRIPTION: Generate C source for fast keyword tokenizer |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
################################################################################ |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# Copyright (c) 2002-2018 Marcus Holland-Moritz. All rights reserved. |
12
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify |
13
|
|
|
|
|
|
|
# it under the same terms as Perl itself. |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
################################################################################ |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
package Devel::Tokenizer::C; |
18
|
|
|
|
|
|
|
|
19
|
4
|
|
|
4
|
|
12042
|
use 5.005_03; |
|
4
|
|
|
|
|
25
|
|
20
|
4
|
|
|
4
|
|
22
|
use strict; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
66
|
|
21
|
4
|
|
|
4
|
|
15
|
use Carp; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
171
|
|
22
|
4
|
|
|
4
|
|
18
|
use vars '$VERSION'; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
8078
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$VERSION = '0.11'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my %DEF = ( |
27
|
|
|
|
|
|
|
CaseSensitive => 1, |
28
|
|
|
|
|
|
|
Comments => 1, |
29
|
|
|
|
|
|
|
Indent => ' ', |
30
|
|
|
|
|
|
|
MergeSwitches => 0, |
31
|
|
|
|
|
|
|
Strategy => 'ordered', # wide, narrow, ordered |
32
|
|
|
|
|
|
|
StringLength => '', |
33
|
|
|
|
|
|
|
TokenEnd => "'\\0'", |
34
|
|
|
|
|
|
|
TokenFunc => sub { "return $_[0];\n" }, |
35
|
|
|
|
|
|
|
# TokenSort => sub { $_[0] cmp $_[1] }, # TODO? |
36
|
|
|
|
|
|
|
TokenString => 'tokstr', |
37
|
|
|
|
|
|
|
UnknownLabel => 'unknown', |
38
|
|
|
|
|
|
|
UnknownCode => undef, |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub new |
42
|
|
|
|
|
|
|
{ |
43
|
134
|
|
|
134
|
1
|
88129171
|
my $class = shift; |
44
|
134
|
|
|
|
|
1440
|
my %opt = @_; |
45
|
134
|
100
|
|
|
|
738
|
for (keys %opt) { exists $DEF{$_} or croak "Invalid option '$_'" } |
|
748
|
|
|
|
|
2213
|
|
46
|
133
|
100
|
|
|
|
533
|
if (exists $opt{TokenFunc}) { |
47
|
131
|
100
|
|
|
|
729
|
ref $opt{TokenFunc} eq 'CODE' |
48
|
|
|
|
|
|
|
or croak "Option TokenFunc needs a code reference"; |
49
|
|
|
|
|
|
|
} |
50
|
132
|
|
|
|
|
48408
|
my %self = ( |
51
|
|
|
|
|
|
|
%DEF, @_, |
52
|
|
|
|
|
|
|
__tcheck__ => {}, |
53
|
|
|
|
|
|
|
__tokens__ => {}, |
54
|
|
|
|
|
|
|
__backup__ => [], |
55
|
|
|
|
|
|
|
__maxlen__ => 0, |
56
|
|
|
|
|
|
|
); |
57
|
132
|
50
|
66
|
|
|
1796
|
if ($self{StringLength} eq '' and $self{Strategy} ne 'ordered') { |
58
|
0
|
|
|
|
|
0
|
croak "Cannot use Strategy '$self{Strategy}' without StringLength"; |
59
|
|
|
|
|
|
|
} |
60
|
132
|
|
|
|
|
940
|
bless \%self, $class; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub add_tokens |
64
|
|
|
|
|
|
|
{ |
65
|
65038
|
|
|
65038
|
1
|
530975
|
my $self = shift; |
66
|
65038
|
100
|
|
|
|
178949
|
my($tokens, $pre) = ref $_[0] eq 'ARRAY' ? @_ : \@_; |
67
|
65038
|
|
|
|
|
103213
|
for (@$tokens) { |
68
|
65041
|
100
|
|
|
|
129929
|
my $tok = $self->{CaseSensitive} ? $_ : lc; |
69
|
|
|
|
|
|
|
exists $self->{__tcheck__}{$tok} |
70
|
65041
|
100
|
100
|
|
|
143823
|
and carp $self->{__tcheck__}{$tok} eq ($pre || '') |
|
|
100
|
|
|
|
|
|
71
|
|
|
|
|
|
|
? "Multiple definition of token '$_'" |
72
|
|
|
|
|
|
|
: "Redefinition of token '$_'"; |
73
|
65041
|
|
100
|
|
|
256485
|
$self->{__tcheck__}{$tok} = $self->{__tokens__}{$_} = $pre || ''; |
74
|
65041
|
|
|
|
|
113135
|
my $len = length __quotecomment__($_); |
75
|
65041
|
100
|
|
|
|
191506
|
$self->{__maxlen__} = $len if $len > $self->{__maxlen__}; |
76
|
|
|
|
|
|
|
} |
77
|
65038
|
|
|
|
|
131968
|
$self; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub generate |
81
|
|
|
|
|
|
|
{ |
82
|
131
|
|
|
131
|
1
|
3323
|
my $self = shift; |
83
|
131
|
|
|
|
|
1137
|
my %options = (Indent => '', @_); |
84
|
131
|
|
|
|
|
377
|
my $IND = $options{Indent}; |
85
|
131
|
|
|
|
|
394
|
my $I = $self->{Indent}; |
86
|
|
|
|
|
|
|
|
87
|
131
|
100
|
|
|
|
841
|
if ($self->{StringLength}) { |
88
|
97
|
|
|
|
|
638
|
my @tokens; |
89
|
97
|
|
|
|
|
247
|
for my $t (keys %{$self->{__tokens__}}) { |
|
97
|
|
|
|
|
14030
|
|
90
|
48770
|
|
|
|
|
207244
|
$tokens[length $t]{$t} = $self->{__tokens__}{$t}; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
97
|
|
|
|
|
2602
|
my $rv = <
|
94
|
|
|
|
|
|
|
${IND}switch ($self->{StringLength}) |
95
|
|
|
|
|
|
|
$IND\{ |
96
|
|
|
|
|
|
|
EOS |
97
|
|
|
|
|
|
|
|
98
|
97
|
|
|
|
|
484
|
for my $len (1 .. $#tokens) { |
99
|
1730
|
100
|
|
|
|
8006
|
$tokens[$len] or next; |
100
|
1537
|
|
|
|
|
3115
|
my $count = keys %{$tokens[$len]}; |
|
1537
|
|
|
|
|
10264
|
|
101
|
1537
|
|
|
|
|
8798
|
my $switch = $self->__makeit__($IND.$I.$I, $self->__order__($tokens[$len]), 0, 0, $tokens[$len]); |
102
|
1537
|
|
|
|
|
50683
|
$rv .= <
|
103
|
|
|
|
|
|
|
$IND${I}case $len: /* $count tokens of length $len */ |
104
|
|
|
|
|
|
|
$switch |
105
|
|
|
|
|
|
|
EOS |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
97
|
|
|
|
|
495
|
my $unk = $self->__unknown__("$IND$I$I"); |
109
|
|
|
|
|
|
|
|
110
|
97
|
50
|
|
|
|
1476
|
$rv .= <
|
111
|
|
|
|
|
|
|
$IND${I}default: |
112
|
|
|
|
|
|
|
$unk |
113
|
|
|
|
|
|
|
EOS |
114
|
|
|
|
|
|
|
|
115
|
97
|
|
|
|
|
55491
|
$rv .= "$IND}\n" |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
else { |
118
|
34
|
|
|
|
|
284
|
return $self->__makeit__($IND, undef, 0, 0, $self->{__tokens__}); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub __order__ |
123
|
|
|
|
|
|
|
{ |
124
|
1537
|
|
|
1537
|
|
4566
|
my($self, $tok) = @_; |
125
|
1537
|
|
|
|
|
3027
|
my @hist; |
126
|
|
|
|
|
|
|
|
127
|
1537
|
100
|
|
|
|
7290
|
return undef if $self->{Strategy} eq 'ordered'; |
128
|
|
|
|
|
|
|
|
129
|
1024
|
|
|
|
|
13342
|
for my $k (keys %$tok) { |
130
|
32512
|
100
|
|
|
|
166373
|
my @key = ($self->{CaseSensitive} ? $k : uc $k) =~ /(.)/g; |
131
|
32512
|
|
|
|
|
52637
|
for my $i (0 .. $#key) { |
132
|
305600
|
|
|
|
|
427317
|
$hist[$i]{$key[$i]}++; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} |
135
|
1024
|
|
|
|
|
4259
|
for my $i (0 .. $#hist) { |
136
|
10752
|
|
|
|
|
18438
|
$hist[$i]{ix} = $i; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
1024
|
100
|
|
|
|
4335
|
if ($self->{Strategy} eq 'wide') { |
|
|
50
|
|
|
|
|
|
140
|
512
|
|
|
|
|
2779
|
@hist = sort { keys %$b <=> keys %$a } @hist; |
|
13328
|
|
|
|
|
18201
|
|
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
elsif ($self->{Strategy} eq 'narrow') { |
143
|
512
|
|
|
|
|
2212
|
@hist = sort { keys %$a <=> keys %$b } @hist; |
|
11536
|
|
|
|
|
15940
|
|
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
else { |
146
|
0
|
|
|
|
|
0
|
croak "Invalid Strategy '$self->{Strategy}'"; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
1024
|
|
|
|
|
16824
|
return [map $_->{ix}, @hist]; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub __commented__ |
153
|
|
|
|
|
|
|
{ |
154
|
65027
|
|
|
65027
|
|
122075
|
my($self, $code, $comment) = @_; |
155
|
65027
|
50
|
|
|
|
124063
|
return "$code\n" unless $self->{Comments}; |
156
|
65027
|
|
|
|
|
140656
|
sprintf "%-50s/* %-$self->{__maxlen__}s */\n", $code, __quotecomment__($comment); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub __unknown__ |
160
|
|
|
|
|
|
|
{ |
161
|
95660
|
|
|
95660
|
|
181772
|
my($self, $indent) = @_; |
162
|
|
|
|
|
|
|
my $code = defined $self->{UnknownCode} ? $self->{UnknownCode} |
163
|
95660
|
100
|
|
|
|
222468
|
: "goto $self->{UnknownLabel};"; |
164
|
95660
|
|
|
|
|
224655
|
$code =~ s/\s+$//; |
165
|
95660
|
|
|
|
|
267658
|
$code =~ s/^/$indent/m; |
166
|
95660
|
|
|
|
|
245800
|
return $code; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub __makeit__ |
170
|
|
|
|
|
|
|
{ |
171
|
97542
|
|
|
97542
|
|
211069
|
my($self, $IND, $order, $level, $pre_flag, $t, %tok) = @_; |
172
|
97542
|
|
|
|
|
150432
|
my $I = $self->{Indent}; |
173
|
|
|
|
|
|
|
|
174
|
97542
|
100
|
|
|
|
173499
|
%$t or return ''; |
175
|
|
|
|
|
|
|
|
176
|
97541
|
100
|
|
|
|
187546
|
if (keys(%$t) == 1) { |
177
|
65027
|
|
|
|
|
135380
|
my($token) = keys %$t; |
178
|
65027
|
|
|
|
|
105127
|
my($rvs,$code); |
179
|
65027
|
|
|
|
|
85185
|
my $unknown = ''; |
180
|
|
|
|
|
|
|
|
181
|
65027
|
100
|
|
|
|
106959
|
if ($level > length $token) { |
182
|
144
|
|
|
|
|
497
|
$rvs = $self->__commented__($IND.'{', $token); |
183
|
144
|
|
|
|
|
649
|
$code = $self->{TokenFunc}->($token); |
184
|
144
|
|
|
|
|
2136
|
$code =~ s/^/$IND$I/mg; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
else { |
187
|
64883
|
|
|
|
|
483697
|
my @chars = $token =~ /(.)/g; |
188
|
|
|
|
|
|
|
my $cmp = join " &&\n$IND$I$I", |
189
|
437395
|
|
|
|
|
686295
|
map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { |
|
780803
|
|
|
|
|
969532
|
|
190
|
64883
|
100
|
|
|
|
196930
|
my $p = defined $order ? $order->[$_] : $_; |
|
437395
|
|
|
|
|
878289
|
|
191
|
437395
|
|
|
|
|
882344
|
[$p, $self->__chr2cmp__($p, "'".__quotechar__($chars[$p])."'")]; |
192
|
|
|
|
|
|
|
} $level .. $#chars; |
193
|
|
|
|
|
|
|
|
194
|
64883
|
100
|
66
|
|
|
267587
|
if (defined $self->{TokenEnd} and not $self->{StringLength}) { |
195
|
16113
|
|
|
|
|
26603
|
$level = @chars; |
196
|
16113
|
100
|
|
|
|
34971
|
$cmp and $cmp .= " &&\n$IND$I$I"; |
197
|
16113
|
|
|
|
|
33536
|
$cmp .= $self->{TokenString} . "[$level] == $self->{TokenEnd}"; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
64883
|
100
|
|
|
|
171273
|
$unknown = "\n" . $self->__unknown__($IND) . "\n" if $cmp; |
201
|
|
|
|
|
|
|
|
202
|
64883
|
100
|
|
|
|
233722
|
$rvs = ($cmp ? $IND . "if ($cmp)\n" : '') . $self->__commented__($IND.'{', $token); |
203
|
|
|
|
|
|
|
|
204
|
64883
|
|
|
|
|
243733
|
$code = $self->{TokenFunc}->($token); |
205
|
64883
|
|
|
|
|
863729
|
$code =~ s/^/$IND$I/mg; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
65027
|
|
|
|
|
369594
|
return "$rvs$code$IND}\n$unknown"; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
32514
|
|
|
|
|
93994
|
for my $n (keys %$t) { |
212
|
173956
|
100
|
|
|
|
526914
|
my $c = __quotechar__(substr $n, (defined $order ? $order->[$level] : $level), 1); |
213
|
173956
|
50
|
66
|
|
|
487921
|
next if $c eq '' and not defined $self->{TokenEnd}; |
214
|
|
|
|
|
|
|
$tok{$c ne '' ? ($self->{CaseSensitive} || $c !~ /^[a-zA-Z]$/ ? "'$c'" : "'\U$c\E'") |
215
|
173956
|
100
|
100
|
|
|
1215386
|
: $self->{TokenEnd}}{$n} = $t->{$n}; |
|
|
100
|
|
|
|
|
|
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
32514
|
100
|
|
|
|
90589
|
my $pos = defined $order ? $order->[$level] : $level; |
219
|
32514
|
|
|
|
|
51215
|
my $bke = ''; |
220
|
32514
|
|
|
|
|
52391
|
my $rvs = ''; |
221
|
32514
|
|
|
|
|
45650
|
my $nlflag = 0; |
222
|
|
|
|
|
|
|
|
223
|
32514
|
100
|
100
|
|
|
93446
|
if (keys %tok > 1 or !$self->{MergeSwitches}) { |
224
|
29330
|
100
|
|
|
|
37462
|
if (@{$self->{__backup__}}) { |
|
29330
|
|
|
|
|
76501
|
|
225
|
|
|
|
|
|
|
my $cmp = join " &&\n$IND$I$I", |
226
|
3184
|
|
|
|
|
9646
|
map { $_->[1] } sort { $a->[0] <=> $b->[0] } |
|
2712
|
|
|
|
|
4381
|
|
227
|
1672
|
|
|
|
|
6284
|
@{$self->{__backup__}}; |
|
1672
|
|
|
|
|
5531
|
|
228
|
|
|
|
|
|
|
|
229
|
1672
|
|
|
|
|
7597
|
$rvs .= $IND."if ($cmp)\n".$IND."{\n"; |
230
|
1672
|
|
|
|
|
3383
|
$bke = "$IND}\n"; |
231
|
|
|
|
|
|
|
|
232
|
1672
|
|
|
|
|
2916
|
$IND .= $I; |
233
|
|
|
|
|
|
|
|
234
|
1672
|
|
|
|
|
3111
|
@{$self->{__backup__}} = (); |
|
1672
|
|
|
|
|
5176
|
|
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
29330
|
|
|
|
|
96874
|
$rvs .= $IND."switch ($self->{TokenString}\[$pos])\n".$IND."{\n"; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
else { |
240
|
3184
|
100
|
|
|
|
5275
|
$bke = "\n" . $self->__unknown__($IND) . "\n" unless @{$self->{__backup__}}; |
|
3184
|
|
|
|
|
11743
|
|
241
|
3184
|
|
|
|
|
5470
|
push @{$self->{__backup__}}, [$pos, $self->__chr2cmp__($pos, keys %tok)]; |
|
3184
|
|
|
|
|
11302
|
|
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
32514
|
|
|
|
|
120320
|
for my $c (sort keys %tok) { |
245
|
95971
|
|
|
|
|
163130
|
my($clear_pre_flag, %seen) = 0; |
246
|
95971
|
|
|
|
|
117018
|
my @pre = grep !$seen{$_}++, values %{$tok{$c}}; |
|
95971
|
|
|
|
|
546082
|
|
247
|
|
|
|
|
|
|
|
248
|
95971
|
100
|
|
|
|
216445
|
$nlflag and $rvs .= "\n"; |
249
|
|
|
|
|
|
|
|
250
|
95971
|
100
|
66
|
|
|
408593
|
if( $pre_flag == 0 && @pre == 1 && $pre[0] ) { |
|
|
|
100
|
|
|
|
|
251
|
12737
|
|
|
|
|
30175
|
$rvs .= "#if $pre[0]\n"; |
252
|
12737
|
|
|
|
|
22467
|
$pre_flag = $clear_pre_flag = 1; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
95971
|
100
|
100
|
|
|
236809
|
if (keys %tok > 1 or !$self->{MergeSwitches}) { |
256
|
92787
|
100
|
100
|
|
|
445250
|
$rvs .= $self->{CaseSensitive} || $c !~ /^'[a-zA-Z]'$/ |
257
|
|
|
|
|
|
|
? $IND.$I."case $c:\n" |
258
|
|
|
|
|
|
|
: $IND.$I."case \U$c\E:\n" |
259
|
|
|
|
|
|
|
. $IND.$I."case \L$c\E:\n"; |
260
|
|
|
|
|
|
|
|
261
|
92787
|
|
|
|
|
303985
|
$rvs .= $self->__makeit__($IND.$I.$I, $order, $level+1, $pre_flag, $tok{$c}); |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
else { |
264
|
3184
|
|
|
|
|
12116
|
$rvs .= $self->__makeit__($IND, $order, $level+1, $pre_flag, $tok{$c}); |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
95971
|
100
|
|
|
|
244034
|
if ($clear_pre_flag) { |
268
|
12737
|
50
|
|
|
|
49053
|
my $cmt = $self->{Comments} ? " /* $pre[0] */" : ''; |
269
|
12737
|
|
|
|
|
26924
|
$rvs .= "#endif$cmt\n"; |
270
|
12737
|
|
|
|
|
20035
|
$pre_flag = 0; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
95971
|
|
|
|
|
222982
|
$nlflag = 1; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
32514
|
100
|
100
|
|
|
118517
|
if (keys %tok > 1 || !$self->{MergeSwitches}) { |
277
|
29330
|
|
|
|
|
89317
|
my $unk = $self->__unknown__("$IND$I$I"); |
278
|
|
|
|
|
|
|
|
279
|
29330
|
50
|
|
|
|
85711
|
$unk = "$IND${I}default:\n$unk\n" if $unk; |
280
|
|
|
|
|
|
|
|
281
|
29330
|
|
|
|
|
419298
|
return <
|
282
|
|
|
|
|
|
|
$rvs |
283
|
|
|
|
|
|
|
$unk$IND} |
284
|
|
|
|
|
|
|
EOS |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
else { |
287
|
3184
|
|
|
|
|
20972
|
return $rvs . $bke; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub __quotechar__ |
292
|
|
|
|
|
|
|
{ |
293
|
611351
|
|
|
611351
|
|
1106894
|
my $str = shift; |
294
|
611351
|
|
|
|
|
904097
|
$str =~ s/(['\\])/\\$1/g; |
295
|
611351
|
|
|
|
|
972875
|
return __quotecomment__($str); |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub __quotecomment__ |
299
|
|
|
|
|
|
|
{ |
300
|
741419
|
|
|
741419
|
|
1034631
|
my $str = shift; |
301
|
741419
|
|
|
|
|
1141276
|
for my $c (qw( a b f n r t )) { |
302
|
4448514
|
|
|
|
|
167878880
|
my $e = eval qq("\\$c"); |
303
|
4448514
|
|
|
|
|
42440575
|
$str =~ s/$e/\\$c/g; |
304
|
|
|
|
|
|
|
} |
305
|
741419
|
|
|
|
|
1531941
|
$str =~ s/([\x01-\x1F])/sprintf "\\%o", ord($1)/eg; |
|
0
|
|
|
|
|
0
|
|
306
|
741419
|
|
|
|
|
2354786
|
return $str; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub __chr2cmp__ |
310
|
|
|
|
|
|
|
{ |
311
|
440579
|
|
|
440579
|
|
909641
|
my($self, $p, $c) = @_; |
312
|
|
|
|
|
|
|
$self->{CaseSensitive} || $c !~ /^'[a-zA-Z]'$/ |
313
|
|
|
|
|
|
|
? $self->{TokenString}."[$p] == $c" |
314
|
|
|
|
|
|
|
: '(' . $self->{TokenString} . "[$p] == \U$c\E || " |
315
|
440579
|
100
|
100
|
|
|
3184733
|
. $self->{TokenString} . "[$p] == \L$c\E)"; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
1; |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
__END__ |