File Coverage

lib/Log/Shiras/Test2.pm

Criterion	Covered	Total	%
statement	106	138	76.8
branch	17	32	53.1
condition	10	17	58.8
subroutine	21	23	91.3
pod	6	7	85.7
total	160	217	73.7

package Log::Shiras::Test2;
our $AUTHORITY = 'cpan:JANDREW';
use version; our $VERSION = version->declare("v0.48.0");
use strict;
use warnings;
use 5.010;
use utf8;
use lib '../../';
#~ use Log::Shiras::Unhide qw( :InternalLoGShiraSTesT );
###InternalLoGShiraSTesT	warn "You uncovered internal logging statements for Log::Shiras::Test2-$VERSION";
use	Moose;
use MooseX::StrictConstructor;
use	MooseX::HasDefaults::RO;
use Test2::API qw/context/;
use MooseX::Types::Moose qw( RegexpRef Bool ArrayRef );
use Data::Dumper;
use Log::Shiras::Switchboard 0.029;
use Log::Shiras::Types qw( PosInt );

our	$last_buffer_position = 11;# This one goes to eleven :^|

#########1 Public Attributes  3#########4#########5#########6#########7#########8#########9

has keep_matches =>(
    isa     => Bool,
    default => 0,
    writer  => 'set_match_retention',
);

has test_buffer_size =>(
	isa		=> PosInt,
	default	=> sub{ $last_buffer_position },#
	writer	=> 'change_test_buffer_size',
	trigger => \&_set_buffer_size,
);


#########1 Public Methods     3#########4#########5#########6#########7#########8#########9

sub get_buffer{
	my ( $self, $report_name ) = @_;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::get_buffer',
	###InternalLoGShiraSTesT		message =>[ "getting the buffer for: $report_name" ], } );
	my	$buffer_ref = [];
	if( $self->_has_test_buffer( $report_name ) ){
		$buffer_ref = $self->_get_test_buffer( $report_name );
	}
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::get_buffer',
	###InternalLoGShiraSTesT		message =>[ "returning: $buffer_ref" ], } );
	return $buffer_ref;
}

#########1 Test Methods       3#########4#########5#########6#########7#########8#########9

sub clear_buffer{
    my ( $self, $report_name, $test_description ) = @_;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::clear_buffer',
	###InternalLoGShiraSTesT		message =>[ "Reached clear_buffer for  : $report_name" ], } );
	$self->_set_test_buffer( $report_name => [] );
    my $ctx = context();
    $ctx->ok(1, $test_description);
    $ctx->release;
    return $report_name;
}

sub has_buffer{
    my ( $self, $report_name, $expected, $test_description ) = @_;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::has_buffer',
	###InternalLoGShiraSTesT		message =>[ "Reached has_buffer for report: $report_name",
	###InternalLoGShiraSTesT					"........with expected outcome: $expected",
	###InternalLoGShiraSTesT					"..........and primary message: $test_description" ], } );
    my $ctx = context();
	my $result = $self->_has_test_buffer( $report_name );
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::has_buffer',
	###InternalLoGShiraSTesT		message =>[ "resulting in: $result" ], } );
    $ctx->ok( $result == $expected, $test_description);
    if( $result != $expected ){
        if( !$result ){
            $ctx->diag( "Expected to find a buffer for -$report_name- but it didn't exist" );
        }else{
            $ctx->diag( "A buffer for -$report_name- was un-expectedly found" );
        }
    }
    $ctx->release;
    return $report_name;
}

sub buffer_count{
    my ( $self, $report_name, $guess, $test_description ) = @_;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::buffer_count',
	###InternalLoGShiraSTesT		message =>[ "testing the row count loaded in the buffer ...",
	###InternalLoGShiraSTesT					"for       : $report_name",
	###InternalLoGShiraSTesT					"with guess: $guess" ], } );
    my $ctx = context();
    my  $actual_count = scalar( @{$self->get_buffer( $report_name )} );
    $ctx->ok($actual_count == $guess, $test_description);
    if( $actual_count != $guess ){
        $ctx->diag( "Expected -$guess- items in the buffer but found -$actual_count- items" );
    }
    $ctx->release;
    return $report_name;
}

