s/Dialect/Language/snap-20010320

10 files changed, 518 insertions, 0 deletions

diff --git a/fml/lib/Language/.cvsignore b/fml/lib/Language/.cvsignore
new file mode 100644
index 00000000..b643ba41
--- /dev/null
+++ b/fml/lib/Language/.cvsignore
@@ -0,0 +1 @@
+@@doc
diff --git a/fml/lib/Language/ISO2022JP.pm b/fml/lib/Language/ISO2022JP.pm
new file mode 100644
index 00000000..f56f0615
--- /dev/null
+++ b/fml/lib/Language/ISO2022JP.pm
@@ -0,0 +1,75 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2001 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself. 
+#
+# $Id$
+# $FML$
+#
+
+package Dialect::ISO2022JP;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+
+=head1 NAME
+
+Dialect::ISO2022JP - adapter for Dialect::Japanese
+
+=head1 SYNOPSIS
+
+    use Dialect::ISO2022JP qw(is_iso2022jp_string);
+    if ( is_iso2022jp_string($string) ) { do_something_if_Japanese;}
+
+    use Dialect::ISO2022JP qw(STR2EUC);
+    $euc_string = STR2EUC( $string );
+
+=cut
+
+
+use Dialect::Japanese::Utils qw(is_iso2022jp_string);
+use Dialect::Japanese::String qw(STR2JIS STR2EUC STR2SJIS);
+
+require Exporter;
+@ISA = qw(Dialect::Japanese::Utils Dialect::Japanese::String Exporter);
+push(@EXPORT_OK, @Dialect::Japanese::Utils::EXPORT_OK);
+push(@EXPORT_OK, @Dialect::Japanese::String::EXPORT_OK);
+
+
+=head1 METHODS
+
+=head2 C<is_iso2022jp_string>
+
+See L<Dialect::Japanese::Utils>
+
+=head2 C<STR2JIS> C<STR2EUC> C<STR2SJIS>
+
+See L<Dialect::Japanese::String>
+
+=head1 SEE ALSO
+
+L<Dialect::Japanese::Utils>,
+L<Dialect::Japanese::String>
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself. 
+
+=head1 HISTORY
+
+Dialect::ISO2022JP appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Language/Japanese/.cvsignore b/fml/lib/Language/Japanese/.cvsignore
new file mode 100644
index 00000000..b643ba41
--- /dev/null
+++ b/fml/lib/Language/Japanese/.cvsignore
@@ -0,0 +1 @@
+@@doc
diff --git a/fml/lib/Language/Japanese/Makefile b/fml/lib/Language/Japanese/Makefile
new file mode 100644
index 00000000..4ed76816
--- /dev/null
+++ b/fml/lib/Language/Japanese/Makefile
@@ -0,0 +1,6 @@
+all: html
+
+html:	index.ja.html
+
+index.ja.html: *.pm
+	../../../../doc/bin/dir2url.pl > index.ja.html
diff --git a/fml/lib/Language/Japanese/String.pm b/fml/lib/Language/Japanese/String.pm
new file mode 100644
index 00000000..4e748e4b
--- /dev/null
+++ b/fml/lib/Language/Japanese/String.pm
@@ -0,0 +1,91 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2000 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself. 
+#
+# $Id$
+# $FML$
+#
+
+package Dialect::Japanese::String;
+use strict;
+use Carp;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+
+=head1 NAME
+
+Dialect::Japanese::String -- utilities to manipulate strings
+
+=head1 SYNOPSIS
+
+    use Dialect::Japanese::String qw(STR2JIS);
+    $euc_str = STR2JIS($str);
+
+=head1 METHOD
+
+=head2 C<STR2JIS(string)>
+
+convert CHARSET of the given string to JIS.
+
+=head2 C<STR2EUC(string)>
+
+convert CHARSET of the given string to EUC.
+
+=head2 C<STR2SJIS(string)>
+
+convert CHARSET of the given string to SJIS.
+
+=cut
+
+
+require Exporter;
+@ISA       = qw(Exporter); 
+@EXPORT_OK = qw(STR2JIS STR2EUC STR2SJIS);
+
+use Jcode;
+
+
+sub STR2EUC
+{
+    my ($str) = @_;
+    &Jcode::convert(\$str, 'euc');
+    $str;
+}
+
+
+sub STR2JIS
+{
+    my ($str) = @_;
+    &Jcode::convert(\$str, 'jis');
+    $str;
+}
+
+
+sub STR2SJIS
+{
+    my ($str) = @_;
+    &Jcode::convert(\$str, 'sjis');
+    $str;
+}
+
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself. 
+
+=head1 HISTORY
+
+Dialect::Japanese::String appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Language/Japanese/Subject.pm b/fml/lib/Language/Japanese/Subject.pm
new file mode 100644
index 00000000..3ccf5179
--- /dev/null
+++ b/fml/lib/Language/Japanese/Subject.pm
@@ -0,0 +1,161 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2001 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself. 
+#
+# $Id$
+# $FML$
+#
+
+
+###                                                   ###
+### CAUTION: THE CHARSET OF THIS FILE IS "EUC-JAPAN". ###
+###                                                   ###
+
+
+package Dialect::Japanese::Subject;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use Jcode;
+
+=head1 NAME
+
+Dialect::Japanese::Subject - Japanese specific handling of a subject
+
+=head1 SYNOPSIS
+
+    use Dialect::Japanese::Subject;
+    $is_reply = Dialect::Japanese::Subject::is_reply($subject);
+
+=head1 DESCRIPTION
+
+a collection to handle Japanese specific representations which appears
+in the subject.
+
+=cut
+
+
+require Exporter;
+@ISA = qw(Exporter);
+
+# XXX we should it in proper way in the future.
+# XXX but we import it anyway for further rewriting.
+my $CUT_OFF_RERERE_PATTERN = '';
+my $CUT_OFF_RERERE_HOOK    = '';
+
+
+# subjec reply pattern
+# apply patch from OGAWA Kunihiko <kuni@edit.ne.jp> 
+#            fml-support:7626 7653 07666
+#            Re: Re2:   Re[2]:     Re(2):     Re^2:    Re*2:
+my $pattern  = 'Re:|Re\d+:|Re\[\d+\]:|Re\(\d+\):|Re\^\d+:|Re\*\d+:';
+   $pattern .= '|(返信|返|ＲＥ|Ｒｅ)(\s*:|：)';
+
+
+=head1 METHODS
+
+=head2 C<new()>
+
+usual constructor.
+
+=head2 C<is_reply($string)>
+
+check whether C<$string> looks like a reply message.
+C<$string> is a C<Subject:> of the mail header.
+For example, it is like this:
+
+  Re: reply to your messages
+
+=cut
+
+
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+sub is_reply
+{
+    my ($self, $x) = @_;
+    return 0 unless $x;
+    &Jcode::convert(\$x, 'euc');
+    return ($x =~ /^((\s|(　))*($pattern)\s*)+/ ? 1 : 0);
+}
+
+
+=head2 C<cut_off_reply_tag($subject)>
+
+cut off C<Re:> in the string C<$subject> like C<Re: ... >
+within C<Subject:>.
+
+=cut
+
+
+# fml-support: 07507
+# sub CutOffRe
+# {
+#    いままでどおりの Re: とかとっぱらう 
+#
+#   if ($LANGUAGE eq 'Japanese') {
+#	日本語処理依存ライブラリへ飛ぶ
+#	この中で $CUT_OFF_PATTERN (config.ph)などにしたがって
+#	切り落とすのも良し（きっと日本語を書くだろうとおもうわけで
+#	で、このライブラリの先で実行する）
+#   }
+#
+#   run-hooks $CUT_OFF_HOOK(ユーザ定義HOOK)
+#}
+# レレレ対策
+sub cut_off_reply_tag
+{
+    my ($subject) = @_;
+    my ($y, $limit);
+
+    Jcode::convert(\$subject, 'euc');
+
+    if ($CUT_OFF_RERERE_PATTERN) {
+	Jcode::convert(\$CUT_OFF_RERERE_PATTERN, 'euc');
+    }
+
+    $pattern .= '|' . $CUT_OFF_RERERE_PATTERN if ($CUT_OFF_RERERE_PATTERN);
+
+    # fixed by OGAWA Kunihiko <kuni@edit.ne.jp> (fml-support: 07815)
+    # $subject =~ s/^((\s*|(　)*)*($pattern)\s*)+/Re: /oi;
+    $subject =~ s/^((\s|(　))*($pattern)\s*)+/Re: /oi;
+
+    if ($CUT_OFF_RERERE_HOOK) { 
+	eval($CUT_OFF_RERERE_HOOK);
+	&Log($@) if $@;
+    }
+
+    Jcode::convert(\$subject, 'jis');
+    $subject;
+}
+
+
+=head1 AUTHOR
+
+ Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself. 
+
+=head1 HISTORY
+
+Dialect::Japanese::Subject appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/Language/Japanese/Utils.pm b/fml/lib/Language/Japanese/Utils.pm
new file mode 100644
index 00000000..54595737
--- /dev/null
+++ b/fml/lib/Language/Japanese/Utils.pm
@@ -0,0 +1,102 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2001 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself. 
+#
+# $Id$
+# $FML$
+#
+
+package Dialect::Japanese::Utils;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+=head1 NAME
+
+Dialect::Japanese::Utils - what is this
+
+=head1 SYNOPSIS
+
+   use Dialect::Japanese::Utils qw(is_iso2022jp_string);
+   if ( is_iso2022jp_string($string) ) { do_something_if_Japanese;}
+
+=head1 DESCRIPTION
+
+Utilities for Japanse string
+
+=head1 METHODS
+
+=head2 <is_iso2022jp_string($string)>
+
+check whether $string looks Japanese. 
+return 1 if it looks so.
+
+=cut
+
+require Exporter;
+
+@ISA       = qw(Exporter);
+@EXPORT_OK = qw(is_iso2022jp_string);
+
+
+sub is_iso2022jp_string
+{
+    my ($buf) = @_;
+    return (not _look_not_iso2022jp_string($buf));
+}
+
+
+# based on fml-support: 07020, 07029
+#   Koji Sudo <koji@cherry.or.jp>
+#   Takahiro Kambe <taca@sky.yamashina.kyoto.jp>
+# check the given buffer has unusual Japanese (not ISO-2022-JP)
+sub _look_not_iso2022jp_string
+{
+    my ($buf) = @_;
+
+    # check 8 bit on
+    if ($buf =~ /[\x80-\xFF]/){
+        return 1;
+    }
+
+    # check SI/SO
+    if ($buf =~ /[\016\017]/) {
+        return 1;
+    }
+
+    # HANKAKU KANA
+    if ($buf =~ /\033\(I/) {
+        return 1;
+    }
+
+    # MSB flag or other control sequences
+    if ($buf =~ /[\001-\007\013\015\020-\032\034-\037\177-\377]/) {
+        return 1;
+    }
+
+    0; # O.K.
+}
+
+
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself. 
+
+=head1 HISTORY
+
+Dialect::Japanese::Utils appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Language/Japanese/index.ja.html b/fml/lib/Language/Japanese/index.ja.html
new file mode 100644
index 00000000..f288a2b4
--- /dev/null
+++ b/fml/lib/Language/Japanese/index.ja.html
@@ -0,0 +1,38 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+Dialect/Japanese::* classes
+</TITLE>
+<META http-equiv="Content-Type"
+	content="text/html; charset=EUC-JP">
+</HEAD>
+
+<BODY BGCOLOR="#E6E6FA">
+<CENTER><EM>Dialect::Japanese class modules</EM></CENTER>
+<HR>
+<TABLE>
+<TR>
+<TD>
+ String.pm <TD>
+<A HREF="String.pm">[source]</A>
+<TD>
+<A HREF="@@doc/String.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
+ Subject.pm <TD>
+<A HREF="Subject.pm">[source]</A>
+<TD>
+<A HREF="@@doc/Subject.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
+ Utils.pm <TD>
+<A HREF="Utils.pm">[source]</A>
+<TD>
+<A HREF="@@doc/Utils.txt">[manual]</A>
+<TD>
+</TABLE>
+</BODY>
+</HTML>
diff --git a/fml/lib/Language/Makefile b/fml/lib/Language/Makefile
new file mode 100644
index 00000000..2347ea49
--- /dev/null
+++ b/fml/lib/Language/Makefile
@@ -0,0 +1,16 @@
+all: anal
+
+anal:
+	@ find . | sort | grep -v CVS | sed 's@./@@'
+
+html:	index.ja.html
+
+index.ja.html: *.pm Japanese/*.pm
+	(cd Japanese; make html)
+	../../../doc/bin/dir2url.pl > index.ja.html
+
+_clean:
+	rm -f index.ja.html */index.ja.html
+
+clean:
+	(cd ../../..;make clean)
diff --git a/fml/lib/Language/index.ja.html b/fml/lib/Language/index.ja.html
new file mode 100644
index 00000000..a0e95cdb
--- /dev/null
+++ b/fml/lib/Language/index.ja.html
@@ -0,0 +1,27 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+Dialect::* classes
+</TITLE>
+<META http-equiv="Content-Type"
+	content="text/html; charset=EUC-JP">
+</HEAD>
+
+<BODY BGCOLOR="#E6E6FA">
+<CENTER><EM>Dialect class modules</EM></CENTER>
+<HR>
+<TABLE>
+<TR>
+<TD>
+ ISO2022JP.pm <TD>
+<A HREF="ISO2022JP.pm">[source]</A>
+<TD>
+<A HREF="@@doc/ISO2022JP.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
+ <A HREF=Japanese/index.ja.html>Dialect::Japanese::* class</A>
+</TABLE>
+</BODY>
+</HTML>