home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.madoka.org
/
2014.12.ftp.madoka.org.tar
/
ftp.madoka.org
/
pub
/
plum
/
2.x
/
plum2_26_1.lzh
/
support
/
cnvcode
< prev
next >
Wrap
Text File
|
1998-07-31
|
9KB
|
378 lines
#!/bin/perl -w
# $Id: cnvcode,v 2.12 1998/03/19 02:05:07 hasegawa Exp $
# copyright (c)1997-1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
&main(@ARGV);
sub main {
local(@args) = @_;
local($input, $output, $return, $arg);
$input = 'jis';
$output = 'jis';
$return = "\n";
if (!@args) {
&usage();
exit(1);
}
binmode(STDIN);
binmode(STDOUT);
while (@args) {
$arg = shift(@args);
if ($arg =~ /^\-/) {
if ($arg eq '-') {
&convert(shift(@args), $input, $output, $return);
} elsif ($arg eq '--') {
&convert($arg, $input, $output, $return);
} elsif ($arg eq '-l' || $arg eq '--lf') {
$return = "\n";
} elsif ($arg eq '-r' || $arg eq '--cr') {
$return = "\r";
} elsif ($arg eq '-n' || $arg eq '--crlf') {
$return = "\r\n";
} elsif ($arg eq '-i') {
$input = shift(@args);
} elsif ($arg =~ /^\-\-input\=/) {
$input = $';
} elsif ($arg eq '-o') {
$output = shift(@args);
} elsif ($arg =~ /^\-\-output\=/) {
$output = $';
} else {
&usage();
exit(1);
}
} else {
&convert($arg, $input, $output, $return);
}
}
}
sub convert {
local($file, $input, $output, $return) = @_;
local(@sub, $sub, $tmp, $buf, @item);
foreach $in (split(/\,/, $input)) {
$sub = $in . '_' . $output;
if (!defined(&$sub)) {
warn 'cannot convert ', $in, ' to ', $output, "\n";
return;
}
push(@sub, $sub);
}
if ($file eq '--') {
open(FILE, '<&STDIN');
} elsif (open(FILE, $file)) {
binmode(FILE);
} else {
warn $file, ' not found', "\n";
return;
}
$buf = '';
$tmp = '';
while (read(FILE, $tmp, 1024)) {
$buf .= $tmp;
while ($buf =~ /(\r\n|\n|\r)/) {
@item = ($`, $');
foreach $sub (@sub) {
$item[0] = &$sub($item[0]);
}
print $item[0], $return;
$buf = $item[1] || '';
}
}
close(FILE);
}
sub usage {
print 'usage: perl cnvcode [<option>] [<file>] ...', "\n";
print 'options:', "\n";
print ' -i, --input=<code>[,<code>] input kanji codes', "\n";
print ' -o, --output=<code> output kanji code', "\n";
print ' -l, --lf line feed only (UNIX)', "\n";
print ' -r, --cr carriage return only (Macintosh)', "\n";
print ' -n, --crlf line feed and carriage return (MS-DOS/Windows)', "\n";
print 'codes:', "\n";
print ' jis euc sjis', "\n";
}
sub 'euc_euc {
local($euc) = @_;
return $euc;
}
sub 'euc_jis {
local($euc) = @_;
local($jis, $kanji, $c, $n, $i);
$kanji = 0;
$jis = '';
$euc = &'euc_euc($euc);
for ($i = 0; $i < length($euc); $i++) {
$c = substr($euc, $i, 1);
$n = ord($c);
if ($n >= 0xa1) {
if ($kanji != 1) {
$jis .= "\e\$B";
$kanji = 1;
}
$jis .= pack('C', $n & 0x7f);
$i++;
$jis .= pack('C', ord(substr($euc, $i, 1)) & 0x7f);
} elsif ($n == 0x8e) {
if ($kanji != 2) {
$jis .= "\e(I";
$kanji = 2;
}
$i++;
$jis .= pack('C', ord(substr($euc, $i, 1)) & 0x7f);
} else {
if ($kanji) {
$jis .= "\e\(B";
$kanji = 0;
}
$jis .= $c;
}
}
$jis .= "\e\(B" if $kanji;
return $jis;
}
sub 'euc_sjis {
local($euc) = @_;
local($sjis, $c, $n1, $n2, $i);
$sjis = '';
$euc = &'euc_euc($euc);
for ($i = 0; $i < length($euc); $i++) {
$c = substr($euc, $i, 1);
$n1 = ord($c);
if ($n1 >= 0xa1) {
$i++;
$n2 = ord(substr($euc, $i, 1));
if (($n1 & 0x01) == 0) {
$n2 -= 0x03;
} else {
$n2 -= 0x61;
}
$n2++ if $n2 >= 0x7f;
$n1 = ((($n1 - 0xa1) >> 1) + 0xa1) ^ 0x20;
$sjis .= pack('CC', $n1, $n2);
} elsif ($n1 == 0x8e) {
$i++;
$sjis .= substr($euc, $i, 1);
} else {
$sjis .= $c;
}
}
return $sjis;
}
sub 'jis_euc {
local($jis) = @_;
local($euc, $kanji, $i);
$kanji = 0;
$euc = '';
$jis = &'jis_jis($jis);
for ($i = 0; $i < length($jis); $i++) {
if (substr($jis, $i, 3) eq "\e\(B") {
$kanji = 0;
$i += 2;
next;
} elsif (substr($jis, $i, 3) eq "\e\$B") {
$kanji = 1;
$i += 2;
next;
} elsif (substr($jis, $i, 3) eq "\e\(I") {
$kanji = 2;
$i += 2;
next;
}
if ($kanji == 0) {
$euc .= substr($jis, $i, 1);
} elsif ($kanji == 1) {
$euc .= pack('C', ord(substr($jis, $i, 1)) | 0x80);
$i++;
$euc .= pack('C', ord(substr($jis, $i, 1)) | 0x80);
} else {
$euc .= "\x8e" . pack('C', ord(substr($jis, $i, 1)) | 0x80);
}
}
return $euc;
}
sub 'jis_jis {
local($jis) = @_;
local($ret, $kanji, $last, $seq, $c, $i);
$kanji = 0;
$last = 0;
$ret = '';
for ($i = 0; $i < length($jis); $i++) {
$c = substr($jis, $i, 1);
$seq = substr($jis, $i, 3);
if ($seq eq "\e\$\@" || $seq eq "\e\$B") {
$ret .= "\e\$B";
$kanji = 1;
$i += 2;
next;
} elsif ($seq eq "\e(J" || $seq eq "\e(B") {
$ret .= "\e(B";
$kanji = 0;
$i += 2;
next;
} elsif ($seq eq "\e(I") {
$ret .= "\e(I";
$kanji = 2;
$i += 2;
next;
} elsif ($c eq "\cN") {
if ($kanji != 2) {
$last = $kanji;
$ret .= "\e(I";
$kanji = 2;
}
next;
} elsif ($c eq "\cO") {
if ($kanji != 2) {
if ($last) {
$ret .= "\e\$B";
} else {
$ret .= "\e(B";
}
$kanji = $last;
}
next;
} elsif (substr($jis, $i, 6) eq "\e&\@\e\$B") {
$ret .= "\e\$B";
$kanji = 1;
$i += 5;
next;
}
if ($kanji == 0) {
$ret .= $c;
} elsif ($kanji == 1) {
$ret .= substr($jis, $i, 2);
$i++;
} else {
$ret .= $c;
}
}
$ret .= "\e(B" if $kanji;
return $ret;
}
sub 'jis_sjis {
local($jis) = @_;
local($sjis, $kanji, $n1, $n2, $i);
$kanji = 0;
$sjis = '';
$jis = &'jis_jis($jis);
for ($i = 0; $i < length($jis); $i++) {
if (substr($jis, $i, 3) eq "\e\(B") {
$kanji = 0;
$i += 2;
next;
} elsif (substr($jis, $i, 3) eq "\e\$B") {
$kanji = 1;
$i += 2;
next;
} elsif (substr($jis, $i, 3) eq "\e\(I") {
$kanji = 2;
$i += 2;
next;
}
if ($kanji == 0) {
$sjis .= substr($jis, $i, 1);
} elsif ($kanji == 1) {
$n1 = ord(substr($jis, $i, 1));
$i++;
$n2 = ord(substr($jis, $i, 1));
if (($n1 & 0x01) == 0) {
$n2 += 0x7d;
} else {
$n2 += 0x1f;
}
$n2++ if $n2 >= 0x7f;
$n1 = ((($n1 - 0x21) >> 1) + 0xa1) ^ 0x20;
$sjis .= pack('CC', $n1, $n2);
} else {
$sjis .= pack('C', ord(substr($jis, $i, 1)) | 0x80);
}
}
return $sjis;
}
sub 'sjis_euc {
local($sjis) = @_;
local($euc, $c, $n1, $n2, $i);
$euc = '';
$sjis = &'sjis_sjis($sjis);
for ($i = 0; $i < length($sjis); $i++) {
$c = substr($sjis, $i, 1);
$n1 = ord($c);
if ($n1 >= 0xa0 && $n1 <= 0xdf) {
$euc .= "\x8e$c";
} elsif ($n1 >= 0x81) {
$i++;
$n2 = ord(substr($sjis, $i, 1));
$n2-- if $n2 > 0x7f;
if ($n2 >= 0x9e) {
$n1 = ((($n1 ^ 0x20) - 0xa1) << 1) + 0xa2;
$n2 += 0x03;
} else {
$n1 = ((($n1 ^ 0x20) - 0xa1) << 1) + 0xa1;
$n2 += 0x61
}
$euc .= pack('CC', $n1, $n2);
} else {
$euc .= $c;
}
}
return $euc;
}
sub 'sjis_jis {
local($sjis) = @_;
local($jis, $kanji, $c, $n1, $n2, $i);
$kanji = 0;
$jis = '';
$sjis = &'sjis_sjis($sjis);
for ($i = 0; $i < length($sjis); $i++) {
$c = substr($sjis, $i, 1);
$n1 = ord($c);
if ($n1 >= 0xa0 && $n1 <= 0xdf) {
if ($kanji != 2) {
$jis .= "\e(I";
$kanji = 2;
}
$jis .= pack('C', $n1 & 0x7f);
} elsif ($n1 >= 0x81) {
if ($kanji != 1) {
$jis .= "\e\$B";
$kanji = 1;
}
$i++;
$n2 = ord(substr($sjis, $i, 1));
$n2-- if $n2 > 0x7f;
if ($n2 >= 0x9e) {
$n1 = ((($n1 ^ 0x20) - 0xa1) << 1) + 0x22;
$n2 -= 0x7d;
} else {
$n1 = ((($n1 ^ 0x20) - 0xa1) << 1) + 0x21;
$n2 -= 0x1f;
}
$jis .= pack('CC', $n1, $n2);
} else {
if ($kanji) {
$jis .= "\e\(B";
$kanji = 0;
}
$jis .= $c;
}
}
$jis .= "\e\(B" if $kanji;
return $jis;
}
sub 'sjis_sjis {
local($sjis) = @_;
return $sjis;
}