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