t/003-Data-Walk-Print.t

#!perl
#######  Test File for Data::Walk::Extracted  #######
BEGIN{
	#~ $ENV{ Smart_Comments } = '### #### #####';
}

use Test::Most;
use Test::Moose;
use Capture::Tiny 0.12 qw( 
	capture_stdout 
);
use MooseX::ShortCut::BuildInstance 0.008;
use lib '../lib', 'lib';
use Data::Walk::Extracted 0.024;
use Data::Walk::Print 0.024;
if( $ENV{ Smart_Comments } ){
	use Smart::Comments -ENV;#'###'
	### Smart-Comments turned on for the Data-Walk-Print test ...
}

my  ( 
			$first_ref, $second_ref, $newclass, $gutenberg, 
			$test_inst, $capture, $wait, $x, @answer,
);
my 			$test_case = 1;
my 			@class_attributes = qw(
				sorted_nodes
				skipped_nodes
				skip_level
				skip_node_tests
				change_array_size
				fixed_primary
			);
my  		@class_methods = qw(
				new
				has_sorted_nodes
				has_skipped_nodes
				has_skip_level
				has_skip_node_tests
				has_change_array_size
				has_fixed_primary
				get_sorted_nodes
				get_skipped_nodes
				get_skip_level
				get_skip_node_tests
				get_change_array_size
				get_fixed_primary
				set_sorted_nodes
				set_skipped_nodes
				set_skip_level
				set_skip_node_tests
				set_change_array_size
				set_fixed_primary
				clear_sorted_nodes
				clear_skipped_nodes
				clear_skip_level
				clear_skip_node_tests
				clear_change_array_size
				clear_fixed_primary
				add_sorted_nodes
				check_sorted_node
				remove_sorted_node
				add_skipped_nodes
				check_skipped_node
				remove_skipped_node
				add_skip_node_test
			);
my  		@instance_attributes = qw(
				sorted_nodes
				skipped_nodes
				skip_level
				skip_node_tests
				change_array_size
				fixed_primary
				match_highlighting
			);
my  		@instance_methods = qw(
				has_sorted_nodes
				has_skipped_nodes
				has_skip_level
				has_skip_node_tests
				has_change_array_size
				has_fixed_primary
				get_sorted_nodes
				get_skipped_nodes
				get_skip_level
				get_skip_node_tests
				get_change_array_size
				get_fixed_primary
				set_sorted_nodes
				set_skipped_nodes
				set_skip_level
				set_skip_node_tests
				set_change_array_size
				set_fixed_primary
				clear_sorted_nodes
				clear_skipped_nodes
				clear_skip_level
				clear_skip_node_tests
				clear_change_array_size
				clear_fixed_primary
				add_sorted_nodes
				check_sorted_node
				remove_sorted_node
				add_skipped_nodes
				check_skipped_node
				remove_skipped_node
				add_skip_node_test
				print_data
				set_match_highlighting
				get_match_highlighting
				has_match_highlighting
				clear_match_highlighting
			);
