root/t/00db.t

#!/usr/bin/perl -w

BEGIN { chdir 't' if -d 't' }
use lib '../lib';
use blib;

use Test::More tests => 223;
use Test::DatabaseRow;
use Test::Exception;
use Test::Warn;

use File::Path;

package Lancelot::DB;
use subs 'time';
package main;
my $the_time = 1000000000;
*Lancelot::DB::time = sub {
    return $the_time;
};

use_ok(Lancelot::DB);

# This must not conflict with a real list name.
my ($listname_local, $listname_domain) = ('pl-testlist', 'example.com');
my $listname = "$listname_local\@$listname_domain";

can_ok('Lancelot::DB', 'new');
rmtree("$ENV{HOME}/.pl/$listname", 1);
my $db = new Lancelot::DB $listname, { "create" => 0 };
ok( !defined $db,  "new() returned undef for non-existing list" );

$db = new Lancelot::DB $listname, { user => "root" };
ok( !defined $db, "new() still undef if user is root");
dies_ok { $db = new Lancelot::DB $listname, { user => 'NONEXISTENTUSER' } }
    "new() with non-existent user";

foreach my $create (qw/1 0/) {
    $db = new Lancelot::DB $listname, { "create" => $create };
    ok( defined $db, "new() returned something with create=$create" );

    if ($create) {
        # double-create test
        my $db2;
        dies_ok { $db2 = new Lancelot::DB $listname, { create => 1 } }
            "creating existing database";
    }

    ok( $db->isa('Lancelot::DB'),  "and it's the right class" );
    ok( $db->get_parameter('dbversion') > 0, "and it has a schema version" );

    is( $db->get_config('list.address'), $listname,
        "and the proper list address");

    ok( $db->set_parameter('pl-test', 'xyzzy'),
        "set_parameter() seems to work" );
    my $test = $db->get_parameter('pl-test');
    is( $test, 'xyzzy', "and get_parameter() gets the same back" );

    ok( $db->set_config('ll.test', 'xyzzy'), "set_config() seems to work");
    $test = $db->get_config('ll.test');
    is( $test, 'xyzzy', "and get_config() gets the same back" );
}
undef $db;

my $home = $ENV{HOME}; delete $ENV{HOME};
ok( $db = Lancelot::DB->new($listname, { create => 0 }), "HOME from passwd");
undef $db;
$ENV{HOME} = $home;

# ourisp hack

my $ourispdir = "$ENV{HOME}/domains/$listname_domain";
-d $ourispdir || mkpath $ourispdir;
rmtree "$ourispdir/$listname_local";
ok( $db = Lancelot::DB->new($listname, { create => 1, ourisp => 1 }),
    "ourisp hack");
ok( -f "$ourispdir/$listname_local/list.db", "ourisp hack list.db check");
undef $db;

$ENV{HOME} = "$ourispdir/$listname_local";
ok( $db = Lancelot::DB->new($listname, { create => 0 }),
    "ourisp hack - use only");
undef $db;
unlink "$ourispdir/$listname_local/list.db";
$db = new Lancelot::DB $listname, { create => 0 },
ok( !defined $db, "ourisp hack - use only (no list.db file)");
undef $db;
rmtree "$ourispdir/$listname_local";

$ENV{HOME} = $home;
$db = new Lancelot::DB $listname, { create => 1, ourisp => 1 };
undef $db;
ok( $db = Lancelot::DB->new($listname, { create => 0 }),
    "open ourisp-style list w/o \$HOME");
undef $db;
rmtree "$ourispdir/$listname_local";

# various nit-picks

$ENV{HOME} = $home;
rmtree "$ENV{HOME}/.pl/$listname";
$db = new Lancelot::DB $listname, { create => 1 };
undef $db;

open F, "> $ENV{HOME}/.pl/$listname/list.db";
print F "Hallo\n";
close F;
$db = new Lancelot::DB $listname, { create => 0 };
ok( !defined $db, "list.db too short");

