move main db manipulation code from ToHTML.pm to DB.pm.

XXX caution: but the index generator not works now.

2 files changed, 813 insertions, 391 deletions

diff --git a/fml/lib/Mail/Message/DB.pm b/fml/lib/Mail/Message/DB.pm
new file mode 100644
index 00000000..65202bcd
--- /dev/null
+++ b/fml/lib/Mail/Message/DB.pm
@@ -0,0 +1,739 @@
+#-*- perl -*-
+#
+#  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.
+#
+# $FML$
+#
+
+package Mail::Message::DB;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+use lib qw(../../../../fml/lib
+	   ../../../../cpan/lib
+	   ../../../../img/lib
+	   );
+
+my $version = q$FML$;
+if ($version =~ /,v\s+([\d\.]+)\s+/) { $version = $1;}
+
+my $debug = 1;
+
+my $keepalive = 1;
+
+my (@table_list) = qw(
+		      from who date subject to cc reply_to
+
+		      message_id
+		      message_id_to_key
+		      message_id_to_key_list
+
+		      ref_key_list
+		      next_key
+		      prev_key
+		      monthly_to_key_list
+
+		      filename
+		      filepath
+		      subdir
+
+		      month 
+		      hint
+		      );
+
+
+
+=head1 NAME
+
+Mail::Message::DB - DB interface
+
+=head1 SYNOPSIS
+
+  ... lock by something ...
+
+  ... unlock by something ...
+
+This module itself provides no lock function.
+please use flock() built in perl or CPAN lock modules for it.
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 C<new($args)>
+
+    my $args = {
+	db_module    => 'AnyDBM_File',
+	db_base_dir  => '/var/spool/ml/@udb@/thread',
+	db_name      => 'elena',  # mailing list identifier
+	key          => 100,      # article sequence number
+    };
+
+In fml 8 case, C<table> not needs the full mail address such as
+C<elena@fml.org> since fml uses different $db_base_dir for each
+domain.
+
+For example, this module creates/updates the following databases (e.g.
+/$db_base_dir/$db_name/$table.db where $table is 'article', '
+message_id', 'sender', et.al.).
+
+   /var/spool/ml/@udb@/thread/elena/articles.db
+   /var/spool/ml/@udb@/thread/elena/date.db
+   /var/spool/ml/@udb@/thread/elena/message_id.db
+   /var/spool/ml/@udb@/thread/elena/sender.db
+   /var/spool/ml/@udb@/thread/elena/status.db
+   /var/spool/ml/@udb@/thread/elena/thread_id.db
+
+Almost all tables use $key (article sequence number) as primary key
+since it is unique in the mailing list articles.
+
+    # key => filepath
+    $article = {
+	100 => /var/spool/ml/elena/spool/100,
+	101 => /var/spool/ml/elena/spool/101,
+    };
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self, $args) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+
+    # initialize DB module backend
+    set_db_module_name($me, $args->{ db_module } || 'AnyDBM_File');
+
+    # db_base_dir = /var/spool/ml/@udb@/elena
+    set_db_base_dir($me,
+		    $args->{ db_base_dir } || croak("specify db_base_dir"));
+
+    # $db_name/$table uses $key as primary key.
+    set_db_name($me, $args->{ db_name }) if defined $args->{ db_name };
+    set_key($me,     $args->{ key })     if defined $args->{ key };
+		
+    return bless $me, $type;
+}
+
+
+# Descriptions: destructor.
+#    Arguments: OBJ($self)
+# Side Effects: close db
+# Return Value: none
+sub DESTROY
+{
+    my ($self) = @_;
+
+    if (defined $self->{ _db }) {
+	$self->db_close();
+    }
+}
+
+
+=head1 PARSE and ANALYZE
+
+=cut
+
+
+# Descriptions: update database on message header, thread relation
+#               et. al.
+#    Arguments: OBJ($self) OBJ($msg) HASH_REF($args)
+# Side Effects: update database
+# Return Value: none
+sub analyze
+{
+    my ($self, $msg) = @_;
+    my $hdr      = $msg->whole_message_header;
+    my $date     = $hdr->get('date');     $date    =~ s/\s*$//;
+    my $to       = $hdr->get('to');       $to      =~ s/\s*$//;
+    my $cc       = $hdr->get('cc');       $cc      =~ s/\s*$//;
+    my $replyto  = $hdr->get('reply-to'); $replyto =~ s/\s*$//;
+    my $subject  = $hdr->get('subject');  $subject =~ s/\s*$//;
+    my $id       = $self->get_key();
+    my $month    = $self->msg_time($hdr, 'yyyy/mm');
+    my $subdir   = $self->msg_time($hdr, 'yyyymm');
+    my $_subject = $self->_decode_mime_string($subject);
+    my $who      = $self->_who_of_address( $hdr->get('from') );
+    my $ra_from  = $self->_address_clean_up( $hdr->get('from') );
+    my $ra_mid   = $self->_address_clean_up( $hdr->get('message-id') );
+    my $from     = $ra_from->[0] || 'unknown';
+    my $mid      = $ra_mid->[0]  || '';
+
+    my $db = $self->db_open();
+
+    $self->_update_id_max($db, $id);
+
+    $self->_db_set($db, 'date',     $id, $date);     # Sun Jun 1 13:46:15 ...
+    $self->_db_set($db, 'from',     $id, $from);     # rudo@nuinui.net
+    $self->_db_set($db, 'reply_to', $id, $replyto);  # a@b
+    $self->_db_set($db, 'who',      $id, $who);      # Rudolf Shumidt
+    $self->_db_set($db, 'subject',  $id, $_subject); # subject string ...
+    $self->_db_set($db, 'to',       $id, $to);       # a@b
+    $self->_db_set($db, 'cc',       $id, $cc);       # a@b
+    $self->_db_set($db, 'month',    $id, $month);    # 2003/06
+    $self->_db_set($db, 'subdir',   $id, $subdir);   # 200306
+    $self->_db_set($db, 'id',       $id, $id);       # 100
+
+    if ($mid) {
+	$self->_db_set($db, 'message_id',        $id, $mid); # 20030601rudo@nui
+	$self->_db_set($db, 'message_id_to_key', $mid, $id); # REVERSE_MAP
+
+	# { message_id => id1 id2 id3 ... } where id* refers this $mid.
+	$self->_db_add_list_entry($db, 'message_id_to_key_list', $mid, $id);
+    }
+
+    # HASH { YYYY/MM => (id1 id2 id3 ..) }
+    $self->_db_add_list_entry($db, 'monthly_to_key_list', $month, $id);
+
+    $self->_analyze_thread($db, $msg, $hdr);
+
+    unless ($keepalive) {
+	$self->db_close();
+    }
+}
+
+
+# Descriptions: update $id_max in hint.
+#    Arguments: OBJ($self) HASH_REF($db) NUM($id)
+# Side Effects: update hint in $db
+# Return Value: none
+sub _update_id_max
+{
+    my ($self, $db, $id) = @_;
+
+    # we should not update max_id when our target is an attachment.
+    # update max_id only under the top level operation
+    unless ($self->{ _is_attachment }) {
+	_PRINT_DEBUG("mode = parent");
+
+	my $id_max = $self->_db_get($db, 'hint', 'id_max') || 0;
+	if (defined $id_max && $id_max) {
+	    my $value = $id_max < $id ? $id : $id_max;
+	    $self->_db_set($db, 'hint', 'id_max', $value);
+	}
+	else {
+	    $self->_db_set($db, 'hint', 'id_max', $id);
+	}
+    }
+    else {
+	_PRINT_DEBUG("mode = child");
+    }
+}
+
+
+# Descriptions: analyze thread information based on
+#                In-Reply-To: and References.
+#    Arguments: OBJ($self) HASH_REF($db) OBJ($msg) OBJ($hdr)
+# Side Effects: update db
+# Return Value: none
+sub _analyze_thread
+{
+    my ($self, $db, $msg, $hdr) = @_;
+    my $id           = $self->get_key();
+    my $ra_ref       = $self->_address_clean_up($hdr->get('references'));
+    my $ra_inreplyto = $self->_address_clean_up($hdr->get('in-reply-to'));
+    my $in_reply_to  = $ra_inreplyto->[0] || '';
+
+    # I. prepare and save thread related information 
+    #   1. analyze In-Reply-To: and prepare REVERSE MAP for them.
+    #   2. apply the same logic for all message-id's in References:
+    my %uniq  = ();
+    my $count = 0;
+
+  MSGID_SEARCH:
+    for my $mid (@$ra_inreplyto, @$ra_ref) {
+	next MSGID_SEARCH unless defined $mid;
+
+	# ensure uniqueness
+	_PRINT_DEBUG("DUP: $mid") if $uniq{$mid};
+	next MSGID_SEARCH if $uniq{$mid};
+	$uniq{$mid} = 1;
+	$count++;
+
+	# REVERSE_MAP { message-id => (id1 id2 id3 ...)
+	$self->_db_add_list_entry($db, 'message_id_to_key_list', $mid, $id);
+
+	# we extract id1 from MAP { message-id => $idlist = (id1 id2 id3 ...) }
+	# and define id1 = $head_id.
+	# XXX $id_list is not ARRAY but STR such as "id1 id2 id3 ...";
+	my $id_list = $self->_db_get($db, 'message_id_to_key_list', $mid);
+	my $head_id = _head_of_list_str($id_list) || 0;
+
+	# REVERSE_MAP { head_id(id1) => (id1 id2 id3 ...) }
+	if ($head_id && $head_id != $id) {
+	    $self->_db_add_list_entry($db, 'ref_key_list', $head_id, $id);
+	    _PRINT_DEBUG("THREAD SEARCH: $head_id => $id ($id_list)");
+	}
+	else {
+	    _PRINT_DEBUG("THREAD SEARCH: NOT FOUND");
+	}
+    }
+
+    unless ($count) {
+	_PRINT_DEBUG("THREAD SEARCH: NOT TRY");
+    }
+
+    # II. ok. go to speculate prev/next links
+    #   1. If In-Reply-To: is found, use it as "pointer to previous id"
+    my $idp = 0;
+    if (defined $in_reply_to) {
+	# XXX idp (id pointer) = id1 by _head_of_list_str( (id1 id2 id3 ...)
+	my $id_list = 
+	    $self->_db_get($db, 'message_id_to_key_list', $in_reply_to);
+	$idp = _head_of_list_str($id_list);
+    }
+    # 2. if not found, try to use References: "in reverse order"
+    elsif (@$ra_ref) {
+	my (@rra) = reverse(@$ra_ref);
+	$idp = $rra[0];
+    }
+    # 3. no link to previous one found
+    else {
+	$idp = 0;
+    }
+
+    # 4. if $idp (link to previous message) found, 
+    if (defined($idp) && $idp && $idp =~ /^\d+$/) {
+	if ($idp != $id) {
+	    $self->_db_set($db, 'prev_key', $id, $idp);
+	}
+
+	# We should not overwrite "id => next_key" assinged already.
+	# We should preserve the first "id => next_key" value.
+	# but we may overwride it if "id => id (itself)", wrong link.
+	my $nid = $self->_db_get($db, 'next_key', $idp) || 0;
+	unless ($nid && $nid != $idp && $id != $idp) {
+	    $self->_db_set($db, 'next_key', $idp, $id);
+	}
+    }
+    else {
+	_PRINT_DEBUG("no prev thread link (id=$id)");
+    }
+}
+
+
+=head1 UTILITY FUNCTIONS
+
+All methods are module internal.
+
+=cut
+
+
+# Descriptions: convert space-separeted string to array
+#    Arguments: STR($str)
+# Side Effects: none
+# Return Value: ARRAY_REF
+sub _str_to_array_ref
+{
+    my ($str) = @_;
+
+    return undef unless defined $str;
+
+    $str =~ s/^\s*//;
+    $str =~ s/\s*$//;
+    my (@a) = split(/\s+/, $str);
+    return \@a;
+}
+
+
+# Descriptions: add { key => value } into $table with converting
+#               where value is "x y z ..." form, space separated string.
+#    Arguments: HASH_REF($db) STR($dbname) STR($key) STR($value)
+# Side Effects: update database
+# Return Value: none
+sub _db_add_list_entry
+{
+    my ($self, $db, $table, $key, $value) = @_;
+    my $found = 0;
+    my $ra    = _str_to_array_ref($db->{ $table }->{ $key }) || [];
+
+    if (defined($key) && $key && defined($value) && $value) {
+	# check duplication to ensure uniqueness within this array.
+	for my $v (@$ra) {
+	    $found = 1 if ($value =~ /^\d+$/o) && ($v == $value);
+	    $found = 1 if ($value !~ /^\d+$/o) && ($v eq $value);
+	}
+	
+	# add if the value is a new comer.
+	unless ($found) {
+	    my $v = $self->_db_get($db, $table, $key) || '';
+	    $v .= $v ? " $value" : $value;
+	    $self->_db_set($db, $table, $key, $v);
+	}
+    }
+}
+
+
+# Descriptions: head of array (space separeted string)
+#    Arguments: STR($buf)
+# Side Effects: none
+# Return Value: STR
+sub _head_of_list_str
+{
+    my ($buf) = @_;
+    $buf =~ s/^\s*//;
+    $buf =~ s/\s*$//;
+
+    return (split(/\s+/, $buf))[0];
+}
+
+
+# Descriptions: decode mime string.
+#    Arguments: OBJ($self) STR($str) STR($out_code) STR($in_code)
+# Side Effects: none
+# Return Value: STR
+sub _decode_mime_string
+{
+    my ($self, $str, $out_code, $in_code) = @_;
+
+    use Mail::Message::Encode;
+    my $encode = new Mail::Message::Encode;
+    return $encode->decode_mime_string($str, $out_code, $in_code);
+}
+
+
+# Descriptions: return formated time of message Date:
+#    Arguments: OBJ($self) STR($type)
+# Side Effects: none
+# Return Value: STR
+sub msg_time
+{
+    my ($self, $hdr, $type) = @_;
+
+    if (defined($hdr) && $hdr->get('date')) {
+	use Time::ParseDate;
+	my $unixtime = parsedate( $hdr->get('date') );
+	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime( $unixtime );
+
+	if ($type eq 'yyyymm') {
+	    return sprintf("%04d%02d", 1900 + $year, $mon + 1);
+	}
+	elsif ($type eq 'yyyy/mm') {
+	    return sprintf("%04d/%02d", 1900 + $year, $mon + 1);
+	}
+    }
+    else {
+	my $id = $self->{ _current_id };
+	warn("cannot pick up Date: field id=$id");
+	return '';
+    }
+}
+
+
+# Descriptions: clean up email address by Mail::Address.
+#               return clean-up'ed address list.
+#    Arguments: STR($addr)
+# Side Effects: none
+# Return Value: ARRAY_REF
+sub _address_clean_up
+{
+    my ($self, $addr) = @_;
+    my (@r);
+
+    use Mail::Address;
+    my (@addrs) = Mail::Address->parse($addr);
+
+    my $i = 0;
+  LIST:
+    for my $addr (@addrs) {
+	my $xaddr = $addr->address();
+	next LIST unless $xaddr =~ /\@/;
+	push(@r, $xaddr);
+    }
+
+    return \@r;
+}
+
+
+# Descriptions: extrace gecos field in $address
+#    Arguments: OBJ($self) STR($address)
+# Side Effects: none
+# Return Value: STR
+sub _who_of_address
+{
+    my ($self, $address) = @_;
+    my ($user);
+
+    use Mail::Address;
+    my (@addrs) = Mail::Address->parse($address);
+
+    for my $addr (@addrs) {
+	if (defined( $addr->phrase() )) {
+	    my $phrase = $self->_decode_mime_string( $addr->phrase() );
+
+	    if ($phrase) {
+		return($phrase);
+	    }
+	}
+
+	$user = $addr->user();
+    }
+
+    return( $user ? "$user\@xxx.xxx.xxx.xxx" : $address );
+}
+
+
+=head1 DATABASE PARAMETERS MANIPULATION
+
+=cut
+
+
+# Descriptions: open database
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: tied with $self->{ _db }
+#         Todo: we should use IO::Adapter ?
+# Return Value: none
+sub db_open
+{
+    my ($self, $args) = @_;
+
+    return $self->{ _db } if defined $self->{ _db };
+
+    my $db_type   = $self->get_db_module_name();
+    my $db_dir    = $self->get_db_base_dir();
+    my $file_mode = $self->{ _file_mode } || 0644;
+
+    _PRINT_DEBUG("db_open( type = $db_type )");
+
+    eval qq{ use $db_type; use Fcntl;};
+    unless ($@) {
+ 	for my $db (@table_list) {
+	    my $file = "$db_dir/${db}";
+	    my $str = qq{
+		my \%$db = ();
+		tie \%$db, \$db_type, \$file, O_RDWR|O_CREAT, $file_mode;
+		\$self->{ _db }->{ '_$db' } = \\\%$db;
+	    };
+	    eval $str;
+	    croak($@) if $@;
+	}
+    }
+    else {
+	croak("cannot use $db_type");
+    }
+
+    $self->{ _db } || undef;
+}
+
+
+# Descriptions: close database
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: untie $self->{ _db }
+#         Todo: we should use IO::Adapter ?
+# Return Value: none
+sub db_close
+{
+    my ($self, $args) = @_;
+    my $db_type = $args->{ db_type } || $self->{ _db_type } || 'AnyDBM_File';
+    my $db_dir  = $self->{ _html_base_directory };
+
+    _PRINT_DEBUG("db_close()");
+
+    for my $db (@table_list) {
+	my $str = qq{
+	    my \$${db} = \$self->{ _db }->{ '_$db' };
+	    untie \%\$${db};
+	};
+	eval $str;
+	croak($@) if $@;
+    }
+
+    delete $self->{ _db } if defined $self->{ _db };
+}
+
+
+sub set
+{
+    my ($self, $table, $key, $value) = @_;
+    my $db = $self->db_open();
+
+    $self->_db_set($db, $table, $key, $value);
+}
+
+
+sub get
+{
+    my ($self, $table, $key) = @_;
+    my $db = $self->db_open();
+
+    return $self->_db_get($db, $table, $key);
+}
+
+
+sub _db_set
+{
+    my ($self, $db, $table, $key, $value) = @_;
+
+    if (defined $value && $value) {
+	_PRINT_DEBUG("db: table=$table { $key => $value }");
+	$db->{ "_$table" }->{ $key } = $value;
+    }
+}
+
+
+sub _db_get
+{
+    my ($self, $db, $table, $key) = @_;
+
+    return( $db->{ "_$table" }->{ $key } || '' );
+}
+
+
+sub set_db_module_name
+{
+    my ($self, $module) = @_;
+
+    $self->{ _db_module } = $module if defined $module;
+}
+
+
+sub get_db_module_name
+{
+    my ($self) = @_;
+
+    return( $self->{ _db_module } || undef );
+}
+
+
+sub set_db_base_dir
+{
+    my ($self, $dir) = @_;
+
+    $self->{ _db_base_dir } = $dir if defined $dir;
+}
+
+
+sub get_db_base_dir
+{
+    my ($self) = @_;
+
+    return( $self->{ _db_base_dir } || undef );
+}
+
+
+sub set_db_name
+{
+    my ($self, $name) = @_;
+
+    $self->{ _db_name } = $name if defined $name;
+}
+
+
+sub get_db_name
+{
+    my ($self) = @_;
+
+    return( $self->{ _db_name } || undef );
+}
+
+
+sub set_key
+{
+    my ($self, $key) = @_;
+
+    $self->{ _key } = $key if defined $key;
+}
+
+
+sub get_key
+{
+    my ($self) = @_;
+
+    return( $self->{ _key } || undef );
+}
+
+
+
+=head1 DEBUG
+
+=cut
+
+# Descriptions: debug
+#    Arguments: STR($str)
+# Side Effects: none
+# Return Value: none
+sub _PRINT_DEBUG
+{
+    my ($str) = @_;
+    print STDERR "(debug) $str\n" if $debug;
+}
+
+
+# Descriptions: debug, print out hash
+#    Arguments: HASH_REF($hash)
+# Side Effects: none
+# Return Value: none
+sub _PRINT_DEBUG_DUMP_HASH
+{
+    my ($hash) = @_;
+    my ($k,$v);
+
+    if ($debug) {
+	while (($k, $v) = each %$hash) {
+	    printf STDERR "%-30s => %s\n", $k, $v;
+	}
+    }
+}
+
+
+#
+# DEBUG
+#
+if ($0 eq __FILE__) {
+    my $args = {
+	db_module    => 'AnyDBM_File',
+	db_base_dir  => '/tmp',
+	db_name      => 'elena',  # mailing list identifier
+	key          => 100,      # article sequence number
+    };
+
+    my $obj = new Mail::Message::DB $args;
+
+    for my $file (@ARGV) {
+	use File::Basename;
+	my $id = basename($file);
+
+	use Mail::Message;
+	my $msg = Mail::Message->parse( { file => $file } );
+	$obj->set_key($id);
+	$obj->analyze($msg);
+    }
+}
+
+
+=head1 TODO
+
+=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.
+
+=head1 HISTORY
+
+Mail::Message::DB first appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+This class is renamed from C<Mail::HTML::Lite> 1.40 (2001-2002).
+
+=cut
+
+
+1;
diff --git a/fml/lib/Mail/Message/ToHTML.pm b/fml/lib/Mail/Message/ToHTML.pm
index c57fdca1..40ddc7cb 100644
--- a/fml/lib/Mail/Message/ToHTML.pm
+++ b/fml/lib/Mail/Message/ToHTML.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: ToHTML.pm,v 1.40 2003/05/16 13:40:57 fukachan Exp $
+# $FML: ToHTML.pm,v 1.41 2003/05/27 11:34:14 fukachan Exp $
 #
 
 package Mail::Message::ToHTML;
@@ -17,7 +17,7 @@ my $debug = 0;
 my $URL   =
     "<A HREF=\"http://www.fml.org/software/\">Mail::Message::ToHTML</A>";
 
-my $version = q$FML: ToHTML.pm,v 1.40 2003/05/16 13:40:57 fukachan Exp $;
+my $version = q$FML: ToHTML.pm,v 1.41 2003/05/27 11:34:14 fukachan Exp $;
 if ($version =~ /,v\s+([\d\.]+)\s+/) {
     $version = "$URL $1";
 }
@@ -92,19 +92,35 @@ stored.
 sub new
 {
     my ($self, $args) = @_;
-    my ($type) = ref($self) || $self;
-    my $me     = {};
+    my ($type)  = ref($self) || $self;
+    my $me      = {};
 
     $me->{ _html_base_directory } = $args->{ directory };
     $me->{ _charset }             = $args->{ charset } || 'us-ascii';
     $me->{ _is_attachment }       = defined($args->{ attachment }) ? 1 : 0;
     $me->{ _db_type }             = $args->{ db_type };
+    $me->{ _db_name }             = $args->{ db_name };
+    $me->{ _db_base_dir }         = $args->{ db_base_dir };
     $me->{ _args }                = $args;
     $me->{ _num_attachment }      = 0; # for child process
     $me->{ _use_subdir }          = 'yes';
     $me->{ _subdir_style }        = 'yyyymm';
     $me->{ _html_id_order }       = $args->{ index_order } || 'normal';
 
+    my $db_type = $me->{ _db_type };
+    my $db_base = $me->{ _db_base_dir } || croak("specify db_base_dir\n");
+    my $db_name = $me->{ _db_name }     || croak("specify db_name\n");
+    my $_args   = {
+	db_module   => $db_type,
+	db_base_dir => $db_base,
+	db_name     => $db_name, # mailing list identifier
+    };
+
+    # Firstly, prepare db object.
+    use Mail::Message::DB;
+    my $ndb = new Mail::Message::DB $_args;
+    $me->{ _ndb } = $ndb;
+
     return bless $me, $type;
 }
 
