Log/Dispatch/Tangram.pm

#################################
#
#  $Id: Tangram.pm,v 1.2 2002/10/11 04:48:05 cvsjoko Exp $
#
#  $Log: Tangram.pm,v $
#  Revision 1.2  2002/10/11 04:48:05  cvsjoko
#  + added strictness (use strict, use warnings)
#
#  Revision 1.1  2002/10/10 03:44:42  cvsjoko
#  + new
#
#
#################################

package Log::Dispatch::Tangram;

use strict;
use warnings;

use Log::Dispatch::Output;

use base qw( Log::Dispatch::Output );
#use fields qw( fh filename );

use vars qw[ $VERSION ];

$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /: (\d+)\.(\d+)/;

use POSIX qw(strftime);

# Prevents death later on if IO::File can't export this constant.
BEGIN
{
    my $exists;
    eval { $exists = O_APPEND(); };

    *O_APPEND = \&APPEND unless defined $exists;
}

sub APPEND {;};

1;

sub new
{
    my $proto = shift;
    my $class = ref $proto || $proto;

    my %params = @_;

    my $self = bless {}, $class;

    $self->_basic_init(%params);
    #$self->_make_handle(%params);
    $self->_params_init(%params);

    return $self;
}

sub _params_init {
    my $self = shift;
    my %params = @_;
    
    # todo: do generic / push all args ...
    $self->{storage} = $params{storage};
    $self->{objectCreator} = $params{objectCreator};
    $self->{mapping} = $params{fields};
    $self->{filter_patterns} = $params{filter_patterns};
    
}

sub _make_handle
{
    my $self = shift;
    my %params = @_;

    $self->{filename} = $params{filename};

    my $mode;
    if ( exists $params{mode} &&
         defined $params{mode} &&
         ( $params{mode} =~ /^>>$|^append$/ ||
           ( $params{mode} =~ /^\d+$/ &&
             $params{mode} == O_APPEND() ) ) )
    {
        $mode = '>>';
    }
    else
    {
        $mode = '>';
    }

    my $fh = do { local *FH; *FH; };
    open $fh, "$mode$self->{filename}"
        or die "Can't write to '$self->{filename}': $!";

    # turn on autoflush
    my $oldfh = select $fh; $| = 1; select $oldfh;

    $self->{fh} = $fh;
}

sub log_message
{
    my $self = shift;
    my %params = @_;

    #my $fh = $self->{fh};
    #print $fh $params{message};
    
    #print "MESSAGE TO TANGRAM: ", $params{message}, "\n";
    #print "STORAGE: ", $self->{storage}, "\n";
    #print "CREATOR: ", $self->{objectCreator}, "\n";

    # filter log messages
    foreach my $pattern (@{$self->{filter_patterns}}) {
      #print "pattern: $pattern", "\n";
      #print "pattern: $pattern", "\n";
      #print $params{message}, "\n";
      #print $params{message}, "\n";
      my $bool_dontlog = (grep /$pattern/, $params{message});
      #print "dontlog: $bool_dontlog", "\n";
      #print "result: $bool_dontlog", "\n";
      return if ($bool_dontlog);
    }

    my $sysEvent = $self->{objectCreator}();

    my $now_string = strftime("%Y-%m-%d %H:%M:%S", localtime);
    $sysEvent->{$self->{mapping}{timestamp}} = $now_string;
    $sysEvent->{$self->{mapping}{name}} = $params{name};
    $sysEvent->{$self->{mapping}{level}} = $params{level};
    $sysEvent->{$self->{mapping}{message}} = $params{message};

    $self->{storage}->isConnected() && $self->{storage}->insert($sysEvent);

}

sub DESTROY
{
    my $self = shift;

    if ( $self->{fh} )
    {
        my $fh = $self->{fh};
        close $fh;
    }
}

__END__

=head1 NAME

Log::Dispatch::File - Object for logging to files

=head1 SYNOPSIS

  use Log::Dispatch::File;

  my $file = Log::Dispatch::File->new( name      => 'file1',
                                       min_level => 'info',
                                       filename  => 'Somefile.log',
                                       mode      => 'append' );

  $file->log( level => 'emerg', message => "I've fallen and I can't get up\n" );

=head1 DESCRIPTION

This module provides a simple object for logging to files under the
Log::Dispatch::* system.

=head1 METHODS

=over 4

=item * new(%PARAMS)

This method takes a hash of parameters.  The following options are
valid:

=item -- name ($)

The name of the object (not the filename!).  Required.

=item -- min_level ($)

The minimum logging level this object will accept.  See the
Log::Dispatch documentation for more information.  Required.

=item -- max_level ($)

The maximum logging level this obejct will accept.  See the
Log::Dispatch documentation for more information.  This is not
required.  By default the maximum is the highest possible level (which
means functionally that the object has no maximum).

=item -- filename ($)

The filename to be opened for writing.

=item -- mode ($)

The mode the file should be opened with.  Valid options are 'write',
'>', 'append', '>>', or the relevant constants from Fcntl.  The
default is 'write'.

=item -- callbacks( \& or [ \&, \&, ... ] )

This parameter may be a single subroutine reference or an array
reference of subroutine references.  These callbacks will be called in
the order they are given and passed a hash containing the following keys:

 ( message => $log_message, level => $log_level )

The callbacks are expected to modify the message and then return a
single scalar containing that modified message.  These callbacks will
be called when either the C<log> or C<log_to> methods are called and
will only be applied to a given message once.

=item * log_message( message => $ )

Sends a message to the appropriate output.  Generally this shouldn't
be called directly but should be called through the C<log()> method
(in Log::Dispatch::Output).

=back

=head1 AUTHOR

Dave Rolsky, <autarch@urth.org>

=head1 SEE ALSO

Log::Dispatch, Log::Dispatch::ApacheLog, Log::Dispatch::Email,
Log::Dispatch::Email::MailSend, Log::Dispatch::Email::MailSendmail,
Log::Dispatch::Email::MIMELite, Log::Dispatch::Handle,
Log::Dispatch::Output, Log::Dispatch::Screen, Log::Dispatch::Syslog

=cut
                       
1	cvsjoko	1.1	#################################
2			#
3	joko	1.3	# $Id: Tangram.pm,v 1.2 2002/10/11 04:48:05 cvsjoko Exp $
4	cvsjoko	1.2	#
5			# $Log: Tangram.pm,v $
6	joko	1.3	# Revision 1.2 2002/10/11 04:48:05 cvsjoko
7			# + added strictness (use strict, use warnings)
8			#
9	cvsjoko	1.2	# Revision 1.1 2002/10/10 03:44:42 cvsjoko
10			# + new
11	cvsjoko	1.1	#
12			#
13			#################################
14
15			package Log::Dispatch::Tangram;
16
17			use strict;
18	cvsjoko	1.2	use warnings;
19	cvsjoko	1.1
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	joko	1.3	$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /: (\d+)\.(\d+)/;
28	cvsjoko	1.1
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	joko	1.3	$self->{storage}->isConnected() && $self->{storage}->insert($sysEvent);
136	cvsjoko	1.1
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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26