The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
#
# Test processing of URIs
#

use strict;
use warnings;

package Mail::Message::Field::URIs;   # define package name
package main;

use lib qw(. .. tests);
use Tools;

use Test::More;

BEGIN {
   if($] < 5.007003)
   {   plan skip_all => "Requires module Encode which requires Perl 5.7.3";
       exit 0;
   }

   eval 'require Mail::Message::Field::URIs';
   if($@)
   {   plan skip_all => 'Extended attributes not available (install Encode?)';
       exit 0;
   }
   else
   {   plan tests => 33;
   }
}

require Mail::Message::Field::Full;
my $mmff  = 'Mail::Message::Field::Full';

my $mmfu  = 'Mail::Message::Field::URIs';

#
# Test single URI
#

my $u = URI->new('http://x.org');
ok(defined $u,                                  "uri creation");
isa_ok($u, 'URI');
is($u->scheme, 'http');

my $uf = $mmfu->new('List-Post' => $u);
ok(defined $uf,                                 "uri field creation");
isa_ok($uf, $mmfu);
is($uf->string, "List-Post: <http://x.org/>\n");
is("$uf", '<http://x.org/>');
my @u = $uf->URIs;
cmp_ok(@u, '==', 1);
isa_ok($u[0], 'URI');

$uf = $mmfu->new('List-Post' => $u);
my $u2 = $uf->addURI('mailto:x@example.com?subject=y');
ok(defined $u2,                                 "auto-create URI");
isa_ok($u2, "URI");
@u = $uf->URIs;
cmp_ok(@u, '==', 2);
isa_ok($u[1], 'URI');
is($u[1]->scheme, "mailto");
is($u[1]->to, 'x@example.com');

my %headers = $u[1]->headers;
is($headers{to}, 'x@example.com');
is($headers{subject}, 'y');
is($uf->string, <<'FOLDED');
List-Post: <http://x.org/>, <mailto:x@example.com?subject=y>
FOLDED

is("$uf", '<http://x.org/>, <mailto:x@example.com?subject=y>');

#
# Test other constructions
#

$uf = $mmff->new("List-Post: <mailto:x\@y.com>, <http://A.org>\n");
ok(defined $uf,                               "create from field");
isa_ok($uf, $mmff);
isa_ok($uf, $mmfu);
@u = $uf->URIs;
cmp_ok(@u, '==', 2);
isa_ok($u[0], 'URI');
is($u[0]->scheme, "mailto");
is($u[0]->to, 'x@y.com');
is("$u[0]", 'mailto:x@y.com');
isa_ok($u[1], 'URI');
is($u[1]->scheme, "http");
is("$u[1]", 'http://a.org/');  # modified by URI::canonical()

is("$uf", '<mailto:x@y.com>, <http://A.org>');
is($uf->string, <<'FOLDED');
List-Post: <mailto:x@y.com>, <http://A.org>
FOLDED

$uf->beautify;
is("$uf", '<http://a.org/>, <mailto:x@y.com>');