sub match_message{
    my ( $self, $report_name, $line, $test_description ) = @_;
    chomp $line;
	$test_description //= '';
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
	###InternalLoGShiraSTesT		message =>[ "Reached match_output",
	###InternalLoGShiraSTesT					"for             : $report_name",
	###InternalLoGShiraSTesT					"testing line    : $line",
	###InternalLoGShiraSTesT					"with explanation: $test_description" ] } );
    my $ctx = context();
    my $result = 0;
    my @failarray;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
	###InternalLoGShiraSTesT		message =>[ "Check if the buffer exists" ] } );
    if( $self->_has_test_buffer( $report_name ) ){
		###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
		###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
		###InternalLoGShiraSTesT		message =>[ "The buffer exists" ] } );
        my @buffer_list = @{$self->_get_test_buffer( $report_name )};
		###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
		###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
		###InternalLoGShiraSTesT		message =>[ "The buffer list is:", @buffer_list ] } );
        @failarray = (
            'Expected to find: ',  $line,
            "but could not match it to data in -$report_name-..."
        );
        if( !@buffer_list ){
			###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
			###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
			###InternalLoGShiraSTesT		message =>[ "The buffer list is EMPTY!", ] } );
            push @failarray, 'Because the test buffer is EMPTY!';
        }else{
			my $position = 0;
            TESTALL: for my $buffer_message ( @buffer_list ){
				my $buffer_array_ref = $buffer_message->{message};
				###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
				###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
				###InternalLoGShiraSTesT		message =>[ "testing line:", $buffer_array_ref, ] } );
				for my $ref_element ( @$buffer_array_ref ){
					if( !$ref_element or length( $ref_element ) == 0 ){
						###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
						###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
						###InternalLoGShiraSTesT		message =>[ "Nothing to match in this message", ] } );
					}elsif( ( is_RegexpRef( $line ) and $ref_element =~ $line ) or
							( $ref_element eq $line )           					){
						###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
						###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
						###InternalLoGShiraSTesT		message =>[ "Found a match!", ] } );
						splice( @buffer_list, $position, 1 ) if !$self->keep_matches;
						$result = 1;
						last TESTALL;
					}else{
						###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
						###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
						###InternalLoGShiraSTesT		message =>[ "No Match Here", ] } );
						push @failarray, "---" . Dumper( $ref_element );
					}
				}
				$position++;
            }
        }
		###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
		###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
		###InternalLoGShiraSTesT		message =>[ "The match test result is: $result", ] } );
        if( $result ){
			###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
			###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
			###InternalLoGShiraSTesT		message =>[ "Reloading the updated buffer", ] } );
            $self->_set_test_buffer( $report_name => [@buffer_list] );
			###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
			###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
			###InternalLoGShiraSTesT		message =>[ "Updates complete", ] } );
        }
    } else {
		my $message = "The master test buffer does not contain: $report_name";
		###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
		###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
		###InternalLoGShiraSTesT		message =>[  $message ], } );
        @failarray = ( $message );
    }
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::match_message',
	###InternalLoGShiraSTesT		message =>[ "passing result to Test2::API: $result" ], } );
    $ctx->ok($result, $test_description);
    if( !$result ) {
        map{ $ctx->diag( $_ ) } @failarray;
		$report_name = 0;
    }
    $ctx->release;
	return $report_name;
}

