[3] | 1 | # |
---|
| 2 | # Copyright (c) 2004-2007 - Consultas, PKG.fr |
---|
| 3 | # |
---|
| 4 | # This file is part of A2P. |
---|
| 5 | # |
---|
| 6 | # A2P 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 | # A2P 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 A2P; if not, write to the Free Software |
---|
| 18 | # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA |
---|
| 19 | # |
---|
| 20 | # $Id: Logger.pm 3 2007-10-18 16:20:19Z guillaume $ |
---|
| 21 | # |
---|
| 22 | |
---|
| 23 | package A2P::Logger ; |
---|
| 24 | |
---|
| 25 | # Derived class from Thread.pm |
---|
| 26 | use base qw(A2P::Thread); |
---|
| 27 | |
---|
| 28 | use strict ; |
---|
| 29 | use integer ; |
---|
| 30 | use Time::HiRes qw( gettimeofday tv_interval ) ; |
---|
| 31 | use A2P::Globals ; |
---|
| 32 | use A2P::Syslog ; |
---|
| 33 | use A2P::Com qw( IsCom GetCom comREQ comCOM comLOG ); |
---|
| 34 | |
---|
| 35 | BEGIN { |
---|
| 36 | our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ; |
---|
| 37 | } |
---|
| 38 | our $VERSION ; |
---|
| 39 | |
---|
| 40 | # These are the ordered levels to cache ( info, debug) |
---|
| 41 | my @LevelToCache = ( 6 , 7 ); |
---|
| 42 | |
---|
| 43 | ############################################################################# |
---|
| 44 | ## Logger code ## |
---|
| 45 | ############################################################################# |
---|
| 46 | |
---|
| 47 | sub ThreadInitEarly { |
---|
| 48 | my $self = shift ; |
---|
| 49 | # Set $loggertid to enable direct call to syslog in DirectLog from A2P::Syslog.pm |
---|
| 50 | $loggertid = $$ ; |
---|
| 51 | &SetLogger( $self ); |
---|
| 52 | |
---|
| 53 | # Initializes our cache |
---|
| 54 | $self->{CACHETIMER} = [ &gettimeofday() ]; |
---|
| 55 | $self->{CACHE} = {} ; |
---|
| 56 | |
---|
| 57 | } |
---|
| 58 | |
---|
| 59 | sub Do { |
---|
| 60 | my $self = shift ; |
---|
| 61 | my $ref = shift ; |
---|
| 62 | |
---|
| 63 | my $Ret = 0 ; |
---|
| 64 | |
---|
| 65 | my @Log = &IsCom( comLOG , $$ref ); |
---|
| 66 | |
---|
| 67 | if ( @Log == 2 ) { |
---|
| 68 | |
---|
| 69 | &UPSTAT('GETCOMLOG'); |
---|
| 70 | |
---|
| 71 | if ( grep { $_ == $Log[0] } @LevelToCache ) { |
---|
| 72 | # Cache this log |
---|
| 73 | push @{$self->{CACHE}->{$Log[0]}}, $Log[1] ; |
---|
| 74 | |
---|
| 75 | } else { |
---|
| 76 | # Log immediatly if necessary |
---|
| 77 | if ( $Log[0] =~ /^\d+/ ) { |
---|
| 78 | &DirectLog( $Log[0] , [ $Log[1] ] ); |
---|
| 79 | |
---|
| 80 | } else { |
---|
| 81 | local $" = "' -> '" ; |
---|
| 82 | &Warn("Can't log '@Log'"); |
---|
| 83 | &debugdev("Can't log '@Log'"); |
---|
| 84 | } |
---|
| 85 | } |
---|
| 86 | |
---|
| 87 | $Ret ++ ; |
---|
| 88 | |
---|
| 89 | } else { |
---|
| 90 | &Error("Can't interpret log request '$$ref'"); |
---|
| 91 | } |
---|
| 92 | |
---|
| 93 | return $Ret ; |
---|
| 94 | } |
---|
| 95 | |
---|
| 96 | sub DoLog { |
---|
| 97 | my $self = shift ; |
---|
| 98 | &UPSTAT('DOLOG'); |
---|
| 99 | |
---|
| 100 | my $log = &GetCom( comREQ , TODO , @_ ); |
---|
| 101 | return $self->PrintSock( $self->{SON}, $log ) if ( $$ == $maintid ); |
---|
| 102 | |
---|
| 103 | &debugdev("Not expected to handle '$log' from here"); |
---|
| 104 | &UPSTAT('DOLOG-ERROR'); |
---|
| 105 | return 0 ; |
---|
| 106 | } |
---|
| 107 | |
---|
| 108 | sub GetRequest { |
---|
| 109 | my $self = shift ; |
---|
| 110 | my $Requests = shift ; |
---|
| 111 | |
---|
| 112 | return 1 if ( $MUSTQUIT or $self->{DO_QUIT} ); |
---|
| 113 | |
---|
| 114 | my $read = $self->ReadSock($Requests); |
---|
| 115 | |
---|
| 116 | # Flush our log cache if no more log is available or more than 1 sec has passed |
---|
| 117 | $self->FlushCache() if ( %{$self->{CACHE}} and |
---|
| 118 | ( ! $read or &tv_interval($self->{CACHETIMER}) >= 1) ); |
---|
| 119 | |
---|
| 120 | return $read ; |
---|
| 121 | } |
---|
| 122 | |
---|
| 123 | sub FlushCache { |
---|
| 124 | my $self = shift ; |
---|
| 125 | &UPSTAT('FLUSH-LOG-CACHE'); |
---|
| 126 | |
---|
| 127 | # Log cache for each cached level |
---|
| 128 | foreach my $level (keys(%{$self->{CACHE}})) { |
---|
| 129 | |
---|
| 130 | # Check cached messages |
---|
| 131 | unless ( grep { $_ =~ /^$level$/ } @LevelToCache ) { |
---|
| 132 | &debugdev("Can't flush info at level <$level>"); |
---|
| 133 | } |
---|
| 134 | |
---|
| 135 | if (@{$self->{CACHE}->{$level}}) { |
---|
| 136 | &UPSTAT('FLUSH-LINE-LEVEL-'.$level,scalar(@{$self->{CACHE}->{$level}})); |
---|
| 137 | &DirectLog( $level , $self->{CACHE}->{$level} ); |
---|
| 138 | |
---|
| 139 | # Empty cache for that level |
---|
| 140 | @{$self->{CACHE}->{$level}} = [] ; |
---|
| 141 | } |
---|
| 142 | delete $self->{CACHE}->{$level} ; |
---|
| 143 | } |
---|
| 144 | |
---|
| 145 | # Reset timer |
---|
| 146 | $self->{CACHETIMER} = [ &gettimeofday() ]; |
---|
| 147 | } |
---|
| 148 | |
---|
| 149 | sub DoBeforeQuit { |
---|
| 150 | my $self = shift ; |
---|
| 151 | |
---|
| 152 | $self->FlushCache(); |
---|
| 153 | |
---|
| 154 | # Purge message in log queue |
---|
| 155 | my @Logs = $self->ReadSock($self->{DADDY}); |
---|
| 156 | close($self->{DADDY}); |
---|
| 157 | |
---|
| 158 | map { |
---|
| 159 | my $log = $_ ; |
---|
| 160 | chomp $log; |
---|
| 161 | my @Req = &IsCom( comREQ , $log ); |
---|
| 162 | if ( @Req ) { |
---|
| 163 | my @Log = &IsCom( comLOG , $Req[1] ); |
---|
| 164 | &DirectLog( $Log[0] , [ $Log[1] ] , "Purging:" ) if ( $Log[1] ); |
---|
| 165 | } |
---|
| 166 | } @Logs ; |
---|
| 167 | |
---|
| 168 | # Close Syslog socket |
---|
| 169 | shutdown($SYSLOG,2) if (defined($SYSLOG)); |
---|
| 170 | } |
---|
| 171 | |
---|
| 172 | &Debug("Module " . __PACKAGE__ . " v$VERSION loaded"); |
---|
| 173 | |
---|
| 174 | 1; |
---|