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