Commit | Line | Data |
---|---|---|
b4514920 CG |
1 | package Test2::API::Stack; |
2 | use strict; | |
3 | use warnings; | |
4 | ||
35014935 | 5 | our $VERSION = '1.302035'; |
b4514920 CG |
6 | |
7 | ||
8 | use Test2::Hub(); | |
9 | ||
10 | use Carp qw/confess/; | |
11 | ||
12 | sub new { | |
13 | my $class = shift; | |
14 | return bless [], $class; | |
15 | } | |
16 | ||
17 | sub 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) | |
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 | ||
45 | sub top { | |
46 | my $self = shift; | |
47 | return $self->new_hub unless @$self; | |
48 | return $self->[-1]; | |
49 | } | |
50 | ||
51 | sub peek { | |
52 | my $self = shift; | |
53 | return @$self ? $self->[-1] : undef; | |
54 | } | |
55 | ||
56 | sub cull { | |
57 | my $self = shift; | |
58 | $_->cull for reverse @$self; | |
59 | } | |
60 | ||
61 | sub all { | |
62 | my $self = shift; | |
63 | return @$self; | |
64 | } | |
65 | ||
66 | sub 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 | ||
97 | 1; | |
98 | ||
99 | __END__ | |
100 | ||
101 | =pod | |
102 | ||
103 | =encoding UTF-8 | |
104 | ||
105 | =head1 NAME | |
106 | ||
107 | Test2::API::Stack - Object to manage a stack of L<Test2::Hub> | |
108 | instances. | |
109 | ||
110 | =head1 ***INTERNALS NOTE*** | |
111 | ||
112 | B<The internals of this package are subject to change at any time!> The public | |
58818a66 | 113 | methods provided will not change in backwards incompatible ways, but the |
b4514920 CG |
114 | underlying implementation details might. B<Do not break encapsulation here!> |
115 | ||
116 | =head1 DESCRIPTION | |
117 | ||
118 | This module is used to represent and manage a stack of L<Test2::Hub> | |
119 | objects. Hubs are usually in a stack so that you can push a new hub into place | |
120 | that 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 | ||
133 | This 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 | ||
141 | This will generate a new hub and push it to the top of the stack. Optionally | |
142 | you can provide arguments that will be passed into the constructor for the | |
143 | L<Test2::Hub> object. | |
144 | ||
145 | If you specify the C<< 'class' => $class >> argument, the new hub will be an | |
146 | instance of the specified class. | |
147 | ||
148 | Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the | |
58818a66 CG |
149 | formatter and IPC instance will be inherited from the current top hub. You can |
150 | set the parameters to C<undef> to avoid having a formatter or IPC instance. | |
b4514920 | 151 | |
58818a66 | 152 | If there is no top hub, and you do not ask to leave IPC and formatter undef, |
b4514920 CG |
153 | then a new formatter will be created, and the IPC instance from |
154 | L<Test2::API> will be used. | |
155 | ||
156 | =item $hub = $stack->top() | |
157 | ||
158 | This will return the top hub from the stack. If there is no top hub yet this | |
159 | will create it. | |
160 | ||
161 | =item $hub = $stack->peek() | |
162 | ||
163 | This will return the top hub from the stack. If there is no top hub yet this | |
164 | will return undef. | |
165 | ||
166 | =item $stack->cull | |
167 | ||
168 | This will call C<< $hub->cull >> on all hubs in the stack. | |
169 | ||
170 | =item @hubs = $stack->all | |
171 | ||
172 | This will return all the hubs in the stack as a list. | |
173 | ||
174 | =item $stack->clear | |
175 | ||
176 | This will completely remove all hubs from the stack. Normally you do not want | |
177 | to do this, but there are a few valid reasons for it. | |
178 | ||
179 | =item $stack->push($hub) | |
180 | ||
181 | This will push the new hub onto the stack. | |
182 | ||
183 | =item $stack->pop($hub) | |
184 | ||
185 | This will pop a hub from the stack, if the hub at the top of the stack does not | |
186 | match the hub you expect (passed in as an argument) it will throw an exception. | |
187 | ||
188 | =back | |
189 | ||
190 | =head1 SOURCE | |
191 | ||
192 | The source code repository for Test2 can be found at | |
193 | F<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 | ||
213 | Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>. | |
214 | ||
215 | This program is free software; you can redistribute it and/or | |
216 | modify it under the same terms as Perl itself. | |
217 | ||
218 | See F<http://dev.perl.org/licenses/> | |
219 | ||
220 | =cut |