summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test2/API/Stack.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Stack.pm220
1 files changed, 220 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm b/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm
new file mode 100755
index 00000000000..534cd78d1ba
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm
@@ -0,0 +1,220 @@
+package Test2::API::Stack;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Test2::Hub();
+
+use Carp qw/confess/;
+
+sub new {
+ my $class = shift;
+ return bless [], $class;
+}
+
+sub new_hub {
+ my $self = shift;
+ my %params = @_;
+
+ my $class = delete $params{class} || 'Test2::Hub';
+
+ my $hub = $class->new(%params);
+
+ if (@$self) {
+ $hub->inherit($self->[-1], %params);
+ }
+ else {
+ require Test2::API;
+ $hub->format(Test2::API::test2_formatter()->new)
+ unless $hub->format || exists($params{formatter});
+
+ my $ipc = Test2::API::test2_ipc();
+ if ($ipc && !$hub->ipc && !exists($params{ipc})) {
+ $hub->set_ipc($ipc);
+ $ipc->add_hub($hub->hid);
+ }
+ }
+
+ push @$self => $hub;
+
+ $hub;
+}
+
+sub top {
+ my $self = shift;
+ return $self->new_hub unless @$self;
+ return $self->[-1];
+}
+
+sub peek {
+ my $self = shift;
+ return @$self ? $self->[-1] : undef;
+}
+
+sub cull {
+ my $self = shift;
+ $_->cull for reverse @$self;
+}
+
+sub all {
+ my $self = shift;
+ return @$self;
+}
+
+sub clear {
+ my $self = shift;
+ @$self = ();
+}
+
+# Do these last without keywords in order to prevent them from getting used
+# when we want the real push/pop.
+
+{
+ no warnings 'once';
+
+ *push = sub {
+ my $self = shift;
+ my ($hub) = @_;
+ $hub->inherit($self->[-1]) if @$self;
+ push @$self => $hub;
+ };
+
+ *pop = sub {
+ my $self = shift;
+ my ($hub) = @_;
+ confess "No hubs on the stack"
+ unless @$self;
+ confess "You cannot pop the root hub"
+ if 1 == @$self;
+ confess "Hub stack mismatch, attempted to pop incorrect hub"
+ unless $self->[-1] == $hub;
+ pop @$self;
+ };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::Stack - Object to manage a stack of L<Test2::Hub>
+instances.
+
+=head1 ***INTERNALS NOTE***
+
+B<The internals of this package are subject to change at any time!> The public
+methods provided will not change in backwards incompatible ways, but the
+underlying implementation details might. B<Do not break encapsulation here!>
+
+=head1 DESCRIPTION
+
+This module is used to represent and manage a stack of L<Test2::Hub>
+objects. Hubs are usually in a stack so that you can push a new hub into place
+that can intercept and handle events differently than the primary hub.
+
+=head1 SYNOPSIS
+
+ my $stack = Test2::API::Stack->new;
+ my $hub = $stack->top;
+
+=head1 METHODS
+
+=over 4
+
+=item $stack = Test2::API::Stack->new()
+
+This will create a new empty stack instance. All arguments are ignored.
+
+=item $hub = $stack->new_hub()
+
+=item $hub = $stack->new_hub(%params)
+
+=item $hub = $stack->new_hub(%params, class => $class)
+
+This will generate a new hub and push it to the top of the stack. Optionally
+you can provide arguments that will be passed into the constructor for the
+L<Test2::Hub> object.
+
+If you specify the C<< 'class' => $class >> argument, the new hub will be an
+instance of the specified class.
+
+Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the
+formatter and IPC instance will be inherited from the current top hub. You can
+set the parameters to C<undef> to avoid having a formatter or IPC instance.
+
+If there is no top hub, and you do not ask to leave IPC and formatter undef,
+then a new formatter will be created, and the IPC instance from
+L<Test2::API> will be used.
+
+=item $hub = $stack->top()
+
+This will return the top hub from the stack. If there is no top hub yet this
+will create it.
+
+=item $hub = $stack->peek()
+
+This will return the top hub from the stack. If there is no top hub yet this
+will return undef.
+
+=item $stack->cull
+
+This will call C<< $hub->cull >> on all hubs in the stack.
+
+=item @hubs = $stack->all
+
+This will return all the hubs in the stack as a list.
+
+=item $stack->clear
+
+This will completely remove all hubs from the stack. Normally you do not want
+to do this, but there are a few valid reasons for it.
+
+=item $stack->push($hub)
+
+This will push the new hub onto the stack.
+
+=item $stack->pop($hub)
+
+This will pop a hub from the stack, if the hub at the top of the stack does not
+match the hub you expect (passed in as an argument) it will throw an exception.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut