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

use strict;
use warnings;

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

use Test::More;
use IO::Scalar;
use File::Spec;

use Mail::Message::Head::Complete;
use Mail::Message;
use Mail::Box::Mbox;

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

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

#
# Creation of a group
#

my $mailbox = '"Mail::Box development" <mailbox@perl.overmeer.net>';
my $lg0 = Mail::Message::Head::ListGroup->new(address => $mailbox);

ok(defined $lg0,                         'simple construction');
my $addr = $lg0->address;

ok(defined $addr,                        'address defined');
isa_ok($addr, 'Mail::Message::Field::Address');
is($addr->phrase, 'Mail::Box development');
is($lg0->listname, 'Mail::Box development');
is($addr->address, 'mailbox@perl.overmeer.net');
is("$addr", $mailbox);
is($lg0->address->string, $mailbox);

ok(!defined $lg0->type);
ok(!defined $lg0->software);
ok(!defined $lg0->version);
ok(!defined $lg0->rfc);

#
# Extraction of a group
#

my $h = Mail::Message::Head::Complete->new;
ok(defined $h);

my $lg = Mail::Message::Head::ListGroup->from($h);
ok(!defined $lg,                     "no listgroup in empty header");

#
# Open folder with example messages
#

my $fn = 'mlfolder';
$fn = File::Spec->catfile('31fgroups', $fn) unless -f $fn;
$fn = File::Spec->catfile('tests', $fn)  unless -f $fn;
die "Cannot find file with mailinglist examples ($fn)" unless -f $fn;

my $folder = Mail::Box::Mbox->new(folder => $fn, extract => 'ALWAYS');
ok(defined $folder,                   "open example folder");
die unless defined $folder;

