view release on metacpan or  search on metacpan

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

            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";
    
    foreach my $interval_ref( @intervals ) {
        $self->database->remove( stats => "${table}_performance" => {
            module => \@module_names,
            period => $interval_ref->[0],
            start  => { 
                '<' => $interval_ref->[1],
            }
        } );
        $self->database->remove( stats => "${table}_response" => {
            module => \@module_names,
            period => $interval_ref->[0],
            start  => { 
                '<' => $interval_ref->[1],
            }
        } );
    }
};


=head1 METHODS

=head2 update_stats

=cut

sub update_stats {
    my ( $self, $module, $type, $weight_diff, $runtime ) = @_;
    
    print Dumper [ $type => $weight_diff, $runtime ];
    
    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 };
    
    eval {
        
        my $table = lc( $self->name );
        foreach my $interval_ref( @intervals ) {
            my %search = (
                module => "$module",
                period => $interval_ref->[0],
                start  => $interval_ref->[1],
            );
            
            # increment weighting
            if ( defined $weight_diff ) {
                $self->database->usr_lock;
                my $db_ref = $self->database->get( stats => "${table}_performance" => \%search );
                $db_ref ||= { weight => 0, runtime => 0, calls => 0 };
                $self->database->set( stats => "${table}_performance" => \%search, {
                    weight  => ( $db_ref->{ weight } || 0 ) + $weight_diff,
                    calls   => $db_ref->{ calls } + 1,
                    runtime => $db_ref->{ runtime } + $runtime
                } );
                $self->database->usr_unlock;
            }
            
            # increment response counter
            $self->database->increment( stats => "${table}_response" => {
                %search,
                type => $type,
            } );
        }
    };
    $self->logger->error( "Error updating stats for $module / $type: $@" ) if $@;
    
    return;
}


=head2 print_stats

Print out stats

=cut

sub print_stats {
    my ( $self, $return ) = @_;
    
    my $table = lc( $self->name );
    
    my $now = DateTime->now( time_zone => $self->stats_time_zone );