source: A2P/a2p/A2P/Logger.pm @ 3

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