my @msgs   = $folder->messages;
my @expect =
 ( {
   }
 , { type    => 'Mailman'
   , version => '2.0rc1'
   , address => 'templates@template-toolkit.org'
   , listname=> 'templates'
   , details => 'Mailman at templates@template-toolkit.org (2.0rc1), 11 fields'
   , rfc     => 'rfc2369'
   }
 , { type    => 'Ezmlm'
   , software=> undef
   , version => undef
   , address => 'perl5-porters@perl.org'
   , listname=> 'perl5-porters'
   , details => 'Ezmlm at perl5-porters@perl.org, 6 fields'
   , rfc     => 'rfc2369'
   }
 , { type    => 'Smartlist'
   , software=> undef
   , version => undef
   , address => 'debian-devel@lists.debian.org'
   , listname=> 'debian-devel'
   , details => 'Smartlist at debian-devel@lists.debian.org, 12 fields'
   , rfc     => undef
   }
 , { type    => 'Majordomo'
   , software=> undef
   , version => undef
   , address => 'london-pm@lists.dircon.co.uk'
   , listname=> 'london-pm'
   , details => 'Majordomo at london-pm@lists.dircon.co.uk, 2 fields'
   , rfc     => undef
   }
 , { type    => 'Sympa'
   , software=> undef
   , version => undef
   , address => 'noustestons@cru.fr'
   , listname=> 'noustestons'
   , details => 'Sympa at noustestons@cru.fr, 9 fields'
   , rfc     => 'rfc2369'
   }
 , { type    => 'Listar'
   , software=> 'Listar'
   , version => 'v0.129a'
   , address => 'adm@oasys.net'
   , listname=> 'adm'
   , details => 'Listar at adm@oasys.net (v0.129a), 8 fields'
   , rfc     => undef
   }
 , { type    => 'YahooGroups'
   , software=> undef
   , version => undef
   , address => 'ryokoforever@yahoogroups.com'
   , listname=> 'ryokoforever'
   , details => 'YahooGroups at ryokoforever@yahoogroups.com, 7 fields'
   , rfc     => undef
   }
 , { type    => 'Mailman'
   , software=> undef
   , version => '2.0.1'
   , address => 'London.pm Perl M[ou]ngers <london-pm@london.pm.org>'
   , listname=> 'London.pm Perl M[ou]ngers <london.pm.london.pm.org>'
   , details => 'Mailman at london.pm@london.pm.org (2.0.1), 6 fields'
   , rfc     => 'rfc2919'
   }
 , { type    => 'Ecartis'
   , software=> 'Ecartis'
   , version => 'v1.0.0'
   , address => 'adm@oasys.net'
   , listname=> 'adm'
   , details => 'Ecartis at adm@oasys.net (v1.0.0), 7 fields'
   , rfc     => undef
   }
 , { type    => 'CommuniGatePro'
   , software=> 'CommuniGate Pro'
   , version => '4.0.6'
   , address => 'Mail-ListDetector@gunzel.org'
   , listname=> 'Mail-ListDetector.gunzel.org'
   , details => 'CommuniGatePro at Mail-ListDetector@gunzel.org (CommuniGate Pro 4.0.6), 4 fields'
   , rfc     => 'rfc2919'
   }
 , { type    => 'FML'
   , software=> 'fml'
   , version => '4.0 STABLE (20010208)'
   , address => 'mlname@domain.example.com'
   , listname=> 'mlname'
   , details => 'FML at mlname@domain.example.com (fml 4.0 STABLE (20010208)), 10 fields'
   , rfc     => 'rfc2369'
   }
 , { type    => 'FML'
   , software=> 'fml'
   , version => '4.0 STABLE (20010218)'
   , address => 'Announce@mldetector.gr.jp'
   , listname=> 'Announce'
   , details => 'FML at Announce@mldetector.gr.jp (fml 4.0 STABLE (20010218)), 6 fields'
   , rfc     => undef
   }
 , { type    => 'Listbox'             # based on sending address (old)
   , software=> undef
   , version => undef
   , address => 'sample@v2.listbox.com'
   , listname=> 'sample'
   , details => 'Listbox at sample@v2.listbox.com, 5 fields'
   , rfc     => 'rfc2919'
   }
 , { type    => 'Listbox'             # based on List-Software
   , software=> 'listbox.com'
   , version => 'v2.0'
   , address => 'sample@v2.listbox.com'
   , listname=> 'sample'
   , details => 'Listbox at sample@v2.listbox.com (listbox.com v2.0), 6 fields'
   , rfc     => 'rfc2919'
   }
 , { type    => 'Listserv'
   , software=> 'LISTSERV-TCP/IP'
   , version => '1.8e'
   , address => '"EXAMPLE Discussion" <EXAMPLE@LISTSERV.EXAMPLE.COM>'
   , listname=> 'EXAMPLE Discussion'
   , details => 'Listserv at "EXAMPLE Discussion" <EXAMPLE@LISTSERV.EXAMPLE.COM> (LISTSERV-TCP/IP 1.8e), 1 fields'
   , rfc     => undef
   }
 , { type    => 'Listserv'
   , software=> 'LISTSERV-TCP/IP'
   , version => '1.8d'
   , address => '"Comedy Company" <COCO@LISTSERV.EXAMPLE.COM>'
   , listname=> 'Comedy Company'
   , details => 'Listserv at "Comedy Company" <COCO@LISTSERV.EXAMPLE.COM> (LISTSERV-TCP/IP 1.8d), 1 fields'
   , rfc     => undef
   }
 , { type    => 'CommuniGate'
   , software=> 'CommuniGate'
   , version => '1.4'
   , address => '<CGnet@total.example.com> (CGnet)'
   , listname=> 'CGnet'
   , details => 'CommuniGate at CGnet@total.example.com (1.4), 1 fields'
   , rfc     => undef
   }
 );

cmp_ok(scalar @msgs, '==', @expect,         "all messages");

for(my $nr = 0; $nr < @msgs; $nr++)
{  my $msg = $msgs[$nr];
   my %exp = %{$expect[$nr]};

   my $lg = $msg->head->listGroup;
   if(! defined $lg)
   {   ok(keys %exp == 0,                   "msg $nr is non-list message");
       next;
   }
   isa_ok($lg, 'Mail::Message::Head::ListGroup', "msg $nr from $exp{type}");

   is($lg->details, $exp{details},          "$nr details");
   is($lg->type, $exp{type},                "$nr type");
   is($lg->software, $exp{software},        "$nr software");
   is($lg->version, $exp{version},          "$nr version");
   is($lg->rfc, $exp{rfc},                  "$nr rfc");
}