File Coverage

blib/lib/Log/Log4perl/Appender/Screen.pm
Criterion Covered Total %
statement 21 26 80.7
branch 6 14 42.8
condition 0 3 0.0
subroutine 5 5 100.0
pod 1 2 50.0
total 33 50 66.0


line stmt bran cond sub pod time code
1             ##################################################
2             ##################################################
3              
4             our @ISA = qw(Log::Log4perl::Appender);
5              
6             use warnings;
7 8     8   1999 use strict;
  8         16  
  8         251  
8 8     8   37  
  8         13  
  8         149  
9             use IO::Handle;
10 8     8   2483  
  8         28465  
  8         1860  
11             ##################################################
12             ##################################################
13             my($class, @options) = @_;
14              
15 13     13 1 50 my $self = {
16             autoflush => 0,
17 13         54 name => "unknown name",
18             stderr => 1,
19             utf8 => undef,
20             @options,
21             };
22              
23             if( $self->{utf8} ) {
24             if( $self->{stderr} ) {
25 13 100       35 binmode STDERR, ":utf8";
26 1 50       4 } else {
27 1         5 binmode STDOUT, ":utf8";
28             }
29 0         0 }
30              
31             if( $self->{autoflush} ) {
32             if( $self->{stderr} ) {
33 13 50       31 STDERR->autoflush(1);
34 0 0       0 } else {
35 0         0 STDOUT->autoflush(1);
36             }
37 0         0 }
38              
39             bless $self, $class;
40             }
41 13         38  
42             ##################################################
43             ##################################################
44             my($self, %params) = @_;
45              
46             my $fh = \*STDOUT;
47 17     17 0 62 if (ref $self->{stderr}) {
48             $fh = \*STDERR if $self->{stderr}{ $params{'log4p_level'} }
49 17         31 || $self->{stderr}{ lc $params{'log4p_level'} };
50 17 50       59 } elsif ($self->{stderr}) {
    50          
51             $fh = \*STDERR;
52 0 0 0     0 }
53              
54 17         25 print $fh $params{message};
55             }
56              
57 17         419 1;
58              
59              
60             =encoding utf8
61              
62             =head1 NAME
63              
64             Log::Log4perl::Appender::Screen - Log to STDOUT/STDERR
65              
66             =head1 SYNOPSIS
67              
68             use Log::Log4perl::Appender::Screen;
69              
70             my $app = Log::Log4perl::Appender::Screen->new(
71             autoflush => 1,
72             stderr => 0,
73             utf8 => 1,
74             );
75              
76             $file->log(message => "Log me\n");
77              
78             =head1 DESCRIPTION
79              
80             This is a simple appender for writing to STDOUT or STDERR.
81              
82             The constructor C<new()> takes an optional parameter C<stderr>:
83              
84             =over
85              
86             =item *
87              
88             If set to a false value, it will log all levels to STDOUT (or, more
89             accurately, whichever file handle is selected via C<select()>, STDOUT
90             by default).
91              
92             =item *
93              
94             If set to a hash, then any C<log4p_level> with a truthy value will
95             dynamically use STDERR, or STDOUT otherwise.
96              
97             =item *
98              
99             Otherwise, if a true value (the default setting is 1), messages will be
100             logged to STDERR.
101              
102             =back
103              
104             # All messages/levels to STDERR
105             my $app = Log::Log4perl::Appender::Screen->new(
106             stderr => 1,
107             );
108              
109             # Only ERROR and FATAL to STDERR (case-sensitive)
110             my $app = Log::Log4perl::Appender::Screen->new(
111             stderr => { ERROR => 1, FATAL => 1},
112             );
113              
114             Design and implementation of this module has been greatly inspired by
115             Dave Rolsky's C<Log::Dispatch> appender framework.
116              
117             To enable printing wide utf8 characters, set the utf8 option to a true
118             value:
119              
120             my $app = Log::Log4perl::Appender::Screen->new(
121             stderr => 1,
122             utf8 => 1,
123             );
124              
125             This will issue the necessary binmode command to the selected output
126             channel (stderr/stdout).
127              
128             To enable L<autoflush|perlvar/"HANDLE-E<gt>autoflush( EXPR )">, set the
129             C<autoflush> option to a true value:
130              
131             my $app = Log::Log4perl::Appender::Screen->new(
132             autoflush => 1,
133             );
134              
135             This will issue the necessary autoflush command to the selected output
136             channel (stderr/stdout).
137              
138             This is required in containers, especially when the log volume is low, to
139             not buffer the log messages and cause a significant delay.
140              
141             =head1 LICENSE
142              
143             Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt>
144             and Kevin Goess E<lt>cpan@goess.orgE<gt>.
145              
146             This library is free software; you can redistribute it and/or modify
147             it under the same terms as Perl itself.
148              
149             =head1 AUTHOR
150              
151             Please contribute patches to the project on Github:
152              
153             http://github.com/mschilli/log4perl
154              
155             Send bug reports or requests for enhancements to the authors via our
156              
157             MAILING LIST (questions, bug reports, suggestions/patches):
158             log4perl-devel@lists.sourceforge.net
159              
160             Authors (please contact them via the list above, not directly):
161             Mike Schilli <m@perlmeister.com>,
162             Kevin Goess <cpan@goess.org>
163              
164             Contributors (in alphabetical order):
165             Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
166             Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
167             Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
168             Grundman, Paul Harrington, Alexander Hartmaier David Hull,
169             Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter,
170             Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope,
171             Lars Thegler, David Viner, Mac Yang.
172