Log/Dispatch/Tangram.pm

#################################
#
#  $Id$
#
#  $Log$
#
#################################

package Log::Dispatch::Tangram;

use strict;

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