1#!/usr/bin/env perl 2# 3# Test the processing of list groups. 4# 5 6use strict; 7use warnings; 8 9use Mail::Message; 10use Mail::Message::Test; 11use Mail::Message::Head::Complete; 12use Mail::Message::Head::ListGroup; 13 14use Test::More; 15use IO::Scalar; 16use File::Spec; 17use File::Basename qw(dirname); 18 19BEGIN { 20 eval 'require Mail::Box::Mbox'; 21 if($@) 22 { plan skip_all => 'requires Mail::Box::Mbox.'; 23 exit 0; 24 } 25 else 26 { plan tests => 119; 27 } 28} 29 30# 31# Creation of a group 32# 33 34my $mailbox = '"Mail::Box development" <mailbox@perl.overmeer.net>'; 35my $lg0 = Mail::Message::Head::ListGroup->new(address => $mailbox); 36 37ok(defined $lg0, 'simple construction'); 38my $addr = $lg0->address; 39 40ok(defined $addr, 'address defined'); 41isa_ok($addr, 'Mail::Message::Field::Address'); 42is($addr->phrase, 'Mail::Box development'); 43is($lg0->listname, 'Mail::Box development'); 44is($addr->address, 'mailbox@perl.overmeer.net'); 45is("$addr", $mailbox); 46is($lg0->address->string, $mailbox); 47 48ok(!defined $lg0->type); 49ok(!defined $lg0->software); 50ok(!defined $lg0->version); 51ok(!defined $lg0->rfc); 52 53# 54# Extraction of a group 55# 56 57my $h = Mail::Message::Head::Complete->new; 58ok(defined $h); 59 60my $lg = Mail::Message::Head::ListGroup->from($h); 61ok(!defined $lg, "no listgroup in empty header"); 62 63# 64# Open folder with example messages 65# 66 67my $fn = dirname(__FILE__).'/203-mlfolder.mbox'; 68die "Cannot find file with mailinglist examples ($fn)" unless -f $fn; 69 70my $folder = Mail::Box::Mbox->new(folder => $fn, extract => 'ALWAYS'); 71ok(defined $folder, "open example folder"); 72die unless defined $folder; 73 74my @msgs = $folder->messages; 75my @expect = 76 ( { 77 } 78 , { type => 'Mailman' 79 , version => '2.0rc1' 80 , address => 'templates@template-toolkit.org' 81 , listname=> 'templates' 82 , details => 'Mailman at templates@template-toolkit.org (2.0rc1), 11 fields' 83 , rfc => 'rfc2369' 84 } 85 , { type => 'Ezmlm' 86 , software=> undef 87 , version => undef 88 , address => 'perl5-porters@perl.org' 89 , listname=> 'perl5-porters' 90 , details => 'Ezmlm at perl5-porters@perl.org, 6 fields' 91 , rfc => 'rfc2369' 92 } 93 , { type => 'Smartlist' 94 , software=> undef 95 , version => undef 96 , address => 'debian-devel@lists.debian.org' 97 , listname=> 'debian-devel' 98 , details => 'Smartlist at debian-devel@lists.debian.org, 12 fields' 99 , rfc => undef 100 } 101 , { type => 'Majordomo' 102 , software=> undef 103 , version => undef 104 , address => 'london-pm@lists.dircon.co.uk' 105 , listname=> 'london-pm' 106 , details => 'Majordomo at london-pm@lists.dircon.co.uk, 2 fields' 107 , rfc => undef 108 } 109 , { type => 'Sympa' 110 , software=> undef 111 , version => undef 112 , address => 'noustestons@cru.fr' 113 , listname=> 'noustestons' 114 , details => 'Sympa at noustestons@cru.fr, 9 fields' 115 , rfc => 'rfc2369' 116 } 117 , { type => 'Listar' 118 , software=> 'Listar' 119 , version => 'v0.129a' 120 , address => 'adm@oasys.net' 121 , listname=> 'adm' 122 , details => 'Listar at adm@oasys.net (v0.129a), 8 fields' 123 , rfc => undef 124 } 125 , { type => 'YahooGroups' 126 , software=> undef 127 , version => undef 128 , address => 'ryokoforever@yahoogroups.com' 129 , listname=> 'ryokoforever' 130 , details => 'YahooGroups at ryokoforever@yahoogroups.com, 7 fields' 131 , rfc => undef 132 } 133 , { type => 'Mailman' 134 , software=> undef 135 , version => '2.0.1' 136 , address => 'London.pm Perl M[ou]ngers <london-pm@london.pm.org>' 137 , listname=> 'London.pm Perl M[ou]ngers <london.pm.london.pm.org>' 138 , details => 'Mailman at london.pm@london.pm.org (2.0.1), 6 fields' 139 , rfc => 'rfc2919' 140 } 141 , { type => 'Ecartis' 142 , software=> 'Ecartis' 143 , version => 'v1.0.0' 144 , address => 'adm@oasys.net' 145 , listname=> 'adm' 146 , details => 'Ecartis at adm@oasys.net (v1.0.0), 7 fields' 147 , rfc => undef 148 } 149 , { type => 'CommuniGatePro' 150 , software=> 'CommuniGate Pro' 151 , version => '4.0.6' 152 , address => 'Mail-ListDetector@gunzel.org' 153 , listname=> 'Mail-ListDetector.gunzel.org' 154 , details => 'CommuniGatePro at Mail-ListDetector@gunzel.org (CommuniGate Pro 4.0.6), 4 fields' 155 , rfc => 'rfc2919' 156 } 157 , { type => 'FML' 158 , software=> 'fml' 159 , version => '4.0 STABLE (20010208)' 160 , address => 'mlname@domain.example.com' 161 , listname=> 'mlname' 162 , details => 'FML at mlname@domain.example.com (fml 4.0 STABLE (20010208)), 10 fields' 163 , rfc => 'rfc2369' 164 } 165 , { type => 'FML' 166 , software=> 'fml' 167 , version => '4.0 STABLE (20010218)' 168 , address => 'Announce@mldetector.gr.jp' 169 , listname=> 'Announce' 170 , details => 'FML at Announce@mldetector.gr.jp (fml 4.0 STABLE (20010218)), 6 fields' 171 , rfc => undef 172 } 173 , { type => 'Listbox' # based on sending address (old) 174 , software=> undef 175 , version => undef 176 , address => 'sample@v2.listbox.com' 177 , listname=> 'sample' 178 , details => 'Listbox at sample@v2.listbox.com, 5 fields' 179 , rfc => 'rfc2919' 180 } 181 , { type => 'Listbox' # based on List-Software 182 , software=> 'listbox.com' 183 , version => 'v2.0' 184 , address => 'sample@v2.listbox.com' 185 , listname=> 'sample' 186 , details => 'Listbox at sample@v2.listbox.com (listbox.com v2.0), 6 fields' 187 , rfc => 'rfc2919' 188 } 189 , { type => 'Listserv' 190 , software=> 'LISTSERV-TCP/IP' 191 , version => '1.8e' 192 , address => '"EXAMPLE Discussion" <EXAMPLE@LISTSERV.EXAMPLE.COM>' 193 , listname=> 'EXAMPLE Discussion' 194 , details => 'Listserv at "EXAMPLE Discussion" <EXAMPLE@LISTSERV.EXAMPLE.COM> (LISTSERV-TCP/IP 1.8e), 1 fields' 195 , rfc => undef 196 } 197 , { type => 'Listserv' 198 , software=> 'LISTSERV-TCP/IP' 199 , version => '1.8d' 200 , address => '"Comedy Company" <COCO@LISTSERV.EXAMPLE.COM>' 201 , listname=> 'Comedy Company' 202 , details => 'Listserv at "Comedy Company" <COCO@LISTSERV.EXAMPLE.COM> (LISTSERV-TCP/IP 1.8d), 1 fields' 203 , rfc => undef 204 } 205 , { type => 'CommuniGate' 206 , software=> 'CommuniGate' 207 , version => '1.4' 208 , address => '<CGnet@total.example.com> (CGnet)' 209 , listname=> 'CGnet' 210 , details => 'CommuniGate at CGnet@total.example.com (1.4), 1 fields' 211 , rfc => undef 212 } 213 ); 214 215cmp_ok(scalar @msgs, '==', @expect, "all messages"); 216 217for(my $nr = 0; $nr < @msgs; $nr++) 218{ my $msg = $msgs[$nr]; 219 my %exp = %{$expect[$nr]}; 220 221 my $lg = $msg->head->listGroup; 222 if(! defined $lg) 223 { ok(keys %exp == 0, "msg $nr is non-list message"); 224 next; 225 } 226 isa_ok($lg, 'Mail::Message::Head::ListGroup', "msg $nr from $exp{type}"); 227 228 is($lg->details, $exp{details}, "$nr details"); 229 is($lg->type, $exp{type}, "$nr type"); 230 is($lg->software, $exp{software}, "$nr software"); 231 is($lg->version, $exp{version}, "$nr version"); 232 is($lg->rfc, $exp{rfc}, "$nr rfc"); 233} 234 235