@@ -163,7 +179,7 @@ sub htmlfy_rfc822_message
     $self->{ _hints }->{ src }->{ filepath } = $src;
 
     # save information for index.html and thread.html
-    $self->cache_message_info($msg, { id => $id,
+    $self->cache_message_info($msg, { id  => $id,
 				      src => $src,
 				      dst => $dst,
 				  } );
@@ -360,43 +376,35 @@ sub html_filename
 sub _html_file_subdir_name
 {
     my ($self, $id) = @_;
-    my $html_base_dir = $self->{ _html_base_directory };
+    my $ndb           = $self->ndb();
     my $subdir        = '';
+    my $html_base_dir = $self->{ _html_base_directory };
     my $subdir_style  = $self->{ _subdir_style };
-    my $month_db      = $self->{ _db }->{ _month };
-    my $subdir_db     = $self->{ _db }->{ _subdir };
-    my $curid         = $self->{ _current_id };
     my $dir_mode      = $self->{ _dir_mode } || 0755;
 
     if ($subdir_style eq 'yyyymm') {
-	if (defined $subdir_db->{ $id } && $subdir_db->{ $id }) {
-	    $subdir = $subdir_db->{ $id };
-	}
-	else {
-	    $subdir = $self->_msg_time('yyyymm');
+	my $hdr = $self->{ _current_hdr  };
+	$subdir = $ndb->msg_time($hdr, 'yyyymm');
 
-	    # XXX why we need validate $curid here ? (sholed be true always ?)
-	    if (defined($curid) && $curid == $id) {
-		$subdir_db->{ $id } = $subdir; # cache subdir info into DB.
-		# print STDERR "xdebug: \$subdir_db->{ $id } = $subdir\n";
-	    }
-
-	    use File::Spec;
-	    my $xsubdir = File::Spec->catfile($html_base_dir, $subdir);
-	    unless (-d $xsubdir) {
-		my $mask = umask();
-		umask(022);
-		mkdir($xsubdir, $dir_mode);
-		umask($mask);
-	    }
+	use File::Spec;
+	my $xsubdir = File::Spec->catfile($html_base_dir, $subdir);
+	unless (-d $xsubdir) {
+	    my $mask = umask();
+	    umask(022);
+	    mkdir($xsubdir, $dir_mode);
+	    umask($mask);
 	}
     }
+    else {
+	croak("unknown \$subdir_style");
+    }
 
     if ($subdir) {
 	use File::Spec;
 	return File::Spec->catfile($subdir, "msg$id.html");
     }
     else {
+	warn("not create msg$id.html");
 	return undef;
     }
 }
@@ -607,9 +615,10 @@ sub _set_output_channel
 sub _create_temporary_filename
 {
     my ($self) = @_;
-    my $db_dir = $self->{ _html_base_directory };
+    my $html_base_dir = $self->{ _html_base_directory };
 
-    return "$db_dir/tmp$$";
+    use File::Spec;
+    return File::Spec->catfile($html_base_dir, "tmp.$$");
 }
 
 
@@ -917,176 +926,29 @@ See section C<Internal Data Presentation> for more detail.
 sub cache_message_info
 {
     my ($self, $msg, $args) = @_;
-    my $hdr = $msg->whole_message_header;
-    my $id  = $args-> { id };
-    my $dst = $args-> { dst };
-
-    $self->_db_open();
-    my $db = $self->{ _db };
-
-    # XXX we should not update max_id when our target is an attachment.
-    # XXX update max_id only under the top level operation
-    unless ($self->{ _is_attachment }) {
-	if (defined $db->{ _info }->{ id_max }) {
-	    $db->{_info}->{id_max} =
-		$db->{_info}->{id_max} < $id ? $id : $db->{_info}->{id_max};
-	}
-	else {
-	    $db->{_info}->{id_max} = $id;
-	}
-	_PRINT_DEBUG("   parent");
-	_PRINT_DEBUG("   update id_max = $db->{_info }->{id_max}");
-    }
-    else {
-	_PRINT_DEBUG("   child");
-    }
-
-    _PRINT_DEBUG("   cache_message_info( id=$id ) running");
-
-    # HASH { $id => Date: }
-    $db->{ _date }->{ $id } = $hdr->get('date');
-
-    # HASH { $id => YYYY/MM }
-    my $month = $self->_msg_time('yyyy/mm');
-    $db->{ _month }->{ $id } = $month;
-
-    # HASH { YYYY/MM => (id1 id2 id3 ..) }
-    __add_value_to_array($db, '_monthly_idlist', $month, $id);
-
-    # need month database to determine subdir for the html file
-    $db->{ _filename }->{ $id } = $self->html_filename($id);
-    $db->{ _filepath }->{ $id } = $dst;
-
-    # HASH { $id => Subject: }
-    $db->{ _subject }->{ $id } =
-	$self->_decode_mime_string( $hdr->get('subject') );
-
-    # HASH { $id => From: }
-    my $ra = _address_clean_up( $hdr->get('from') );
-    $db->{ _from }->{ $id } = $ra->[0];
-    $db->{ _who }->{ $id }  = $self->_who_of_address( $hdr->get('from') );
-
-    # HASH { $id => Message-Id: }
-    # HASH { Message-Id: => $id }
-    # HASH { $id => list of $id ... }
-    $ra  = _address_clean_up( $hdr->get('message-id') );
-    my $mid = $ra->[0];
-    if ($mid) {
-	$db->{ _message_id }->{ $id } = $mid;
-	$db->{ _msgidref }->{ $mid }  = $id;
-	$db->{ _idref }->{ $id }      = $id;
-    }
-
-    # Thread Information by In-Reply-To: and References
-    {
-	my $irt_ra = _address_clean_up( $hdr->get('in-reply-to') );
-	my $in_reply_to = $irt_ra->[0];
-
-	_PRINT_DEBUG("In-Reply-To: $in_reply_to") if defined $in_reply_to;
-
-	# save message-id(s) within In-Reply-To: field into database
-	for my $mid (@$irt_ra) {
-	    # { message-id => (id1 id2 id3 ...)
-	    __add_value_to_array($db, '_msgidref', $mid, $id);
+    my $ndb     = $self->ndb();
+    my $id      = $args->{ id };
+    my $src     = $args->{ src };
+    my $dst     = $args->{ dst };
 
-	    # idp (pointer to id) by { message-id => id }
-	    my $idp = _list_head($db->{ _msgidref }->{ $mid });
+    $ndb->set_key($id);
+    $self->{ _ndb_key } = $id;
 
-	    # { idp => (id1 id2 id3 ...) }
-	    __add_value_to_array($db, '_idref', $idp, $id) if defined $idp;
-	}
-
-	# apply the same logic as above for all message-id's in References:
-	my $ref_ra = _address_clean_up( $hdr->get('references') );
-	my %uniq = ();
-      MSGID_SEARCH:
-	for my $mid (@$ref_ra) {
-	    next MSGID_SEARCH unless defined $mid;
-	    next MSGID_SEARCH if $uniq{$mid};
-	    $uniq{$mid} = 1; # ensure uniqueness
-
-	    _PRINT_DEBUG("References: $mid");
-	    __add_value_to_array($db, '_msgidref', $mid, $id);
-	    my $idp = _list_head($db->{ _msgidref }->{ $mid });
-	    __add_value_to_array($db, '_idref', $idp, $id) if defined $idp;
-	}
-
-	# 0. ok. go to speculate prev/next links
-	# 1. If In-Reply-To: is found, use it as "pointer to previous id"
-	my $idp = 0;
-	if (defined $in_reply_to) {
-	    # XXX idp (id pointer) = id1 by _list_head( (id1 id2 id3 ...)
-	    $idp = _list_head( $db->{ _msgidref }->{ $in_reply_to } );
-	}
-	# 2. if not found, try to use References: "in reverse order"
-	elsif (@$ref_ra) {
-	    my (@rra) = reverse(@$ref_ra);
-	    $idp = $rra[0];
-	}
-	# 3. no prev/next link
-	else {
-	    $idp = 0;
-	}
-
-	if (defined($idp) && $idp && $idp =~ /^\d+$/) {
-	    if ($idp != $id) {
-		$db->{ _prev_id }->{ $id } = $idp;
-		_PRINT_DEBUG("\$db->{ _prev_id }->{ $id } = $idp");
-	    }
-	    else {
-		_PRINT_DEBUG("no \$db->{ _prev_id }");
-	    }
-
-	    # XXX we should not overwrite " id => next_id " assinged already.
-	    # XXX we preserve the first " id => next_id " value.
-	    # XXX but we overwride it if "id => id (itself)", wrong link.
-	    unless ((defined $db->{ _next_id }->{ $idp }) &&
-		    ($db->{ _next_id }->{ $idp } != $idp)) {
-		$db->{ _next_id }->{ $idp } = $id;
-		_PRINT_DEBUG("override \$db->{ _next_id }->{ $idp } = $id");
-	    }
-	    else {
-		my $thread_head_id  = _thread_head( $db, $id );
-		_PRINT_DEBUG("no \$db->{ _next_id }->{ $idp } override");
-		_PRINT_DEBUG("   = $db->{ _next_id }->{ $idp }");
-	    }
-	}
-	else {
-	    _PRINT_DEBUG("no prev/next thread link (id=$id)");
-	    warn("no prev/next thread link (id=$id)\n") if $debug;
-	}
-    }
-
-    $self->_db_close();
+    $ndb->analyze($msg);
 }
 
 
-# Descriptions: return
-#    Arguments: OBJ($self) STR($type)
-# Side Effects: none
-# Return Value: STR
-sub _msg_time
+sub ndb_key
 {
-    my ($self, $type) = @_;
-    my $hdr  = $self->{ _current_hdr  };
+    my ($self) = @_;
+    return $self->{ _ndb_key };
+}
 
-    if (defined($hdr) && $hdr->get('date')) {
-	use Time::ParseDate;
-	my $unixtime = parsedate( $hdr->get('date') );
-	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime( $unixtime );
 
-	if ($type eq 'yyyymm') {
-	    return sprintf("%04d%02d", 1900 + $year, $mon + 1);
-	}
-	elsif ($type eq 'yyyy/mm') {
-	    return sprintf("%04d/%02d", 1900 + $year, $mon + 1);
-	}
-    }
-    else {
-	my $id = $self->{ _current_id };
-	warn("cannot pick up Date: field id=$id");
-	return '';
-    }
+sub ndb
+{
+    my ($self) = @_;
+    return $self->{ _ndb };
 }
 
 
@@ -1107,54 +969,6 @@ sub __str2array
 }
 
 
-# Descriptions: add { key => value } of database $dbname.
-#               value is "x y z ..." form, space separated string.
-#    Arguments: HASH_REF($db) STR($dbname) STR($key) STR($value)
-# Side Effects: update database
-# Return Value: none
-sub __add_value_to_array
-{
-    my ($db, $dbname, $key, $value) = @_;
-    my $found = 0;
-    my $ra    = __str2array($db->{ $dbname }->{ $key }) || [];
-
-    if (defined($key) && $key && defined($value) && $value) {
-	# check dup to ensure uniqueness within this array.
-	for my $v (@$ra) {
-	    $found = 1 if ($value =~ /^\d+$/o) && ($v == $value);
-	    $found = 1 if ($value !~ /^\d+$/o) && ($v eq $value);
-	}
-	
-	# add if the value is a new comer.
-	unless ($found) {
-	    $db->{ $dbname }->{ $key } .= " $value";
-	}
-    }
-}
-
-
-# Descriptions: speculate head of thread list,
-#               traced back from $id.
-#    Arguments: HASH_REF($db) STR($id)
-# Side Effects: none
-# Return Value: NUM
-sub _thread_head
-{
-    my ($db, $id) = @_;
-    my $max     = 128;
-    my $head_id = $id;
-
-    # track back id list to search the thread head
-    while ($max-- > 0) {
-	my $prev_id = $db->{ _prev_id }->{ $head_id };
-	last unless $prev_id;
-	$head_id = $prev_id;
-    }
-
-    return $head_id;
-}
-
-
 # Descriptions: speculate head of the next thread list.
 #    Arguments: HASH_REF($db) STR($id)
 # Side Effects: none
@@ -1559,138 +1373,6 @@ sub evaluate_safe_footer
 }
 
 
-=head1 Internal Data Presentation
-
-=head2 Hashes for Database
-
-   name          hash content
-   ----------------------------
-   from          id => From: header field
-   date          id => Date: header field
-   subject       id => Subject: header field
-   message_id    id => Message-Id: header field
-   references    id => References: header field
-   filepath      id => file location ( /some/where/YYYY/MM/DD/xxx.html )
-   idref         id => id(myself) refered-by-id1 refered-by-id2 ...
-   msgidref      message-id => id(myself) refered-by-id1 refered-by-id2 ...
-
-We need several information to speculate thread relation rapidly.
-At least we need two relations:
-
-1. to speculate [Next by Thread]
-
-   message-id => ( id1 id2 id3 ... )
-
-where C<id1> is the message itself.
-
-2. to speculate [Prev by Thread]
-
-   id         => message-id of replied message (e.g. In-Reply-To:)
-
-hashes.
-
-BTW, the end message of the thread has no next message,
-and the top of the thread has no previous message.
-We arrange apporopviate link to another thread.
-Also we need this relation for C<thread.html>.
-
-To resolve this problem, we need ID or Date ordered thread (top id of
-th thread) list ?
-
-   thread   followup relation in the thread
-   -----------------------------
-     id1    id1 - id2 - id4
-     id3    id3 - id5 - id6
-                   |
-                    - id7 - id10
-     id8    id8 - id9 - id11
-     id12   id12   ...
-
-=head2 Usage
-
-For example, you can set { $key => $value } for C<from> data in this way:
-
-    $self->{ _db }->{ _from }->{ $key } = $value;
-
-=cut
-
-my @kind_of_databases = qw(from date subject message_id references
-			   msgidref idref next_id prev_id
-			   filename filepath
-			   unixtime month monthly_idlist
-			   thread_list
-			   subdir
-			   who info);
-
-
-# 1. Hmm, what database is needed for
-#    {Prev,Next} by Article ID
-#    {Prev,Next} by Thread
-#
-# 2. each message needs ?
-#
-#      Subject:
-#      From:
-#
-
-
-# Descriptions: open database
-#    Arguments: OBJ($self) HASH_REF($args)
-# Side Effects: tied with $self->{ _db }
-#         Todo: we should use IO::Adapter ?
-# Return Value: none
-sub _db_open
-{
-    my ($self, $args) = @_;
-    my $db_type   = $args->{ db_type } || $self->{ _db_type } || 'AnyDBM_File';
-    my $db_dir    = $self->{ _html_base_directory };
-    my $file_mode = $self->{ _file_mode } || 0644;
-
-    _PRINT_DEBUG("_db_open( type = $db_type )");
-
-    eval qq{ use $db_type; use Fcntl;};
-    unless ($@) {
- 	for my $db (@kind_of_databases) {
-	    my $file = "$db_dir/.htdb_${db}";
-	    my $str = qq{
-		my \%$db = ();
-		tie \%$db, \$db_type, \$file, O_RDWR|O_CREAT, $file_mode;
-		\$self->{ _db }->{ _$db } = \\\%$db;
-	    };
-	    eval $str;
-	    croak($@) if $@;
-	}
-    }
-    else {
-	croak("cannot use $db_type");
-    }
-}
-
-
-# Descriptions: close database
-#    Arguments: OBJ($self) HASH_REF($args)
-# Side Effects: untie $self->{ _db }
-#         Todo: we should use IO::Adapter ?
-# Return Value: none
-sub _db_close
-{
-    my ($self, $args) = @_;
-    my $db_type = $args->{ db_type } || $self->{ _db_type } || 'AnyDBM_File';
-    my $db_dir  = $self->{ _html_base_directory };
-
-    _PRINT_DEBUG("_db_close()");
-
-    for my $db (@kind_of_databases) {
-	my $str = qq{
-	    my \$${db} = \$self->{ _db }->{ _$db };
-	    untie \%\$${db};
-	};
-	eval $str;
-	croak($@) if $@;
-    }
-}
-
-
 =head2 C<update_id_index($args)>
 
 update index.html.
@@ -1885,10 +1567,14 @@ sub _update_id_montly_index_master
     my ($self, $args) = @_;
     my $html_base_dir = $self->{ _html_base_directory };
     my $code          = _charset_to_code($self->{ _charset });
+
+    use File::Spec;
+    my $old = File::Spec->catfile($html_base_dir, "monthly_index.html");
+    my $new = File::Spec->catfile($html_base_dir, "monthly_index.html.new.$$");
     my $htmlinfo = {
 	title => defined($args->{ title }) ? $args->{ title } : "ID Index",
-	old   => "$html_base_dir/monthly_index.html",
-	new   => "$html_base_dir/monthly_index.html.new.$$",
+	old   => $old,
+	new   => $new,
 	code  => $code,
     };
 
@@ -2455,19 +2141,6 @@ sub _who_of_address
 }
 
 
