Applications/casawiki: jcode.pl annotate

annotate jcode.pl @ 1:0b233d5d1944

added .htaccess

author	Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp>
date	Sun, 06 Jun 2010 22:01:03 +0900
parents	a2f0a2c135cf
children

rev	line source
0 a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	1 package jcode;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	2 ;######################################################################
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	3 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	4 ;# jcode.pl: Perl library for Japanese character code conversion
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	5 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	6 ;# Copyright (c) 1995-1999 Kazumasa Utashiro <utashiro@iij.ad.jp>
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	7 ;# Internet Initiative Japan Inc.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	8 ;# 3-13 Kanda Nishiki-cho, Chiyoda-ku, Tokyo 101-0054, Japan
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	9 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	10 ;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	11 ;# Software Research Associates, Inc.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	12 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	13 ;# Use and redistribution for ANY PURPOSE are granted as long as all
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	14 ;# copyright notices are retained. Redistribution with modification
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	15 ;# is allowed provided that you make your modified version obviously
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	16 ;# distinguishable from the original one. THIS SOFTWARE IS PROVIDED
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	17 ;# BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ARE
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	18 ;# DISCLAIMED.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	19 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	20 ;# Original version was developed under the name of srekcah@sra.co.jp
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	21 ;# February 1992 and it was called kconv.pl at the beginning. This
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	22 ;# address was a pen name for group of individuals and it is no longer
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	23 ;# valid.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	24 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	25 ;# The latest version is available here:
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	26 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	27 ;# ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	28 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	29 ;; $rcsid = q$Id: jcode.pl,v 2.11 1999/12/26 17:16:47 utashiro Exp $;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	30 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	31 ;######################################################################
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	32 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	33 ;# PERL4 INTERFACE:
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	34 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	35 ;# &jcode'getcode(*line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	36 ;# Return 'jis', 'sjis', 'euc' or undef according to
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	37 ;# Japanese character code in $line. Return 'binary' if
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	38 ;# the data has non-character code.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	39 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	40 ;# When evaluated in array context, it returns a list
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	41 ;# contains two items. First value is the number of
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	42 ;# characters which matched to the expected code, and
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	43 ;# second value is the code name. It is useful if and
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	44 ;# only if the number is not 0 and the code is undef;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	45 ;# that case means it couldn't tell 'euc' or 'sjis'
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	46 ;# because the evaluation score was exactly same. This
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	47 ;# interface is too tricky, though.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	48 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	49 ;# Code detection between euc and sjis is very difficult
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	50 ;# or sometimes impossible or even lead to wrong result
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	51 ;# when it includes JIS X0201 KANA characters. So JIS
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	52 ;# X0201 KANA is ignored for automatic code detection.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	53 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	54 ;# &jcode'convert(*line, $ocode [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	55 ;# Convert the contents of $line to the specified
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	56 ;# Japanese code given in the second argument $ocode.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	57 ;# $ocode can be any of "jis", "sjis" or "euc", or use
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	58 ;# "noconv" when you don't want the code conversion.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	59 ;# Input code is recognized automatically from the line
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	60 ;# itself when $icode is not supplied (JIS X0201 KANA is
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	61 ;# ignored in code detection. See the above descripton
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	62 ;# of &getcode). $icode also can be specified, but
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	63 ;# xxx2yyy routine is more efficient when both codes are
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	64 ;# known.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	65 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	66 ;# It returns the code of input string in scalar context,
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	67 ;# and a list of pointer of convert subroutine and the
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	68 ;# input code in array context.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	69 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	70 ;# Japanese character code JIS X0201, X0208, X0212 and
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	71 ;# ASCII code are supported. X0212 characters can not be
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	72 ;# represented in SJIS and they will be replased by
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	73 ;# "geta" character when converted to SJIS.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	74 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	75 ;# See next paragraph for $option parameter.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	76 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	77 ;# &jcode'xxx2yyy(*line [, $option])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	78 ;# Convert the Japanese code from xxx to yyy. String xxx
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	79 ;# and yyy are any convination from "jis", "euc" or
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	80 ;# "sjis". They return approximate number of converted
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	81 ;# bytes. So return value 0 means the line was not
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	82 ;# converted at all.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	83 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	84 ;# Optional parameter $option is used to specify optional
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	85 ;# conversion method. String "z" is for JIS X0201 KANA
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	86 ;# to X0208 KANA, and "h" is for reverse.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	87 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	88 ;# $jcode'convf{'xxx', 'yyy'}
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	89 ;# The value of this associative array is pointer to the
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	90 ;# subroutine jcode'xxx2yyy().
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	91 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	92 ;# &jcode'to($ocode, $line [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	93 ;# &jcode'jis($line [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	94 ;# &jcode'euc($line [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	95 ;# &jcode'sjis($line [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	96 ;# These functions are prepared for easy use of
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	97 ;# call/return-by-value interface. You can use these
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	98 ;# funcitons in s///e operation or any other place for
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	99 ;# convenience.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	100 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	101 ;# &jcode'jis_inout($in, $out)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	102 ;# Set or inquire JIS start and end sequences. Default
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	103 ;# is "ESC-$-B" and "ESC-(-B". If you supplied only one
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	104 ;# character, "ESC-$" or "ESC-(" is prepended for each
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	105 ;# character respectively. Acutually "ESC-(-B" is not a
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	106 ;# sequence to end JIS code but a sequence to start ASCII
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	107 ;# code set. So `in' and `out' are somewhat misleading.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	108 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	109 ;# &jcode'get_inout($string)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	110 ;# Get JIS start and end sequences from $string.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	111 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	112 ;# &jcode'cache()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	113 ;# &jcode'nocache()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	114 ;# &jcode'flush()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	115 ;# Usually, converted character is cached in memory to
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	116 ;# avoid same calculations have to be done many times.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	117 ;# To disable this caching, call &jcode'nocache(). It
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	118 ;# can be revived by &jcode'cache() and cache is flushed
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	119 ;# by calling &jcode'flush(). &cache() and &nocache()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	120 ;# functions return previous caching state.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	121 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	122 ;# ---------------------------------------------------------------
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	123 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	124 ;# &jcode'h2z_xxx(*line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	125 ;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	126 ;# (Zenkaku-KANA) code conversion routine. String xxx is
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	127 ;# any of "jis", "sjis" and "euc". From the difficulty
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	128 ;# of recognizing code set from 1-byte KATAKANA string,
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	129 ;# automatic code recognition is not supported.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	130 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	131 ;# &jcode'z2h_xxx(*line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	132 ;# X0208 to X0201 KANA code conversion routine. String
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	133 ;# xxx is any of "jis", "sjis" and "euc".
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	134 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	135 ;# $jcode'z2hf{'xxx'}
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	136 ;# $jcode'h2zf{'xxx'}
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	137 ;# These are pointer to the corresponding function just
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	138 ;# as $jcode'convf.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	139 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	140 ;# ---------------------------------------------------------------
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	141 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	142 ;# &jcode'tr(*line, $from, $to [, $option])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	143 ;# &jcode'tr emulates tr operator for 2 byte code. Only 'd'
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	144 ;# is interpreted as an option.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	145 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	146 ;# Range operator like `A-Z' for 2 byte code is partially
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	147 ;# supported. Code must be JIS or EUC, and first byte
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	148 ;# have to be same on first and last character.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	149 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	150 ;# CAUTION: Handling range operator is a kind of trick
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	151 ;# and it is not perfect. So if you need to transfer `-'
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	152 ;# character, please be sure to put it at the beginning
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	153 ;# or the end of $from and $to strings.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	154 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	155 ;# &jcode'trans($line, $from, $to [, $option)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	156 ;# Same as &jcode'tr but accept string and return string
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	157 ;# after translation.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	158 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	159 ;# ---------------------------------------------------------------
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	160 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	161 ;# &jcode'init()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	162 ;# Initialize the variables used in this package. You
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	163 ;# don't have to call this when using jocde.pl by `do' or
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	164 ;# `require' interface. Call it first if you embedded
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	165 ;# the jcode.pl at the end of your script.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	166 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	167 ;######################################################################
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	168 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	169 ;# PERL5 INTERFACE:
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	170 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	171 ;# Current jcode.pl is written in Perl 4 but it is possible to use
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	172 ;# from Perl 5 using `references'. Fully perl5 capable version is
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	173 ;# future issue.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	174 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	175 ;# Since lexical variable is not a subject of typeglob, *string style
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	176 ;# call doesn't work if the variable is declared as `my'. Same thing
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	177 ;# happens to special variable $_ if the perl is compiled to use
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	178 ;# thread capability. So using reference is generally recommented to
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	179 ;# avoid the mysterious error.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	180 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	181 ;# jcode::getcode(\$line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	182 ;# jcode::convert(\$line, $ocode [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	183 ;# jcode::xxx2yyy(\$line [, $option])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	184 ;# &{$jcode::convf{'xxx', 'yyy'}}(\$line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	185 ;# jcode::to($ocode, $line [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	186 ;# jcode::jis($line [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	187 ;# jcode::euc($line [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	188 ;# jcode::sjis($line [, $icode [, $option]])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	189 ;# jcode::jis_inout($in, $out)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	190 ;# jcode::get_inout($string)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	191 ;# jcode::cache()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	192 ;# jcode::nocache()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	193 ;# jcode::flush()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	194 ;# jcode::h2z_xxx(\$line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	195 ;# jcode::z2h_xxx(\$line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	196 ;# &{$jcode::z2hf{'xxx'}}(\$line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	197 ;# &{$jcode::h2zf{'xxx'}}(\$line)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	198 ;# jcode::tr(\$line, $from, $to [, $option])
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	199 ;# jcode::trans($line, $from, $to [, $option)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	200 ;# jcode::init()
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	201 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	202 ;######################################################################
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	203 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	204 ;# SAMPLES
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	205 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	206 ;# Convert any Kanji code to JIS and print each line with code name.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	207 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	208 ;# while (defined($s = <>)) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	209 ;# $code = &jcode'convert(*s, 'jis');
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	210 ;# print $code, "\t", $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	211 ;# }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	212 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	213 ;# Convert all lines to JIS according to the first recognized line.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	214 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	215 ;# while (defined($s = <>)) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	216 ;# print, next unless $s =~ /[\033\200-\377]/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	217 ;# (f, $icode) = &jcode'convert(s, 'jis');
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	218 ;# print;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	219 ;# defined(&f) \|\| next;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	220 ;# while (<>) { &f(*s); print; }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	221 ;# last;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	222 ;# }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	223 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	224 ;# The safest way of JIS conversion.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	225 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	226 ;# while (defined($s = <>)) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	227 ;# ($matched, $icode) = &jcode'getcode(*s);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	228 ;# if (@buf == 0 && $matched == 0) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	229 ;# print $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	230 ;# next;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	231 ;# }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	232 ;# push(@buf, $s);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	233 ;# next unless $icode;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	234 ;# while (defined($s = shift(@buf))) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	235 ;# &jcode'convert(*s, 'jis', $icode);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	236 ;# print $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	237 ;# }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	238 ;# while (defined($s = <>)) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	239 ;# &jcode'convert(*s, 'jis', $icode);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	240 ;# print $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	241 ;# }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	242 ;# last;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	243 ;# }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	244 ;# print @buf if @buf;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	245 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	246 ;######################################################################
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	247
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	248 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	249 ;# Call initialize function if it is not called yet. This may sound
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	250 ;# strange but it makes easy to embed the jcode.pl at the end of
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	251 ;# script. Call &jcode'init at the beginning of the script in that
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	252 ;# case.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	253 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	254 &init unless defined $version;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	255
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	256 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	257 ;# Initialize variables.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	258 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	259 sub init {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	260 $version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unkown';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	261
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	262 $re_bin = '[\000-\006\177\377]';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	263
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	264 $re_jis0208_1978 = '\e\$\@';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	265 $re_jis0208_1983 = '\e\$B';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	266 $re_jis0208_1990 = '\e&\@\e\$B';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	267 $re_jis0208 = "$re_jis0208_1978\|$re_jis0208_1983\|$re_jis0208_1990";
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	268 $re_jis0212 = '\e\$\(D';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	269 $re_jp = "$re_jis0208\|$re_jis0212";
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	270 $re_asc = '\e\([BJ]';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	271 $re_kana = '\e\(I';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	272
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	273 $esc_0208 = "\e\$B";
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	274 $esc_0212 = "\e\$(D";
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	275 $esc_asc = "\e(B";
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	276 $esc_kana = "\e(I";
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	277
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	278 $re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	279 $re_sjis_kana = '[\241-\337]';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	280
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	281 $re_euc_c = '[\241-\376][\241-\376]';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	282 $re_euc_kana = '\216[\241-\337]';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	283 $re_euc_0212 = '\217[\241-\376][\241-\376]';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	284
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	285 # Use `geta' for undefined character code
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	286 $undef_sjis = "\x81\xac";
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	287
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	288 $cache = 1;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	289
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	290 # X0201 -> X0208 KANA conversion table. Looks weird? Not that
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	291 # much. This is simply JIS text without escape sequences.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	292 ($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\041-\176/\241-\376/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	293 ! !# $ !" % !& " !V # !W
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	294 ^ !+ _ !, 0 !<
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	295 ' %! ( %# ) %% * %' + %)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	296 , %c - %e . %g / %C
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	297 1 %" 2 %$ 3 %& 4 %( 5 %*
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	298 6 %+ 7 %- 8 %/ 9 %1 : %3
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	299 6^ %, 7^ %. 8^ %0 9^ %2 :^ %4
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	300 ; %5 < %7 = %9 > %; ? %=
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	301 ;^ %6 <^ %8 =^ %: >^ %< ?^ %>
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	302 @ %? A %A B %D C %F D %H
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	303 @^ %@ A^ %B B^ %E C^ %G D^ %I
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	304 E %J F %K G %L H %M I %N
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	305 J %O K %R L %U M %X N %[
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	306 J^ %P K^ %S L^ %V M^ %Y N^ %\
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	307 J_ %Q K_ %T L_ %W M_ %Z N_ %]
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	308 O %^ P %_ Q %` R %a S %b
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	309 T %d U %f V %h
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	310 W %i X %j Y %k Z %l [ %m
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	311 \ %o ] %s & %r 3^ %t
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	312 __TABLE_END__
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	313 %h2z = split(/\s+/, $h2z . $h2z_high);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	314 %z2h = reverse %h2z;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	315
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	316 $convf{'jis' , 'jis' } = *jis2jis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	317 $convf{'jis' , 'sjis'} = *jis2sjis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	318 $convf{'jis' , 'euc' } = *jis2euc;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	319 $convf{'euc' , 'jis' } = *euc2jis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	320 $convf{'euc' , 'sjis'} = *euc2sjis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	321 $convf{'euc' , 'euc' } = *euc2euc;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	322 $convf{'sjis' , 'jis' } = *sjis2jis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	323 $convf{'sjis' , 'sjis'} = *sjis2sjis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	324 $convf{'sjis' , 'euc' } = *sjis2euc;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	325 $h2zf{'jis' } = *h2z_jis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	326 $z2hf{'jis' } = *z2h_jis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	327 $h2zf{'euc' } = *h2z_euc;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	328 $z2hf{'euc' } = *z2h_euc;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	329 $h2zf{'sjis'} = *h2z_sjis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	330 $z2hf{'sjis'} = *z2h_sjis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	331 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	332
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	333 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	334 ;# Set escape sequences which should be put before and after Japanese
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	335 ;# (JIS X0208) string.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	336 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	337 sub jis_inout {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	338 $esc_0208 = shift \|\| $esc_0208;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	339 $esc_0208 = "\e\$$esc_0208" if length($esc_0208) == 1;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	340 $esc_asc = shift \|\| $esc_asc;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	341 $esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	342 ($esc_0208, $esc_asc);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	343 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	344
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	345 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	346 ;# Get JIS in and out sequences from the string.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	347 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	348 sub get_inout {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	349 local($esc_0208, $esc_asc);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	350 $_[$[] =~ /($re_jis0208)/o && ($esc_0208 = $1);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	351 $_[$[] =~ /($re_asc)/o && ($esc_asc = $1);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	352 ($esc_0208, $esc_asc);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	353 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	354
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	355 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	356 ;# Recognize character code.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	357 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	358 sub getcode {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	359 local(*s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	360 local($matched, $code);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	361
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	362 if ($s !~ /[\e\200-\377]/) { # not Japanese
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	363 $matched = 0;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	364 $code = undef;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	365 } # 'jis'
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	366 elsif ($s =~ /$re_jp\|$re_asc\|$re_kana/o) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	367 $matched = 1;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	368 $code = 'jis';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	369 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	370 elsif ($s =~ /$re_bin/o) { # 'binary'
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	371 $matched = 0;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	372 $code = 'binary';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	373 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	374 else { # should be 'euc' or 'sjis'
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	375 local($sjis, $euc) = (0, 0);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	376
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	377 while ($s =~ /(($re_sjis_c)+)/go) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	378 $sjis += length($1);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	379 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	380 while ($s =~ /(($re_euc_c\|$re_euc_kana\|$re_euc_0212)+)/go) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	381 $euc += length($1);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	382 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	383 $matched = &max($sjis, $euc);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	384 $code = ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1];
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	385 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	386 wantarray ? ($matched, $code) : $code;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	387 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	388 sub max { $_[ $[ + ($_[ $[ ] < $_[ $[ + 1 ]) ]; }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	389
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	390 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	391 ;# Convert any code to specified code.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	392 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	393 sub convert {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	394 local(*s, $ocode, $icode, $opt) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	395 return (undef, undef) unless $icode = $icode \|\| &getcode(*s);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	396 return (undef, $icode) if $icode eq 'binary';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	397 $ocode = 'jis' unless $ocode;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	398 $ocode = $icode if $ocode eq 'noconv';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	399 local(*f) = $convf{$icode, $ocode};
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	400 &f(*s, $opt);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	401 wantarray ? (*f, $icode) : $icode;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	402 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	403
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	404 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	405 ;# Easy return-by-value interfaces.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	406 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	407 sub jis { &to('jis', @_); }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	408 sub euc { &to('euc', @_); }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	409 sub sjis { &to('sjis', @_); }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	410 sub to {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	411 local($ocode, $s, $icode, $opt) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	412 &convert(*s, $ocode, $icode, $opt);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	413 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	414 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	415 sub what {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	416 local($s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	417 &getcode(*s);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	418 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	419 sub trans {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	420 local($s) = shift;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	421 &tr(*s, @_);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	422 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	423 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	424
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	425 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	426 ;# SJIS to JIS
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	427 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	428 sub sjis2jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	429 local(*s, $opt, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	430 &sjis2sjis(*s, $opt) if $opt;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	431 $s =~ s/(($re_sjis_c\|$re_sjis_kana)+)/&_sjis2jis($1) . $esc_asc/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	432 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	433 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	434 sub _sjis2jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	435 local($s) = shift;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	436 $s =~ s/(($re_sjis_c)+\|($re_sjis_kana)+)/&__sjis2jis($1)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	437 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	438 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	439 sub __sjis2jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	440 local($s) = shift;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	441 if ($s =~ /^$re_sjis_kana/o) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	442 $n += $s =~ tr/\241-\337/\041-\137/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	443 $esc_kana . $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	444 } else {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	445 $n += $s =~ s/($re_sjis_c)/$s2e{$1}\|\|&s2e($1)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	446 $s =~ tr/\241-\376/\041-\176/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	447 $esc_0208 . $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	448 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	449 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	450
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	451 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	452 ;# EUC to JIS
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	453 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	454 sub euc2jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	455 local(*s, $opt, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	456 &euc2euc(*s, $opt) if $opt;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	457 $s =~ s/(($re_euc_c\|$re_euc_kana\|$re_euc_0212)+)/
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	458 &_euc2jis($1) . $esc_asc
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	459 /geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	460 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	461 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	462 sub _euc2jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	463 local($s) = shift;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	464 $s =~ s/(($re_euc_c)+\|($re_euc_kana)+\|($re_euc_0212)+)/&__euc2jis($1)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	465 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	466 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	467 sub __euc2jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	468 local($s) = shift;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	469 local($esc);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	470
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	471 if ($s =~ tr/\216//d) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	472 $esc = $esc_kana;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	473 } elsif ($s =~ tr/\217//d) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	474 $esc = $esc_0212;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	475 } else {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	476 $esc = $esc_0208;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	477 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	478
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	479 $n += $s =~ tr/\241-\376/\041-\176/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	480 $esc . $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	481 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	482
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	483 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	484 ;# JIS to EUC
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	485 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	486 sub jis2euc {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	487 local(*s, $opt, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	488 $s =~ s/($re_jp\|$re_asc\|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	489 &euc2euc(*s, $opt) if $opt;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	490 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	491 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	492 sub _jis2euc {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	493 local($esc, $s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	494 if ($esc !~ /^$re_asc/o) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	495 $n += $s =~ tr/\041-\176/\241-\376/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	496 if ($esc =~ /^$re_kana/o) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	497 $s =~ s/([\241-\337])/\216$1/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	498 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	499 elsif ($esc =~ /^$re_jis0212/o) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	500 $s =~ s/([\241-\376][\241-\376])/\217$1/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	501 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	502 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	503 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	504 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	505
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	506 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	507 ;# JIS to SJIS
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	508 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	509 sub jis2sjis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	510 local(*s, $opt, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	511 &jis2jis(*s, $opt) if $opt;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	512 $s =~ s/($re_jp\|$re_asc\|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	513 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	514 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	515 sub _jis2sjis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	516 local($esc, $s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	517 if ($esc =~ /^$re_jis0212/o) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	518 $s =~ s/../$undef_sjis/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	519 $n = length;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	520 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	521 elsif ($esc !~ /^$re_asc/o) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	522 $n += $s =~ tr/\041-\176/\241-\376/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	523 if ($esc =~ /^$re_jp/o) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	524 $s =~ s/($re_euc_c)/$e2s{$1}\|\|&e2s($1)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	525 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	526 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	527 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	528 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	529
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	530 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	531 ;# SJIS to EUC
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	532 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	533 sub sjis2euc {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	534 local(*s, $opt,$n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	535 $n = $s =~ s/($re_sjis_c\|$re_sjis_kana)/$s2e{$1}\|\|&s2e($1)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	536 &euc2euc(*s, $opt) if $opt;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	537 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	538 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	539 sub s2e {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	540 local($c1, $c2, $code);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	541 ($c1, $c2) = unpack('CC', $code = shift);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	542
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	543 if (0xa1 <= $c1 && $c1 <= 0xdf) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	544 $c2 = $c1;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	545 $c1 = 0x8e;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	546 } elsif (0x9f <= $c2) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	547 $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	548 $c2 += 2;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	549 } else {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	550 $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	551 $c2 += 0x60 + ($c2 < 0x7f);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	552 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	553 if ($cache) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	554 $s2e{$code} = pack('CC', $c1, $c2);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	555 } else {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	556 pack('CC', $c1, $c2);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	557 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	558 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	559
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	560 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	561 ;# EUC to SJIS
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	562 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	563 sub euc2sjis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	564 local(*s, $opt,$n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	565 &euc2euc(*s, $opt) if $opt;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	566 $n = $s =~ s/($re_euc_c\|$re_euc_kana\|$re_euc_0212)/$e2s{$1}\|\|&e2s($1)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	567 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	568 sub e2s {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	569 local($c1, $c2, $code);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	570 ($c1, $c2) = unpack('CC', $code = shift);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	571
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	572 if ($c1 == 0x8e) { # SS2
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	573 return substr($code, 1, 1);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	574 } elsif ($c1 == 0x8f) { # SS3
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	575 return $undef_sjis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	576 } elsif ($c1 % 2) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	577 $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	578 $c2 -= 0x60 + ($c2 < 0xe0);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	579 } else {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	580 $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	581 $c2 -= 2;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	582 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	583 if ($cache) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	584 $e2s{$code} = pack('CC', $c1, $c2);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	585 } else {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	586 pack('CC', $c1, $c2);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	587 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	588 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	589
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	590 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	591 ;# JIS to JIS, SJIS to SJIS, EUC to EUC
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	592 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	593 sub jis2jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	594 local(*s, $opt) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	595 $s =~ s/$re_jis0208/$esc_0208/go;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	596 $s =~ s/$re_asc/$esc_asc/go;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	597 &h2z_jis(*s) if $opt =~ /z/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	598 &z2h_jis(*s) if $opt =~ /h/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	599 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	600 sub sjis2sjis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	601 local(*s, $opt) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	602 &h2z_sjis(*s) if $opt =~ /z/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	603 &z2h_sjis(*s) if $opt =~ /h/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	604 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	605 sub euc2euc {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	606 local(*s, $opt) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	607 &h2z_euc(*s) if $opt =~ /z/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	608 &z2h_euc(*s) if $opt =~ /h/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	609 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	610
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	611 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	612 ;# Cache control functions
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	613 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	614 sub cache {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	615 ($cache, $cache = 1)[$[];
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	616 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	617 sub nocache {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	618 ($cache, $cache = 0)[$[];
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	619 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	620 sub flushcache {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	621 undef %e2s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	622 undef %s2e;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	623 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	624
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	625 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	626 ;# X0201 -> X0208 KANA conversion routine
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	627 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	628 sub h2z_jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	629 local(*s, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	630 if ($s =~ s/$re_kana([^\e]*)/$esc_0208 . &_h2z_jis($1)/geo) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	631 1 while $s =~ s/(($re_jis0208)[^\e]*)($re_jis0208)/$1/o;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	632 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	633 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	634 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	635 sub _h2z_jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	636 local($s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	637 $n += $s =~ s/([\41-\137]([\136\137])?)/$h2z{$1}/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	638 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	639 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	640
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	641 sub h2z_euc {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	642 local(*s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	643 $s =~ s/\216([\241-\337])(\216([\336\337]))?/$h2z{"$1$3"}/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	644 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	645
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	646 sub h2z_sjis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	647 local(*s, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	648 $s =~ s/(($re_sjis_c)+)\|(([\241-\337])([\336\337])?)/
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	649 $1 \|\| ($n++, $e2s{$h2z{$3}} \|\| &e2s($h2z{$3}))
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	650 /geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	651 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	652 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	653
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	654 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	655 ;# X0208 -> X0201 KANA conversion routine
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	656 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	657 sub z2h_jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	658 local(*s, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	659 $s =~ s/($re_jis0208)([^\e]+)/&_z2h_jis($2)/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	660 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	661 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	662 sub _z2h_jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	663 local($s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	664 $s =~ s/((\%[!-~]\|![\#\"&VW+,<])+\|([^!%][!-~]\|![^\#\"&VW+,<])+)/
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	665 &__z2h_jis($1)
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	666 /ge;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	667 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	668 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	669 sub __z2h_jis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	670 local($s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	671 return $esc_0208 . $s unless /^%/ \|\| $s =~ /^![\#\"&VW+,<]/;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	672 $n += length($s) / 2;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	673 $s =~ s/(..)/$z2h{$1}/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	674 $esc_kana . $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	675 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	676
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	677 sub z2h_euc {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	678 local(*s, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	679 &init_z2h_euc unless defined %z2h_euc;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	680 $s =~ s/($re_euc_c\|$re_euc_kana)/
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	681 $z2h_euc{$1} ? ($n++, $z2h_euc{$1}) : $1
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	682 /geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	683 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	684 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	685
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	686 sub z2h_sjis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	687 local(*s, $n) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	688 &init_z2h_sjis unless defined %z2h_sjis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	689 $s =~ s/($re_sjis_c)/$z2h_sjis{$1} ? ($n++, $z2h_sjis{$1}) : $1/geo;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	690 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	691 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	692
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	693 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	694 ;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	695 ;# can be done in &init but it's not worth doing. Similarly,
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	696 ;# precalculated table is not worth to occupy the file space and
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	697 ;# reduce the readability. The author personnaly discourages to use
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	698 ;# X0201 Kana character in the any situation.
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	699 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	700 sub init_z2h_euc {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	701 local($k, $s);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	702 while (($k, $s) = each %z2h) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	703 $s =~ s/([\241-\337])/\216$1/g && ($z2h_euc{$k} = $s);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	704 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	705 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	706 sub init_z2h_sjis {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	707 local($s, $v);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	708 while (($s, $v) = each %z2h) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	709 $s =~ /[\200-\377]/ && ($z2h_sjis{&e2s($s)} = $v);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	710 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	711 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	712
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	713 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	714 ;# TR function for 2-byte code
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	715 ;#
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	716 sub tr {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	717 # $prev_from, $prev_to, %table are persistent variables
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	718 local(*s, $from, $to, $opt) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	719 local(@from, @to);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	720 local($jis, $n) = (0, 0);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	721
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	722 $jis++, &jis2euc(*s) if $s =~ /$re_jp\|$re_asc\|$re_kana/o;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	723 $jis++ if $to =~ /$re_jp\|$re_asc\|$re_kana/o;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	724
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	725 if (!defined($prev_from) \|\| $from ne $prev_from \|\| $to ne $prev_to) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	726 ($prev_from, $prev_to) = ($from, $to);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	727 undef %table;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	728 &_maketable;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	729 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	730
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	731 $s =~ s/([\200-\377][\000-\377]\|[\000-\377])/
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	732 defined($table{$1}) && ++$n ? $table{$1} : $1
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	733 /ge;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	734
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	735 &euc2jis(*s) if $jis;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	736
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	737 $n;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	738 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	739
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	740 sub _maketable {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	741 local($ascii) = '(\\\\[\\-\\\\]\|[\0-\133\135-\177])';
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	742
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	743 &jis2euc(*to) if $to =~ /$re_jp\|$re_asc\|$re_kana/o;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	744 &jis2euc(*from) if $from =~ /$re_jp\|$re_asc\|$re_kana/o;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	745
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	746 grep(s/(([\200-\377])[\200-\377]-\2[\200-\377])/&_expnd2($1)/ge,
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	747 $from, $to);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	748 grep(s/($ascii-$ascii)/&_expnd1($1)/geo,
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	749 $from, $to);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	750
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	751 @to = $to =~ /[\200-\377][\000-\377]\|[\000-\377]/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	752 @from = $from =~ /[\200-\377][\000-\377]\|[\000-\377]/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	753 push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	754 @table{@from} = @to;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	755 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	756
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	757 sub _expnd1 {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	758 local($s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	759 $s =~ s/\\(.)/$1/g;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	760 local($c1, $c2) = unpack('CxC', $s);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	761 if ($c1 <= $c2) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	762 for ($s = ''; $c1 <= $c2; $c1++) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	763 $s .= pack('C', $c1);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	764 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	765 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	766 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	767 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	768
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	769 sub _expnd2 {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	770 local($s) = @_;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	771 local($c1, $c2, $c3, $c4) = unpack('CCxCC', $s);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	772 if ($c1 == $c3 && $c2 <= $c4) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	773 for ($s = ''; $c2 <= $c4; $c2++) {
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	774 $s .= pack('CC', $c1, $c2);
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	775 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	776 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	777 $s;
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	778 }
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	779
a2f0a2c135cf hg init Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp> parents: diff changeset	780 1;

Mercurial > hg > Applications > casawiki

annotate jcode.pl @ 1:0b233d5d1944