libparanoid-perl 2.05-2 / usr / share / perl5 / Paranoid / Log.pm

# Paranoid::Log -- Log support for paranoid programs
#
# (c) 2005 - 2017, Arthur Corliss <corliss@digitalmages.com>
#
# $Id: lib/Paranoid/Log.pm, 2.05 2017/02/06 01:48:57 acorliss Exp $
#
#    This software is licensed under the same terms as Perl, itself.
#    Please see http://dev.perl.org/licenses/ for more information.
#
#####################################################################

#####################################################################
#
# Environment definitions
#
#####################################################################

package Paranoid::Log;

use 5.008;

use strict;
use warnings;
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use base qw(Exporter);
use Paranoid::Debug qw(:all);
use Paranoid::Module;
use Paranoid::Input;

($VERSION) = ( q$Revision: 2.05 $ =~ /(\d+(?:\.\d+)+)/sm );

@EXPORT = qw(
    PL_DEBUG     PL_INFO      PL_NOTICE    PL_WARN
    PL_ERR       PL_CRIT      PL_ALERT     PL_EMERG
    PL_EQ        PL_NE        PL_GE        PL_LE
    startLogger stopLogger plog
    );
@EXPORT_OK = (@EXPORT);
%EXPORT_TAGS = ( all => [@EXPORT_OK], );

use constant PL_DEBUG  => 0;
use constant PL_INFO   => 1;
use constant PL_NOTICE => 2;
use constant PL_WARN   => 3;
use constant PL_ERR    => 4;
use constant PL_CRIT   => 5;
use constant PL_ALERT  => 6;
use constant PL_EMERG  => 7;

use constant PL_EQ => '=';
use constant PL_NE => '!';
use constant PL_GE => '+';
use constant PL_LE => '-';

use constant PL_LREF => 0;
use constant PL_AREF => 1;
use constant PL_DREF => 2;

our @_scopes = ( PL_EQ, PL_NE, PL_GE, PL_LE );
our @_levels = (
    PL_DEBUG, PL_INFO, PL_NOTICE, PL_WARN,
    PL_ERR,   PL_CRIT, PL_ALERT,  PL_EMERG,
    );

#####################################################################
#
# Module code follows
#
#####################################################################

