Acrux
view release on metacpan or search on metacpan
eg/acrux_lite.pl view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
# perl -Ilib eg/acrux_lite.pl ver
# perl -Ilib eg/acrux_lite.pl test 1 2 3
# perl -Ilib eg/acrux_lite.pl error
use Acme::Crux;
use Acrux::Util qw/dumper color/;
my $app = Acme::Crux->new(
project => 'MyApp',
preload => [], # disable preloading all system plugins
);
#print Acrux::Util::dumper($app);
eg/acrux_lite.pl view on Meta::CPAN
### CODE:
my ($self, $meta, @args) = @_;
print dumper({
meta => $meta,
args => \@args,
});
return 1;
});
$app->register_handler(
handler => "error",
description => "Error test handler",
code => sub {
### CODE:
my ($self, $meta, @args) = @_;
$self->error("My test error string");
return 0;
});
my $command = shift(@ARGV) // 'default';
my @arguments = @ARGV ? @ARGV : ();
# Check command
unless (grep {$_ eq $command} (@{ $app->handlers(1) })) {
die color("bright_red" => "No handler $command found") . "\n";
}
# Run
my $exitval = $app->run($command, @arguments) ? 0 : 1;
warn color("bright_red" => $app->error) . "\n" and exit $exitval if $exitval;
1;
__END__
eg/acrux_log.pl view on Meta::CPAN
# 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_std.pl view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
# perl -Ilib eg/acrux_std.pl ver
# perl -Ilib eg/acrux_std.pl test 1 2 3
# perl -Ilib eg/acrux_std.pl error
# perl -Ilib eg/acrux_std.pl noop
package MyApp;
use parent 'Acme::Crux';
use Acrux::Util qw/dumper color/;
our $VERSION = '1.00';
eg/acrux_std.pl view on Meta::CPAN
### CODE:
my ($self, $meta, @args) = @_;
print dumper({
meta => $meta,
args => \@args,
});
return 1;
});
__PACKAGE__->register_handler(
handler => "error",
description => "Error test handler",
code => sub {
### CODE:
my ($self, $meta, @args) = @_;
$self->error("My test error string");
return 0;
});
1;
package main;
use Acrux::Util qw/dumper color/;
my $app = MyApp->new(
eg/acrux_std.pl view on Meta::CPAN
my $command = shift(@ARGV) // 'default';
my @arguments = @ARGV ? @ARGV : ();
# Check command
unless (grep {$_ eq $command} (@{ $app->handlers(1) })) {
die color("bright_red" => "No handler $command found") . "\n";
}
# Run
my $exitval = $app->run($command, @arguments) ? 0 : 1;
warn color("bright_red" => $app->error) . "\n" and exit $exitval if $exitval;
1;
__END__
eg/acrux_test.pl view on Meta::CPAN
$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;
eg/acrux_test.pl view on Meta::CPAN
);
# Check command
unless (grep {$_ eq $command} (@{ $app->handlers(1) })) {
die color("bright_red" => "No handler $command found") . "\n";
}
# Run
my $exitval = $app->run($command, @arguments) ? 0 : 1;
warn color("bright_red" => $app->error) . "\n" and exit $exitval if $exitval;
1;
package MyTestPlugin;
use warnings;
use strict;
use utf8;
our $VERSION = '0.01';
lib/Acme/Crux.pm view on Meta::CPAN
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
=head2 exedir
my $exedir = $app->exedir;
Gets exedir value
=head2 handlers
my @names = $app->handlers;
lib/Acme/Crux.pm view on Meta::CPAN
$app->has_handler($command)
or die "The command not found";
This method returns true if the specified command name is exists
=head2 lookup_handler
my $handler = $app->lookup_handler($name)
or die "Handler not found";
Lookup handler by name or aliase. Returns handler or undef while error
=head2 option, opt, getopt
my $value = $app->option("key");
Returns option value by key
my $options = $app->option;
Returns hash-ref structure to all options
lib/Acme/Crux.pm view on Meta::CPAN
By default this method is alias for L</run_handler> method.
This method meant to be overloaded in a subclass
=head2 run_handler
my $result = $app->run_handler("foo",
foo => "one",
bar => 1
) or die $app->error;
Runs handler by name and returns result of it handler running
=head2 silentmode
$app->silentmode;
Returns the verbose flag in the opposite value. 0 - verbose, 1 - silent.
See L</verbosemode>
lib/Acme/Crux.pm view on Meta::CPAN
|| $class || scalar(caller(0));
my $moniker = $args->{moniker} || _project2moniker($project)
|| _project2moniker($class || scalar(caller(0)));
# Current dir
my $pwd = getcwd();
# Create
my $self = bless {
# Common
error => "",
script => $Script,
invocant => scalar(caller(0)),
project => $project,
moniker => $moniker,
pid => $$,
running => 0,
# General
orig => {%$args},
created => Time::HiRes::time,
lib/Acme/Crux.pm view on Meta::CPAN
return $self->{pidfile};
}
# Modes (methods)
sub testmode { !! shift->{testmode} }
sub debugmode { !! shift->{debugmode} }
sub verbosemode { !! shift->{verbosemode} }
sub silentmode { ! shift->{verbosemode} }
# Methods
sub error {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{error} = shift;
return $self;
}
return $self->{error};
}
sub begin {
my $self = shift;
$self->{hitime} = [gettimeofday];
return $self->{hitime}
}
sub elapsed {
my $self = shift;
my $timing_begin = shift;
return undef unless my $started = $timing_begin || $self->{hitime};
lib/Acme/Crux.pm view on Meta::CPAN
my $self = shift;
my $name = shift // ''; # Plugin name
my $class = shift // ''; # Plugin class
my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}; # Plugin arguments
my $plugins = $self->{plugins};
croak "No plugin name specified!" unless length $name;
croak "No plugin class specified!" unless length $class;
# Load plugin if not exists in already loaded plugins list
return 1 if exists($plugins->{$name}) && $plugins->{$name}->{loaded};
if (my $error = load_class($class)) {
$self->verbosemode
? die qq{Plugin "$name" missing, maybe you need to install it?\n$error\n}
: die qq{Plugin "$name" missing, maybe you need to install it?\n};
}
# Create plugin instance
die qq{Plugin "$name" no contains required the "new" method\n} unless $class->can('new');
my $p = $class->new($name);
# Register this plugin
my $ret = $p->register($self, $args); # $app, $args
lib/Acme/Crux.pm view on Meta::CPAN
my $self = shift;
my $name = trim(shift // '');
return undef unless length $name;
return !!grep { $_ eq $name } @{ $self->handlers(1) };
}
sub run_handler {
my $self = shift;
my $name = shift // 'default';
my @args = @_;
if ($self->{running}) {
$self->error(sprintf(qq{The application "%s" is already runned}, $self->project));
return 0;
}
unless(length($name)) {
$self->error("Invalid handler name");
return 0;
}
my $meta = $self->lookup_handler($name);
unless ($meta) {
$self->error(sprintf("Handler %s not found", $name));
return 0;
}
# Run
my %info = (orig => $name);
my $func;
$self->{running} = 1;
foreach my $k (keys %$meta) {
next unless defined $k;
if ($k eq 'code') {
$func = $meta->{code};
next;
}
$info{$k} = $meta->{$k};
}
unless(is_code_ref($func)) {
$self->error("Handler code not found! Maybe you need to implement it?");
return 0;
}
# Call function and return
my $ret = &$func($self, {%info}, @args);
$self->{running} = 0;
return $ret;
}
sub run { goto &run_handler }
lib/Acme/Crux/Plugin/Config.pm view on Meta::CPAN
# Create instance
my $config = Acrux::Config->new(
file => $file,
options => $options,
noload => $noload,
defaults => $defaults,
root => $root,
dirs => $dirs,
);
if (my $err = $config->error) {
if ($app->debugmode) {
$app->verbosemode
? warn qq{Can't load configuration file "$file"\n$err\n}
: warn qq{Can't load configuration file "$file"\n};
}
}
# Set conf and config helpers (methods)
$app->register_method(config => sub { $config });
$app->register_method(conf => sub { $config });
lib/Acme/Crux/Plugin/Log.pm view on Meta::CPAN
# 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
lib/Acme/Crux/Plugin/Log.pm view on Meta::CPAN
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
lib/Acrux/Config.pm view on Meta::CPAN
# ['value']
Returns an array of found values from configuration
=head2 config, conf
my $config_hash = $config->config; # { ... }
This method returns config structure directly as hash ref
=head2 error
my $error = $config->error;
Returns error string if occurred any errors while creating the object or reading the configuration file
=head2 first
say $config->first('/foo'); # ['first', 'second', 'third']
# first
Returns an first value of found values from configuration
=head2 get
lib/Acrux/Config.pm view on Meta::CPAN
sub new {
my $class = shift;
my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
my $self = bless {
default => $args->{defaults} || $args->{default} || {},
file => $args->{file} // '',
root => $args->{root} // '', # base path to default files/directories
dirs => $args->{dirs} || [],
noload => $args->{noload} || 0,
options => {},
error => '',
config => {},
pointer => Acrux::Pointer->new,
files => [],
orig => $args->{options} || $args->{opts} || {},
}, $class;
my $myroot = length($self->{root}) ? $self->{root} : getcwd();
# Set dirs
my @dirs = ();
foreach my $dir (as_array($self->{dirs})) {
lib/Acrux/Config.pm view on Meta::CPAN
my $file = $self->{file};
$file = sprintf("%s.conf", basename($0)) unless length $file;
unless (File::Spec->file_name_is_absolute($file)) { # rel
$file = length($myroot)
? File::Spec->rel2abs($file, $myroot)
: File::Spec->rel2abs($file);
}
$self->{file} = $file;
unless ($self->{noload}) {
unless (-r $file) {
$self->{error} = sprintf("Configuration file \"%s\" not found or unreadable", $file);
return $self;
}
}
# Config::General Options
my $orig = $self->{orig};
$orig = {} unless is_hash_ref($orig);
my %options = (%{DEFAULT_CG_OPTS()}, %$orig); # Merge everything
$options{'-ConfigFile'} = $file;
$options{"-ConfigPath"} ||= [@dirs] if scalar(@dirs);
lib/Acrux/Config.pm view on Meta::CPAN
return $self->load;
}
sub default {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{default} = shift;
return $self;
}
return $self->{default};
}
sub error {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{error} = shift;
return $self;
}
return $self->{error};
}
sub file {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{file} = shift;
return $self;
}
return $self->{file};
}
sub dirs {
lib/Acrux/Config.pm view on Meta::CPAN
if (scalar(@_) >= 1) {
$self->{dirs} = shift;
return $self;
}
return $self->{dirs};
}
sub pointer { shift->{pointer} }
sub load {
my $self = shift;
my $opts = $self->{options};
$self->{error} = "";
# Load
my $cfg = eval { Config::General->new(%$opts) };
return $self->error(sprintf("Can't load configuration from file \"%s\": %s", $self->file, $@)) if $@;
return $self->error(sprintf("Configuration file \"%s\" did not return a Config::General object", $self->file))
unless ref $cfg eq 'Config::General';
my %config = $cfg->getall;
my @files = $cfg->files;
# Merge defaults
my $defaults = $self->default || {};
%config = (%$defaults, %config) if is_hash_ref($defaults) && scalar keys %$defaults;
# Add system values
$config{'_config_files'} = [@files];
lib/Acrux/FileLock.pm view on Meta::CPAN
use Acrux::FileLock;
my $fl = Acrux::FileLock->new(
file => '/tmp/file.lock',
pid => $$,
auto => 0,
flock => 0,
);
if ( $fl->check ) {
warn $fl->error if $fl->error;
die "Already running: $fl->own";
}
$fl->lock;
die $fl->error if $fl->error;
# . . . do stuff . . .
$fl->unlock;
die $fl->error if $fl->error;
... or with auto-lock and auto-unlock:
my $fl = Acrux::FileLock->new(
file => '/tmp/file.lock',
pid => $$,
auto => 1,
);
die $fl->error if $fl->error;
die "Already running" if $fl->check;
# . . . do stuff . . .
=head1 DESCRIPTION
The Lock File simple interface
This package manages a lock files. It will create a lock file,
query the process within to discover if it's still running, and remove
lib/Acrux/FileLock.pm view on Meta::CPAN
Number of times to retry getting a lockfile
Default: 5
=back
=head2 check
if ( $fl->check ) {
warn $fl->error if $fl->error;
die "Already running: $fl->own";
}
This method checks whether the lock is currently considered active.
Returns C<1> if the lock is active or C<0> if the lock is free.
The return value is always boolean and does not contain the PID of the
lock owner.
Before checking the lock state, this method reads the owner information
lib/Acrux/FileLock.pm view on Meta::CPAN
by the system file lock. The C<own> and C<uid> attributes are still
updated from the lock file, but they do not participate in determining
the lock state.
In the regular mode, the owner PID and UID are additionally used to
determine whether the lock is still valid. A stale lock file is removed
automatically when possible.
If a stale lock file cannot be removed by the operating system, the
lock is considered active and C<check> returns C<1>. This condition is
reported through the debug facility and does not set C<error>.
=head2 error
my $error = $fl->error;
Returns current error message
=head2 file
my $file = $fl->file;
Accessor for the filename used as the lock file.
=head2 lock
$self = $self->lock;
lib/Acrux/FileLock.pm view on Meta::CPAN
use constant {
RETRIES => 5,
DELAY => 60,
};
sub new {
my $class = shift;
my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
my $self = bless {%$args}, $class;
$self->{debug} ||= 0;
$self->{error} = "";
$self->{file} //= File::Spec->catfile(getcwd, sprintf("%s.lock", basename($0)));
$self->{pid} //= $$; # Current PID by default
$self->{own} //= 0; # Owner PID
$self->{uid} //= 0; # Owner UID
$self->{auto} //= 0;
$self->{retries} //= RETRIES;
$self->{delay} //= DELAY;
$self->{'flock'} ||= 0;
$self->{fh} = undef;
$self->{_is_locked} = 0;
lib/Acrux/FileLock.pm view on Meta::CPAN
return $self->{own};
}
sub uid { # Owner UID
my $self = shift;
if (scalar(@_) >= 1) {
$self->{uid} = shift;
return $self;
}
return $self->{uid};
}
sub error {
my $self = shift;
if (scalar(@_) >= 1) {
$self->{error} = shift;
return $self;
}
return $self->{error};
}
sub lock {
my $self = shift;
$self->error(undef);
if ($self->_is_locked) {
$self->_debug(sprintf("File \"%s\" already locked", $self->file));
return $self;
}
# Signals
$SIG{HUP} = $SIG{QUIT} = $SIG{INT} = $SIG{TERM} = sub {
$self->_debug( "Caught SIG$_[0]" );
exit;
};
# Using flock
if ($self->_use_flock) {
# Initialize or reuse initialized fh
$self->{fh} //= IO::File->new($self->file, O_RDWR | O_CREAT);
if (my $fh = $self->{fh}) {
unless (flock $fh, LOCK_EX | LOCK_NB) {
$self->error(sprintf("Can't lock \"%s\": %s", $self->file, $!));
$self->_debug($self->error);
$self->{fh} = undef;
return $self;
}
# Truncate file
unless (truncate $fh, 0) {
$self->error(sprintf("Can't truncate \"%s\": %s", $self->file, $!));
$self->_debug($self->error);
return $self->_rollback;
}
seek $fh, 0, 0;
# Write data
unless ($fh->printf("%d:%d\n", $self->pid || $$, $>)) {
$self->error(sprintf("Can't write message to \"%s\": %s", $self->file, $!));
$self->_debug($self->error);
return $self->_rollback;
}
# Ok
$self->{_is_locked} = 1;
$self->own($self->pid || $$)->uid($>);
$self->_debug("Got lock file (flock=true)");
} else {
$self->error(sprintf("Can't open \"%s\": %s", $self->file, $!));
$self->_debug($self->error);
}
return $self;
}
# Regular case: save temp file first
my $tmp_file = sprintf("%s.%d", $self->file, $self->pid);
if (my $fh = IO::File->new($tmp_file, O_WRONLY | O_CREAT)) {
unless ($fh->printf("%d:%d\n", $self->pid || $$, $>)) {
$self->error(sprintf("Can't write message to \"%s\": %s", $tmp_file, $!));
$self->_debug($self->error);
unlink $tmp_file if -f $tmp_file;
return $self;
}
unless ($fh->close) {
$self->error(sprintf("Can't close \"%s\": %s", $tmp_file, $!));
$self->_debug($self->error);
unlink $tmp_file if -f $tmp_file;
return $self;
}
# Rename temp file to lock file
for my $try (0 .. $self->{retries}) {
unless ($self->check()) { # not exists, ok
if (rename($tmp_file, $self->file)) {
$self->{_is_locked} = 1;
$self->_debug("Got lock file (flock=false)");
return $self;
}
}
if ($self->{retries} && ($try != $self->{retries})) {
$self->_debug(sprintf("Retrying in %d seconds", $self->{delay}));
sleep $self->{delay} unless ($try == $self->{retries});
}
}
} else {
$self->error(sprintf("Can't open \"%s\": %s", $tmp_file, $!));
$self->_debug($self->error);
}
# Remove temp file in silent mode
unlink $tmp_file if -f $tmp_file;
# Ok
return $self;
}
sub check {
my $self = shift;
$self->error(undef);
# Read owner-data of existed file (see own and uid accessors)
$self->_read_owner;
return $self->_is_locked
if $self->_use_flock;
# File not exists. Returns 0
return 0 unless -f $self->file;
lib/Acrux/FileLock.pm view on Meta::CPAN
unless (-f $self->file) {
$self->own(0)->uid(0);
}
$self->_debug("Found and removed stale lock file");
}
return 0;
}
sub unlock {
my $self = shift;
$self->error(undef);
# Remove lock file
if ($self->_is_locked) {
# Release file handler first
if ($self->{fh}) {
flock $self->{fh}, LOCK_UN;
$self->{fh} = undef;
}
# Unlink file
$self->error(sprintf("Can't remove \"%s\": %s", $self->file, $!))->_debug($self->error)
unless unlink $self->file;
$self->own(0)->uid(0) unless -f $self->file; # Reset owner PID and UID to 0
} else {
$self->own(0)->uid(0) # Reset owner PID and UID to 0
}
# Remove temp file in silent mode
my $tmp_file = sprintf("%s.%d", $self->file, $self->pid);
unlink $tmp_file if -f $tmp_file;
lib/Acrux/Log.pm view on Meta::CPAN
=head1 NAME
Acrux::Log - Acrux logger
=head1 SYNOPSIS
use Acrux::Log;
# Logging to STDERR (by default)
my $log = Acrux::Log->new();
$log->error("My test error message to STDERR")
# Using file
my $log = Acrux::Log->new(file => '/tmp/test.log');
$log->error("My test error message to /tmp/test.log")
# Using STDOUT
my $log = Acrux::Log->new(file => 'stdout'); # or 'stdout:', ':stdout'
my $log = Acrux::Log->new(file => '-');
# Using STDOUT (handle)
my $log = Acrux::Log->new(
handle => IO::Handle->new_from_fd(fileno(STDOUT), "w")
);
lib/Acrux/Log.pm view on Meta::CPAN
# 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
lib/Acrux/Log.pm view on Meta::CPAN
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
lib/Acrux/Log.pm view on Meta::CPAN
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()
lib/Acrux/Log.pm view on Meta::CPAN
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
lib/Acrux/Log.pm view on Meta::CPAN
$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
lib/Acrux/Log.pm view on Meta::CPAN
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;
lib/Acrux/Log.pm view on Meta::CPAN
}
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;
lib/Acrux/Util.pm view on Meta::CPAN
$is_unix = is_os_type('Unix', 'dragonfly');
Given an OS type and OS name, returns true or false if the OS name is of the given type.
As with os_type, it will use the current operating system as a default
if no OS name is provided
Original this function see in L<Perl::OSType/is_os_type>
=head2 load_class
my $error = load_class('Foo::Bar');
Loads a class and returns a false value if loading was successful,
a true value if the class was not found or loading failed.
=head2 os_type
$os_type = os_type(); # Unix
$os_type = os_type('MSWin32'); # Windows
Returns a single, generic OS type for a given operating system name.
t/08-config.t view on Meta::CPAN
BEGIN { use_ok('Acrux::Config') }
my $c = Acrux::Config->new(
#root => '/tmp/test',
#dirs => ['t', 'src', '/home/minus/prj/modules/Acrux/lib'],
file => 't/test.conf',
);
#diag explain $c;
# Check errors
ok(!$c->error, 'Check errors') or do { diag $c->error; exit 255 if $c->error };
## Foo One
## Bar 1
## Baz On
## Qux Off
## <Box>
## Test 123
## </Box>
## <Array>
## Test First
use strict;
use utf8;
use Test::More;
use_ok qw/Acrux::Log/;
# Error message with debug loglevel
{
my $log = Acrux::Log->new(prefix => '# ', file => '-');
is $log->level, 'debug', "Debug LogLevel";
ok $log->error("My test error message #1"), 'Error message to STDOUT';
}
# Info and fatal message with eror loglevel
{
my $log = Acrux::Log->new(level => 'error', prefix => '# ', file => '-');
is $log->level, 'error', "Error LogLevel";
ok !$log->info("My test info message #2"), 'Info message not allowed';
ok $log->fatal("My test fatal message #2.1"), 'Fatal message to syslog';
#note explain $log;
}
# Fake Logger
{
my $fake = FakeLogger->new;
my $log = Acrux::Log->new(logger => $fake, prefix => '# ');
$log->error("Test error message #3") and ok 1, "Test error message to STDOUT via FakeLogger";
#ok $log->debug("Test debug message");
$log->info("Test info message #3.1") 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 #4"), '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
t/10-app-min.t view on Meta::CPAN
use Test::More;
use_ok qw/Acme::Crux/;
# Direct
{
my $app = new_ok( 'Acme::Crux' => [(
project => 'MyApp',
preload => [], # Disable plugins
)] );
ok(!$app->error, 'No errors') or diag($app->error);
}
1;
package MyApp;
use parent 'Acme::Crux';
__PACKAGE__->register_handler; # default
t/10-app-min.t view on Meta::CPAN
package main;
# MyApp
my $app = new_ok( 'MyApp' => [(
project => 'MyApp',
preload => [], # Disable plugins
)] ); # => \@args
# Run defult handler
ok($app->run, "Default handler returns 1") or diag $app->error;
# And again
ok($app->run, "Default handler returns 1 (retry)") or diag $app->error;
#my $handler = $app->lookup_handler( 'foo' );
#note explain $handler;
#my $handlers = $app->handlers(1);
#note explain $handlers;
#my $res = $app->run('one', abc => 123, def => 456);
#note explain $res;
t/13-filelock.t view on Meta::CPAN
use constant FLOCK => !!($ENV{ACRUX_FILELOCK_FLOCK} || 0);
my $file = "test13.lock";
note "Current PID=$$";
subtest "Base call" => sub {
my $l = Acrux::FileLock->new(file => $file, debug => DEBUG, flock => FLOCK);
is $l->pid, $$, "$$ current process by default";
# Lock
ok !$l->lock->error, "$$ lock file" or diag $l->error;
# Check
ok $l->check, "$$ is locked";
# Get owner uid
if (my $owner_uid = $l->uid) {
is $owner_uid, $>, "$$ owner uid" and note "owner uid = $owner_uid";
}
# Unlock
t/13-filelock.t view on Meta::CPAN
ok !$l->check, "$$ now is NOT locked";
};
subtest "Auto call" => sub {
my $l = Acrux::FileLock->new(file => $file, auto => 1, debug => DEBUG, flock => FLOCK);
# Check
ok $l->check, "$$ is locked";
# Lock again
ok !$l->lock->error, "$$ lock file again" or diag $l->error;
};
subtest "Fork mode" => sub {
# Parent process
if (my $child = fork) {
sleep 1;
my $l = Acrux::FileLock->new(file => $file, auto => 1, flock => FLOCK);
note sprintf "Parent PID: %s; Parent Owner PID: %s", $l->pid, $l->own;
( run in 1.968 second using v1.01-cache-2.11-cpan-364913b4093 )