/
usr
/
bin
/
/usr/bin
mkdir
upload
Name
Size
Mode
Actions
aclocal
36376
0755
edit
dl
rm
aclocal-1.16
36376
0755
edit
dl
rm
addr2line
28408
0755
edit
dl
rm
agentxtrap
27960
0755
edit
dl
rm
animate
15456
0755
edit
dl
rm
ar
57328
0755
edit
dl
rm
arch
32224
0755
edit
dl
rm
arpaname
15472
0755
edit
dl
rm
as
727360
0755
edit
dl
rm
aspell
154744
0755
edit
dl
rm
at
6009
0755
edit
dl
rm
atq
6011
0755
edit
dl
rm
atrm
6013
0755
edit
dl
rm
autoconf
14771
0755
edit
dl
rm
autoheader
8534
0755
edit
dl
rm
autom4te
32181
0755
edit
dl
rm
automake
257981
0755
edit
dl
rm
automake-1.16
257981
0755
edit
dl
rm
autoreconf
21066
0755
edit
dl
rm
autoscan
17124
0755
edit
dl
rm
autoupdate
33872
0755
edit
dl
rm
awk
714928
0755
edit
dl
rm
b2sum
52832
0755
edit
dl
rm
base32
36344
0755
edit
dl
rm
base64
36344
0755
edit
dl
rm
basename
32240
0755
edit
dl
rm
basenc
48976
0755
edit
dl
rm
bash
1389024
0755
edit
dl
rm
bashbug-64
7079
0755
edit
dl
rm
batch
140
0755
edit
dl
rm
bison
506632
0755
edit
dl
rm
bunzip2
40392
0755
edit
dl
rm
bzcat
40392
0755
edit
dl
rm
bzcmp
2144
0755
edit
dl
rm
bzdiff
2144
0755
edit
dl
rm
bzgrep
2058
0755
edit
dl
rm
bzip2
40392
0755
edit
dl
rm
bzip2recover
15592
0755
edit
dl
rm
bzless
1263
0755
edit
dl
rm
bzmore
1263
0755
edit
dl
rm
c++
1097224
0755
edit
dl
rm
c++filt
27840
0755
edit
dl
rm
c89
228
0755
edit
dl
rm
c99
219
0755
edit
dl
rm
cagefs_enter.proxied
6029
0755
edit
dl
rm
cal
53064
0755
edit
dl
rm
captoinfo
89896
0755
edit
dl
rm
cat
36312
0755
edit
dl
rm
catchsegv
3289
0755
edit
dl
rm
cc
1093128
0755
edit
dl
rm
chcon
61488
0755
edit
dl
rm
chgrp
57320
0755
edit
dl
rm
chmod
57304
0755
edit
dl
rm
chown
61432
0755
edit
dl
rm
chrt
27960
0755
edit
dl
rm
cksum
32136
0755
edit
dl
rm
cldetect
11222
0755
edit
dl
rm
clear
15512
0755
edit
dl
rm
cloudlinux-awp-user
1818
0755
edit
dl
rm
clwpos-user
1818
0755
edit
dl
rm
cmp
41096
0755
edit
dl
rm
col
23792
0755
edit
dl
rm
colcrt
15552
0755
edit
dl
rm
colrm
15528
0755
edit
dl
rm
column
36184
0755
edit
dl
rm
comm
36408
0755
edit
dl
rm
compare
15456
0755
edit
dl
rm
composite
15456
0755
edit
dl
rm
conjure
15464
0755
edit
dl
rm
convert
15464
0755
edit
dl
rm
cp
144400
0755
edit
dl
rm
cpan
8571
0755
edit
dl
rm
cpp
1097224
0755
edit
dl
rm
crontab
5826
0755
edit
dl
rm
crontab.cagefs
41440
0755
edit
dl
rm
csplit
111272
0755
edit
dl
rm
curl
254456
0755
edit
dl
rm
cut
44656
0755
edit
dl
rm
cyrusbdb2current
1651824
0755
edit
dl
rm
date
106336
0755
edit
dl
rm
dbiprof
6206
0755
edit
dl
rm
dd
69576
0755
edit
dl
rm
delv
45544
0755
edit
dl
rm
df
82464
0755
edit
dl
rm
diff
199368
0755
edit
dl
rm
diff3
53560
0755
edit
dl
rm
dig
139872
0755
edit
dl
rm
dir
140752
0755
edit
dl
rm
dircolors
40568
0755
edit
dl
rm
dirname
27952
0755
edit
dl
rm
display
15456
0755
edit
dl
rm
dnstap-read
23744
0755
edit
dl
rm
du
152848
0755
edit
dl
rm
echo
27944
0755
edit
dl
rm
ed
53768
0755
edit
dl
rm
egrep
32
0755
edit
dl
rm
enc2xs
41663
0755
edit
dl
rm
enchant
24296
0755
edit
dl
rm
enchant-lsmod
16184
0755
edit
dl
rm
env
45088
0755
edit
dl
rm
eps2eps
643
0755
edit
dl
rm
eqn
194064
0755
edit
dl
rm
ex
1452256
0755
edit
dl
rm
expand
40488
0755
edit
dl
rm
expr
111040
0755
edit
dl
rm
factor
73592
0755
edit
dl
rm
false
27936
0755
edit
dl
rm
fc-cache
139
0755
edit
dl
rm
fc-cache-64
23728
0755
edit
dl
rm
fc-cat
19616
0755
edit
dl
rm
fc-conflist
15496
0755
edit
dl
rm
fc-list
15496
0755
edit
dl
rm
fc-match
15496
0755
edit
dl
rm
fc-pattern
15504
0755
edit
dl
rm
fc-query
15496
0755
edit
dl
rm
fc-scan
15504
0755
edit
dl
rm
fc-validate
15504
0755
edit
dl
rm
fgrep
32
0755
edit
dl
rm
file
28288
0755
edit
dl
rm
find
291792
0755
edit
dl
rm
flex
422544
0755
edit
dl
rm
flex++
422544
0755
edit
dl
rm
flock
23928
0755
edit
dl
rm
fmt
40528
0755
edit
dl
rm
fold
40456
0755
edit
dl
rm
free
23920
0755
edit
dl
rm
freetype-config
4423
0755
edit
dl
rm
funzip
32000
0755
edit
dl
rm
g++
1097224
0755
edit
dl
rm
gawk
714928
0755
edit
dl
rm
gcc
1093128
0755
edit
dl
rm
gcc-ar
28336
0755
edit
dl
rm
gcc-nm
28312
0755
edit
dl
rm
gcc-ranlib
28336
0755
edit
dl
rm
gcov
488576
0755
edit
dl
rm
gcov-dump
298768
0755
edit
dl
rm
gcov-tool
328160
0755
edit
dl
rm
gencat
28104
0755
edit
dl
rm
geoiplookup
16248
0755
edit
dl
rm
geoiplookup6
16200
0755
edit
dl
rm
geqn
194064
0755
edit
dl
rm
GET
16200
0755
edit
dl
rm
getconf
36080
0755
edit
dl
rm
getent
36720
0755
edit
dl
rm
getopt
23824
0755
edit
dl
rm
ghostscript
15488
0755
edit
dl
rm
git
4397352
0755
edit
dl
rm
git-receive-pack
4397352
0755
edit
dl
rm
git-shell
826960
0755
edit
dl
rm
git-upload-archive
4397352
0755
edit
dl
rm
git-upload-pack
4397352
0755
edit
dl
rm
gm
16048
0755
edit
dl
rm
gmake
255792
0755
edit
dl
rm
gneqn
916
0755
edit
dl
rm
gnroff
3285
0755
edit
dl
rm
gpg
1123624
0755
edit
dl
rm
gpg-agent
350488
0755
edit
dl
rm
gpg-error
36968
0755
edit
dl
rm
gpgsplit
28160
0755
edit
dl
rm
gpgv
302520
0755
edit
dl
rm
gpic
206560
0755
edit
dl
rm
gprof
103920
0755
edit
dl
rm
grep
158200
0755
edit
dl
rm
groff
99088
0755
edit
dl
rm
grops
171272
0755
edit
dl
rm
grotty
125128
0755
edit
dl
rm
groups
36328
0755
edit
dl
rm
gs
15488
0755
edit
dl
rm
gsnd
281
0755
edit
dl
rm
gsoelim
-
0
edit
dl
rm
gtar
534824
0755
edit
dl
rm
gtbl
134000
0755
edit
dl
rm
gtroff
749640
0755
edit
dl
rm
gunzip
2350
0755
edit
dl
rm
gzexe
6484
0755
edit
dl
rm
gzip
91088
0755
edit
dl
rm
h2ph
29382
0755
edit
dl
rm
h2xs
60931
0755
edit
dl
rm
head
40560
0755
edit
dl
rm
hexdump
52640
0755
edit
dl
rm
host
111176
0755
edit
dl
rm
hostid
32224
0755
edit
dl
rm
hostname
24408
0755
edit
dl
rm
hunspell
105136
0755
edit
dl
rm
iconv
65624
0755
edit
dl
rm
icu-config
205
0755
edit
dl
rm
icu-config-64
22189
0755
edit
dl
rm
icuinfo
15864
0755
edit
dl
rm
id
40472
0755
edit
dl
rm
identify
15464
0755
edit
dl
rm
idn
36664
0755
edit
dl
rm
ifnames
4128
0755
edit
dl
rm
import
15456
0755
edit
dl
rm
infocmp
65208
0755
edit
dl
rm
infotocap
89896
0755
edit
dl
rm
install
152656
0755
edit
dl
rm
instmodsh
4194
0755
edit
dl
rm
ionice
15576
0755
edit
dl
rm
ipcrm
19688
0755
edit
dl
rm
ipcs
40280
0755
edit
dl
rm
isosize
15512
0755
edit
dl
rm
ispell
992
0755
edit
dl
rm
join
52928
0755
edit
dl
rm
kill
32032
0755
edit
dl
rm
ld
1791600
0755
edit
dl
rm
ld.bfd
1791600
0755
edit
dl
rm
ldd
5446
0755
edit
dl
rm
less
202440
0755
edit
dl
rm
lessecho
15536
0755
edit
dl
rm
lesskey
25200
0755
edit
dl
rm
lesspipe.sh
3580
0755
edit
dl
rm
lex
422544
0755
edit
dl
rm
libnetcfg
15775
0755
edit
dl
rm
libtool
367802
0755
edit
dl
rm
libtoolize
129200
0755
edit
dl
rm
link
32232
0755
edit
dl
rm
ln
57288
0755
edit
dl
rm
locale
60496
0755
edit
dl
rm
localedef
321584
0755
edit
dl
rm
logger
36840
0755
edit
dl
rm
login
44504
0755
edit
dl
rm
logname
32224
0755
edit
dl
rm
look
19632
0755
edit
dl
rm
ls
140744
0755
edit
dl
rm
lto-dump
27882568
0755
edit
dl
rm
m4
246168
0755
edit
dl
rm
Mail
-
0
edit
dl
rm
mail
-
0
edit
dl
rm
mailx
-
0
edit
dl
rm
make
255792
0755
edit
dl
rm
make-dummy-cert
614
0755
edit
dl
rm
mariadb
5246200
0755
edit
dl
rm
mariadb-access
111961
0755
edit
dl
rm
mariadb-admin
5013392
0755
edit
dl
rm
mariadb-binlog
5303232
0755
edit
dl
rm
mariadb-check
5010424
0755
edit
dl
rm
mariadb-conv
4731024
0755
edit
dl
rm
mariadb-convert-table-format
4220
0755
edit
dl
rm
mariadb-dump
5107000
0755
edit
dl
rm
mariadb-dumpslow
8242
0755
edit
dl
rm
mariadb-embedded
24373096
0755
edit
dl
rm
mariadb-find-rows
3290
0755
edit
dl
rm
mariadb-hotcopy
35359
0755
edit
dl
rm
mariadb-import
5005256
0755
edit
dl
rm
mariadb-plugin
4705784
0755
edit
dl
rm
mariadb-secure-installation
13803
0755
edit
dl
rm
mariadb-setpermission
17977
0755
edit
dl
rm
mariadb-show
5003656
0755
edit
dl
rm
mariadb-slap
5023200
0755
edit
dl
rm
mariadb-tzinfo-to-sql
4709208
0755
edit
dl
rm
mariadb-waitpid
4696504
0755
edit
dl
rm
mcookie
27960
0755
edit
dl
rm
md5sum
40392
0755
edit
dl
rm
mesg
15504
0755
edit
dl
rm
mkdir
69760
0755
edit
dl
rm
mkfifo
40592
0755
edit
dl
rm
mknod
44728
0755
edit
dl
rm
mktemp
40568
0755
edit
dl
rm
mogrify
15464
0755
edit
dl
rm
montage
15464
0755
edit
dl
rm
more
44464
0755
edit
dl
rm
msql2mysql
1450
0755
edit
dl
rm
mv
144328
0755
edit
dl
rm
mysql
5246200
0755
edit
dl
rm
mysqlaccess
111961
0755
edit
dl
rm
mysqladmin
5013392
0755
edit
dl
rm
mysqlbinlog
5303232
0755
edit
dl
rm
mysqlcheck
5010424
0755
edit
dl
rm
mysqldump
5107000
0755
edit
dl
rm
mysqlimport
5005256
0755
edit
dl
rm
mysqlshow
5003656
0755
edit
dl
rm
mysql_config
4608
0755
edit
dl
rm
mysql_find_rows
3290
0755
edit
dl
rm
mysql_waitpid
4696504
0755
edit
dl
rm
mytop
73757
0755
edit
dl
rm
my_print_defaults
4697008
0755
edit
dl
rm
namei
23784
0755
edit
dl
rm
nano
354504
0755
edit
dl
rm
neqn
916
0755
edit
dl
rm
net-snmp-create-v3-user
3371
0755
edit
dl
rm
nice
36336
0755
edit
dl
rm
nl
102920
0755
edit
dl
rm
nm
45792
0755
edit
dl
rm
nohup
36248
0755
edit
dl
rm
nproc
36352
0755
edit
dl
rm
nroff
3285
0755
edit
dl
rm
nslookup
115224
0755
edit
dl
rm
nsupdate
73528
0755
edit
dl
rm
numfmt
56968
0755
edit
dl
rm
objcopy
189816
0755
edit
dl
rm
objdump
423000
0755
edit
dl
rm
od
65408
0755
edit
dl
rm
openssl
1122472
0755
edit
dl
rm
pango-list
19568
0755
edit
dl
rm
pango-segmentation
19584
0755
edit
dl
rm
pango-view
61616
0755
edit
dl
rm
passwd
6017
0755
edit
dl
rm
paste
36240
0755
edit
dl
rm
patch
199696
0755
edit
dl
rm
pathchk
36328
0755
edit
dl
rm
pdf2dsc
701
0755
edit
dl
rm
pdf2ps
913
0755
edit
dl
rm
perl
15488
0755
edit
dl
rm
perl5.32.1
15488
0755
edit
dl
rm
perlbug
44863
0755
edit
dl
rm
perldoc
118
0755
edit
dl
rm
perlivp
10813
0755
edit
dl
rm
perlml
14840
0755
edit
dl
rm
perlthanks
44863
0755
edit
dl
rm
pgrep
32176
0755
edit
dl
rm
php
937
0755
edit
dl
rm
pic
206560
0755
edit
dl
rm
piconv
8271
0755
edit
dl
rm
ping
91472
0755
edit
dl
rm
pinky
36264
0755
edit
dl
rm
pkg-config
335
0755
edit
dl
rm
pkill
32176
0755
edit
dl
rm
pl2pm
4533
0755
edit
dl
rm
pmap
36240
0755
edit
dl
rm
pod2html
4134
0755
edit
dl
rm
pod2man
15034
0755
edit
dl
rm
pod2text
10803
0755
edit
dl
rm
pod2usage
4107
0755
edit
dl
rm
podchecker
3658
0755
edit
dl
rm
post-grohtml
204552
0755
edit
dl
rm
pr
73832
0755
edit
dl
rm
pre-grohtml
95152
0755
edit
dl
rm
precat
5660
0755
edit
dl
rm
preunzip
5660
0755
edit
dl
rm
prezip
5660
0755
edit
dl
rm
prezip-bin
16064
0755
edit
dl
rm
printenv
32040
0755
edit
dl
rm
printf
52816
0755
edit
dl
rm
prove
13562
0755
edit
dl
rm
ps
144536
0755
edit
dl
rm
ps2ascii
635
0755
edit
dl
rm
ps2epsi
1268
0755
edit
dl
rm
ps2pdf
276
0755
edit
dl
rm
ps2pdf12
219
0755
edit
dl
rm
ps2pdf13
219
0755
edit
dl
rm
ps2pdf14
219
0755
edit
dl
rm
ps2pdfwr
1082
0755
edit
dl
rm
ps2ps
651
0755
edit
dl
rm
ps2ps2
673
0755
edit
dl
rm
ptx
131912
0755
edit
dl
rm
pwd
36376
0755
edit
dl
rm
pwdx
15648
0755
edit
dl
rm
pydoc
78
0755
edit
dl
rm
pydoc3
78
0755
edit
dl
rm
pydoc3.9
78
0755
edit
dl
rm
ranlib
57336
0755
edit
dl
rm
readelf
683296
0755
edit
dl
rm
readlink
40456
0755
edit
dl
rm
realpath
40536
0755
edit
dl
rm
recode
32696
0755
edit
dl
rm
red
92
0755
edit
dl
rm
rename
23784
0755
edit
dl
rm
renew-dummy-cert
729
0755
edit
dl
rm
renice
15528
0755
edit
dl
rm
replace
4679032
0755
edit
dl
rm
reset
27992
0755
edit
dl
rm
rev
15520
0755
edit
dl
rm
rm
61432
0755
edit
dl
rm
rmdir
44464
0755
edit
dl
rm
rnano
354504
0755
edit
dl
rm
run-with-aspell
89
0755
edit
dl
rm
runcon
36312
0755
edit
dl
rm
rvi
1452256
0755
edit
dl
rm
rview
1452256
0755
edit
dl
rm
scalar
876968
0755
edit
dl
rm
scl
40496
0755
edit
dl
rm
scl_enabled
262
0755
edit
dl
rm
scl_source
1929
0755
edit
dl
rm
scp
136104
0755
edit
dl
rm
script
52816
0755
edit
dl
rm
sdiff
45264
0755
edit
dl
rm
sed
115544
0755
edit
dl
rm
selectorctl
8276
0755
edit
dl
rm
seq
48736
0755
edit
dl
rm
setsid
15512
0755
edit
dl
rm
setterm
36176
0755
edit
dl
rm
sftp
160840
0755
edit
dl
rm
sh
1389024
0755
edit
dl
rm
sha1sum
40392
0755
edit
dl
rm
sha224sum
40392
0755
edit
dl
rm
sha256sum
40392
0755
edit
dl
rm
sha384sum
40392
0755
edit
dl
rm
sha512sum
40392
0755
edit
dl
rm
shred
52920
0755
edit
dl
rm
shuf
48952
0755
edit
dl
rm
size
32368
0755
edit
dl
rm
skill
32152
0755
edit
dl
rm
slabtop
23984
0755
edit
dl
rm
sleep
32224
0755
edit
dl
rm
snice
32152
0755
edit
dl
rm
snmpconf
26051
0755
edit
dl
rm
soelim
-
0
edit
dl
rm
sort
115608
0755
edit
dl
rm
spell
125
0755
edit
dl
rm
splain
19411
0755
edit
dl
rm
split
53360
0755
edit
dl
rm
sprof
36296
0755
edit
dl
rm
sqlite3
1610224
0755
edit
dl
rm
ssh
917880
0755
edit
dl
rm
ssh-add
313056
0755
edit
dl
rm
ssh-agent
325320
0755
edit
dl
rm
ssh-copy-id
14174
0755
edit
dl
rm
ssh-keygen
486832
0755
edit
dl
rm
ssh-keyscan
346352
0755
edit
dl
rm
stat
81768
0755
edit
dl
rm
stdbuf
44600
0755
edit
dl
rm
strace
2176664
0755
edit
dl
rm
stream
15456
0755
edit
dl
rm
strings
32504
0755
edit
dl
rm
strip
189808
0755
edit
dl
rm
stty
77456
0755
edit
dl
rm
sum
36232
0755
edit
dl
rm
sync
36200
0755
edit
dl
rm
tabs
19624
0755
edit
dl
rm
tac
102808
0755
edit
dl
rm
tail
69536
0755
edit
dl
rm
tar
534824
0755
edit
dl
rm
taskset
23784
0755
edit
dl
rm
tbl
134000
0755
edit
dl
rm
tclsh
16064
0755
edit
dl
rm
tclsh8.6
16064
0755
edit
dl
rm
tee
36344
0755
edit
dl
rm
test
44664
0755
edit
dl
rm
tic
89896
0755
edit
dl
rm
timeout
36848
0755
edit
dl
rm
tload
19800
0755
edit
dl
rm
tmpwatch
36896
0755
edit
dl
rm
toe
23784
0755
edit
dl
rm
top
135448
0755
edit
dl
rm
touch
94048
0755
edit
dl
rm
tput
27904
0755
edit
dl
rm
tr
44728
0755
edit
dl
rm
troff
749640
0755
edit
dl
rm
true
27936
0755
edit
dl
rm
truncate
36328
0755
edit
dl
rm
tset
27992
0755
edit
dl
rm
tsort
48744
0755
edit
dl
rm
tty
32224
0755
edit
dl
rm
tzselect
15352
0755
edit
dl
rm
uapi
6013
0755
edit
dl
rm
ul
23816
0755
edit
dl
rm
uname
32232
0755
edit
dl
rm
unexpand
40480
0755
edit
dl
rm
uniq
44680
0755
edit
dl
rm
unlink
32224
0755
edit
dl
rm
unzip
200688
0755
edit
dl
rm
unzipsfx
89808
0755
edit
dl
rm
uptime
15656
0755
edit
dl
rm
users
32256
0755
edit
dl
rm
utmpdump
23768
0755
edit
dl
rm
vdir
140752
0755
edit
dl
rm
vi
1452256
0755
edit
dl
rm
view
146
0755
edit
dl
rm
vmstat
40360
0755
edit
dl
rm
watch
28536
0755
edit
dl
rm
wc
44576
0755
edit
dl
rm
wget
533720
0755
edit
dl
rm
whereis
32608
0755
edit
dl
rm
which
28560
0755
edit
dl
rm
who
52832
0755
edit
dl
rm
whoami
32224
0755
edit
dl
rm
word-list-compress
16080
0755
edit
dl
rm
x86_64-redhat-linux-c++
1097224
0755
edit
dl
rm
x86_64-redhat-linux-g++
1097224
0755
edit
dl
rm
x86_64-redhat-linux-gcc
1093128
0755
edit
dl
rm
x86_64-redhat-linux-gcc-11
1093128
0755
edit
dl
rm
xargs
65632
0755
edit
dl
rm
xmlcatalog
23712
0755
edit
dl
rm
xmllint
82488
0755
edit
dl
rm
xmlwf
40576
0755
edit
dl
rm
xsltproc
31984
0755
edit
dl
rm
xsubpp
5080
0755
edit
dl
rm
yes
32064
0755
edit
dl
rm
zcat
1988
0755
edit
dl
rm
zcmp
1682
0755
edit
dl
rm
zdiff
6451
0755
edit
dl
rm
zegrep
33
0755
edit
dl
rm
zfgrep
33
0755
edit
dl
rm
zforce
2085
0755
edit
dl
rm
zgrep
8116
0755
edit
dl
rm
zip
226400
0755
edit
dl
rm
zipcloak
77512
0755
edit
dl
rm
zipgrep
2957
0755
edit
dl
rm
zipinfo
200688
0755
edit
dl
rm
zipnote
69232
0755
edit
dl
rm
zipsplit
65104
0755
edit
dl
rm
zless
2210
0755
edit
dl
rm
zmore
1846
0755
edit
dl
rm
znew
4581
0755
edit
dl
rm
zsoelim
-
0
edit
dl
rm
[
52872
0755
edit
dl
rm
Edit:
/usr/bin/enc2xs
(41663B)
#!/usr/bin/perl BEGIN { # @INC poking no longer needed w/ new MakeMaker and Makefile.PL's # with $ENV{PERL_CORE} set # In case we need it in future... require Config; import Config; pop @INC if $INC[-1] eq '.'; } use strict; use warnings; use Getopt::Std; use Config; my @orig_ARGV = @ARGV; our $VERSION = do { my @r = (q$Revision: 2.23 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # These may get re-ordered. # RAW is a do_now as inserted by &enter # AGG is an aggregated do_now, as built up by &process use constant { RAW_NEXT => 0, RAW_IN_LEN => 1, RAW_OUT_BYTES => 2, RAW_FALLBACK => 3, AGG_MIN_IN => 0, AGG_MAX_IN => 1, AGG_OUT_BYTES => 2, AGG_NEXT => 3, AGG_IN_LEN => 4, AGG_OUT_LEN => 5, AGG_FALLBACK => 6, }; # (See the algorithm in encengine.c - we're building structures for it) # There are two sorts of structures. # "do_now" (an array, two variants of what needs storing) is whatever we need # to do now we've read an input byte. # It's housed in a "do_next" (which is how we got to it), and in turn points # to a "do_next" which contains all the "do_now"s for the next input byte. # There will be a "do_next" which is the start state. # For a single byte encoding it's the only "do_next" - each "do_now" points # back to it, and each "do_now" will cause bytes. There is no state. # For a multi-byte encoding where all characters in the input are the same # length, then there will be a tree of "do_now"->"do_next"->"do_now" # branching out from the start state, one step for each input byte. # The leaf "do_now"s will all be at the same distance from the start state, # only the leaf "do_now"s cause output bytes, and they in turn point back to # the start state. # For an encoding where there are variable length input byte sequences, you # will encounter a leaf "do_now" sooner for the shorter input sequences, but # as before the leaves will point back to the start state. # The system will cope with escape encodings (imagine them as a mostly # self-contained tree for each escape state, and cross links between trees # at the state-switching characters) but so far no input format defines these. # The system will also cope with having output "leaves" in the middle of # the bifurcating branches, not just at the extremities, but again no # input format does this yet. # There are two variants of the "do_now" structure. The first, smaller variant # is generated by &enter as the input file is read. There is one structure # for each input byte. Say we are mapping a single byte encoding to a # single byte encoding, with "ABCD" going "abcd". There will be # 4 "do_now"s, {"A" => [...,"a",...], "B" => [...,"b",...], "C"=>..., "D"=>...} # &process then walks the tree, building aggregate "do_now" structures for # adjacent bytes where possible. The aggregate is for a contiguous range of # bytes which each produce the same length of output, each move to the # same next state, and each have the same fallback flag. # So our 4 RAW "do_now"s above become replaced by a single structure # containing: # ["A", "D", "abcd", 1, ...] # ie, for an input byte $_ in "A".."D", output 1 byte, found as # substr ("abcd", (ord $_ - ord "A") * 1, 1) # which maps very nicely into pointer arithmetic in C for encengine.c sub encode_U { # UTF-8 encode long hand - only covers part of perl's range ## my $uv = shift; # chr() works in native space so convert value from table # into that space before using chr(). my $ch = chr(utf8::unicode_to_native($_[0])); # Now get core perl to encode that the way it likes. utf8::encode($ch); return $ch; } sub encode_S { # encode single byte ## my ($ch,$page) = @_; return chr($ch); return chr $_[0]; } sub encode_D { # encode double byte MS byte first ## my ($ch,$page) = @_; return chr($page).chr($ch); return chr ($_[1]) . chr $_[0]; } sub encode_M { # encode Multi-byte - single for 0..255 otherwise double ## my ($ch,$page) = @_; ## return &encode_D if $page; ## return &encode_S; return chr ($_[1]) . chr $_[0] if $_[1]; return chr $_[0]; } my %encode_types = (U => \&encode_U, S => \&encode_S, D => \&encode_D, M => \&encode_M, ); # Win32 does not expand globs on command line if ($^O eq 'MSWin32' and !$ENV{PERL_CORE}) { eval "\@ARGV = map(glob(\$_),\@ARGV)"; @ARGV = @orig_ARGV unless @ARGV; } my %opt; # I think these are: # -Q to disable the duplicate codepoint test # -S make mapping errors fatal # -q to remove comments written to output files # -O to enable the (brute force) substring optimiser # -o <output> to specify the output file name (else it's the first arg) # -f <inlist> to give a file with a list of input files (else use the args) # -n <name> to name the encoding (else use the basename of the input file. #Getopt::Long::Configure("bundling"); #GetOptions(\%opt, qw(C M=s S Q q O o=s f=s n=s v)); getopts('CM:SQqOo:f:n:v',\%opt); $opt{M} and make_makefile_pl($opt{M}, @ARGV); $opt{C} and make_configlocal_pm($opt{C}, @ARGV); $opt{v} ||= $ENV{ENC2XS_VERBOSE}; $opt{q} ||= $ENV{ENC2XS_NO_COMMENTS}; sub verbose { print STDERR @_ if $opt{v}; } sub verbosef { printf STDERR @_ if $opt{v}; } # ($cpp, $static, $sized) = compiler_info($declaration) # # return some information about the compiler and compile options we're using: # # $declaration - true if we're doing a declaration rather than a definition. # # $cpp - we're using C++ # $static - ok to declare the arrays as static # $sized - the array declarations should be sized sub compiler_info { my ($declaration) = @_; my $ccflags = $Config{ccflags}; if (defined $Config{ccwarnflags}) { $ccflags .= " " . $Config{ccwarnflags}; } my $compat = $ccflags =~ /\Q-Wc++-compat/; my $pedantic = $ccflags =~ /-pedantic/; my $cpp = ($Config{d_cplusplus} || '') eq 'define'; # The encpage_t tables contain recursive and mutually recursive # references. To allow them to compile under C++ and some restrictive # cc options, it may be necessary to make the tables non-static/const # (thus moving them from the text to the data segment) and/or not # include the size in the declaration. my $static = !( $cpp || ($compat && $pedantic) || ($^O eq 'MacOS' && $declaration) ); # -Wc++-compat on its own warns if the array declaration is sized. # The easiest way to avoid this warning is simply not to include # the size in the declaration. # With -pedantic as well, the issue doesn't arise because $static # above becomes false. my $sized = $declaration && !($compat && !$pedantic); return ($cpp, $static, $sized); } # This really should go first, else the die here causes empty (non-erroneous) # output files to be written. my @encfiles; if (exists $opt{f}) { # -F is followed by name of file containing list of filenames my $flist = $opt{f}; open(FLIST,$flist) || die "Cannot open $flist:$!"; chomp(@encfiles = <FLIST>); close(FLIST); } else { @encfiles = @ARGV; } my $cname = $opt{o} ? $opt{o} : shift(@ARGV); unless ($cname) { #debuging a win32 nmake error-only. works via cmdline print "\nARGV:"; print "$_ " for @ARGV; print "\nopt:"; print " $_ => ",defined $opt{$_}?$opt{$_}:"undef","\n" for keys %opt; } chmod(0666,$cname) if -f $cname && !-w $cname; open(C,">", $cname) || die "Cannot open $cname:$!"; my $dname = $cname; my $hname = $cname; my ($doC,$doEnc,$doUcm,$doPet); if ($cname =~ /\.(c|xs)$/i) # VMS may have upcased filenames with DECC$ARGV_PARSE_STYLE defined { $doC = 1; $dname =~ s/(\.[^\.]*)?$/.exh/; chmod(0666,$dname) if -f $cname && !-w $dname; open(D,">", $dname) || die "Cannot open $dname:$!"; $hname =~ s/(\.[^\.]*)?$/.h/; chmod(0666,$hname) if -f $cname && !-w $hname; open(H,">", $hname) || die "Cannot open $hname:$!"; foreach my $fh (\*C,\*D,\*H) { print $fh <<"END" unless $opt{'q'}; /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file was autogenerated by: $^X $0 @orig_ARGV enc2xs VERSION $VERSION */ END } if ($cname =~ /(\w+)\.xs$/) { print C "#define PERL_NO_GET_CONTEXT\n"; print C "#include <EXTERN.h>\n"; print C "#include <perl.h>\n"; print C "#include <XSUB.h>\n"; } print C "#include \"encode.h\"\n\n"; } elsif ($cname =~ /\.enc$/) { $doEnc = 1; } elsif ($cname =~ /\.ucm$/) { $doUcm = 1; } elsif ($cname =~ /\.pet$/) { $doPet = 1; } my %encoding; my %strings; my $string_acc; my %strings_in_acc; my $saved = 0; my $subsave = 0; my $strings = 0; sub cmp_name { if ($a =~ /^.*-(\d+)/) { my $an = $1; if ($b =~ /^.*-(\d+)/) { my $r = $an <=> $1; return $r if $r; } } return $a cmp $b; } foreach my $enc (sort cmp_name @encfiles) { my ($name,$sfx) = $enc =~ /^.*?([\w-]+)\.(enc|ucm)$/; $name = $opt{'n'} if exists $opt{'n'}; if (open(E,$enc)) { if ($sfx eq 'enc') { compile_enc(\*E,lc($name)); } else { compile_ucm(\*E,lc($name)); } } else { warn "Cannot open $enc for $name:$!"; } } if ($doC) { verbose "Writing compiled form\n"; foreach my $name (sort cmp_name keys %encoding) { my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}}; process($name.'_utf8',$e2u); addstrings(\*C,$e2u); process('utf8_'.$name,$u2e); addstrings(\*C,$u2e); } outbigstring(\*C,"enctable"); foreach my $name (sort cmp_name keys %encoding) { my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}}; outtable(\*C,$e2u, "enctable"); outtable(\*C,$u2e, "enctable"); # push(@{$encoding{$name}},outstring(\*C,$e2u->{Cname}.'_def',$erep)); } my ($cpp) = compiler_info(0); my $ext = $cpp ? 'extern "C"' : "extern"; my $exta = $cpp ? 'extern "C"' : "static"; my $extb = $cpp ? 'extern "C"' : ""; foreach my $enc (sort cmp_name keys %encoding) { # my ($e2u,$u2e,$rep,$min_el,$max_el,$rsym) = @{$encoding{$enc}}; my ($e2u,$u2e,$rep,$min_el,$max_el) = @{$encoding{$enc}}; #my @info = ($e2u->{Cname},$u2e->{Cname},$rsym,length($rep),$min_el,$max_el); my $replen = 0; $replen++ while($rep =~ /\G\\x[0-9A-Fa-f]/g); my $sym = "${enc}_encoding"; $sym =~ s/\W+/_/g; my @info = ($e2u->{Cname},$u2e->{Cname},"${sym}_rep_character",$replen, $min_el,$max_el); print C "${exta} const U8 ${sym}_rep_character[] = \"$rep\";\n"; print C "${exta} const char ${sym}_enc_name[] = \"$enc\";\n\n"; print C "${extb} const encode_t $sym = \n"; # This is to make null encoding work -- dankogai for (my $i = (scalar @info) - 1; $i >= 0; --$i){ $info[$i] ||= 1; } # end of null tweak -- dankogai print C " {",join(',',@info,"{${sym}_enc_name,(const char *)0}"),"};\n\n"; } foreach my $enc (sort cmp_name keys %encoding) { my $sym = "${enc}_encoding"; $sym =~ s/\W+/_/g; print H "${ext} encode_t $sym;\n"; print D " Encode_XSEncoding(aTHX_ &$sym);\n"; } if ($cname =~ /(\w+)\.xs$/) { my $mod = $1; print C <<'END'; static void Encode_XSEncoding(pTHX_ encode_t *enc) { dSP; HV *stash = gv_stashpv("Encode::XS", TRUE); SV *iv = newSViv(PTR2IV(enc)); SV *sv = sv_bless(newRV_noinc(iv),stash); int i = 0; /* with the SvLEN() == 0 hack, PVX won't be freed. We cast away name's constness, in the hope that perl won't mess with it. */ assert(SvTYPE(iv) >= SVt_PV); assert(SvLEN(iv) == 0); SvFLAGS(iv) |= SVp_POK; SvPVX(iv) = (char*) enc->name[0]; PUSHMARK(sp); XPUSHs(sv); while (enc->name[i]) { const char *name = enc->name[i++]; XPUSHs(sv_2mortal(newSVpvn(name,strlen(name)))); } PUTBACK; call_pv("Encode::define_encoding",G_DISCARD); SvREFCNT_dec(sv); } END print C "\nMODULE = Encode::$mod\tPACKAGE = Encode::$mod\n\n"; print C "BOOT:\n{\n"; print C "#include \"$dname\"\n"; print C "}\n"; } # Close in void context is bad, m'kay close(D) or warn "Error closing '$dname': $!"; close(H) or warn "Error closing '$hname': $!"; my $perc_saved = $saved/($strings + $saved) * 100; my $perc_subsaved = $subsave/($strings + $subsave) * 100; verbosef "%d bytes in string tables\n",$strings; verbosef "%d bytes (%.3g%%) saved spotting duplicates\n", $saved, $perc_saved if $saved; verbosef "%d bytes (%.3g%%) saved using substrings\n", $subsave, $perc_subsaved if $subsave; } elsif ($doEnc) { foreach my $name (sort cmp_name keys %encoding) { my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}}; output_enc(\*C,$name,$e2u); } } elsif ($doUcm) { foreach my $name (sort cmp_name keys %encoding) { my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}}; output_ucm(\*C,$name,$u2e,$erep,$min_el,$max_el); } } # writing half meg files and then not checking to see if you just filled the # disk is bad, m'kay close(C) or die "Error closing '$cname': $!"; # End of the main program. sub compile_ucm { my ($fh,$name) = @_; my $e2u = {}; my $u2e = {}; my $cs; my %attr; while (<$fh>) { s/#.*$//; last if /^\s*CHARMAP\s*$/i; if (/^\s*<(\w+)>\s+"?([^"]*)"?\s*$/i) # " # Grrr { $attr{$1} = $2; } } if (!defined($cs = $attr{'code_set_name'})) { warn "No <code_set_name> in $name\n"; } else { $name = $cs unless exists $opt{'n'}; } my $erep; my $urep; my $max_el; my $min_el; if (exists $attr{'subchar'}) { #my @byte; #$attr{'subchar'} =~ /^\s*/cg; #push(@byte,$1) while $attr{'subchar'} =~ /\G\\x([0-9a-f]+)/icg; #$erep = join('',map(chr(hex($_)),@byte)); $erep = $attr{'subchar'}; $erep =~ s/^\s+//; $erep =~ s/\s+$//; } print "Reading $name ($cs)\n" unless defined $ENV{MAKEFLAGS} and $ENV{MAKEFLAGS} =~ /\b(s|silent|quiet)\b/; my $nfb = 0; my $hfb = 0; while (<$fh>) { s/#.*$//; last if /^\s*END\s+CHARMAP\s*$/i; next if /^\s*$/; my (@uni, @byte) = (); my ($uni, $byte, $fb) = m/^(\S+)\s+(\S+)\s+(\S+)\s+/o or die "Bad line: $_"; while ($uni =~ m/\G<([U0-9a-fA-F\+]+)>/g){ push @uni, map { substr($_, 1) } split(/\+/, $1); } while ($byte =~ m/\G\\x([0-9a-fA-F]+)/g){ push @byte, $1; } if (@uni) { my $uch = join('', map { encode_U(hex($_)) } @uni ); my $ech = join('',map(chr(hex($_)),@byte)); my $el = length($ech); $max_el = $el if (!defined($max_el) || $el > $max_el); $min_el = $el if (!defined($min_el) || $el < $min_el); if (length($fb)) { $fb = substr($fb,1); $hfb++; } else { $nfb++; $fb = '0'; } # $fb is fallback flag # 0 - round trip safe # 1 - fallback for unicode -> enc # 2 - skip sub-char mapping # 3 - fallback enc -> unicode enter($u2e,$uch,$ech,$u2e,$fb+0) if ($fb =~ /[01]/); enter($e2u,$ech,$uch,$e2u,$fb+0) if ($fb =~ /[03]/); } else { warn $_; } } if ($nfb && $hfb) { die "$nfb entries without fallback, $hfb entries with\n"; } $encoding{$name} = [$e2u,$u2e,$erep,$min_el,$max_el]; } sub compile_enc { my ($fh,$name) = @_; my $e2u = {}; my $u2e = {}; my $type; while ($type = <$fh>) { last if $type !~ /^\s*#/; } chomp($type); return if $type eq 'E'; # Do the hash lookup once, rather than once per function call. 4% speedup. my $type_func = $encode_types{$type}; my ($def,$sym,$pages) = split(/\s+/,scalar(<$fh>)); warn "$type encoded $name\n"; my $rep = ''; # Save a defined test by setting these to defined values. my $min_el = ~0; # A very big integer my $max_el = 0; # Anything must be longer than 0 { my $v = hex($def); $rep = &$type_func($v & 0xFF, ($v >> 8) & 0xffe); } my $errors; my $seen; # use -Q to silence the seen test. Makefile.PL uses this by default. $seen = {} unless $opt{Q}; do { my $line = <$fh>; chomp($line); my $page = hex($line); my $ch = 0; my $i = 16; do { # So why is it 1% faster to leave the my here? my $line = <$fh>; $line =~ s/\r\n$/\n/; die "$.:${line}Line should be exactly 65 characters long including newline (".length($line).")" unless length ($line) == 65; # Split line into groups of 4 hex digits, convert groups to ints # This takes 65.35 # map {hex $_} $line =~ /(....)/g # This takes 63.75 (2.5% less time) # unpack "n*", pack "H*", $line # There's an implicit loop in map. Loops are bad, m'kay. Ops are bad, m'kay # Doing it as while ($line =~ /(....)/g) took 74.63 foreach my $val (unpack "n*", pack "H*", $line) { next if $val == 0xFFFD; my $ech = &$type_func($ch,$page); if ($val || (!$ch && !$page)) { my $el = length($ech); $max_el = $el if $el > $max_el; $min_el = $el if $el < $min_el; my $uch = encode_U($val); if ($seen) { # We're doing the test. # We don't need to read this quickly, so storing it as a scalar, # rather than 3 (anon array, plus the 2 scalars it holds) saves # RAM and may make us faster on low RAM systems. [see __END__] if (exists $seen->{$uch}) { warn sprintf("U%04X is %02X%02X and %04X\n", $val,$page,$ch,$seen->{$uch}); $errors++; } else { $seen->{$uch} = $page << 8 | $ch; } } # Passing 2 extra args each time is 3.6% slower! # Even with having to add $fallback ||= 0 later enter_fb0($e2u,$ech,$uch); enter_fb0($u2e,$uch,$ech); } else { # No character at this position # enter($e2u,$ech,undef,$e2u); } $ch++; } } while --$i; } while --$pages; die "\$min_el=$min_el, \$max_el=$max_el - seems we read no lines" if $min_el > $max_el; die "$errors mapping conflicts\n" if ($errors && $opt{'S'}); $encoding{$name} = [$e2u,$u2e,$rep,$min_el,$max_el]; } # my ($a,$s,$d,$t,$fb) = @_; sub enter { my ($current,$inbytes,$outbytes,$next,$fallback) = @_; # state we shift to after this (multibyte) input character defaults to same # as current state. $next ||= $current; # Making sure it is defined seems to be faster than {no warnings;} in # &process, or passing it in as 0 explicitly. # XXX $fallback ||= 0; # Start at the beginning and work forwards through the string to zero. # effectively we are removing 1 character from the front each time # but we don't actually edit the string. [this alone seems to be 14% speedup] # Hence -$pos is the length of the remaining string. my $pos = -length $inbytes; while (1) { my $byte = substr $inbytes, $pos, 1; # RAW_NEXT => 0, # RAW_IN_LEN => 1, # RAW_OUT_BYTES => 2, # RAW_FALLBACK => 3, # to unicode an array would seem to be better, because the pages are dense. # from unicode can be very sparse, favouring a hash. # hash using the bytes (all length 1) as keys rather than ord value, # as it's easier to sort these in &process. # It's faster to always add $fallback even if it's undef, rather than # choosing between 3 and 4 element array. (hence why we set it defined # above) my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,'',$fallback]; # When $pos was -1 we were at the last input character. unless (++$pos) { $do_now->[RAW_OUT_BYTES] = $outbytes; $do_now->[RAW_NEXT] = $next; return; } # Tail recursion. The intermediate state may not have a name yet. $current = $do_now->[RAW_NEXT]; } } # This is purely for optimisation. It's just &enter hard coded for $fallback # of 0, using only a 3 entry array ref to save memory for every entry. sub enter_fb0 { my ($current,$inbytes,$outbytes,$next) = @_; $next ||= $current; my $pos = -length $inbytes; while (1) { my $byte = substr $inbytes, $pos, 1; my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,'']; unless (++$pos) { $do_now->[RAW_OUT_BYTES] = $outbytes; $do_now->[RAW_NEXT] = $next; return; } $current = $do_now->[RAW_NEXT]; } } sub process { my ($name,$a) = @_; $name =~ s/\W+/_/g; $a->{Cname} = $name; my $raw = $a->{Raw}; my ($l, $agg_max_in, $agg_next, $agg_in_len, $agg_out_len, $agg_fallback); my @ent; $agg_max_in = 0; foreach my $key (sort keys %$raw) { # RAW_NEXT => 0, # RAW_IN_LEN => 1, # RAW_OUT_BYTES => 2, # RAW_FALLBACK => 3, my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}}; # Now we are converting from raw to aggregate, switch from 1 byte strings # to numbers my $b = ord $key; $fallback ||= 0; if ($l && # If this == fails, we're going to reset $agg_max_in below anyway. $b == ++$agg_max_in && # References in numeric context give the pointer as an int. $agg_next == $next && $agg_in_len == $in_len && $agg_out_len == length $out_bytes && $agg_fallback == $fallback # && length($l->[AGG_OUT_BYTES]) < 16 ) { # my $i = ord($b)-ord($l->[AGG_MIN_IN]); # we can aggregate this byte onto the end. $l->[AGG_MAX_IN] = $b; $l->[AGG_OUT_BYTES] .= $out_bytes; } else { # AGG_MIN_IN => 0, # AGG_MAX_IN => 1, # AGG_OUT_BYTES => 2, # AGG_NEXT => 3, # AGG_IN_LEN => 4, # AGG_OUT_LEN => 5, # AGG_FALLBACK => 6, # Reset the last thing we saw, plus set 5 lexicals to save some derefs. # (only gains .6% on euc-jp -- is it worth it?) push @ent, $l = [$b, $agg_max_in = $b, $out_bytes, $agg_next = $next, $agg_in_len = $in_len, $agg_out_len = length $out_bytes, $agg_fallback = $fallback]; } if (exists $next->{Cname}) { $next->{'Forward'} = 1 if $next != $a; } else { process(sprintf("%s_%02x",$name,$b),$next); } } # encengine.c rules say that last entry must be for 255 if ($agg_max_in < 255) { push @ent, [1+$agg_max_in, 255,undef,$a,0,0]; } $a->{'Entries'} = \@ent; } sub addstrings { my ($fh,$a) = @_; my $name = $a->{'Cname'}; # String tables foreach my $b (@{$a->{'Entries'}}) { next unless $b->[AGG_OUT_LEN]; $strings{$b->[AGG_OUT_BYTES]} = undef; } if ($a->{'Forward'}) { my ($cpp, $static, $sized) = compiler_info(1); my $count = $sized ? scalar(@{$a->{'Entries'}}) : ''; if ($static) { # we cannot ask Config for d_plusplus since we can override CC=g++-6 on the cmdline print $fh "#ifdef __cplusplus\n"; # -fpermissive since g++-6 print $fh "extern encpage_t $name\[$count];\n"; print $fh "#else\n"; print $fh "static const encpage_t $name\[$count];\n"; print $fh "#endif\n"; } else { print $fh "extern encpage_t $name\[$count];\n"; } } $a->{'DoneStrings'} = 1; foreach my $b (@{$a->{'Entries'}}) { my ($s,$e,$out,$t,$end,$l) = @$b; addstrings($fh,$t) unless $t->{'DoneStrings'}; } } sub outbigstring { my ($fh,$name) = @_; $string_acc = ''; # Make the big string in the string accumulator. Longest first, on the hope # that this makes it more likely that we find the short strings later on. # Not sure if it helps sorting strings of the same length lexically. foreach my $s (sort {length $b <=> length $a || $a cmp $b} keys %strings) { my $index = index $string_acc, $s; if ($index >= 0) { $saved += length($s); $strings_in_acc{$s} = $index; } else { OPTIMISER: { if ($opt{'O'}) { my $sublength = length $s; while (--$sublength > 0) { # progressively lop characters off the end, to see if the start of # the new string overlaps the end of the accumulator. if (substr ($string_acc, -$sublength) eq substr ($s, 0, $sublength)) { $subsave += $sublength; $strings_in_acc{$s} = length ($string_acc) - $sublength; # append the last bit on the end. $string_acc .= substr ($s, $sublength); last OPTIMISER; } # or if the end of the new string overlaps the start of the # accumulator next unless substr ($string_acc, 0, $sublength) eq substr ($s, -$sublength); # well, the last $sublength characters of the accumulator match. # so as we're prepending to the accumulator, need to shift all our # existing offsets forwards $_ += $sublength foreach values %strings_in_acc; $subsave += $sublength; $strings_in_acc{$s} = 0; # append the first bit on the start. $string_acc = substr ($s, 0, -$sublength) . $string_acc; last OPTIMISER; } } # Optimiser (if it ran) found nothing, so just going have to tack the # whole thing on the end. $strings_in_acc{$s} = length $string_acc; $string_acc .= $s; }; } } $strings = length $string_acc; my ($cpp) = compiler_info(0); my $var = $cpp ? '' : 'static'; my $definition = "\n$var const U8 $name\[$strings] = { " . join(',',unpack "C*",$string_acc); # We have a single long line. Split it at convenient commas. print $fh $1, "\n" while $definition =~ /\G(.{74,77},)/gcs; print $fh substr ($definition, pos $definition), " };\n"; } sub findstring { my ($name,$s) = @_; my $offset = $strings_in_acc{$s}; die "Can't find string " . join (',',unpack "C*",$s) . " in accumulator" unless defined $offset; "$name + $offset"; } sub outtable { my ($fh,$a,$bigname) = @_; my $name = $a->{'Cname'}; $a->{'Done'} = 1; foreach my $b (@{$a->{'Entries'}}) { my ($s,$e,$out,$t,$end,$l) = @$b; outtable($fh,$t,$bigname) unless $t->{'Done'}; } my ($cpp, $static) = compiler_info(0); my $count = scalar(@{$a->{'Entries'}}); if ($static) { print $fh "#ifdef __cplusplus\n"; # -fpermissive since g++-6 print $fh "encpage_t $name\[$count] = {\n"; print $fh "#else\n"; print $fh "static const encpage_t $name\[$count] = {\n"; print $fh "#endif\n"; } else { print $fh "\nencpage_t $name\[$count] = {\n"; } foreach my $b (@{$a->{'Entries'}}) { my ($sc,$ec,$out,$t,$end,$l,$fb) = @$b; # $end |= 0x80 if $fb; # what the heck was on your mind, Nick? -- Dan print $fh "{"; if ($l) { printf $fh findstring($bigname,$out); } else { print $fh "0"; } print $fh ",",$t->{Cname}; printf $fh ",0x%02x,0x%02x,$l,$end},\n",$sc,$ec; } print $fh "};\n"; } sub output_enc { my ($fh,$name,$a) = @_; die "Changed - fix me for new structure"; foreach my $b (sort keys %$a) { my ($s,$e,$out,$t,$end,$l,$fb) = @{$a->{$b}}; } } sub decode_U { my $s = shift; } my @uname; sub char_names{} # cf. https://rt.cpan.org/Ticket/Display.html?id=132471 sub output_ucm_page { my ($cmap,$a,$t,$pre) = @_; # warn sprintf("Page %x\n",$pre); my $raw = $t->{Raw}; foreach my $key (sort keys %$raw) { # RAW_NEXT => 0, # RAW_IN_LEN => 1, # RAW_OUT_BYTES => 2, # RAW_FALLBACK => 3, my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}}; my $u = ord $key; $fallback ||= 0; if ($next != $a && $next != $t) { output_ucm_page($cmap,$a,$next,(($pre|($u &0x3F)) << 6)&0xFFFF); } elsif (length $out_bytes) { if ($pre) { $u = $pre|($u &0x3f); } my $s = sprintf "<U%04X> ",$u; #foreach my $c (split(//,$out_bytes)) { # $s .= sprintf "\\x%02X",ord($c); #} # 9.5% faster changing that loop to this: $s .= sprintf +("\\x%02X" x length $out_bytes), unpack "C*", $out_bytes; $s .= sprintf " |%d # %s\n",($fallback ? 1 : 0),$uname[$u]; push(@$cmap,$s); } else { warn join(',',$u, @{$raw->{$key}},$a,$t); } } } sub output_ucm { my ($fh,$name,$h,$rep,$min_el,$max_el) = @_; print $fh "# $0 @orig_ARGV\n" unless $opt{'q'}; print $fh "<code_set_name> \"$name\"\n"; char_names(); if (defined $min_el) { print $fh "<mb_cur_min> $min_el\n"; } if (defined $max_el) { print $fh "<mb_cur_max> $max_el\n"; } if (defined $rep) { print $fh "<subchar> "; foreach my $c (split(//,$rep)) { printf $fh "\\x%02X",ord($c); } print $fh "\n"; } my @cmap; output_ucm_page(\@cmap,$h,$h,0); print $fh "#\nCHARMAP\n"; foreach my $line (sort { substr($a,8) cmp substr($b,8) } @cmap) { print $fh $line; } print $fh "END CHARMAP\n"; } use vars qw( $_Enc2xs $_Version $_Inc $_E2X $_Name $_TableFiles $_Now ); sub find_e2x{ eval { require File::Find; }; my (@inc, %e2x_dir); for my $inc (@INC){ push @inc, $inc unless $inc eq '.'; #skip current dir } File::Find::find( sub { my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = lstat($_) or return; -f _ or return; if (/^.*\.e2x$/o){ no warnings 'once'; $e2x_dir{$File::Find::dir} ||= $mtime; } return; }, @inc); warn join("\n", keys %e2x_dir), "\n"; for my $d (sort {$e2x_dir{$a} <=> $e2x_dir{$b}} keys %e2x_dir){ $_E2X = $d; # warn "$_E2X => ", scalar localtime($e2x_dir{$d}); return $_E2X; } } sub make_makefile_pl { eval { require Encode } or die "You need to install Encode to use enc2xs -M\nerror: $@\n"; # our used for variable expansion $_Enc2xs = $0; $_Version = $VERSION; $_E2X = find_e2x(); $_Name = shift; $_TableFiles = join(",", map {qq('$_')} @_); $_Now = scalar localtime(); eval { require File::Spec; }; _print_expand(File::Spec->catfile($_E2X,"Makefile_PL.e2x"),"Makefile.PL"); _print_expand(File::Spec->catfile($_E2X,"_PM.e2x"), "$_Name.pm"); _print_expand(File::Spec->catfile($_E2X,"_T.e2x"), "t/$_Name.t"); _print_expand(File::Spec->catfile($_E2X,"README.e2x"), "README"); _print_expand(File::Spec->catfile($_E2X,"Changes.e2x"), "Changes"); exit; } use vars qw( $_ModLines $_LocalVer ); sub make_configlocal_pm { eval { require Encode } or die "Unable to require Encode: $@\n"; eval { require File::Spec; }; # our used for variable expantion my %in_core = map { $_ => 1 } ( 'ascii', 'iso-8859-1', 'utf8', 'ascii-ctrl', 'null', 'utf-8-strict' ); my %LocalMod = (); # check @enc; use File::Find (); my $wanted = sub{ -f $_ or return; $File::Find::name =~ /\A\./ and return; $File::Find::name =~ /\.pm\z/ or return; $File::Find::name =~ m/\bEncode\b/ or return; my $mod = $File::Find::name; $mod =~ s/.*\bEncode\b/Encode/o; $mod =~ s/\.pm\z//o; $mod =~ s,/,::,og; eval qq{ require $mod; } or return; warn qq{ require $mod;\n}; for my $enc ( Encode->encodings() ) { no warnings; $in_core{$enc} and next; $Encode::Config::ExtModule{$enc} and next; $LocalMod{$enc} ||= $mod; } }; File::Find::find({wanted => $wanted}, @INC); $_ModLines = ""; for my $enc ( sort keys %LocalMod ) { $_ModLines .= qq(\$Encode::ExtModule{'$enc'} = "$LocalMod{$enc}";\n); } warn $_ModLines if $_ModLines; $_LocalVer = _mkversion(); $_E2X = find_e2x(); $_Inc = $INC{"Encode.pm"}; $_Inc =~ s/\.pm$//o; _print_expand( File::Spec->catfile( $_E2X, "ConfigLocal_PM.e2x" ), File::Spec->catfile( $_Inc, "ConfigLocal.pm" ), 1 ); exit; } sub _mkversion{ # v-string is now depreciated; use time() instead; #my ($ss,$mm,$hh,$dd,$mo,$yyyy) = localtime(); #$yyyy += 1900, $mo +=1; #return sprintf("v%04d.%04d.%04d", $yyyy, $mo*100+$dd, $hh*100+$mm); return time(); } sub _print_expand{ eval { require File::Basename } or die "File::Basename needed. Are you on miniperl?;\nerror: $@\n"; File::Basename->import(); my ($src, $dst, $clobber) = @_; if (!$clobber and -e $dst){ warn "$dst exists. skipping\n"; return; } warn "Generating $dst...\n"; open my $in, $src or die "$src : $!"; if ((my $d = dirname($dst)) ne '.'){ -d $d or mkdir $d, 0755 or die "mkdir $d : $!"; } open my $out, ">", $dst or die "$!"; my $asis = 0; while (<$in>){ if (/^#### END_OF_HEADER/){ $asis = 1; next; } s/(\$_[A-Z][A-Za-z0-9]+)_/$1/gee unless $asis; print $out $_; } } __END__ =head1 NAME enc2xs -- Perl Encode Module Generator =head1 SYNOPSIS enc2xs -[options] enc2xs -M ModName mapfiles... enc2xs -C =head1 DESCRIPTION F<enc2xs> builds a Perl extension for use by Encode from either Unicode Character Mapping files (.ucm) or Tcl Encoding Files (.enc). Besides being used internally during the build process of the Encode module, you can use F<enc2xs> to add your own encoding to perl. No knowledge of XS is necessary. =head1 Quick Guide If you want to know as little about Perl as possible but need to add a new encoding, just read this chapter and forget the rest. =over 4 =item 0.Z<> Have a .ucm file ready. You can get it from somewhere or you can write your own from scratch or you can grab one from the Encode distribution and customize it. For the UCM format, see the next Chapter. In the example below, I'll call my theoretical encoding myascii, defined in I<my.ucm>. C<$> is a shell prompt. $ ls -F my.ucm =item 1.Z<> Issue a command as follows; $ enc2xs -M My my.ucm generating Makefile.PL generating My.pm generating README generating Changes Now take a look at your current directory. It should look like this. $ ls -F Makefile.PL My.pm my.ucm t/ The following files were created. Makefile.PL - MakeMaker script My.pm - Encode submodule t/My.t - test file =over 4 =item 1.1.Z<> If you want *.ucm installed together with the modules, do as follows; $ mkdir Encode $ mv *.ucm Encode $ enc2xs -M My Encode/*ucm =back =item 2.Z<> Edit the files generated. You don't have to if you have no time AND no intention to give it to someone else. But it is a good idea to edit the pod and to add more tests. =item 3.Z<> Now issue a command all Perl Mongers love: $ perl Makefile.PL Writing Makefile for Encode::My =item 4.Z<> Now all you have to do is make. $ make cp My.pm blib/lib/Encode/My.pm /usr/local/bin/perl /usr/local/bin/enc2xs -Q -O \ -o encode_t.c -f encode_t.fnm Reading myascii (myascii) Writing compiled form 128 bytes in string tables 384 bytes (75%) saved spotting duplicates 1 bytes (0.775%) saved using substrings .... chmod 644 blib/arch/auto/Encode/My/My.bs $ The time it takes varies depending on how fast your machine is and how large your encoding is. Unless you are working on something big like euc-tw, it won't take too long. =item 5.Z<> You can "make install" already but you should test first. $ make test PERL_DL_NONLAZY=1 /usr/local/bin/perl -Iblib/arch -Iblib/lib \ -e 'use Test::Harness qw(&runtests $verbose); \ $verbose=0; runtests @ARGV;' t/*.t t/My....ok All tests successful. Files=1, Tests=2, 0 wallclock secs ( 0.09 cusr + 0.01 csys = 0.09 CPU) =item 6.Z<> If you are content with the test result, just "make install" =item 7.Z<> If you want to add your encoding to Encode's demand-loading list (so you don't have to "use Encode::YourEncoding"), run enc2xs -C to update Encode::ConfigLocal, a module that controls local settings. After that, "use Encode;" is enough to load your encodings on demand. =back =head1 The Unicode Character Map Encode uses the Unicode Character Map (UCM) format for source character mappings. This format is used by IBM's ICU package and was adopted by Nick Ing-Simmons for use with the Encode module. Since UCM is more flexible than Tcl's Encoding Map and far more user-friendly, this is the recommended format for Encode now. A UCM file looks like this. # # Comments # <code_set_name> "US-ascii" # Required <code_set_alias> "ascii" # Optional <mb_cur_min> 1 # Required; usually 1 <mb_cur_max> 1 # Max. # of bytes/char <subchar> \x3F # Substitution char # CHARMAP <U0000> \x00 |0 # <control> <U0001> \x01 |0 # <control> <U0002> \x02 |0 # <control> .... <U007C> \x7C |0 # VERTICAL LINE <U007D> \x7D |0 # RIGHT CURLY BRACKET <U007E> \x7E |0 # TILDE <U007F> \x7F |0 # <control> END CHARMAP =over 4 =item * Anything that follows C<#> is treated as a comment. =item * The header section continues until a line containing the word CHARMAP. This section has a form of I<E<lt>keywordE<gt> value>, one pair per line. Strings used as values must be quoted. Barewords are treated as numbers. I<\xXX> represents a byte. Most of the keywords are self-explanatory. I<subchar> means substitution character, not subcharacter. When you decode a Unicode sequence to this encoding but no matching character is found, the byte sequence defined here will be used. For most cases, the value here is \x3F; in ASCII, this is a question mark. =item * CHARMAP starts the character map section. Each line has a form as follows: <UXXXX> \xXX.. |0 # comment ^ ^ ^ | | +- Fallback flag | +-------- Encoded byte sequence +-------------- Unicode Character ID in hex The format is roughly the same as a header section except for the fallback flag: | followed by 0..3. The meaning of the possible values is as follows: =over 4 =item |0 Round trip safe. A character decoded to Unicode encodes back to the same byte sequence. Most characters have this flag. =item |1 Fallback for unicode -> encoding. When seen, enc2xs adds this character for the encode map only. =item |2 Skip sub-char mapping should there be no code point. =item |3 Fallback for encoding -> unicode. When seen, enc2xs adds this character for the decode map only. =back =item * And finally, END OF CHARMAP ends the section. =back When you are manually creating a UCM file, you should copy ascii.ucm or an existing encoding which is close to yours, rather than write your own from scratch. When you do so, make sure you leave at least B<U0000> to B<U0020> as is, unless your environment is EBCDIC. B<CAVEAT>: not all features in UCM are implemented. For example, icu:state is not used. Because of that, you need to write a perl module if you want to support algorithmical encodings, notably the ISO-2022 series. Such modules include L<Encode::JP::2022_JP>, L<Encode::KR::2022_KR>, and L<Encode::TW::HZ>. =head2 Coping with duplicate mappings When you create a map, you SHOULD make your mappings round-trip safe. That is, C<encode('your-encoding', decode('your-encoding', $data)) eq $data> stands for all characters that are marked as C<|0>. Here is how to make sure: =over 4 =item * Sort your map in Unicode order. =item * When you have a duplicate entry, mark either one with '|1' or '|3'. =item * And make sure the '|1' or '|3' entry FOLLOWS the '|0' entry. =back Here is an example from big5-eten. <U2550> \xF9\xF9 |0 <U2550> \xA2\xA4 |3 Internally Encoding -> Unicode and Unicode -> Encoding Map looks like this; E to U U to E -------------------------------------- \xF9\xF9 => U2550 U2550 => \xF9\xF9 \xA2\xA4 => U2550 So it is round-trip safe for \xF9\xF9. But if the line above is upside down, here is what happens. E to U U to E -------------------------------------- \xA2\xA4 => U2550 U2550 => \xF9\xF9 (\xF9\xF9 => U2550 is now overwritten!) The Encode package comes with F<ucmlint>, a crude but sufficient utility to check the integrity of a UCM file. Check under the Encode/bin directory for this. When in doubt, you can use F<ucmsort>, yet another utility under Encode/bin directory. =head1 Bookmarks =over 4 =item * ICU Home Page L<http://www.icu-project.org/> =item * ICU Character Mapping Tables L<http://site.icu-project.org/charts/charset> =item * ICU:Conversion Data L<http://www.icu-project.org/userguide/conversion-data.html> =back =head1 SEE ALSO L<Encode>, L<perlmod>, L<perlpod> =cut # -Q to disable the duplicate codepoint test # -S make mapping errors fatal # -q to remove comments written to output files # -O to enable the (brute force) substring optimiser # -o <output> to specify the output file name (else it's the first arg) # -f <inlist> to give a file with a list of input files (else use the args) # -n <name> to name the encoding (else use the basename of the input file. With %seen holding array refs: 865.66 real 28.80 user 8.79 sys 7904 maximum resident set size 1356 average shared memory size 18566 average unshared data size 229 average unshared stack size 46080 page reclaims 33373 page faults With %seen holding simple scalars: 342.16 real 27.11 user 3.54 sys 8388 maximum resident set size 1394 average shared memory size 14969 average unshared data size 236 average unshared stack size 28159 page reclaims 9839 page faults Yes, 5 minutes is faster than 15. Above is for CP936 in CN. Only difference is how %seen is storing things its seen. So it is pathalogically bad on a 16M RAM machine, but it's going to help even on modern machines. Swapping is bad, m'kay :-)
Save
cmd:
run