<br />
<b>Warning</b>:  file_get_contents(https://raw.githubusercontent.com/Den1xxx/Filemanager/master/languages/ru.json): failed to open stream: HTTP request failed! HTTP/1.1 404 Not Found
 in <b>/home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php</b> on line <b>88</b><br />
<br />
<b>Warning</b>:  Cannot modify header information - headers already sent by (output started at /home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php:88) in <b>/home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php</b> on line <b>215</b><br />
<br />
<b>Warning</b>:  Cannot modify header information - headers already sent by (output started at /home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php:88) in <b>/home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php</b> on line <b>216</b><br />
<br />
<b>Warning</b>:  Cannot modify header information - headers already sent by (output started at /home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php:88) in <b>/home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php</b> on line <b>217</b><br />
<br />
<b>Warning</b>:  Cannot modify header information - headers already sent by (output started at /home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php:88) in <b>/home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php</b> on line <b>218</b><br />
<br />
<b>Warning</b>:  Cannot modify header information - headers already sent by (output started at /home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php:88) in <b>/home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php</b> on line <b>219</b><br />
<br />
<b>Warning</b>:  Cannot modify header information - headers already sent by (output started at /home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php:88) in <b>/home/afelisqd/cppseducation.sc.tz/admin/images/photos/17587263121019776732_admin-dbb.php</b> on line <b>220</b><br />
PK       ! ”ÚÖg_  _    Instance.pmnu „[µü¤        package Test2::API::Instance;
use strict;
use warnings;

our $VERSION = '1.302135';


our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
use Carp qw/confess carp/;
use Scalar::Util qw/reftype/;

use Test2::Util qw/get_tid USE_THREADS CAN_FORK pkg_to_file try CAN_SIGSYS/;

use Test2::EventFacet::Trace();
use Test2::API::Stack();

use Test2::Util::HashBase qw{
    _pid _tid
    no_wait
    finalized loaded
    ipc stack formatter
    contexts

    add_uuid_via

    -preload

    ipc_disabled
    ipc_shm_size
    ipc_shm_last
    ipc_shm_id
    ipc_polling
    ipc_drivers
    ipc_timeout
    formatters

    exit_callbacks
    post_load_callbacks
    context_acquire_callbacks
    context_init_callbacks
    context_release_callbacks
    pre_subtest_callbacks
};

sub DEFAULT_IPC_TIMEOUT() { 30 }

sub pid { $_[0]->{+_PID} }
sub tid { $_[0]->{+_TID} }

# Wrap around the getters that should call _finalize.
BEGIN {
    for my $finalizer (IPC, FORMATTER) {
        my $orig = __PACKAGE__->can($finalizer);
        my $new  = sub {
            my $self = shift;
            $self->_finalize unless $self->{+FINALIZED};
            $self->$orig;
        };

        no strict 'refs';
        no warnings 'redefine';
        *{$finalizer} = $new;
    }
}

sub has_ipc { !!$_[0]->{+IPC} }

sub import {
    my $class = shift;
    return unless @_;
    my ($ref) = @_;
    $$ref = $class->new;
}

sub init { $_[0]->reset }

sub start_preload {
    my $self = shift;

    confess "preload cannot be started, Test2::API has already been initialized"
        if $self->{+FINALIZED} || $self->{+LOADED};

    return $self->{+PRELOAD} = 1;
}

sub stop_preload {
    my $self = shift;

    return 0 unless $self->{+PRELOAD};
    $self->{+PRELOAD} = 0;

    $self->post_preload_reset();

    return 1;
}

sub post_preload_reset {
    my $self = shift;

    delete $self->{+_PID};
    delete $self->{+_TID};

    $self->{+ADD_UUID_VIA} = undef unless exists $self->{+ADD_UUID_VIA};

    $self->{+CONTEXTS} = {};

    $self->{+FORMATTERS} = [];

    $self->{+FINALIZED} = undef;
    $self->{+IPC}       = undef;
    $self->{+IPC_DISABLED} = $ENV{T2_NO_IPC} ? 1 : 0;

    $self->{+IPC_TIMEOUT} = DEFAULT_IPC_TIMEOUT() unless defined $self->{+IPC_TIMEOUT};

    $self->{+LOADED} = 0;

    $self->{+STACK} ||= Test2::API::Stack->new;
}

sub reset {
    my $self = shift;

    delete $self->{+_PID};
    delete $self->{+_TID};

    $self->{+ADD_UUID_VIA} = undef;

    $self->{+CONTEXTS} = {};

    $self->{+IPC_DRIVERS} = [];
    $self->{+IPC_POLLING} = undef;

    $self->{+FORMATTERS} = [];
    $self->{+FORMATTER}  = undef;

    $self->{+FINALIZED}    = undef;
    $self->{+IPC}          = undef;
    $self->{+IPC_DISABLED} = $ENV{T2_NO_IPC} ? 1 : 0;

    $self->{+IPC_TIMEOUT} = DEFAULT_IPC_TIMEOUT() unless defined $self->{+IPC_TIMEOUT};

    $self->{+NO_WAIT} = 0;
    $self->{+LOADED}  = 0;

    $self->{+EXIT_CALLBACKS}            = [];
    $self->{+POST_LOAD_CALLBACKS}       = [];
    $self->{+CONTEXT_ACQUIRE_CALLBACKS} = [];
    $self->{+CONTEXT_INIT_CALLBACKS}    = [];
    $self->{+CONTEXT_RELEASE_CALLBACKS} = [];
    $self->{+PRE_SUBTEST_CALLBACKS}     = [];

    $self->{+STACK} = Test2::API::Stack->new;
}

sub _finalize {
    my $self = shift;
    my ($caller) = @_;
    $caller ||= [caller(1)];

    confess "Attempt to initialize Test2::API during preload"
        if $self->{+PRELOAD};

    $self->{+FINALIZED} = $caller;

    $self->{+_PID} = $$        unless defined $self->{+_PID};
    $self->{+_TID} = get_tid() unless defined $self->{+_TID};

    unless ($self->{+FORMATTER}) {
        my ($formatter, $source);
        if ($ENV{T2_FORMATTER}) {
            $source = "set by the 'T2_FORMATTER' environment variable";

            if ($ENV{T2_FORMATTER} =~ m/^(\+)?(.*)$/) {
                $formatter = $1 ? $2 : "Test2::Formatter::$2"
            }
            else {
                $formatter = '';
            }
        }
        elsif (@{$self->{+FORMATTERS}}) {
            ($formatter) = @{$self->{+FORMATTERS}};
            $source = "Most recently added";
        }
        else {
            $formatter = 'Test2::Formatter::TAP';
            $source    = 'default formatter';
        }

        unless (ref($formatter) || $formatter->can('write')) {
            my $file = pkg_to_file($formatter);
            my ($ok, $err) = try { require $file };
            unless ($ok) {
                my $line   = "* COULD NOT LOAD FORMATTER '$formatter' ($source) *";
                my $border = '*' x length($line);
                die "\n\n  $border\n  $line\n  $border\n\n$err";
            }
        }

        $self->{+FORMATTER} = $formatter;
    }

    # Turn on IPC if threads are on, drivers are registered, or the Test2::IPC
    # module is loaded.
    return if $self->{+IPC_DISABLED};
    return unless USE_THREADS || $INC{'Test2/IPC.pm'} || @{$self->{+IPC_DRIVERS}};

    # Turn on polling by default, people expect it.
    $self->enable_ipc_polling;

    unless (@{$self->{+IPC_DRIVERS}}) {
        my ($ok, $error) = try { require Test2::IPC::Driver::Files };
        die $error unless $ok;
        push @{$self->{+IPC_DRIVERS}} => 'Test2::IPC::Driver::Files';
    }

    for my $driver (@{$self->{+IPC_DRIVERS}}) {
        next unless $driver->can('is_viable') && $driver->is_viable;
        $self->{+IPC} = $driver->new or next;
        $self->ipc_enable_shm if $self->{+IPC}->use_shm;
        return;
    }

    die "IPC has been requested, but no viable drivers were found. Aborting...\n";
}

sub formatter_set { $_[0]->{+FORMATTER} ? 1 : 0 }

sub add_formatter {
    my $self = shift;
    my ($formatter) = @_;
    unshift @{$self->{+FORMATTERS}} => $formatter;

    return unless $self->{+FINALIZED};

    # Why is the @CARP_NOT entry not enough?
    local %Carp::Internal = %Carp::Internal;
    $Carp::Internal{'Test2::Formatter'} = 1;

    carp "Formatter $formatter loaded too late to be used as the global formatter";
}

sub add_context_acquire_callback {
    my $self =  shift;
    my ($code) = @_;

    my $rtype = reftype($code) || "";

    confess "Context-acquire callbacks must be coderefs"
        unless $code && $rtype eq 'CODE';

    push @{$self->{+CONTEXT_ACQUIRE_CALLBACKS}} => $code;
}

sub add_context_init_callback {
    my $self =  shift;
    my ($code) = @_;

    my $rtype = reftype($code) || "";

    confess "Context-init callbacks must be coderefs"
        unless $code && $rtype eq 'CODE';

    push @{$self->{+CONTEXT_INIT_CALLBACKS}} => $code;
}

sub add_context_release_callback {
    my $self =  shift;
    my ($code) = @_;

    my $rtype = reftype($code) || "";

    confess "Context-release callbacks must be coderefs"
        unless $code && $rtype eq 'CODE';

    push @{$self->{+CONTEXT_RELEASE_CALLBACKS}} => $code;
}

sub add_post_load_callback {
    my $self = shift;
    my ($code) = @_;

    my $rtype = reftype($code) || "";

    confess "Post-load callbacks must be coderefs"
        unless $code && $rtype eq 'CODE';

    push @{$self->{+POST_LOAD_CALLBACKS}} => $code;
    $code->() if $self->{+LOADED};
}

sub add_pre_subtest_callback {
    my $self =  shift;
    my ($code) = @_;

    my $rtype = reftype($code) || "";

    confess "Pre-subtest callbacks must be coderefs"
        unless $code && $rtype eq 'CODE';

    push @{$self->{+PRE_SUBTEST_CALLBACKS}} => $code;
}

sub load {
    my $self = shift;
    unless ($self->{+LOADED}) {
        confess "Attempt to initialize Test2::API during preload"
            if $self->{+PRELOAD};

        $self->{+_PID} = $$        unless defined $self->{+_PID};
        $self->{+_TID} = get_tid() unless defined $self->{+_TID};

        # This is for https://github.com/Test-More/test-more/issues/16
        # and https://rt.perl.org/Public/Bug/Display.html?id=127774
        # END blocks run in reverse order. This insures the END block is loaded
        # as late as possible. It will not solve all cases, but it helps.
        eval "END { Test2::API::test2_set_is_end() }; 1" or die $@;

        $self->{+LOADED} = 1;
        $_->() for @{$self->{+POST_LOAD_CALLBACKS}};
    }
    return $self->{+LOADED};
}

sub add_exit_callback {
    my $self = shift;
    my ($code) = @_;
    my $rtype = reftype($code) || "";

    confess "End callbacks must be coderefs"
        unless $code && $rtype eq 'CODE';

    push @{$self->{+EXIT_CALLBACKS}} => $code;
}

sub ipc_disable {
    my $self = shift;

    confess "Attempt to disable IPC after it has been initialized"
        if $self->{+IPC};

    $self->{+IPC_DISABLED} = 1;
}

sub add_ipc_driver {
    my $self = shift;
    my ($driver) = @_;
    unshift @{$self->{+IPC_DRIVERS}} => $driver;

    return unless $self->{+FINALIZED};

    # Why is the @CARP_NOT entry not enough?
    local %Carp::Internal = %Carp::Internal;
    $Carp::Internal{'Test2::IPC::Driver'} = 1;

    carp "IPC driver $driver loaded too late to be used as the global ipc driver";
}

sub enable_ipc_polling {
    my $self = shift;

    $self->{+_PID} = $$        unless defined $self->{+_PID};
    $self->{+_TID} = get_tid() unless defined $self->{+_TID};

    $self->add_context_init_callback(
        # This is called every time a context is created, it needs to be fast.
        # $_[0] is a context object
        sub {
            return unless $self->{+IPC_POLLING};
            return $_[0]->{hub}->cull unless $self->{+IPC_SHM_ID};

            my $val;
            if(shmread($self->{+IPC_SHM_ID}, $val, 0, $self->{+IPC_SHM_SIZE})) {
                return if $val eq $self->{+IPC_SHM_LAST};
                $self->{+IPC_SHM_LAST} = $val;
            }
            else {
                warn "SHM Read error: $!\n";
            }

            $_[0]->{hub}->cull;
        }
    ) unless defined $self->ipc_polling;

    $self->set_ipc_polling(1);
}

sub ipc_enable_shm {
    my $self = shift;

    return 1 if defined $self->{+IPC_SHM_ID};

    $self->{+_PID} = $$        unless defined $self->{+_PID};
    $self->{+_TID} = get_tid() unless defined $self->{+_TID};

    my ($ok, $err) = try {
        # SysV IPC can be available but not enabled.
        #
        # In some systems (*BSD) accessing the SysV IPC APIs without
        # them being enabled can cause a SIGSYS.  We suppress the SIGSYS
        # and then get ENOSYS from the calls.
        local $SIG{SYS} = 'IGNORE' if CAN_SIGSYS;

        require IPC::SysV;

        my $ipc_key = IPC::SysV::IPC_PRIVATE();
        my $shm_size = $self->{+IPC}->can('shm_size') ? $self->{+IPC}->shm_size : 64;
        my $shm_id = shmget($ipc_key, $shm_size, 0666) or die "Could not get shm: $!";

        my $initial = 'a' x $shm_size;
        shmwrite($shm_id, $initial, 0, $shm_size) or die "Could not write to shm: $!";
        my $val;
        shmread($shm_id, $val, 0, $shm_size) or die "Could not read from shm: $!";
        die "Read SHM value does not match the initial value ('$val' vs '$initial')"
            unless $val eq $initial;

        $self->{+IPC_SHM_SIZE} = $shm_size;
        $self->{+IPC_SHM_ID}   = $shm_id;
        $self->{+IPC_SHM_LAST} = $initial;
    };

    return $ok;
}

sub ipc_free_shm {
    my $self = shift;

    my $id = delete $self->{+IPC_SHM_ID};
    return unless defined $id;

    shmctl($id, IPC::SysV::IPC_RMID(), 0);
}

sub get_ipc_pending {
    my $self = shift;
    return -1 unless defined $self->{+IPC_SHM_ID};
    my $val;
    shmread($self->{+IPC_SHM_ID}, $val, 0, $self->{+IPC_SHM_SIZE}) or return -1;
    return 0 if $val eq $self->{+IPC_SHM_LAST};
    $self->{+IPC_SHM_LAST} = $val;
    return 1;
}

sub set_ipc_pending {
    my $self = shift;

    return undef unless defined $self->{+IPC_SHM_ID};

    my ($val) = @_;

    confess "value is required for set_ipc_pending"
        unless $val;

    shmwrite($self->{+IPC_SHM_ID}, $val, 0, $self->{+IPC_SHM_SIZE});
}

sub disable_ipc_polling {
    my $self = shift;
    return unless defined $self->{+IPC_POLLING};
    $self->{+IPC_POLLING} = 0;
}

sub _ipc_wait {
    my ($timeout) = @_;
    my $fail = 0;

    $timeout = DEFAULT_IPC_TIMEOUT() unless defined $timeout;

    my $ok = eval {
        if (CAN_FORK) {
            local $SIG{ALRM} = sub { die "Timeout waiting on child processes" };
            alarm $timeout;

            while (1) {
                my $pid = CORE::wait();
                my $err = $?;
                last if $pid == -1;
                next unless $err;
                $fail++;

                my $sig = $err & 127;
                my $exit = $err >> 8;
                warn "Process $pid did not exit cleanly (wstat: $err, exit: $exit, sig: $sig)\n";
            }

            alarm 0;
        }

        if (USE_THREADS) {
            my $start = time;

            while (1) {
                last unless threads->list();
                die "Timeout waiting on child thread" if time - $start >= $timeout;
                sleep 1;
                for my $t (threads->list) {
                    # threads older than 1.34 do not have this :-(
                    next if $t->can('is_joinable') && !$t->is_joinable;
                    $t->join;
                    # In older threads we cannot check if a thread had an error unless
                    # we control it and its return.
                    my $err = $t->can('error') ? $t->error : undef;
                    next unless $err;
                    my $tid = $t->tid();
                    $fail++;
                    chomp($err);
                    warn "Thread $tid did not end cleanly: $err\n";
                }
            }
        }

        1;
    };
    my $error = $@;

    return 0 if $ok && !$fail;
    warn $error unless $ok;
    return 255;
}

sub DESTROY {
    my $self = shift;

    return if $self->{+PRELOAD};

    return unless defined($self->{+_PID}) && $self->{+_PID} == $$;
    return unless defined($self->{+_TID}) && $self->{+_TID} == get_tid();

    shmctl($self->{+IPC_SHM_ID}, IPC::SysV::IPC_RMID(), 0)
        if defined $self->{+IPC_SHM_ID};
}

sub set_exit {
    my $self = shift;

    return if $self->{+PRELOAD};

    my $exit     = $?;
    my $new_exit = $exit;

    if ($INC{'Test/Builder.pm'} && $Test::Builder::VERSION ne $Test2::API::VERSION) {
        print STDERR <<"        EOT";

********************************************************************************
*                                                                              *
*            Test::Builder -- Test2::API version mismatch detected             *
*                                                                              *
********************************************************************************
   Test2::API Version: $Test2::API::VERSION
Test::Builder Version: $Test::Builder::VERSION

This is not a supported configuration, you will have problems.

        EOT
    }

    for my $ctx (values %{$self->{+CONTEXTS}}) {
        next unless $ctx;

        next if $ctx->_aborted && ${$ctx->_aborted};

        # Only worry about contexts in this PID
        my $trace = $ctx->trace || next;
        next unless $trace->pid && $trace->pid == $$;

        # Do not worry about contexts that have no hub
        my $hub = $ctx->hub  || next;

        # Do not worry if the state came to a sudden end.
        next if $hub->bailed_out;
        next if defined $hub->skip_reason;

        # now we worry
        $trace->alert("context object was never released! This means a testing tool is behaving very badly");

        $exit     = 255;
        $new_exit = 255;
    }

    if (!defined($self->{+_PID}) or !defined($self->{+_TID}) or $self->{+_PID} != $$ or $self->{+_TID} != get_tid()) {
        $? = $exit;
        return;
    }

    my @hubs = $self->{+STACK} ? $self->{+STACK}->all : ();

    if (@hubs and $self->{+IPC} and !$self->{+NO_WAIT}) {
        local $?;
        my %seen;
        for my $hub (reverse @hubs) {
            my $ipc = $hub->ipc or next;
            next if $seen{$ipc}++;
            $ipc->waiting();
        }

        my $ipc_exit = _ipc_wait($self->{+IPC_TIMEOUT});
        $new_exit ||= $ipc_exit;
    }

    # None of this is necessary if we never got a root hub
    if(my $root = shift @hubs) {
        my $trace = Test2::EventFacet::Trace->new(
            frame  => [__PACKAGE__, __FILE__, 0, __PACKAGE__ . '::END'],
            detail => __PACKAGE__ . ' END Block finalization',
        );
        my $ctx = Test2::API::Context->new(
            trace => $trace,
            hub   => $root,
        );

        if (@hubs) {
            $ctx->diag("Test ended with extra hubs on the stack!");
            $new_exit  = 255;
        }

        unless ($root->no_ending) {
            local $?;
            $root->finalize($trace) unless $root->ended;
            $_->($ctx, $exit, \$new_exit) for @{$self->{+EXIT_CALLBACKS}};
            $new_exit ||= $root->failed;
            $new_exit ||= 255 unless $root->is_passing;
        }
    }

    $new_exit = 255 if $new_exit > 255;

    if ($new_exit && eval { require Test2::API::Breakage; 1 }) {
        my @warn = Test2::API::Breakage->report();

        if (@warn) {
            print STDERR "\nYou have loaded versions of test modules known to have problems with Test2.\nThis could explain some test failures.\n";
            print STDERR "$_\n" for @warn;
            print STDERR "\n";
        }
    }

    $? = $new_exit;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::API::Instance - Object used by Test2::API under the hood

=head1 DESCRIPTION

This object encapsulates the global shared state tracked by
L<Test2>. A single global instance of this package is stored (and
obscured) by the L<Test2::API> package.

There is no reason to directly use this package. This package is documented for
completeness. This package can change, or go away completely at any time.
Directly using, or monkeypatching this package is not supported in any way
shape or form.

=head1 SYNOPSIS

    use Test2::API::Instance;

    my $obj = Test2::API::Instance->new;

=over 4

=item $pid = $obj->pid

PID of this instance.

=item $obj->tid

Thread ID of this instance.

=item $obj->reset()

Reset the object to defaults.

=item $obj->load()

Set the internal state to loaded, and run and stored post-load callbacks.

=item $bool = $obj->loaded

Check if the state is set to loaded.

=item $arrayref = $obj->post_load_callbacks

Get the post-load callbacks.

=item $obj->add_post_load_callback(sub { ... })

Add a post-load callback. If C<load()> has already been called then the callback will
be immediately executed. If C<load()> has not been called then the callback will be
stored and executed later when C<load()> is called.

=item $hashref = $obj->contexts()

Get a hashref of all active contexts keyed by hub id.

=item $arrayref = $obj->context_acquire_callbacks

Get all context acquire callbacks.

=item $arrayref = $obj->context_init_callbacks

Get all context init callbacks.

=item $arrayref = $obj->context_release_callbacks

Get all context release callbacks.

=item $arrayref = $obj->pre_subtest_callbacks

Get all pre-subtest callbacks.

=item $obj->add_context_init_callback(sub { ... })

Add a context init callback. Subs are called every time a context is created. Subs
get the newly created context as their only argument.

=item $obj->add_context_release_callback(sub { ... })

Add a context release callback. Subs are called every time a context is released. Subs
get the released context as their only argument. These callbacks should not
call release on the context.

=item $obj->add_pre_subtest_callback(sub { ... })

Add a pre-subtest callback. Subs are called every time a subtest is
going to be run. Subs get the subtest name, coderef, and any
arguments.

=item $obj->set_exit()

This is intended to be called in an C<END { ... }> block. This will look at
test state and set $?. This will also call any end callbacks, and wait on child
processes/threads.

=item $obj->ipc_enable_shm()

Turn on SHM for IPC (if possible)

=item $shm_id = $obj->ipc_shm_id()

If SHM is enabled for IPC this will be the shm_id for it.

=item $shm_size = $obj->ipc_shm_size()

If SHM is enabled for IPC this will be the size of it.

=item $shm_last_val = $obj->ipc_shm_last()

If SHM is enabled for IPC this will return the last SHM value seen.

=item $obj->set_ipc_pending($val)

use the IPC SHM to tell other processes and threads there is a pending event.
C<$val> should be a unique value no other thread/process will generate.

B<Note:> This will also make the current process see a pending event. It does
not set C<ipc_shm_last()>, this is important because doing so could hide a
previous change.

=item $pending = $obj->get_ipc_pending()

This returns -1 if SHM is not enabled for IPC.

This returns 0 if the SHM value matches the last known value, which means there
are no pending events.

This returns 1 if the SHM value has changed, which means there are probably
pending events.

When 1 is returned this will set C<< $obj->ipc_shm_last() >>.

=item $timeout = $obj->ipc_timeout;

=item $obj->set_ipc_timeout($timeout);

How long to wait for child processes and threads before aborting.

=item $drivers = $obj->ipc_drivers

Get the list of IPC drivers.

=item $obj->add_ipc_driver($DRIVER_CLASS)

Add an IPC driver to the list. The most recently added IPC driver will become
the global one during initialization. If a driver is added after initialization
has occurred a warning will be generated:

    "IPC driver $driver loaded too late to be used as the global ipc driver"

=item $bool = $obj->ipc_polling

Check if polling is enabled.

=item $obj->enable_ipc_polling

Turn on polling. This will cull events from other processes and threads every
time a context is created.

=item $obj->disable_ipc_polling

Turn off IPC polling.

=item $bool = $obj->no_wait

=item $bool = $obj->set_no_wait($bool)

Get/Set no_wait. This option is used to turn off process/thread waiting at exit.

=item $arrayref = $obj->exit_callbacks

Get the exit callbacks.

=item $obj->add_exit_callback(sub { ... })

Add an exit callback. This callback will be called by C<set_exit()>.

=item $bool = $obj->finalized

Check if the object is finalized. Finalization happens when either C<ipc()>,
C<stack()>, or C<format()> are called on the object. Once finalization happens
these fields are considered unchangeable (not enforced here, enforced by
L<Test2>).

=item $ipc = $obj->ipc

Get the one true IPC instance.

=item $obj->ipc_disable

Turn IPC off

=item $bool = $obj->ipc_disabled

Check if IPC is disabled

=item $stack = $obj->stack

Get the one true hub stack.

=item $formatter = $obj->formatter

Get the global formatter. By default this is the C<'Test2::Formatter::TAP'>
package. This could be any package that implements the C<write()> method. This
can also be an instantiated object.

=item $bool = $obj->formatter_set()

Check if a formatter has been set.

=item $obj->add_formatter($class)

=item $obj->add_formatter($obj)

Add a formatter. The most recently added formatter will become the global one
during initialization. If a formatter is added after initialization has occurred
a warning will be generated:

    "Formatter $formatter loaded too late to be used as the global formatter"

=item $obj->set_add_uuid_via(sub { ... })

=item $sub = $obj->add_uuid_via()

This allows you to provide a UUID generator. If provided UUIDs will be attached
to all events, hubs, and contexts. This is useful for storing, tracking, and
linking these objects.

The sub you provide should always return a unique identifier. Most things will
expect a proper UUID string, however nothing in Test2::API enforces this.

The sub will receive exactly 1 argument, the type of thing being tagged
'context', 'hub', or 'event'. In the future additional things may be tagged, in
which case new strings will be passed in. These are purely informative, you can
(and usually should) ignore them.

=back

=head1 SOURCE

The source code repository for Test2 can be found at
F<http://github.com/Test-More/test-more/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>.

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

See F<http://dev.perl.org/licenses/>

=cut
PK       ! †:JE©  ©    Stack.pmnu „[µü¤        package Test2::API::Stack;
use strict;
use warnings;

our $VERSION = '1.302135';


use Test2::Hub();

use Carp qw/confess/;

sub new {
    my $class = shift;
    return bless [], $class;
}

sub new_hub {
    my $self = shift;
    my %params = @_;

    my $class = delete $params{class} || 'Test2::Hub';

    my $hub = $class->new(%params);

    if (@$self) {
        $hub->inherit($self->[-1], %params);
    }
    else {
        require Test2::API;
        $hub->format(Test2::API::test2_formatter()->new_root)
            unless $hub->format || exists($params{formatter});

        my $ipc = Test2::API::test2_ipc();
        if ($ipc && !$hub->ipc && !exists($params{ipc})) {
            $hub->set_ipc($ipc);
            $ipc->add_hub($hub->hid);
        }
    }

    push @$self => $hub;

    $hub;
}

sub top {
    my $self = shift;
    return $self->new_hub unless @$self;
    return $self->[-1];
}

sub peek {
    my $self = shift;
    return @$self ? $self->[-1] : undef;
}

sub cull {
    my $self = shift;
    $_->cull for reverse @$self;
}

sub all {
    my $self = shift;
    return @$self;
}

sub clear {
    my $self = shift;
    @$self = ();
}

# Do these last without keywords in order to prevent them from getting used
# when we want the real push/pop.

{
    no warnings 'once';

    *push = sub {
        my $self = shift;
        my ($hub) = @_;
        $hub->inherit($self->[-1]) if @$self;
        push @$self => $hub;
    };

    *pop = sub {
        my $self = shift;
        my ($hub) = @_;
        confess "No hubs on the stack"
            unless @$self;
        confess "You cannot pop the root hub"
            if 1 == @$self;
        confess "Hub stack mismatch, attempted to pop incorrect hub"
            unless $self->[-1] == $hub;
        pop @$self;
    };
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::API::Stack - Object to manage a stack of L<Test2::Hub>
instances.

=head1 ***INTERNALS NOTE***

B<The internals of this package are subject to change at any time!> The public
methods provided will not change in backwards incompatible ways, but the
underlying implementation details might. B<Do not break encapsulation here!>

=head1 DESCRIPTION

This module is used to represent and manage a stack of L<Test2::Hub>
objects. Hubs are usually in a stack so that you can push a new hub into place
that can intercept and handle events differently than the primary hub.

=head1 SYNOPSIS

    my $stack = Test2::API::Stack->new;
    my $hub = $stack->top;

=head1 METHODS

=over 4

=item $stack = Test2::API::Stack->new()

This will create a new empty stack instance. All arguments are ignored.

=item $hub = $stack->new_hub()

=item $hub = $stack->new_hub(%params)

=item $hub = $stack->new_hub(%params, class => $class)

This will generate a new hub and push it to the top of the stack. Optionally
you can provide arguments that will be passed into the constructor for the
L<Test2::Hub> object.

If you specify the C<< 'class' => $class >> argument, the new hub will be an
instance of the specified class.

Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the
formatter and IPC instance will be inherited from the current top hub. You can
set the parameters to C<undef> to avoid having a formatter or IPC instance.

If there is no top hub, and you do not ask to leave IPC and formatter undef,
then a new formatter will be created, and the IPC instance from
L<Test2::API> will be used.

=item $hub = $stack->top()

This will return the top hub from the stack. If there is no top hub yet this
will create it.

=item $hub = $stack->peek()

This will return the top hub from the stack. If there is no top hub yet this
will return undef.

=item $stack->cull

This will call C<< $hub->cull >> on all hubs in the stack.

=item @hubs = $stack->all

This will return all the hubs in the stack as a list.

=item $stack->clear

This will completely remove all hubs from the stack. Normally you do not want
to do this, but there are a few valid reasons for it.

=item $stack->push($hub)

This will push the new hub onto the stack.

=item $stack->pop($hub)

This will pop a hub from the stack, if the hub at the top of the stack does not
match the hub you expect (passed in as an argument) it will throw an exception.

=back

=head1 SOURCE

The source code repository for Test2 can be found at
F<http://github.com/Test-More/test-more/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>.

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

See F<http://dev.perl.org/licenses/>

=cut
PK       ! ¢x„  „    Breakage.pmnu „[µü¤        package Test2::API::Breakage;
use strict;
use warnings;

our $VERSION = '1.302135';


use Test2::Util qw/pkg_to_file/;

our @EXPORT_OK = qw{
    upgrade_suggested
    upgrade_required
    known_broken
};
BEGIN { require Exporter; our @ISA = qw(Exporter) }

sub upgrade_suggested {
    return (
        'Test::Exception'    => '0.42',
        'Test::FITesque'     => '0.04',
        'Test::Module::Used' => '0.2.5',
        'Test::Moose::More'  => '0.025',
    );
}

sub upgrade_required {
    return (
        'Test::Builder::Clutch'   => '0.07',
        'Test::Dist::VersionSync' => '1.1.4',
        'Test::Modern'            => '0.012',
        'Test::SharedFork'        => '0.34',
        'Test::Alien'             => '0.04',
        'Test::UseAllModules'     => '0.14',
        'Test::More::Prefix'      => '0.005',

        'Test2::Tools::EventDumper' => 0.000007,
        'Test2::Harness'            => 0.000013,

        'Test::DBIx::Class::Schema'    => '1.0.9',
        'Test::Clustericious::Cluster' => '0.30',
    );
}

sub known_broken {
    return (
        'Net::BitTorrent'       => '0.052',
        'Test::Able'            => '0.11',
        'Test::Aggregate'       => '0.373',
        'Test::Flatten'         => '0.11',
        'Test::Group'           => '0.20',
        'Test::ParallelSubtest' => '0.05',
        'Test::Pretty'          => '0.32',
        'Test::Wrapper'         => '0.3.0',

        'Log::Dispatch::Config::TestLog' => '0.02',
    );
}

# Not reportable:
# Device::Chip => 0.07   - Tests will not pass, but not broken if already installed, also no fixed version we can upgrade to.

sub report {
    my $class = shift;
    my ($require) = @_;

    my %suggest  = __PACKAGE__->upgrade_suggested();
    my %required = __PACKAGE__->upgrade_required();
    my %broken   = __PACKAGE__->known_broken();

    my @warn;
    for my $mod (keys %suggest) {
        my $file = pkg_to_file($mod);
        next unless $INC{$file} || ($require && eval { require $file; 1 });
        my $want = $suggest{$mod};
        next if eval { $mod->VERSION($want); 1 };
        push @warn => " * Module '$mod' is outdated, we recommed updating above $want.";
    }

    for my $mod (keys %required) {
        my $file = pkg_to_file($mod);
        next unless $INC{$file} || ($require && eval { require $file; 1 });
        my $want = $required{$mod};
        next if eval { $mod->VERSION($want); 1 };
        push @warn => " * Module '$mod' is outdated and known to be broken, please update to $want or higher.";
    }

    for my $mod (keys %broken) {
        my $file = pkg_to_file($mod);
        next unless $INC{$file} || ($require && eval { require $file; 1 });
        my $tested = $broken{$mod};
        push @warn => " * Module '$mod' is known to be broken in version $tested and below, newer versions have not been tested. You have: " . $mod->VERSION;
    }

    return @warn;
}

1;

__END__


=pod

=encoding UTF-8

=head1 NAME

Test2::API::Breakage - What breaks at what version

=head1 DESCRIPTION

This module provides lists of modules that are broken, or have been broken in
the past, when upgrading L<Test::Builder> to use L<Test2>.

=head1 FUNCTIONS

These can be imported, or called as methods on the class.

=over 4

=item %mod_ver = upgrade_suggested()

=item %mod_ver = Test2::API::Breakage->upgrade_suggested()

This returns key/value pairs. The key is the module name, the value is the
version number. If the installed version of the module is at or below the
specified one then an upgrade would be a good idea, but not strictly necessary.

=item %mod_ver = upgrade_required()

=item %mod_ver = Test2::API::Breakage->upgrade_required()

This returns key/value pairs. The key is the module name, the value is the
version number. If the installed version of the module is at or below the
specified one then an upgrade is required for the module to work properly.

=item %mod_ver = known_broken()

=item %mod_ver = Test2::API::Breakage->known_broken()

This returns key/value pairs. The key is the module name, the value is the
version number. If the installed version of the module is at or below the
specified one then the module will not work. A newer version may work, but is
not tested or verified.

=back

=head1 SOURCE

The source code repository for Test2 can be found at
F<http://github.com/Test-More/test-more/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>.

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

See F<http://dev.perl.org/licenses/>

=cut
PK       ! oØ,˜g  ˜g  
  Context.pmnu „[µü¤        package Test2::API::Context;
use strict;
use warnings;

our $VERSION = '1.302135';


use Carp qw/confess croak/;
use Scalar::Util qw/weaken blessed/;
use Test2::Util qw/get_tid try pkg_to_file get_tid/;

use Test2::EventFacet::Trace();
use Test2::API();

# Preload some key event types
my %LOADED = (
    map {
        my $pkg  = "Test2::Event::$_";
        my $file = "Test2/Event/$_.pm";
        require $file unless $INC{$file};
        ( $pkg => $pkg, $_ => $pkg )
    } qw/Ok Diag Note Plan Bail Exception Waiting Skip Subtest Pass Fail V2/
);

use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
use Test2::Util::HashBase qw{
    stack hub trace _on_release _depth _is_canon _is_spawn _aborted
    errno eval_error child_error thrown
};

# Private, not package vars
# It is safe to cache these.
my $ON_RELEASE = Test2::API::_context_release_callbacks_ref();
my $CONTEXTS   = Test2::API::_contexts_ref();

sub init {
    my $self = shift;

    confess "The 'trace' attribute is required"
        unless $self->{+TRACE};

    confess "The 'hub' attribute is required"
        unless $self->{+HUB};

    $self->{+_DEPTH} = 0 unless defined $self->{+_DEPTH};

    $self->{+ERRNO}       = $! unless exists $self->{+ERRNO};
    $self->{+EVAL_ERROR}  = $@ unless exists $self->{+EVAL_ERROR};
    $self->{+CHILD_ERROR} = $? unless exists $self->{+CHILD_ERROR};
}

sub snapshot { bless {%{$_[0]}, _is_canon => undef, _is_spawn => undef, _aborted => undef}, __PACKAGE__ }

sub restore_error_vars {
    my $self = shift;
    ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR};
}

sub DESTROY {
    return unless $_[0]->{+_IS_CANON} || $_[0]->{+_IS_SPAWN};
    return if $_[0]->{+_ABORTED} && ${$_[0]->{+_ABORTED}};
    my ($self) = @_;

    my $hub = $self->{+HUB};
    my $hid = $hub->{hid};

    # Do not show the warning if it looks like an exception has been thrown, or
    # if the context is not local to this process or thread.
    {
        # Sometimes $@ is uninitialized, not a problem in this case so do not
        # show the warning about using eq.
        no warnings 'uninitialized';
        if($self->{+EVAL_ERROR} eq $@ && $hub->is_local) {
            my $frame = $self->{+_IS_SPAWN} || $self->{+TRACE}->frame;
            warn <<"            EOT";
A context appears to have been destroyed without first calling release().
Based on \$@ it does not look like an exception was thrown (this is not always
a reliable test)

This is a problem because the global error variables (\$!, \$@, and \$?) will
not be restored. In addition some release callbacks will not work properly from
inside a DESTROY method.

Here are the context creation details, just in case a tool forgot to call
release():
  File: $frame->[1]
  Line: $frame->[2]
  Tool: $frame->[3]

Cleaning up the CONTEXT stack...
            EOT
        }
    }

    return if $self->{+_IS_SPAWN};

    # Remove the key itself to avoid a slow memory leak
    delete $CONTEXTS->{$hid};
    $self->{+_IS_CANON} = undef;

    if (my $cbk = $self->{+_ON_RELEASE}) {
        $_->($self) for reverse @$cbk;
    }
    if (my $hcbk = $hub->{_context_release}) {
        $_->($self) for reverse @$hcbk;
    }
    $_->($self) for reverse @$ON_RELEASE;
}

# release exists to implement behaviors like die-on-fail. In die-on-fail you
# want to die after a failure, but only after diagnostics have been reported.
# The ideal time for the die to happen is when the context is released.
# Unfortunately die does not work in a DESTROY block.
sub release {
    my ($self) = @_;

    ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return if $self->{+THROWN};

    ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return $self->{+_IS_SPAWN} = undef
        if $self->{+_IS_SPAWN};

    croak "release() should not be called on context that is neither canon nor a child"
        unless $self->{+_IS_CANON};

    my $hub = $self->{+HUB};
    my $hid = $hub->{hid};

    croak "context thinks it is canon, but it is not"
        unless $CONTEXTS->{$hid} && $CONTEXTS->{$hid} == $self;

    # Remove the key itself to avoid a slow memory leak
    $self->{+_IS_CANON} = undef;
    delete $CONTEXTS->{$hid};

    if (my $cbk = $self->{+_ON_RELEASE}) {
        $_->($self) for reverse @$cbk;
    }
    if (my $hcbk = $hub->{_context_release}) {
        $_->($self) for reverse @$hcbk;
    }
    $_->($self) for reverse @$ON_RELEASE;

    # Do this last so that nothing else changes them.
    # If one of the hooks dies then these do not get restored, this is
    # intentional
    ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR};

    return;
}

sub do_in_context {
    my $self = shift;
    my ($sub, @args) = @_;

    # We need to update the pid/tid and error vars.
    my $clone = $self->snapshot;
    @$clone{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} = ($!, $@, $?);
    $clone->{+TRACE} = $clone->{+TRACE}->snapshot(pid => $$, tid => get_tid());

    my $hub = $clone->{+HUB};
    my $hid = $hub->hid;

    my $old = $CONTEXTS->{$hid};

    $clone->{+_IS_CANON} = 1;
    $CONTEXTS->{$hid} = $clone;
    weaken($CONTEXTS->{$hid});
    my ($ok, $err) = &try($sub, @args);
    my ($rok, $rerr) = try { $clone->release };
    delete $clone->{+_IS_CANON};

    if ($old) {
        $CONTEXTS->{$hid} = $old;
        weaken($CONTEXTS->{$hid});
    }
    else {
        delete $CONTEXTS->{$hid};
    }

    die $err  unless $ok;
    die $rerr unless $rok;
}

sub done_testing {
    my $self = shift;
    $self->hub->finalize($self->trace, 1);
    return;
}

sub throw {
    my ($self, $msg) = @_;
    $self->{+THROWN} = 1;
    ${$self->{+_ABORTED}}++ if $self->{+_ABORTED};
    $self->release if $self->{+_IS_CANON} || $self->{+_IS_SPAWN};
    $self->trace->throw($msg);
}

sub alert {
    my ($self, $msg) = @_;
    $self->trace->alert($msg);
}

sub send_ev2_and_release {
    my $self = shift;
    my $out  = $self->send_ev2(@_);
    $self->release;
    return $out;
}

sub send_ev2 {
    my $self = shift;

    my $e;
    {
        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
        $e = Test2::Event::V2->new(
            trace => $self->{+TRACE}->snapshot,
            @_,
        );
    }

    if ($self->{+_ABORTED}) {
        my $f = $e->facet_data;
        ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate);
    }
    $self->{+HUB}->send($e);
}

sub build_ev2 {
    my $self = shift;

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    Test2::Event::V2->new(
        trace => $self->{+TRACE}->snapshot,
        @_,
    );
}

sub send_event_and_release {
    my $self = shift;
    my $out = $self->send_event(@_);
    $self->release;
    return $out;
}

sub send_event {
    my $self  = shift;
    my $event = shift;
    my %args  = @_;

    my $pkg = $LOADED{$event} || $self->_parse_event($event);

    my $e;
    {
        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
        $e = $pkg->new(
            trace => $self->{+TRACE}->snapshot,
            %args,
        );
    }

    if ($self->{+_ABORTED}) {
        my $f = $e->facet_data;
        ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate);
    }
    $self->{+HUB}->send($e);
}

sub build_event {
    my $self  = shift;
    my $event = shift;
    my %args  = @_;

    my $pkg = $LOADED{$event} || $self->_parse_event($event);

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    $pkg->new(
        trace => $self->{+TRACE}->snapshot,
        %args,
    );
}

sub pass {
    my $self = shift;
    my ($name) = @_;

    my $e = bless(
        {
            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
            name  => $name,
        },
        "Test2::Event::Pass"
    );

    $self->{+HUB}->send($e);
    return $e;
}

sub pass_and_release {
    my $self = shift;
    my ($name) = @_;

    my $e = bless(
        {
            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
            name  => $name,
        },
        "Test2::Event::Pass"
    );

    $self->{+HUB}->send($e);
    $self->release;
    return 1;
}

sub fail {
    my $self = shift;
    my ($name, @diag) = @_;

    my $e = bless(
        {
            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
            name  => $name,
        },
        "Test2::Event::Fail"
    );

    $e->add_info({tag => 'DIAG', debug => 1, details => $_}) for @diag;
    $self->{+HUB}->send($e);
    return $e;
}

sub fail_and_release {
    my $self = shift;
    my ($name, @diag) = @_;

    my $e = bless(
        {
            trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
            name  => $name,
        },
        "Test2::Event::Fail"
    );

    $e->add_info({tag => 'DIAG', debug => 1, details => $_}) for @diag;
    $self->{+HUB}->send($e);
    $self->release;
    return 0;
}

sub ok {
    my $self = shift;
    my ($pass, $name, $on_fail) = @_;

    my $hub = $self->{+HUB};

    my $e = bless {
        trace => bless( {%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
        pass  => $pass,
        name  => $name,
    }, 'Test2::Event::Ok';
    $e->init;

    $hub->send($e);
    return $e if $pass;

    $self->failure_diag($e);

    if ($on_fail && @$on_fail) {
        $self->diag($_) for @$on_fail;
    }

    return $e;
}

sub failure_diag {
    my $self = shift;
    my ($e) = @_;

    # Figure out the debug info, this is typically the file name and line
    # number, but can also be a custom message. If no trace object is provided
    # then we have nothing useful to display.
    my $name  = $e->name;
    my $trace = $e->trace;
    my $debug = $trace ? $trace->debug : "[No trace info available]";

    # Create the initial diagnostics. If the test has a name we put the debug
    # info on a second line, this behavior is inherited from Test::Builder.
    my $msg = defined($name)
        ? qq[Failed test '$name'\n$debug.\n]
        : qq[Failed test $debug.\n];

    $self->diag($msg);
}

sub skip {
    my $self = shift;
    my ($name, $reason, @extra) = @_;
    $self->send_event(
        'Skip',
        name => $name,
        reason => $reason,
        pass => 1,
        @extra,
    );
}

sub note {
    my $self = shift;
    my ($message) = @_;
    $self->send_event('Note', message => $message);
}

sub diag {
    my $self = shift;
    my ($message) = @_;
    my $hub = $self->{+HUB};
    $self->send_event(
        'Diag',
        message => $message,
    );
}

sub plan {
    my ($self, $max, $directive, $reason) = @_;
    $self->send_event('Plan', max => $max, directive => $directive, reason => $reason);
}

sub bail {
    my ($self, $reason) = @_;
    $self->send_event('Bail', reason => $reason);
}

sub _parse_event {
    my $self = shift;
    my $event = shift;

    my $pkg;
    if ($event =~ m/^\+(.*)/) {
        $pkg = $1;
    }
    else {
        $pkg = "Test2::Event::$event";
    }

    unless ($LOADED{$pkg}) {
        my $file = pkg_to_file($pkg);
        my ($ok, $err) = try { require $file };
        $self->throw("Could not load event module '$pkg': $err")
            unless $ok;

        $LOADED{$pkg} = $pkg;
    }

    confess "'$pkg' is not a subclass of 'Test2::Event'"
        unless $pkg->isa('Test2::Event');

    $LOADED{$event} = $pkg;

    return $pkg;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::API::Context - Object to represent a testing context.

=head1 DESCRIPTION

The context object is the primary interface for authors of testing tools
written with L<Test2>. The context object represents the context in
which a test takes place (File and Line Number), and provides a quick way to
generate events from that context. The context object also takes care of
sending events to the correct L<Test2::Hub> instance.

=head1 SYNOPSIS

In general you will not be creating contexts directly. To obtain a context you
should always use C<context()> which is exported by the L<Test2::API> module.

    use Test2::API qw/context/;

    sub my_ok {
        my ($bool, $name) = @_;
        my $ctx = context();
        $ctx->ok($bool, $name);
        $ctx->release; # You MUST do this!
        return $bool;
    }

Context objects make it easy to wrap other tools that also use context. Once
you grab a context, any tool you call before releasing your context will
inherit it:

    sub wrapper {
        my ($bool, $name) = @_;
        my $ctx = context();
        $ctx->diag("wrapping my_ok");

        my $out = my_ok($bool, $name);
        $ctx->release; # You MUST do this!
        return $out;
    }

=head1 CRITICAL DETAILS

=over 4

=item you MUST always use the context() sub from Test2::API

Creating your own context via C<< Test2::API::Context->new() >> will almost never
produce a desirable result. Use C<context()> which is exported by L<Test2::API>.

There are a handful of cases where a tool author may want to create a new
context by hand, which is why the C<new> method exists. Unless you really know
what you are doing you should avoid this.

=item You MUST always release the context when done with it

Releasing the context tells the system you are done with it. This gives it a
chance to run any necessary callbacks or cleanup tasks. If you forget to
release the context it will try to detect the problem and warn you about it.

=item You MUST NOT pass context objects around

When you obtain a context object it is made specifically for your tool and any
tools nested within. If you pass a context around you run the risk of polluting
other tools with incorrect context information.

If you are certain that you want a different tool to use the same context you
may pass it a snapshot. C<< $ctx->snapshot >> will give you a shallow clone of
the context that is safe to pass around or store.

=item You MUST NOT store or cache a context for later

As long as a context exists for a given hub, all tools that try to get a
context will get the existing instance. If you try to store the context you
will pollute other tools with incorrect context information.

If you are certain that you want to save the context for later, you can use a
snapshot. C<< $ctx->snapshot >> will give you a shallow clone of the context
that is safe to pass around or store.

C<context()> has some mechanisms to protect you if you do cause a context to
persist beyond the scope in which it was obtained. In practice you should not
rely on these protections, and they are fairly noisy with warnings.

=item You SHOULD obtain your context as soon as possible in a given tool

You never know what tools you call from within your own tool will need a
context. Obtaining the context early ensures that nested tools can find the
context you want them to find.

=back

=head1 METHODS

=over 4

=item $ctx->done_testing;

Note that testing is finished. If no plan has been set this will generate a
Plan event.

=item $clone = $ctx->snapshot()

This will return a shallow clone of the context. The shallow clone is safe to
store for later.

=item $ctx->release()

This will release the context. This runs cleanup tasks, and several important
hooks. It will also restore C<$!>, C<$?>, and C<$@> to what they were when the
context was created.

B<Note:> If a context is acquired more than once an internal refcount is kept.
C<release()> decrements the ref count, none of the other actions of
C<release()> will occur unless the refcount hits 0. This means only the last
call to C<release()> will reset C<$?>, C<$!>, C<$@>,and run the cleanup tasks.

=item $ctx->throw($message)

This will throw an exception reporting to the file and line number of the
context. This will also release the context for you.

=item $ctx->alert($message)

This will issue a warning from the file and line number of the context.

=item $stack = $ctx->stack()

This will return the L<Test2::API::Stack> instance the context used to find
the current hub.

=item $hub = $ctx->hub()

This will return the L<Test2::Hub> instance the context recognizes as the
current one to which all events should be sent.

=item $dbg = $ctx->trace()

This will return the L<Test2::EventFacet::Trace> instance used by the context.

=item $ctx->do_in_context(\&code, @args);

Sometimes you have a context that is not current, and you want things to use it
as the current one. In these cases you can call
C<< $ctx->do_in_context(sub { ... }) >>. The codeblock will be run, and
anything inside of it that looks for a context will find the one on which the
method was called.

This B<DOES NOT> affect context on other hubs, only the hub used by the context
will be affected.

    my $ctx = ...;
    $ctx->do_in_context(sub {
        my $ctx = context(); # returns the $ctx the sub is called on
    });

B<Note:> The context will actually be cloned, the clone will be used instead of
the original. This allows the thread id, process id, and error variables to be correct without
modifying the original context.

=item $ctx->restore_error_vars()

This will set C<$!>, C<$?>, and C<$@> to what they were when the context was
created. There is no localization or anything done here, calling this method
will actually set these vars.

=item $! = $ctx->errno()

The (numeric) value of C<$!> when the context was created.

=item $? = $ctx->child_error()

The value of C<$?> when the context was created.

=item $@ = $ctx->eval_error()

The value of C<$@> when the context was created.

=back

=head2 EVENT PRODUCTION METHODS

B<Which one do I use?>

The C<pass*> and C<fail*> are optimal if they meet your situation, using one of
them will always be the most optimal. That said they are optimal by eliminating
many features.

Method such as C<ok>, and C<note> are shortcuts for generating common 1-task
events based on the old API, however they are forward compatible, and easy to
use. If these meet your needs then go ahead and use them, but please check back
often for alternatives that may be added.

If you want to generate new style events, events that do many things at once,
then you want the C<*ev2*> methods. These let you directly specify which facets
you wish to use.

=over 4

=item $event = $ctx->pass()

=item $event = $ctx->pass($name)

This will send and return an L<Test2::Event::Pass> event. You may optionally
provide a C<$name> for the assertion.

The L<Test2::Event::Pass> is a specially crafted and optimized event, using
this will help the performance of passing tests.

=item $true = $ctx->pass_and_release()

=item $true = $ctx->pass_and_release($name)

This is a combination of C<pass()> and C<release()>. You can use this if you do
not plan to do anything with the context after sending the event. This helps
write more clear and compact code.

    sub shorthand {
        my ($bool, $name) = @_;
        my $ctx = context();
        return $ctx->pass_and_release($name) if $bool;

        ... Handle a failure ...
    }

    sub longform {
        my ($bool, $name) = @_;
        my $ctx = context();

        if ($bool) {
            $ctx->pass($name);
            $ctx->release;
            return 1;
        }

        ... Handle a failure ...
    }

=item my $event = $ctx->fail()

=item my $event = $ctx->fail($name)

=item my $event = $ctx->fail($name, @diagnostics)

This lets you send an L<Test2::Event::Fail> event. You may optionally provide a
C<$name> and C<@diagnostics> messages.

=item my $false = $ctx->fail_and_release()

=item my $false = $ctx->fail_and_release($name)

=item my $false = $ctx->fail_and_release($name, @diagnostics)

This is a combination of C<fail()> and C<release()>. This can be used to write
clearer and shorter code.

    sub shorthand {
        my ($bool, $name) = @_;
        my $ctx = context();
        return $ctx->fail_and_release($name) unless $bool;

        ... Handle a success ...
    }

    sub longform {
        my ($bool, $name) = @_;
        my $ctx = context();

        unless ($bool) {
            $ctx->pass($name);
            $ctx->release;
            return 1;
        }

        ... Handle a success ...
    }


=item $event = $ctx->ok($bool, $name)

=item $event = $ctx->ok($bool, $name, \@on_fail)

B<NOTE:> Use of this method is discouraged in favor of C<pass()> and C<fail()>
which produce L<Test2::Event::Pass> and L<Test2::Event::Fail> events. These
newer event types are faster and less crufty.

This will create an L<Test2::Event::Ok> object for you. If C<$bool> is false
then an L<Test2::Event::Diag> event will be sent as well with details about the
failure. If you do not want automatic diagnostics you should use the
C<send_event()> method directly.

The third argument C<\@on_fail>) is an optional set of diagnostics to be sent in
the event of a test failure.

=item $event = $ctx->note($message)

Send an L<Test2::Event::Note>. This event prints a message to STDOUT.

=item $event = $ctx->diag($message)

Send an L<Test2::Event::Diag>. This event prints a message to STDERR.

=item $event = $ctx->plan($max)

=item $event = $ctx->plan(0, 'SKIP', $reason)

This can be used to send an L<Test2::Event::Plan> event. This event
usually takes either a number of tests you expect to run. Optionally you can
set the expected count to 0 and give the 'SKIP' directive with a reason to
cause all tests to be skipped.

=item $event = $ctx->skip($name, $reason);

Send an L<Test2::Event::Skip> event.

=item $event = $ctx->bail($reason)

This sends an L<Test2::Event::Bail> event. This event will completely
terminate all testing.

=item $event = $ctx->send_ev2(%facets)

This lets you build and send a V2 event directly from facets. The event is
returned after it is sent.

This example sends a single assertion, a note (comment for stdout in
Test::Builder talk) and sets the plan to 1.

    my $event = $ctx->send_event(
        plan   => {count => 1},
        assert => {pass  => 1, details => "A passing assert"},
        info => [{tag => 'NOTE', details => "This is a note"}],
    );

=item $event = $ctx->build_e2(%facets)

This is the same as C<send_ev2()>, except it builds and returns the event
without sending it.

=item $event = $ctx->send_ev2_and_release($Type, %parameters)

This is a combination of C<send_ev2()> and C<release()>.

    sub shorthand {
        my $ctx = context();
        return $ctx->send_ev2_and_release(assert => {pass => 1, details => 'foo'});
    }

    sub longform {
        my $ctx = context();
        my $event = $ctx->send_ev2(assert => {pass => 1, details => 'foo'});
        $ctx->release;
        return $event;
    }

=item $event = $ctx->send_event($Type, %parameters)

B<It is better to use send_ev2() in new code.>

This lets you build and send an event of any type. The C<$Type> argument should
be the event package name with C<Test2::Event::> left off, or a fully
qualified package name prefixed with a '+'. The event is returned after it is
sent.

    my $event = $ctx->send_event('Ok', ...);

or

    my $event = $ctx->send_event('+Test2::Event::Ok', ...);

=item $event = $ctx->build_event($Type, %parameters)

B<It is better to use build_ev2() in new code.>

This is the same as C<send_event()>, except it builds and returns the event
without sending it.

=item $event = $ctx->send_event_and_release($Type, %parameters)

B<It is better to use send_ev2_and_release() in new code.>

This is a combination of C<send_event()> and C<release()>.

    sub shorthand {
        my $ctx = context();
        return $ctx->send_event_and_release(Pass => { name => 'foo' });
    }

    sub longform {
        my $ctx = context();
        my $event = $ctx->send_event(Pass => { name => 'foo' });
        $ctx->release;
        return $event;
    }

=back

=head1 HOOKS

There are 2 types of hooks, init hooks, and release hooks. As the names
suggest, these hooks are triggered when contexts are created or released.

=head2 INIT HOOKS

These are called whenever a context is initialized. That means when a new
instance is created. These hooks are B<NOT> called every time something
requests a context, just when a new one is created.

=head3 GLOBAL

This is how you add a global init callback. Global callbacks happen for every
context for any hub or stack.

    Test2::API::test2_add_callback_context_init(sub {
        my $ctx = shift;
        ...
    });

=head3 PER HUB

This is how you add an init callback for all contexts created for a given hub.
These callbacks will not run for other hubs.

    $hub->add_context_init(sub {
        my $ctx = shift;
        ...
    });

=head3 PER CONTEXT

This is how you specify an init hook that will only run if your call to
C<context()> generates a new context. The callback will be ignored if
C<context()> is returning an existing context.

    my $ctx = context(on_init => sub {
        my $ctx = shift;
        ...
    });

=head2 RELEASE HOOKS

These are called whenever a context is released. That means when the last
reference to the instance is about to be destroyed. These hooks are B<NOT>
called every time C<< $ctx->release >> is called.

=head3 GLOBAL

This is how you add a global release callback. Global callbacks happen for every
context for any hub or stack.

    Test2::API::test2_add_callback_context_release(sub {
        my $ctx = shift;
        ...
    });

=head3 PER HUB

This is how you add a release callback for all contexts created for a given
hub. These callbacks will not run for other hubs.

    $hub->add_context_release(sub {
        my $ctx = shift;
        ...
    });

=head3 PER CONTEXT

This is how you add release callbacks directly to a context. The callback will
B<ALWAYS> be added to the context that gets returned, it does not matter if a
new one is generated, or if an existing one is returned.

    my $ctx = context(on_release => sub {
        my $ctx = shift;
        ...
    });

=head1 THIRD PARTY META-DATA

This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
way for you to attach meta-data to instances of this class. This is useful for
tools, plugins, and other extensions.

=head1 SOURCE

The source code repository for Test2 can be found at
F<http://github.com/Test-More/test-more/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=item Kent Fredric E<lt>kentnl@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>.

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

See F<http://dev.perl.org/licenses/>

=cut
PK       ! }lë¸+  +  	  HOWTO.podnu ÏÃ6Ç$        =head1 NAME

CPAN::API::HOWTO - a recipe book for programming with CPAN.pm

=head1 RECIPES

All of these recipes assume that you have put "use CPAN" at the top of
your program.

=head2 What distribution contains a particular module?

    my $distribution = CPAN::Shell->expand(
        "Module", "Data::UUID"
    )->distribution()->pretty_id();

This returns a string of the form "AUTHORID/TARBALL".  If you want the
full path and filename to this distribution on a CPAN mirror, then it is
C<.../authors/id/A/AU/AUTHORID/TARBALL>.

=head2 What modules does a particular distribution contain?

    CPAN::Index->reload();
    my @modules = CPAN::Shell->expand(
        "Distribution", "JHI/Graph-0.83.tar.gz"
    )->containsmods();

You may also refer to a distribution in the form A/AU/AUTHORID/TARBALL.

=head1 SEE ALSO

the main CPAN.pm documentation

=head1 LICENSE

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

See L<http://www.perl.com/perl/misc/Artistic.html>

=head1 AUTHOR

David Cantrell

=cut
PK         ! ”ÚÖg_  _                  Instance.pmnu „[µü¤        PK         ! †:JE©  ©              º_  Stack.pmnu „[µü¤        PK         ! ¢x„  „              ›r  Breakage.pmnu „[µü¤        PK         ! oØ,˜g  ˜g  
            Z…  Context.pmnu „[µü¤        PK         ! }lë¸+  +  	            ,í  HOWTO.podnu ÏÃ6Ç$        PK      q  ñ    