[Mew-dist 10318] Re: Japanese nickname in Addrbook
Kazumasa Utashiro
utashiro at example.com
1999年 8月 21日 (土) 23:55:10 JST
From: OBATA Noboru <obata at example.com>
Subject: [Mew-dist 10316] Re: Japanese nickname in Addrbook
Date: Sat, 21 Aug 1999 18:35:31 +0900
> > 実は eyeball-check しかしていないので、誰かテストしてください。
>
> perl はあまり分からないのですが、次のようにしないと imls で日本
> 語のニックネームが化けてしまいました。
これは全部チェックしたはずなのになあ... と思ったら、ちょっと古いファイ
ルの diff を送ってました。すみません。
もう一度、im-124 に対する diff を送ります。ついでに、若干実装を変更し
ました。imput, imsetup も直しました。imput の方は、念のために modifier
s を指定してあるんですが、必要無かったら取っても構いません。
--utashiro
-------------- next part --------------
*** IM/Japanese.pm.bak Fri Aug 20 15:15:03 1999
--- IM/Japanese.pm Sat Aug 21 23:01:41 1999
***************
*** 223,254 ****
#
sub conv_from_sjis ($) {
my $line = shift;
! $line =~ s/(($C_sjis)+|($C_sjis_kana)+)/s2j($&, $')/geo;
return $line;
}
!
! # s2e() is taken from jcode.pl-1.9/2.3 by utashiro at example.com
! ######################################################################
! #
! # jcode.pl: Perl library for Japanese character code conversion
! #
! # Copyright (c) 1995,1996,1997 Kazumasa Utashiro <utashiro at example.com>
! # Internet Initiative Japan Inc.
! # 1-4 Sanban-cho, Chiyoda-ku, Tokyo 102, Japan
! #
! # Copyright (c) 1992,1993,1994 Kazumasa Utashiro
! # Software Research Associates, Inc.
! #
! # Original version was developed under the name of srekcah at example.com
! # February 1992 and it was called kconv.pl at the beginning. This
! # address was a pen name for group of individuals and it is no longer
! # valid.
! #
! # Use and redistribution for any purpose, without significant
! # modification, is granted as long as all copyright notices are
! # retained. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND
! # ANY EXPRESS OR IMPLIED WARRANTIES ARE DISCLAIMED.
! ######################################################################
sub s2e ($) {
my $code = shift;
my ($c1, $c2) = unpack('CC', $code);
--- 223,236 ----
#
sub conv_from_sjis ($) {
my $line = shift;
! $line =~ s/((?:$C_sjis|$C_sjis_kana)+)/sjis2jis($1)/geo;
return $line;
}
! sub sjis2jis ($) {
! my $line = shift;
! $line =~ s/((?:$C_sjis)+|(?:$C_sjis_kana)+)/s2j($1)/geo;
! return "$line$E_asc";
! }
sub s2e ($) {
my $code = shift;
my ($c1, $c2) = unpack('CC', $code);
***************
*** 264,281 ****
}
return pack('CC', $c1, $c2);
}
! # s2j() is based on _sjis2jis() of jcode.pl-1.9/2.0 by utashiro at example.com
! sub s2j ($$) {
! my ($cur, $rest) = @_;
! if ($cur =~ /^($C_sjis_kana+)/o) {
$cur =~ tr/\xa1-\xdf/\x21-\x5f/;
! return "$E_kana$cur" if ($rest =~ /^($C_sjis|$C_sjis_kana)/o);
! return "$E_kana$cur$E_asc";
} else {
$cur =~ s/(..)/s2e($1)/ge;
$cur =~ tr/\xa1-\xfe/\x21-\x7e/;
! return "$E_jp$cur" if ($rest =~ /^($C_sjis|$C_sjis_kana)/o);
! return "$E_jp$cur$E_asc";
}
}
--- 246,260 ----
}
return pack('CC', $c1, $c2);
}
! sub s2j ($) {
! my $cur = shift;
! if ($cur =~ /^$C_sjis_kana/o) {
$cur =~ tr/\xa1-\xdf/\x21-\x5f/;
! return "$E_kana$cur";
} else {
$cur =~ s/(..)/s2e($1)/ge;
$cur =~ tr/\xa1-\xfe/\x21-\x7e/;
! return "$E_jp$cur";
}
}
***************
*** 287,306 ****
#
sub conv_from_euc ($) {
my $line = shift;
! $line =~ s/(($C_euc)+|($C_euc_kana)+)/e2j($&, $')/geo;
return $line;
}
! # e2j() is based on _euc2jis() of jcode.pl-1.9/2.0 by utashiro at example.com
! sub e2j ($$) {
! my ($cur, $rest) = @_;
$cur =~ tr/\xa1-\xfe/\x21-\x7e/;
! if ($cur =~ /\x8e/) {
! $cur =~ tr/\x8e//d;
! return "$E_kana$cur" if ($rest =~ /^($C_euc|$C_euc_kana)/o);
! return "$E_kana$cur$E_asc";
} else {
! return "$E_jp$cur" if ($rest =~ /^($C_euc|$C_euc_kana)/o);
! return "$E_jp$cur$E_asc";
}
}
--- 266,286 ----
#
sub conv_from_euc ($) {
my $line = shift;
! $line =~ s/((?:$C_euc|$C_euc_kana)+)/euc2jis($1)/geo;
return $line;
}
! sub euc2jis ($) {
! my $line = shift;
! $line =~ s/((?:$C_euc)+|(?:$C_euc_kana)+)/e2j($1)/geo;
! return "$line$E_asc";
! }
! sub e2j ($) {
! my $cur = shift;
$cur =~ tr/\xa1-\xfe/\x21-\x7e/;
! if ($cur =~ tr/\x8e//d) {
! return "$E_kana$cur";
} else {
! return "$E_jp$cur";
}
}
***************
*** 313,319 ****
sub conv_euc_from_sjis ($) {
my $line = shift;
! $line =~ s/$C_sjis|$C_sjis_kana/s2e($&)/geo;
return $line;
}
--- 293,299 ----
sub conv_euc_from_sjis ($) {
my $line = shift;
! $line =~ s/($C_sjis|$C_sjis_kana)/s2e($1)/geo;
return $line;
}
*** IM/Scan.pm.bak Fri Aug 20 15:15:04 1999
--- IM/Scan.pm Sat Aug 21 23:00:22 1999
***************
*** 887,898 ****
} while (/[,\\]$/ && defined($_ = <ADDRBOOK>));
$_ = $line;
s/"([^"]+)"/w2n($1)/geo;
! s/,\s+/,/g;
! if (/^(\S+)\s+(\S+)\s+(\S+)/) {
$key = $1;
! $addr = $2;
! $petname = $3;
! $_ = $';
next if ($key =~ /:$/);
next if $petname eq '*';
} else {
--- 887,897 ----
} while (/[,\\]$/ && defined($_ = <ADDRBOOK>));
$_ = $line;
s/"([^"]+)"/w2n($1)/geo;
! s/,\s+/,/g;
! if (s/^(\S+)\s+(\S+)\s+(\S+)//) {
$key = $1;
! $addr = $2;
! $petname = $3;
next if ($key =~ /:$/);
next if $petname eq '*';
} else {
*** imput.in.bak Fri Aug 20 15:15:02 1999
--- imput.in Sat Aug 21 23:07:22 1999
***************
*** 410,417 ****
my ($h);
foreach $h (@Add_headers) {
! if ($h =~ /^([\w\-]+):\s*/) {
! &add_header(\@Header, 0, $1, $');
}
}
--- 410,417 ----
my ($h);
foreach $h (@Add_headers) {
! if ($h =~ /^([\w\-]+):\s*(.*)/s) {
! &add_header(\@Header, 0, $1, $2);
}
}
*** imsetup.in.bak Fri Aug 20 15:15:02 1999
--- imsetup.in Sat Aug 21 23:14:59 1999
***************
*** 204,221 ****
open(MH_PROFILE, $mh_profile);
while(<MH_PROFILE>) {
chomp;
! if (/^Path:\s*/i) {
! $mhdir = $mail = $';
$mail =~ s/($home|~)\///;
}
! if (/^Aliasfile:\s*/i) {
! $mhalias = $';
}
! if (!$mhalias && /^ali:\s*-alias\s*/i) {
! $mhalias = $';
}
! if (/^Alternate-Mailboxes:\s*/i) {
! $address = $';
}
}
} else {
--- 204,221 ----
open(MH_PROFILE, $mh_profile);
while(<MH_PROFILE>) {
chomp;
! if (/^Path:\s*(.*)/i) {
! $mhdir = $mail = $1;
$mail =~ s/($home|~)\///;
}
! if (/^Aliasfile:\s*(.*)/i) {
! $mhalias = $1;
}
! if (!$mhalias && /^ali:\s*-alias\s*(.*)/i) {
! $mhalias = $1;
}
! if (/^Alternate-Mailboxes:\s*(.*)/i) {
! $address = $1;
}
}
} else {
***************
*** 287,294 ****
print "Setup $im_config.\n";
if (!$opt_noharm) {
my $a = extract_addr($address);
! $a =~ /\@/;
! $domain = $';
$nntpservers = $ENV{'NNTPSERVER'} || "localhost";
open(CONFIG, ">$im_config");
print CONFIG <<"---";
--- 287,295 ----
print "Setup $im_config.\n";
if (!$opt_noharm) {
my $a = extract_addr($address);
! if ($a =~ /\@(.*)/) {
! $domain = $1;
! }
$nntpservers = $ENV{'NNTPSERVER'} || "localhost";
open(CONFIG, ">$im_config");
print CONFIG <<"---";
Mew-dist メーリングリストの案内