# Copyright (c) 2012 Network Appliance, Inc.
# All rights reserved.

## @summary Setup Matcher Library
## @author  Adam.Ciapponi@netapp.com
## @pod     here

=head1 NAME

NACL::Matcher

=head1 DESCRIPTION

This module is a base class for the implementation of RSpec like matchers in perl.  They provide a simple and straightforward interface to
perform comparisons of complex data structures with a minimum of additional code by allowing a developer to
write statements that are more similar to plain english than function calls.

It is not necessary to implement a new Matcher class for each type of comparison you need to make.  Most
common uses such as return value comparison and exception handling are already defined within existing classes.
For information on the basic set of available comparison operators, see L<NACL::Expectation|lib-NACL-Expectation-pm>

NOTE: Matcher is a base class and should never be used to instantiate Matcher objects.  See the following child classes
for more information on available Matcher object types to handle specific types of complex comparisons:

=over

=item L<NACL::Matchers::DeeplyEqualMatcher|lib-NACL-Matchers-DeeplyEqualMatcher-pm>

=item L<NACL::Matchers::EvaluationMatcher|lib-NACL-Matchers-EvaluationMatcher-pm>

=item L<NACL::Matchers::ExceptionMatcher|lib-NACL-Matchers-ExceptionMatcher-pm>

=item L<NACL::Matchers::MockObjectMatcher|lib-NACL-Matchers-MockObjectMatcher-pm>

=item L<NACL::Matchers::MetaMatchers::PeriodicMatcher|lib-NACL-Matchers-MetaMatchers-PeriodicMatcher-pm>

=back

=cut

package NACL::Matcher;

# Compiler directives.
use strict;
use warnings;

# Module import.
use CR::Setup::Constants;
use NACL::MatcherValue;
use Data::Dumper;
use Params::Validate qw(:all);
use NATE::Log qw(log_global);
my $Log = log_global();
my $may_enter = $Log->may_enter();
my $may_exit  = $Log->may_exit();

=head1 METHODS

=head2 new

This is the base constructor for the Matcher class. It is initialized with the expected value and the
custom failure messages for exceptions thrown by the object during comparison operations.

Note that the two failure message methods do not need to be overridden, though it is recommended to
do so if there is any need for specialized error messages.

=cut

my $new_validate_spec = {
    expected => { default => undef },
    failure_message => {
        type => SCALAR,
        default => 'Expected matcher to match but it did not.',
    },
    negative_failure_message => {
        type => SCALAR,
        default => 'Expected matcher not to match but it did.',
    },
};
sub new {
    my %params = validate(
        @{[@_[1..$#_]]},
        $new_validate_spec
    );
    my $self = \%params;
    bless $self, $_[0];
    $self->_set_state_from_matcher_value(
        matcher_value => NACL::MatcherValue->make_matcher_value_if_not_already( value => $params{'expected'} ),
        which_value => 'expected',
    );
    $self;
}

=head2 matches

This method returns a boolean based on whether or not the actual value passed into the matcher matches the expected value.
It is typically overridden in a child class to account for the complex data structures the Matcher object
is used on.

=head3 usage

In order to get the actual value of the MatcherValue, you must use ->value()

See the child classes mentioned above for examples of overridden versions of this method

=cut

sub matches {
    my ( $matcher_value ) = validate_pos(@{[@_[1..$#_]]}, NACL::Matcher::matcher_value_validate_spec());
    $_[0]->_set_state_from_matcher_value( matcher_value => $matcher_value, which_value => 'actual' );
    $TRUE;
}

=head2 failure_message

This method handles the error message returned by the exception thrown when a should statement does not match.

=head3 usage

When overridden, this method is often similar in structure to this method, where the only true difference is in
the output and its formatting.

=cut

sub failure_message {
    validate_pos(@{[@_[1..$#_]]});
    join(
        "\n\n",
        $_[0]->{'failure_message'},
        'Expected:',
        $_[0]->_indent_text(Dumper( $_[0]->{'expected'} )),
        'Actual:',
        $_[0]->_indent_text(Dumper( $_[0]->{'actual'} )),
        '',
    );
}

=head2 negative_failure_message

This method handles the error message returned by the exception thrown when a should_not statement does not match.

=head3 usage

As with the failure_message method above, an overridden version of this method is often very similar except for
the output and its formatting.

=cut

sub negative_failure_message {
    validate_pos(@{[@_[1..$#_]]});
    join(
        "\n\n",
        $_[0]->{'negative_failure_message'},
        'Expected:',
        $_[0]->_indent_text(Dumper( $_[0]->{'expected'} )),
        'Actual:',
        $_[0]->_indent_text(Dumper( $_[0]->{'actual'} )),
        '',
    );
}

=head2 with_property

This function is used for building up the behaviour of the matcher by adding a property to the instance.
It can then be used in a variety of ways, such as passing a Node interface to a Matcher object, or
to perform comparisons against these defined object properties.

=head3 usage

When redefined in a child class, it is typically used as the return value for the new function.  For
example, to create a Node property:

    sub with_node {
        my ( $self, $node ) = @_;
        return $self->with_property( 'node', $node );
    }

=cut

my @with_property_validate_spec = (
    {type => SCALAR},
    $TRUE
);
sub with_property {
    validate_pos(@{[@_[1..$#_]]}, @with_property_validate_spec);
    $_[0]->{$_[1]} = $_[2];
    $_[0];
}

=head2 matcher_stacktrace

Returns the matchers in the matcher stack tracing up to and including this matcher.

=cut

sub matcher_stacktrace {
    validate_pos(@{[@_[1..$#_]]});
    # Deepest is first
    [ $_[0] ];
}

=head2 expected

Returns the expected value.

=cut

sub expected {
    validate_pos(@{[@_[1..$#_]]});
    $_[0]->{'expected'};
}

=head2 actual

Returns the actual value.

=cut

sub actual {
    validate_pos(@{[@_[1..$#_]]});
    $_[0]->{'actual'};
}

=head2 matcher_value_validate_spec

Returns the validation spec for a MatcherValue.

=cut

# No validate spec, this is core and gets used all over
# perl optimizes function calls with static return values
my @matcher_value_validate_spec = (
    { isa => 'NACL::MatcherValue' }
);
sub matcher_value_validate_spec {
    @matcher_value_validate_spec;
}

my $_set_state_from_matcher_value_validate_spec = {
    matcher_value => NACL::Matcher::matcher_value_validate_spec(),
    which_value => { type => SCALAR, regex => qr/^actual|expected$/ },
};
sub _set_state_from_matcher_value {
    my %params = validate(
        @{[@_[1..$#_]]},
        $_set_state_from_matcher_value_validate_spec
    );
    $_[0]->{$params{'which_value'}} = $params{'matcher_value'}->value();
    $_[0]->{$params{'which_value'}};
}

my @_indent_text_validate_spec = (
    { type => SCALAR, default => '' }
);
sub _indent_text {
    validate_pos(@{[@_[1..$#_]]}, @_indent_text_validate_spec);
    "    " . join("\n    ", (split("\n", $_[1])));
}

1;