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 |