sub cant_match_message{
    my ( $self, $report_name, $line, $test_description ) = @_;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
	###InternalLoGShiraSTesT		message =>[ "Reached cant_match_output",
	###InternalLoGShiraSTesT					"for             : $report_name",
	###InternalLoGShiraSTesT					"testing line    : $line",
	###InternalLoGShiraSTesT					"with explanation: $test_description" ] } );
    my $ctx    = context();
    my $result = 1;
    my $i      = 0;
    my @failarray;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
	###InternalLoGShiraSTesT		message =>[ "Checking if the buffer exists" ] } );
    if( $self->_has_test_buffer( $report_name ) ){
		###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
		###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
		###InternalLoGShiraSTesT		message =>[ "The buffer exists" ] } );
        my @buffer_list = @{$self->_get_test_buffer( $report_name )};
		###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
		###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
		###InternalLoGShiraSTesT		message =>[ "The buffer list is:", @buffer_list ] } );
        TESTMISS: for my $test_line ( @buffer_list) {
			$test_line = $test_line->{message};
			###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
			###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
			###InternalLoGShiraSTesT		message =>[ "testing line:", $test_line, ] } );
			if( is_ArrayRef( $test_line ) ){
				###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
				###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
				###InternalLoGShiraSTesT		message =>[ "Message line already an ArrayRef - do nothing", ] } );
			}else{
				###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
				###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
				###InternalLoGShiraSTesT		message =>[ "Making the buffer line an ArrayRef", ] } );
				$test_line = [ $test_line ];
			}
			for my $ref_element ( @$test_line ){
				if( ( is_RegexpRef( $line ) and $ref_element =~ $line ) or
					( $ref_element eq $line )           					){
					###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
					###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
					###InternalLoGShiraSTesT		message =>[ "Found a match! (BAD)", ] } );
					$result = 0;
					push @failarray, (
							"For the -$report_name- buffer a no match condition was desired",
							"for the for the test -$line-",
							"a match was found at position -$i-",
							"(The line was not removed from the buffer!)"
						);
					last TESTMISS;
					$result = 1;
				}else{
					###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
					###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
					###InternalLoGShiraSTesT		message =>[ "No Match For: $ref_element", ] } );
					$i++;
				}
			}
        }
        if( $result ) {
			###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
			###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
			###InternalLoGShiraSTesT		message =>[ "Test buffer exists but the line was not found in: $report_name", ] } );
        }
    } else {
		###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 1,
		###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::cant_match_message',
		###InternalLoGShiraSTesT		message =>[ "Pass! no buffer found ...", ] } );
    }
    $ctx->ok($result, $test_description);
    if( !$result ) {
        map{ $ctx->diag( $_ ) } @failarray;
		$report_name = 0;
    }
    $ctx->release;
	return $report_name;
}

#########1 Private Attributes 3#########4#########5#########6#########7#########8#########9

has _switchboard_link =>(# Use methods from the Switchboard singleton
	isa		=> 'Log::Shiras::Switchboard',
	reader	=> '_get_switchboard',
	handles =>[ qw(
		_has_test_buffer	_get_test_buffer	_set_test_buffer
		master_talk			_clear_all_test_buffers
	) ],
	default	=> sub{ Log::Shiras::Switchboard->get_operator(); },
);

#########1 Private Methods    3#########4#########5#########6#########7#########8#########9

after 'change_test_buffer_size' => \&_set_buffer_size;

sub _set_buffer_size{
	my ( $self, $new_size ) = @_;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 0,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::_set_buffer_size',
	###InternalLoGShiraSTesT		message =>[ "setting the new test buffer size to: $new_size" ], } );
	$last_buffer_position = $new_size;
}

sub DEMOLISH{
	my ( $self, ) = @_;
	###InternalLoGShiraSTesT	$self->master_talk( { report => 'log_file', level => 3,
	###InternalLoGShiraSTesT		name_space => 'Log::Shiras::Switchboard::DEMOLISH',
	###InternalLoGShiraSTesT		message =>[ "clearing ALL the test buffers" ], } );
	$self->_clear_all_test_buffers;
}

#########1 Phinish            3#########4#########5#########6#########7#########8#########9