open F, "> $ENV{HOME}/.pl/$listname/list.db";
print F "** This file contains an SQLite 2.1 database"; # Yeah right.
close F;
$db = new Lancelot::DB $listname, { create => 0 };
ok( !defined $db, "list.db is SQLite2 file");
rmtree "$ENV{HOME}/.pl/$listname";

$db = new Lancelot::DB $listname, { create => 1 };
$db->{dbh}->do("update config set value='sqlite:foobar' where key='list.addressdb'");
undef $db;
dies_ok {
    $db = new Lancelot::DB $listname, { create => 0 };
    $db->get_addresses();
} "invalid sqlite:foobar subscriber data source type";
rmtree "$ENV{HOME}/.pl/$listname";

$db = new Lancelot::DB $listname, { create => 1 };
$db->{dbh}->do("update config set value='foo:bar' where key='list.addressdb'");
undef $db;
dies_ok {
    $db = new Lancelot::DB $listname, { create => 0 };
    $db->get_addresses();
} "invalid foo:bar subscriber data source type";
rmtree "$ENV{HOME}/.pl/$listname";

$db = new Lancelot::DB $listname, { create => 1 };
$db->{dbh}->do("update parameter set value=9999 where key='dbversion'");
undef $db;
dies_ok { $db = new Lancelot::DB $listname, { create => 0 } }
    "schema version too new";

# get_listdir

$ENV{HOME} = $home;
rmtree "$ENV{HOME}/.pl/$listname";
$db = new Lancelot::DB $listname, { create => 1 };
my $dir = $db->get_listdir();
is( $dir, "$ENV{HOME}/.pl/$listname", "get_listdir() seems to work" );

# Parameter

can_ok($db, 'set_parameter');
can_ok($db, 'increment_parameter');
can_ok($db, 'get_parameter');
$db->set_parameter('pl-inctest', '0');
is( $db->increment_parameter('pl-inctest'), 0, "increment_parameter() result" );
is( $db->get_parameter('pl-inctest'), 1, "increment_parameter() db entry" );

local $Test::DatabaseRow::dbh = $db->{dbh};

can_ok($db, 'set_configs');
ok( $db->set_configs("ll.c1 = abc"), "set_configs() single" );
row_ok(table => 'config',
       where => [ key => 'll.c1', value => 'abc' ],
       label => "set_configs() single db check");
ok( $db->set_configs('ll.c1 = "abc "'), "set_configs() single quoted" );
row_ok(table => 'config',
       where => [ key => 'll.c1', value => 'abc ' ],
       label => "set_configs() single quoted db check");
ok( $db->set_configs("ll.c1 = abc", "ll.c2 = def"), "set_configs() double" );
row_ok(table => 'config',
       where => [ key => 'll.c1', value => 'abc' ],
       label => "set_configs() double db check");
can_ok($db, 'get_config');
ok( $db->get_config('ll.c1') eq 'abc' && $db->get_config('ll.c2') eq 'def'
    && $db->get_config('list.address') eq $listname, "set_configs() db entry");

can_ok($db, 'delete_configs');
ok( $db->delete_configs("ll.c1", "ll.c2") == 2, 'delete_configs()');
ok( !defined $db->get_config('ll.c1') && !defined $db->get_config('ll.c2')
    && $db->get_config('list.address') eq $listname,
    "delete_configs() db entry");
warning_like {
    ok( $db->delete_configs("%&/*+") == 0, 'delete_configs() invalid key');
} qr|invalid config name: %&/\*\+|, "invalid config name warning";
warning_like {
    ok( $db->set_configs("xyzzy") == 0, 'invalid config' );
} qr|invalid config "xyzzy"|, "invalid config warning";

$db->set_configs('ll.c1 = abc', 'll.c2 = def');
can_ok($db, 'config_names');
my @names = sort $db->config_names();
my @stdnames = <DATA>; chomp @stdnames;
is_deeply (\@names, \@stdnames, 'config_names()');

