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