File Coverage

blib/lib/Test2/API/Stack.pm
Criterion Covered Total %
statement 55 55 100.0
branch 18 20 90.0
condition 8 11 72.7
subroutine 15 15 100.0
pod 7 8 87.5
total 103 109 94.5


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