can_ok($db, 'set_configs_from_file');
ok( $db->set_configs_from_file('nonexistent.cfg', 0) == 0,
    "set_configs_from_file: nonexistent file");
dies_ok { $db->set_configs_from_file('nonexistent.cfg', 1) }
    "set_configs_from_file: nonexistent file (must_exist)";
ok( $db->set_configs_from_file('test.cfg', 0) == 2,
    "set_configs_from_file: test.cfg");

can_ok($db, 'init_address_db');
ok( $db->init_address_db(), 'init_address_db()' );
row_ok(sql => 'select * from user', results => 0,
       label => "new list has no users");
row_ok(sql => 'select * from address', results => 0,
       label => "new list has no addresses");
row_ok(sql => 'select * from subscription', results => 0,
       label => "new list has no subscriptions");
can_ok($db, 'add_address');
ok( $db->add_address('hugo@example.com', {}), 'simple add_address()' );
row_ok(table => 'user',
       where => [ id => 1, name => 'hugo@example.com', password => '' ],
       label => 'user row added');
row_ok(table => 'address',
       where => [ user_id => 1,
                  local => 'hugo', domain => 'example.com' ],
       label => 'address row added');
row_ok(table => 'subscription',
       where => [ list_id => 1, address_id => 1,
                  status => 'SUBSCRIBED',
                  moderator => 0, nomail => 0, digest => 0, moderated => 0,
                  admin => 0 ],
       label => "one subscriber added");
can_ok($db, 'get_subscription_id');
is( $db->get_subscription_id('hugo@example.com'), 1,
    'get_subscription_id(), existing sub');
is( $db->get_subscription_id((Email::Address->parse('hugo@example.com'))[0]), 1,
    'get_subscription_id(), existing sub, Email::Address');
is( $db->get_subscription_id('nonexistent@example.com'), undef,
    'get_subscription_id(), non-existing sub');
ok( $db->add_address('John Doe <jdoe@example.com>', {}),
    'add_address() w/name');
row_ok(table => 'user',
       where => [ id => 2, name => 'John Doe', password => '' ],
       label => 'user w/name added');
row_ok(table => 'address',
       where => [ user_id => 2,
                  local => 'jdoe', domain => 'example.com' ],
       label => 'address row w/name added');
row_ok(table => 'subscription',
       where => [ id => '2', list_id => 1, address_id => 2,
                  status => 'SUBSCRIBED',
                  moderator => 0, nomail => 0, digest => 0, moderated => 0,
                  admin => 0 ],
       label => "second subscription (w/name) added" );
{ my $addr = (Email::Address->parse('Bob <bob@example.com>'))[0];
  ok( $db->add_address($addr, {}),
      'add_address() from pre-parsed Email::Address');
}
row_ok(table => 'user',
       where => [ id => 3, name => 'Bob', password => '' ],
       label => 'user w/name from pre-parsed Email::Address added');
row_ok(table => 'address',
       where => [ user_id => 3,
                  local => 'bob', domain => 'example.com' ],
       label => 'address row w/name from pre-parsed Email::Address added');
row_ok(table => 'subscription',
       where => [ id => '3', list_id => 1, address_id => 3,
                  status => 'SUBSCRIBED',
                  moderator => 0, nomail => 0, digest => 0, moderated => 0,
                  admin => 0 ],
       label => "third subscription added (from Email::Address)" );

can_ok($db, 'set_address_options');
ok( $db->set_address_options('jdoe@example.com', { name => 'Jonathan Doe' }),
    "name change using set_address_options");
row_ok( sql => q{select u.name as name
                 from user u left join address a on a.user_id=u.id
                 where a.local='jdoe' and a.domain='example.com'},
        tests => [ name => 'Jonathan Doe' ],
        label => "name changed" );

ok( $db->set_address_options('jdoe@example.com', { status => 'DELETE' }),
    "deleting second subscriber");
row_ok( sql => q{select * from subscription where list_id=1 and address_id=2},
        results => 0, label => "second subscriber deleted again" );
ok( $db->set_address_options('bob@example.com', { status => 'DELETE' }),
    "deleting third subscriber");