my			$answer_ref = [
				'',#qr/The composed class passed to 'new' does not have either a 'before_method' or an 'after_method' the Role 'Data::Walk::Print' will be added/,
				[
					"undef,",
				],
				[
					"'Test String',",
				],
				[
					"[", "\t'Test String',", "],",
				],
				[
					"{", "\tTestString => 1,", "},",
				],
				[
					"{", "\tTestString => 'value',", "},",
				],
				[
					"{", "\tHelping => [", "\t\t{", "\t\t\tMyKey => {", "\t\t\t\tMiddleKey => {",
					"\t\t\t\t\tLowerKey1 => 'lvalue1',", "\t\t\t\t\tLowerKey2 => {", 
					"\t\t\t\t\t\tBottomKey1 => 12345,", "\t\t\t\t\t\tBottomKey2 => [", 
					"\t\t\t\t\t\t\t'bavalue2',", "\t\t\t\t\t\t\t'bavalue1',", 
					"\t\t\t\t\t\t\t'bavalue3',", "\t\t\t\t\t\t],", 
					"\t\t\t\t\t},", "\t\t\t\t},", "\t\t\t},","\t\t\tSomelevel => {", 
					"\t\t\t\tSublevel => \'levelvalue\',", "\t\t\t},", "\t\t},", "\t],",
					"\tParsing => {", "\t\tHashRef => {", "\t\t\tLOGGER => {",
					"\t\t\t\trun => 'INFO',", "\t\t\t},", "\t\t},", "\t},",
					"\tSomeotherkey => 'value',", "},"
				],
				[
					"{", '\tHelping => ARRAY\(0x.{7,25}\),', 
					"\tParsing => {", "\t\tHashRef => {", "\t\t\tLOGGER => {",
					"\t\t\t\trun => 'INFO',", "\t\t\t},", "\t\t},", "\t},",
					"\tSomeotherkey => 'value',", "},"
				],
				[
					"{#<--- Ref Type Match", "\tHelping => [#<--- Hash Key Match - Ref Type Match",
					"\t\t{#<--- Position Exists - Ref Type Mismatch", 
					"\t\t\tMyKey => {#<--- Hash Key Mismatch - Ref Type Mismatch", 
					"\t\t\t\tMiddleKey => {#<--- Hash Key Mismatch - Ref Type Mismatch", 
					"\t\t\t\t\tLowerKey1 => 'lvalue1',#<--- Hash Key Mismatch - Scalar Value Does NOT Match", 
					"\t\t\t\t\tLowerKey2 => {#<--- Hash Key Mismatch - Ref Type Mismatch", 
					"\t\t\t\t\t\tBottomKey1 => 12345,#<--- Hash Key Mismatch - Scalar Value Does NOT Match", 
					"\t\t\t\t\t\tBottomKey2 => [#<--- Hash Key Mismatch - Ref Type Mismatch", 
					"\t\t\t\t\t\t\t'bavalue2',#<--- No Matching Position - Scalar Value Does NOT Match", 
					"\t\t\t\t\t\t\t'bavalue1',#<--- No Matching Position - Scalar Value Does NOT Match", 
					"\t\t\t\t\t\t\t'bavalue3',#<--- No Matching Position - Scalar Value Does NOT Match", 
					"\t\t\t\t\t\t],", "\t\t\t\t\t},", "\t\t\t\t},", "\t\t\t},", 
					"\t\t\tSomelevel => {#<--- Hash Key Mismatch - Ref Type Mismatch", 
					"\t\t\t\tSublevel => 'levelvalue',#<--- Hash Key Mismatch - Scalar Value Does NOT Match", 
					"\t\t\t},", "\t\t},", "\t],", "\tParsing => {#<--- Hash Key Match - Ref Type Mismatch", 
					"\t\tHashRef => {#<--- Hash Key Mismatch - Ref Type Mismatch", 
					"\t\t\tLOGGER => {#<--- Hash Key Mismatch - Ref Type Mismatch", 
					"\t\t\t\trun => 'INFO',#<--- Hash Key Mismatch - Scalar Value Does NOT Match", 
					"\t\t\t},", "\t\t},", "\t},", 
					"\tSomeotherkey => 'value',#<--- Hash Key Match - Scalar Value Matches", 
					"},", 
				],
				[
					"{", "\tHelping => [", "\t\t{", "\t\t\tMyKey => {", "\t\t\t\tMiddleKey => {", 
					"\t\t\t\t\tLowerKey1 => 'lvalue1',", "\t\t\t\t\tLowerKey2 => {", 
					"\t\t\t\t\t\tBottomKey1 => 12345,", "\t\t\t\t\t\tBottomKey2 => [", 
					"\t\t\t\t\t\t\t'bavalue2',", "\t\t\t\t\t\t\t'bavalue1',", "\t\t\t\t\t\t\t'bavalue3',", 
					"\t\t\t\t\t\t],", "\t\t\t\t\t},", "\t\t\t\t},", "\t\t\t},", "\t\t\tSomelevel => {", 
					"\t\t\t\tSublevel => 'levelvalue',", "\t\t\t},", "\t\t},", "\t],", "\tParsing => {", 
					"\t\tHashRef => {", "\t\t\tLOGGER => {", "\t\t\t\trun => 'INFO',", "\t\t\t},", "\t\t},", 
					"\t},", "\tSomeotherkey => 'value',", "},",
				],
				[
					"{#<--- Ref Type Match", "\tHelping => [#<--- Hash Key Match - Ref Type Match",
					"\t\t'Somelevel',#<--- Position Exists - Scalar Value Matches",
					"\t\t{#<--- Position Exists - Ref Type Match",
					"\t\t\tMyKey => {#<--- Hash Key Match - Ref Type Match",
					"\t\t\t\tMiddleKey => {#<--- Hash Key Match - Ref Type Match",
					"\t\t\t\t\tLowerKey1 => 'lvalue1',#<--- Hash Key Match - Scalar Value Matches",
					"\t\t\t\t\tLowerKey2 => {#<--- Hash Key Match - Ref Type Match",
					"\t\t\t\t\t\tBottomKey1 => 12345,#<--- Hash Key Match - Scalar Value Does NOT Match",
					"\t\t\t\t\t\tBottomKey2 => [#<--- Hash Key Match - Ref Type Match",
					"\t\t\t\t\t\t\t'bavalue1',#<--- Position Exists - Scalar Value Matches",
					"\t\t\t\t\t\t\t'bavalue2',#<--- Position Exists - Scalar Value Does NOT Match",
					"\t\t\t\t\t\t\t'bavalue3',#<--- No Matching Position - Scalar Value Does NOT Match",
					"\t\t\t\t\t\t],", "\t\t\t\t\t},", "\t\t\t\t},", "\t\t\t},", "\t\t},", "\t],",
					"\tParsing => {#<--- Hash Key Mismatch - Ref Type Mismatch",
					"\t\tHashRef => {#<--- Hash Key Mismatch - Ref Type Mismatch",
					"\t\t\tLOGGER => {#<--- Hash Key Mismatch - Ref Type Mismatch",
					"\t\t\t\trun => 'INFO',#<--- Hash Key Mismatch - Scalar Value Does NOT Match",
					"\t\t\t},", "\t\t},", "\t},",
					"\tSomeotherkey => 'value',#<--- Hash Key Match - Scalar Value Matches",
					"},",
				],
				[
					"{", "\tMyArray => [", "\t\tundef,", "\t\tundef,", "\t\t'ValueFive',", "\t],", "},",
				],
			];
