1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
#!/usr/bin/perl
# $Id: 02-mailbox.t 1910 2023-03-30 19:16:30Z willem $ -*-perl-*-
#
use strict;
use warnings;
use Test::More tests => 40;
use TestToolkit;
use_ok('Net::DNS::Mailbox');
for my $mailbox ( Net::DNS::Mailbox->new('mbox@example.com') ) {
ok( $mailbox->isa('Net::DNS::Mailbox'), 'object returned by new() constructor' );
$mailbox->address; ## untestable optimisation: avoid returning address in void context
ok( $mailbox->address, 'mailbox->address' );
}
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 <<mailbox>>' => 'mailbox',
'obscure <<left><<<deep>>><right>>' => 'right',
'obsolete <@source;@route:mailbox>' => 'mailbox',
'quoted <"stuff@local"@domain>' => '"stuff@local"@domain',
);
foreach my $test ( sort keys %testcase ) {
my $expect = $testcase{$test};
my $mailbox = Net::DNS::Mailbox->new($test);
my $data = $mailbox->encode;
my $decoded = Net::DNS::Mailbox->decode( \$data );
is( $decoded->address, $expect, "encode/decode mailbox $test" );
}
for my $mailbox ( Net::DNS::Mailbox->new( 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 = Net::DNS::Mailbox->decode( \$data );
my $downcased = Net::DNS::Mailbox->new( 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' );
}
for my $mailbox ( Net::DNS::Mailbox1035->new( 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 = Net::DNS::Mailbox1035->decode( \$data );
my $downcased = Net::DNS::Mailbox1035->new( 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' );
}
for my $mailbox ( Net::DNS::Mailbox2535->new( 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 = Net::DNS::Mailbox2535->decode( \$data );
my $downcased = Net::DNS::Mailbox2535->new( 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' );
}
exception( 'empty argument list', sub { Net::DNS::Mailbox->new() } );
exception( 'argument undefined', sub { Net::DNS::Mailbox->new(undef) } );
exit;
|