no Moose;
__PACKAGE__->meta->make_immutable;

1;
# The preceding line will help the module return a true value

#########1 main pod docs      3#########4#########5#########6#########7#########8#########9
__END__

=head1 NAME

Log::Shiras::Test2 - Test2 for traffic in the ::Switchboard

=head1 SYNOPSIS

	use Test2::Bundle::Extended qw( !meta );
	use Test2::Plugin::UTF8;
	use Test::Log::Shiras;
	plan( 3 );

	~~ Set up the Log::Shiras::Switchboard operator here ($ella_peterson) ~~

	my $test_class;
	ok( lives{	$test_class = Log::Shiras::Test2->new },
											"Build a test class for reading messages from the bat phone" ) or note($@);;
	ok( lives{
				$ella_peterson->master_talk({ # Use Ella Petersons bat phone
					name_space => 'main', report => 'report1', level => 'eleven',
					message =>[ 'Hello World' ], });
	},										"Test making a call (with Ella Petersons bat phone)" ) or note($@);
	$test_class->match_message( 'report1', "Hello World",
											"... and check the output" );

=head1 DESCRIPTION

This is a class used for testing.  It inherits directly from L<Test2::API> without going through
Test::Builder.  This will feed back to any Test2 rooted test with the understanding that even
Test::More now uses Test2 Under the hood.  The tests are object oriented methods rather than
functions.  That was a conscious choice in order to auto link to the singleton once without
re-connecting over and over.  The goal is to be able to set up messages to the switchboard with
minimum wiring to the reports and still be able to see if the messages are working as expected.
Log::Shiras::Switchboard will actually check if this module is active and store messages to a test
buffer right before sending them to the reports.  This allows the reports to exist in name only
and to still test permissions levels and caller actions without using L<Capture::Tiny> or reading
output files for test results.

=head2 Attributes

These are things that can be passed to the ->new argument in order to change the general behavior
of the test instance.

=head3 keep_matches

=over

B<Description:> This determines whether a match is deleted from the test buffer when it is matched
by the test L<match_message|/match_message( $report, $test_line, $message )>.

B<Range:> accepts a boolean value

B<Default:> 1 = yes, matches are deleted when found

B<attribute methods:>

=over

B<set_match_retention( $bool )>

=over

B<Description:> Changes the keep_matches attribute setting to the passed $bool

=back

=back

=back

=head3 test_buffer_size

=over

B<Description:> This attribute attempts to mirror L<$Test::Log::Shiras::last_buffer_position
|/$Test::Log::Shiras::last_buffer_position>.  If you set it upon instantiation of an instance of this
class then it will change the global variable too.

B<Range:> accepts a positive integer

B<Default:> 11 this starts at eleven

B<attribute methods:>

=over

B<change_test_buffer_size( $int )>

=over

B<Definition:> This will change the maximum test buffer size.  If the target buffer size is
reduced greater than the current buffer contents the size will not be resolved until the next
message is sent to the buffer.

=back

=back

=back

=head2 Methods

These are not tests!

=head3 get_buffer( $report )

=over

B<Definition:> This will return the full test buffer for a given report.  It should be noted
that messages are stored with metadata.  Active buffers are not an ArrayRef of strings.

B<Accepts:> The target $report name

B<Returns:> An ArrayRef of HashRefs

=back

=head2 Tests

All tests here are written as methods on an object not exportable functions.  As such they
are implemented in the following fashion.

	my $tester = Test::Log::Shiras->new;
	$tester->match_message( $report, $wanted, $message );

=head3 clear_buffer( $report, $message )

=over

B<Definition:> This test will clear the buffer.  It always passes.

B<Accepts:> The target $report name string to clear and the $message to append to the test report.

B<Returns:> The cleared test name_space

=back

=head3 has_buffer( $report, $expected, $message )

=over

B<Definition:> This test checks to see if there is a test buffer for the $report name.  It allows
for testing a buffer existence whether the buffer is $expected to exist or not.

