lib/Stem/Log.pm

   1 #  File: Stem/Log.pm
   2
   3 #  This file is part of Stem.
   4 #  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
   5
   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.
  10
  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.
  15
  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
  19
  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:
  23
  24 #       Stem Systems, Inc.              781-643-7504
  25 #       79 Everett St.                  info@stemsystems.com
  26 #       Arlington, MA 02474
  27 #       USA
  28
  29 use strict ;
  30
  31 use Stem::Log::Entry ;
  32 use Stem::Log::File ;
  33
  34 my %logs ;
  35
  36 package Stem::Log ;
  37
  38 use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
  39 use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
  40
  41
  42 use Data::Dumper ;
  43
  44 use Stem::Vars ;
  45
  46 Stem::Route::register_class( __PACKAGE__, 'log' ) ;
  47
  48 my $attr_spec = [
  49
  50         {
  51                 'name'          => 'name',
  52                 'required'      => 1,
  53                 'help'          => <<HELP,
  54 Name of this logical log.
  55 HELP
  56         },
  57         {
  58                 'name'          => 'file',
  59                 'class'         => 'Stem::Log::File',
  60                 'help'          => <<HELP,
  61 The Stem::Log::File object that will create and manage a physical log file.
  62 HELP
  63         },
  64         {
  65                 'name'          => 'format',
  66                 'default'       => '%T',
  67                 'help'          => <<HELP,
  68 Format to print entries for this logical log. See elsewhere in this
  69 document for the details of the sprintf-like format'
  70 HELP
  71         },
  72         {
  73                 'name'          => 'strftime',
  74                 'default'       => '%C',
  75                 'help'          => <<HELP,
  76 Format passed to strftime to print the %f entry format.
  77 HELP
  78         },
  79         {
  80                 'name'          => 'use_gmt',
  81                 'default'       => 1,
  82                 'type'          => 'boolean',
  83                 'help'          => <<HELP,
  84 Make strftime use gmtime instead of localtime to break the log entry
  85 timestamp into its parts.
  86 HELP
  87         },
  88         {
  89                 'name'          => 'filters',
  90                 'help'          => <<HELP,
  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.
  93 HELP
  94         },
  95
  96 ] ;
  97
  98
  99 sub new {
 100
 101         my( $class ) = shift ;
 102
 103         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
 104         return $self unless ref $self ;
 105
 106         $logs{ $self->{'name'} } = $self ;
 107
 108         return ;
 109 }
 110
 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
 113
 114 my %filter_to_code = (
 115
 116         'match_text'    => sub { $_[0]->{'text'}  =~ /$_[1]/ },
 117         'match_label'   => sub { $_[0]->{'label'} =~ /$_[1]/ },
 118
 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] },
 124
 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 ) },
 130
 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,
 142
 143         'custom'        => \&_custom_filter,
 144 ) ;
 145
 146 my %flag_to_code = (
 147
 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 },
 155 ) ;
 156
 157 sub submit {
 158
 159         my( $self, $entry ) = @_ ;
 160
 161         $entry->{'format'} = $self->{'format'} ;
 162         $entry->{'strftime'} = $self->{'strftime'} ;
 163         $entry->{'use_gmt'} = $self->{'use_gmt'} ;
 164
 165         my $filter_list = $self->{'filters'} ;
 166
 167         unless ( $filter_list ) {
 168
 169 # no filter so the default is to log to the file
 170
 171                 _action_file( $entry, 0, $self ) ;
 172
 173                 return ;
 174         }
 175
 176 # start with all actions enabled
 177
 178         $entry->{'flag'} = 1 ;
 179
 180 # scan the filter list by pairs
 181
 182         for( my $i = 0 ; $i < @{$filter_list} ; $i += 2 ) {
 183
 184                 my ( $filter_key, $filter_arg ) =
 185                                 @{$filter_list}[$i, $i + 1] ;
 186
 187 # handle the flag operations first.
 188
 189                 if ( $filter_key eq 'flag' ) {
 190
 191                         if ( my $code = $flag_to_code{ $filter_arg } ) {
 192
 193                                 $code->( $entry ) ;
 194                         }
 195
 196                         next ;
 197                 }
 198
 199 # skip this filter rule/action if the flag is false
 200
 201                 next unless $entry->{'flag'} && ! $entry->{'invert_test'} ;
 202
 203 # check for and remove a 'not_' prefix
 204
 205                 my $not = $filter_key =~ s/^not_(\w+)$/$1/ ;
 206
 207 #print "FILT $filter_key $filter_arg\n" ;
 208
 209                 my $code = $filter_to_code{ $filter_key } ;
 210
 211                 next unless $code ;
 212
 213 # execute the rule/action code
 214
 215                 my $flag_val = $code->( $entry, $filter_arg, $self ) ;
 216
 217 # don't mung the flag unless we get a boolean return
 218
 219                 next unless defined( $flag_val ) ;
 220
 221 # invert the returned flag value if needed
 222
 223                 $flag_val = ! $flag_val if $not ;
 224
 225 # do the right boolean op
 226
 227                 if ( $entry->{'or'} ) {
 228
 229                         $entry->{'flag'} ||= $flag_val ;
 230                 }
 231                 else {
 232
 233                         $entry->{'flag'} &&= $flag_val ;
 234                 }
 235         }
 236 }
 237
 238
 239 sub _format_entry {
 240
 241         my( $entry ) = @_ ;
 242
 243         my $formatted = $entry->{'format'} ;
 244
 245         $formatted =~ s/%(.)/_format_field( $entry, $1 )/seg ;
 246
 247         return $formatted ;
 248 }
 249
 250 my %letter_to_key = (
 251
 252         'T'     => 'text',
 253         't'     => 'time',
 254         'L'     => 'label',
 255         'l'     => 'level',
 256         'H'     => 'hub_name',
 257         'h'     => 'host_name',
 258         'P'     => 'program_name',
 259 ) ;
 260
 261 sub _format_field {
 262
 263         my( $entry, $letter ) = @_ ;
 264
 265         if ( my $key = $letter_to_key{ $letter } ) {
 266
 267                 return $entry->{$key} ;
 268         }
 269
 270         if ( $letter eq 'f' ) {
 271
 272                 require POSIX ;
 273
 274                 $entry->{'formatted_time'} ||= do {
 275
 276                         my @times = ( $entry->{'use_gmt'} ) ?
 277                                         gmtime( $entry->{'time'} ) :
 278                                         localtime( $entry->{'time'} ) ;
 279
 280                         POSIX::strftime( $entry->{'strftime'}, @times ) ;
 281                 } ;
 282
 283                 return $entry->{'formatted_time'} ;
 284         }
 285
 286         return $letter ;
 287 }
 288
 289 sub _action_file {
 290
 291         my( $entry, $arg, $log_obj ) = @_ ;
 292
 293         my $file = $log_obj->{'file'} ;
 294
 295         $file or return ;
 296
 297         $entry->{'formatted'} ||= _format_entry( $entry ) ;
 298
 299         $file->write( $entry->{'formatted'} ) ;
 300
 301         return ;
 302 }
 303
 304 sub _action_stdout {
 305
 306         my( $entry ) = shift ;
 307
 308         $entry->{'formatted'} ||= _format_entry( $entry ) ;
 309
 310         print STDOUT $entry->{'formatted'} ;
 311
 312         return ;
 313 }
 314
 315 sub _action_stderr {
 316
 317         my( $entry ) = shift ;
 318
 319         $entry->{'formatted'} ||= _format_entry( $entry ) ;
 320
 321         print STDERR $entry->{'formatted'} ;
 322
 323         return ;
 324 }
 325
 326 sub _action_write {
 327
 328         my( $entry, $arg ) = @_ ;
 329
 330         $entry->{'formatted'} ||= _format_entry( $entry ) ;
 331
 332         my @users = ref $arg ? @{$arg} : $arg ;
 333
 334         foreach my $user ( @users ) {
 335
 336                 system <<SYS ;
 337 /bin/echo '$entry->{'formatted'}' | write $user >/dev/null 2>&1 &
 338 SYS
 339         }
 340
 341         return ;
 342 }
 343
 344 sub _action_wall {
 345
 346         my( $entry ) = shift ;
 347
 348         $entry->{'formatted'} ||= _format_entry( $entry ) ;
 349
 350
 351         system <<SYS ;
 352 /bin/echo '$entry->{'formatted'}' | wall &
 353 SYS
 354
 355         return ;
 356 }
 357
 358 # handle to write log entries to /dev/tty
 359
 360 my $tty_fh ;
 361
 362 sub _action_dev_tty {
 363
 364         my( $entry ) = shift ;
 365
 366         $tty_fh ||= IO::File->new( ">/dev/tty" ) ;
 367
 368         unless( $tty_fh ) {
 369
 370                 warn "can't open log file /dev/tty $!" ;
 371                 return ;
 372         }
 373
 374         $entry->{'formatted'} ||= _format_entry( $entry ) ;
 375
 376         print $tty_fh $entry->{'formatted'} ;
 377
 378         return ;
 379 }
 380
 381 sub _action_console {
 382
 383         my( $entry ) = shift ;
 384
 385         $entry->{'formatted'} ||= _format_entry( $entry ) ;
 386
 387         return unless Stem::Console->can( 'write' ) ;
 388
 389         Stem::Console->write( $entry->{'formatted'} ) ;
 390
 391         return ;
 392 }
 393
 394 sub _action_forward {
 395
 396         my( $entry, $arg ) = @_ ;
 397
 398         my @logs = ref $arg ? @{$arg} : $arg ;
 399
 400         my $entry_obj = $entry->{'entry_obj'} ;
 401
 402         $entry_obj->submit( @logs ) ;
 403
 404         return ;
 405 }
 406
 407 sub _action_email {
 408
 409         my( $entry, $arg ) = @_ ;
 410
 411         $entry->{'formatted'} ||= _format_entry( $entry ) ;
 412
 413         my ( $email_addr, $subject ) = ( ref $arg ) ?
 414                                 @{$arg} : ( $arg, 'Stem::Log' ) ;
 415
 416 #print "EMAIL  $email_addr: $subject\n" ;
 417
 418         require Mail::Send ;
 419
 420         my $mail = Mail::Send->new(
 421                         'To'    => $email_addr,
 422                         'Subject' => $subject
 423         ) ;
 424
 425         my $fh = $mail->open();
 426
 427         $fh->print( $entry->{'formatted'} ) ;
 428
 429         $fh->close;
 430
 431         return ;
 432 }
 433
 434 sub _custom_filter {
 435
 436         my( $entry, $arg ) = @_ ;
 437
 438 #####
 439 # do this
 440 #####
 441
 442         return ;
 443 }
 444
 445 sub find_log {
 446
 447         my ( $log_name ) = @_ ;
 448
 449         return( $logs{ $log_name } ) ;
 450 }
 451
 452 sub status_cmd {
 453
 454         my $status_text .= sprintf( "%-20s%-40s%10s\n",
 455                                                 "Logical Log",
 456                                                 "Physical File",
 457                                                 "Size" ) ;
 458         $status_text .= sprintf "-" x 70 . "\n";
 459
 460         foreach my $log_name ( sort keys %logs ) {
 461
 462                 my $ref = $logs{$log_name} ;
 463
 464                 $status_text .= sprintf "%-20s%-40s%10s\n",
 465                                                      $log_name,
 466                                                      $ref->{'file'}{'path'},
 467                                                      $ref->{'file'}{'size'} ;
 468         }
 469
 470         $status_text .= "\n\n" ;
 471
 472         return $status_text ;
 473 }
 474
 475 1 ;