summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Stack.pm
blob: b5585a8ef4af60fefcda3140fac63178361fa5a0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
package Test2::API::Stack;
use strict;
use warnings;

our $VERSION = '1.302183';


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 root {
    my $self = shift;
    return unless @$self;
    return $self->[0];
}

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