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; |
---|