1package Test2::IPC::Driver; 2use strict; 3use warnings; 4 5our $VERSION = '1.302133'; 6 7 8use Carp qw/confess/; 9use Test2::Util::HashBase qw{no_fatal no_bail}; 10 11use Test2::API qw/test2_ipc_add_driver/; 12 13my %ADDED; 14sub import { 15 my $class = shift; 16 return if $class eq __PACKAGE__; 17 return if $ADDED{$class}++; 18 test2_ipc_add_driver($class); 19} 20 21sub use_shm { 0 } 22 23for 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 36sub 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 48sub 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 551; 56 57__END__ 58 59=pod 60 61=encoding UTF-8 62 63=head1 NAME 64 65Test2::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 81If an IPC encounters a fatal error it should use this. This will print the 82message to STDERR with C<'IPC Fatal Error: '> prefixed to it, then it will 83forcefully exit 255. IPC errors may occur in threads or processes other than 84the main one, this method provides the best chance of the harness noticing the 85error. 86 87=item $self->abort_trace($msg) 88 89This is the same as C<< $ipc->abort($msg) >> except that it uses 90C<Carp::longmess> to add a stack trace to the message. 91 92=item $false = $self->use_shm 93 94The base class always returns false for this method. You may override it if you 95wish to use the SHM made available in L<Test2::API>/L<Test2::API::Instance>. 96 97=back 98 99=head1 LOADING DRIVERS 100 101Test2::IPC::Driver has an C<import()> method. All drivers inherit this import 102method. This import method registers the driver. 103 104In most cases you just need to load the desired IPC driver to make it work. You 105should load this driver as early as possible. A warning will be issued if you 106load 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 173This should return true if the driver works in the current environment. This 174should return false if it does not. This is a CLASS method. 175 176=item $ipc->add_hub($hid) 177 178This is used to alert the driver that a new hub is expecting events. The driver 179should keep track of the process and thread ids, the hub should only be dropped 180by 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 191This is used to alert the driver that a hub is no longer accepting events. The 192driver should keep track of the process and thread ids, the hub should only be 193dropped by the proc+thread that started it (This is the drivers responsibility 194to 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 207Used to send events from the current process/thread to the specified hub in its 208process+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 221If C<$global> is true then the driver should send the event to all hubs in all 222processes and threads. 223 224=item @events = $ipc->cull($hid) 225 226Used 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 239This is called in the parent process when it is complete and waiting for all 240child 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 257This is a hook called by C<< Test2::IPC::Driver->abort() >>. This is your 258chance to cleanup when an abort happens. You cannot prevent the abort, but you 259can gracefully except it. 260 261=item $bool = $ipc->use_shm() 262 263True if you want to make use of the L<Test2::API>/L<Test2::API::Instance> SHM. 264 265=item $bites = $ipc->shm_size() 266 267Use this to customize the size of the SHM space. There are no guarantees about 268what the size will be if you do not implement this. 269 270=back 271 272=head1 SOURCE 273 274The source code repository for Test2 can be found at 275F<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 295Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. 296 297This program is free software; you can redistribute it and/or 298modify it under the same terms as Perl itself. 299 300See F<http://dev.perl.org/licenses/> 301 302=cut 303