line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sjis; |
2
|
386
|
|
|
386
|
|
247922
|
use strict; |
|
386
|
|
|
|
|
2830
|
|
|
386
|
|
|
|
|
15785
|
|
3
|
386
|
50
|
|
386
|
|
7334
|
BEGIN { $INC{'warnings.pm'} = '' if $] < 5.006 } use warnings; |
|
386
|
|
|
386
|
|
1916
|
|
|
386
|
|
|
|
|
643
|
|
|
386
|
|
|
|
|
9597
|
|
4
|
|
|
|
|
|
|
###################################################################### |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Sjis - Source code filter to escape ShiftJIS script |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# http://search.cpan.org/dist/Char-Sjis/ |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# Copyright (c) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2019 INABA Hitoshi |
11
|
|
|
|
|
|
|
###################################################################### |
12
|
|
|
|
|
|
|
|
13
|
386
|
|
|
386
|
|
7911
|
use 5.00503; # Galapagos Consensus 1998 for primetools |
|
386
|
|
|
|
|
1271
|
|
14
|
|
|
|
|
|
|
# use 5.008001; # Lancaster Consensus 2013 for toolchains |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# 12.3. Delaying use Until Runtime |
17
|
|
|
|
|
|
|
# in Chapter 12. Packages, Libraries, and Modules |
18
|
|
|
|
|
|
|
# of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. |
19
|
|
|
|
|
|
|
# (and so on) |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Version numbers should be boring |
22
|
|
|
|
|
|
|
# http://www.dagolden.com/index.php/369/version-numbers-should-be-boring/ |
23
|
|
|
|
|
|
|
# For the impatient, the disinterested or those who just want to follow |
24
|
|
|
|
|
|
|
# a recipe, my advice for all modules is this: |
25
|
|
|
|
|
|
|
# our $VERSION = "0.001"; # or "0.001_001" for a dev release |
26
|
|
|
|
|
|
|
# $VERSION = CORE::eval $VERSION; # No!! because '1.10' makes '1.1' |
27
|
|
|
|
|
|
|
|
28
|
386
|
|
|
386
|
|
2313
|
use vars qw($VERSION); |
|
386
|
|
|
|
|
694
|
|
|
386
|
|
|
|
|
58644
|
|
29
|
|
|
|
|
|
|
$VERSION = '1.21'; |
30
|
|
|
|
|
|
|
$VERSION = $VERSION; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
BEGIN { |
33
|
386
|
50
|
|
386
|
|
6323
|
if ($^X =~ / jperl /oxmsi) { |
34
|
0
|
|
|
|
|
0
|
die __FILE__, ": needs perl(not jperl) 5.00503 or later. (\$^X==$^X)\n"; |
35
|
|
|
|
|
|
|
} |
36
|
386
|
|
|
|
|
724
|
if (CORE::ord('A') == 193) { |
37
|
|
|
|
|
|
|
die __FILE__, ": is not US-ASCII script (may be EBCDIC or EBCDIK script).\n"; |
38
|
|
|
|
|
|
|
} |
39
|
386
|
|
|
|
|
34679
|
if (CORE::ord('A') != 0x41) { |
40
|
|
|
|
|
|
|
die __FILE__, ": is not US-ASCII script (must be US-ASCII script).\n"; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
BEGIN { |
45
|
386
|
|
|
386
|
|
5639
|
(my $dirname = __FILE__) =~ s{^(.+)/[^/]*$}{$1}; |
46
|
386
|
|
|
|
|
3094
|
unshift @INC, $dirname; |
47
|
386
|
|
|
|
|
699708
|
CORE::require Esjis; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# instead of Symbol.pm |
51
|
1158
|
|
|
|
|
4196
|
BEGIN { |
52
|
|
|
|
|
|
|
sub gensym () { |
53
|
0
|
50
|
|
1158
|
0
|
0
|
if ($] < 5.006) { |
54
|
0
|
|
|
|
|
0
|
return \do { local *_ }; |
|
1158
|
|
|
|
|
2738
|
|
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
else { |
57
|
386
|
|
|
|
|
4906
|
return undef; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# P.714 29.2.39. flock |
63
|
|
|
|
|
|
|
# in Chapter 29: Functions |
64
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# P.863 flock |
67
|
|
|
|
|
|
|
# in Chapter 27: Functions |
68
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# P.228 Inlining Constant Functions |
71
|
|
|
|
|
|
|
# in Chapter 6: Subroutines |
72
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# P.331 Inlining Constant Functions |
75
|
|
|
|
|
|
|
# in Chapter 7: Subroutines |
76
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub LOCK_SH() {1} |
79
|
|
|
|
|
|
|
sub LOCK_EX() {2} |
80
|
|
|
|
|
|
|
sub LOCK_UN() {8} |
81
|
|
|
|
|
|
|
sub LOCK_NB() {4} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
0
|
|
|
sub unimport {} |
84
|
|
|
|
|
|
|
sub Sjis::escape_script; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# 6.18. Matching Multiple-Byte Characters |
87
|
|
|
|
|
|
|
# in Chapter 6. Pattern Matching |
88
|
|
|
|
|
|
|
# of ISBN 978-1-56592-243-3 Perl Perl Cookbook. |
89
|
|
|
|
|
|
|
# (and so on) |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# regexp of character |
92
|
|
|
|
|
|
|
my $qq_char = qr/(?> \\c[\x40-\x5F] | \\? (?:[\x81-\x9F\xE0-\xFC][\x00-\xFF] | [\x00-\xFF]) )/oxms; |
93
|
|
|
|
|
|
|
my $q_char = qr/(?> [\x81-\x9F\xE0-\xFC][\x00-\xFF] | [\x00-\xFF] )/oxms; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# when this script is main program |
96
|
|
|
|
|
|
|
if ($0 eq __FILE__) { |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# show usage |
99
|
|
|
|
|
|
|
unless (@ARGV) { |
100
|
|
|
|
|
|
|
die <
|
101
|
|
|
|
|
|
|
$0: usage |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
perl $0 ShiftJIS_script.pl > Escaped_script.pl.e |
104
|
|
|
|
|
|
|
END |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
print Sjis::escape_script($ARGV[0]); |
108
|
|
|
|
|
|
|
exit 0; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my($package,$filename,$line,$subroutine,$hasargs,$wantarray,$evaltext,$is_require,$hints,$bitmask) = caller 0; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# called any package not main |
114
|
|
|
|
|
|
|
if ($package ne 'main') { |
115
|
|
|
|
|
|
|
die <
|
116
|
|
|
|
|
|
|
@{[__FILE__]}: escape by manually command '$^X @{[__FILE__]} "$filename" > "@{[__PACKAGE__]}::$filename"' |
117
|
|
|
|
|
|
|
and rewrite "use $package;" to "use @{[__PACKAGE__]}::$package;" of script "$0". |
118
|
|
|
|
|
|
|
END |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# P.302 Module Privacy and the Exporter |
122
|
|
|
|
|
|
|
# in Chapter 11: Modules |
123
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
124
|
|
|
|
|
|
|
# |
125
|
|
|
|
|
|
|
# A module can do anything it jolly well pleases when it's used, since use just |
126
|
|
|
|
|
|
|
# calls the ordinary import method for the module, and you can define that |
127
|
|
|
|
|
|
|
# method to do anything you like. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# P.406 Module Privacy and the Exporter |
130
|
|
|
|
|
|
|
# in Chapter 11: Modules |
131
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
132
|
|
|
|
|
|
|
# |
133
|
|
|
|
|
|
|
# A module can do anything it jolly well pleases when it's used, since use just |
134
|
|
|
|
|
|
|
# calls the ordinary import method for the module, and you can define that |
135
|
|
|
|
|
|
|
# method to do anything you like. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub import { |
138
|
|
|
|
|
|
|
|
139
|
0
|
50
|
|
386
|
|
0
|
if (Esjis::e("$filename.e")) { |
140
|
0
|
0
|
|
|
|
0
|
if (exists $ENV{'CHAR_DEBUG'}) { |
|
|
0
|
|
|
|
|
|
141
|
0
|
|
|
|
|
0
|
Esjis::unlink "$filename.e"; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
elsif (Esjis::z("$filename.e")) { |
144
|
0
|
|
|
|
|
0
|
Esjis::unlink "$filename.e"; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
else { |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
#---------------------------------------------------- |
149
|
|
|
|
|
|
|
# older > |
150
|
|
|
|
|
|
|
# newer >>>>> |
151
|
|
|
|
|
|
|
#---------------------------------------------------- |
152
|
|
|
|
|
|
|
# Filter > |
153
|
|
|
|
|
|
|
# Source >>>>> |
154
|
|
|
|
|
|
|
# Escape >>> needs re-escape (Source was changed) |
155
|
|
|
|
|
|
|
# |
156
|
|
|
|
|
|
|
# Filter >>> |
157
|
|
|
|
|
|
|
# Source >>>>> |
158
|
|
|
|
|
|
|
# Escape > needs re-escape (Source was changed) |
159
|
|
|
|
|
|
|
# |
160
|
|
|
|
|
|
|
# Filter >>>>> |
161
|
|
|
|
|
|
|
# Source >>> |
162
|
|
|
|
|
|
|
# Escape > needs re-escape (Source was changed) |
163
|
|
|
|
|
|
|
# |
164
|
|
|
|
|
|
|
# Filter >>>>> |
165
|
|
|
|
|
|
|
# Source > |
166
|
|
|
|
|
|
|
# Escape >>> needs re-escape (Filter was changed) |
167
|
|
|
|
|
|
|
# |
168
|
|
|
|
|
|
|
# Filter > |
169
|
|
|
|
|
|
|
# Source >>> |
170
|
|
|
|
|
|
|
# Escape >>>>> executable without re-escape |
171
|
|
|
|
|
|
|
# |
172
|
|
|
|
|
|
|
# Filter >>> |
173
|
|
|
|
|
|
|
# Source > |
174
|
|
|
|
|
|
|
# Escape >>>>> executable without re-escape |
175
|
|
|
|
|
|
|
#---------------------------------------------------- |
176
|
|
|
|
|
|
|
|
177
|
0
|
|
|
|
|
0
|
my $mtime_filter = (Esjis::stat(__FILE__ ))[9]; |
178
|
0
|
|
|
|
|
0
|
my $mtime_source = (Esjis::stat($filename ))[9]; |
179
|
0
|
|
|
|
|
0
|
my $mtime_escape = (Esjis::stat("$filename.e"))[9]; |
180
|
0
|
0
|
0
|
|
|
0
|
if (($mtime_escape < $mtime_source) or ($mtime_escape < $mtime_filter)) { |
181
|
386
|
|
|
|
|
2086
|
Esjis::unlink "$filename.e"; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
386
|
50
|
|
|
|
1338
|
if (not Esjis::e("$filename.e")) { |
187
|
386
|
|
|
|
|
1948
|
my $fh = gensym(); |
188
|
386
|
50
|
|
|
|
3855
|
Esjis::_open_a($fh, "$filename.e") or die __FILE__, ": Can't write open file: $filename.e\n"; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# 7.19. Flushing Output |
191
|
|
|
|
|
|
|
# in Chapter 7. File Access |
192
|
|
|
|
|
|
|
# of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. |
193
|
|
|
|
|
|
|
|
194
|
386
|
|
|
|
|
2593
|
select((select($fh), $|=1)[0]); |
195
|
|
|
|
|
|
|
|
196
|
0
|
50
|
|
|
|
0
|
if (0) { |
|
|
50
|
|
|
|
|
|
197
|
|
|
|
|
|
|
} |
198
|
0
|
|
|
|
|
0
|
elsif ($^O eq 'MacOS') { |
199
|
0
|
|
|
|
|
0
|
CORE::eval q{ |
200
|
|
|
|
|
|
|
CORE::require Mac::Files; |
201
|
|
|
|
|
|
|
Mac::Files::FSpSetFLock("$filename.e"); |
202
|
|
|
|
|
|
|
}; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
elsif (exists $ENV{'CHAR_NONBLOCK'}) { |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# P.419 File Locking |
207
|
|
|
|
|
|
|
# in Chapter 16: Interprocess Communication |
208
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# P.524 File Locking |
211
|
|
|
|
|
|
|
# in Chapter 15: Interprocess Communication |
212
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
# P.571 Handling Race Conditions |
215
|
|
|
|
|
|
|
# in Chapter 23: Security |
216
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# P.663 Handling Race Conditions |
219
|
|
|
|
|
|
|
# in Chapter 20: Security |
220
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# (and so on) |
223
|
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
0
|
CORE::eval q{ flock($fh, LOCK_EX | LOCK_NB) }; |
225
|
0
|
0
|
|
|
|
0
|
if ($@) { |
226
|
386
|
|
|
|
|
27116
|
die __FILE__, ": Can't immediately write-lock the file: $filename.e\n"; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
else { |
230
|
386
|
|
|
|
|
16980
|
CORE::eval q{ flock($fh, LOCK_EX) }; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
386
|
|
|
|
|
5156
|
CORE::eval q{ truncate($fh, 0) }; |
234
|
386
|
50
|
|
|
|
1569
|
seek($fh, 0, 0) or die __FILE__, ": Can't seek file: $filename.e\n"; |
235
|
|
|
|
|
|
|
|
236
|
386
|
|
|
|
|
990
|
my $e_script = Sjis::escape_script($filename); |
237
|
386
|
|
|
|
|
33098
|
print {$fh} $e_script; |
|
386
|
|
|
|
|
3706
|
|
238
|
|
|
|
|
|
|
|
239
|
386
|
|
|
|
|
13366
|
my $mode = (Esjis::stat($filename))[2] & 0777; |
240
|
386
|
|
|
|
|
3323
|
chmod $mode, "$filename.e"; |
241
|
|
|
|
|
|
|
|
242
|
0
|
50
|
|
|
|
0
|
if ($^O eq 'MacOS') { |
243
|
386
|
|
|
|
|
42343
|
CORE::eval q{ |
244
|
|
|
|
|
|
|
CORE::require Mac::Files; |
245
|
|
|
|
|
|
|
Mac::Files::FSpRstFLock("$filename.e"); |
246
|
|
|
|
|
|
|
}; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
386
|
50
|
|
|
|
2643
|
close($fh) or die "Can't close file: $filename.e: $!"; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
386
|
|
|
|
|
2973
|
my $fh = gensym(); |
253
|
386
|
50
|
|
|
|
3639
|
Esjis::_open_r($fh, "$filename.e") or die __FILE__, ": Can't read open file: $filename.e\n"; |
254
|
|
|
|
|
|
|
|
255
|
0
|
50
|
|
|
|
0
|
if (0) { |
|
|
50
|
|
|
|
|
|
256
|
|
|
|
|
|
|
} |
257
|
0
|
|
|
|
|
0
|
elsif ($^O eq 'MacOS') { |
258
|
0
|
|
|
|
|
0
|
CORE::eval q{ |
259
|
|
|
|
|
|
|
CORE::require Mac::Files; |
260
|
|
|
|
|
|
|
Mac::Files::FSpSetFLock("$filename.e"); |
261
|
|
|
|
|
|
|
}; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
elsif (exists $ENV{'CHAR_NONBLOCK'}) { |
264
|
0
|
|
|
|
|
0
|
CORE::eval q{ flock($fh, LOCK_SH | LOCK_NB) }; |
265
|
0
|
0
|
|
|
|
0
|
if ($@) { |
266
|
386
|
|
|
|
|
34816
|
die __FILE__, ": Can't immediately read-lock the file: $filename.e\n"; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
else { |
270
|
386
|
|
|
|
|
2237
|
CORE::eval q{ flock($fh, LOCK_SH) }; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
386
|
|
|
|
|
2846
|
my @switch = (); |
274
|
0
|
50
|
|
|
|
0
|
if ($^W) { |
275
|
386
|
|
|
|
|
1952
|
push @switch, '-w'; |
276
|
|
|
|
|
|
|
} |
277
|
0
|
50
|
|
|
|
0
|
if (defined $^I) { |
278
|
0
|
|
|
|
|
0
|
push @switch, '-i' . $^I; |
279
|
386
|
|
|
|
|
1220
|
undef $^I; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# P.707 29.2.33. exec |
283
|
|
|
|
|
|
|
# in Chapter 29: Functions |
284
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
285
|
|
|
|
|
|
|
# |
286
|
|
|
|
|
|
|
# If there is more than one argument in LIST, or if LIST is an array with more |
287
|
|
|
|
|
|
|
# than one value, the system shell will never be used. This also bypasses any |
288
|
|
|
|
|
|
|
# shell processing of the command. The presence or absence of metacharacters in |
289
|
|
|
|
|
|
|
# the arguments doesn't affect this list-triggered behavior, which makes it the |
290
|
|
|
|
|
|
|
# preferred from in security-conscious programs that do not with to expose |
291
|
|
|
|
|
|
|
# themselves to potential shell escapes. |
292
|
|
|
|
|
|
|
# Environment variable PERL5SHELL(Microsoft ports only) will never be used, too. |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# P.855 exec |
295
|
|
|
|
|
|
|
# in Chapter 27: Functions |
296
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
297
|
|
|
|
|
|
|
# |
298
|
|
|
|
|
|
|
# If there is more than one argument in LIST, or if LIST is an array with more |
299
|
|
|
|
|
|
|
# than one value, the system shell will never be used. This also bypasses any |
300
|
|
|
|
|
|
|
# shell processing of the command. The presence or absence of metacharacters in |
301
|
|
|
|
|
|
|
# the arguments doesn't affect this list-triggered behavior, which makes it the |
302
|
|
|
|
|
|
|
# preferred from in security-conscious programs that do not wish to expose |
303
|
|
|
|
|
|
|
# themselves to injection attacks via shell escapes. |
304
|
|
|
|
|
|
|
# Environment variable PERL5SHELL(Microsoft ports only) will never be used, too. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# P.489 #! and Quoting on Non-Unix Systems |
307
|
|
|
|
|
|
|
# in Chapter 19: The Command-Line Interface |
308
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# P.578 #! and Quoting on Non-Unix Systems |
311
|
|
|
|
|
|
|
# in Chapter 17: The Command-Line Interface |
312
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
313
|
|
|
|
|
|
|
|
314
|
386
|
|
|
|
|
3608
|
my $system = 0; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# DOS-like system |
317
|
0
|
50
|
|
|
|
0
|
if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) { |
|
|
50
|
|
|
|
|
|
318
|
|
|
|
|
|
|
$system = Esjis::_systemx( |
319
|
|
|
|
|
|
|
_escapeshellcmd_MSWin32($^X), |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# -I switch can not treat space included path |
322
|
|
|
|
|
|
|
# (map { '-I' . _escapeshellcmd_MSWin32($_) } @INC), |
323
|
0
|
|
|
|
|
0
|
(map { '-I' . $_ } @INC), |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
@switch, |
326
|
|
|
|
|
|
|
'--', |
327
|
0
|
|
|
|
|
0
|
map { _escapeshellcmd_MSWin32($_) } "$filename.e", @ARGV |
|
0
|
|
|
|
|
0
|
|
328
|
|
|
|
|
|
|
); |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# MacOS system |
332
|
|
|
|
|
|
|
elsif ($^O eq 'MacOS') { |
333
|
|
|
|
|
|
|
$system = Esjis::_systemx( |
334
|
|
|
|
|
|
|
_escapeshellcmd_MacOS($^X), |
335
|
0
|
|
|
|
|
0
|
(map { '-I' . _escapeshellcmd_MacOS($_) } @INC), |
336
|
|
|
|
|
|
|
@switch, |
337
|
|
|
|
|
|
|
'--', |
338
|
0
|
|
|
|
|
0
|
map { _escapeshellcmd_MacOS($_) } "$filename.e", @ARGV |
|
0
|
|
|
|
|
0
|
|
339
|
|
|
|
|
|
|
); |
340
|
386
|
|
|
|
|
1946
|
CORE::eval q{ |
341
|
|
|
|
|
|
|
CORE::require Mac::Files; |
342
|
|
|
|
|
|
|
Mac::Files::FSpRstFLock("$filename.e"); |
343
|
|
|
|
|
|
|
}; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# UNIX-like system |
347
|
|
|
|
|
|
|
else { |
348
|
|
|
|
|
|
|
$system = Esjis::_systemx( |
349
|
|
|
|
|
|
|
_escapeshellcmd($^X), |
350
|
386
|
|
|
|
|
1376
|
(map { '-I' . _escapeshellcmd($_) } @INC), |
351
|
|
|
|
|
|
|
@switch, |
352
|
|
|
|
|
|
|
'--', |
353
|
4632
|
|
|
|
|
6578
|
map { _escapeshellcmd($_) } "$filename.e", @ARGV |
|
386
|
|
|
|
|
748755
|
|
354
|
|
|
|
|
|
|
); |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# exit with actual exit value |
358
|
0
|
|
|
|
|
0
|
exit($system >> 8); |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
# escape shell command line on DOS-like system |
362
|
|
|
|
|
|
|
sub _escapeshellcmd_MSWin32 { |
363
|
0
|
|
|
0
|
|
0
|
my($word) = @_; |
364
|
0
|
0
|
|
|
|
0
|
if ($word =~ / [ ] /oxms) { |
365
|
0
|
|
|
|
|
0
|
return qq{"$word"}; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
else { |
368
|
0
|
|
|
|
|
0
|
return $word; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# escape shell command line on Mac OS |
373
|
|
|
|
|
|
|
sub _escapeshellcmd_MacOS { |
374
|
0
|
|
|
0
|
|
0
|
my($word) = @_; |
375
|
5404
|
|
|
|
|
8512
|
return $word; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
# escape shell command line on UNIX-like system |
379
|
|
|
|
|
|
|
sub _escapeshellcmd { |
380
|
5404
|
|
|
5404
|
|
14707
|
my($word) = @_; |
381
|
386
|
|
|
|
|
1020
|
return $word; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# P.619 Source Filters |
385
|
|
|
|
|
|
|
# in Chapter 24: Common Practices |
386
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# P.718 Source Filters |
389
|
|
|
|
|
|
|
# in Chapter 21: Common Practices |
390
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# escape ShiftJIS script |
393
|
|
|
|
|
|
|
sub Sjis::escape_script { |
394
|
386
|
|
|
386
|
0
|
734
|
my($script) = @_; |
395
|
386
|
|
|
|
|
998
|
my $e_script = ''; |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
# read ShiftJIS script |
398
|
386
|
|
|
|
|
1601
|
my $fh = gensym(); |
399
|
386
|
50
|
|
|
|
2253
|
Esjis::_open_r($fh, $script) or die __FILE__, ": Can't open file: $script\n"; |
400
|
386
|
|
|
|
|
8539
|
local $/ = undef; # slurp mode |
401
|
386
|
|
|
|
|
4649
|
$_ = <$fh>; |
402
|
386
|
50
|
|
|
|
2261
|
close($fh) or die "Can't close file: $script: $!"; |
403
|
|
|
|
|
|
|
|
404
|
0
|
50
|
|
|
|
0
|
if (/^ use Esjis(?:(?>\s+)(?>[0-9\.]*))?(?>\s*); $/oxms) { |
405
|
386
|
|
|
|
|
2301
|
return $_; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
else { |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
# #! shebang line |
410
|
0
|
50
|
|
|
|
0
|
if (s/\A(#!.+?\n)//oms) { |
411
|
0
|
|
|
|
|
0
|
my $head = $1; |
412
|
0
|
|
|
|
|
0
|
$head =~ s/\bjperl\b/perl/gi; |
413
|
386
|
|
|
|
|
1156
|
$e_script .= $head; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# DOS-like system header |
417
|
0
|
50
|
|
|
|
0
|
if (s/\A(\@rem(?>\s*)=(?>\s*)'.*?'(?>\s*);\s*\n)//oms) { |
418
|
0
|
|
|
|
|
0
|
my $head = $1; |
419
|
0
|
|
|
|
|
0
|
$head =~ s/\bjperl\b/perl/gi; |
420
|
386
|
|
|
|
|
15880
|
$e_script .= $head; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# P.618 Generating Perl in Other Languages |
424
|
|
|
|
|
|
|
# in Chapter 24: Common Practices |
425
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# P.717 Generating Perl in Other Languages |
428
|
|
|
|
|
|
|
# in Chapter 21: Common Practices |
429
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
430
|
|
|
|
|
|
|
|
431
|
0
|
50
|
|
|
|
0
|
if (s/(.*^#(?>\s*)line(?>\s+)(?>[0-9]+)(?:(?>\s+)"(?:$q_char)+?")?\s*\n)//oms) { |
432
|
0
|
|
|
|
|
0
|
my $head = $1; |
433
|
0
|
|
|
|
|
0
|
$head =~ s/\bjperl\b/perl/gi; |
434
|
386
|
|
|
|
|
2394
|
$e_script .= $head; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
# P.210 5.10.3.3. Match-time code evaluation |
438
|
|
|
|
|
|
|
# in Chapter 5: Pattern Matching |
439
|
|
|
|
|
|
|
# of ISBN 0-596-00027-8 Programming Perl Third Edition. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# P.255 Match-time code evaluation |
442
|
|
|
|
|
|
|
# in Chapter 5: Pattern Matching |
443
|
|
|
|
|
|
|
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
# '...' quote to avoid "Octal number in vector unsupported" on perl 5.6 |
446
|
|
|
|
|
|
|
|
447
|
386
|
|
|
|
|
5058
|
$e_script .= sprintf("use Esjis '%s.0'; # 'quote' for perl5.6\n", $Sjis::VERSION); # require run-time routines version |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
# use Sjis version qw(ord reverse getc); |
450
|
386
|
50
|
|
|
|
1171
|
if (s/^ (?>\s*) use (?>\s+) (?: Char | Sjis ) (?>\s*) ([^\x81-\x9F\xE0-\xFC;]*) ; \s* \n? $//oxms) { |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# require version |
453
|
386
|
|
|
|
|
1508
|
my $list = $1; |
454
|
0
|
50
|
|
|
|
0
|
if ($list =~ s/\A ((?>[0-9]+)\.(?>[0-9]+)) \.0 (?>\s*) //oxms) { |
|
|
50
|
|
|
|
|
|
455
|
0
|
|
|
|
|
0
|
my $version = $1; |
456
|
0
|
0
|
|
|
|
0
|
if ($version ne $Sjis::VERSION) { |
457
|
0
|
|
|
|
|
0
|
my @file = grep -e, map {qq{$_/Sjis.pm}} @INC; |
|
0
|
|
|
|
|
0
|
|
458
|
0
|
|
|
|
|
0
|
my %file = map { $_ => 1 } @file; |
|
0
|
|
|
|
|
0
|
|
459
|
0
|
0
|
|
|
|
0
|
if (scalar(keys %file) >= 2) { |
460
|
0
|
|
|
|
|
0
|
my $file = join "\n", sort keys %file; |
461
|
0
|
|
|
|
|
0
|
warn <
|
462
|
|
|
|
|
|
|
**************************************************** |
463
|
|
|
|
|
|
|
C A U T I O N |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
CONFLICT Sjis.pm FILE |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
$file |
468
|
|
|
|
|
|
|
**************************************************** |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
END |
471
|
|
|
|
|
|
|
} |
472
|
0
|
|
|
|
|
0
|
die "Script $0 expects Sjis.pm $version, but @{[__FILE__]} is version $Sjis::VERSION\n"; |
|
0
|
|
|
|
|
0
|
|
473
|
|
|
|
|
|
|
} |
474
|
0
|
|
|
|
|
0
|
$e_script .= qq{die "Script \$0 expects Esjis.pm $version, but \\\$Esjis::VERSION is \$Esjis::VERSION" if \$Esjis::VERSION ne '$version';\n}; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
elsif ($list =~ s/\A ((?>[0-9]+)(?>\.[0-9]*)) (?>\s*) //oxms) { |
477
|
0
|
|
|
|
|
0
|
my $version = $1; |
478
|
0
|
0
|
|
|
|
0
|
if ($version > $Sjis::VERSION) { |
479
|
0
|
|
|
|
|
0
|
die "Script $0 required Sjis.pm $version, but @{[__FILE__]} is only version $Sjis::VERSION\n"; |
|
386
|
|
|
|
|
1879
|
|
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# demand ord, reverse, and getc |
484
|
0
|
50
|
|
|
|
0
|
if ($list !~ /\A (?>\s*) \z/oxms) { |
485
|
0
|
|
|
|
|
0
|
local $@; |
486
|
0
|
|
|
|
|
0
|
my @list = CORE::eval $list; |
487
|
0
|
|
|
|
|
0
|
for (@list) { |
488
|
0
|
0
|
|
|
|
0
|
$Esjis::function_ord = 'Sjis::ord' if /\A ord \z/oxms; |
489
|
0
|
0
|
|
|
|
0
|
$Esjis::function_ord_ = 'Sjis::ord_' if /\A ord \z/oxms; |
490
|
0
|
0
|
|
|
|
0
|
$Esjis::function_reverse = 'Sjis::reverse' if /\A reverse \z/oxms; |
491
|
0
|
0
|
|
|
|
0
|
$Esjis::function_getc = 'Sjis::getc' if /\A getc \z/oxms; |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# avoid: used only once: possible typo at ... |
494
|
0
|
|
|
|
|
0
|
$Esjis::function_ord = $Esjis::function_ord; |
495
|
0
|
|
|
|
|
0
|
$Esjis::function_ord_ = $Esjis::function_ord_; |
496
|
0
|
|
|
|
|
0
|
$Esjis::function_reverse = $Esjis::function_reverse; |
497
|
386
|
|
|
|
|
1706
|
$Esjis::function_getc = $Esjis::function_getc; |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
|
503
|
386
|
|
|
|
|
4152
|
$e_script .= Sjis::escape(); |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
return $e_script; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
1; |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
__END__ |