B<Accepts:> The target $report name string to check and whether you $expected to find the buffer or not.
It also accepts the $message used for test result reporting.

B<Returns:> The tested report buffer name

=back

=head3 buffer_count( $report, $expected, $message )

=over

B<Definition:> This test checks a known buffer to see how many records it contains.  It will compare that
to how many records are $expected.  The buffer count will mostly never exceed the L<mandated max
|/$Test::Log::Shiras::last_buffer_position> buffer size.

B<Accepts:> The target $report name string to check and how many records were $expected in the buffer.
It also accepts the $message used for test result reporting.

B<Returns:> The tested report buffer name

=back

=head3 match_message( $report, $test_line, $message )

=over

B<Definition:> This test checks if a $test_line exists in any of the message elements in the test buffer.
The message elements take the following relevant format.

	$message->{message} =>[ $compare_line1, $compare_line2, etc. ]

$compare_line1 and $compare_line2 are the elements tested.  If $test_line is a RegexpRef then it will
do a regex compare otherwise it does an exact string 'eq' compare.  If there is a match the test will
splice out the message from the buffer so It won't show up again unless you re-send it to the buffer.
This behavior can be changed with the attribute L<keep_matches|/keep_matches>.

B<Accepts:> The target $report name string a $test_line [or regex] to check with.  It also accepts the
$message used for test result reporting.

B<Returns:> The tested report buffer name

=back

=head3 cant_match_message( $report, $test_line, $message )

=over

B<Definition:> This test checks all messages in a buffer to see if a $test_line exists in any of the
message elements.  The message elements take the following relevant format.

	$message->{message} =>[ $compare_line1, $compare_line2, etc. ]

$compare_line1 and $compare_line2 are the elements tested.  If $test_line is a RegexpRef then it will
do a regex compare otherwise it does an exact string 'eq' compare.  Even if there is a match the buffer
remains un-edited but the test fails.

B<Accepts:> The target $report name string a $test_line [or regex] to check with.  It also accepts the
$message used for test result reporting.

B<Returns:> The tested report buffer name

=back

=head2 GLOBAL VARIABLES

=over

B<$Test::Log::Shiras::last_buffer_position>

=over

In order to not have memory issues with long running tests that accumulate buffers without
flushing there is a global variable for the max items in the test buffer.  The actual test
buffer is not stored here but rather in the L<Switchboard|Log::Shiras::Switchboard> in
order to leverage the Singleton there.  The default value is 11 (Store to 11).  So if you
want to do a lot of work and then check if a message was processed early on then you need
to increase this value (equivalent to max buffer size).  Internal to the instance it is
best to change the max buffer using the attribute L<test_buffer_size|/test_buffer_size>
and it's method.

=back

=back

=head1 SUPPORT

=over

=item L<github Log-Shiras/issues|https://github.com/jandrew/Log-Shiras/issues>

=back

=head1 TODO

=over

B<1.> Nothing yet

=back

=head1 AUTHOR

=over

=item Jed Lund

=item [e-mail]

=back

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

This software is copyrighted (c) 2012, 2016 by Jed Lund.

=head1 DEPENDANCIES

=over

L<version> - 0.77

L<5.010|http://perldoc.perl.org/perl5100delta.html> (for use of
L<defined or|http://perldoc.perl.org/perlop.html#Logical-Defined-Or> //)

L<utf8>

L<Moose>

L<MooseX::StrictConstructor>

L<MooseX::HasDefaults::RO>

L<Test2::API> - context

L<MooseX::Types::Moose> - RegexpRef Bool ArrayRef

L<Log::Shiras::Switchboard> - 0.029

L<Log::Shiras::Types>

=back

=head1 SEE ALSO

=over

L<Log::Log4perl::Appender::TestBuffer>

L<Log::Log4perl::Appender::TestArrayBuffer>

=back

=cut

#################### <where> - main pod documentation end ###################