File Coverage

blib/lib/App/Milter/Limit/Plugin/BerkeleyDB.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

#
# This file is part of App-Milter-Limit-Plugin-BerkeleyDB
#
# This software is copyright (c) 2010 by Michael Schout.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#

package App::Milter::Limit::Plugin::BerkeleyDB;
$App::Milter::Limit::Plugin::BerkeleyDB::VERSION = '0.52';
# ABSTRACT: BerkeleyDB driver for App::Milter::Limit

use strict;
use warnings;
use base qw(App::Milter::Limit::Plugin Class::Accessor);

use App::Milter::Limit::Log;
use BerkeleyDB qw(DB_CREATE DB_INIT_MPOOL DB_INIT_CDB);

__PACKAGE__->mk_accessors(qw(_db));

sub init {
    my $self = shift;

    $self->init_defaults;

    App::Milter::Limit::Util::make_path($self->config_get('driver', 'home'));

    # db/env creation deferred until child_init
}

sub init_defaults {
    my $self = shift;

    $self->config_defaults('driver',
        home  => $self->config_get('global', 'state_dir'),
        file  => 'bdb-stats.db',
    );
}

# open BerkeleyDB handles in child_init handler.
sub child_init {
    my $self = shift;

    my $conf = App::Milter::Limit::Config->section('driver');

    my $env = BerkeleyDB::Env->new(
        -Home  => $$conf{home},
        -Flags => DB_CREATE | DB_INIT_MPOOL | DB_INIT_CDB)
            or die "failed to open BerkeleyDB env: $!";

    my $db = BerkeleyDB::Hash->new(
        -Filename => $$conf{file},
        -Env      => $env,
        -Flags    => DB_CREATE) or die "failed to open BerkeleyDB: $!";

    $self->_db($db);

    debug("BerkeleyDB connection initialized");
}

sub query {
    my ($self, $from) = @_;

    my $conf = App::Milter::Limit::Config->global;

    my $db = $self->_db;

    my $val;
    $db->db_get($from, $val);

    unless (defined $val) {
        # initialize new record for sender
        $val = join ':', time, 0;
    }

    my ($start, $count) = split ':', $val;

    # reset counter if it is expired
    if ($start < time - $$conf{expire}) {
        $count = 0;
        $start = time;
    }

    # update database for this sender.
    $val = join ':', $start, ++$count;
    $db->db_put($from, $val);

    return $count;
}

1;

__END__