<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Test2::Compare::Custom;
use strict;
use warnings;

use base 'Test2::Compare::Base';

our $VERSION = '0.000162';

use Test2::Util::HashBase qw/code name operator stringify_got/;

use Carp qw/croak/;

sub init {
    my $self = shift;

    croak "'code' is required" unless $self-&gt;{+CODE};

    $self-&gt;{+OPERATOR} ||= 'CODE(...)';
    $self-&gt;{+NAME}     ||= '&lt;Custom Code&gt;';
    $self-&gt;{+STRINGIFY_GOT} = $self-&gt;SUPER::stringify_got()
      unless defined $self-&gt;{+STRINGIFY_GOT};

    $self-&gt;SUPER::init();
}

sub verify {
    my $self = shift;
    my %params = @_;
    my ($got, $exists) = @params{qw/got exists/};

    my $code = $self-&gt;{+CODE};

    local $_ = $got;
    my $ok = $code-&gt;(
        got      =&gt; $got,
        exists   =&gt; $exists,
        operator =&gt; $self-&gt;{+OPERATOR},
        name     =&gt; $self-&gt;{+NAME},
    );

    return $ok;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Compare::Custom - Custom field check for comparisons.

=head1 DESCRIPTION

Sometimes you want to do something complicated or unusual when validating a
field nested inside a deep data structure. You could pull it out of the
structure and test it separately, or you can use this to embed the check. This
provides a way for you to write custom checks for fields in deep comparisons.

=head1 SYNOPSIS

    my $cus = Test2::Compare::Custom-&gt;new(
        name =&gt; 'IsRef',
        operator =&gt; 'ref(...)',
        stringify_got =&gt; 1,
        code =&gt; sub {
            my %args = @_;
            return $args{got} ? 1 : 0;
        },
    );

    # Pass
    is(
        { a =&gt; 1, ref =&gt; {},   b =&gt; 2 },
        { a =&gt; 1, ref =&gt; $cus, b =&gt; 2 },
        "This will pass"
    );

    # Fail
    is(
        {a =&gt; 1, ref =&gt; 'notref', b =&gt; 2},
        {a =&gt; 1, ref =&gt; $cus,     b =&gt; 2},
        "This will fail"
    );

=head1 ARGUMENTS

Your custom sub will be passed 4 arguments in a hash:

    code =&gt; sub {
        my %args = @_;
        # provides got, exists, operator, name
        return ref($args{got}) ? 1 : 0;
    },

C&lt;$_&gt; is also localized to C&lt;got&gt; to make it easier for those who need to use
regexes.

=over 4

=item got

=item $_

The value to be checked.

=item exists

This will be a boolean. This will be true if C&lt;got&gt; exists at all. If
C&lt;exists&gt; is false then it means C&lt;got&gt; is not simply undef, but doesn't
exist at all (think checking the value of a hash key that does not exist).

=item operator

The operator specified at construction.

=item name

The name provided at construction.

=back

=head1 METHODS

=over 4

=item $code = $cus-&gt;code

Returns the coderef provided at construction.

=item $name = $cus-&gt;name

Returns the name provided at construction.

=item $op = $cus-&gt;operator

Returns the operator provided at construction.

=item $stringify = $cus-&gt;stringify_got

Returns the stringify_got flag provided at construction.

=item $bool = $cus-&gt;verify(got =&gt; $got, exists =&gt; $bool)

=back

=head1 SOURCE

The source code repository for Test2-Suite can be found at
F&lt;https://github.com/Test-More/Test2-Suite/&gt;.

=head1 MAINTAINERS

=over 4

=item Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;

=back

=head1 AUTHORS

=over 4

=item Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;

=item Daniel BÃ¶hmer E&lt;lt&gt;dboehmer@cpan.orgE&lt;gt&gt;

=back

=head1 COPYRIGHT

Copyright 2018 Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;.

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

See F&lt;http://dev.perl.org/licenses/&gt;

=cut
</pre></body></html>