cpan/Test-Simple/lib/Test2/IPC/Driver.pm

   1 package Test2::IPC::Driver;
   2 use strict;
   3 use warnings;
   4
   5 our $VERSION = '1.302071';
   6
   7
   8 use Carp qw/confess longmess/;
   9 use Test2::Util::HashBase qw{no_fatal};
  10
  11 use Test2::API qw/test2_ipc_add_driver/;
  12
  13 my %ADDED;
  14 sub import {
  15     my $class = shift;
  16     return if $class eq __PACKAGE__;
  17     return if $ADDED{$class}++;
  18     test2_ipc_add_driver($class);
  19 }
  20
  21 sub use_shm { 0 }
  22
  23 for my $meth (qw/send cull add_hub drop_hub waiting is_viable/) {
  24     no strict 'refs';
  25     *$meth = sub {
  26         my $thing = shift;
  27         confess "'$thing' did not define the required method '$meth'."
  28     };
  29 }
  30
  31 # Print the error and call exit. We are not using 'die' cause this is a
  32 # catastrophic error that should never be caught. If we get here it
  33 # means some serious shit has happened in a child process, the only way
  34 # to inform the parent may be to exit false.
  35
  36 sub abort {
  37     my $self = shift;
  38     chomp(my ($msg) = @_);
  39     print STDERR "IPC Fatal Error: $msg\n";
  40     print STDOUT "not ok - IPC Fatal Error\n";
  41
  42     CORE::exit(255) unless $self->no_fatal;
  43 }
  44
  45 sub abort_trace {
  46     my $self = shift;
  47     my ($msg) = @_;
  48     $self->abort(longmess($msg));
  49 }
  50
  51 1;
  52
  53 __END__
  54
  55 =pod
  56
  57 =encoding UTF-8
  58
  59 =head1 NAME
  60
  61 Test2::IPC::Driver - Base class for Test2 IPC drivers.
  62
  63 =head1 SYNOPSIS
  64
  65     package Test2::IPC::Driver::MyDriver;
  66
  67     use base 'Test2::IPC::Driver';
  68
  69     ...
  70
  71 =head1 METHODS
  72
  73 =over 4
  74
  75 =item $self->abort($msg)
  76
  77 If an IPC encounters a fatal error it should use this. This will print the
  78 message to STDERR with C<'IPC Fatal Error: '> prefixed to it, then it will
  79 forcefully exit 255. IPC errors may occur in threads or processes other than
  80 the main one, this method provides the best chance of the harness noticing the
  81 error.
  82
  83 =item $self->abort_trace($msg)
  84
  85 This is the same as C<< $ipc->abort($msg) >> except that it uses
  86 C<Carp::longmess> to add a stack trace to the message.
  87
  88 =item $false = $self->use_shm
  89
  90 The base class always returns false for this method. You may override it if you
  91 wish to use the SHM made available in L<Test2::API>/L<Test2::API::Instance>.
  92
  93 =back
  94
  95 =head1 LOADING DRIVERS
  96
  97 Test2::IPC::Driver has an C<import()> method. All drivers inherit this import
  98 method. This import method registers the driver.
  99
 100 In most cases you just need to load the desired IPC driver to make it work. You
 101 should load this driver as early as possible. A warning will be issued if you
 102 load it too late for it to be effective.
 103
 104     use Test2::IPC::Driver::MyDriver;
 105     ...
 106
 107 =head1 WRITING DRIVERS
 108
 109     package Test2::IPC::Driver::MyDriver;
 110     use strict;
 111     use warnings;
 112
 113     use base 'Test2::IPC::Driver';
 114
 115     sub is_viable {
 116         return 0 if $^O eq 'win32'; # Will not work on windows.
 117         return 1;
 118     }
 119
 120     sub add_hub {
 121         my $self = shift;
 122         my ($hid) = @_;
 123
 124         ... # Make it possible to contact the hub
 125     }
 126
 127     sub drop_hub {
 128         my $self = shift;
 129         my ($hid) = @_;
 130
 131         ... # Nothing should try to reach the hub anymore.
 132     }
 133
 134     sub send {
 135         my $self = shift;
 136         my ($hid, $e, $global) = @_;
 137
 138         ... # Send the event to the proper hub.
 139
 140         # If you are using the SHM you should notify other procs/threads that
 141         # there is a pending event.
 142         Test2::API::test2_ipc_set_pending($uniq_val);
 143     }
 144
 145     sub cull {
 146         my $self = shift;
 147         my ($hid) = @_;
 148
 149         my @events = ...; # Here is where you get the events for the hub
 150
 151         return @events;
 152     }
 153
 154     sub waiting {
 155         my $self = shift;
 156
 157         ... # Notify all listening procs and threads that the main
 158         ... # process/thread is waiting for them to finish.
 159     }
 160
 161     1;
 162
 163 =head2 METHODS SUBCLASSES MUST IMPLEMENT
 164
 165 =over 4
 166
 167 =item $ipc->is_viable
 168
 169 This should return true if the driver works in the current environment. This
 170 should return false if it does not. This is a CLASS method.
 171
 172 =item $ipc->add_hub($hid)
 173
 174 This is used to alert the driver that a new hub is expecting events. The driver
 175 should keep track of the process and thread ids, the hub should only be dropped
 176 by the proc+thread that started it.
 177
 178     sub add_hub {
 179         my $self = shift;
 180         my ($hid) = @_;
 181
 182         ... # Make it possible to contact the hub
 183     }
 184
 185 =item $ipc->drop_hub($hid)
 186
 187 This is used to alert the driver that a hub is no longer accepting events. The
 188 driver should keep track of the process and thread ids, the hub should only be
 189 dropped by the proc+thread that started it (This is the drivers responsibility
 190 to enforce).
 191
 192     sub drop_hub {
 193         my $self = shift;
 194         my ($hid) = @_;
 195
 196         ... # Nothing should try to reach the hub anymore.
 197     }
 198
 199 =item $ipc->send($hid, $event);
 200
 201 =item $ipc->send($hid, $event, $global);
 202
 203 Used to send events from the current process/thread to the specified hub in its
 204 process+thread.
 205
 206     sub send {
 207         my $self = shift;
 208         my ($hid, $e) = @_;
 209
 210         ... # Send the event to the proper hub.
 211
 212         # If you are using the SHM you should notify other procs/threads that
 213         # there is a pending event.
 214         Test2::API::test2_ipc_set_pending($uniq_val);
 215     }
 216
 217 If C<$global> is true then the driver should send the event to all hubs in all
 218 processes and threads.
 219
 220 =item @events = $ipc->cull($hid)
 221
 222 Used to collect events that have been sent to the specified hub.
 223
 224     sub cull {
 225         my $self = shift;
 226         my ($hid) = @_;
 227
 228         my @events = ...; # Here is where you get the events for the hub
 229
 230         return @events;
 231     }
 232
 233 =item $ipc->waiting()
 234
 235 This is called in the parent process when it is complete and waiting for all
 236 child processes and threads to complete.
 237
 238     sub waiting {
 239         my $self = shift;
 240
 241         ... # Notify all listening procs and threads that the main
 242         ... # process/thread is waiting for them to finish.
 243     }
 244
 245 =back
 246
 247 =head2 METHODS SUBCLASSES MAY IMPLEMENT OR OVERRIDE
 248
 249 =over 4
 250
 251 =item $bool = $ipc->use_shm()
 252
 253 True if you want to make use of the L<Test2::API>/L<Test2::API::Instance> SHM.
 254
 255 =item $bites = $ipc->shm_size()
 256
 257 Use this to customize the size of the SHM space. There are no guarantees about
 258 what the size will be if you do not implement this.
 259
 260 =back
 261
 262 =head1 SOURCE
 263
 264 The source code repository for Test2 can be found at
 265 F<http://github.com/Test-More/test-more/>.
 266
 267 =head1 MAINTAINERS
 268
 269 =over 4
 270
 271 =item Chad Granum E<lt>exodist@cpan.orgE<gt>
 272
 273 =back
 274
 275 =head1 AUTHORS
 276
 277 =over 4
 278
 279 =item Chad Granum E<lt>exodist@cpan.orgE<gt>
 280
 281 =back
 282
 283 =head1 COPYRIGHT
 284
 285 Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 286
 287 This program is free software; you can redistribute it and/or
 288 modify it under the same terms as Perl itself.
 289
 290 See F<http://dev.perl.org/licenses/>
 291
 292 =cut