{

    my %loaded = ();    # module => loaded (boolean)
    my %msubs  = ();    # module => log sub ref
    my @dist;           # modules to distribute to by log level

    # This has consists of the name/array key/value pairs.  Each associated
    # array consists of the following entries:
    #        [ $sref, $level, $scope, \%mopts ].
    my %loggers = ();

    sub _loadModule {

        # Purpose:  Loads the requested module if it hasn't been already.
        #           Attempts to first load the module as a name relative to
        #           Paranoid::Log, otherwise by itself.
        # Returns:  True (1) if load was successful,
        #           False (0) if there are any errors
        # Usage:    $rv = _loadModule($module);

        my $module = shift;
        my $mname  = $module;
        my ( $sref, $aref, $dref, $rv );

        pdebug( 'entering w/(%s)', PDLEVEL2, $module );
        pIn();

        # Was module already loaded (or a load attempted)?
        if ( exists $loaded{$module} ) {

            # Yep, so return module status
            $rv = $loaded{$module};

        } else {

            # Nope, so let's try to load it.
            #
            # Is the module name taint-safe?
            if ( detaint( $mname, 'filename' ) ) {

                # Yep, so try to load relative to Paranoid::Log
                $rv =
                    $mname eq 'Stderr' ? 1
                    : loadModule( "Paranoid::Log::$mname", '' )
                    && eval "Paranoid::Log::${mname}::init();"
                    && eval "\$sref = \\&Paranoid::Log::${mname}::logMsg;"
                    && eval "\$aref = \\&Paranoid::Log::${mname}::addLogger;"
                    && eval "\$dref = \\&Paranoid::Log::${mname}::delLogger;"
                    ? 1
                    : 0;

                # If that failed, try to load it directly
                unless ($rv) {
                    $rv =
                           loadModule( $mname, '' )
                        && eval "${mname}::init();"
                        && eval "\$sref = \\&${mname}::logMsg;"
                        && eval "\$aref = \\&${mname}::addLogger;"
                        && eval "\$dref = \\&${mname}::delLogger;"
                        ? 1
                        : 0;
                }

                # Cache & report the results
                $loaded{$module} = $rv;
                $msubs{$module} = [ $sref, $aref, $dref ];
                if ($rv) {
                    pdebug( 'successfully loaded log module for %s',
                        PDLEVEL3, $module );
                } else {
                    Paranoid::ERROR =
                        pdebug( 'failed to load log module for %s',
                        PDLEVEL1, $module );
                }

            } else {

                # Module name failed detainting -- report
                Paranoid::ERROR =
                    pdebug( 'failed to detaint module name', PDLEVEL1 );
                $rv = 0;
            }
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL2, $rv );

        return $rv;
    }

    sub _updateDist {

        # Purpose:  Registers logging handles at the appropriate log levels
        # Returns:  Boolean
        # Usage:    $rv = _updateDist();

        my ( $logger, $level, $scope );

        # Purge @dist and reinitialize
        foreach ( PL_DEBUG .. PL_EMERG ) { $dist[$_] = [] }

        # Set up the distribution list
        foreach $logger ( keys %loggers ) {
            ( $level, $scope ) = @{ $loggers{$logger} }{qw(severity scope)};
            if ( $scope eq PL_EQ ) {
                push @{ $dist[$level] }, $logger;
            } elsif ( $scope eq PL_GE ) {
                foreach ( $level .. PL_EMERG ) {
                    push @{ $dist[$_] }, $logger;
                }
            } elsif ( $scope eq PL_LE ) {
                foreach ( PL_DEBUG .. $level ) {
                    push @{ $dist[$_] }, $logger;
                }
            } else {
                foreach ( PL_DEBUG .. PL_EMERG ) {
                    push @{ $dist[$_] }, $logger if $level != $_;
                }
            }
        }

        # Report distribution list
        foreach $level ( PL_DEBUG .. PL_EMERG ) {
            pdebug( '%s: %s', PDLEVEL3, $level, @{ $dist[$level] } );
        }

        return 1;
    }

    sub startLogger {

      # Purpose:  Adds a named logger to our loggers hash.
      # Returns:  True (1) if successful,
      #           False (0) if there are any errors
      # Usage:    $rv = startLogger($name, $mech, $level, $scope, { %mopts });

        my $name  = shift;
        my $mech  = shift;
        my $level = shift;
        my $scope = shift;
        my $mopts = shift;
        my $rv    = 1;

        pdebug( 'entering w/(%s)(%s)(%s)(%s)(%s)',
            PDLEVEL3, $name, $mech, $level, $scope, $mopts );
        pIn();

        # Set defaults for optional arguments that were left undefined
        $level = PL_NOTICE unless defined $level;
        $scope = PL_GE     unless defined $scope;

        # Make sure this is a valid named logger
        unless ( defined $name and length $name ) {
            Paranoid::ERROR =
                pdebug( 'invalid log name specified: %s', PDLEVEL1, $name );
            $rv = 0;
        }

        # Validate log level
        unless ( scalar grep { $_ == $level } @_levels ) {
            Paranoid::ERROR =
                pdebug( 'invalid log level specified: %s', PDLEVEL1, $level );
            $rv = 0;
        }

        # Validate scope
        unless ( scalar grep { $_ eq $scope } @_scopes ) {
            Paranoid::ERROR =
                pdebug( 'invalid log scope specified: %s', PDLEVEL1, $scope );
            $rv = 0;
        }

        # Make sure the module can be loaded if the log level was valid
        $rv = _loadModule($mech) if $rv;

        # Make sure the log entry is uniqe
        if ($rv) {
            if ( exists $loggers{$name} ) {
                Paranoid::ERROR = pdebug( 'a logger for %s already exists',
                    PDLEVEL1, $name );
                $rv = 0;
            } else {
                $mopts = {}
                    unless defined $mopts and ref $mopts eq 'HASH';
                $loggers{$name} = {
                    name      => $name,
                    mechanism => $mech,
                    severity  => $level,
                    scope     => $scope,
                    options   => {%$mopts} };
                $rv =
                    $mech eq 'Stderr'
                    ? 1
                    : &{ $msubs{$mech}[PL_AREF] }( %{ $loggers{$name} } );
                if ($rv) {
                    _updateDist();
                } else {
                    delete $loggers{$name};
                }
            }
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv );

        return $rv;
    }

    sub stopLogger {

        # Purpose:  Deletes a named logger from the hash.
        # Returns:  True (1)
        # Usage:    _delLogger($name);

        my $name = shift;
        my $rv   = 1;

        pdebug( 'deleting %s logger', PDLEVEL3, $name );
        if ( exists $loggers{$name} ) {
            unless ( $loggers{$name}{mechanism} eq 'Stderr' ) {
                $rv =
                    &{ $msubs{ $loggers{$name}{mechanism} }[PL_DREF] }(
                    %{ $loggers{$name} } );
            }
            if ($rv) {
                delete $loggers{$name};
                _updateDist();
            }
        }

        return $rv;
    }

    sub plog {

       # Purpose:  Logs the message to all facilities registered at that level
       # Returns:  True (1) if the message was succesfully logged,
       #           False (0) if there are any errors
       # Usage:    $rv = plog($severity, $message);

        my $level   = shift;
        my $message = shift;
        my $rv      = 1;
        my %record  = (
            severity => $level,
            message  => $message,
            );
        my ( $logger, $sref );

        pdebug( 'entering w/(%s)(%s)', PDLEVEL1, $level, $message );
        pIn();

        # Validate level and message
        $rv = 0
            unless defined $message
                and scalar grep { $_ == $level } @_levels;

        if ($rv) {

            # Iterate over the @dist level
            if ( defined $dist[$level] ) {

                # Iterate over each logger
                foreach $logger ( @{ $dist[$level] } ) {
                    if ( $loggers{$logger}{mechanism} eq 'Stderr' ) {

                        # Special handling for STDERR
                        $rv = pderror($message) ? 1 : 0;

                    } else {

                        # Get the sub ref for the logger
                        $sref =
                            $msubs{ $loggers{$logger}{mechanism} }[PL_LREF];
                        $rv =
                            defined $sref
                            ? &$sref( %{ $loggers{$logger} }, %record )
                            : 0;
                    }
                }
            }

        } else {

            # Report error
            Paranoid::ERROR = pdebug( 'invalid log level(%s) or message(%s)',
                PDLEVEL1, $level, $message );
            $rv = 0;
        }

        pOut();
        pdebug( 'leaving w / rv : %s', PDLEVEL1, $rv );

        return $rv;
    }
}

