1 |
################################# |
2 |
# |
3 |
# $Id$ |
4 |
# |
5 |
# $Log$ |
6 |
# |
7 |
################################# |
8 |
|
9 |
package Log::Dispatch::Tangram; |
10 |
|
11 |
use strict; |
12 |
|
13 |
use Log::Dispatch::Output; |
14 |
|
15 |
use base qw( Log::Dispatch::Output ); |
16 |
#use fields qw( fh filename ); |
17 |
|
18 |
use vars qw[ $VERSION ]; |
19 |
|
20 |
$VERSION = sprintf "%d.%02d", q$Revision: 0.01 $ =~ /: (\d+)\.(\d+)/; |
21 |
|
22 |
use POSIX qw(strftime); |
23 |
|
24 |
# Prevents death later on if IO::File can't export this constant. |
25 |
BEGIN |
26 |
{ |
27 |
my $exists; |
28 |
eval { $exists = O_APPEND(); }; |
29 |
|
30 |
*O_APPEND = \&APPEND unless defined $exists; |
31 |
} |
32 |
|
33 |
sub APPEND {;}; |
34 |
|
35 |
1; |
36 |
|
37 |
sub new |
38 |
{ |
39 |
my $proto = shift; |
40 |
my $class = ref $proto || $proto; |
41 |
|
42 |
my %params = @_; |
43 |
|
44 |
my $self = bless {}, $class; |
45 |
|
46 |
$self->_basic_init(%params); |
47 |
#$self->_make_handle(%params); |
48 |
$self->_params_init(%params); |
49 |
|
50 |
return $self; |
51 |
} |
52 |
|
53 |
sub _params_init { |
54 |
my $self = shift; |
55 |
my %params = @_; |
56 |
|
57 |
# todo: do generic / push all args ... |
58 |
$self->{storage} = $params{storage}; |
59 |
$self->{objectCreator} = $params{objectCreator}; |
60 |
$self->{mapping} = $params{fields}; |
61 |
$self->{filter_patterns} = $params{filter_patterns}; |
62 |
|
63 |
} |
64 |
|
65 |
sub _make_handle |
66 |
{ |
67 |
my $self = shift; |
68 |
my %params = @_; |
69 |
|
70 |
$self->{filename} = $params{filename}; |
71 |
|
72 |
my $mode; |
73 |
if ( exists $params{mode} && |
74 |
defined $params{mode} && |
75 |
( $params{mode} =~ /^>>$|^append$/ || |
76 |
( $params{mode} =~ /^\d+$/ && |
77 |
$params{mode} == O_APPEND() ) ) ) |
78 |
{ |
79 |
$mode = '>>'; |
80 |
} |
81 |
else |
82 |
{ |
83 |
$mode = '>'; |
84 |
} |
85 |
|
86 |
my $fh = do { local *FH; *FH; }; |
87 |
open $fh, "$mode$self->{filename}" |
88 |
or die "Can't write to '$self->{filename}': $!"; |
89 |
|
90 |
# turn on autoflush |
91 |
my $oldfh = select $fh; $| = 1; select $oldfh; |
92 |
|
93 |
$self->{fh} = $fh; |
94 |
} |
95 |
|
96 |
sub log_message |
97 |
{ |
98 |
my $self = shift; |
99 |
my %params = @_; |
100 |
|
101 |
#my $fh = $self->{fh}; |
102 |
#print $fh $params{message}; |
103 |
|
104 |
#print "MESSAGE TO TANGRAM: ", $params{message}, "\n"; |
105 |
#print "STORAGE: ", $self->{storage}, "\n"; |
106 |
#print "CREATOR: ", $self->{objectCreator}, "\n"; |
107 |
|
108 |
# filter log messages |
109 |
foreach my $pattern (@{$self->{filter_patterns}}) { |
110 |
#print "pattern: $pattern", "\n"; |
111 |
#print "pattern: $pattern", "\n"; |
112 |
#print $params{message}, "\n"; |
113 |
#print $params{message}, "\n"; |
114 |
my $bool_dontlog = (grep /$pattern/, $params{message}); |
115 |
#print "dontlog: $bool_dontlog", "\n"; |
116 |
#print "result: $bool_dontlog", "\n"; |
117 |
return if ($bool_dontlog); |
118 |
} |
119 |
|
120 |
my $sysEvent = $self->{objectCreator}(); |
121 |
|
122 |
my $now_string = strftime("%Y-%m-%d %H:%M:%S", localtime); |
123 |
$sysEvent->{$self->{mapping}{timestamp}} = $now_string; |
124 |
$sysEvent->{$self->{mapping}{name}} = $params{name}; |
125 |
$sysEvent->{$self->{mapping}{level}} = $params{level}; |
126 |
$sysEvent->{$self->{mapping}{message}} = $params{message}; |
127 |
|
128 |
$self->{storage}->insert($sysEvent); |
129 |
|
130 |
} |
131 |
|
132 |
sub DESTROY |
133 |
{ |
134 |
my $self = shift; |
135 |
|
136 |
if ( $self->{fh} ) |
137 |
{ |
138 |
my $fh = $self->{fh}; |
139 |
close $fh; |
140 |
} |
141 |
} |
142 |
|
143 |
__END__ |
144 |
|
145 |
=head1 NAME |
146 |
|
147 |
Log::Dispatch::File - Object for logging to files |
148 |
|
149 |
=head1 SYNOPSIS |
150 |
|
151 |
use Log::Dispatch::File; |
152 |
|
153 |
my $file = Log::Dispatch::File->new( name => 'file1', |
154 |
min_level => 'info', |
155 |
filename => 'Somefile.log', |
156 |
mode => 'append' ); |
157 |
|
158 |
$file->log( level => 'emerg', message => "I've fallen and I can't get up\n" ); |
159 |
|
160 |
=head1 DESCRIPTION |
161 |
|
162 |
This module provides a simple object for logging to files under the |
163 |
Log::Dispatch::* system. |
164 |
|
165 |
=head1 METHODS |
166 |
|
167 |
=over 4 |
168 |
|
169 |
=item * new(%PARAMS) |
170 |
|
171 |
This method takes a hash of parameters. The following options are |
172 |
valid: |
173 |
|
174 |
=item -- name ($) |
175 |
|
176 |
The name of the object (not the filename!). Required. |
177 |
|
178 |
=item -- min_level ($) |
179 |
|
180 |
The minimum logging level this object will accept. See the |
181 |
Log::Dispatch documentation for more information. Required. |
182 |
|
183 |
=item -- max_level ($) |
184 |
|
185 |
The maximum logging level this obejct will accept. See the |
186 |
Log::Dispatch documentation for more information. This is not |
187 |
required. By default the maximum is the highest possible level (which |
188 |
means functionally that the object has no maximum). |
189 |
|
190 |
=item -- filename ($) |
191 |
|
192 |
The filename to be opened for writing. |
193 |
|
194 |
=item -- mode ($) |
195 |
|
196 |
The mode the file should be opened with. Valid options are 'write', |
197 |
'>', 'append', '>>', or the relevant constants from Fcntl. The |
198 |
default is 'write'. |
199 |
|
200 |
=item -- callbacks( \& or [ \&, \&, ... ] ) |
201 |
|
202 |
This parameter may be a single subroutine reference or an array |
203 |
reference of subroutine references. These callbacks will be called in |
204 |
the order they are given and passed a hash containing the following keys: |
205 |
|
206 |
( message => $log_message, level => $log_level ) |
207 |
|
208 |
The callbacks are expected to modify the message and then return a |
209 |
single scalar containing that modified message. These callbacks will |
210 |
be called when either the C<log> or C<log_to> methods are called and |
211 |
will only be applied to a given message once. |
212 |
|
213 |
=item * log_message( message => $ ) |
214 |
|
215 |
Sends a message to the appropriate output. Generally this shouldn't |
216 |
be called directly but should be called through the C<log()> method |
217 |
(in Log::Dispatch::Output). |
218 |
|
219 |
=back |
220 |
|
221 |
=head1 AUTHOR |
222 |
|
223 |
Dave Rolsky, <autarch@urth.org> |
224 |
|
225 |
=head1 SEE ALSO |
226 |
|
227 |
Log::Dispatch, Log::Dispatch::ApacheLog, Log::Dispatch::Email, |
228 |
Log::Dispatch::Email::MailSend, Log::Dispatch::Email::MailSendmail, |
229 |
Log::Dispatch::Email::MIMELite, Log::Dispatch::Handle, |
230 |
Log::Dispatch::Output, Log::Dispatch::Screen, Log::Dispatch::Syslog |
231 |
|
232 |
=cut |
233 |
|