### <where> - easy questions
map{ 
has_attribute_ok
			'Data::Walk::Extracted', $_,
										"Check that Data::Walk::Extracted has the -$_- attribute"
} 			@class_attributes;
map{
can_ok		'Data::Walk::Extracted', $_,
} 			@class_methods;

### <where> - harder questions
lives_ok{
			$gutenberg = 	build_instance(
								package => 'Print::Shop',
								superclasses => ['Data::Walk::Extracted'],
								roles => ['Data::Walk::Print'],
								sorted_nodes =>{
									HASH => 1, #To ensure test passes
								},
								match_highlighting => 0,
							);
}										"Prep a new Print instance";
map{
has_attribute_ok 
			$gutenberg, $_,				"Check that the new class has the -$_- attribute"
} 			@instance_attributes;
map can_ok( 
			$gutenberg, $_,
), 			@instance_methods;

### <where> 'hardest questions
ok			$capture = capture_stdout{ 
				$gutenberg->print_data( print_ref => undef, ); 
			},							'Test sending -undef- as a simple case for test case: ' . $test_case;
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
ok			$capture = capture_stdout{ 
				$gutenberg->print_data( print_ref => 'Test String', ); 
			},							'Test sending a string as a simple case for test case: ' . $test_case;
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
ok			$capture = capture_stdout{ 
				$gutenberg->print_data( print_ref =>[ 'Test String', ] ); 
			},							'Test sending a simple array with one level for test case: ' . $test_case;
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
ok			$capture = capture_stdout{ 
				$gutenberg->print_data( print_ref =>{ TestString => 1, } ); 
			},							'Test sending a simple hash with one level, one key, and numeric value for test case: ' . $test_case;
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
ok			$capture = capture_stdout{ 
				$gutenberg->print_data( print_ref =>{ TestString => 'value', } ); 
			},							'Test sending a simple hash with one level, one key, and string value  for test case: ' . $test_case;
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
lives_ok{   
			$first_ref = {
				Someotherkey => 'value',
				Parsing =>{
					HashRef =>{
						LOGGER =>{
							run => 'INFO',
						},
					},
				},
				Helping =>[
					{
						Somelevel =>{
							Sublevel => 'levelvalue',
						},
						MyKey =>{
							MiddleKey =>{
								LowerKey1 => 'lvalue1',
								LowerKey2 => {
									BottomKey1 => 12345,
									BottomKey2 =>[
										'bavalue2',
										'bavalue1',
										'bavalue3',
									],
								},
							},
						},
					},
				],
			};
}                                        'Build the $first_ref for testing';
#### $first_ref
ok			$capture = capture_stdout{ 
				$gutenberg->print_data( print_ref => $first_ref, ) 
			},							'Test sending the data structure for test case: ' . $test_case;
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
ok			$gutenberg->add_skipped_nodes( ARRAY => 1, ),
										"... set 'skip = yes' for future parsed ARRAY refs (test case: $test_case)";
