# # Copyright (c) 2004-2007 - Consultas, PKG.fr # # This file is part of A2P. # # A2P is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # A2P is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with A2P; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # # $Id: Logger.pm 3 2007-10-18 16:20:19Z guillaume $ # package A2P::Logger ; # Derived class from Thread.pm use base qw(A2P::Thread); use strict ; use integer ; use Time::HiRes qw( gettimeofday tv_interval ) ; use A2P::Globals ; use A2P::Syslog ; use A2P::Com qw( IsCom GetCom comREQ comCOM comLOG ); BEGIN { our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ; } our $VERSION ; # These are the ordered levels to cache ( info, debug) my @LevelToCache = ( 6 , 7 ); ############################################################################# ## Logger code ## ############################################################################# sub ThreadInitEarly { my $self = shift ; # Set $loggertid to enable direct call to syslog in DirectLog from A2P::Syslog.pm $loggertid = $$ ; &SetLogger( $self ); # Initializes our cache $self->{CACHETIMER} = [ &gettimeofday() ]; $self->{CACHE} = {} ; } sub Do { my $self = shift ; my $ref = shift ; my $Ret = 0 ; my @Log = &IsCom( comLOG , $$ref ); if ( @Log == 2 ) { &UPSTAT('GETCOMLOG'); if ( grep { $_ == $Log[0] } @LevelToCache ) { # Cache this log push @{$self->{CACHE}->{$Log[0]}}, $Log[1] ; } else { # Log immediatly if necessary if ( $Log[0] =~ /^\d+/ ) { &DirectLog( $Log[0] , [ $Log[1] ] ); } else { local $" = "' -> '" ; &Warn("Can't log '@Log'"); &debugdev("Can't log '@Log'"); } } $Ret ++ ; } else { &Error("Can't interpret log request '$$ref'"); } return $Ret ; } sub DoLog { my $self = shift ; &UPSTAT('DOLOG'); my $log = &GetCom( comREQ , TODO , @_ ); return $self->PrintSock( $self->{SON}, $log ) if ( $$ == $maintid ); &debugdev("Not expected to handle '$log' from here"); &UPSTAT('DOLOG-ERROR'); return 0 ; } sub GetRequest { my $self = shift ; my $Requests = shift ; return 1 if ( $MUSTQUIT or $self->{DO_QUIT} ); my $read = $self->ReadSock($Requests); # Flush our log cache if no more log is available or more than 1 sec has passed $self->FlushCache() if ( %{$self->{CACHE}} and ( ! $read or &tv_interval($self->{CACHETIMER}) >= 1) ); return $read ; } sub FlushCache { my $self = shift ; &UPSTAT('FLUSH-LOG-CACHE'); # Log cache for each cached level foreach my $level (keys(%{$self->{CACHE}})) { # Check cached messages unless ( grep { $_ =~ /^$level$/ } @LevelToCache ) { &debugdev("Can't flush info at level <$level>"); } if (@{$self->{CACHE}->{$level}}) { &UPSTAT('FLUSH-LINE-LEVEL-'.$level,scalar(@{$self->{CACHE}->{$level}})); &DirectLog( $level , $self->{CACHE}->{$level} ); # Empty cache for that level @{$self->{CACHE}->{$level}} = [] ; } delete $self->{CACHE}->{$level} ; } # Reset timer $self->{CACHETIMER} = [ &gettimeofday() ]; } sub DoBeforeQuit { my $self = shift ; $self->FlushCache(); # Purge message in log queue my @Logs = $self->ReadSock($self->{DADDY}); close($self->{DADDY}); map { my $log = $_ ; chomp $log; my @Req = &IsCom( comREQ , $log ); if ( @Req ) { my @Log = &IsCom( comLOG , $Req[1] ); &DirectLog( $Log[0] , [ $Log[1] ] , "Purging:" ) if ( $Log[1] ); } } @Logs ; # Close Syslog socket shutdown($SYSLOG,2) if (defined($SYSLOG)); } &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); 1;