consider Accept-Language: (but not used yet now ;-).

3 files changed, 96 insertions, 2 deletions

diff --git a/fml/lib/FML/Process/Kernel.pm b/fml/lib/FML/Process/Kernel.pm
index 3c53875e..ae38e1c0 100644
--- a/fml/lib/FML/Process/Kernel.pm
+++ b/fml/lib/FML/Process/Kernel.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: Kernel.pm,v 1.185 2003/10/14 12:57:45 fukachan Exp $
+# $FML: Kernel.pm,v 1.186 2003/10/15 01:03:34 fukachan Exp $
 #
 
 package FML::Process::Kernel;
@@ -976,6 +976,12 @@ sub parse_incoming_message
 	    $obj->close();
 	}
     }
+
+    # Accept-Language: handling
+    if (defined $msg) {
+	my $list = $msg->accept_language_list();
+	$curproc->set_accept_language_list($list);
+    }
 }
 
 
diff --git a/fml/lib/Mail/Message.pm b/fml/lib/Mail/Message.pm
index 6c2c8d18..f6ac3acc 100644
--- a/fml/lib/Mail/Message.pm
+++ b/fml/lib/Mail/Message.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: Message.pm,v 1.85 2003/09/13 13:01:01 fukachan Exp $
+# $FML: Message.pm,v 1.86 2003/10/15 01:03:37 fukachan Exp $
 #
 
 package Mail::Message;
@@ -2427,6 +2427,21 @@ sub data_type_list
 }
 
 
+=head1 UTILITY for Accept-Language:
+
+=head2 accept_language_list()
+
+return list of languages to accept as ARRAY_REF such as [ 'ja', 'en',
+'*' ] but [ '*' ] if Accept-Language: unavailable.
+
+=cut
+
+
+# Accept-Language: handling
+use Mail::Message::Language;
+push(@ISA, "Mail::Message::Language");
+
+
 =head1 METHODS to make a whole mail message
 
 Please use C<Mail::Message::Compose> class.
diff --git a/fml/lib/Mail/Message/Language.pm b/fml/lib/Mail/Message/Language.pm
new file mode 100644
index 00000000..1056b694
--- /dev/null
+++ b/fml/lib/Mail/Message/Language.pm
@@ -0,0 +1,73 @@
+#-*- perl -*-
+#
+# Copyright (C) 2003 Ken'ichi Fukamachi
+#
+# $FML$
+#
+
+package Mail::Message::Language;
+use strict;
+
+=head1 NAME
+
+Mail::Message::Language - handle *-Language:
+
+=head1 SYNOPSIS
+
+   use Mail::Message::Language;
+   my $mh = new Mail::Message::Language;
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=cut
+
+
+# Descriptions: return list of languages to accept as ARRAY_REF.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: ARRAY_REF
+sub accept_language_list
+{
+    my ($self) = @_;
+    my $header = $self->whole_message_header();
+    my $buf    = $header->get('Accept-Language');
+    my $list   = [];
+
+  LANG:
+    for my $s (split(/\s*,\s*/, $buf)) {
+	if ($s =~ /^\s*ja/oi) {
+	    push(@$list, 'ja');
+	    last LANG;
+	}
+	elsif ($s =~ /^\s*en/oi) {
+	    push(@$list, 'en');
+	    last LANG;
+	}
+    }
+
+    push(@$list, '*'); # any language by default.
+    return $list;
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 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.
+
+=cut
+
+
+1;