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 header-fields with Mail::Message::Field::Fast.
# Only single fields, not whole headers. This also doesn't cover reading
# headers from file.
#

use strict;
use warnings;

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

use Test::More tests => 72;

use Mail::Message::Field::Fast;
use Mail::Address;

#
# Processing unstructured lines.
#

my $a = Mail::Message::Field::Fast->new('A: B  ; C');
is($a->name, 'a');
is($a->body, 'B  ; C');
ok(not defined $a->comment);

# No folding permitted.

my $b1 = ' B  ; C234290iwfjoj w etuwou   toiwutoi';
my $b2 = ' wtwoetuw oiurotu 3 ouwout 2 oueotu2';
my $b3 = ' fqweortu3';
my $bbody = "$b1$b2$b3";

my $b = Mail::Message::Field::Fast->new("A: $bbody");
my @lines = $b->toString(100);
cmp_ok(@lines, '==', 1);
is($lines[0], "A:$bbody\n");

@lines = $b->toString(42);
cmp_ok(@lines, '==', 3);
is($lines[0], "A:$b1\n");
is($lines[1], "$b2\n");
is($lines[2], "$b3\n");
is(' '.$b->body, $bbody);

#
# Processing of structured lines.
#

my $f = Mail::Message::Field::Fast->new('Sender:  B ;  C');
ok($f->isStructured);
is($f->name, 'sender');
is($f->body, 'B');
is($f, 'B ;  C');
is($f->comment, 'C');

# No comment, strip CR LF

my $g = Mail::Message::Field::Fast->new("Sender: B\015\012\n");
is($g->body, 'B');
is($g->comment, '');

# Separate head and body.

my $h = Mail::Message::Field::Fast->new("Sender", "B\015\012\n");
is($h->body, 'B');
is($h->comment, '');

my $i = Mail::Message::Field::Fast->new('Sender', 'B ;  C');
is($i->name, 'sender');
is($i->body, 'B');
like($i->comment, qr/^\s*C\s*/);

my $j = Mail::Message::Field::Fast->new('Sender', 'B', 'C');
is($j->name, 'sender');
is($j->body, 'B');
like($j->comment, qr/^\s*C\s*/);

# Check toString (for unstructured field, so no folding)

my $k = Mail::Message::Field::Fast->new(A => 'short line');
is($k->toString, "A: short line\n");
my @klines = $k->toString;
cmp_ok(@klines, '==', 1);

my $l = Mail::Message::Field::Fast->new(A =>
 'oijfjslkgjhius2rehtpo2uwpefnwlsjfh2oireuqfqlkhfjowtropqhflksjhflkjhoiewurpq');
my @llines = $k->toString;
cmp_ok(@llines, '==', 1); 

my $m = Mail::Message::Field::Fast->new(A =>
  'roijfjslkgjhiu, rehtpo2uwpe, fnwlsjfh2oire, uqfqlkhfjowtrop, qhflksjhflkj, hoiewurpq');

my @mlines = $m->toString;
cmp_ok(@mlines, '==', 2);
is($mlines[1], " hoiewurpq\n");

my $n  = Mail::Message::Field::Fast->new(A => 7);
my $x = $n + 0;
ok($n ? 1 : 0);
ok($x==7);
ok($n > 6);
ok($n < 8);
cmp_ok($n, '==', 7);
ok(6 < $n);
ok(8 > $n);

#
# Check gluing addresses
#

my @mb = Mail::Address->parse('me@localhost, you@somewhere.nl');
cmp_ok(scalar @mb, '==', 2);
my $r  = Mail::Message::Field::Fast->new(Cc => $mb[0]);
is($r->toString, "Cc: me\@localhost\n");

$r     = Mail::Message::Field::Fast->new(Cc => \@mb);
is($r->toString, "Cc: me\@localhost, you\@somewhere.nl\n");

my $r2 = Mail::Message::Field::Fast->new(Bcc => $r);
is($r2->toString, "Bcc: me\@localhost, you\@somewhere.nl\n");

#
# Checking attributes
#

my $charset = 'iso-8859-1';
my $comment = qq(charset="iso-8859-1"; format=flowed);

my $p = Mail::Message::Field::Fast->new("Content-Type: text/plain; $comment");
is($p->comment, $comment);
is($p->body, 'text/plain');
is($p->attribute('charset'), $charset);
is($p->attribute('format'), 'flowed');
ok(!defined $p->attribute('boundary'));
is($p->attribute(charset => 'us-ascii'), 'us-ascii');
is($p->attribute('charset'), 'us-ascii');
is($p->comment, 'charset="us-ascii"; format=flowed');
is($p->attribute(format => 'newform'), 'newform');
is($p->comment, 'charset="us-ascii"; format="newform"');
is($p->attribute(newfield => 'bull'), 'bull');
is($p->attribute('newfield'), 'bull');
is($p->comment, 'charset="us-ascii"; format="newform"; newfield="bull"');

my %attrs = $p->attributes;
cmp_ok(keys %attrs, '==', 3, "list of attributes");
is($attrs{charset}, 'us-ascii');
is($attrs{format}, 'newform');
is($attrs{newfield}, 'bull');

my $q = Mail::Message::Field::Fast->new('Content-Type: text/plain');
is($q->toString, "Content-Type: text/plain\n");
is($q->attribute(charset => 'iso-10646'), 'iso-10646');
is($q->attribute('charset'), 'iso-10646');
is($q->comment, 'charset="iso-10646"');
is($q->toString, qq(Content-Type: text/plain; charset="iso-10646"\n));

#
# Check preferred capitization of Labels
#

my @tests =
( 'Content-Transfer-Encoding' => 'Content-Transfer-Encoding'
, 'content-transfer-encoding' => 'Content-Transfer-Encoding'
, 'CONTENT-TRANSFER-ENCODING' => 'Content-Transfer-Encoding'
, 'cONTENT-tRANSFER-eNCODING' => 'Content-Transfer-Encoding'
, 'mime-version'              => 'MIME-Version'
, 'MIME-VERSION'              => 'MIME-Version'
, 'Mime-vERSION'              => 'MIME-Version'
, 'src-label'                 => 'SRC-Label'
, 'my-src-label'              => 'My-SRC-Label'
);

while(@tests)
{   my ($from, $to) = (shift @tests, shift @tests);
    is(Mail::Message::Field->wellformedName($from), $to);
}