The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use 5.010;
use strict;
use warnings;
use FindBin '$Bin';
use lib $Bin, "$Bin/t";

use Text::Fragment qw(list_fragments);
use Test::More 0.98;

subtest "empty" => sub {
    my $text = <<'_';
1
2
3
4 // FRAGMENT id=id1 cause=different-label
5 # DIFFERENT_LABEL id=id2
_

    is_deeply(
        list_fragments(text=>$text),
        [200, "OK", [
        ]]);
};

subtest "list" => sub {
    my $text = <<'_';
1
2
3
4 # FRAGMENT id=id1 a=1 b=2
# BEGIN FRAGMENT id=id2
a
b
# END FRAGMENT
 5  #FRAGMENT  id=id3
# BEGIN FRAGMENT id=id4
c
# END FRAGMENT
# END FRAGMENT id=id4
_

    is_deeply(
        list_fragments(text=>$text),
        [200, "OK", [
            {
                raw     => "4 # FRAGMENT id=id1 a=1 b=2\n",
                id      => "id1",
                attrs   => {id=>"id1", a=>1, b=>2},
                payload => "4",
            },
            {
                raw     => "# BEGIN FRAGMENT id=id2\na\nb\n# END FRAGMENT\n",
                id      => "id2",
                attrs   => {id=>"id2"},
                payload => "a\nb\n",
            },
            {
                raw     => " 5  #FRAGMENT  id=id3\n",
                id      => "id3",
                attrs   => {id=>"id3"},
                payload => " 5",
            },
            {
                raw     => "# BEGIN FRAGMENT id=id4\nc\n# END FRAGMENT\n".
                    "# END FRAGMENT id=id4\n",
                id      => "id4",
                attrs   => {id=>"id4"},
                payload => "c\n# END FRAGMENT\n",
            },
        ]]);
};

subtest "multi-word label, c-style comment" => sub {
    my $text = <<'_';
1
2
3 /* FRAGMENT id=id0 */
/* BEGIN SPANEL SECTION id=id-1 */
a
b
/* END SPANEL SECTION */
4 /* SPANEL SECTION id=id-2 */
5
_

    is_deeply(
        list_fragments(text=>$text,
                       comment_style=>"c", label=>"SPANEL SECTION"),
        [200, "OK", [
            {
                raw     => "/* BEGIN SPANEL SECTION id=id-1 */\na\nb\n".
                    "/* END SPANEL SECTION */\n",
                id      => "id-1",
                attrs   => {id=>"id-1"},
                payload => "a\nb\n",
            },
            {
                raw     => "4 /* SPANEL SECTION id=id-2 */\n",
                id      => "id-2",
                attrs   => {id=>"id-2"},
                payload => "4",
            },
        ]]);
};

subtest "cpp-style comment" => sub {
    my $text = <<'_';
1
2
// BEGIN FRAGMENT id=id-1
a
b
// END FRAGMENT
4 // FRAGMENT id=id-2
5
_

    is_deeply(
        list_fragments(text=>$text,
                       comment_style=>"cpp"),
        [200, "OK", [
            {
                raw     => "// BEGIN FRAGMENT id=id-1\na\nb\n".
                    "// END FRAGMENT\n",
                id      => "id-1",
                attrs   => {id=>"id-1"},
                payload => "a\nb\n",
            },
            {
                raw     => "4 // FRAGMENT id=id-2\n",
                id      => "id-2",
                attrs   => {id=>"id-2"},
                payload => "4",
            },
        ]]);
};

subtest "ini-style comment" => sub {
    my $text = <<'_';
1
2
; BEGIN FRAGMENT id=id-1
a
b
; END FRAGMENT
4 ; FRAGMENT id=id-2
5
_

    is_deeply(
        list_fragments(text=>$text,
                       comment_style=>"ini"),
        [200, "OK", [
            {
                raw     => "; BEGIN FRAGMENT id=id-1\na\nb\n".
                    "; END FRAGMENT\n",
                id      => "id-1",
                attrs   => {id=>"id-1"},
                payload => "a\nb\n",
            },
            {
                raw     => "4 ; FRAGMENT id=id-2\n",
                id      => "id-2",
                attrs   => {id=>"id-2"},
                payload => "4",
            },
        ]]);
};

subtest "html-style comment" => sub {
    my $text = <<'_';
1
2
<!-- BEGIN FRAGMENT id=id-1 -->
a
b
<!-- END FRAGMENT -->
4 <!-- FRAGMENT id=id-2 -->
5
_

    is_deeply(
        list_fragments(text=>$text,
                       comment_style=>"html"),
        [200, "OK", [
            {
                raw     => "<!-- BEGIN FRAGMENT id=id-1 -->\na\nb\n".
                    "<!-- END FRAGMENT -->\n",
                id      => "id-1",
                attrs   => {id=>"id-1"},
                payload => "a\nb\n",
            },
            {
                raw     => "4 <!-- FRAGMENT id=id-2 -->\n",
                id      => "id-2",
                attrs   => {id=>"id-2"},
                payload => "4",
            },
        ]]);
};

DONE_TESTING:
done_testing;