Acrux
view release on metacpan or search on metacpan
lib/Acrux/Log.pm view on Meta::CPAN
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>
See also L<Sys::Syslog/Levels>
=head2 logger
logger => Mojo::Log->new()
This attribute perfoms to set predefined logger, eg. Mojo::Log
Default: C<undef>
=head2 logopt
logopt => 'ndelay,pid'
This attribute contains zero or more of the options detailed in L<Sys::Syslog/openlog>
Default: C<'ndelay,pid'>
=head2 prefix
prefix => '>>>'
The B<prefix> is prepended to every C<handled> log message
Default: null
=head2 short
short => 1
Generate short log messages without a timestamp but with log level prefix, defaults to C<0>
=head1 METHODS
This class implements the following methods
=head2 alert
$log->alert('Action must be taken immediately');
$log->alert('Real', 'problem');
Log C<alert> message
=head2 crit
$log->crit('Its over...');
$log->crit('Bye', 'bye');
Log C<crit> message (See L</fatal> method)
=head2 debug
$log->debug('You screwed up, but that is ok');
$log->debug('All', 'cool');
Log C<debug> message
=head2 emerg
$log->emerg('System is unusable');
$log->emerg('To', 'die');
Log C<emerg> message
=head2 error
$log->error('You really screwed up this time');
$log->error('Wow', 'seriously');
Log C<error> message
=head2 fatal
$log->fatal('Its over...');
$log->fatal('Bye', 'bye');
Log C<fatal> message
=head2 file
my $file = $log->file;
This method returns file path
=head2 info
$log->info('You are bad, but you prolly know already');
$log->info('Ok', 'then');
Log C<info> message
=head2 level
my $level = $log->level;
$log = $log->level('debug');
Active log level, defaults to debug.
Available log levels are C<trace>, C<debug>, C<info>, C<notice>, C<warn>, C<error>,
C<fatal> (C<crit>), C<alert> and C<emerg>, in that order
=head2 logger
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/;
lib/Acrux/Log.pm view on Meta::CPAN
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, ">>");
lib/Acrux/Log.pm view on Meta::CPAN
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__
( run in 0.925 second using v1.01-cache-2.11-cpan-d80b1682f3f )