row_ok( sql => q{select * from subscription where list_id=1 and address_id=3},
        results => 0, label => "third subscriber deleted again" );

# See if we can set individual subscription options. One iteration of
# the loop is good for three tests.

my ($local, $domain) = ('jane.doe', 'example.net');
my $address = "$local\@$domain";
my $fulladdress = "Jane Doe <$address>";
my @options = qw/admin moderator digest nomail moderated/;
foreach my $i (0 .. $#options) {
    my $opt = $options[$i];
    ok( $db->add_address($fulladdress, { $opt => 1 }),
        "adding record with option $opt set" );
    my @check_opts = @options;
    splice(@check_opts, $i, 1);
    row_ok(sql => sprintf(q{select %s
                            from subscription s
                              left join address a on s.address_id=a.id
                            where s.list_id=1
                              and a.local='%s' and a.domain='%s'},
                          join(",", map { "s.$_ as $_" } @options),
                          $local, $domain),
           tests => [ $opt => 1, map { $_ => 0 } @check_opts ],
           label => "check if option $opt is set" );
    ok( $db->set_address_options($address, { status => 'DELETE' }),
        "delete record with option $opt set");
}

# Now see if we can do the same using set_address_options

ok(!defined $db->set_address_options('NONEXISTENT@example.com', { digest=>1 }),
   "set_address_options w/nonexistent address");

$db->add_address($fulladdress, {});
foreach my $i (0 .. $#options) {
    my $opt = $options[$i];
    ok( $db->set_address_options($address, { $opt => 1 }),
        "setting option $opt" );
    my @check_opts = @options;
    splice(@check_opts, $i, 1);
    my $ao = $db->get_address_options($address);
    row_ok(sql => sprintf(q{select %s
                            from subscription s
                              left join address a on s.address_id=a.id
                            where s.list_id=1
                              and a.local='%s' and a.domain='%s'},
                          join(",", map { "s.$_ as $_" } @options),
                          $local, $domain),
           tests => [ $opt => 1, map { $_ => 0 } @check_opts ],
           label => "check if option $opt is set");
    ok( $db->set_address_options($address, { $opt => 0 }),
        "unsetting option $opt" );
    row_ok(sql => sprintf(q{select %s
                            from subscription s
                              left join address a on s.address_id=a.id
                            where s.list_id=1
                              and a.local='%s' and a.domain='%s'},
                          join(",", map { "s.$_ as $_" } @options),
                          $local, $domain),
           tests => [ $opt => 0, map { $_ => 0 } @check_opts ],
           label => "check if option $opt is unset" );
}

ok ( $db->set_address_options($fulladdress, { auth => 'abc:def:ghi' }),
     "auth test" );
row_ok(sql => sprintf(q{select am.method as method,
                          am.par1 as par1, am.par2 as par2
                        from authmethod am
                          left join subscription s on am.subscription_id=s.id
                          left join address a on s.address_id=a.id
                        where s.list_id=1
                          and a.local='%s' and a.domain='%s'}, $local, $domain),
       tests => [ method => 'abc', par1 => 'def', par2 => 'ghi' ],
       label => 'auth test db check');
ok ( $db->set_address_options($fulladdress,
                              { auth => 'abc:123:456,xyz:987:654' }),
     "auth test (double)");
row_ok(sql => sprintf(q{select am.method as method,
                          am.par1 as par1, am.par2 as par2
                        from authmethod am
                          left join subscription s on am.subscription_id=s.id
                          left join address a on s.address_id=a.id
                        where s.list_id=1
                          and a.local='%s' and a.domain='%s'}, $local, $domain),
       results => 2, label => 'auth test (double) row count/del check');
row_ok(sql => sprintf(q{select am.par1 as par1, am.par2 as par2
                        from authmethod am
                          left join subscription s on am.subscription_id=s.id
                          left join address a on s.address_id=a.id
                        where am.method='abc' and s.list_id=1
                          and a.local='%s' and a.domain='%s'}, $local, $domain),
       tests => [ par1 => '123', par2 => '456' ],
       label => 'auth test (double) db check (1)');
