File Coverage

blib/lib/Test2/API/Stack.pm
Criterion Covered Total %
statement 52 52 100.0
branch 16 18 88.8
condition 7 11 63.6
subroutine 14 14 100.0
pod 7 7 100.0
total 96 102 94.1


line stmt bran cond sub pod time code
1             package Test2::API::Stack;
2 57     57   183 use strict;
  57         63  
  57         1247  
3 57     57   176 use warnings;
  57         50  
  57         2009  
4              
5             our $VERSION = '0.000043';
6             $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
7              
8 57     57   18920 use Test2::Hub();
  57         84  
  57         1166  
9              
10 57     57   255 use Carp qw/confess/;
  57         110  
  57         15845  
11              
12             sub new {
13 158     158 1 184 my $class = shift;
14 158         429 return bless [], $class;
15             }
16              
17             sub new_hub {
18 135     135 1 166 my $self = shift;
19 135         266 my %params = @_;
20              
21 135   100     575 my $class = delete $params{class} || 'Test2::Hub';
22              
23 135         775 my $hub = $class->new(%params);
24              
25 135 100       312 if (@$self) {
26 59         218 $hub->inherit($self->[-1], %params);
27             }
28             else {
29 76         412 require Test2::API;
30             $hub->format(Test2::API::test2_formatter()->new)
31 76 50 33     315 unless $hub->format || exists($params{formatter});
32              
33 76         276 my $ipc = Test2::API::test2_ipc();
34 76 50 66     355 if ($ipc && !$hub->ipc && !exists($params{ipc})) {
      66        
35 41         122 $hub->set_ipc($ipc);
36 41         123 $ipc->add_hub($hub->hid);
37             }
38             }
39              
40 135         266 push @$self => $hub;
41              
42 135         421 $hub;
43             }
44              
45             sub top {
46 136     136 1 178 my $self = shift;
47 136 100       464 return $self->new_hub unless @$self;
48 60         150 return $self->[-1];
49             }
50              
51             sub peek {
52 2     2 1 3 my $self = shift;
53 2 100       8 return @$self ? $self->[-1] : undef;
54             }
55              
56             sub cull {
57 1     1 1 12 my $self = shift;
58 1         4 $_->cull for reverse @$self;
59             }
60              
61             sub all {
62 82     82 1 130 my $self = shift;
63 82         252 return @$self;
64             }
65              
66             sub clear {
67 2     2 1 17 my $self = shift;
68 2         5 @$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 57     57   291 no warnings 'once';
  57         69  
  57         7609  
76              
77             *push = sub {
78 15     15   22 my $self = shift;
79 15         19 my ($hub) = @_;
80 15 100       58 $hub->inherit($self->[-1]) if @$self;
81 15         22 push @$self => $hub;
82             };
83              
84             *pop = sub {
85 60     60   107 my $self = shift;
86 60         71 my ($hub) = @_;
87 60 100       302 confess "No hubs on the stack"
88             unless @$self;
89 59 100       205 confess "You cannot pop the root hub"
90             if 1 == @$self;
91 58 100       232 confess "Hub stack mismatch, attempted to pop incorrect hub"
92             unless $self->[-1] == $hub;
93 57         126 pop @$self;
94             };
95             }
96              
97             1;
98              
99             __END__