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