row_ok(sql => sprintf(q{select am.par1 as par1, am.par2 as par2
                        from authmethod am
                          left join subscription s on am.subscription_id=s.id
                          left join address a on s.address_id=a.id
                        where am.method='xyz' and s.list_id=1
                          and a.local='%s' and a.domain='%s'}, $local, $domain),
       tests => [ par1 => '987', par2 => '654' ],
       label => 'auth test (double) db check (2)');

ok ( $db->set_address_options($fulladdress, { auth => '' }), "auth del test");
row_ok(sql => sprintf(q{select am.method as method,
                          am.par1 as par1, am.par2 as par2
                        from authmethod am
                          left join subscription s on am.subscription_id=s.id
                          left join address a on s.address_id=a.id
                        where s.list_id=1
                          and a.local='%s' and a.domain='%s'}, $local, $domain),
       results => 0,
       label => 'auth del test row count/del check');

# Check the result of get_address_options

my $ref = {
    status => 'SUBSCRIBED', name => 'Jane Doe', auth => '', id => '2',
};
$ref->{$_} = 0 foreach (@options);

can_ok($db, 'get_address_options');
my $aa = (Email::Address->parse($address))[0];
foreach my $a ($fulladdress, ucfirst($aa), $aa) {
    foreach my $i (0 .. $#options) {
        $db->set_address_options($a, { $options[$i] => 1 });
        my $opts;
        $ref->{$options[$i]} = 1;
        ok( $opts = $db->get_address_options($a), "getting address options" );
        is_deeply($opts, $ref, "option $options[$i] set");
        $db->set_address_options($a, { $options[$i] => 0 });
        $ref->{$options[$i]} = 0;
    }
}

$db->set_address_options($address, { auth => 'abc:123:456,xyz:987:654' });
my $opts = $db->get_address_options($address);
is($opts->{auth}, 'abc:123:456,xyz:987:654', "get_address_options auth check");

$db->set_address_options($address, { status => 'DELETE' });


# Check the result of get_addresses

my @crew = (
    [ 'emil', 'example.com', 'Emil Schmidt', { digest => 1 }, 0 ],
    [ 'hans', 'example.net', 'Hans Huber', { nomail => 1 }, 0 ],
    [ 'trude', 'example.com', 'Trude Schulz', {}, 1 ],
    [ 'liese', 'example.net', 'Liese Huber', { nomail => 1 }, 1 ],
    [ 'susi', 'example.com',  'Susi Sorglos', {}, 0 ],
    [ 'fritz', 'example.net', 'Fritz Friedlich', { moderator => 1 }, 0 ],
);

foreach my $cref (@crew) {
    my ($local, $domain, $name, $optref, $bouncing) = @$cref;
    $db->add_address("$name <$local\@$domain>", $optref);
    $db->set_address_options("$local\@$domain", { status => 'BOUNCING' })
        if $bouncing;
}

can_ok($db, 'get_addresses');
my @result = $db->get_addresses;
is(@result, 7, "get_addresses with no argument");
is_deeply(\@result, [ 'emil@example.com',
                      'hugo@example.com',
                      'susi@example.com',
                      'trude@example.com',
                      'fritz@example.net',
                      'hans@example.net',
                      'liese@example.net' ], "get_addresses result check");
@result = $db->get_addresses('*@example.net');
is(@result, 3, "get_addresses with address pattern");
@result = $db->get_addresses('*', { digest => 1 });
is(@result, 1, "get_addresses for digest subscribers");
@result = $db->get_addresses('*', { digest => 0 });
is(@result, 6, "get_addresses for regular subscribers");
@result = $db->get_addresses('*', { nomail => 1 });
is(@result, 2, "get_addresses for nomail subscribers");
@result = $db->get_addresses('*', { nomail => 0 });
is(@result, 5, "get_addresses for no-nomail subscribers");
@result = $db->get_addresses('*', { recipient => 1 });
is(@result, 4, "get addresses for recipient subscribers");
@result = $db->get_addresses('*', { bouncing => 1 });
is(@result, 2, "get addresses for bouncing subscribers");
@result = $db->get_addresses('*', { bouncing => 1, nomail => 1 });
is(@result, 1, "get addresses for bouncing nomail subscribers (AND test)");
@result = $db->get_addresses('*', { moderator => 1 });
is(@result, 1, "get addresses for moderators");

