restructuring under FML::Error class to be more extensible.

5 files changed, 729 insertions, 357 deletions

diff --git a/fml/lib/FML/Error.pm b/fml/lib/FML/Error.pm
index bc79e18f..01a79f4f 100644
--- a/fml/lib/FML/Error.pm
+++ b/fml/lib/FML/Error.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: Error.pm,v 1.20 2003/05/20 10:02:16 fukachan Exp $
+# $FML: Error.pm,v 1.21 2003/05/20 13:49:04 fukachan Exp $
 #
 
 package FML::Error;
@@ -52,10 +52,24 @@ sub new
     my ($self, $curproc) = @_;
     my ($type) = ref($self) || $self;
     my $me     = { _curproc => $curproc };
+    my $config = $curproc->config();
+    my $fp     = $config->{ error_analyzer_function } || 'simple_count';
+
+    # defautl analyzer function
+    $me->{ _analyzer_function_name } = $fp;
+
     return bless $me, $type;
 }
 
 
+=head2 get_lock_channel_name()
+
+return the lock channel name to be used to lock/unlock error related
+functions.
+
+=cut
+
+
 # Descriptions: lock channel we should use to lock this object.
 #    Arguments: OBJ($self)
 # Side Effects: lock "error_analyzer_cache_dir" channel
@@ -69,7 +83,11 @@ sub get_lock_channel_name
 }
 
 
-=head1 LOCK ERROR DB ACCESS
+=head1 LOCK ACCESS TO ERROR CACHE DB
+
+=head2 lock()
+
+=head2 unlock()
 
 =cut
 
@@ -100,7 +118,11 @@ sub unlock
 }
 
 
-=head1 Database
+=head1 DATABASE
+
+=head2 db_open()
+
+=head2 db_close()
 
 =cut
 
@@ -133,7 +155,18 @@ sub db_close
 
 =head2 add($info)
 
-add bounce info into cache.
+add bounce info into cache where $info is a HASH_REF.  Currently,
+$info expects "address", "status" (status code) and "reason".
+"address" and "status" are mandatory.
+
+    $info = {
+	address => $address,
+	status  => $status,
+	reason  => $reason,
+    };
+
+The format to store these information depends on FML::Error::Cache
+module, which conceals the detail of cache structure.
 
 =cut
 
@@ -147,11 +180,12 @@ add bounce info into cache.
 sub add
 {
     my ($self, $info) = @_;
-    my $db = $self->{ _db };
+    my $db   = $self->{ _db };
+    my $addr = $info->{ address }; 
 
     if (defined $db) {
 	$self->lock();
-	$db->add($info);
+	$db->add($addr, $info);
 	$self->unlock();
     }
     else {
@@ -162,12 +196,11 @@ sub add
 
 =head2 analyze()
 
-open error message cache and
-analyze the data by the analyzer function.
-The function is specified by $config->{ error_analyzer_function }.
-Available functions are located in C<FML::Error::Analyze>.
-C<simple_count> function is used by default if $config->{
-error_analyzer_function } is unspecified.
+open error message cache and analyze the data by the analyzer
+function.  The function is specified by $config->{
+error_analyzer_function }.  Available functions are located in
+C<FML::Error::Analyze>.  C<simple_count> function is used by default
+if $config->{ error_analyzer_function } is unspecified.
 
 =cut
 
@@ -175,50 +208,76 @@ error_analyzer_function } is unspecified.
 # Descriptions: open error message cache and analyze the data by
 #               the specified analyzer function.
 #    Arguments: OBJ($self)
-# Side Effects: set up $self->{ _remove_addr_list } used internally.
+# Side Effects: set up $self->{ _removal_addr_list } used internally.
 # Return Value: none
 sub analyze
 {
     my ($self)  = @_;
     my $curproc = $self->{ _curproc };
-    my $config  = $curproc->config();
     my $cache   = $self->db_open();
     my $rdata   = $cache->get_all_values_as_hash_ref();
 
     use FML::Error::Analyze;
     my $analyzer = new FML::Error::Analyze $curproc;
-    my $fp       = $config->{ error_analyzer_function } || 'simple_count';
+    my $fp       = $self->{ _analyzer_function_name };
 
     # critical region: access to db under locked.
     $self->lock();
-    my $list = $analyzer->$fp($curproc, $rdata);
+    $analyzer->$fp($curproc, $rdata);
     $self->unlock();
 
-    $self->{ _analyzer } = $analyzer;
+    # saved for further reference.
+    $self->{ _analyzer }          = $analyzer;
+    $self->{ _removal_addr_list } = $analyzer->removal_address();
+
+    # clean up.
+    $self->db_close();
+}
+
+
+=head2 set_analyzer_function($fp)
+
+set the function for error cost evaluator. Acutually, the contet
+locates at C<FML::Error::Analyze::$fp>.
+
+=head2 get_analyzer_function($fp)
 
-    # pass address list to remove
-    $self->{ _remove_addr_list } = $list;
+get the current function.
+
+=cut
+
+
+# Descriptions: set analyzer function name
+#    Arguments: OBJ($self) STR($fp)
+# Side Effects: one
+# Return Value: STR
+sub set_analyzer_function
+{
+    my ($self, $fp) = @_;
+    $self->{ _analyzer_function_name } = $fp;
 }
 
 
-# Descriptions: get data detail for the current result as HASH_REF.
+# Descriptions: set analyzer function name
 #    Arguments: OBJ($self)
-# Side Effects: none
-# Return Value: HASH_REF
-sub get_data_detail
+# Side Effects: one
+# Return Value: STR
+sub get_analyzer_function
 {
     my ($self) = @_;
-    my $analyzer = $self->{ _analyzer };
-
-    if (defined $analyzer) {
-	return $analyzer->get_data_detail();
-    }
-    else {
-	return {}
-    }
+    return $self->{ _analyzer_function_name };
 }
 
 
+=head1 ADDRESS MANIPULATION
+
+=head2 is_list_address($addr)
+
+check whether $addr is one of addresses this ML uses.
+
+=cut
+
+
 # Descriptions: check whether $addr is one of addresses this ML uses.
 #    Arguments: OBJ($self) STR($addr)
 # Side Effects: none
@@ -250,10 +309,11 @@ sub is_list_address
     return $match;
 }
 