1;

__END__

=head1 NAME

Paranoid::Log - Log Functions

=head1 VERSION

$Id: lib/Paranoid/Log.pm, 2.05 2017/02/06 01:48:57 acorliss Exp $

=head1 SYNOPSIS

  use Paranoid::Log;

  $rv = startLogger($name, $mechanism, PL_WARN, PL_GE, { %options });
  $rv = stopLogger($name);

  $rv = plog($severity, $message);

=head1 DESCRIPTION

B<Paranoid::Log> provides a logging and message distribution framework that's
modeled heavily on I<syslog>.  It follows I<syslog> in that it allows one to
log messages at various levels of severity and have those messages distributed
across multiple log mechanisms automatically.  Within the L<Paranoid>
distribution itself it supports logging to files, STDERR, and named buffers.
Additional modules exist on CPAN to allow for distribution to e-mail, syslog,
and more.  It is also relatively trivial to write your own log mechanism to
work with this framework.

=head1 LOGGING MECHANISMS

Each logging mechanism is implemented as separate module consisting of
non-exported functions that conform to a a consistent API.  Each
mechanism module must have the following functions:

  Function        Description
  ------------------------------------------------------
  init            Called when module first loaded
  addLogger       Add a named instance of the mechanism
  delLogger       Removes a named instance of the mechanism
  logMsg          Logs the passed message

