implement get_encoding_mechanism() in Mail::Message.

return encoding type for specified Mail::Message not whole mail.
The return value is one of base64, quoted-printable or undef.

3 files changed, 42 insertions, 3 deletions

diff --git a/fml/doc/ja/tutorial/module/Mail::Message.sgml b/fml/doc/ja/tutorial/module/Mail::Message.sgml
index 3e3c2518..c697091f 100644
--- a/fml/doc/ja/tutorial/module/Mail::Message.sgml
+++ b/fml/doc/ja/tutorial/module/Mail::Message.sgml
@@ -1,5 +1,5 @@
 <!--
-   $FML$
+   $FML: Mail::Message.sgml,v 1.1.1.1 2001/09/23 10:56:33 fukachan Exp $
 -->
 
 <chapter id=="module.mail.message">
@@ -295,6 +295,15 @@ Mail::Message オブジェクトのタイプ(文字列)を返します。
 どではなく、鎖の各部分のオブジェクトのタイプであることに注意して下さい。
 </para>
 
+<para>
+get_encoding_mechanism()
+は
+Mail::Message オブジェクトのエンコーディングメカニズム(文字列)を返します。
+エンコーディングされていないなら undef が返ります。
+これは、メール全体のタイプ（マルチパートとか text/plain)
+どではなく、鎖の各部分のオブジェクトのタイプであることに注意して下さい。
+</para>
+
 </sect2>
 
 
diff --git a/fml/lib/Mail/Message.pm b/fml/lib/Mail/Message.pm
index f39f2777..705859e7 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.26 2001/08/02 02:00:14 fukachan Exp $
+# $FML: Message.pm,v 1.27 2001/08/23 13:10:34 fukachan Exp $
 #
 
 package Mail::Message;
@@ -1515,6 +1515,29 @@ sub is_empty
 }
 
 
+=head2 C<get_encoding_mechanism()>
+
+return encoding type for specified Mail::Message not whole mail.
+The return value is one of base64, quoted-printable or undef.
+
+=cut
+
+sub get_encoding_mechanism
+{
+    my ($self) = @_;
+    my $buf = $self->header_in_body_part();
+
+    if ($buf =~ /Content-Transfer-Encoding:\s*(\S+)/i) {
+	my $mechanism = $1;
+	$mechanism =~ tr/A-Z/a-z/;
+	return $mechanism;
+    }
+    else {
+	return undef;
+    }
+}
+
+
 =head2 C<header_size()>
 
 =head2 C<body_size()>
diff --git a/regress/message/dump.pl b/regress/message/dump.pl
index 5bf66a3d..ce6c3129 100755
--- a/regress/message/dump.pl
+++ b/regress/message/dump.pl
@@ -1,6 +1,6 @@
 #!/usr/pkg/bin/perl
 #
-# $FML$
+# $FML: dump.pl,v 1.1 2001/09/23 11:23:38 fukachan Exp $
 #
 
 use lib qw(../../fml/lib ../../cpan/lib ../../im/lib);
@@ -16,3 +16,10 @@ my $obj = Mail::Message->parse( { fd => $fh } );
 use Data::Dumper;
 
 print Dumper( $obj );
+
+for (my $mp = $obj, my $i = 0; $mp ; $mp = $mp->{ next } ) {
+    $i++;
+    my $type = $mp->get_data_type();
+    my $e    = $mp->get_encoding_mechanism();
+    printf "object(%d) type = %-30s encoding= %-10s\n", $i, $type, $e;
+}