1#
2# -*- Perl -*-
3# $Id: CodeConv.pm,v 1.7 2003/05/30 12:43:41 togawa Exp $
4#
5# This code is from Namazu. Thanks.
6# codeconv.pl,v 1.3 1999/11/03 05:12:13 satoru Exp
7#
8# Copyright (C) 1997-1999 Satoru Takabayashi  All rights reserved.
9# Patched by Kenji Suzuki, Akihiro Arisawa, HyperNikkiSystem Project
10#     This is free software with ABSOLUTELY NO WARRANTY.
11#
12#  This program is free software; you can redistribute it and/or modify
13#  it under the terms of the GNU General Public License as published by
14#  the Free Software Foundation; either versions 2, or (at your option)
15#  any later version.
16#
17#  This program is distributed in the hope that it will be useful
18#  but WITHOUT ANY WARRANTY; without even the implied warranty of
19#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20#  GNU General Public License for more details.
21#
22#  You should have received a copy of the GNU General Public License
23#  along with this program; if not, write to the Free Software
24#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25#  02111-1307, USA
26#
27#  This file must be encoded in EUC-JP encoding
28#
29# package for code conversion
30#
31#   imported from  Rei FURUKAWA <furukawa@dkv.yamaha.co.jp> san's pnamazu.
32#   [1998-09-24]
33
34package CodeConv;
35use strict;
36
37my @ktoe = (0xA3, 0xD6, 0xD7, 0xA2, 0xA6, 0xF2, 0xA1, 0xA3,
38	     0xA5, 0xA7, 0xA9, 0xE3, 0xE5, 0xE7, 0xC3, 0xBC,
39	     0xA2, 0xA4, 0xA6, 0xA8, 0xAA, 0xAB, 0xAD, 0xAF,
40	     0xB1, 0xB3, 0xB5, 0xB7, 0xB9, 0xBB, 0xBD, 0xBF,
41	     0xC1, 0xC4, 0xC6, 0xC8, 0xCA, 0xCB, 0xCC, 0xCD,
42	     0xCE, 0xCF, 0xD2, 0xD5, 0xD8, 0xDB, 0xDE, 0xDF,
43	     0xE0, 0xE1, 0xE2, 0xE4, 0xE6, 0xE8, 0xE9, 0xEA,
44	     0xEB, 0xEC, 0xED, 0xEF, 0xF3, 0xAB, 0xAC, );
45my $NKF; # 0: jcode.pl
46         # 1: NKF.pm
47         # 2: Jcode.pm
48
49BEGIN {
50    eval 'use Jcode';
51    unless ($@){        # Jcode.pm installed
52        $NKF = 2;
53    }
54    else {
55        eval 'use NKF';
56        unless ($@){	# NKF.pm installed
57            $NKF = 1;
58        }
59        else {
60            $NKF = 0;
61            require "jcode.pl";
62        }
63    }
64}
65
66# convert JIS X0201 KANA characters to JIS X0208 KANA
67sub ktoe {
68    my ($c1, $c2) = @_;
69    $c1 = ord($c1) & 0x7f;
70    my($hi) = ($c1 <= 0x25 || $c1 == 0x30 || 0x5e <= $c1)? "\xa1": "\xa5";
71    $c1 -= 0x21;
72    my($lo) = $ktoe[$c1];
73    if ($c2){
74        if ($c1 == 5){
75            $lo = 0xdd;
76        }else{
77            $lo++;
78            $lo++ if ord($c2) & 0x7f == 0x5f;
79        }
80    }
81    return $hi . chr($lo);
82}
83
84# convert Shift_JIS to EUC-JP
85sub stoe ($$) {
86    my($c1, $c2) = @_;
87
88    $c1 = ord($c1);
89    $c2 = ord($c2);
90    $c1 += ($c1 - 0x60) & 0x7f;
91    if ($c2 < 0x9f){
92        $c1--;
93        $c2 += ($c2 < 0x7f) + 0x60;
94    }else{
95        $c2 += 2;
96    }
97    return chr($c1) . chr($c2);
98}
99
100sub shiftjis_to_eucjp ($){
101    my ($str) = @_;
102    $str =~ s/([\x81-\x9f\xe0-\xfa])(.)|([\xa1-\xdf])([\xde\xdf]?)/($3? ktoe($3, $4): stoe($1, $2))/ge;
103    return $str;
104}
105
106sub etos($$) {
107    my($c1, $c2) = @_;
108
109    $c1 = ord($c1) & 0x7f;
110    $c2 = ord($c2) & 0x7f;
111
112    if ($c1 & 1) {
113        $c1 = ($c1 >> 1) + 0x71;
114        $c2 += 0x1f;
115        $c2++ if $c2 >= 0x7f;
116    } else {
117        $c1 = ($c1 >> 1) + 0x70;
118        $c2 += 0x7e;
119    }
120    $c1 += 0x40 if $c1 > 0x9f;
121
122    return chr($c1) . chr($c2);
123}
124
125sub eucjp_to_shiftjis ($) {
126    my ($str) = @_;
127    $str =~ s/([\xa1-\xfe])([\xa1-\xfe])/etos($1, $2)/ge;
128    return $str;
129}
130
131sub toeuc ($) {
132    my ($line) = @_;
133
134    if ($NKF == 2 ) {
135        &Jcode::convert($line, 'euc');
136    }
137    elsif ($NKF == 1 ) {
138        $$line = nkf("-em0", $$line);
139    }
140    else {
141        &jcode::convert($line, 'euc');
142    }
143    return $line;
144}
145
146sub tosjis ($) {
147    my ($line) = @_;
148
149    if ($NKF == 2) {
150        &Jcode::convert($line, 'sjis');
151    }
152    elsif ($NKF == 1) {
153        $$line = nkf("-sm0", $$line);
154    }
155    else {
156        &jcode::convert($line, 'sjis');
157    }
158    return $line;
159}
160
161sub tojis ($) {
162    my ($line) = @_;
163
164    if ($NKF == 2) {
165        &Jcode::convert($line, 'jis');
166    }
167    elsif ($NKF == 1) {
168        $$line = nkf("-jm0", $$line);
169    }
170    else {
171        &jcode::convert($line, 'jis');
172    }
173    return $line;
174}
175
1761;
177