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 parsing of fields
#

use strict;
use warnings;

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


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

#
# Test consuming phrases
#

my @tests =
 ( 'hi! this is me <tux>' => ['hi! this is me', '<tux>' ]
 , ' aap, noot <tux>'     => ['aap', ', noot <tux>' ]
 , '" aap, noot " <tux>'  => [' aap, noot ', ' <tux>' ]
 , '"aap", "noot"'        => ['aap', ', "noot"' ]
 , '"a\\"b\\"c" d'        => ['a"b"c', ' d' ]
 , '"\\"b\\"" d'          => ['"b"', ' d' ]
 , '"a\\)b\\(c" d'        => ['a\\)b\\(c', ' d' ]
 , '<tux>'                => [ undef, '<tux>' ]
 , ' <tux>'               => [ undef, '<tux>' ]
 , '" " <tux>'            => [ ' ', ' <tux>' ]
 );

while(@tests)
{   my ($from, $to) = (shift @tests, shift @tests);
    my ($exp_phrase, $exp_rest) = @$to;

    my ($phrase, $rest) = $mmff->consumePhrase($from);
    is($phrase, $exp_phrase,  $from);
    is($rest, $exp_rest,      $from);
}

#
# Test consuming comments
#

@tests =
 ( '(this is a comment) <tux>' => [ 'this is a comment', ' <tux>' ]
 , '(this)'                    => [ 'this', '' ]
 , 'this'                      => [ undef, 'this' ]
 , ' (a(b)c) <tux>'            => [ 'a(b)c', ' <tux>' ]
 , '((a)b(c)) <tux>'           => [ '(a)b(c)', ' <tux>' ]
 , '((a)b(c) <tux>'            => [ undef, '((a)b(c) <tux>' ]
 , '(a\(b) <tux>'              => [ 'a(b', ' <tux>' ]
 , '(a <tux>'                  => [ undef, '(a <tux>' ]
 , 'a) <tux>'                  => [ undef, 'a) <tux>' ]
 );

while(@tests)
{   my ($from, $to) = (shift @tests, shift @tests);
    my ($exp_comment, $exp_rest) = @$to;

    my ($comment, $rest) = $mmff->consumeComment($from);
    is($comment, $exp_comment,  $from);
    is($rest, $exp_rest,      $from);
}

#