lives_ok{
			$capture = capture_stdout{ 
				$gutenberg->print_data( print_ref => $first_ref, ); 
			}
}										'Test running the same array with the ARRAY nodes set for skipping (capturing the output)';
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
like		$answer[$x], qr/$_/,			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
lives_ok{ 
			$gutenberg->remove_skipped_node( 'ARRAY' ); 
}										"... set 'skip = NO' for future parsed ARRAY refs (test case: $test_case)";
lives_ok{   
			$second_ref = {
				Someotherkey => 'value',
				'Parsing' =>[
					HashRef =>{
						LOGGER =>{
							run => 'INFO',
						},
					},
				],
				Helping =>[
					[
						'Somelevel',
					],
					{
						MyKey =>{
							MiddleKey =>{
								LowerKey1 =>{
									Testkey1 => 'value1',
									Testkey2 => 'value2',
								},
								LowerKey2 => {
									BottomKey1 => '12354',
									BottomKey2 =>[
										'bavalue1',
										'bavalue3',
									],
								},
							},
						},
					},
				],
			};
}   									"Build a second ref for testing (test case $test_case)";
dies_ok{ 
			$gutenberg->print_data( data_ref => $first_ref, );
}										"Test sending the data with a bad key";
like		$@, qr/-print_ref- is a required key but was not found in the passed ref/,
										"Check that the code caught the wrong failure";
ok			$gutenberg->set_match_highlighting( 1 ),
										"Turn on match_highlighting for future testing";
lives_ok{
			$capture = capture_stdout{ $gutenberg->print_data( 
				print_ref => $first_ref,
				match_ref => $second_ref,
			); }
}                                       "Test the non matching state with a match ref sent";
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
lives_ok{ 
			$gutenberg->set_match_highlighting( 0 ); 
}										"... set 'match_highlighting = NO' for future parsed refs (test case: $test_case)";
dies_ok{
			$gutenberg->print_data(
				bad_ref	=>  $first_ref,
				match_ref   =>  $second_ref,
			) 
}										"Send a bad reference with a new request to print";
like		$@, qr/-print_ref- is a required key but was not found in the passed ref/,
										"Test that the error message was found";
lives_ok{
			$capture = capture_stdout{ $gutenberg->print_data(
				print_ref	=>  $first_ref,
				match_ref   =>  $second_ref,
			) }
}                                      "Send the same request with the reference fixed";#~ $x = 0;
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
lives_ok{
			$first_ref = {
				Someotherkey => 'value',
				Parsing => {
					HashRef => {
						LOGGER => {
							run => 'INFO',
						},
					},
				},
				Helping => [
					'Somelevel',
					{
						MyKey => {
							MiddleKey => {
								LowerKey1 => 'lvalue1',
								LowerKey2 => {
									BottomKey1 => 12345,
									BottomKey2 => [
										'bavalue1',
										'bavalue2',
										'bavalue3',
									],
								},
							},
						},
					},
				],
			};
			$second_ref = {
				Someotherkey => 'value',
				Helping => [
					'Somelevel',
					{
						MyKey => {
							MiddleKey => {
								LowerKey1 => 'lvalue1',
								LowerKey2 => {
									BottomKey2 => [
										'bavalue1',
										'bavalue3',
									],
									BottomKey1 => 12354,
								},
							},
						},
					},
				],
			};
}										"A bug fix text case for testing secondary value equivalence (test case $test_case)";
lives_ok{ 
			$gutenberg->set_match_highlighting( 1 ); 
}										"... set 'match_highlighting = YES' for future parsed refs (test case: $test_case)";
lives_ok{
			$capture = capture_stdout{ $gutenberg->print_data(
				print_ref	=>  $first_ref,
				match_ref   =>  $second_ref,
			) }
}										"Send the request to print_data";
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
lives_ok{
			$capture = capture_stdout{ 
				$gutenberg->print_data(
					match_highlighting => 0,
					print_ref => {
						MyArray => [
							undef,
							undef,
							'ValueFive',
						],
					},
				) 
			}
}										"Text a bug fix case for arrays with undef positions using print_data";
			$x = 0;
			@answer = split "\n", $capture;
### <where> - checking the answers for test: $test_case
map{
is			$answer[$x], $_, 			'Test matching line -' . (1 + $x++) . "- of the output for test: $test_case";
}			@{$answer_ref->[$test_case]};
			$test_case++;
explain 								"...Test Done";
done_testing();
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)