The B<init> function is only called once -- the first time the module is
used and accessed.  No arguments are passed, and if unnecessary for a
particular mechanism it can simply return a boolean true.

The B<logMsg> function is used to actually pass a log message to the 
mechanism.  It is called with a record hash based on the following template:

        my %record  = (
            name      => $name,
            mechanism => $name,
            msgtime   => time,
            severity  => $level,
            scope     => $scope,
            message   => $message,
            options   => {},
            );

The options key will be a hash reference to any logger-specific options,
should the mechanism require one.

The B<addLogger> function is called whenever a logger is started.  It is
called with the logger record above, minus a message and msgtime.

The B<delLogger> function is called whenevever a logger is stopped.  It is
called with the logger record above, minus a message and msgtime.

Please see the source for L<Paranoid::Logger::File> for a simple example of a
mechanism module.

=head1 SUBROUTINES/METHODS

=head2 startLogger

  $rv = startLogger($name, $mechanism, PL_WARN, PL_GE, { %options });

This function enables the specified logging mechanism at the specified levels.
Each mechanism (or permutation of) is associated with an arbitrary name.
This name can be used to bypass log distribution and log only in the named
mechanism.

If you have your own custom mechanism that complies with the Paranoid::Log
calling conventions you can pass this the name of the module (for example,
MyLog::Foo).

Log levels are modeled after syslog:

  log level       description
  =====================================================
  PL_EMERG        system is unusable
  PL_ALERT        action must be taken immediately
  PL_CRIT         critical conditions
  PL_ERR          error conditions
  PL_WARN         warning conditions
  PL_NOTICE       normal but significant conditions
  PL_INFO         informational
  PL_DEBUG        debug-level messages

If omitted level defaults to I<PL_NOTICE>.

Scope is defined with the following characters:

  character       definition
  =====================================================
  PL_EQ           log only messages at this severity
  PL_GE           log only messages at this severity
                    or higher
  PL_LE           log only messages at this severity
                    or lower
  PL_NE          log at all levels but this severity

If omitted scope defaults to I<PL_GE>.

Only the first two arguments are mandatory.  What you put into the %options, 
and whether you need it at all, will depend on the mechanism you're using.  The
facilities provided directly by B<Paranoid> are as follows:

  mechanism        arguments
  =====================================================
  Stderr          none
  Buffer          bufferSize (optional)
  File            file, mode (optional), perm (optional),
                  syslog (optional)

=head2 stopLogger

  $rv = stopLogger($name);

Removes the specified logging mechanism from the configuration and
re-initializes the distribution processor.

=head2 plog

  $rv = plog($severity, $message);

This call logs the passed message to all facilities enabled at the specified
log level.

=head1 DEPENDENCIES

=over

=item o

L<Paranoid::Debug>

=item o

L<Paranoid::Input>

=item o

L<Paranoid::Module>

=back

=head1 EXAMPLES

The following example provides the following behavior:  debug messages go to a
file, notice & above messages go to syslog, and critical and higher messages
also go to console and e-mail.

  # Set up the logging facilities
  startLogger("debug-log", "File", PL_DEBUG, PL_GE,
    { file => '/var/log/myapp-debug.log' });
  startLogger("console-err", "Stderr", PL_CRIT, PL_GE);

  # This goes only to the debug log
  plog(PL_DEBUG, "Starting application");

  # Again, only the debug log
  plog(PL_NOTICE, "Uh, something happened...");

  # This goes to STDERR and the debug log
  plog(PL_EMERG, "Ack! <choke... silence>");

=head1 SEE ALSO

=over

=item o

L<Paranoid::Log::Buffer>

=item o

L<Paranoid::Log::File>

=back

=head1 BUGS AND LIMITATIONS

=head1 AUTHOR

Arthur Corliss (corliss@digitalmages.com)

=head1 LICENSE AND COPYRIGHT

This software is licensed under the same terms as Perl, itself. 
Please see http://dev.perl.org/licenses/ for more information.

(c) 2005 - 2017, Arthur Corliss (corliss@digitalmages.com)