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 general structured fields
#

use strict;
use warnings;

package Mail::Message::Field::Structured;
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::Structured';
   if($@)
   {   plan skip_all => 'Extended attributes not available (install Encode?)';
       exit 0;
   }
   else
   {   plan tests => 64;
   }
}

my $mmff = 'Mail::Message::Field::Full';
my $mmfs = 'Mail::Message::Field::Structured';
my $mmfa = 'Mail::Message::Field::Attribute';

#
# Test construction with simple body
#

my $a = $mmfs->new('a', 'new');
ok(defined $a,                          "Created simplest version");
isa_ok($a, $mmfs);
isa_ok($a, $mmff);
is($a->name, 'a',                       "Name of a");

is($a->unfoldedBody, 'new',             "Unfolded body a");
my @al = $a->foldedBody;
cmp_ok(@al, '==', 1,                    "Folded body of a");
is($al[0], " new\n");

my $b = $mmfs->new('b');
ok(defined $b,                          "No body specified: later");

#
# LINE without new lines (no folds)
#

$b = $mmfs->new('b: new');
ok(defined $b,                          "Created b with body split");
isa_ok($b, $mmfs);
isa_ok($b, $mmff);
is($b->name, 'b',                       "Name of b");

is($b->unfoldedBody, 'new',             "Unfolded body b");
my @bl = $b->foldedBody;
cmp_ok(@bl, '==', 1,                    "Folded body of b");
is($bl[0], " new\n");

#
# LINE with new-lines (folds)
#

my $c = $mmfs->new("c: new\n line\n");
ok(defined $c,                          "Created c with body split");
isa_ok($c, $mmfs);
isa_ok($c, $mmff);
is($c->name, 'c',                       "Name of c");

is($c->unfoldedBody, 'new line',        "Unfolded body c");
my @cl = $c->foldedBody;
cmp_ok(@cl, '==', 2,                    "Folded body of c");
is($cl[0], " new\n",                    "Folded c line 1");
is($cl[1], " line\n",                   "Folded c line 2");

#
# Constructing
#

my $d = $mmfs->new('d');
ok(defined $d,                          "Created d");
is($d->unfoldedBody, "",                "Empty body");
is($d->foldedBody, " \n",               "Empty body");

is($d->datum('text/html'), 'text/html', "Set datum");
$d->beautify;  # required to re-generate
is($d->produceBody, "text/html",        "Check datum");
is($d->unfoldedBody, "text/html");
is($d->foldedBody, " text/html\n");

ok(! defined $d->attribute('unknown'),  "No attributes yet");
cmp_ok(scalar $d->attributes, '==', 0);

my $da = $d->attribute(filename => 'virus.exe');
isa_ok($da, 'Mail::Message::Field::Attribute');
is($d->produceBody, 'text/html; filename="virus.exe"');
is($d->unfoldedBody, 'text/html; filename="virus.exe"');
is($d->foldedBody, qq# text/html; filename="virus.exe"\n#);

#
# Parsing
#

my $body = "(comment1)bod(aa)y(comment2); (comment3)attr1=aaa(comment4); attr2=\"b\"; attr3='c'";

my $e = $mmfs->new("e: $body\n");
ok(defined $e, "field with attributes");
is($e->datum, 'body',                   "Check datum");

my @attrs = $e->attributes;
cmp_ok(scalar @attrs, '==', 3,          "All attributes");

ok(defined $e->attribute('attr1'),      "attr1 exists");
isa_ok($e->attribute('attr1'), $mmfa);
is($e->attribute('attr1')->value, 'aaa',"attr1 value");

ok(defined $e->attribute('attr2'),      "attr2 exists");
isa_ok($e->attribute('attr2'), $mmfa);
is($e->attribute('attr2')->value, 'b',  "attr2 value");

ok(defined $e->attribute('attr3'),      "attr3 exists");
isa_ok($e->attribute('attr3'), $mmfa);
is($e->attribute('attr3')->value, 'c',  "attr3 value");

is($e->unfoldedBody, "$body",           "unfolded not changed");
is($e->foldedBody, " $body\n",          "folded not changed");

$e->beautify;
is($e->unfoldedBody, "body; attr1=aaa; attr2=b; attr3='c'",
                                        "unfolded beautyfied");
is($e->foldedBody, " body; attr1=aaa; attr2=b; attr3='c'\n",
                                        "folded beautyfied");

#
## errors
#

my $f = $mmfs->new('f: c; a="missing quote');  # bug report #31017
ok(defined $f, 'missing quote');
is($f->unfoldedBody, 'c; a="missing quote');
is($f->foldedBody, " c; a=\"missing quote\n");

my $fa = $f->attribute('a');
ok(defined $fa, 'f attribute a');
is($fa->string, '; a=missing quote');
is($fa->value, 'missing quote');

my $g = $mmfs->new('g: c; a="with []"');      # bug report #31912
ok(defined $g, '[]');
my $ga = $g->attribute('a');
ok(defined $ga);
is($ga->value, 'with []');

my $gb = $mmfs->new('g: c; filename=xxxx[1].pif');
ok(defined $gb, 'xxxx[1].pif');
my $gc = $gb->attribute('filename');
ok(defined $gc);
is($gc->value, 'xxxx[1].pif');