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
my @names_and_aliases = $app->handlers(1);
Returns list of aliases and names of registered handlers
=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
$seen{$_a} = 1 if defined($_a) and length($_a);
}
}
return [(sort {$a cmp $b} keys %seen)];
}
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;
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/Log.pm view on Meta::CPAN
=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
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 info
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,
'error' => 3,
'fatal' => 2, 'crit' => 2,
'alert' => 1,
'emerg' => 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();
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
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;
( run in 0.411 second using v1.01-cache-2.11-cpan-65fba6d93b7 )