-# Descriptions: head of array (space separeted string)
-#    Arguments: STR($buf)
-# Side Effects: none
-# Return Value: STR
-sub _list_head
-{
-    my ($buf) = @_;
-    $buf =~ s/^\s*//;
-    $buf =~ s/\s*$//;
-    return (split(/\s+/, $buf))[0];
-}
-
-
 # Descriptions: decode MIME-encoded $str
 #    Arguments: OBJ($self) STR($str) HASH_REF($options)
 # Side Effects: none
@@ -2648,15 +2321,21 @@ if ($0 eq __FILE__) {
     my $has_fork = defined $ENV{'HAS_FORK'} ? 1 : 0;
     my $max      = defined $ENV{'MAX'} ? $ENV{'MAX'} : 1000;
     my $charset  = 'euc-jp';
+    my $opts     = {
+	db_base_dir => "/tmp/",
+	db_name     => "elena", 
+    };
 
     eval q{
-	my $obj = new Mail::Message::ToHTML:
+	my $obj = new Mail::Message::ToHTML $opts;
 
 	for my $x (@ARGV) {
 	    if (-f $x) {
 		$obj->htmlify_file($x, {
-		    directory => $dir
-		    charset   => $charset,
+		    directory   => $dir,
+		    charset     => $charset,
+		    db_base_dir => "/tmp/",
+		    db_name     => "elena", 
 		    });
 	    }
 	    elsif (-d $x) {
@@ -2669,7 +2348,11 @@ if ($0 eq __FILE__) {
 	    }
 	}
     };
-    croak($@) if $@;
+
+    if ($@) {
+	print STDERR $@;
+	exit(1);
+    }
 }