view release on metacpan or  search on metacpan

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

    my $logger = $log->logger;

This method returns the logger object or undef if not exists

=head2 notice

    $log->notice('Normal, but significant, condition...');
    $log->notice('Ok', 'then');

Log C<notice> message

=head2 provider

    print $log->provider;

Returns provider name (C<external>, C<handle>, C<file> or C<syslog>)

=head2 trace

    $log->trace('Whatever');
    $log->trace('Who', 'cares');

Log C<trace> message

=head2 warn

    $log->warn('Dont do that Dave...');
    $log->warn('No', 'really');

Log C<warn> message

=head1 HISTORY

See C<Changes> file

=head1 TO DO

See C<TODO> file

=head1 SEE ALSO

L<Sys::Syslog>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C<LICENSE> file or L<https://opensource.org/license/artistic-2-0> for details

=cut

use Carp qw/carp croak/;
use Scalar::Util qw/blessed/;
use Sys::Syslog qw//;
use File::Basename qw/basename/;
use IO::File qw//;
use Fcntl qw/:flock/;
use Encode qw/find_encoding/;
use Time::HiRes qw/time/;
use Acrux::Util qw/color/;

use constant {
    LOGOPTS         => 'ndelay,pid', # For Sys::Syslog
    SEPARATOR       => ' ',
    LOGFORMAT       => '%s',
};
my %LOGLEVELS = (
    'trace'     => Sys::Syslog::LOG_DEBUG,    # 7 debug-level message
    'debug'     => Sys::Syslog::LOG_DEBUG,    # 7 debug-level message
    'info'      => Sys::Syslog::LOG_INFO,     # 6 informational message
    'notice'    => Sys::Syslog::LOG_NOTICE,   # 5 normal, but significant, condition
    'warn'      => Sys::Syslog::LOG_WARNING,  # 4 warning conditions
    'error'     => Sys::Syslog::LOG_ERR,      # 3 error conditions
    'fatal'     => Sys::Syslog::LOG_CRIT,     # 2 critical conditions
    'crit'      => Sys::Syslog::LOG_CRIT,     # 2 critical conditions
    'alert'     => Sys::Syslog::LOG_ALERT,    # 1 action must be taken immediately
    'emerg'     => Sys::Syslog::LOG_EMERG,    # 0 system is unusable
);
my %MAGIC = (
    'trace'     => 8,
    'debug'     => 7,
    'info'      => 6,
    'notice'    => 5,
    'warn'      => 4, 'warning' => 4,
    'error'     => 3, 'err'     => 3,
    'fatal'     => 2, 'crit'    => 2, 'critical' => 2,
    'alert'     => 1,
    'emerg'     => 0, 'emergency' => 0,
);
my %COLORS = (
    'trace'     => 'white',
    'debug'     => 'bright_white',
    'info'      => 'cyan',
    'notice'    => 'green',
    'warn'      => 'yellow',
    'error'     => 'red',
    'fatal'     => 'bright_red', 'crit' => 'bright_magenta',
    'alert'     => 'white on_red',
    'emerg'     => 'bright_white on_red',
);
my %SHORT = ( # Log::Log4perl::Level notation
    0 => 'fatal', 1 => 'fatal', 2 => 'fatal',
    3 => 'error',
    4 => 'warn',
    5 => 'info', 6 => 'info',
    7 => 'debug',
    8 => 'trace',
);

my $ENCODING = find_encoding('UTF-8') or croak qq/Encoding "UTF-8" not found/;

sub new {
    my $class = shift;
    my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    $args->{facility}   ||= Sys::Syslog::LOG_USER;
    $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 {