3 # This file is part of Stem.
4 # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
6 # Stem is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # Stem is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with Stem; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 # For a license to use the Stem under conditions other than those
21 # described here, to purchase support for this software, or to purchase a
22 # commercial warranty contract, please contact Stem Systems at:
24 # Stem Systems, Inc. 781-643-7504
25 # 79 Everett St. info@stemsystems.com
31 use Stem::Log::Entry ;
38 use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
39 use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
46 Stem::Route::register_class( __PACKAGE__, 'log' ) ;
54 Name of this logical log.
59 'class' => 'Stem::Log::File',
61 The Stem::Log::File object that will create and manage a physical log file.
68 Format to print entries for this logical log. See elsewhere in this
69 document for the details of the sprintf-like format'
76 Format passed to strftime to print the %f entry format.
84 Make strftime use gmtime instead of localtime to break the log entry
85 timestamp into its parts.
91 List of key/value pairs. The keys are either rules, actions or 'flag'.
92 The value is passed to the function for the key. Use a list for complex values.
101 my( $class ) = shift ;
103 my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
104 return $self unless ref $self ;
106 $logs{ $self->{'name'} } = $self ;
111 # table to convert filter keys to code refs to execute
112 # these are all passed the $entry hash ref, the filter arg and the log object
114 my %filter_to_code = (
116 'match_text' => sub { $_[0]->{'text'} =~ /$_[1]/ },
117 'match_label' => sub { $_[0]->{'label'} =~ /$_[1]/ },
119 'eq_level' => sub { $_[0]->{'level'} == $_[1] },
120 'lt_level' => sub { $_[0]->{'level'} < $_[1] },
121 'le_level' => sub { $_[0]->{'level'} <= $_[1] },
122 'gt_level' => sub { $_[0]->{'level'} > $_[1] },
123 'ge_level' => sub { $_[0]->{'level'} >= $_[1] },
125 'env_eq_level' => sub { $_[0]->{'level'} == ( $Env{ $_[1] } || 0 ) },
126 'env_lt_level' => sub { $_[0]->{'level'} > ( $Env{ $_[1] } || 0 ) },
127 'env_le_level' => sub { $_[0]->{'level'} >= ( $Env{ $_[1] } || 0 ) },
128 'env_gt_level' => sub { $_[0]->{'level'} < ( $Env{ $_[1] } || 0 ) },
129 'env_ge_level' => sub { $_[0]->{'level'} <= ( $Env{ $_[1] } || 0 ) },
131 'file' => \&_action_file,
132 'stdout' => \&_action_stdout,
133 'stderr' => \&_action_stderr,
134 'dev_tty' => \&_action_dev_tty,
135 'console' => \&_action_console,
136 # 'msg' => \&_action_msg,
137 'write' => \&_action_write,
138 'wall' => \&_action_wall,
139 'email' => \&_action_email,
140 'page' => \&_action_page,
141 'forward' => \&_action_forward,
143 'custom' => \&_custom_filter,
148 'set' => sub { $_[0]->{'flag'} = 1 },
149 'clear' => sub { $_[0]->{'flag'} = 0 },
150 'invert' => sub { $_[0]->{'flag'} = ! $_[0]->{'flag'} },
151 'inverted_test' => sub { $_[0]->{'invert_test'} = 1 },
152 'normal_test' => sub { $_[0]->{'invert_test'} = 0 },
153 'or' => sub { $_[0]->{'or'} = 1 },
154 'and' => sub { $_[0]->{'or'} = 0 },
159 my( $self, $entry ) = @_ ;
161 $entry->{'format'} = $self->{'format'} ;
162 $entry->{'strftime'} = $self->{'strftime'} ;
163 $entry->{'use_gmt'} = $self->{'use_gmt'} ;
165 my $filter_list = $self->{'filters'} ;
167 unless ( $filter_list ) {
169 # no filter so the default is to log to the file
171 _action_file( $entry, 0, $self ) ;
176 # start with all actions enabled
178 $entry->{'flag'} = 1 ;
180 # scan the filter list by pairs
182 for( my $i = 0 ; $i < @{$filter_list} ; $i += 2 ) {
184 my ( $filter_key, $filter_arg ) =
185 @{$filter_list}[$i, $i + 1] ;
187 # handle the flag operations first.
189 if ( $filter_key eq 'flag' ) {
191 if ( my $code = $flag_to_code{ $filter_arg } ) {
199 # skip this filter rule/action if the flag is false
201 next unless $entry->{'flag'} && ! $entry->{'invert_test'} ;
203 # check for and remove a 'not_' prefix
205 my $not = $filter_key =~ s/^not_(\w+)$/$1/ ;
207 #print "FILT $filter_key $filter_arg\n" ;
209 my $code = $filter_to_code{ $filter_key } ;
213 # execute the rule/action code
215 my $flag_val = $code->( $entry, $filter_arg, $self ) ;
217 # don't mung the flag unless we get a boolean return
219 next unless defined( $flag_val ) ;
221 # invert the returned flag value if needed
223 $flag_val = ! $flag_val if $not ;
225 # do the right boolean op
227 if ( $entry->{'or'} ) {
229 $entry->{'flag'} ||= $flag_val ;
233 $entry->{'flag'} &&= $flag_val ;
243 my $formatted = $entry->{'format'} ;
245 $formatted =~ s/%(.)/_format_field( $entry, $1 )/seg ;
250 my %letter_to_key = (
258 'P' => 'program_name',
263 my( $entry, $letter ) = @_ ;
265 if ( my $key = $letter_to_key{ $letter } ) {
267 return $entry->{$key} ;
270 if ( $letter eq 'f' ) {
274 $entry->{'formatted_time'} ||= do {
276 my @times = ( $entry->{'use_gmt'} ) ?
277 gmtime( $entry->{'time'} ) :
278 localtime( $entry->{'time'} ) ;
280 POSIX::strftime( $entry->{'strftime'}, @times ) ;
283 return $entry->{'formatted_time'} ;
291 my( $entry, $arg, $log_obj ) = @_ ;
293 my $file = $log_obj->{'file'} ;
297 $entry->{'formatted'} ||= _format_entry( $entry ) ;
299 $file->write( $entry->{'formatted'} ) ;
306 my( $entry ) = shift ;
308 $entry->{'formatted'} ||= _format_entry( $entry ) ;
310 print STDOUT $entry->{'formatted'} ;
317 my( $entry ) = shift ;
319 $entry->{'formatted'} ||= _format_entry( $entry ) ;
321 print STDERR $entry->{'formatted'} ;
328 my( $entry, $arg ) = @_ ;
330 $entry->{'formatted'} ||= _format_entry( $entry ) ;
332 my @users = ref $arg ? @{$arg} : $arg ;
334 foreach my $user ( @users ) {
337 /bin/echo '$entry->{'formatted'}' | write $user >/dev/null 2>&1 &
346 my( $entry ) = shift ;
348 $entry->{'formatted'} ||= _format_entry( $entry ) ;
352 /bin/echo '$entry->{'formatted'}' | wall &
358 # handle to write log entries to /dev/tty
362 sub _action_dev_tty {
364 my( $entry ) = shift ;
366 $tty_fh ||= IO::File->new( ">/dev/tty" ) ;
370 warn "can't open log file /dev/tty $!" ;
374 $entry->{'formatted'} ||= _format_entry( $entry ) ;
376 print $tty_fh $entry->{'formatted'} ;
381 sub _action_console {
383 my( $entry ) = shift ;
385 $entry->{'formatted'} ||= _format_entry( $entry ) ;
387 return unless Stem::Console->can( 'write' ) ;
389 Stem::Console->write( $entry->{'formatted'} ) ;
394 sub _action_forward {
396 my( $entry, $arg ) = @_ ;
398 my @logs = ref $arg ? @{$arg} : $arg ;
400 my $entry_obj = $entry->{'entry_obj'} ;
402 $entry_obj->submit( @logs ) ;
409 my( $entry, $arg ) = @_ ;
411 $entry->{'formatted'} ||= _format_entry( $entry ) ;
413 my ( $email_addr, $subject ) = ( ref $arg ) ?
414 @{$arg} : ( $arg, 'Stem::Log' ) ;
416 #print "EMAIL $email_addr: $subject\n" ;
420 my $mail = Mail::Send->new(
422 'Subject' => $subject
425 my $fh = $mail->open();
427 $fh->print( $entry->{'formatted'} ) ;
436 my( $entry, $arg ) = @_ ;
447 my ( $log_name ) = @_ ;
449 return( $logs{ $log_name } ) ;
454 my $status_text .= sprintf( "%-20s%-40s%10s\n",
458 $status_text .= sprintf "-" x 70 . "\n";
460 foreach my $log_name ( sort keys %logs ) {
462 my $ref = $logs{$log_name} ;
464 $status_text .= sprintf "%-20s%-40s%10s\n",
466 $ref->{'file'}{'path'},
467 $ref->{'file'}{'size'} ;
470 $status_text .= "\n\n" ;
472 return $status_text ;