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

our $VERSION = '0.000162';

use Carp qw/croak/;
use Test2::Util::Ref qw/rtype/;

BEGIN {
    if (eval {
        no warnings 'deprecated';
        require Module::Pluggable;
        1;
    }) {
        Module::Pluggable-&gt;import(search_path =&gt; ['Test2::EventFacet'], require =&gt; 1);
    }
    else {
        require Test2::EventFacet::About;
        require Test2::EventFacet::Amnesty;
        require Test2::EventFacet::Assert;
        require Test2::EventFacet::Control;
        require Test2::EventFacet::Error;
        require Test2::EventFacet::Hub;
        require Test2::EventFacet::Info;
        require Test2::EventFacet::Info::Table;
        require Test2::EventFacet::Meta;
        require Test2::EventFacet::Parent;
        require Test2::EventFacet::Plan;
        require Test2::EventFacet::Render;
        require Test2::EventFacet::Trace;

        *plugins = sub {
            return (
                'Test2::EventFacet::About',
                'Test2::EventFacet::Amnesty',
                'Test2::EventFacet::Assert',
                'Test2::EventFacet::Control',
                'Test2::EventFacet::Error',
                'Test2::EventFacet::Hub',
                'Test2::EventFacet::Info',
                'Test2::EventFacet::Info::Table',
                'Test2::EventFacet::Meta',
                'Test2::EventFacet::Parent',
                'Test2::EventFacet::Plan',
                'Test2::EventFacet::Render',
                'Test2::EventFacet::Trace',
            );
        };
    }
}

use Test2::Util::Importer 'Test2::Util::Importer' =&gt; 'import';

our @EXPORT_OK = qw{
    facets
    filter_events
    event_groups
};

my %TYPES;
for my $class (__PACKAGE__-&gt;plugins) {
    my $type = $class;
    $type =~ s/^Test2::EventFacet:://g;

    next unless $class-&gt;isa('Test2::EventFacet');
    my $key;
    $key = $class-&gt;facet_key if $class-&gt;can('facet_key');
    $key = lc($type) unless defined $key;

    $TYPES{$type}     = $class;
    $TYPES{lc($type)} = $class;
    $TYPES{$key}      = $class;
}

sub filter_events {
    my $events = shift;

    my @match = map { rtype($_) eq 'REGEXP' ? $_ : qr/^\Q$_\E::/} @_;

    my @out;
    for my $e (@$events) {
        my $trace = $e-&gt;facet_data-&gt;{trace} or next;
        next unless grep { $trace-&gt;{frame}-&gt;[3] =~ $_ } @match;
        push @out =&gt; $e;
    }

    return \@out;
}

sub event_groups {
    my $events = shift;

    my $out = {};
    for my $e (@$events) {
        my $trace = $e-&gt;facet_data-&gt;{trace};
        my $tool = ($trace &amp;&amp; $trace-&gt;{frame} &amp;&amp; $trace-&gt;{frame}-&gt;[3]) ? $trace-&gt;{frame}-&gt;[3] : undef;

        unless ($tool) {
            push @{$out-&gt;{__NA__}} =&gt; $e;
            next;
        }

        my ($pkg, $sub) = ($tool =~ m/^(.*)(?:::|')([^:']+)$/);

        push @{$out-&gt;{$pkg}-&gt;{$sub}} =&gt; $e;
        push @{$out-&gt;{$pkg}-&gt;{__ALL__}} =&gt; $e;
    }

    return $out;
}

