modified to use new Mail::Message::* framekwork.

2 files changed, 48 insertions, 19 deletions

diff --git a/fml/lib/FML/Article/Summary.pm b/fml/lib/FML/Article/Summary.pm
index 911622b1..52920ccb 100644
--- a/fml/lib/FML/Article/Summary.pm
+++ b/fml/lib/FML/Article/Summary.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: Summary.pm,v 1.15 2003/10/18 05:07:41 fukachan Exp $
+# $FML: Summary.pm,v 1.16 2003/12/30 08:22:36 fukachan Exp $
 #
 
 package FML::Article::Summary;
@@ -87,36 +87,29 @@ sub _prepare_info
 	$article = $self->{ _article };
     }
     else {
-	# XXX-TODO: why we run "new FML::Article" here?
-	# XXX-TODO: how do we know if this $article is proper (e.g. latest)?
-	# XXX-TODO: we should use e.g. $curproc->last_article() ?
+	# XXX we need article object to use $article->filepath() mthod.
 	use FML::Article;
 	$article = new FML::Article $curproc;
     }
 
     my $file = $article->filepath($id);
     if (-f $file) {
-	use Mail::Message;
 	my $msg      = new Mail::Message->parse( { file => $file } );
 	my $header   = $msg->whole_message_header();
 	my $address  = $header->get( 'from' ) || '';
-	my $date     = $header->get( 'date' ) || '';
+	my $date_str = $header->get( 'date' ) || '';
 
-	# XXX-TODO: not object-flavor,
-	# XXX-TODO: $date = new Mail::Message::Date; 
-	# XXX-TODO: $date->set("Tue Dec 30 17:06:34 JST 2003");
-	# XXX-TODO: $date->to_unixtime();
-	my $obj      = new Mail::Message::Date;
-	my $unixtime = $obj->date_to_unixtime( $date );
+	# data -> unix time.
+	use Mail::Message;
+	my $date     = new Mail::Message::Date $date_str;
+	my $unixtime = $date->as_unixtime();
 
 	# log the first 15 bytes of user@domain in From: header field.
 	if (defined $address) {
-	    # XXX-TODO: implement FML::Address class
-	    # XXX-TODO: $addr = FML::Address $from; $addr->cleanup().
-	    use FML::Header;
-	    my $hdr  = new FML::Header;
-	    my $addr = $hdr->address_clean_up($address);
-	    $address = defined $addr ? substr($addr, 0, $addrlen) : '';
+	    use Mail::Message::Address;
+	    my $addr = new Mail::Message::Address $address;
+	    $addr->clean_up();
+	    $address = $addr->substr(0, $addrlen) || '';
 	}
 
 	# XXX-TODO $subject->clean_up() ? (object flavour?)
diff --git a/fml/lib/FML/Header.pm b/fml/lib/FML/Header.pm
index f1071ee8..79592bcb 100644
--- a/fml/lib/FML/Header.pm
+++ b/fml/lib/FML/Header.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: Header.pm,v 1.68 2004/01/21 03:49:14 fukachan Exp $
+# $FML: Header.pm,v 1.69 2004/01/22 12:34:21 fukachan Exp $
 #
 
 package FML::Header;
@@ -415,6 +415,42 @@ replace original C<Received:> to C<X-Received:>.
 sub rewrite_article_subject_tag
 {
     my ($header, $config, $rw_args) = @_;
+    my $tag = $config->{ article_subject_tag };
+
+    # XXX-TODO: need $article_subject_tag expaned already e.g. "\Lmlname\E"
+    # XXX-TODO: we should include this exapansion method within this module?
+    use Mail::Message::Subject;
+    my $str = $header->get('subject');
+    my $sbj = new Mail::Message::Subject $str;
+
+    # mime decode
+    $sbj->mime_decode();
+	
+    # de-tag and cut off Re: Re: Re: ... (duplicated reply tag).
+    $sbj->delete_dup_reply_tag() if $sbj->has_reply_tag();
+    $sbj->delete_tag($tag);
+    $sbj->delete_dup_reply_tag() if $sbj->has_reply_tag();
+
+    # add(prepend) the rewrited tag with mime encoding.
+    my $new_tag = sprintf($tag, $rw_args->{ id });
+    my $new_sbj = sprintf("%s %s", $new_tag, $sbj->as_str());
+
+    # update object.
+    $sbj->set($new_sbj);
+
+    # mime encode and replace subject field.
+    $sbj->mime_encode();
+    $header->replace('Subject', $sbj->as_str());
+}
+
+
+# Descriptions: rewrite subject if needed.
+#    Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args)
+# Side Effects: update $header
+# Return Value: none
+sub rewrite_article_subject_tag_orig
+{
+    my ($header, $config, $rw_args) = @_;
 
     my $pkg = "FML::Header::Subject";
     eval qq{ use $pkg;};