The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# $Id: 02-mailbox.t 1406 2015-10-05 08:25:49Z willem $	-*-perl-*-

use strict;
use Test::More tests => 43;


BEGIN {
	use_ok('Net::DNS::Mailbox');
}


{
	my $name    = 'mbox@example.com';
	my $mailbox = new Net::DNS::Mailbox($name);
	ok( $mailbox->isa('Net::DNS::Mailbox'), 'object returned by new() constructor' );
}


{
	my $mailbox = eval { new Net::DNS::Mailbox(); };
	my $exception = $1 if $@ =~ /^(.+)\n/;
	ok( $exception ||= '', "empty argument list\t[$exception]" );
}


{
	my $mailbox = eval { new Net::DNS::Mailbox(undef); };
	my $exception = $1 if $@ =~ /^(.+)\n/;
	ok( $exception ||= '', "argument undefined\t[$exception]" );
}


{
	my %testcase = (
		'.'				    => '<>',
		'<>'				    => '<>',
		'a'				    => 'a',
		'a.b'				    => 'a@b',
		'a.b.c'				    => 'a@b.c',
		'a.b.c.d'			    => 'a@b.c.d',
		'a@b'				    => 'a@b',
		'a@b.c'				    => 'a@b.c',
		'a@b.c.d'			    => 'a@b.c.d',
		'a\.b.c.d'			    => 'a.b@c.d',
		'a\.b@c.d'			    => 'a.b@c.d',
		'empty <>'			    => '<>',
		'fore <a.b@c.d> aft'		    => 'a.b@c.d',
		'nested <<address>>'		    => 'address',
		'obscure <<left><<<deep>>><right>>' => 'right',
		);

	foreach my $test ( sort keys %testcase ) {
		my $expect  = $testcase{$test};
		my $mailbox = new Net::DNS::Mailbox($test);
		my $data    = $mailbox->encode;
		my $decoded = decode Net::DNS::Mailbox( \$data );
		is( $decoded->address, $expect, "encode/decode mailbox	$test" );
	}
}


{
	my %testcase = (
		'"(a.b)"@c.d' => '"(a.b)"@c.d',
		'"[a.b]"@c.d' => '"[a.b]"@c.d',
		'"a,b"@c.d'   => '"a,b"@c.d',
		'"a:b"@c.d'   => '"a:b"@c.d',
		'"a;b"@c.d'   => '"a;b"@c.d',
		'"a@b"@c.d'   => '"a@b"@c.d',
		);

	foreach my $test ( sort keys %testcase ) {
		my $expect  = $testcase{$test};
		my $mailbox = new Net::DNS::Mailbox($test);
		my $data    = $mailbox->encode;
		my $decoded = decode Net::DNS::Mailbox( \$data );
		is( $decoded->address, $expect, "encode/decode mailbox	$test" );
	}
}


{
	my $mailbox   = new Net::DNS::Mailbox( uc 'MBOX.EXAMPLE.COM' );
	my $hash      = {};
	my $data      = $mailbox->encode( 1, $hash );
	my $compress  = $mailbox->encode( length $data, $hash );
	my $canonical = $mailbox->encode( length $data );
	my $decoded   = decode Net::DNS::Mailbox( \$data );
	my $downcased = new Net::DNS::Mailbox( lc $mailbox->name )->encode( 0, {} );
	ok( $mailbox->isa('Net::DNS::Mailbox'), 'object returned by Net::DNS::Mailbox->new()' );
	ok( $decoded->isa('Net::DNS::Mailbox'), 'object returned by Net::DNS::Mailbox->decode()' );
	is( length $compress, length $data, 'Net::DNS::Mailbox encoding is uncompressed' );
	isnt( $data, $downcased, 'Net::DNS::Mailbox encoding preserves case' );
	is( length $canonical, length $data, 'Net::DNS::Mailbox canonical form is uncompressed' );
	isnt( $canonical, $downcased, 'Net::DNS::Mailbox canonical form preserves case' );
}


{
	my $mailbox   = new Net::DNS::Mailbox1035( uc 'MBOX.EXAMPLE.COM' );
	my $hash      = {};
	my $data      = $mailbox->encode( 1, $hash );
	my $compress  = $mailbox->encode( length $data, $hash );
	my $canonical = $mailbox->encode( length $data );
	my $decoded   = decode Net::DNS::Mailbox1035( \$data );
	my $downcased = new Net::DNS::Mailbox1035( lc $mailbox->name )->encode( 0, {} );
	ok( $mailbox->isa('Net::DNS::Mailbox1035'), 'object returned by Net::DNS::Mailbox1035->new()' );
	ok( $decoded->isa('Net::DNS::Mailbox1035'), 'object returned by Net::DNS::Mailbox1035->decode()' );
	isnt( length $compress, length $data, 'Net::DNS::Mailbox1035 encoding is compressible' );
	isnt( $data,		$downcased,   'Net::DNS::Mailbox1035 encoding preserves case' );
	is( length $canonical, length $data, 'Net::DNS::Mailbox1035 canonical form is uncompressed' );
	is( $canonical,	       $downcased,   'Net::DNS::Mailbox1035 canonical form is lower case' );
}


{
	my $mailbox   = new Net::DNS::Mailbox2535( uc 'MBOX.EXAMPLE.COM' );
	my $hash      = {};
	my $data      = $mailbox->encode( 1, $hash );
	my $compress  = $mailbox->encode( length $data, $hash );
	my $canonical = $mailbox->encode( length $data );
	my $decoded   = decode Net::DNS::Mailbox2535( \$data );
	my $downcased = new Net::DNS::Mailbox2535( lc $mailbox->name )->encode( 0, {} );
	ok( $mailbox->isa('Net::DNS::Mailbox2535'), 'object returned by Net::DNS::Mailbox2535->new()' );
	ok( $decoded->isa('Net::DNS::Mailbox2535'), 'object returned by Net::DNS::Mailbox2535->decode()' );
	is( length $compress, length $data, 'Net::DNS::Mailbox2535 encoding is uncompressed' );
	isnt( $data, $downcased, 'Net::DNS::Mailbox2535 encoding preserves case' );
	is( length $canonical, length $data, 'Net::DNS::Mailbox2535 canonical form is uncompressed' );
	is( $canonical,	       $downcased,   'Net::DNS::Mailbox2535 canonical form is lower case' );
}


exit;