+
 =head2 remove_bouncers()
 
-delete mail addresses, analyze() determined as bouncers, by deluser()
-method.
+delete mail addresses which analyze() determined as bouncers by
+deluser() method.
 
 You need to call analyze() method before calling remove_bouncers() to
 list up addresses to remove.
@@ -269,7 +329,7 @@ sub remove_bouncers
 {
     my ($self) = @_;
     my $curproc = $self->{ _curproc };
-    my $list    = $self->{ _remove_addr_list };
+    my $list    = $self->{ _removal_addr_list };
 
     use FML::Credential;
     my $cred = new FML::Credential $curproc;
@@ -278,27 +338,32 @@ sub remove_bouncers
     my $safe = new FML::Restriction::Base;
 
     # XXX need no lock here since lock is done in FML::Command::* class.
-  ADDR:
-    for my $addr (@$list) {
-	unless ($self->is_list_address($addr)) { 
-	    # check if $address is a safe string.
-	    if ($safe->regexp_match('address', $addr)) {
-		if ($cred->is_member( $addr ) || 
-		    $cred->is_recipient( $addr )) {
-		    $self->deluser( $addr );
+    if (defined $list) {
+      ADDR:
+	for my $addr (@$list) {
+	    unless ($self->is_list_address($addr)) {
+		# check if $address is a safe string.
+		if ($safe->regexp_match('address', $addr)) {
+		    if ($cred->is_member( $addr ) ||
+			$cred->is_recipient( $addr )) {
+			$self->deluser( $addr );
+		    }
+		    else {
+			Log("remove_bouncers: <$addr> seems not member");
+		    }
 		}
 		else {
-		    Log("remove_bouncers: <$addr> seems not member");
+		    LogError("remove_bouncers: <$addr> unsafe expr");
+		    next ADDR;
 		}
 	    }
 	    else {
-		LogError("remove_bouncers: <$addr> is invalid");
-		next ADDR;
+		LogWarn("remove_bouncers: <$addr> ignored");
 	    }
 	}
-	else {
-	    LogWarn("remove_bouncers: <$addr> ignored");
-	}
+    }
+    else {
+	LogError("undefined list");
     }
 }
 
@@ -373,9 +438,9 @@ sub deluser
 
 =head1 DUMP ADDRESS AND STATUS
 
-=head2 dump([$handle])
+=head2 print([$handle])
 
-list up the address and point.
+print list of addresses and the corresponding point.
 
 =cut
 
@@ -384,25 +449,29 @@ list up the address and point.
 #    Arguments: OBJ($self) HANDLE($handle)
 # Side Effects: none
 # Return Value: none
-sub dump
+sub print
 {
     my ($self, $handle) = @_;
-    my $info = $self->get_data_detail();
-    my $wh   = $handle || \*STDOUT;
-
-    my ($k, $v);
-    while (($k, $v) = each %$info) {
-	if (defined($v) && ref($v) eq 'ARRAY') {
-	    my $x = '';
-	    for my $y (@$v) {
-		$x .= $y if defined $y;
-		$x .= " ";
-	    }
+    my $wh       = $handle || \*STDOUT;
+    my $analyzer = $self->{ _analyzer };
 
-	    printf $wh "%25s => (%s)\n", $k, $x;
-	}
-	else {
-	    printf $wh "%25s => %s\n", $k, $v;
+    if (defined $analyzer) {
+	my $info = $analyzer->summary();
+    	my ($k, $v);
+	
+	while (($k, $v) = each %$info) {
+	    if (defined($v) && ref($v) eq 'ARRAY') {
+		my $x = '';
+		for my $y (@$v) {
+		    $x .= $y if defined $y;
+		    $x .= " ";
+		}
+
+		printf $wh "%25s => (%s)\n", $k, $x;
+	    }
+	    else {
+		printf $wh "%25s => %s\n", $k, $v;
+	    }
 	}
     }
 }
diff --git a/fml/lib/FML/Error/Analyze.pm b/fml/lib/FML/Error/Analyze.pm
index b764fbfb..eb4f12f0 100644
--- a/fml/lib/FML/Error/Analyze.pm
+++ b/fml/lib/FML/Error/Analyze.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: Analyze.pm,v 1.18 2003/01/26 05:57:11 fukachan Exp $
+# $FML: Analyze.pm,v 1.19 2003/02/09 12:31:42 fukachan Exp $
 #
 
 package FML::Error::Analyze;
@@ -45,328 +45,121 @@ sub new
 }
 
 
-=head2 $data STRUCTURE
+=head1 METHODS
 
-C<$data> is passed to the error analyer function.
+=head2 summary()
 
-	 $data = {
-	    address => [
-	           error_info_1,
-	           error_info_2, ...
-	    ]
-	 };
+return summary of points of addresses as HASH_REF.
 
-where the error_info_* has error reasons.
+    $summary = {
+	address1 => point,
+	address2 => point,	
+    };
 
-=head1 METHODS
+=head2 removal_address()
 
-=head2 simple_count()
+return addresses to be removed.
 
 =cut
 
 
-# Descriptions: count up the number of errors.
-#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($data)
+# Descriptions: return summary 
+#    Arguments: OBJ($self)
 # Side Effects: none
-# Return Value: ARRAY_REF
-sub simple_count
+# Return Value: HASH_REF
+sub summary
 {
-    my ($self, $curproc, $data) = @_;
-    my ($addr, $bufarray, $count);
-    my ($time, $status, $reason);
-    my @removelist = ();
-    my $summary    = {};
-    my $config     = $curproc->config();
-    my $limit      = $config->{ error_analyzer_simple_count_limit } || 5;
-    my $daylimit   = $config->{ error_analyzer_day_limit } || 14;
-
-    while (($addr, $bufarray) = each %$data) {
-	$count = 0;
-
-	# count up the number of error messsages if the status is 5XX.
-	if (defined $bufarray) {
-	    for my $buf (@$bufarray) {
-		($time, $status, $reason) = split(/\s+/, $buf);
-		next if ((time - $time) > (86400*$daylimit));
-		if ($buf =~ /status=5/i) {
-		    $count++;
-		    $summary->{ $addr } = $count;
-		}
-	    }
-	}
+    my ($self) = @_;
+    my $analyzer = $self->{ _analyzer };
 
-	# add address to the removal list if the count is over $limit.
-	if ($count > $limit) {
-	    push(@removelist, $addr);
-	}
+    if (defined $analyzer) {
+	return $analyzer->summary();
     }
-
-    # debug info
-    if ($debug) {
-	Log("error: simple_count analyzer summary");
-	my ($k, $v);
-	while (($k, $v) = each %$summary) {
-	    Log("summary: $k = $v points");
-	}
+    else {
+	return {};
     }
-
-    # save info
-    $self->{ _summary } = $summary;
-
-    return \@removelist;
 }
 
-# Descriptions: count up the number of errors.
-#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($data)
+
+# Descriptions: return removal address candidates
+#    Arguments: OBJ($self)
 # Side Effects: none
 # Return Value: ARRAY_REF
-sub simple_count2
+sub removal_address
 {
-    my ($self, $curproc, $data) = @_;
-    my ($addr, $bufarray, $count);
-    my ($time, $status, $reason);
-    my @removelist = ();
-    my $summary    = {};
-    my $config     = $curproc->config();
-    my $limit      = $config->{ error_analyzer_simple_count_limit } || 5;
-    my $daylimit   = $config->{ error_analyzer_day_limit } || 14;
-
-    while (($addr, $bufarray) = each %$data) {
-	$count = 0;
-
-	# count up the number of error messsages if the status is 5XX.
-	if (defined $bufarray) {
-	    for my $buf (@$bufarray) {
-		($time, $status, $reason) = split(/\s+/, $buf);
-		next if ((time - $time) > (86400*$daylimit));
-		if ($buf =~ /status=5/i) {
-		    $count++;
-		    $summary->{ $addr } = $count;
-		}
-		if ($buf =~ /status=4/i) {
-		    $count += 0.25;
-		    $summary->{ $addr } = $count;
-		}
-	    }
-	}
-
-	# add address to the removal list if the count is over $limit.
-	if ($count > $limit) {
-	    push(@removelist, $addr);
-	}
+    my ($self) = @_;
+    my $analyzer = $self->{ _analyzer };
+	
+    if (defined $analyzer) {
+	return $analyzer->removal_address();
     }
-
-    # debug info
-    if ($debug) {
-	Log("error: simple_count2 analyzer summary");
-	my ($k, $v);
-	while (($k, $v) = each %$summary) {
-	    Log("summary: $k = $v points");
-	}
+    else {
+	return [];
     }
-
-    return \@removelist;
 }
 
 
-=head2 error_continuity()
-
-    examine the continuity of error messages (*).
-    --------------------> time
-         *           ok
-        *********    bad
-        * * *** *    ambiguous
+=head2 C<AUTOLOAD()>
 
-but sum up count as the delta.
-
-         *
-        ***
+the command dispatcher.
+It hooks up the C<$command> request and loads the module in
+C<FML::Command::$MODE::$command>.
 
 =cut
 
 
-# Descriptions: error continuity based cost counting
-#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($data)
-# Side Effects: none
-# Return Value: ARRAY_REF
-sub error_continuity
+# Descriptions: run FML::Error::Analyze::XXX()
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($anal_args)
+# Side Effects: load appropriate module
+# Return Value: none
+sub AUTOLOAD
 {
-    my ($self, $curproc, $data) = @_;
-    my ($addr, $bufarray, $count, $i);
-    my ($time, $status, $reason);
-    my @removelist = ();
-    my $summary    = {};
-    my $config     = $curproc->config();
-    my $limit      = $config->{ error_analyzer_simple_count_limit } || 14;
-    my $daylimit   = $config->{ error_analyzer_day_limit } || 14;
-
-    while (($addr, $bufarray) = each %$data) {
-	$count = 0;
-	if (defined $bufarray) {
-	    for my $buf (@$bufarray) {
-		($time, $status, $reason) = split(/\s+/, $buf);
-		next if ((time - $time) > (86400*$daylimit));
-
-		if ($buf =~ /status=5/i) {
-		    unless (defined $summary->{ $addr }) {
-			$summary->{ $addr } = [ 0 ];
-		    }
-
-		    # center of distribution function
-		    $i = int( (time - $time ) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 2;
-
-		    # +delta
-		    $i = int( (time - $time + 12*3600) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 1;
-
-		    # -delta
-		    $i = int( (time - $time - 12*3600) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 1 if $i >= 0;
-		}
-	    }
-	}
-    }
-
-    # debug info
-    {
-	my $addr = '';
-	my $sum  = 0;
-	my $ra   = ();
-	while (($addr, $ra) = each %$summary) {
-	    $sum = 0;
-	    for my $v (@$ra) {
-		# count if the top of the mountain is over 2.
-		if (defined $v) {
-		    $sum += 1 if $v >= 2;
-		}
-	    }
-
-	    my $array = __debug_printable_array($ra);
-	    Log("summary: $addr sum=$sum ($array)");
-	    push(@removelist, $addr) if $sum >= $limit;
-	}
-    }
+    my ($self, $curproc, $anal_args) = @_;
 
-    # save info
-    $self->{ _summary } = $summary;
+    # we need to ignore DESTROY()
+    return if $AUTOLOAD =~ /DESTROY/;
 
-    return \@removelist;
-}
+    my $fp = $AUTOLOAD;
+    $fp =~ s/.*:://;
+    my $pkg = "FML::Error::Analyze::${fp}";
 
+    Log("load $pkg") if 1; # debug
 
-# Descriptions: error continuity based cost counting
-#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($data)
-# Side Effects: none
-# Return Value: ARRAY_REF
-sub error_continuity2
-{
-    my ($self, $curproc, $data) = @_;
-    my ($addr, $bufarray, $count, $i);
-    my ($time, $status, $reason);
-    my @removelist = ();
-    my $summary    = {};
-    my $config     = $curproc->config();
-    my $limit      = $config->{ error_analyzer_simple_count_limit } || 14;
-    my $daylimit   = $config->{ error_analyzer_day_limit } || 14;
-
-    while (($addr, $bufarray) = each %$data) {
-	$count = 0;
-	if (defined $bufarray) {
-	    for my $buf (@$bufarray) {
-		($time, $status, $reason) = split(/\s+/, $buf);
-		next if ((time - $time) > (86400*$daylimit));
-
-		if ($buf =~ /status=5/i) {
-		    unless (defined $summary->{ $addr }) {
-			$summary->{ $addr } = [ 0 ];
-		    }
-
-		    # center of distribution function
-		    $i = int( (time - $time ) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 2;
-
-		    # +delta
-		    $i = int( (time - $time + 12*3600) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 1;
-
-		    # -delta
-		    $i = int( (time - $time - 12*3600) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 1 if $i >= 0;
-		}
-		if ($buf =~ /status=4/i) {
-		    unless (defined $summary->{ $addr }) {
-			$summary->{ $addr } = [ 0 ];
-		    }
-
-		    # center of distribution function
-		    $i = int( (time - $time ) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 0.25;
-
-		    # +delta
-		    $i = int( (time - $time + 12*3600) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 0.25;
-
-		    # -delta
-		    $i = int( (time - $time - 12*3600) / (24*3600) );
-		    $summary->{ $addr }->[ $i ] += 0.25 if $i >= 0;
-		}
-	    }
+    my $analyzer = undef;
+    eval qq{ use $pkg; \$analyzer = new $pkg;};
+    unless ($@) {
+	# run the actual process
+	if ($analyzer->can('process')) {
+	    $analyzer->process($curproc, $anal_args);
+	    $self->{ _analyzer } = $analyzer;
 	}
-    }
-
-    # debug info
-    {
-	my $addr = '';
-	my $sum  = 0;
-	my $ra   = ();
-	while (($addr, $ra) = each %$summary) {
-	    $sum = 0;
-	    for my $v (@$ra) {
-		# count if the top of the mountain is over 2.
-		if (defined $v) {
-		    $sum += 1 if $v >= 2;
-		}
-	    }
-
-	    my $array = __debug_printable_array($ra);
-	    Log("summary: $addr sum=$sum ($array)");
-	    push(@removelist, $addr) if $sum >= $limit;
+	else {
+	    LogError("${pkg} has no process method");
 	}
     }
-
-    return \@removelist;
-}
-
-# Descriptions: return array list with 0 padding (debug)
-#    Arguments: ARRAY_REF($ra)
-# Side Effects: none
-# Return Value: STR
-sub __debug_printable_array
-{
-    my ($ra) = @_;
-    my $s    = '';
-
-    for my $x (@$ra) {
-	$s .= defined $x ? $x : 0;
-	$s .= " ";
+    else {
+	LogError($@) if $@;
+	LogError("$pkg module is not found");
+	croak("$pkg module is not found"); # upcall to FML::Error
     }
-
-    return $s;
 }
 
 
-# Descriptions: get data detail for the result as HASH_REF.
-#    Arguments: OBJ($self)
-# Side Effects: none
-# Return Value: HASH_REF
-sub get_data_detail
-{
-    my ($self) = @_;
+=head1 $data STRUCTURE
 
-    return $self->{ _summary } || {};
-}
+C<$data> is passed to the error analyer function 
+C<FML::Error::Analyze::${fp}> (as $anal_args in AUTOLOAD()).
+
+	 $data = {
+	    address => [
+	           error_info_1,
+	           error_info_2, ...
+	    ]
+	 };
 
+where the error_info_* has error reasons (STR).  $fp parses it, count
+up.  FML::Error or FML::Error::Analyze can retrieve the result via
+summary() method.
 
 =head1 CODING STYLE
 
diff --git a/fml/lib/FML/Error/Analyze/histgram.pm b/fml/lib/FML/Error/Analyze/histgram.pm
new file mode 100644
index 00000000..46352a09
--- /dev/null
+++ b/fml/lib/FML/Error/Analyze/histgram.pm
@@ -0,0 +1,232 @@
+#-*- 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: @template.pm,v 1.7 2003/01/01 02:06:22 fukachan Exp $
+#
+
+package FML::Error::Analyze::histgram;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+use FML::Log qw(Log LogWarn LogError);
+
+my $debug = 1;
+
+
+=head1 NAME
+
+FML::Error::Analyze::histgram - cost evaluator
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 C<new($curproc)>
+
+constructor.
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) OBJ($curproc)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self, $curproc) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = { _curproc => $curproc };
+    return bless $me, $type;
+}
+
+
+# Descriptions: cost evaluator.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($data)
+# Side Effects: none
+# Return Value: none
+sub process
+{
+    my ($self, $curproc, $data) = @_;
+    $self->_histgram($curproc, $data);
+}
+
+
+=head2 histgram()
+
+    examine the continuity of error messages (*).
+    --------------------> time
+         *           ok
+        *********    bad
+        * * *** *    ambiguous
+
+but sum up count as the delta.
+
+         *
+        ***
+
+=cut
+
+
+# Descriptions: error continuity based cost counting
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($data)
+# Side Effects: none
+# Return Value: ARRAY_REF
+sub _histgram
+{
+    my ($self, $curproc, $data) = @_;
+    my ($addr, $bufarray, $count, $i);
+    my ($time, $status, $reason);
+    my @removelist = ();
+    my $summary    = {};
+    my $config     = $curproc->config();
+    my $limit      = $config->{ error_analyzer_simple_count_limit } || 14;
+    my $daylimit   = $config->{ error_analyzer_day_limit } || 14;
+    my $now        = time;
+    my $day        = 24*3600;
+    my $threshold  = $day * $daylimit;
+
+    while (($addr, $bufarray) = each %$data) {
+	$count = 0;
+	if (defined $bufarray) {
+	    for my $buf (@$bufarray) {
+		($time, $status, $reason) = split(/\s+/, $buf);
+		next if ((time - $time) > $threshold);
+
+		if ($buf =~ /status=5/i) {
+		    unless (defined $summary->{ $addr }) {
+			$summary->{ $addr } = [ 0 ];
+		    }
+
+		    # center of distribution function
+		    $i = int( (time - $time ) / (24*3600) );
+		    $summary->{ $addr }->[ $i ] += 2;
+
+		    # +delta
+		    $i = int( (time - $time + 12*3600) / (24*3600) );
+		    $summary->{ $addr }->[ $i ] += 1;
+
+		    # -delta
+		    $i = int( (time - $time - 12*3600) / (24*3600) );
+		    $summary->{ $addr }->[ $i ] += 1 if $i >= 0;
+		}
+		elsif ($buf =~ /status=4/i) {
+		    unless (defined $summary->{ $addr }) {
+			$summary->{ $addr } = [ 0 ];
+		    }
+
+		    # center of distribution function
+		    $i = int( (time - $time ) / (24*3600) );
+		    $summary->{ $addr }->[ $i ] += 0.25;
+
+		    # +delta
+		    $i = int( (time - $time + 12*3600) / (24*3600) );
+		    $summary->{ $addr }->[ $i ] += 0.25;
+
+		    # -delta
+		    $i = int( (time - $time - 12*3600) / (24*3600) );
+		    $summary->{ $addr }->[ $i ] += 0.25 if $i >= 0;
+		}
+	    }
+	}
+    }
+
+    # debug info
+    {
+	my $addr = '';
+	my $sum  = 0;
+	my $ra   = ();
+	while (($addr, $ra) = each %$summary) {
+	    $sum = 0;
+	    for my $v (@$ra) {
+		# count if the top of the mountain is over 2.
+		if (defined $v) {
+		    $sum += 1 if $v >= 2;
+		}
+	    }
+
+	    my $array = __debug_printable_array($ra);
+	    Log("summary: $addr sum=$sum ($array)");
+	    push(@removelist, $addr) if $sum >= $limit;
+	}
+    }
+
+    # save info
+    $self->{ _summary } = $summary;
+
+    # save address for removal candidates
+    $self->{ _removal_address } = \@removelist;
+}
+
+
+# Descriptions: return array list with 0 padding (debug)
+#    Arguments: ARRAY_REF($ra)
+# Side Effects: none
+# Return Value: STR
+sub __debug_printable_array
+{
+    my ($ra) = @_;
+    my $s    = '';
+
+    for my $x (@$ra) {
+	$s .= defined $x ? $x : 0;
+	$s .= " ";
+    }
+
+    return $s;
+}
+
+
+# Descriptions: return summary as HASH_REF.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: HASH_REF
+sub summary
+{
+    my ($self) = @_;
+
+    return( $self->{ _summary } || {} );
+}
+
+
+# Descriptions: return addresses to be removed.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: HASH_REF
+sub removal_address
+{
+    my ($self) = @_;
+
+    return( $self->{ _removal_address } || [] );
+}
+
+
+=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
+
+FML::Error::Analyze::simple_count appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Error/Analyze/simple_count.pm b/fml/lib/FML/Error/Analyze/simple_count.pm
new file mode 100644
index 00000000..7624d08b
--- /dev/null
+++ b/fml/lib/FML/Error/Analyze/simple_count.pm
@@ -0,0 +1,165 @@
+#-*- 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: @template.pm,v 1.7 2003/01/01 02:06:22 fukachan Exp $
+#
+
+package FML::Error::Analyze::simple_count;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+use FML::Log qw(Log LogWarn LogError);
+
+my $debug = 1;
+ 
+
+=head1 NAME
+
+FML::Error::Analyze::simple_count - cost evaluator
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 C<new($curproc)>
+
+constructor.
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) OBJ($curproc)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self, $curproc) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = { _curproc => $curproc };
+    return bless $me, $type;
+}
+
+
+# Descriptions: main dispatcher
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($data)
+# Side Effects: none
+# Return Value: none
+sub process
+{
+    my ($self, $curproc, $data) = @_;
+    $self->_simple_count($curproc, $data);
+}
+
+
+# Descriptions: simply count up the number of errors.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($data)
+# Side Effects: none
+# Return Value: ARRAY_REF
+sub _simple_count
+{
+    my ($self, $curproc, $data) = @_;
+    my ($addr, $bufarray, $count);
+    my ($time, $status, $reason);
+    my @removelist = ();
+    my $summary    = {};
+    my $config     = $curproc->config();
+    my $limit      = $config->{ error_analyzer_simple_count_limit } || 5;
+    my $daylimit   = $config->{ error_analyzer_day_limit } || 14;
+    my $now        = time;
+    my $day        = 24*3600;
+    my $threshold  = $day * $daylimit;
+
+    while (($addr, $bufarray) = each %$data) {
+	$count = 0;
+
+	# count up the number of error messsages if the status is 5XX.
+	if (defined $bufarray) {
+	  ELEMENT:
+	    for my $buf (@$bufarray) {
+		($time, $status, $reason) = split(/\s+/, $buf);
+
+		# ignore too old data.
+		next ELEMENT if (($now - $time) > $threshold);
+
+		if ($buf =~ /status=5/i) {
+		    $count += 1.0;
+		}
+		elsif ($buf =~ /status=4/i) {
+		    $count += 0.25;
+		}
+		else {
+		    $count += 0.1;
+		}
+
+		$summary->{ $addr } = $count;
+	    }
+	}
+
+	# add address to the removal list if the count is over $limit.
+	if ($count > $limit) {
+	    push(@removelist, $addr);
+	}
+    }
+
+    # save info
+    $self->{ _summary } = $summary;
+
+    # save address for removal candidates
+    $self->{ _removal_address } = \@removelist;
+}
+
+
+# Descriptions: return summary as HASH_REF.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: HASH_REF
+sub summary
+{
+    my ($self) = @_;
+
+    return( $self->{ _summary } || {} );
+}
+
+
+# Descriptions: return addresses to be removed.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: HASH_REF
+sub removal_address
+{
+    my ($self) = @_;
+
+    return( $self->{ _removal_address } || [] );
+}
+
+
+=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
+
+FML::Error::Analyze::simple_count appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Error/Cache.pm b/fml/lib/FML/Error/Cache.pm
index 919b49ab..ace4178f 100644
--- a/fml/lib/FML/Error/Cache.pm
+++ b/fml/lib/FML/Error/Cache.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: Cache.pm,v 1.8 2002/12/24 10:19:45 fukachan Exp $
+# $FML: Cache.pm,v 1.9 2003/03/06 09:54:24 fukachan Exp $
 #
 
 package FML::Error::Cache;
@@ -63,28 +63,85 @@ sub new
 }
 
 
+=head2 open()
+
+dummy.
+
+=head2 close()
+
+dummy.
+
+=head2 touch()
+
+dummy.
+
+=cut
+
+
+# Descriptions: none
+#    Arguments: none
+# Side Effects: none
+# Return Value: none
+sub open  { 1;}
+
+# Descriptions: none
+#    Arguments: none
+# Side Effects: none
+# Return Value: none
+sub close { 1;}
+
+# Descriptions: none
+#    Arguments: none
+# Side Effects: none
+# Return Value: none
+sub touch { 1;}
+
+
+=head2 add($address, $argv) 
+
+add data given as hash reference $argv.
+
+    $argv = {
+	address => STR,
+	reason  => STR,
+	status  => STR,
+    };
+
+C<Tie::JournaledDir> is a simple hash, so $argv is converted to the
+following a set of key ($address) and value.
+
+     $address => "$unixtime status=$status reason=$reason"
+
+=cut
+
+
 # Descriptions: add bounce info into cache.
-#    Arguments: OBJ($self) HASH_REF($info)
+#    Arguments: OBJ($self) STR($address) HASH_REF($argv)
 # Side Effects: update cache
 # Return Value: none
 sub add
 {
-    my ($self, $info) = @_;
+    my ($self, $address, $argv) = @_;
 
     $self->_open_cache();
 
     my $db = $self->{ _db };
     if (defined $db) {
-	my ($address, $reason, $status);
+	my ($reason, $status);
 	my $unixtime = time;
 
-	$address = $info->{ address };
-	$reason  = $info->{ reason } || 'unknown';
-	$status  = $info->{ status } || 'unknown';
-
-	if ($address) {
+	if (ref($argv) eq 'HASH') {
+	    $reason = $argv->{ reason } || 'unknown';
+	    $status = $argv->{ status } || 'unknown';
 	    $status =~ s/\s+/_/g;
 	    $reason =~ s/\s+/_/g;
+	}
+	else {
+	    LogError("FML::Error::Cache: add: not implemented \$argv type");
+	    return undef;
+	}
+
+	if ($address) {
 	    $db->{ $address } = "$unixtime status=$status reason=$reason";
 	}
 	else {
@@ -99,6 +156,53 @@ sub add
 }
 
 
+=head2 delete($address)
+
+delete entry for $address.
+
+=cut
+
+
+# Descriptions: delete entry for $address.
+#    Arguments: OBJ($self) STR($address) HASH_REF($argv)
+# Side Effects: update cache
+# Return Value: none
+sub delete
+{
+    my ($self, $address) = @_;
+
+    $self->_open_cache();
+
+    my $db = $self->{ _db };
+    if (defined $db) {
+	if ($address) {
+	    delete $db->{ $address };
+	}
+	else {
+	    LogWarn("FML::Error::Cache: delete: invalid data");
+	}
+
+	$self->_close_cache();
+    }
+    else {
+	croak("FML::Error::Cache: delete: unknown data input type");
+    }
+}
+
+
+=head1 CACHE IO MANIPULATION
+
+You need to use primitive methods this class provides for IO into/from
+error data cache.
+
+C<Tie::JournaledDir> is a simple hash, so $argv is converted to the
+following a set of key ($address) and value.
+
+     $address => "$unixtime status=$status reason=$reason"
+
+=cut
+
+
 # Descriptions: open the cache database for File::CacheDir.
 #    Arguments: OBJ($self)
 # Side Effects: none
@@ -137,11 +241,20 @@ sub _close_cache
 }
 
 
-# Descriptions: return key list in db.
+=head1 UTILITY FUNCTIONS
+
+=head2 get_primary_keys()
+
+return primary keys in cache as ARRAY_REF.
+
+=cut
+
+
+# Descriptions: return (primary) key list in cache database.
 #    Arguments: OBJ($self)
 # Side Effects: none
 # Return Value: ARRAY_REF
-sub get_addr_list
+sub get_primary_keys
 {
     my ($self) = @_;