view release on metacpan or  search on metacpan

lib/Acrux/Log.pm  view on Meta::CPAN

package Acrux::Log;
use strict;
use utf8;

=encoding utf-8

=head1 NAME

Acrux::Log - Acrux logger

=head1 SYNOPSIS

    use Acrux::Log;

    # Logging to STDERR (by default)
    my $log = Acrux::Log->new();
       $log->error("My test error message to STDERR")

    # Using file
    my $log = Acrux::Log->new(file => '/tmp/test.log');
       $log->error("My test error message to /tmp/test.log")

    # Using STDOUT
    my $log = Acrux::Log->new(file => 'stdout'); # or 'stdout:', ':stdout'
    my $log = Acrux::Log->new(file => '-');

    # Using STDOUT (handle)
    my $log = Acrux::Log->new(
            handle => IO::Handle->new_from_fd(fileno(STDOUT), "w")
        );

    # Using STDERR (default since 0.10)
    my $log = Acrux::Log->new(file => 'stderr'); # or 'stderr:', ':stderr'
    my $log = Acrux::Log->new(file => '=');

    # Using syslog
    my $log = Acrux::Log->new(file => 'syslog'); # or 'syslog:', ':syslog'
    my $log = Acrux::Log->new(file => '@');

    # Customize minimum log level
    my $log = Acrux::Log->new(level => 'warn');

    # Log messages
    $log->trace('Doing stuff');
    $log->debug('Not sure what is happening here');
    $log->info('FYI: it happened again');
    $log->notice('Normal, but significant, condition...');
    $log->warn('This might be a problem');
    $log->error('Garden variety error');
    $log->fatal('Boom');
    $log->crit('Its over...');
    $log->alert('Action must be taken immediately');
    $log->emerg('System is unusable');

=head1 DESCRIPTION

Acrux::Log is a simple logger for Acrux logging

=head2 new

    my $log = Acrux::Log->new(
        logopt      => 'ndelay,pid',
        facility    => 'user',
        level       => 'debug',
        ident       => 'test.pl',
        autoclean   => 1,
        logopt      => 'ndelay,pid',
    );

With default attributes

    use Mojo::Log;
    my $log = Acrux::Log->new( logger => Mojo::Log->new );
    $log->error("Test error message");

This is example with external loggers

=head1 ATTRIBUTES

This class implements the following attributes

=head2 autoclean

    autoclean => 1

This attribute enables cleaning (closing file handler or syslog) on DESTROY

=head2 color

    color => 1

Colorize log messages with the available levels using L<Term::ANSIColor>, defaults to C<0>

=head2 facility

    facility => 'user'

This attribute sets facility for logging

Available standard facilities: C<auth>, C<authpriv>, C<cron>, C<daemon>, C<ftp>,
C<kern>, C<local0>, C<local1>, C<local2>, C<local3>, C<local4>, C<local5>, C<local6>,
C<local7>, C<lpr>, C<mail>, C<news>, C<syslog>, C<user> and C<uucp>

Default: C<user> (Sys::Syslog::LOG_USER)

See also L<Sys::Syslog/Facilities>

=head2 file

    file => '/var/log/myapp.log'
    file => 'stdout' # 'stdout:', ':stdout', '-'
    file => 'stderr' # 'stderr:', ':stderr', '='
    file => 'syslog' # 'syslog:', ':syslog', '@'

Log file path used by "handle"

B<Compatibility note:>

Prior to version 0.10, Acrux::Log implicitly used syslog when no logging
destination was specified.
Starting with version 0.10, the default destination is STDERR.

To continue using syslog, configure it explicitly:

    file => "syslog:"

or

    file => "@"

=head2 format

    format => sub {...}

A callback function for formatting log messages

    format => sub {
        my ($time, $level, @lines) = @_;
        return "[$time] [$level] " . join (' ', @lines) . "\n";
    }

This callback routine must return formatted string for the log line

=head2 handle

    handle => IO::Handle->new_from_fd(fileno(STDOUT), "w")

Log filehandle, defaults to opening "file" or uses syslog if file not specified

=head2 ident

    ident => 'myapp'

The B<ident> is prepended to every B<syslog> message

Default: script name C<basename($0)>

=head2 level

    level => 'debug'

There are six predefined log levels: C<fatal>, C<error>, C<warn>, C<info>, C<debug>, and C<trace> (in descending priority).
The syslog supports followed additional log levels: C<emerg>, C<alert>, C<crit'> and C<notice> (in descending priority).
But we recommend not using them to maintain compatibility.
Your configured logging level has to at least match the priority of the logging message.

