1package Test2::API::Stack; 2use strict; 3use warnings; 4 5our $VERSION = '1.302199'; 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 root { 67 my $self = shift; 68 return unless @$self; 69 return $self->[0]; 70} 71 72sub clear { 73 my $self = shift; 74 @$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 no warnings 'once'; 82 83 *push = sub { 84 my $self = shift; 85 my ($hub) = @_; 86 $hub->inherit($self->[-1]) if @$self; 87 push @$self => $hub; 88 }; 89 90 *pop = sub { 91 my $self = shift; 92 my ($hub) = @_; 93 confess "No hubs on the stack" 94 unless @$self; 95 confess "You cannot pop the root hub" 96 if 1 == @$self; 97 confess "Hub stack mismatch, attempted to pop incorrect hub" 98 unless $self->[-1] == $hub; 99 pop @$self; 100 }; 101} 102 1031; 104 105__END__ 106 107=pod 108 109=encoding UTF-8 110 111=head1 NAME 112 113Test2::API::Stack - Object to manage a stack of L<Test2::Hub> 114instances. 115 116=head1 ***INTERNALS NOTE*** 117 118B<The internals of this package are subject to change at any time!> The public 119methods provided will not change in backwards incompatible ways, but the 120underlying implementation details might. B<Do not break encapsulation here!> 121 122=head1 DESCRIPTION 123 124This module is used to represent and manage a stack of L<Test2::Hub> 125objects. Hubs are usually in a stack so that you can push a new hub into place 126that 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 139This 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 147This will generate a new hub and push it to the top of the stack. Optionally 148you can provide arguments that will be passed into the constructor for the 149L<Test2::Hub> object. 150 151If you specify the C<< 'class' => $class >> argument, the new hub will be an 152instance of the specified class. 153 154Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the 155formatter and IPC instance will be inherited from the current top hub. You can 156set the parameters to C<undef> to avoid having a formatter or IPC instance. 157 158If there is no top hub, and you do not ask to leave IPC and formatter undef, 159then a new formatter will be created, and the IPC instance from 160L<Test2::API> will be used. 161 162=item $hub = $stack->top() 163 164This will return the top hub from the stack. If there is no top hub yet this 165will create it. 166 167=item $hub = $stack->peek() 168 169This will return the top hub from the stack. If there is no top hub yet this 170will return undef. 171 172=item $stack->cull 173 174This will call C<< $hub->cull >> on all hubs in the stack. 175 176=item @hubs = $stack->all 177 178This will return all the hubs in the stack as a list. 179 180=item $stack->clear 181 182This will completely remove all hubs from the stack. Normally you do not want 183to do this, but there are a few valid reasons for it. 184 185=item $stack->push($hub) 186 187This will push the new hub onto the stack. 188 189=item $stack->pop($hub) 190 191This will pop a hub from the stack, if the hub at the top of the stack does not 192match the hub you expect (passed in as an argument) it will throw an exception. 193 194=back 195 196=head1 SOURCE 197 198The source code repository for Test2 can be found at 199L<https://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 219Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>. 220 221This program is free software; you can redistribute it and/or 222modify it under the same terms as Perl itself. 223 224See L<https://dev.perl.org/licenses/> 225 226=cut 227