view release on metacpan or  search on metacpan

lib/Mail/Decency/Core/Stats.pm  view on Meta::CPAN

package Mail::Decency::Core::Stats;

use Moose::Role;

use version 0.74; our $VERSION = qv( "v0.1.5" );

use Data::Dumper;
use DateTime;

=head1 NAME

Mail::Decency::Core::Stats

=head1 DESCRIPTION

Statistic database for policy server and content filter

=cut

=head2 enable_stats

Wheter enable stats or not

=cut

has enable_stats => ( is => 'rw', isa => 'Bool', default => 0 );

has stats_intervals => ( is => 'rw', isa => 'ArrayRef[Str]', default => sub {
    [
        'hour',
        'day',
        'week',
        'month',
        'year',
    ]
} );
has stats_time_zone => ( is => 'ro', isa => 'DateTime::TimeZone', default => sub {
    DateTime::TimeZone::Local->TimeZone();
} );
has schema_definition => ( is => 'ro', isa => 'HashRef[HashRef]' );


=head1 MODIFIER

=head2 init

Update schema definition of this module

=cut

after 'init' => sub {
    my ( $self ) = @_;
    
    my $prefix = $self->name;
    
    $self->{ schema_definition } ||= {};
    $self->{ schema_definition }->{ stats } = {
        $self->name. "_response" => {
            module  => [ varchar => 32 ],
            period  => [ varchar => 10 ],
            start   => 'integer',
            type    => [ varchar => 32 ],
            -unique => [ qw/ module period start type / ]
        },
        $self->name. "_performance" => {
            module  => [ varchar => 32 ],
            type    => [ varchar => 32 ],
            period  => [ varchar => 10 ],
            calls   => [ varchar => 10 ],
            runtime => [ 'real' ],
            start   => 'integer',
            -unique => [ qw/ module period start type / ]
        }
    };
    
    $self->enable_stats( 1 )
        if $self->config->{ enable_stats };
};

=head2 maintenance

Clears all entries which are older then the current interval. For hour, that would mean any hourly stats before the current hour, for year that would mean any stat from the last year and so on..

=cut

before 'maintenance' => sub {
    my ( $self ) = @_;
    my $table = lc( $self->name );
    
    my $now = DateTime->now( time_zone => $self->stats_time_zone );
    my @intervals = map {
        my $iv = $now->clone->truncate( to => $_ );
        [ $_, $iv->epoch ];
    } grep {
        /^(hour|day|week|month|year)$/
    } @{ $self->stats_intervals };
    
    my @module_names = map { "$_" } @{ $self->childs };
    ( my $server_name = ref( $self ) ) =~ s/^.*:://;
    push @module_names, "${server_name}Core";