src/perlmods/OpenSRF/Utils/Logger.pm

   1 package OpenSRF::Utils::Logger;
   2 use strict;
   3 use vars qw($AUTOLOAD @EXPORT_OK %EXPORT_TAGS);
   4 use Exporter;
   5 use Unix::Syslog qw(:macros :subs);
   6 use base qw/OpenSRF Exporter/;
   7 use FileHandle;
   8 use Time::HiRes qw(gettimeofday);
   9 use OpenSRF::Utils::Config;
  10 use Fcntl;
  11
  12 =head1
  13
  14 Logger code
  15
  16 my $logger = OpenSRF::Utils::Logger;
  17 $logger->error( $msg );
  18
  19 For backwards compability, a log level may also be provided to each log
  20 function thereby overriding the level defined by the function.
  21
  22 i.e. $logger->error( $msg, WARN );  # logs at log level WARN
  23
  24 =cut
  25
  26 @EXPORT_OK = qw/ NONE ERROR WARN INFO DEBUG INTERNAL /;
  27 push @EXPORT_OK, '$logger';
  28
  29 %EXPORT_TAGS = ( level => [ qw/ NONE ERROR WARN INFO DEBUG INTERNAL / ], logger => [ '$logger' ] );
  30
  31 my $config;                                                     # config handle
  32 my $loglevel;                                           # global log level
  33 my $logfile;                                            # log file
  34 my $facility;                                           # syslog facility
  35 my $actfac;                                                     # activity log syslog facility
  36 my $actfile;                                            # activity log file
  37 my $service = $0;                       # default service name
  38 my $syslog_enabled = 0;                 # is syslog enabled?
  39 my $act_syslog_enabled = 0;     # is syslog enabled?
  40 my $logfile_enabled = 1;                # are we logging to a file?
  41 my $act_logfile_enabled = 1;    # are we logging to a file?
  42
  43 our $logger = "OpenSRF::Utils::Logger";
  44
  45 # log levels
  46 sub ACTIVITY    { return -1; }
  47 sub NONE                        { return 0;     }
  48 sub ERROR               { return 1;     }
  49 sub WARN                        { return 2;     }
  50 sub INFO                        { return 3;     }
  51 sub DEBUG               { return 4;     }
  52 sub INTERNAL    { return 5;     }
  53 sub ALL                 { return 100; }
  54
  55 my $isclient;  # true if we control the osrf_xid
  56
  57 # load up our config options
  58 sub set_config {
  59
  60         return if defined $config;
  61
  62         $config = OpenSRF::Utils::Config->current;
  63         if( !defined($config) ) {
  64                 $loglevel = INFO();
  65                 warn "*** Logger found no config.  Using STDERR ***\n";
  66         }
  67
  68         $loglevel =  $config->bootstrap->loglevel;
  69         if($loglevel = 1){ $loglevel = ERROR(); }
  70         elsif($loglevel = 2){ $loglevel = WARN(); }
  71         elsif($loglevel = 3){ $loglevel = INFO(); }
  72         elsif($loglevel = 4){ $loglevel = DEBUG(); }
  73         elsif($loglevel = 5){ $loglevel = INTERNAL(); }
  74         else{$loglevel= INFO(); }
  75
  76         $logfile = $config->bootstrap->logfile;
  77         if($logfile =~ /^syslog/) {
  78                 $syslog_enabled = 1;
  79                 $logfile_enabled = 0;
  80                 $logfile =~ s/^syslog:?//;
  81                 $facility = $logfile;
  82                 $logfile = undef;
  83                 $facility = _fac_to_const($facility);
  84                 openlog($service, 0, $facility);
  85
  86         } else { $logfile = "$logfile"; }
  87
  88         $actfile = $config->bootstrap->actlog;
  89         if($actfile =~ /^syslog/) {
  90                 $act_syslog_enabled = 1;
  91                 $act_logfile_enabled = 0;
  92                 $actfile =~ s/^syslog:?//;
  93                 $actfac = $actfile || "local1";
  94                 $actfile = undef;
  95                 $actfac = _fac_to_const($actfac);
  96
  97         } else { $actfile = "$actfile"; }
  98
  99         $isclient = (OpenSRF::Utils::Config->current->bootstrap->client =~ /^true$/iog) ?  1 : 0;
 100 }
 101
 102 sub _fac_to_const {
 103         my $name = shift;
 104         return LOG_LOCAL0 unless $name;
 105         return LOG_LOCAL0 if $name =~ /local0/i;
 106         return LOG_LOCAL1 if $name =~ /local1/i;
 107         return LOG_LOCAL2 if $name =~ /local2/i;
 108         return LOG_LOCAL3 if $name =~ /local3/i;
 109         return LOG_LOCAL4 if $name =~ /local4/i;
 110         return LOG_LOCAL5 if $name =~ /local5/i;
 111         return LOG_LOCAL6 if $name =~ /local6/i;
 112         return LOG_LOCAL7 if $name =~ /local7/i;
 113         return LOG_LOCAL0;
 114 }
 115
 116 sub is_syslog {
 117         set_config();
 118         return $syslog_enabled;
 119 }
 120
 121 sub is_act_syslog {
 122         set_config();
 123         return $act_syslog_enabled;
 124 }
 125
 126 sub is_filelog {
 127         set_config();
 128         return $logfile_enabled;
 129 }
 130
 131 sub is_act_filelog {
 132         set_config();
 133         return $act_logfile_enabled;
 134 }
 135
 136 sub set_service {
 137         my( $self, $svc ) = @_;
 138         $service = $svc;
 139         if( is_syslog() ) {
 140                 closelog();
 141                 openlog($service, 0, $facility);
 142         }
 143 }
 144
 145 sub error {
 146         my( $self, $msg, $level ) = @_;
 147         $level = ERROR() unless defined ($level);
 148         _log_message( $msg, $level );
 149 }
 150
 151 sub warn {
 152         my( $self, $msg, $level ) = @_;
 153         $level = WARN() unless defined ($level);
 154         _log_message( $msg, $level );
 155 }
 156
 157 sub info {
 158         my( $self, $msg, $level ) = @_;
 159         $level = INFO() unless defined ($level);
 160         _log_message( $msg, $level );
 161 }
 162
 163 sub debug {
 164         my( $self, $msg, $level ) = @_;
 165         $level = DEBUG() unless defined ($level);
 166         _log_message( $msg, $level );
 167 }
 168
 169 sub internal {
 170         my( $self, $msg, $level ) = @_;
 171         $level = INTERNAL() unless defined ($level);
 172         _log_message( $msg, $level );
 173 }
 174
 175 sub activity {
 176         my( $self, $msg ) = @_;
 177         _log_message( $msg, ACTIVITY() );
 178 }
 179
 180 # for backward compability
 181 sub transport {
 182         my( $self, $msg, $level ) = @_;
 183         $level = DEBUG() unless defined ($level);
 184         _log_message( $msg, $level );
 185 }
 186
 187
 188 # ----------------------------------------------------------------------
 189 # creates a new xid if necessary
 190 # ----------------------------------------------------------------------
 191 my $osrf_xid = '';
 192 my $osrf_xid_inc = 0;
 193 sub mk_osrf_xid {
 194    return unless $isclient;
 195    $osrf_xid_inc++;
 196    return $osrf_xid = "$^T${$}$osrf_xid_inc";
 197 }
 198
 199 sub set_osrf_xid {
 200    return if $isclient; # if we're a client, we control our xid
 201    $osrf_xid = $_[1];
 202 }
 203
 204 sub get_osrf_xid { return $osrf_xid; }
 205 # ----------------------------------------------------------------------
 206
 207
 208 sub _log_message {
 209         my( $msg, $level ) = @_;
 210         return if $level > $loglevel;
 211
 212         my $l; my $n;
 213         my $fac = $facility;
 214
 215         if ($level == ERROR())                  {$l = LOG_ERR; $n = "ERR "; }
 216         elsif ($level == WARN())                {$l = LOG_WARNING; $n = "WARN"; }
 217         elsif ($level == INFO())                {$l = LOG_INFO; $n = "INFO"; }
 218         elsif ($level == DEBUG())               {$l = LOG_DEBUG; $n = "DEBG"; }
 219         elsif ($level == INTERNAL())    {$l = LOG_DEBUG; $n = "INTL"; }
 220         elsif ($level == ACTIVITY())    {$l = LOG_INFO; $n = "ACT"; $fac = $actfac; }
 221
 222         my( undef, $file, $line_no ) = caller(1);
 223    $file =~ s#/.*/##og;
 224
 225         # help syslog with the formatting
 226         $msg =~ s/\%/\%\%/gso if( is_act_syslog() or is_syslog() );
 227
 228         $msg = "[$n:"."$$".":$file:$line_no:$osrf_xid] $msg";
 229
 230         $msg = substr($msg, 0, 1536);
 231
 232         if( $level == ACTIVITY() ) {
 233                 if( is_act_syslog() ) { syslog( $fac | $l, $msg ); }
 234                 elsif( is_act_filelog() ) { _write_file( $msg, 1 ); }
 235
 236         } else {
 237                 if( is_syslog() ) { syslog( $fac | $l, $msg ); }
 238                 elsif( is_filelog() ) { _write_file($msg); }
 239         }
 240 }
 241
 242
 243 sub _write_file {
 244         my( $msg, $isact) = @_;
 245         my $file = $logfile;
 246         $file = $actfile if $isact;
 247         my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 248         $year += 1900; $mon += 1;
 249         sysopen( SINK, $file, O_NONBLOCK|O_WRONLY|O_APPEND|O_CREAT )
 250                 or die "Cannot sysopen $logfile: $!";
 251         binmode(SINK, ':utf8');
 252         print SINK "[$year-$mon-$mday $hour:$min:$sec] $service $msg\n";
 253         close( SINK );
 254 }
 255
 256
 257
 258 1;