#!/usr/bin/perl -w use Test::More tests => 62; BEGIN { chdir 't' if -d 't'; use lib '../blib/lib', 'lib/', '..'; } my $mod = "Parse::DebControl"; #Object initialization - 2 tests use_ok($mod); ok($pdc = new Parse::DebControl(), "Parser object creation works fine"); #Object default failure - 2 tests ok(!$pdc->parse_mem(), "Parser should fail if not given a name"); ok(!$pdc->parse_file(), "Parser should fail if not given a filename"); #Single item (no ending newline) parsing - 8 tests my $data; ok($data = $pdc->parse_mem("Description: foo"), "Parser for one-line returns valid data"); ok(exists($data->[0]->{Description}), "...and the data exists"); ok($data->[0]->{Description} eq "foo", "...and is the correct value"); ok(@$data == 1, "...and there's only one stanza"); ok(keys %{$data->[0]} == 1, "...and there's only item in the stanza"); ok($data = $pdc->parse_mem("Description: foo "), "Parser for one-line with trailing whitespace"); ok(exists($data->[0]->{Description}), "...and the data exists"); ok($data->[0]->{Description} eq "foo", "...and is the correct whitespace-stripped-value"); #Multiple item (no ending newline) parsing - 6 tests ok($data = $pdc->parse_mem("Item: value1\nOtherItem : value2\nFinalItem:value3"), "Multiple items read in correctly"); ok(@$data == 1, "...and there's only one stanza"); ok(keys %{$data->[0]} == 3, "...and there are three items in the stanza"); ok($data->[0]->{Item} eq "value1", "...and the first key is correct"); ok($data->[0]->{OtherItem} eq "value2", "...and the second key is correct"); ok($data->[0]->{FinalItem} eq "value3", "...and the third key is correct"); #Multiple Stanza (with ending newline) parsing - 9 tests # These tests also make sure we strip off ending newlines ok($data = $pdc->parse_mem("Title: hello\nSection: unknown\n\nManifest: 12345.67890\nOther: value\nThreshold : unknown\n\n\n"), "Parses in a complex structure, and returns valid data"); ok(@$data == 2, "...and there are two stanzas"); ok(keys %{$data->[0]} == 2, "...and the first stanza is the right size"); ok(keys %{$data->[1]} == 3, "...and the second stanza is the right size"); ok($data->[0]->{Title} eq "hello", "First stanza: The first data piece is correct"); ok($data->[0]->{Section} eq "unknown", "...and the second data piece"); ok($data->[1]->{Manifest} eq "12345.67890", "Second stanza: and the (numeric) first data piece"); ok($data->[1]->{Other} eq "value", "...and the second value"); ok($data->[1]->{Threshold} eq "unknown", "...and the third value"); #Single Stanza (overflowline no ending newline) parsing - 4 tests # Here we make sure multilines and period-only lines get stripped ok($data = $pdc->parse_mem("Description: Item1\n Hello\n World\n .\n Again"), "Parse a complex multi-line, single-stanza structure"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 1, "...and the first stanza is the right size"); ok($data->[0]->{Description} eq "Item1\nHello\nWorld\n\nAgain", "...and the data is correct"); #Single Stanza (Tie::IxHash test) - 6 tests SKIP: { eval { require Tie::IxHash }; skip "Tie::IxHash is not installed", 6 if($@); ok($data = $pdc->parse_mem("Description: item\nCorona: GoodWithLime\nOther-Item: here\n\n", {'useTieIxHash' => 1}), "Parse a single stanza item with Tie::IxHash support"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 3, "...and the stanza is the right size"); ok((keys %{$data->[0]})[0] eq "Description", "...and the order is right (first item)"); ok((keys %{$data->[0]})[1] eq "Corona", "...and the order is right (second item)"); ok((keys %{$data->[0]})[2] eq "Other-Item", "...and the order is right (third item)"); } #Single Stanza using caseDiscard - 6 tests ok($data = $pdc->parse_mem("Key1: value1\nKey2: value2\nKEY3: Value3", {'discardCase' => 1}), "Parse a simple structure with discardCase"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 3, "...and the stanza is the right size"); ok((exists($data->[0]->{key1}) and $data->[0]->{key1} eq "value1"), "The first entry exists and has the right value"); ok((exists($data->[0]->{key2}) and $data->[0]->{key2} eq "value2"), "...and the second value"); ok((exists($data->[0]->{key3}) and $data->[0]->{key3} eq "Value3"), "...and the third value"); #Side conditions - 4 tests ok($data = $pdc->parse_mem("Key1:\nKey2: value2\nkey3: value3"), "Parse a simple structure with a bad (blank) value"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 3, "...and the stanza is the right size"); ok($data->[0]->{Key1} eq "", "...and the blank key is correct"); #verbatim tests - 10 tests ok($data = $pdc->parse_mem("Key1: value1\n Testing1\n Testing2\n Testing3", {verbMultiLine => 1}), "Multiline verbatim option parses correctly"); ok(@$data == 1,"...and there is one stanza"); ok(keys %{$data->[0]} == 1, "...and the first stanza is the right size"); ok($data->[0]->{Key1} eq "value1\n Testing1\n Testing2\n Testing3", "...and the data works out correctly"); ok($data = $pdc->parse_mem("Key1: value1\n Testing1\n .\n Testing2", {verbMultiLine => 1}), "Multiline verbatim option parses correctly (with a period line"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 1, "...and the first stanza is the right size"); ok($data->[0]->{Key1} eq "value1\n Testing1\n .\n Testing2", "... and the dot stays in per expected behaviour"); ok($data = $pdc->parse_mem("Key1: value1 ", {verbMultiLine => 1}), "Single line verbatim option parses correctly, (verbatim whitespace save test)"); ok($data->[0]->{Key1} eq "value1 ", "verbMultiLine does not collapse trailing whitespace"); #CRLF tests - 5 tests ok($data = $pdc->parse_mem("Key1: value1\r\nKey2: Value2 \r\n"), "CRLF parses correctly"); ok(@$data == 1, "...and there is one stanza"); ok(keys %{$data->[0]} == 2, "...and the firest stanza is the right size"); ok($data->[0]->{Key1} eq "value1", "...and the first valus is correct"); ok($data->[0]->{Key2} eq "Value2", "...and the second value is correct");