The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl -w

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

use strict;

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

use Test::More tests => 29;
use Test::MockObject;

mkdir 'addresses' unless -d 'addresses';

END
{
	rmtree 'addresses' unless @ARGV;
}

my $mock_addy = Test::MockObject->new();
$mock_addy->fake_module( 'Mail::TempAddress::Address',
	new => sub { shift; $mock_addy->my_new( @_ ) } );

my $module = 'Mail::TempAddress::Addresses';
use_ok( $module ) or exit;

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

can_ok( $module, 'storage_dir' );
is( $addys->storage_dir(), 'addresses',
	'storage_dir() should return value set in constructor' );

$addys = $module->new();
is( $addys->storage_dir(), File::Spec->catdir( $ENV{HOME}, '.addresses' ),
	'... or default value, if none is set' );

$addys = $module->new( 'addresses' );

can_ok( $module, 'stored_class' );
is( $module->stored_class(), 'Mail::TempAddress::Address',
	'stored_class() should be M::TA::Addresses' );

can_ok( $module, 'storage_extension' );
is( $addys->storage_extension(), 'mta', 
	'storage_extension() should return "mta"' );

can_ok( $module, 'storage_file' );
my $exists = File::Spec->catfile( 'addresses', 'exists.mta' );
my $result = $addys->storage_file( 'exists' );
is( $result, $exists,
	'storage_file() should add path and extension to filename' );

can_ok( $module, 'exists' );
{
	local *OUT;
	open( OUT, '>' . $exists )
		or diag "exists() tests will fail; cannot create file: $!"; 
	print OUT "file";
	close OUT;
}
$result = $addys->exists( 'exists' );
ok( $result,   'exists() should return true if file exists' );

$result = $addys->exists( 'doesnotexist' );
ok( ! $result, '... and false if it does not' );

can_ok( $module, 'generate_address' );
$result = $addys->generate_address();
ok( $result, 'generate_address() should return a new address given no arg' );
is( $result =~ tr/a-f0-9//c, 0, '... with only alphanumerics' );

$result = $addys->generate_address( 'a new id' );
is( $result, 'a new id', '... using given address' );

$result = $addys->generate_address( 'exists' );
isnt( $result, 'exists', '... unless it already exists' );

can_ok( $module, 'create' );
$mock_addy->set_always( my_new => $mock_addy );
$result = $addys->create( 'me@home' );
my ($method, $args) = $mock_addy->next_call();
is( $method,      'my_new',   'create() should create new Address object' );

shift @$args;
my %args = @$args;

is( $args{owner}, 'me@home',  '... passing from address' );
is( $result,      $mock_addy, '... returning result' );

can_ok( $module, 'save' );

$addys->save( { Foo => 'bar', name => 'foo' }, 'foo' );
ok( $addys->exists( 'foo' ), 'save() should save file given name' );

can_ok( $module, 'fetch' );

$mock_addy->mock( my_new => sub
{
	my ($class, %args) = @_;
	bless \%args, 'Mail::TempAddress::Addresses';
});
	
$result = $addys->fetch( 'foo' );
ok( $result,                 'fetch() should fetch file, given name' );
is_deeply( $result, { name => 'foo', Foo => 'bar', },
                             '... restoring all keys plus name' );