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	#################################
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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26