The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use Test::More tests => 9;

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

use strict;

use File::Path;
use File::Spec;

mkdir 'aliases' unless -d 'aliases';

END
{   
    rmtree 'aliases' unless @ARGV;
}

my $role = 'Mail::Action::Role::Purge';
use_ok( $role ) or exit;

my $module = 'Mail::SimpleList::Aliases';
use_ok( $module ) or exit;

use_ok('Class::Roles');
Class::Roles->import(
    apply => {
        role => 'Purge',
        to   => 'Mail::SimpleList::Aliases'
    },
);

can_ok( $module, 'new' );
my $aliases = $module->new( 'aliases' );
isa_ok( $aliases, $module );

# create five objects, all of which are expired
my $time = time();
my $increment = 60*60;
for( 1..5 ) {
    my $addy = Mail::SimpleList::Alias->new(
        expires => $time - ($increment + $_),
    );
    $aliases->save(
        $addy,
        generate_address(),
    );
}

# make sure that we have five aliases
is( $aliases->num_objects, 5, 'five aliases exist');

# create five objects without expire times
for( 1..5 ) {
    my $addy = Mail::SimpleList::Alias->new;
    $aliases->save(
        $addy,
        generate_address(),
    );
}

# make sure that we have ten aliases
is( $aliases->num_objects, 10, 'ten aliases exist');

# run the purge script
my $script = File::Spec->catfile(
    File::Spec->catdir("..", "bin"),
    "mail_simplelist_purge.pl",
);
my $rc = system("$^X -Mblib $script -v ./aliases");
is( $rc, 0, "purge script ran successfully");

# make sure we have five aliases
is( $aliases->num_objects, 5, 'five aliases exist');

# sub yanked from Mail::TempAddresses::Addresses since M::SL doesn't
# have an equivalent
sub generate_address
{

	my $id ||= sprintf '%x', reverse scalar time;

	while ($aliases->exists( $id ))
	{
		$id = sprintf '%x', ( reverse ( time() + rand($$) ));
	}

	return $id;
}