If your configured logging level is C<warn>, then messages logged with info(), debug(), and trace()
will be suppressed; fatal(), error() and warn() will make their way through, because their
priority is higher or equal than the configured setting.

Default: C<debug>

lib/Acrux/Log.pm  view on Meta::CPAN

    $args->{ident}      ||= basename($0);
    $args->{logopt}     ||= LOGOPTS;
    $args->{logger}     ||= undef;
    $args->{level}      ||= 'debug';
    $args->{file}       ||= undef;
    $args->{handle}     ||= undef;
    $args->{provider}     = 'unknown';
    $args->{autoclean}  ||= 0;
    $args->{prefix}     ||= '';
    $args->{format}     ||= undef;
    $args->{color}      ||= 0;

    # Check level
    $args->{level} = lc($args->{level});
    unless (exists $MAGIC{$args->{level}}) {
        carp "Incorrect log level specified. Well be used debug log level by default";
        $args->{level} = 'debug';
    }

    # Instance
    my $self = bless {%$args}, $class;

    # Set formatter
    $self->{format} ||= $self->{short} ? \&_short : $self->{color} ? \&_color : \&_default;

    # External logger object specified directly
    if ($args->{logger}) {
        $self->{provider} = "external";
        unless (blessed($args->{logger})) {
            printf STDERR "Blessed reference expected in \"logger\" attribute. Logging to STDERR instead.\n";
            $self->{provider} = "handle";
            $self->{handle} = IO::Handle->new_from_fd(fileno(STDERR), "w");
        }
    }

    # Handler specified directly
    elsif ($args->{handle}) {
        $self->{provider} = "handle";
        return $self;
    }

    # File rules
    elsif ($args->{file}) { # File
        my $file = $args->{file};

        # Open syslog socket
        if ($file =~ /^\:?syslog\:?$/i or $file eq '@') {
            Sys::Syslog::openlog($args->{ident}, $args->{logopt}, $args->{facility});
            $self->{provider} = "syslog";
            $self->{file} = "syslog";
        }

        # Use STDOUT handle
        elsif ($file =~ /^\:?stdout\:?$/i or $file eq '-') {
            $self->{provider} = "handle";
            $self->{handle} = IO::Handle->new_from_fd(fileno(STDOUT), "w");
            $self->{file} = "stdout";
        }

        # Use STDERR handle
        elsif ($file =~ /^\:?stderr\:?$/i or $file eq '=') {
            $self->{provider} = "handle";
            $self->{handle} = IO::Handle->new_from_fd(fileno(STDERR), "w");
            $self->{file} = "stderr";
        }

        # Open log file handle
        else {
            $self->{provider} = "file";
            $self->{handle} = IO::File->new($file, ">>");
            unless (defined $self->{handle}) { # Error
                printf STDERR "Can't open log file \"%s\" for writing (%s). Logging to STDERR instead.\n",
                    $file, $!;
                $self->{provider} = "handle";
                $self->{handle} = IO::Handle->new_from_fd(fileno(STDERR), "w");
            }
        }
    }

    # Default: STDERR (since 0.10)
    else {
        $self->{provider} = "handle";
        $self->{handle} = IO::Handle->new_from_fd(fileno(STDERR), "w");
    }

    return $self;
}
sub file { shift->{file} }
sub level {
    my $self = shift;
    if (scalar(@_) >= 1) {
        my $level = lc(shift // '');
        if (exists $MAGIC{$level}) {
            $self->{level} = $level;
        } else {
            carp "Incorrect log level specified";
        }
        return $self;
    }
    return $self->{level};
}
sub logger { shift->{logger} }
sub handle { shift->{handle} }
sub provider { shift->{provider} }

sub trace { shift->_log('trace', @_) }
sub debug { shift->_log('debug', @_) }
sub info { shift->_log('info', @_) }
sub notice { shift->_log('notice', @_) }
sub warn { shift->_log('warn', @_) }
sub error { shift->_log('error', @_) }
sub fatal { shift->_log('fatal', @_) }
sub crit { shift->_log('crit', @_) }
sub alert { shift->_log('alert', @_) }
sub emerg { shift->_log('emerg', @_) }

sub _log {
    my ($self, $level, @msg) = @_;
    my $req = $MAGIC{$self->level};
    my $mag = $MAGIC{$level} // 7;
    return 0 unless $mag <= $req;

    # External logger
    if (my $logger = $self->logger) {