File Coverage

blib/lib/Log/Dispatch/Pipe.pm
Criterion Covered Total %
statement 40 40 100.0
branch 8 8 100.0
condition 6 9 66.6
subroutine 11 11 100.0
pod 1 2 50.0
total 66 70 94.2


line stmt bran cond sub pod time code
1             package Log::Dispatch::Pipe;
2 3     3   35814 use 5.008001;
  3         6  
3 3     3   12 use strict;
  3         3  
  3         45  
4 3     3   16 use warnings;
  3         2  
  3         145  
5             our $VERSION = "0.06";
6              
7 3     3   1332 use Log::Dispatch 2.00;
  3         30369  
  3         67  
8 3     3   400 use parent 'Log::Dispatch::Output';
  3         208  
  3         16  
9              
10 3     3   3965 use Scalar::Util qw(openhandle);
  3         4  
  3         816  
11              
12             sub new {
13 5     5 1 11346 my ($proto, %params) = @_;
14 5   33     29 my $class = ref $proto || $proto;
15              
16 5         10 my $self = bless {}, $class;
17 5         36 $self->_basic_init(%params);
18 5         530 $self->_init(%params);
19              
20 4         15 $self;
21             }
22              
23             sub _init {
24 5     5   8 my ($self, %params) = @_;
25              
26 5         20 $self->{output_to} = $params{output_to};
27 5         7 $self->{binmode} = $params{binmode};
28              
29 5 100       16 $self->_open_handle if $params{try_at_init};
30             }
31              
32             sub _open_handle {
33 4     4   5 my $self = shift;
34              
35             open my $fh, '|-', $self->{output_to}
36 4 100       5965 or die "Failed opening pipe: $!";
37              
38 2         33 my $oldfh = select $fh;
39 2         11 $| = 1;
40 2         12 select $oldfh;
41              
42             binmode $fh, $self->{binmode}
43 2 100       18 if $self->{binmode};
44              
45 2         5726412 $fh;
46             }
47              
48             sub log_message {
49 3     3 0 247 my ($self, %params) = @_;
50              
51 3   100     16 $self->{fh} ||= $self->_open_handle;
52              
53 2         4 my $fh = $self->{fh};
54 2         47 print $fh $params{message};
55             }
56              
57             sub DESTROY {
58 5     5   2242 my $self = shift;
59 5 100 66     4299 close $self->{fh} if $self->{fh} and openhandle($self->{fh});
60             }
61              
62             1;
63             __END__