From be90c08e4f1458980ea79697de34567fc2ccdaf4 Mon Sep 17 00:00:00 2001 From: erickson Date: Wed, 30 Nov 2005 17:01:19 +0000 Subject: [PATCH] drastically simplified logger code now supports logging to file and syslog logger is backward compatible, but future calls need only have the form: $logger->error($msg); $logger->warn($msg); $logger->info($msg); $logger->debug($msg); $logger->internal($msg); $logger->activity($msg); log message format is not entirely complete yet (haven't added caller info) syslog and file logging have been tested added example config options for log file and activity syslog facility removed convoluted log line from appsession git-svn-id: svn://svn.open-ils.org/OpenSRF/trunk@586 9efc2488-bf62-4759-914b-345cdb29e865 --- examples/bootstrap.conf.example | 7 + src/perlmods/OpenSRF/AppSession.pm | 2 - src/perlmods/OpenSRF/Utils/Logger.pm | 449 +++++++++------------------ 3 files changed, 154 insertions(+), 304 deletions(-) diff --git a/examples/bootstrap.conf.example b/examples/bootstrap.conf.example index add5120..f416c1e 100644 --- a/examples/bootstrap.conf.example +++ b/examples/bootstrap.conf.example @@ -9,6 +9,13 @@ settings_config = /path/to/opensrf.xml # log files directory log_dir = /path/to/log +## Log file is either a file name or syslog: +#logfile = osrfysys.log +logfile = syslog:local0 + +# defines the syslog facility for the activity log +actlog = local1 + # log level debug = ERROR #debug = INFO diff --git a/src/perlmods/OpenSRF/AppSession.pm b/src/perlmods/OpenSRF/AppSession.pm index 8e0b484..b0920dd 100644 --- a/src/perlmods/OpenSRF/AppSession.pm +++ b/src/perlmods/OpenSRF/AppSession.pm @@ -789,9 +789,7 @@ sub queue_wait { if( ! $self->{peer_handle} ) { return 0; } my $timeout = shift || 0; $logger->debug( "Calling queue_wait($timeout)" , DEBUG ); - $logger->debug( "Timestamp before process($timeout) : " . $logger->format_time(), INTERNAL ); my $o = $self->{peer_handle}->process($timeout); - $logger->debug( "Timestamp after process($timeout) : " . $logger->format_time(), INTERNAL ); $self->flush_resend; return $o; } diff --git a/src/perlmods/OpenSRF/Utils/Logger.pm b/src/perlmods/OpenSRF/Utils/Logger.pm index 502c8af..d8944ff 100644 --- a/src/perlmods/OpenSRF/Utils/Logger.pm +++ b/src/perlmods/OpenSRF/Utils/Logger.pm @@ -2,353 +2,198 @@ package OpenSRF::Utils::Logger; use strict; use vars qw($AUTOLOAD @EXPORT_OK %EXPORT_TAGS); use Exporter; +use Unix::Syslog qw(:macros :subs); use base qw/OpenSRF Exporter/; use FileHandle; use Time::HiRes qw(gettimeofday); use OpenSRF::Utils::Config; use Fcntl; -@EXPORT_OK = qw/ NONE ERROR WARN INFO DEBUG INTERNAL /; - -%EXPORT_TAGS = ( level => [ qw/ NONE ERROR WARN INFO DEBUG INTERNAL / ] ); - -# XXX Update documentation - -=head1 Description - -OpenSRF::Utils::Logger - -General purpose logging package. The logger searches $config->logs->$log_name for the -actual file to log to. Any file in the config may be logged to. If the user attempts to -log to a log file that does not exist within the config, then the messages will to -to STDERR. - -There are also a set of predefined log levels. Currently they are -NONE, ERROR, WARN, INFO, DEBUG, INTERNAL, and ALL. You can select one of these log levels -when you send messages to the logger. The message will be logged if it is of equal or greater -'importance' than the global log level, found at $config->system->debug. If you don't specify -a log level, a defaul will be provided. Current defaults are: - -error -> ERROR - -debug -> DEBUG - -transport -> INTERNAL +=head1 -message -> INFO +Logger code -method -> INFO +my $logger = OpenSRF::Utils::Logger; +$logger->error( $msg ); -All others are logged to INFO by default. +For backwards compability, a log level may also be provided to each log +function thereby overriding the level defined by the function. -You write to a log by calling the log's method. - -use OpenSRF::Utils::Logger qw(:level); - -my $logger = "OpenSRF::Utils::Logger"; - -$logger->debug( "degug message" ); -$logger->transport( "debug message", DEBUG ); -$logger->blahalb( "I'll likely end up at STDERR with a log level of INFO" ); - -will only write the time, line number, and file that the method was called from. - -Note also that all messages with a log level of ERROR are written to the "error" log -in addition to the intended log file. +i.e. $logger->error( $msg, WARN ); # logs at log level WARN =cut -# Just set this first and not during every call to the logger -# XXX this should be added to the sig{hup} handler once it exists. - - -############## -# 1. check config, if file exists write to that file locally -# 2. If not in config and set to remote, send to socket. if not remote log to stderr - -my $config; -my $file_hash; -my $trace_active = 0; - -my $port; -my $proto; -my $peer; -my $socket; -my $remote_logging = 0; - -my $LEVEL = "OpenSRF::Utils::LogLevel"; -my $FILE = "OpenSRF::Utils::LogFile"; - -# --- Log levels - values and names - -my $none = $LEVEL->new( 1, "NONE" ); -my $error = $LEVEL->new( 10, "ERRR" ); -my $warn = $LEVEL->new( 20, "WARN" ); -my $info = $LEVEL->new( 30, "INFO" ); -my $debug = $LEVEL->new( 40, "DEBG" ); -my $internal = $LEVEL->new( 50, "INTL" ); -my $all = $LEVEL->new( 100, "ALL " ); - - -sub NONE { return $none; } -sub ERROR { return $error; } -sub WARN { return $warn; } -sub INFO { return $info; } -sub DEBUG { return $debug; } -sub INTERNAL { return $internal; } -sub ALL { return $all; } - -# Known log files and their default log levels -my $known_logs = [ - $FILE->new( "error", &ERROR ), - $FILE->new( "debug", &DEBUG ), - $FILE->new( "transport",&INTERNAL ), - $FILE->new( "message", &INFO ), - $FILE->new( "method", &INFO ), - ]; - - - - -# --------------------------------------------------------- - -{ - my $global_llevel; - sub global_llevel { return $global_llevel; } - - sub set_config { - - $config = OpenSRF::Utils::Config->current; - - if( defined($config) ) { - - $global_llevel = $config->bootstrap->debug; - $port = ""; - $proto = ""; - $peer = ""; - $remote_logging = 0; - - { - no strict "refs"; - $global_llevel = &{$global_llevel}; - } - build_file_hash(); - } - - else { - $global_llevel = DEBUG; - warn "*** Logger found no suitable config. Using STDERR ***\n"; - } - } -} - -sub build_file_hash { - $file_hash = {}; - my $path = $config->bootstrap->log_dir; - $file_hash->{"error"} = join("/",$path,$config->logs->error); - $file_hash->{"transport"} = join("/",$path,$config->logs->transport); - $file_hash->{"debug"} = join("/",$path,$config->logs->debug); -} - -# --------------------------------------------------------- - -sub AUTOLOAD { - +@EXPORT_OK = qw/ NONE ERROR WARN INFO DEBUG INTERNAL /; - my( $self, $string, $llevel ) = @_; - my $log = $AUTOLOAD; - $log =~ s/.*://; # strip fully-qualified portion +%EXPORT_TAGS = ( level => [ qw/ NONE ERROR WARN INFO DEBUG INTERNAL / ] ); - unless( defined($config) or global_llevel() ) { - set_config(); +my $config; # config handle +my $loglevel; # global log level +my $logfile; # log file +my $facility; # syslog facility +my $actlog; # activity log syslog facility +my $service = "osrf"; # default service name +my $syslog_enabled = 0; # is syslog enabled? +my $logfile_enabled = 1; # are we logging to a file? +my $logdir; # log file directory + +# log levels +sub ACTIVITY { return -1; } +sub NONE { return 0; } +sub ERROR { return 1; } +sub WARN { return 2; } +sub INFO { return 3; } +sub DEBUG { return 4; } +sub INTERNAL { return 5; } +sub ALL { return 100; } + +# load up our config options +sub set_config { + + return if defined $config; + + $config = OpenSRF::Utils::Config->current; + if( !defined($config) ) { + $loglevel = INFO(); + warn "*** Logger found no config. Using STDERR ***\n"; } - # Build the sub here so we can use the enclosed $log variable. - # This is some weird Perl s*** that only satan could dream up. - # We mangle the symbol table so that future calls to $logger->blah - # will no longer require the autoload. - # The $log variable (above) will contain the name of the log - # log file the user is attempting to log to. This is true, however, - # even though the above code is presumably run only the first time - # the call to $logger->blah is made. - - no strict "refs"; - - *{$log} = sub { - - if( global_llevel()->level == NONE->level ) { return; } - - my( $class, $string, $llevel ) = @_; - - # see if we can return - if( $llevel ) { - # if level is passed in as a string, cast it to a level object - ref( $llevel ) || do{ $llevel = &{$llevel} }; - return if ($llevel->level > global_llevel()->level); - } - - else { # see if there is a default llevel, set to INFO if not. - my $log_obj; - foreach my $l ( @$known_logs ) { - if( $l->name eq $log ) { $log_obj = $l and last; } - } - if( $log_obj ) { $llevel = $log_obj->def_level; } - else { $llevel = INFO; } - } - + $loglevel = $config->bootstrap->debug; + if($loglevel =~ /error/i){ $loglevel = ERROR(); } + elsif($loglevel =~ /warn/i){ $loglevel = WARN(); } + elsif($loglevel =~ /info/i){ $loglevel = INFO(); } + elsif($loglevel =~ /debug/i){ $loglevel = DEBUG(); } + elsif($loglevel =~ /internal/i){ $loglevel = INTERNAL(); } + else{$loglevel= INFO(); } - # again, see if we can get out of this - return if ($llevel->level > global_llevel()->level); + $logfile = $config->bootstrap->logfile; - my @caller = caller(); - push( @caller, (caller(1))[3] ); - - # In the absense of a config, we write to STDERR - - if( ! defined($config) ) { - _write_stderr( $string, $llevel->name, @caller); - return; - } - - if( $remote_logging ) { - _write_net( $log, $string, $llevel->name, @caller ); - - } elsif ( my $file = $file_hash->{$log} ) { - _write_local( $file, $string, $llevel->name, @caller ); - - } else { - _write_stderr( $string, $llevel->name, @caller); - } + if($logfile =~ /^syslog:/) { + $syslog_enabled = 1; + $logfile_enabled = 0; + $logfile =~ s/^syslog://; + $facility = $logfile; + $facility = _fac_to_const($facility); + if(!$facility) { $facility = LOG_LOCAL0; } + $actlog = $config->bootstrap->actlog; + if(!$actlog) { $actlog = "local1"; } + $actlog = _fac_to_const($actlog); + + } else { + my $logdir = $config->bootstrap->log_dir; + $logfile = "$logdir/$logfile"; + } - - if( $llevel->name eq ERROR->name ) { # send all error to stderr - _write_stderr( $string, $llevel->name, @caller); - } - - if( $llevel->name eq ERROR->name and $log ne "error" ) { - if( my $e_file = $file_hash->{"error"} ) { - if( ! $remote_logging ) { - _write_local( $e_file, $string, $llevel->name, @caller ); - } - } - } - - }; - - $self->$log( $string, $llevel ); + #warn "Level: $loglevel, Fac: $facility, Act: $actlog\n"; } +sub _fac_to_const { + my $name = shift; + return LOG_LOCAL0 unless $name; + return LOG_LOCAL0 if $name =~ /local0/i; + return LOG_LOCAL1 if $name =~ /local1/i; + return LOG_LOCAL2 if $name =~ /local2/i; + return LOG_LOCAL3 if $name =~ /local3/i; + return LOG_LOCAL4 if $name =~ /local4/i; + return LOG_LOCAL5 if $name =~ /local5/i; + return LOG_LOCAL6 if $name =~ /local6/i; + return LOG_LOCAL7 if $name =~ /local7/i; + return LOG_LOCAL0; +} -# write_net expects a log_type_name and not a log_file_name for the first parameter -my $net_buffer = ""; -my $counter = 0; -sub _write_net { - - - my( $log, $string, $llevel, @caller ) = @_; - my( $pack, $file, $line_no ) = @caller; - my @lines = split( "\n", $string ); - - my $message = "$log|"."-" x 33 . - "\n$log|[$0 $llevel] $line_no $pack". - "\n$log|[$0 $llevel] $file"; - - foreach my $line (@lines) { - $message .= "\n$log|[$0 $llevel] $line"; - } - - $net_buffer .= "$message\n"; +sub is_syslog { + set_config() unless defined($config); + return $syslog_enabled; +} - # every 4th load is sent on the socket - if( $counter++ % 4 ) { return; } +sub is_filelog { + set_config() unless defined($config); + return $logfile_enabled; +} - unless( $socket ) { - $socket = IO::Socket::INET->new( - PeerAddr => $peer, - PeerPort => $port, - Proto => $proto ) - or die "Unable to open socket to log server"; +sub set_service { + my( $self, $svc ) = @_; + $service = $svc; + if( is_syslog() ) { + closelog(); + openlog($service, 0, $facility); } +} - $socket->send( $net_buffer ); - $net_buffer = ""; - +sub error { + my( $self, $msg, $level ) = @_; + $level = ERROR() unless defined ($level); + _log_message( $msg, $level ); } -sub _write_local { +sub warn { + my( $self, $msg, $level ) = @_; + $level = WARN() unless defined ($level); + _log_message( $msg, $level ); +} - my( $log, $string, $llevel, @caller ) = @_; - my( $pack, $file, $line_no ) = @caller; - my @lines = split( "\n", $string ); - my $time = format_time(); - sysopen( SINK, $log, O_NONBLOCK|O_WRONLY|O_APPEND|O_CREAT ) - or die "Cannot sysopen $log: $!"; - binmode(SINK, ':utf8'); - print SINK "-" x 23 . "\n"; - print SINK "$time [$0 $llevel] $line_no $pack \n"; - print SINK "$time [$0 $llevel] $file\n"; - foreach my $line (@lines) { - print SINK "$time [$0 $llevel] $line\n"; - } - close( SINK ); +sub info { + my( $self, $msg, $level ) = @_; + $level = INFO() unless defined ($level); + _log_message( $msg, $level ); +} +sub debug { + my( $self, $msg, $level ) = @_; + $level = DEBUG() unless defined ($level); + _log_message( $msg, $level ); } -sub _write_stderr { - my( $string, $llevel, @caller ) = @_; - my( $pack, $file, $line_no ) = @caller; - my @lines = split( "\n", $string ); - my $time = format_time(); - print STDERR "-" x 23 . "\n"; - print STDERR "$time [$0 $llevel] $line_no $pack\n"; - print STDERR "$time [$0 $llevel] $file\n"; - foreach my $line (@lines) { - print STDERR "$time [$0 $llevel] $line\n"; - } +sub internal { + my( $self, $msg, $level ) = @_; + $level = INTERNAL() unless defined ($level); + _log_message( $msg, $level ); } -sub format_time { - my ($s, $ms) = gettimeofday(); - my @time = localtime( $s ); - $ms = substr( $ms, 0, 3 ); - my $year = $time[5] + 1900; - my $mon = $time[4] + 1; - my $day = $time[3]; - my $hour = $time[2]; - my $min = $time[1]; - my $sec = $time[0]; - $mon = "0" . "$mon" if ( length($mon) == 1 ); - $day = "0" . "$day" if ( length($day) == 1 ); - $hour = "0" . "$hour" if ( length($hour) == 1 ); - $min = "0" . "$min" if (length($min) == 1 ); - $sec = "0" . "$sec" if (length($sec) == 1 ); - - my $proc = $$; - while( length( $proc ) < 5 ) { $proc = "0" . "$proc"; } - return "[$year-$mon-$day $hour:$min:$sec.$ms $proc]"; +sub activity { + my( $self, $msg ) = @_; + _log_message( $msg, ACTIVITY() ); } +# for backwards compability +sub transport { + my( $self, $msg, $level ) = @_; + $level = DEBUG() unless defined ($level); + _log_message( $msg, $level ); +} -# ---------------------------------------------- -# --- Models a log level -package OpenSRF::Utils::LogLevel; -sub new { return bless( [ $_[1], $_[2] ], $_[0] ); } -sub level { return $_[0]->[0]; } -sub name { return $_[0]->[1]; } +sub _log_message { + my( $msg, $level ) = @_; + return if $level > $loglevel; + my $l; my $n; + my $fac = $facility; -# ---------------------------------------------- + if ($level == ERROR()) {$l = LOG_ERR, $n = "ERR "; } + elsif ($level == WARN()) {$l = LOG_WARNING, $n = "WARN"; } + elsif ($level == INFO()) {$l = LOG_INFO, $n = "INFO"; } + elsif ($level == DEBUG()) {$l = LOG_DEBUG, $n = "DEBG"; } + elsif ($level == INTERNAL()){$l = LOG_DEBUG, $n = "INTL"; } + elsif ($level == ACTIVITY()){$l = LOG_INFO, $n = "ACT"; $fac = $actlog} -package OpenSRF::Utils::LogFile; -use OpenSRF::Utils::Config; + #my( $pack, $file, $line_no ) = @caller; + if( is_syslog() ) { syslog( $fac | $l, $msg ); } + elsif( is_filelog() ) { _write_file($msg); } +} -sub new{ return bless( [ $_[1], $_[2] ], $_[0] ); } -sub name { return $_[0]->[0]; } -sub def_level { return $_[0]->[1]; } +sub _write_file { + my $msg = shift; + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); + $year += 1900; $mon += 1; + sysopen( SINK, $logfile, O_NONBLOCK|O_WRONLY|O_APPEND|O_CREAT ) + or die "Cannot sysopen $logfile: $!"; + binmode(SINK, ':utf8'); + print SINK "[$year-$mon-$mday $hour:$min:$sec] $service $msg\n"; + close( SINK ); +} -# ---------------------------------------------- 1; -- 2.43.2