File Coverage

blib/lib/Metabrik/Log/File.pm
Criterion Covered Total %
statement 9 64 14.0
branch 0 18 0.0
condition 0 24 0.0
subroutine 3 14 21.4
pod 10 10 100.0
total 22 130 16.9


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # log::file Brik
5             #
6             package Metabrik::Log::File;
7 1     1   913 use strict;
  1         2  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   4 use base qw(Metabrik::Core::Log);
  1         2  
  1         962  
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 => 1,
28             text_prefix => 1,
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             };
40             }
41              
42             sub brik_use_properties {
43 0     0 1   my $self = shift;
44              
45 0           my $datadir = $self->datadir;
46              
47             return {
48 0           attributes_default => {
49             level => $self->log->level,
50             output => $datadir.'/output.log',
51             },
52             };
53             }
54              
55             sub brik_init {
56 0     0 1   my $self = shift;
57              
58 0           my $output = $self->output;
59 0 0         open(my $fd, '>>', $output)
60             or return $self->log->error("brik_init: can't open output file [$output]: $!");
61              
62 0           $self->log->verbose("brik_init: now logging to file [$output]");
63              
64             # Makes the file handle unbuffered
65 0           my $current = select;
66 0           select($fd);
67 0           $|++;
68 0           select($current);
69              
70 0           $self->_fd($fd);
71              
72 0           return $self->SUPER::brik_init;
73             }
74              
75             sub _print {
76 0     0     my $self = shift;
77 0           my ($msg, $text, $graph, $caller) = @_;
78              
79 0           my $fd = $self->_fd;
80              
81 0 0         my $prefix = $self->text_prefix ? $text : $graph;
82 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
83 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
84              
85 0           print $fd $buffer;
86              
87 0           return 1;
88             }
89              
90             sub warning {
91 0     0 1   my $self = shift;
92 0           my ($msg, $caller) = @_;
93              
94 0   0       return $self->_print($msg, 'WARN ', '[!]', ($caller) ||= caller());
95             }
96              
97             sub error {
98 0     0 1   my $self = shift;
99 0           my ($msg, $caller) = @_;
100              
101 0   0       $self->_print($msg, 'ERROR', '[-]', ($caller) ||= caller());
102              
103             # Returning undef is my official way of stating an error occured:
104             # Number 0 is for stating a false condition occured, not an error.
105 0           return;
106             }
107              
108             sub fatal {
109 0     0 1   my $self = shift;
110 0           my ($msg, $caller) = @_;
111              
112 0   0       $self->_print($msg, 'FATAL', '[F]', ($caller) ||= caller());
113              
114 0 0         my $prefix = $self->text_prefix ? 'FATAL' : '[F]';
115 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
116 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
117              
118 0           die($buffer);
119             }
120              
121             sub info {
122 0     0 1   my $self = shift;
123 0           my ($msg, $caller) = @_;
124              
125 0 0         return 1 unless $self->level > 0;
126              
127 0   0       return $self->_print($msg, 'INFO ', '[+]', ($caller) ||= caller());
128             }
129              
130             sub verbose {
131 0     0 1   my $self = shift;
132 0           my ($msg, $caller) = @_;
133              
134 0 0         return 1 unless $self->level > 1;
135              
136 0   0       return $self->_print($msg, 'VERB ', '[*]', ($caller) ||= caller());
137             }
138              
139             sub debug {
140 0     0 1   my $self = shift;
141 0           my ($msg, $caller) = @_;
142              
143 0 0         return 1 unless $self->level > 2;
144              
145 0   0       $self->_print($msg, 'DEBUG', '[D]', ($caller) ||= caller());
146              
147 0           return 1;
148             }
149              
150             sub brik_fini {
151 0     0 1   my $self = shift;
152              
153 0           my $fd = $self->_fd;
154 0 0         if (defined($fd)) {
155 0           close($fd);
156 0           $self->_fd(undef);
157             }
158              
159 0           return 1;
160             }
161              
162             1;
163              
164             __END__