view release on metacpan or  search on metacpan

lib/Acme/Ghost/Log.pm  view on Meta::CPAN

=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 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,
    'error'     => 3,
    'fatal'     => 2, 'crit' => 2,
    'alert'     => 1,
    'emerg'     => 0,
);
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';

    # Check level
    croak "Incorrect log level specified" unless exists $MAGIC{$args->{level}};

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

    # Open sys log socket
    if ($args->{logger}) {
        croak "Blessed reference expected in logger attribute" unless blessed($args->{logger});
        $self->{provider} = "external";
    } elsif ($args->{handle}) {
        $self->{provider} = "handle";
        return $self;
    } elsif ($args->{file}) {
        my $file = $args->{file};
        $self->{handle} = IO::File->new($file, ">>");
        croak qq/Can't open file "$file": $!/ unless defined $self->{handle};
        $self->{provider} = "file";
    } else {
        Sys::Syslog::openlog($args->{ident}, $args->{logopt}, $args->{facility});
        $self->{provider} = "syslog";
    }

    return $self;
}
sub level {
    my $self = shift;
    if (scalar(@_) >= 1) {
        $self->{level} = shift;
        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', @_) }