File Coverage

blib/lib/Metabrik/Log/Dual.pm
Criterion Covered Total %
statement 9 81 11.1
branch 0 38 0.0
condition 0 18 0.0
subroutine 3 14 21.4
pod 10 10 100.0
total 22 161 13.6


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # log::dual Brik
5             #
6             package Metabrik::Log::Dual;
7 1     1   568 use strict;
  1         2  
  1         68  
8 1     1   7 use warnings;
  1         2  
  1         30  
9              
10 1     1   4 use base qw(Metabrik::Core::Log);
  1         2  
  1         456  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable logging) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             level => [ qw(0|1|2|3) ],
21             output => [ qw(file) ],
22             time_prefix => [ qw(0|1) ],
23             text_prefix => [ qw(0|1) ],
24             _fd => [ qw(file_descriptor) ],
25             },
26             attributes_default => {
27             time_prefix => 0,
28             text_prefix => 0,
29             },
30             commands => {
31             message => [ qw(string caller|OPTIONAL) ],
32             info => [ qw(string caller|OPTIONAL) ],
33             verbose => [ qw(string caller|OPTIONAL) ],
34             warning => [ qw(string caller|OPTIONAL) ],
35             error => [ qw(string caller|OPTIONAL) ],
36             fatal => [ qw(string caller|OPTIONAL) ],
37             debug => [ qw(string caller|OPTIONAL) ],
38             },
39             require_modules => {
40             'Term::ANSIColor' => [ ],
41             },
42             };
43             }
44              
45             sub brik_use_properties {
46 0     0 1   my $self = shift;
47              
48 0           my $datadir = $self->datadir;
49              
50             return {
51 0           attributes_default => {
52             debug => $self->log->debug,
53             level => $self->log->level,
54             output => $datadir.'/output.log',
55             },
56             };
57             }
58              
59             sub brik_init {
60 0     0 1   my $self = shift;
61              
62 0           my $output = $self->output;
63 0 0         open(my $fd, '>>', $output)
64             or return $self->log->error("brik_init: can't open output file [$output]: $!");
65              
66             # Makes the file handle unbuffered
67 0           my $current = select;
68 0           select($fd);
69 0           $|++;
70 0           select($current);
71              
72 0           $self->_fd($fd);
73              
74 0           return $self->SUPER::brik_init;
75             }
76              
77             sub _print {
78 0     0     my $self = shift;
79 0           my ($buffer) = @_;
80              
81 0           my $fd = $self->_fd;
82              
83 0           print $fd $buffer;
84 0           print $buffer;
85              
86 0           return 1;
87             }
88              
89             sub warning {
90 0     0 1   my $self = shift;
91 0           my ($msg, $caller) = @_;
92              
93 0 0         my $prefix = $self->text_prefix ? 'WARN ' : '[!]';
94 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
95 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
96              
97 0           return $self->_print($buffer);
98             }
99              
100             sub error {
101 0     0 1   my $self = shift;
102 0           my ($msg, $caller) = @_;
103              
104 0 0         my $prefix = $self->text_prefix ? 'ERROR' : '[-]';
105 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
106 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
107              
108 0           $self->_print($buffer);
109              
110             # Returning undef is my official way of stating an error occured:
111             # Number 0 is for stating a false condition occured, not not error.
112 0           return;
113             }
114              
115             sub fatal {
116 0     0 1   my $self = shift;
117 0           my ($msg, $caller) = @_;
118              
119 0 0         my $prefix = $self->text_prefix ? 'FATAL' : '[F]';
120 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
121 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
122              
123 0           my $fd = $self->_fd;
124              
125 0           print $fd $buffer;
126 0           die($buffer);
127             }
128              
129             sub info {
130 0     0 1   my $self = shift;
131 0           my ($msg, $caller) = @_;
132              
133 0 0         return 1 unless $self->level > 0;
134              
135 0 0         my $prefix = $self->text_prefix ? 'INFO ' : '[+]';
136 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
137 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
138              
139 0           return $self->_print($buffer);
140             }
141              
142             sub verbose {
143 0     0 1   my $self = shift;
144 0           my ($msg, $caller) = @_;
145              
146 0 0         return 1 unless $self->level > 1;
147              
148 0 0         my $prefix = $self->text_prefix ? 'VERB ' : '[*]';
149 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
150 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
151              
152 0           return $self->_print($buffer);
153             }
154              
155             sub debug {
156 0     0 1   my $self = shift;
157 0           my ($msg, $caller) = @_;
158              
159             # We have a conflict between the method and the accessor,
160             # we have to identify which one is accessed.
161              
162             # If no message defined, we want to access the Attribute
163 0 0         if (! defined($msg)) {
164 0           return $self->{debug};
165             }
166             else {
167             # If $msg is either 1 or 0, we want to set the Attribute
168 0 0         if ($msg =~ /^(?:1|0)$/) {
169 0           return $self->{debug} = $msg;
170             }
171             else {
172 0 0         return 1 unless $self->level > 2;
173              
174 0 0         my $prefix = $self->text_prefix ? 'DEBUG' : '[D]';
175 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
176 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
177              
178 0           $self->_print($buffer);
179             }
180             }
181              
182 0           return 1;
183             }
184              
185             sub brik_fini {
186 0     0 1   my $self = shift;
187              
188 0           my $fd = $self->_fd;
189 0 0         if (defined($fd)) {
190 0           close($fd);
191 0           $self->_fd(undef);
192             }
193              
194 0           return 1;
195             }
196              
197             1;
198              
199             __END__