The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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");