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