1package Test2::API::Stack;
2use strict;
3use warnings;
4
5our $VERSION = '1.302162';
6
7
8use Test2::Hub();
9
10use Carp qw/confess/;
11
12sub new {
13    my $class = shift;
14    return bless [], $class;
15}
16
17sub new_hub {
18    my $self = shift;
19    my %params = @_;
20
21    my $class = delete $params{class} || 'Test2::Hub';
22
23    my $hub = $class->new(%params);
24
25    if (@$self) {
26        $hub->inherit($self->[-1], %params);
27    }
28    else {
29        require Test2::API;
30        $hub->format(Test2::API::test2_formatter()->new_root)
31            unless $hub->format || exists($params{formatter});
32
33        my $ipc = Test2::API::test2_ipc();
34        if ($ipc && !$hub->ipc && !exists($params{ipc})) {
35            $hub->set_ipc($ipc);
36            $ipc->add_hub($hub->hid);
37        }
38    }
39
40    push @$self => $hub;
41
42    $hub;
43}
44
45sub top {
46    my $self = shift;
47    return $self->new_hub unless @$self;
48    return $self->[-1];
49}
50
51sub peek {
52    my $self = shift;
53    return @$self ? $self->[-1] : undef;
54}
55
56sub cull {
57    my $self = shift;
58    $_->cull for reverse @$self;
59}
60
61sub all {
62    my $self = shift;
63    return @$self;
64}
65
66sub clear {
67    my $self = shift;
68    @$self = ();
69}
70
71# Do these last without keywords in order to prevent them from getting used
72# when we want the real push/pop.
73
74{
75    no warnings 'once';
76
77    *push = sub {
78        my $self = shift;
79        my ($hub) = @_;
80        $hub->inherit($self->[-1]) if @$self;
81        push @$self => $hub;
82    };
83
84    *pop = sub {
85        my $self = shift;
86        my ($hub) = @_;
87        confess "No hubs on the stack"
88            unless @$self;
89        confess "You cannot pop the root hub"
90            if 1 == @$self;
91        confess "Hub stack mismatch, attempted to pop incorrect hub"
92            unless $self->[-1] == $hub;
93        pop @$self;
94    };
95}
96
971;
98
99__END__
100
101=pod
102
103=encoding UTF-8
104
105=head1 NAME
106
107Test2::API::Stack - Object to manage a stack of L<Test2::Hub>
108instances.
109
110=head1 ***INTERNALS NOTE***
111
112B<The internals of this package are subject to change at any time!> The public
113methods provided will not change in backwards incompatible ways, but the
114underlying implementation details might. B<Do not break encapsulation here!>
115
116=head1 DESCRIPTION
117
118This module is used to represent and manage a stack of L<Test2::Hub>
119objects. Hubs are usually in a stack so that you can push a new hub into place
120that can intercept and handle events differently than the primary hub.
121
122=head1 SYNOPSIS
123
124    my $stack = Test2::API::Stack->new;
125    my $hub = $stack->top;
126
127=head1 METHODS
128
129=over 4
130
131=item $stack = Test2::API::Stack->new()
132
133This will create a new empty stack instance. All arguments are ignored.
134
135=item $hub = $stack->new_hub()
136
137=item $hub = $stack->new_hub(%params)
138
139=item $hub = $stack->new_hub(%params, class => $class)
140
141This will generate a new hub and push it to the top of the stack. Optionally
142you can provide arguments that will be passed into the constructor for the
143L<Test2::Hub> object.
144
145If you specify the C<< 'class' => $class >> argument, the new hub will be an
146instance of the specified class.
147
148Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the
149formatter and IPC instance will be inherited from the current top hub. You can
150set the parameters to C<undef> to avoid having a formatter or IPC instance.
151
152If there is no top hub, and you do not ask to leave IPC and formatter undef,
153then a new formatter will be created, and the IPC instance from
154L<Test2::API> will be used.
155
156=item $hub = $stack->top()
157
158This will return the top hub from the stack. If there is no top hub yet this
159will create it.
160
161=item $hub = $stack->peek()
162
163This will return the top hub from the stack. If there is no top hub yet this
164will return undef.
165
166=item $stack->cull
167
168This will call C<< $hub->cull >> on all hubs in the stack.
169
170=item @hubs = $stack->all
171
172This will return all the hubs in the stack as a list.
173
174=item $stack->clear
175
176This will completely remove all hubs from the stack. Normally you do not want
177to do this, but there are a few valid reasons for it.
178
179=item $stack->push($hub)
180
181This will push the new hub onto the stack.
182
183=item $stack->pop($hub)
184
185This will pop a hub from the stack, if the hub at the top of the stack does not
186match the hub you expect (passed in as an argument) it will throw an exception.
187
188=back
189
190=head1 SOURCE
191
192The source code repository for Test2 can be found at
193F<http://github.com/Test-More/test-more/>.
194
195=head1 MAINTAINERS
196
197=over 4
198
199=item Chad Granum E<lt>exodist@cpan.orgE<gt>
200
201=back
202
203=head1 AUTHORS
204
205=over 4
206
207=item Chad Granum E<lt>exodist@cpan.orgE<gt>
208
209=back
210
211=head1 COPYRIGHT
212
213Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
214
215This program is free software; you can redistribute it and/or
216modify it under the same terms as Perl itself.
217
218See F<http://dev.perl.org/licenses/>
219
220=cut
221