File Coverage

blib/lib/Log/Any/For/Std.pm
Criterion Covered Total %
statement 19 20 95.0
branch 3 4 75.0
condition 4 6 66.6
subroutine 6 7 85.7
pod n/a
total 32 37 86.4


line stmt bran cond sub pod time code
1             package Log::Any::For::Std;
2              
3             #
4             # Send output of STDERR to Log::Any
5             #
6              
7 2     2   112587 use 5.008001;
  2         8  
8 2     2   11 use strict;
  2         3  
  2         42  
9 2     2   9 use warnings;
  2         7  
  2         73  
10              
11 2     2   2196 use Log::Any '$log', default_adapter => 'Duperr';
  2         16825  
  2         12  
12              
13             our $VERSION = '0.05';
14              
15             #---
16              
17             my $sig;
18              
19             # Value assignment is needed for futher learning in the PRINT method where the message came from
20             $SIG{__DIE__} = sub { die @_ if ( $^S or not defined $^S ); $sig = 'DIE' };
21             $SIG{__WARN__} = sub { $sig = 'WARN'; print STDERR @_ };
22              
23             # We connect the descriptor STDERR with the current packet for interception of all error messages
24             tie *STDERR, __PACKAGE__;
25              
26             # Redefinition of standard constructor for the connnected descriptor STDERR
27             sub TIEHANDLE {
28 2     2   6 my $class = shift;
29              
30 2         8 bless {}, $class;
31             }
32              
33             # Redefinition of standart method PRINT for the connected descriptor STDERR
34             sub PRINT {
35 3     3   167 my ( $self, @msg ) = @_;
36              
37 3         7 chomp(@msg);
38              
39             # Current value in $@ says where the message came from
40 3 50 66     26 if ( defined $sig and $sig eq 'DIE' ) {
    100 66        
41 0         0 $log->emergency(@msg);
42             }
43             elsif ( defined $sig and $sig eq 'WARN' ) {
44 1         8 $log->warning(@msg);
45             }
46             else {
47 2         19 $log->notice(@msg);
48             }
49              
50             # Reset to the default value
51 3         73 undef $sig;
52             }
53              
54             # Redefinition of standard methode BINMODE for the connected descriptor STDERR
55             # In fact this method makes no sense here but it has to be fulfiled for the backward compatibility
56             # with the modules that call this method for their own purposes
57       0     sub BINMODE { }
58              
59             1;
60              
61             __END__