@result = $db->get_addresses('*', { order => 'address' });
is_deeply(\@result, [ 'emil@example.com',
                      'fritz@example.net',
                      'hans@example.net',
                      'hugo@example.com',
                      'liese@example.net',
                      'susi@example.com',
                      'trude@example.com' ],
          "get_addresses sort check (address)");

@result = $db->get_addresses('*', { order => 'domain' });
is_deeply(\@result, [ 'emil@example.com',
                      'hugo@example.com',
                      'susi@example.com',
                      'trude@example.com',
                      'fritz@example.net',
                      'hans@example.net',
                      'liese@example.net' ],
          "get_addresses sort check (domain)");

# confirmation database

{
    can_ok($db, 'set_confirm');
    can_ok($db, 'check_confirm');
    can_ok($db, 'clear_confirm');
    ok ($db->set_confirm('foo@example.com', 'ABCD1234', $the_time+5, 'Data'),
        "set_confirm test");
    ok (! defined $db->check_confirm('foo@example.com', 'XYZQ6789'),
        "check_confirm with bad cookie");
    ok (! defined $db->check_confirm('bar@example.com', 'ABCD1234'),
        "check_confirm with non-existing address");
    { my $data = $db->check_confirm('foo@example.com', 'ABCD1234');
      is ($data, 'Data', "check_confirm with correct parameters");
    }
    $the_time += 10;
    ok (! defined $db->check_confirm('foo@example.com', 'ABCD1234'),
        "confirm time limit exceeded");
    $db->clear_confirm('foo@example.com', 'XYZQ6789');
    row_ok(sql => q{select *
                    from confirmation c
                      left join subscription s on c.subscription_id=s.id
                      left join address a on s.address_id=a.id
                    where a.local='foo' and a.domain='example.com'
                      and c.cookie='ABCD1234'},
           results => 1, label => 'clear_confirm with wrong cookie');
    $db->clear_confirm('bar@example.com', 'ABCD1234');
    row_ok(sql => q{select *
                    from confirmation c
                      left join subscription s on c.subscription_id=s.id
                      left join address a on s.address_id=a.id
                    where a.local='foo' and a.domain='example.com'
                      and c.cookie='ABCD1234'},
           results => 1, label => 'clear_confirm with wrong address');
    $db->clear_confirm('foo@example.com', 'ABCD1234');
    row_ok(sql => q{select *
                    from confirmation c
                      left join subscription s on c.subscription_id=s.id
                      left join address a on s.address_id=a.id
                    where a.local='foo' and a.domain='example.com'
                      and c.cookie='ABCD1234'},
           results => 0, label => 'clear_confirm with correct parameters');
}

# bounce database

can_ok($db, 'log_bounce');
can_ok($db, 'get_bounces');
can_ok($db, 'get_bounce_addresses');
can_ok($db, 'clear_bounces');
row_ok(sql => "select * from bounce", results => 0,
       label => "bounce database must be empty");
$db->log_bounce('susi@example.com', 1234, 10);
row_ok(sql => "select * from bounce", results => 1,
       label => "log_bounce 1");