sub facets {
    my ($type, $events) = @_;

    my ($key, $is_list);
    my $class = $TYPES{$type};
    if ($class) {
        $key = $class-&gt;facet_key || lc($type);
        $is_list = $class-&gt;is_list;
    }
    else {
        $key = lc($type);
    }

    my @out;
    for my $e (@$events) {
        my $fd = $e-&gt;facet_data;
        my $f  = $fd-&gt;{$key} or next;

        my $list = defined($is_list) ? $is_list : rtype($f) eq 'ARRAY';

        if ($list) {
            push @out =&gt; map { $class ? $class-&gt;new($_) : $_ } @$f;
        }
        else {
            push @out =&gt; $class ? $class-&gt;new($f) : $f;
        }
    }

    return \@out;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Tools::Tester - Tools to help you test other testing tools.

=head1 DESCRIPTION

This is a collection of tools that are useful when testing other test tools.

=head1 SYNOPSIS

    use Test2::Tools::Tester qw/event_groups filter_events facets/;

    use Test2::Tools::Basic qw/plan pass ok/;
    use Test2::Tools::Compare qw/is like/;

    my $events = intercept {
        plan 11;

        pass('pass');
        ok(1, 'pass');

        is(1, 1, "pass");
        like(1, 1, "pass");
    };

    # Grab events generated by tools in Test2::Tools::Basic
    my $basic = filter $events =&gt; 'Test2::Tools::Basic';

    # Grab events generated by Test2::Tools::Basic;
    my $compare = filter $events =&gt; 'Test2::Tools::Compare';

    # Grab events generated by tools named 'ok'.
    my $oks = filter $events =&gt; qr/.*::ok$/;

    my $grouped = group_events $events;
    # Breaks events into this structure:
    {
        '__NA__' =&gt; [ ... ],
        'Test2::Tools::Basic' =&gt; {
            '__ALL__' =&gt; [ $events-&gt;[0], $events-&gt;[1], $events-&gt;[2] ],
            plan =&gt; [ $events-&gt;[0] ],
            pass =&gt; [ $events-&gt;[1] ],
            ok =&gt; [ $events-&gt;[2] ],
        },
        Test2::Tools::Compare =&gt; { ... },
    }

    # Get an arrayref of all the assert facets from the list of events.
    my $assert_facets = facets assert =&gt; $events;
    # [
    #   bless({ details =&gt; 'pass', pass =&gt; 1}, 'Test2::EventFacet::Assert'),
    #   bless({ details =&gt; 'pass', pass =&gt; 1}, 'Test2::EventFacet::Assert'),
    # ]

    # Same, but for info facets
    my $info_facets = facets info =&gt; $events;

=head1 EXPORTS

No subs are exported by default.

=over 4

=item $array_ref = filter $events =&gt; $PACKAGE

=item $array_ref = filter $events =&gt; $PACKAGE1, $PACKAGE2

=item $array_ref = filter $events =&gt; qr/match/

=item $array_ref = filter $events =&gt; qr/match/, $PACKAGE

This function takes an arrayref of events as the first argument. All additional
arguments must either be a package name, or a regex. Any event that is
generated by a tool in any of the package, or by a tool that matches any of the
regexes, will be returned in an arrayref.

=item $grouped = group_events($events)

This function iterates all the events in the argument arrayref and splits them
into groups. The resulting data structure is:

    { PACKAGE =&gt; { SUBNAME =&gt; [ $EVENT1, $EVENT2, ... }}

If the package of an event is not known it will be put into and arrayref under
the '__NA__' key at the root of the structure. If a sub name is not known it
will typically go under the '__ANON__' key in under the package name.

In addition there is an '__ALL__' key under each package which stores all of
the events sorted into that group.

A more complete example:

    {
        '__NA__' =&gt; [ $event-&gt;[3] ],
        'Test2::Tools::Basic' =&gt; {
            '__ALL__' =&gt; [ $events-&gt;[0], $events-&gt;[1], $events-&gt;[2] ],
            plan =&gt; [ $events-&gt;[0] ],
            pass =&gt; [ $events-&gt;[1] ],
            ok =&gt; [ $events-&gt;[2] ],
        },
    }

=item $arrayref = facets TYPE =&gt; $events

This function will compile a list of all facets of the specified type that are
found in the arrayref of events. If the facet has a C&lt;Test2::EventFacet::TYPE&gt;
package available then the facet will be constructed into an instance of the
class, otherwise it is left as a hashref. Facet Order is preserved.

    my $assert_facets = facets assert =&gt; $events;
    # [
    #   bless({ details =&gt; 'pass', pass =&gt; 1}, 'Test2::EventFacet::Assert'),
    #   bless({ details =&gt; 'pass', pass =&gt; 1}, 'Test2::EventFacet::Assert'),
    # ]

=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;

=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>