File Coverage

blib/lib/Test/Stream/Plugin/IPC.pm
Criterion Covered Total %
statement 51 51 100.0
branch 13 14 92.8
condition n/a
subroutine 10 10 100.0
pod 0 2 0.0
total 74 77 96.1


line stmt bran cond sub pod time code
1             package Test::Stream::Plugin::IPC;
2 97     97   1002 use strict;
  97         244  
  97         2429  
3 97     97   545 use warnings;
  97         159  
  97         2324  
4              
5 97     97   48685 use Test::Stream::IPC;
  97         291  
  97         414  
6              
7 97     97   60226 use Test::Stream::Context qw/context/;
  97         301  
  97         672  
8 97     97   703 use Test::Stream::Util qw/pkg_to_file/;
  97         201  
  97         533  
9 97     97   542 use Carp qw/croak confess/;
  97         206  
  97         5547  
10              
11 97     97   58246 use Test::Stream::Plugin;
  97         254  
  97         406  
12              
13             sub load_ts_plugin {
14 120     120 0 289 my $class = shift;
15 120         256 my $caller = shift;
16              
17 120         242 my @drivers;
18             my %params;
19              
20 120         337 for my $arg (@_) {
21 8 100       47 if ($arg =~ m/^-(.*)$/) {
    100          
22 5         21 $params{$1}++;
23             }
24             elsif ($arg =~ m/^\+(.+)$/) {
25 1         4 push @drivers => $1;
26             }
27             else {
28 2         8 push @drivers => "Test::Stream::IPC::$arg";
29             }
30             }
31              
32 120         285 for my $driver (@drivers) {
33 3         7 my $file = pkg_to_file($driver);
34 3 100       6 unless(eval { require $file; 1 }) {
  3         23  
  1         407  
35 2         162 my $error = $@;
36 2 50       10 die $error unless $error =~ m/^Can't locate/;
37 2         7 next;
38             }
39 1         8 Test::Stream::IPC->register_driver($driver);
40             }
41              
42 120 100       458 Test::Stream::IPC->enable_polling if delete $params{poll};
43              
44 120 100       401 if (delete $params{cull}) {
45 97     97   601 no strict 'refs';
  97         212  
  97         17694  
46 3         6 *{"$caller->[0]\::cull"} = \&cull
  3         16  
47             }
48              
49 120 100       1065 if (my @bad = keys %params) {
50 1         3 confess "Invalid parameters: " . join ', ', map { "'-$_'" } @bad;
  1         203  
51             }
52             }
53              
54             sub cull {
55 1     1 0 7 my $ctx = context();
56 1         5 $ctx->hub->cull;
57 1         5 $ctx->release;
58             }
59              
60             1;
61              
62             __END__