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   1003 use strict;
  97         228  
  97         2365  
3 97     97   457 use warnings;
  97         160  
  97         2281  
4              
5 97     97   49542 use Test::Stream::IPC;
  97         309  
  97         417  
6              
7 97     97   60196 use Test::Stream::Context qw/context/;
  97         306  
  97         725  
8 97     97   673 use Test::Stream::Util qw/pkg_to_file/;
  97         209  
  97         500  
9 97     97   553 use Carp qw/croak confess/;
  97         197  
  97         5942  
10              
11 97     97   58801 use Test::Stream::Plugin;
  97         257  
  97         412  
12              
13             sub load_ts_plugin {
14 120     120 0 279 my $class = shift;
15 120         326 my $caller = shift;
16              
17 120         244 my @drivers;
18             my %params;
19              
20 120         347 for my $arg (@_) {
21 8 100       44 if ($arg =~ m/^-(.*)$/) {
    100          
22 5         24 $params{$1}++;
23             }
24             elsif ($arg =~ m/^\+(.+)$/) {
25 1         4 push @drivers => $1;
26             }
27             else {
28 2         6 push @drivers => "Test::Stream::IPC::$arg";
29             }
30             }
31              
32 120         288 for my $driver (@drivers) {
33 3         11 my $file = pkg_to_file($driver);
34 3 100       6 unless(eval { require $file; 1 }) {
  3         28  
  1         438  
35 2         169 my $error = $@;
36 2 50       9 die $error unless $error =~ m/^Can't locate/;
37 2         7 next;
38             }
39 1         10 Test::Stream::IPC->register_driver($driver);
40             }
41              
42 120 100       475 Test::Stream::IPC->enable_polling if delete $params{poll};
43              
44 120 100       402 if (delete $params{cull}) {
45 97     97   574 no strict 'refs';
  97         200  
  97         17495  
46 3         7 *{"$caller->[0]\::cull"} = \&cull
  3         16  
47             }
48              
49 120 100       1071 if (my @bad = keys %params) {
50 1         3 confess "Invalid parameters: " . join ', ', map { "'-$_'" } @bad;
  1         242  
51             }
52             }
53              
54             sub cull {
55 1     1 0 6 my $ctx = context();
56 1         6 $ctx->hub->cull;
57 1         4 $ctx->release;
58             }
59              
60             1;
61              
62             __END__