#-*- perl -*-
#
# Copyright (C) 2003,2004,2005,2006 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: simple_count.pm,v 1.13 2006/02/15 13:44:04 fukachan Exp $
#
package FML::Error::Analyze::simple_count;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Carp;
my $debug = 1;
=head1 NAME
FML::Error::Analyze::simple_count - simple cost evaluator.
=head1 SYNOPSIS
my $analyzer = new FML::Error::Analyze::simple_count;
$analyzer->process($curproc, $data);
=head1 DESCRIPTION
This class provides simple evaluation of the number of error messages.
=head1 METHODS
=head2 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;
}
=head2 process($curproc, $data)
count up the number of error messsages if the status is [45]XX.
The cost to sum up varies according to the status code.
=cut
# 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_mail_analyzer_simple_count_limit } || 5;
my $daylimit = $config->{ error_mail_analyzer_day_limit } || 14;
my $now = time;
my $day = 24*3600;
my $threshold = $day * $daylimit;
# $data format = {
# key1 => [ value1, value2, ... ],
# key2 => [ value1, value2, ... ],
# }
while (($addr, $bufarray) = each %$data) {
$count = 0;
# count up the number of error messsages if the status is [45]XX.
if (defined $bufarray) {
ELEMENT:
for my $buf (@$bufarray) {
($time, $status, $reason) = split(/\s+/, $buf);
# ignore too old data.
next ELEMENT if (($now - $time) > $threshold);
# XXX-TODO: cost should be customizable.
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->{ _address_to_be_removed } = \@removelist;
}
# Descriptions: return summary as HASH_REF.
# Arguments: OBJ($self)
# Side Effects: none
# Return Value: HASH_REF
sub get_summary
{
my ($self) = @_;
return( $self->{ _summary } || {} );
}
# Descriptions: return addresses to be removed.
# Arguments: OBJ($self)
# Side Effects: none
# Return Value: ARRAY_REF
sub get_address_to_be_deleted
{
my ($self) = @_;
return( $self->{ _address_to_be_removed } || [] );
}
# Descriptions: print address and the summary.
# Arguments: OBJ($self) STR($addr)
# Side Effects: none
# Return Value: none
sub print
{
my ($self, $addr) = @_;
my $wh = \*STDOUT;
my $summary = $self->get_summary();
printf $wh "%25s => %s\n", $addr, $summary->{ $addr };
}
=head1 CODING STYLE
See C on fml coding style guide.
=head1 AUTHOR
Ken'ichi Fukamachi
=head1 COPYRIGHT
Copyright (C) 2003,2004,2005,2006 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 for more details.
=cut
1;