view release on metacpan or  search on metacpan

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

        }
    }

    # 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) {
        my $name = $SHORT{$mag};
        if (my $code = $logger->can($name)) {
            return $logger->$code(@msg);
        } else {
            carp(sprintf("Can't found '%s' method in '%s' package", $name, ref($logger)));
        }
        return 0;
    }

    # Handle
    if (my $handle = $self->handle) {
        # Set message
        my $pfx = (defined($self->{prefix}) && length($self->{prefix})) ? $self->{prefix} : '';
        my $_msg = $ENCODING->encode($pfx . $self->{format}->(time, $level, @msg), 0);

        # Flush
        if ($self->{provider} eq "file") { # Flush to file
            flock $handle, LOCK_EX;
            $handle->print($_msg) or croak "Can't write to log file: $!";
            flock $handle, LOCK_UN;
        } elsif ($self->{provider} eq "handle") { # Flush to handle
            print $handle $_msg;
        } else {
            return 0;
        }
        return 1;
    }

    # Syslog
    return 0 if $self->provider ne "syslog";
    my $lvl = $LOGLEVELS{$level} // Sys::Syslog::LOG_DEBUG;
    Sys::Syslog::syslog($lvl, LOGFORMAT, join(SEPARATOR, @msg));
}

sub _default {
    my ($tm, $l, @msg) = @_;
    my ($s, $m, $h, $day, $month, $year) = localtime $tm;
    my $time = sprintf '%04d-%02d-%02d %02d:%02d:%08.5f', $year + 1900, $month + 1, $day, $h, $m,
       "$s." . ((split /\./, $tm)[1] // 0);
    return "[$time] [$$] [$l] " . join(SEPARATOR, @msg) . "\n";
}
sub _short {
    my ($tm, $l, @msg) = @_;
    my $short = substr($l, 0, 1);
    return "[$$] [$short] " . join(SEPARATOR, @msg) . "\n";
}
sub _color {
    my $msg = _default(shift, my $level = shift, @_);
    return $msg unless $COLORS{$level};
    chomp $msg;
    return color($COLORS{$level}, $msg) . "\n";
}

DESTROY {
    my $self = shift;
    if ($self->{autoclean}) {
        undef $self->{handle} if $self->{file};
        Sys::Syslog::closelog() if $self->{provider} eq "syslog";
    }
}

1;

__END__