cpan/Test-Simple/lib/Test2/API/Stack.pm

   1 package Test2::API::Stack;
   2 use strict;
   3 use warnings;
   4
   5 our $VERSION = '1.302073';
   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
 113 methods provided will not change in backwards incompatible ways, but the
 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
 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.
 151
 152 If there is no top hub, and you do not ask to leave IPC and formatter undef,
 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