Log/Dispatch/Tangram.pm

#################################
#
#  $Id: Tangram.pm,v 1.1 2002/10/10 03:44:42 cvsjoko Exp $
#
#  $Log: Tangram.pm,v $
#  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.1 $ =~ /: (\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}->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	cvsjoko	1.2	# $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	cvsjoko	1.1	#
9			#
10			#################################
11
12			package Log::Dispatch::Tangram;
13
14			use strict;
15	cvsjoko	1.2	use warnings;
16	cvsjoko	1.1
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	cvsjoko	1.2	$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /: (\d+)\.(\d+)/;
25	cvsjoko	1.1
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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26