The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;

if (eval "require Test::Differences") {
    no warnings 'redefine';
    *is_deeply = \&Test::Differences::eq_or_diff;
}

my $class = 'Text::vFile::asData';
require_ok( $class );
isa_ok( my $p = $class->new, $class );

# rfc2445 4.1
is_deeply( [ $p->_unwrap_lines(
    "FOO:This is a te",
    " st.  Not a",
    "  real foo." )
            ],
   [ "FOO:This is a test.  Not a real foo." ],
   "line unwrapping",
);

is_deeply( $p->parse_lines(
    "FOO:This is a te",
    " st.  Not a",
    "  real foo." ),
        {
            properties => {
                FOO => [ { value => "This is a test.  Not a real foo." }
                   ],
            },
        },
        "simple property"
       );


is_deeply( $p->parse_lines( 'CHECK:one\, two' ),
           {
               properties => {
                   CHECK => [ { value => 'one\, two' } ],
               },
           },
           "value containing an escaped comma"
          );

is_deeply( $p->parse_lines( "CHECK:one,two" ),
           {
               properties => {
                   CHECK => [ { value => "one,two" } ],
               },
           },
           "value containing an unescaped comma"
          );

is_deeply( $p->parse_lines( "CHECK;testing=one:two" ),
           {
            properties => {
                           CHECK => [ { value => 'two',
                                        param => { testing => 'one' }
                                      } ],
                           },
            },
           "a single parameter"
         );

is_deeply( $p->parse_lines( "CHECK;testing1=one;testing2=two:ffff" ),
           {
            properties => {
                           CHECK => [ { value => 'ffff',
                                        param => { testing1 => 'one',
                                                   testing2 => 'two', }
                                                 } ],
                                 },
                          },
            "multiple parameters"
           );

is_deeply( $p->parse_lines(
    "BEGIN:PIE",
    "FILLING:MEAT",
    "END:PIE",
   ),
           {
               objects => [
                   {
                       type => "PIE",
                       properties => {
                           FILLING => [ { value => 'MEAT' } ],
                       },
                   },
                  ],
           },
           "nest 1"
          );

is_deeply( $p->parse_lines(
    "BEGIN:PIE",
    "FILLING:MEAT",
    "BEGIN:CRUST",
    "BASE:CORN",
    "END:CRUST",
    "END:PIE",
   ),
           {
               objects => [
                   {
                       type       => "PIE",
                       properties => {
                           FILLING => [ { value => 'MEAT' } ],
                       },
                       objects   => [
                           {
                               type       => "CRUST",
                               properties => {
                                   BASE => [ { value => "CORN" } ],
                               }
                          },
                          ],
                   },
                  ],
           },
           "nest two"
          );

eval {
    $p->parse_lines(
        "BEGIN:PIE",
        "FILLING:MEAT",
        "END:FUN",
       );
};

like( $@, qr/^END FUN in PIE/, "nest failure" );

eval {
    $p->parse_lines(
        "BEGIN:PIE",
        "FILLING:MEAT",
       );
};

like( $@, qr/^BEGIN PIE without matching END/, "still nested nest failure" );

# rt #12381
eval {
    $p->parse_lines(
        "BEGIN:PIE",
        "FILLING:MEAT",
        "end:Pie",
       );
};

is( $@, "", "case-insensitive nesting" );


is_deeply( $p->parse_lines(
    "FOO;BAR=BAZ;QUUX=FLANGE:FROOBLE" ),
           {
               properties => {
                   FOO => [
                       {
                           param => {
                               BAR  => 'BAZ',
                               QUUX => 'FLANGE',
                           },
                           value => 'FROOBLE',
                       },
                      ],
               },
           },
           "simple params" );


is_deeply( $p->parse_lines(
    'FOO;BAR="BAZ was here";QUUX="FLANGE":FROOBLE' ),
           {
               properties => {
                   FOO => [
                       {
                           param => {
                               BAR  => 'BAZ was here',
                               QUUX => 'FLANGE',
                           },
                           value => 'FROOBLE',
                       },
                      ],
               },
           },
           "quoted params" );

is_deeply( $p->parse_lines(
    'FOO;BAR="BAZ was here";QUUX="FLANGE wants the colon: ":FROOBLE' ),
           {
               properties => {
                   FOO => [
                       {
                           param => {
                               BAR  => 'BAZ was here',
                               QUUX => 'FLANGE wants the colon: ',
                           },
                           value => 'FROOBLE',
                       },
                      ],
               },
           },
           "quoted params" );


is_deeply( $p->parse_lines(
    'FOO;BAR="BAZ was here";QUUX="FLANGE wants the colon: ":FROOBLE: NINJA' ),
           {
               properties => {
                   FOO => [
                       {
                           param => {
                               BAR  => 'BAZ was here',
                               QUUX => 'FLANGE wants the colon: ',
                           },
                           value => 'FROOBLE: NINJA',
                       },
                      ],
               },
           },
           "quoted params colon in the value" );

# Richard Russo points out this one
is_deeply( $p->parse_lines( q{ORGANIZER;CN="Will O'the Wisp":William} ),
           {
               properties => {
                   ORGANIZER => [
                       {
                           param  => {
                               CN => "Will O'the Wisp",
                           },
                           value => 'William',
                       },
                   ],
               },
           },
           "quoted param with embedded quote marks" );


# Leo's corner case; you will sometimes have two params with the same
# names (pesky vCards)
is_deeply( $p->parse_lines( 'FOO;corner=fruit;corner=case:BAZ' ),
           {
               properties => {
                   FOO => [
                       {
                           param  => {
                               corner => 'case',
                           },
                           value => 'BAZ',
                       },
                      ],
               },
           },
           "collapsing params" );

$p->preserve_params( 1 );
is_deeply( $p->parse_lines( 'FOO;corner=fruit;corner=case:BAZ' ),
           {
               properties => {
                   FOO => [
                       {
                           param  => {
                               corner => 'case',
                           },
                           params => [
                               { corner => 'fruit' },
                               { corner => 'case' },
                              ],
                           value => 'BAZ',
                       },
                      ],
               },
           },
           "collapsing and non-collapsing params" );

# Another one via Leo, parsing vCards with embedded images leads to segfaulty
# death - probably just because we try and tokenize 49k of data with a simple
# regex
open my $fh, "t/user_with_image.vcf" or die "couldn't open test card";
my $data = $p->parse( $fh );
ok( 1, "didn't segfault on parsing an embedded image" );
ok( exists $data->{objects}[0]{properties}{PHOTO}[0]{param}{BASE64},
    "Looks like we handled the vcard too" );

done_testing();