$db->log_bounce('hugo@example.com', 1234, 10);
row_ok(sql => "select * from bounce", results => 2,
       label => "log_bounce 2");
{ my $ref = $db->get_bounces('susi@example.com', 0);
  is(@$ref, 1, "number of bounces returned by get_bounces()");
  my $aref = $$ref[0];
  is($$aref[1], 10, "bounce score returned by get_bounces()");
  is($$aref[2], 1234, "bounce message returned by get_bounces()");
  $db->log_bounce('susi@example.com', 1235, 10);
  row_ok(sql => "select * from bounce", results => 3,
         label => "log_bounce 3");
  $ref = $db->get_bounces('susi@example.com', 0);
  is(@$ref, 2, "number of bounces returned by get_bounces()");
  $aref = $$ref[0];
  is($$aref[1], 10, "bounce score returned by get_bounces()");
  is($$aref[2], 1235, "bounce message returned by get_bounces()");
  $aref = $$ref[1];
  is($$aref[1], 10, "bounce score returned by get_bounces()");
  is($$aref[2], 1234, "bounce message returned by get_bounces()");
  my @addr = $db->get_bounce_addresses();
  is(scalar(@addr), 2, "result count of get_bounce_addresses()");
  ok($addr[0] eq 'hugo@example.com' && $addr[1] eq 'susi@example.com',
     "result of get_bounce_addresses()");
  @addr = $db->get_bounce_addresses('*');
  is(scalar(@addr), 2, "result count of get_bounce_addresses('*')");
  ok($addr[0] eq 'hugo@example.com' && $addr[1] eq 'susi@example.com',
     "result of get_bounce_addresses('*')");
  @addr = $db->get_bounce_addresses('susi@*');
  is(scalar(@addr), 1, "result count of get_bounce_addresses('foo\@*')");
  ok($addr[0] eq 'susi@example.com', "result of get_bounce_adresses('foo\@*')");
  $db->clear_bounces('susi@example.com');
  row_ok(sql => "select * from bounce", results => 1,
         label => "row count after clear_bounces('foo')");
}

# bounce warnings

can_ok($db, 'log_bounce_warning');
can_ok($db, 'last_bounce_warning');
can_ok($db, 'clear_bounce_warnings');
$the_time = 1000000000;
row_ok(sql => 'select * from bouncewarning',
       results => 0, label => 'check bouncewarning table is empty');
$db->log_bounce_warning('susi@example.com');
row_ok(sql => 'select * from bouncewarning',
       results => 1, label => 'check database after log_bounce_warning() 1');
$the_time += 10;
$db->log_bounce_warning('susi@example.com');
row_ok(sql => 'select * from bouncewarning',
       results => 2, label => 'check database after log_bounce_warning() 2');
$db->log_bounce_warning('hugo@example.com');
row_ok(sql => 'select * from bouncewarning',
       results => 3, label => 'check database after log_bounce_warning() 3');
{ my ($count, $last) = $db->last_bounce_warning('susi@example.com');
  ok($count == 2 && $last == $the_time, "check last_bounce_warning() result");
  $db->clear_bounce_warnings('susi@example.com');
  row_ok(sql => 'select * from bouncewarning',
         results => 1, label => 'check database after clear_bounce_warning()');
}


__END__
archive.directory
bounce.bucketcount
bounce.bucketsize
bounce.score.hard
bounce.score.soft
bounce.threshold
bounce.unknownaction
digests.enable
digests.maxperiod
digests.maxsize
lancelot.templatedirs
list.address
list.addressdb
list.language
ll.c1
ll.c2
mail.delimiter
mail.forcereplyto
mail.listheaders
mail.policy.explicitaddress
mail.policy.subscribersonly
mail.replyto
mail.subjecttag
mail.workflow.bounce
mail.workflow.config
mail.workflow.help
mail.workflow.owner
mail.workflow.submit
mail.workflow.subscribe
mail.workflow.unsubscribe
mod.aquorum
mod.enable
mod.rquorum
smtp.debug
smtp.maxrecipients
smtp.port
smtp.server
smtp.timeout
subscribe.confirm
subscribe.confirmdefault
subscribe.digestchange
subscribe.digestdefault
subscribe.moderateddefault
subscribe.nomailchange
subscribe.nomaildefault
subscribe.type
subscribe.welcome
unsubscribe.confirm
unsubscribe.confirmdefault
unsubscribe.goodbye