Acrux
view release on metacpan or search on metacpan
t/00-pod.t Checking all POD documents
t/00-trailingspace.t Style test: TrailingSpace
t/01-use.t Test script
t/02-util.t Utilities
t/03-refutil.t RefUtil test
t/04-pointer.t Pointer test
t/05-filepid.t FilePid interface
t/06-digest-m11r.t M11R Digest test
t/07-digest-fnv32a.t FNV32a Digest test
t/08-config.t Config test
t/09-log.t Logger test
t/10-app-min.t App with a minimum number of args
t/11-strf.t The strf() function
t/test.conf Test file of config
# Examples
eg/acrux_lite.pl
eg/acrux_log.pl
eg/acrux_std.pl
eg/acrux_test.pl
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Config::General" : "2",
"Sub::Util" : "1.41",
"Sys::Syslog" : "0",
"perl" : "5.020"
}
}
},
"release_status" : "stable",
"resources" : {
"homepage" : "https://sourceforge.net/projects/acrux/",
"license" : [
"https://dev.perl.org/licenses"
],
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Acrux
no_index:
directory:
- t
- inc
requires:
Config::General: '2'
Sub::Util: '1.41'
Sys::Syslog: '0'
perl: '5.020'
resources:
homepage: https://sourceforge.net/projects/acrux/
license: https://dev.perl.org/licenses
repository: https://abalama@git.code.sf.net/p/acrux/code
version: '0.06'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
Makefile.PL view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use ExtUtils::MakeMaker;
my $build_requires = {
'ExtUtils::MakeMaker' => 6.60,
'Test::More' => 0.94,
};
my $prereq_pm = {
'Sys::Syslog' => 0,
'Config::General' => 2.00, # Ubuntu = libconfig-general-perl RHEL = perl-Config-General
'Sub::Util' => 1.41,
};
WriteMakefile(
'NAME' => 'Acrux',
'MIN_PERL_VERSION' => 5.020001,
'VERSION_FROM' => 'lib/Acrux.pm',
'ABSTRACT_FROM' => 'lib/Acrux.pm',
'BUILD_REQUIRES' => $build_requires,
Makefile.PL view on Meta::CPAN
homepage => 'https://sourceforge.net/projects/acrux/',
license => 'https://dev.perl.org/licenses',
repository => {
type => 'git',
url => 'https://abalama@git.code.sf.net/p/acrux/code',
web => 'https://sourceforge.net/p/acrux/code/ci/master/tree/',
},
},
},
clean => {
FILES => '*.tmp *.log *.pid',
},
);
1;
eg/acrux_log.pl view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use utf8;
use Acrux::Log;
use IO::Handle;
my $log = Acrux::Log->new(
handle => IO::Handle->new_from_fd(fileno(STDOUT), "w"),
level => 'trace',
#short => 1,
color => 1,
#format => sub {
# my ($time, $level, @lines) = @_;
# return "[$time] [$level] " . join (' ', @lines) . "\n";
#}
);
$log->trace('Whatever');
$log->debug('You screwed up, but that is ok');
$log->info('You are bad, but you prolly know already');
$log->notice('Normal, but significant, condition...');
$log->warn('Dont do that Dave...');
$log->error('You really screwed up this time');
$log->fatal('Its over...');
$log->crit('Its over...');
$log->alert('Action must be taken immediately');
$log->emerg('System is unusable');
__END__
eg/acrux_test.pl view on Meta::CPAN
### CODE:
my ($self, $meta, @args) = @_;
$self->test; # Call created method
#print dumper(
# "App:" => $self,
# "Meta:" => $meta,
# "Args:" => \@args,
# );
$self->log->debug(sprintf('Config value "/deep/foo/bar/test": >%s<',
$self->config->get("/deep/foo/bar/test")));
# Test log
#$self->log->trace('Whatever');
#$self->log->debug('You screwed up, but that is ok');
#$self->log->info('You are bad, but you prolly know already');
#$self->log->notice('Normal, but significant, condition...');
#$self->log->warn('Dont do that Dave...');
#$self->log->error('You really screwed up this time');
#$self->log->fatal('Its over...');
#$self->log->crit('Its over...');
#$self->log->alert('Action must be taken immediately');
#$self->log->emerg('System is unusable');
return 1;
});
1;
package main;
use Getopt::Long;
use IO::Handle;
eg/acrux_test.pl view on Meta::CPAN
project => 'MyApp',
preload => [qw/Config Log/], # disable preloading all system plugins
options => $options,
root => '.',
configfile => $options->{config} // 't/test.conf',
verbose => $options->{verbose},
debug => $options->{debug},
test => $options->{test},
#config_noload => 1,
loghandle => IO::Handle->new_from_fd(fileno(STDOUT), "w"),
logcolorize => 1
# ($options->{datadir} ? (datadir => $options->{datadir}) : ()),
);
# Check command
unless (grep {$_ eq $command} (@{ $app->handlers(1) })) {
die color("bright_red" => "No handler $command found") . "\n";
}
eg/acrux_test.pl view on Meta::CPAN
use parent 'Acme::Crux::Plugin';
use Acrux::Util qw/color/;
sub register {
my ($self, $app, $args) = @_;
print sprintf(color(bright_magenta => "Registered %s plugin"), $self->name), "\n";
$app->register_method(test => sub { print color(red => "This test method created in plugin register"), "\n" });
$app->log->debug(sprintf("Registered %s plugin", $self->name));
return sprintf 'Ok! I am %s plugin!', $self->name;
}
1;
__END__
lib/Acme/Crux.pm view on Meta::CPAN
options => {foo => 'bar'},
plugins => { foo => 'MyApp::Foo', bar => 'MyApp::Bar' },
preload => 'Config, Log',
cachedir => '/var/cache/myapp',
configfile => '/etc/myapp/myapp.conf',
datadir => '/var/lib/myapp',
docdir => '/usr/share/doc/myapp',
lockdir => '/var/lock/myapp',
logdir => '/var/log/myapp',
logfile => '/var/log/myapp/myapp.log',
pidfile => '/var/run/myapp/myapp.pid',
root => '/etc/myapp',
rundir => '/var/run/myapp',
sharedir => '/usr/share/myapp',
spooldir => '/var/spool/myapp',
tempdir => '/tmp/myapp',
webdir => '/var/www/myapp',
debug => 0,
test => 0,
lib/Acme/Crux.pm view on Meta::CPAN
lockdir => '/var/lock/myapp'
Lock dir for project lock files
$app = $app->lockdir( "/path/to/lock/dir" );
my $lockdir = $app->lockdir;
Default: /var/lock/<MONIKER>
=head2 logdir
logdir => '/var/log/myapp'
Log dir for project logging
$app = $app->logdir( "/path/to/log/dir" );
my $logdir = $app->logdir;
Default: /var/log/<MONIKER>
=head2 logfile
logfile => '/var/log/myapp/myapp.log'
Path to the log file
$app = $app->logfile( "/path/to/file.log" );
my $logfile = $app->logfile;
Default: /var/log/<MONIKER>/<MONIKER>.log
=head2 moniker
moniker => 'myapp'
This attribute sets moniker of project name.
Moniker B<SHOULD> contains only symbols: a-z, 0-9, '_', '-', '.'
$app = $app->moniker( 'myapp' );
lib/Acme/Crux.pm view on Meta::CPAN
my $elapsed = $app->elapsed;
my $timing_begin = [gettimeofday];
# ... long operations ...
my $elapsed = $app->elapsed( $timing_begin );
Return fractional amount of time in seconds since unnamed timstamp has been created while start application
my $elapsed = $app->elapsed;
$app->log->debug("Database stuff took $elapsed seconds");
For formatted output:
$app->log->debug(sprintf("%+.*f sec", 4, $app->elapsed));
=head2 error
my $error = $app->error;
Returns error string if occurred any errors while working with application
$app = $app->error( "error text" );
Sets new error message and returns object
lib/Acme/Crux.pm view on Meta::CPAN
=item L<Acme::Crux::Plugin::Config>
Config => Acme::Crux::Plugin::Config
L<Acrux::Config> configuration plugin
=item L<Acme::Crux::Plugin::Log>
Log => Acme::Crux::Plugin::Log
L<Acrux::Log> logging plugin
=back
=head1 TO DO
See C<TODO> file
=head1 SEE ALSO
L<CTK>, L<CTK::App>
lib/Acme/Crux.pm view on Meta::CPAN
debugmode => 0,
testmode => 0,
verbosemode => 0,
# Dirs
pwd => $pwd,
exedir => $RealBin, # Script dir
root => $args->{root}, # Root dir of project. Default: /etc/moniker
tempdir => $args->{tempdir}, # Temp dir of project. Default: /tmp/moniker
datadir => $args->{datadir}, # Data dir of project. Defaut: /var/lib/moniker
logdir => $args->{logdir}, # Log dir of project. Default: /var/log/moniker
sharedir => $args->{sharedir}, # Share dir. Default: /usr/share/moniker
docdir => $args->{docdir}, # Share dir. Default: /usr/share/doc/moniker
cachedir => $args->{cachedir}, # Cache dir. Default: /var/cache/moniker
spooldir => $args->{spooldir}, # Spool dir. Default: /var/spool/moniker
rundir => $args->{rundir}, # Run dir. Default: /var/run/moniker
lockdir => $args->{lockdir}, # Lock dir. Default: /var/lock/moniker
webdir => $args->{webdir}, # Web dir. Default: /var/www/moniker
# Files
logfile => $args->{logfile}, # Log file of project. Default: /var/log/moniker/moniker.log
configfile => $args->{configfile}, # Config file of project. Default: /etc/moniker/moniker.conf
pidfile => $args->{pidfile}, # PID file of project. Default: /var/run/moniker.pid
}, $class;
# Modes
foreach my $mode ( @{(ALOWED_MODES)}) {
$self->{$mode."mode"} = 1 if is_true_flag($args->{$mode});
}
lib/Acme/Crux.pm view on Meta::CPAN
$temp = $self->{tempdir} = File::Spec->catdir(File::Spec->tmpdir(), $moniker);
}
# Data dir
my $datadir = $self->{datadir};
unless (defined($datadir) && length($datadir)) {
$datadir = $self->{datadir} = File::Spec->catdir(SHAREDSTATEDIR, $moniker);
}
# Log dir
my $logdir = $self->{logdir};
unless (defined($logdir) && length($logdir)) {
$logdir = $self->{logdir} = File::Spec->catdir(LOGDIR, $moniker);
}
# Share dir
my $sharedir = $self->{sharedir};
unless (defined($sharedir) && length($sharedir)) {
$self->{sharedir} = File::Spec->catdir(DATADIR, $moniker);
}
# Doc dir
my $docdir = $self->{docdir};
lib/Acme/Crux.pm view on Meta::CPAN
$self->{webdir} = File::Spec->catdir(WEBDIR, $moniker);
}
# Config file
my $configfile = $self->{configfile};
unless (defined($configfile) && length($configfile)) {
$self->{configfile} = File::Spec->catfile(IS_ROOT ? $root : $pwd, sprintf("%s.conf", $moniker));
}
# Log file
my $logfile = $self->{logfile};
unless (defined($logfile) && length($logfile)) {
$self->{logfile} = File::Spec->catfile(IS_ROOT ? $logdir : $pwd, sprintf("%s.log", $moniker));
}
# PID file
my $pidfile = $self->{pidfile};
unless (defined($pidfile) && length($pidfile)) {
$self->{pidfile} = File::Spec->catfile(IS_ROOT ? $rundir : $pwd, sprintf("%s.pid", $moniker));
}
# Define plugins list to plugin map
$self->plugins(as_hash_ref($args->{plugins}));
lib/Acme/Crux.pm view on Meta::CPAN
return $self->{tempdir};
}
sub datadir {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{datadir} = shift;
return $self;
}
return $self->{datadir};
}
sub logdir {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{logdir} = shift;
return $self;
}
return $self->{logdir};
}
sub sharedir {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{sharedir} = shift;
return $self;
}
return $self->{sharedir};
}
sub docdir {
lib/Acme/Crux.pm view on Meta::CPAN
return $self->{webdir};
}
sub configfile {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{configfile} = shift;
return $self;
}
return $self->{configfile};
}
sub logfile {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{logfile} = shift;
return $self;
}
return $self->{logfile};
}
sub pidfile {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{pidfile} = shift;
return $self;
}
return $self->{pidfile};
}
lib/Acme/Crux/Plugin/Log.pm view on Meta::CPAN
package Acme::Crux::Plugin::Log;
use warnings;
use strict;
use utf8;
=encoding utf-8
=head1 NAME
Acme::Crux::Plugin::Log - The Acme::Crux plugin for logging in your application
=head1 SYNOPSIS
# In startup
$app->plugin('Log');
$app->plugin('Log', undef, { ... options ... });
# In application
$app->log->trace('Whatever');
$app->log->debug('You screwed up, but that is ok');
$app->log->info('You are bad, but you prolly know already');
$app->log->notice('Normal, but significant, condition...');
$app->log->warn('Dont do that Dave...');
$app->log->error('You really screwed up this time');
$app->log->fatal('Its over...');
$app->log->crit('Its over...');
$app->log->alert('Action must be taken immediately');
$app->log->emerg('System is unusable');
=head1 DESCRIPTION
The Acme::Crux plugin for logging in your application
=head1 OPTIONS
This plugin supports the following options
=head2 autoclean
$app->plugin(Log => undef, {autoclean => 1});
This option enables cleaning (closing handler or syslog) on DESTROY
Default: C<logautoclean> command line option or C<logautoclean> application argument
or C<LogAutoclean> configuration value or C<0> otherwise
=head2 color
$app->plugin(Log => undef, {color => 1});
This option enables colorize log messages with the available levels using L<Term::ANSIColor>
Default: C<logcolorize> command line option or C<logcolorize> application argument
or C<LogColorize> configuration value or C<0> otherwise
=head2 facility
$app->plugin(Log => undef, {facility => 'user'});
This option 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<logfacility> command line option or C<logfacility> application argument
or C<LogFacility> configuration value or C<user> otherwise
=head2 file
$app->plugin(Log => undef, {file => '/var/log/myapp.log'});
Log file path used by "handle"
Default: C<logfile> command line option or C<LogFile> configuration value
or C<logfile> application argument or C</var/log/$moniker/$moniker.log> otherwise
=head2 format
$app->plugin(Log => undef, {format => sub {...}});
A callback function for formatting log messages. See L<Acrux::Log/format>
Default: C<logformat> application argument or C<undef> otherwise
=head2 handle
$app->plugin(Log => undef, {
handle => IO::Handle->new_from_fd(fileno(STDOUT), "w")
});
Log filehandle, defaults to opening "file" or uses syslog if file not specified
Default: C<loghandle> application argument or C<undef> otherwise
=head2 ident
$app->plugin(Log => undef, {ident => 'myapp'});
The B<ident> is prepended to every B<syslog> message
Default: C<logident> command line option or C<logident> application argument
or C<LogIdent> configuration value or script name C<basename($0)> otherwise
=head2 level
$app->plugin(Log => undef, {level => 'debug'});
This option sets log level
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.
See also L<Acrux::Log/level>
Default: C<loglevel> command line option or C<loglevel> application argument
or C<LogLevel> configuration value or C<debug> otherwise
=head2 logger
$app->plugin(Log => undef, {logger => Mojo::Log->new()});
This option sets predefined logger, eg. Mojo::Log
Default: C<logger> application argument or C<undef> otherwise
=head2 logopt
$app->plugin(Log => undef, {logopt => 'ndelay,pid'});
This option contains zero or more of the options detailed in L<Sys::Syslog/openlog>
Default: C<logopt> command line option or C<logopt> application argument
or C<LogOpt> configuration value or C<'ndelay,pid'> otherwise
=head2 prefix
$app->plugin(Log => undef, {prefix => '>>>'});
The B<prefix> is prepended to every C<handled> log message
Default: C<logprefix> command line option or C<logprefix> application argument
or C<LogPrefix> configuration value or C<null> otherwise
=head2 provider
$app->plugin(Log => undef, {provider => 'syslog'});
This option select the provider of logging. Avalabled providers:
C<logger>, C<handler>, C<file> and C<syslog>.
Default: C<logprovider> command line option or C<logprovider> application argument
or C<LogProvider> configuration value or C<file> otherwise
=head2 short
$app->plugin(Log => undef, {short => 1});
Generate short log messages without a timestamp but with log level prefix
Default: C<logshort> command line option or C<logshort> application argument
or C<LogShort> configuration value or C<0> otherwise
=head1 METHODS
This class inherits all methods from L<Acme::Crux::Plugin> and implements the following new ones
=head2 register
$plugin->register($app, {file => '/var/log/app.log'});
Register plugin in Acme::Crux application
=head1 HELPERS
All helpers of this plugin are allows get access to logger object.
See L<Acrux::Log> for details
=head2 log
Returns L<Acrux::Log> object
=head1 TO DO
See C<TODO> file
=head1 SEE ALSO
L<Acme::Crux::Plugin>, L<Acrux::Log>
lib/Acme/Crux/Plugin/Log.pm view on Meta::CPAN
use Carp qw/croak/;
use Acrux::RefUtil qw/as_array_ref as_hash_ref is_code_ref is_true_flag is_ref/;
sub register {
my ($self, $app, $args) = @_;
my $has_config = $app->can('config') ? 1 : 0;
# Autoclean flag: PLGARGS || OPTS || ORIG || CONF || DEFS
my $autoclean = is_true_flag($args->{autoclean}) # From plugin arguments first
|| $app->getopt("logautoclean") # From command line options
|| $app->orig->{"logautoclean"} # From App arguments
|| ($has_config ? $app->config->get("/logautoclean") : 0); # From config file
# Colorize flag: PLGARGS || OPTS || ORIG || CONF || DEFS
my $colorize = is_true_flag($args->{color}) # From plugin arguments first
|| $app->getopt("logcolorize") # From command line options
|| $app->orig->{"logcolorize"} # From App arguments
|| ($has_config ? $app->config->get("/logcolorize") : 0); # From config file
# Log facility: PLGARGS || OPTS || ORIG || CONF || DEFS
my $facility = $args->{facility} # From plugin arguments first
|| $app->getopt("logfacility") # From command line options
|| $app->orig->{"logfacility"} # From App arguments
|| ($has_config ? $app->config->get("/logfacility") : ''); # From config file
# Log file: PLGARGS || OPTS || CONF || ORIG || DEFS
my $file = $args->{file} # From plugin arguments first
|| $app->getopt("logfile") # From command line options
|| ($has_config ? $app->config->get("/logfile") : '') # From config file
|| $app->logfile; # From App arguments
# Format: PLGARGS || DEFS
my $frmt = $args->{format} || $app->orig->{"logformat"};
if (defined($frmt) && length($frmt)) {
croak(qq{Invalid log format coderef}) unless is_code_ref($frmt);
}
# Handle: PLGARGS || DEFS
my $handle = $args->{handle} || $app->orig->{"loghandle"};
if (defined $handle) {
croak(qq{Invalid log handle}) unless is_ref($handle);
}
# Log ident: PLGARGS || OPTS || ORIG || CONF || DEFS
my $ident = $args->{ident} # From plugin arguments first
|| $app->getopt("logident") # From command line options
|| $app->orig->{"logident"} # From App arguments
|| ($has_config ? $app->config->get("/logident") : ''); # From config file
# Log level: PLGARGS || OPTS || ORIG || CONF || DEFS
my $level = $args->{level} # From plugin arguments first
|| $app->getopt("loglevel") # From command line options
|| $app->orig->{"loglevel"} # From App arguments
|| ($has_config ? $app->config->get("/loglevel") : ''); # From config file
# Logger: PLGARGS || DEFS
my $logger = $args->{logger} || $app->orig->{"logger"};
if (defined $logger) {
croak(qq{Invalid logger object}) unless is_ref($logger);
}
# Log options: PLGARGS || OPTS || ORIG || CONF || DEFS
my $logopt = $args->{logopt} # From plugin arguments first
|| $app->getopt("logopt") # From command line options
|| $app->orig->{"logopt"} # From App arguments
|| ($has_config ? $app->config->get("/logopt") : ''); # From config file
# Short flag: PLGARGS || OPTS || ORIG || CONF || DEFS
my $short = is_true_flag($args->{short}) # From plugin arguments first
|| $app->getopt("logshort") # From command line options
|| $app->orig->{"logshort"} # From App arguments
|| ($has_config ? $app->config->get("/logshort") : 0); # From config file
# Log prefix: PLGARGS || OPTS || ORIG || CONF || DEFS
my $prefix = $args->{prefix} # From plugin arguments first
|| $app->getopt("logprefix") # From command line options
|| $app->orig->{"logprefix"} # From App arguments
|| ($has_config ? $app->config->get("/logprefix") : ''); # From config file
# Correct provider rules
my $provider = $args->{provider} # From plugin arguments first
|| $app->getopt("logprovider") # From command line options
|| $app->orig->{"logprovider"} # From App arguments
|| ($has_config ? $app->config->get("/logprovider") : '') || ''; # From config file
if ($provider eq 'syslog') { $file = $handle = $logger = undef }
elsif ($provider eq 'file') { $logger = $handle = undef }
elsif ($provider eq 'handle') { $logger = undef }
# Create instance
my $log = Acrux::Log->new(
autoclean => $autoclean,
color => $colorize, # !!
facility => $facility,
file => $file,
format => $frmt, # !!
handle => $handle,
ident => $ident,
level => $level,
logger => $logger,
logopt => $logopt,
short => $short,
prefix => $prefix,
);
# Set log helper (method)
$app->register_method(log => sub { $log });
return $log;
}
1;
__END__
lib/Acrux/Const.pm view on Meta::CPAN
*BINDIR = sub { $bindir }; # bindir /usr/bin
*SBINDIR = sub { state $sbindir = File::Spec->catdir($prefix, 'sbin') }; # sbindir /usr/sbin
*DATADIR = sub { state $datadir = File::Spec->catdir($prefix, 'share') }; # datadir /usr/share
*DOCDIR = sub { state $docdir = File::Spec->catdir($prefix, 'share', 'doc') }; # docdir /usr/share/doc
*LOCALEDIR = sub { state $localedir = File::Spec->catdir($prefix, 'share', 'locale') }; # localedir /usr/share/locale
*MANDIR = sub { state $mandir = File::Spec->catdir($prefix, 'share', 'man') }; # mandir /usr/share/man
*LOCALBINDIR = sub { state $localbindir = File::Spec->catdir($prefix, 'local', 'bin') };# localbindir /usr/local/bin
# Local State related Dirs
*CACHEDIR = sub { state $cachedir = File::Spec->catdir($localstatedir, 'cache') }; # cachedir /var/cache
*LOGDIR = sub { state $logdir = File::Spec->catdir($localstatedir, 'log') }; # logdir /var/log
*SPOOLDIR = sub { state $spooldir = File::Spec->catdir($localstatedir, 'spool') }; # spooldir /var/spool
*RUNDIR = sub { state $rundir = File::Spec->catdir($localstatedir, 'run') }; # rundir /var/run
*LOCKDIR = sub { state $lockdir = File::Spec->catdir($localstatedir, 'lock') }; # lockdir /var/lock
*SHAREDSTATEDIR = sub { state $sharedstatedir = File::Spec->catdir($localstatedir, 'lib') }; # sharedstatedir /var/lib
*WEBDIR = sub { state $webdir = File::Spec->catdir($localstatedir, 'www') }; # webdir /var/www
1;
__END__
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;
# Using syslog
my $log = Acrux::Log->new();
$log->error("My test error message to syslog")
# Using file
my $log = Acrux::Log->new(file => '/tmp/test.log');
$log->error("My test error message to /tmp/test.log")
# Using STDOUT (handle)
my $log = Acrux::Log->new(
handle => IO::Handle->new_from_fd(fileno(STDOUT), "w")
);
$log->error("My test error message to STDOUT")
# 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 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'
Log file path used by "handle"
=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 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-2024 D&D Corporation. All Rights Reserved
=head1 LICENSE
lib/Acrux/Log.pm view on Meta::CPAN
modify it under the same terms as Perl itself.
See C<LICENSE> file and L<https://dev.perl.org/licenses/>
=cut
our $VERSION = '0.01';
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,
'error' => 3,
'fatal' => 2, 'crit' => 2,
'alert' => 1,
lib/Acrux/Log.pm view on Meta::CPAN
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;
# 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 log 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', @_) }
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 {
lib/Acrux/Log.pm view on Meta::CPAN
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__
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#########################################################################
use strict;
use utf8;
use Test::More;
use_ok qw/Acrux::Log/;
# Error message with debug loglevel
{
my $log = Acrux::Log->new();
is $log->level, 'debug', "Debug LogLevel";
ok $log->error("My test error message"), 'Error message to syslog';
}
# Info and fatal message with eror loglevel
{
my $log = Acrux::Log->new(level => 'error');
is $log->level, 'error', "Error LogLevel";
ok !$log->info("My test info message"), 'Info message not allowed';
ok $log->fatal("My test fatal message"), 'Fatal message to syslog';
#note explain $log;
}
# Fake Logger
{
my $fake = FakeLogger->new;
my $log = Acrux::Log->new(logger => $fake);
$log->error("Test error message") and ok 1, "Test error message to STDOUT via FakeLogger";
#ok $log->debug("Test debug message");
$log->info("Test info message") and ok 1, "Test info message to STDOUT via FakeLogger";
#note explain $log;
}
# File
{
my $log = Acrux::Log->new(file => 'log.tmp');
$log->error("Test error message") and ok 1, "Test error message to file";
$log->warn("ТеÑтовое Ñообщение") and ok 1, "Test error message to file (RU)";
$log->info("Test info message") and ok 1, "Test info message to file";
}
# STDOUT
{
use IO::Handle;
my $log = Acrux::Log->new(
handle => IO::Handle->new_from_fd(fileno(STDOUT), "w"),
prefix => '# ',
);
ok $log->error("My test error message"), 'Error message to handler STDOUT';
}
done_testing;
1;
package FakeLogger;
sub new { bless {}, shift }
sub info { printf "# Info[$$] %s\n", pop @_ }
sub error { printf "# Error[$$] %s\n", pop @_ }
1;
__END__
prove -lv t/09-log.t
( run in 0.778 second using v1.01-cache-2.11-cpan-49f99fa48dc )