Acrux
view release on metacpan or search on metacpan
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
my $origin_args = $app->orig;
Returns hash-ref structure to all origin arguments
=head2 plugin
$app->plugin(foo => 'MyApp::Plugin::Foo');
$app->plugin(foo);
$app->plugin(foo => 'MyApp::Plugin::Foo', {bar => 123, baz => 'test'});
$app->plugin(foo => 'MyApp::Plugin::Foo', bar => 123, baz => 'test');
$app->plugin(foo, undef, {bar => 123, baz => 'test'});
Load a plugin by name or pair - name and class
=head2 pwd
my $pwd = $app->pwd;
This method returns current/working directory
=head2 register_handler
lib/Acme/Crux.pm view on Meta::CPAN
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};
return tv_interval($started, [gettimeofday]);
}
sub exedir { shift->{exedir} }
sub orig { shift->{orig} }
sub option {
my $self = shift;
my $key = shift;
my $opts = $self->{options};
return undef unless $opts;
return $opts unless defined $key;
return $opts->{$key};
}
sub opt { goto &option }
sub getopt { goto &option }
# Register method. See Mojo::Util::monkey_patch
sub register_method {
my $self = shift;
my $code = pop || sub { 1 }; # last param
lib/Acme/Crux.pm view on Meta::CPAN
my $code = $info{code} || sub {return 1};
$info{code} = is_code_ref($code) ? $code : sub { $code };
# Set info to handler data
$handlers->{$name} = {%info};
return 1;
}
sub lookup_handler {
my $self = shift;
my $name = trim(shift // '');
return undef unless length $name;
my $invocant = ref($self) || scalar(caller(0));
my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
return undef unless defined($handlers) && is_hash_ref($handlers);
foreach my $n (keys %$handlers) {
my $aliases = as_array_ref($handlers->{$n}->{aliases});
return $handlers->{$n} if grep {defined && $_ eq $name} ($n, @$aliases);
}
return undef;
}
sub handlers {
my $self = shift;
my $all = shift // 0; # returns aliases too
my $invocant = ref($self) || scalar(caller(0));
my $handlers = $Acme::Crux::Sandbox::HANDLERS{"$invocant.$$"};
return [] unless defined($handlers) && is_hash_ref($handlers);
return [(sort {$a cmp $b} keys %$handlers)] unless $all;
# All: names and aliases
lib/Acme/Crux.pm view on Meta::CPAN
my $aliases = as_array_ref($handlers->{$n}->{aliases});
foreach my $_a ($n, @$aliases) {
$seen{$_a} = 1 if defined($_a) and length($_a);
}
}
return [(sort {$a cmp $b} keys %seen)];
}
sub has_handler {
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;
}
lib/Acme/Crux/Plugin/Config.pm view on Meta::CPAN
=encoding utf-8
=head1 NAME
Acme::Crux::Plugin::Config - The Acme::Crux plugin for configuration your application
=head1 SYNOPSIS
# In startup
my $config = $app->plugin('Config');
my $config = $app->plugin('Config', undef, {file => '/etc/myapp.conf'});
# In application
my $val = $app->config->get("/foo/bar/baz");
my $all = $app->config->conf;
my $array = $app->config->array('/foo'); # 'value'
# ['value']
my $hash = $app->config->hash('/foo'); # { foo => 'first', bar => 'second' }
# { foo => 'first', bar => 'second' }
lib/Acme/Crux/Plugin/Config.pm view on Meta::CPAN
=head1 DESCRIPTION
The Acme::Crux plugin for configuration your application
=head1 OPTIONS
This plugin supports the following options
=head2 default
$app->plugin(Config => undef, {default => {foo => 'bar'});
Sets the default configuration hash
Default: no defaults, empty config structure
=head2 dirs
$app->plugin(Config => undef, {dirs => ['/etc/foo', '/etc/bar']});
Paths to additional directories of config files
Default: no additional directories
=head2 file
$app->plugin(Config => undef, {file => '/etc/myapp.conf'});
Path to configuration file, absolute or relative to the application root directory,
defaults to the value of the C<$moniker.conf> in the application root directory.
Default: C<configfile> command line option or C<configfile> application argument
or C</etc/$moniker/$moniker.conf> otherwise
=head2 noload
$app->plugin(Config => undef, {noload => 1});
This option disables auto loading config file
Default: C<noload> command line option or C<config_noload> application argument
or C<0> otherwise
=head2 opts, options
$app->plugin(Config => undef, {opts => {'-AutoTrue' => 0}});
$app->plugin(Config => undef, {options => {'-AutoTrue' => 0}});
Sets the L<Config::General> options directly
Default: no special options
=head2 root
$app->plugin(Config => undef, {root => '/etc/myapp'});
Sets the root directory to configuration files and directories location
Default: C<configroot> command line option or C<root> application argument
or C</etc/$moniker> otherwise
=head1 METHODS
This class inherits all methods from L<Acme::Crux::Plugin> and implements the following new ones
lib/Acme/Crux/Plugin/Log.pm view on Meta::CPAN
=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...');
lib/Acme/Crux/Plugin/Log.pm view on Meta::CPAN
=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
lib/Acme/Crux/Plugin/Log.pm view on Meta::CPAN
|| $app->getopt("logprefix") # From command line options
|| $app->orig->{"logprefix"} # From App arguments
|| ($has_config ? $app->config->latest("/logprefix") : ''); # From config file
croak(qq{Invalid log prefix}) if defined($prefix) && is_ref($prefix);
# 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->latest("/logprovider") : '') || ''; # From config file
if ($provider eq 'syslog') { $file = 'syslog'; $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,
lib/Acrux/Config.pm view on Meta::CPAN
# Set config data
$self->{config} = {%config}; # hash data
$self->pointer->data(clone($self->{config}));
return $self;
}
sub config {
my $self = shift;
my $key = shift;
return undef unless $self->{config};
return $self->{config} unless defined $key and length $key;
return $self->{config}->{$key};
}
sub conf { goto &config }
sub get {
my $self = shift;
my $key = shift;
return $self->pointer->get($key);
}
sub first {
my $self = shift;
return undef unless defined($_[0]) && length($_[0]);
my $node = $self->pointer->get($_[0]);
if (is_array_ref($node)) { # Array ref
return exists($node->[0]) ? $node->[0] : undef;
} elsif (is_value($node)) { # Scalar value
return $node;
}
return undef;
}
sub latest {
my $self = shift;
return undef unless defined($_[0]) && length($_[0]);
my $node = $self->pointer->get($_[0]);
if (is_array_ref($node)) { # Array ref
return exists($node->[0]) ? $node->[-1] : undef;
} elsif (is_value($node)) { # Scalar value
return $node;
}
return undef;
}
sub array {
my $self = shift;
return undef unless defined($_[0]) && length($_[0]);
my $node = $self->pointer->get($_[0]);
if (is_array_ref($node)) { # Array ref
return $node;
} elsif (defined($node)) {
return [$node];
}
return [];
}
sub list { goto &array }
sub hash {
my $self = shift;
return undef unless defined($_[0]) && length($_[0]);
my $node = $self->pointer->get($_[0]);
return $node if is_hash_ref($node);
return {};
}
sub object { goto &hash }
1;
__END__
lib/Acrux/FileLock.pm view on Meta::CPAN
$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;
# PID normalize
my $raw_pid = $self->{pid} || 0;
$self->{pid} = abs(int($raw_pid)) if defined($raw_pid) && $raw_pid =~ /^-?\d+$/;
unless (defined($self->{pid}) && $self->{pid} =~ /^[0-9]{1,11}$/) { # Protect
croak("Incorrect \"pid\" attribute: $raw_pid");
}
# Check etries and delay
lib/Acrux/FileLock.pm view on Meta::CPAN
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;
lib/Acrux/FileLock.pm view on Meta::CPAN
}
# 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
}
lib/Acrux/FileLock.pm view on Meta::CPAN
# Ok
return 1;
}
sub _rollback {
my $self = shift;
$self->{_is_locked} = 0;
$self->own(0)->uid(0);
return $self unless $self->{fh};
flock $self->{fh}, LOCK_UN;
$self->{fh}->close;
$self->{fh} = undef;
return $self;
}
sub _is_locked {
my $self = shift;
return ($self->{_is_locked} && -f $self->file) ? 1 : 0
}
sub _use_flock {shift->{'flock'} ? 1 : 0}
sub _debug {
my $self = shift;
warn sprintf("%s: %s\n", ref($self), join("\n", @_)) if $self->{debug};
lib/Acrux/FilePid.pm view on Meta::CPAN
$fp->file("/var/run/file.pid");
my $pidfile = $fp->file;
Accessor/mutator for the filename used as the pid file.
=head2 load
$fp->load;
Load owner pid from file.
On success, the object is returned. On failure, C<undef> is
returned.
=head2 owner
$fp->owner(123);
my $owner = $fp->owner;
Accessor/mutator for the pid being saved to the pid file.
=head2 pid
lib/Acrux/FilePid.pm view on Meta::CPAN
Removes the pid file from disk. Returns true on success, false on
failure.
=head2 running
my $pid = $fp->running;
die "Service already running: $pid" if $pid;
Checks to see if the pricess identified in the pid file is still
running. If the process is still running, the pid is returned. Otherwise
C<undef> is returned.
=head2 save
$fp->save;
Writes the pid file to disk, inserting the pid inside the file.
On success, the object is returned. On failure, C<undef> is
returned.
=head1 HISTORY
See C<Changes> file
=head1 TO DO
See C<TODO> file
lib/Acrux/FilePid.pm view on Meta::CPAN
my $self = shift;
if (scalar(@_) >= 1) {
$self->{owner} = shift;
return $self;
}
return $self->{owner};
}
sub running {
my $self = shift;
my $owner = $self->load->owner || 0; # Get PID from file
my $r = kill(0, $owner) ? $owner : undef;
$self->{is_running} = $r ? 1 : 0;
return $r; # Is running?
}
sub remove {
my $self = shift;
my $file = $self->file;
return $self unless -e $file;
unlink $file;
$self->owner(0); # Reset owner PID to 0
return $self;
lib/Acrux/FilePid.pm view on Meta::CPAN
sub save {
my $self = shift;
my $file = $self->file;
my $pid = $self->pid || $$;
$self->owner($pid); # Set owner PID as current PID
# Save PID to file
my $fh = IO::File->new($file, "w");
croak qq/Can't open file "$file": $!/ unless defined $fh;
$fh->write("$pid\n") or croak qq/Can't write to file "$file": $!/;
undef $fh; # automatically closes the file
# Returns self
return $self;
}
sub load {
my $self = shift;
my $file = $self->file;
return $self unless -e $file;
# Read file
my $ret = my $content = '';
my $fh = IO::File->new($file, "r");
croak qq/Can't open file "$file": $!/ unless defined $fh;
while ($ret = $fh->read(my $buf, 255)) { $content .= $buf }
croak qq/Can't read from file "$file": $!/ unless defined $ret;
undef $fh; # automatically closes the file
# Set loaded PID as owner
chomp $content;
$self->owner(($content || 0) * 1) if $content =~ /^\d+$/;
# Returns object
return $self;
}
sub DESTROY {
my $self = shift;
lib/Acrux/Log.pm view on Meta::CPAN
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
lib/Acrux/Log.pm view on Meta::CPAN
$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
lib/Acrux/Log.pm view on Meta::CPAN
);
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
lib/Acrux/Log.pm view on Meta::CPAN
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__
lib/Acrux/Pointer.pm view on Meta::CPAN
my $data = $self->data;
return $get ? $data : 1 unless length($pointer);
foreach my $p (length($pointer) ? (split /\//, $pointer, -1) : ($pointer)) {
$p =~ s|~1|/|g;
$p =~ s|~0|~|g;
if ((ref($data) eq 'HASH') && exists $data->{$p}) { # Hash ref
$data = $data->{$p}
} elsif ((ref($data) eq 'ARRAY') && ($p =~ /^[0-9]+$/) && @$data > $p) { # Array ref
$data = $data->[$p]
} else { # Not found
return undef;
}
}
return $get ? $data : 1;
}
1;
__END__
lib/Acrux/RefUtil.pm view on Meta::CPAN
=over 4
=item as_array_ref
This method returns the argument as a array reference
my $arr = as_array_ref( "foo" ); # ['foo']
my $arr = as_array_ref( "foo", "bar" ); # ['foo', 'bar']
my $arr = as_array_ref( ["foo", "bar"] ); # ['foo', 'bar']
my $arr = as_array_ref(); # []
my $arr = as_array_ref(undef); # []
my $arr = as_array_ref([undef]); # [undef]
=item as_array, as_list
This method returns argument as array-reference (see L</"as_array_ref">) or regular array (list) in list context
my $arr = as_array( "foo", "bar" ); # ['foo', 'bar']
my @arr = as_array( "foo", "bar" ); # ('foo', 'bar')
=item as_first, as_first_val
lib/Acrux/RefUtil.pm view on Meta::CPAN
my $foo = as_first( qw/foo bar baz/ );
=item as_hash_ref
This method returns the argument as a hash reference
my $hash = as_hash_ref( {foo => 'one'} ); {foo => 'one'}
my $hash = as_hash_ref( foo => 'one', bar => 2 );
# {foo => 'one', bar => 2 }
my $hash = as_hash_ref(); # {}
my $hash = as_hash_ref(undef); # {}
=item as_hash
This method returns argument as hash-reference (see L</"as_hash_ref">) or regular hash in list context
my $hash = as_hash( "foo", "bar" ); # {'foo' => 'bar'}
my %hash = as_hash( "foo", "bar" ); # ('foo', 'bar')
=item as_last, as_last_val, as_latest
lib/Acrux/RefUtil.pm view on Meta::CPAN
equivalent to is_value($value) && length($value) > 0
=item is_number
Checks whether I<value> is a number
=item is_integer, is_int8, is_int16, is_int32, is_int64
Checks whether I<value> is an integer
=item is_undef
Checks for a undef value
=back
=head2 VOID
Void functions are introduced by the C<:void> import tag, which check
the argument type in void value and return a bool
=over 4
=item is_void
print "Void" if is_void({});
Returns true if the structure contains useful data.
Useful data - this data is different from the value undef
=item isnt_void
print "NOT Void" if isnt_void({foo=>undef});
Returns true if the structure does not contain any nested useful data.
Useful data - this data is different from the value undef
=back
=head2 FLAG
=over 4
=item is_false_flag
print "Disabled" if is_false_flag("off");
lib/Acrux/RefUtil.pm view on Meta::CPAN
=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 base qw/Exporter/;
our @EXPORT = (qw/
is_ref is_undef
is_scalar_ref is_array_ref is_hash_ref is_code_ref
is_glob_ref is_regexp_ref is_regex_ref is_rx
is_value is_string is_number is_integer
is_int8 is_int16 is_int32 is_int64
/);
# Required
our @EXPORT_OK = (qw/
is_void isnt_void
is_true_flag is_false_flag
lib/Acrux/RefUtil.pm view on Meta::CPAN
as => [qw/
as_array as_list as_array_ref as_hash as_hash_ref
as_first as_first_val as_last as_last_val as_latest
/],
);
use constant MAX_DEPTH => 32;
# Base functions
sub is_ref { ref($_[0]) ? 1 : 0 }
sub is_undef { !defined($_[0]) }
sub is_scalar_ref { ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF' }
sub is_array_ref { ref($_[0]) eq 'ARRAY' }
sub is_hash_ref { ref($_[0]) eq 'HASH' }
sub is_code_ref { ref($_[0]) eq 'CODE' }
sub is_glob_ref { ref($_[0]) eq 'GLOB' }
sub is_regexp_ref { ref($_[0]) eq 'Regexp' }
sub is_regex_ref { goto &is_regexp_ref }
sub is_rx { goto &is_regexp_ref }
sub is_value { defined($_[0]) && !ref($_[0]) && ref(\$_[0]) ne 'GLOB' }
sub is_string { defined($_[0]) && !ref($_[0]) && (ref(\$_[0]) ne 'GLOB') && length($_[0]) }
lib/Acrux/RefUtil.pm view on Meta::CPAN
}
sub is_false_flag {
my $f = shift || return 1;
return $f =~ /^(off|n|false|disable|0)/i ? 1 : 0;
}
# As
sub as_array_ref {
return [] unless scalar @_; # if no args
return [@_] if scalar(@_) > 1; # if too many args
return [] unless defined($_[0]); # if value is undef
if (ref($_[0]) eq 'ARRAY') { return $_[0] } # Array
elsif (ref($_[0]) eq 'HASH') { return [%{$_[0]}] } # Hash
return [$_[0]];
}
sub as_array {
my $r = as_array_ref(@_);
return wantarray ? @$r : $r;
}
sub as_list { goto &as_array }
sub as_hash_ref {
return {} unless scalar @_; # if no args passed
return {@_} unless scalar(@_) % 2; # if even (not odd) args passed
return {} unless defined($_[0]); # if arg is undef
if (ref($_[0]) eq 'HASH') { return $_[0] } # Hash
return {};
}
sub as_hash {
my $r = as_hash_ref(@_);
return wantarray ? %$r : $r;
}
sub as_first {
return undef unless defined $_[0];
my $r = as_array_ref(@_);
return undef unless exists($r->[0]) && defined($r->[0]);
my $v = $r->[0];
if (!ref($v)) { return $v } # No ref
elsif (ref($v) eq 'SCALAR' || ref($v) eq 'REF') { return $$v } # Scalar ref
return $v;
}
sub as_first_val { goto &as_first }
sub as_last {
return undef unless defined $_[0];
my $r = as_array_ref(@_);
return undef unless exists($r->[0]) && defined($r->[0]);
my $v = $r->[-1];
if (!ref($v)) { return $v } # No ref
elsif (ref($v) eq 'SCALAR' || ref($v) eq 'REF') { return $$v } # Scalar ref
return $v;
}
sub as_last_val { goto &as_last }
sub as_latest { goto &as_last }
1;
lib/Acrux/Util.pm view on Meta::CPAN
B<Please note!> All patterns C<'%%'> will be replaced to literal C<'%'> character if you not
redefinet this pattern in Your data set manually
Simple examples:
my %d = (
f => 'foo',
b => 'bar',
baz => 'test',
u => undef,
t => time,
d => 1,
i => 2000,
n => "\n",
);
print strf("test %f string", %d); # "test foo string"
print strf("%{baz} time=%t", %d); # "test time=1234567890"
print strf("test %f%b%i", %d); # "test foobar2000"
print strf("%d%% %{baz}", \%d); # "1% test"
lib/Acrux/Util.pm view on Meta::CPAN
Makes file exist, with current timestamp
See L<ExtUtils::Command>
=head2 trim
print '"'.trim( " string " ).'"'; # "string"
Returns the string with all leading and trailing whitespace removed.
Trim on undef returns undef. Original this function see String::Util
=head2 truncstr
print truncstr( $string, $cutoff_length, $continued_symbol );
If the $string is longer than the $cutoff_length, then the string will be truncated
to $cutoff_length characters, including the $continued_symbol
(which defaults to '.' if none is specified).
print truncstr( "qwertyuiop", 3, '.' ); # q.p
lib/Acrux/Util.pm view on Meta::CPAN
# Common
sub deprecated {
local $Carp::CarpLevel = 1;
$ENV{ACRUX_FATAL_DEPRECATIONS} ? croak @_ : carp @_;
}
sub dumper { Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Dump }
sub clone { dclone(shift) }
sub load_class {
my $class = shift // '';
return "Invalid class name: $class" unless $class =~ /^\w(?:[\w:]*\w)?$/;
return undef if $class->can('new') || eval "require $class; 1"; # Ok
return "Class $class not found" if $@ =~ /^Can't\s+locate/i; # Error
return $@; # Error
}
# Bytes and numbers
sub fbytes {
my $n = int(shift);
if ($n >= 1024 ** 3) {
return sprintf "%.3g GiB", $n / (1024 ** 3);
} elsif ($n >= 1024 ** 2) {
t/03-refutil.t view on Meta::CPAN
#
#########################################################################
use Test::More;
use Acrux::RefUtil qw/:all/;
#
# Checks
#
ok is_ref([]), 'is_ref([])';
ok is_undef(undef), 'is_undef(undef)';
ok is_scalar_ref(\"foo"), 'is_scalar_ref(\"foo")';
ok is_array_ref([]), 'is_array_ref([])';
ok is_hash_ref({}), 'is_hash_ref({})';
ok is_code_ref(sub { 1 }), 'is_code_ref(sub { 1 })';
ok is_glob_ref( \*STDOUT ), 'is_glob_ref( \*STDOUT )';
ok is_regexp_ref(qr/\d/), 'is_regexp_ref(qr/\d/)';
ok is_regex_ref(qr/\d/), 'is_regex_ref(qr/\d/)';
ok is_rx(qr/\d/), 'is_rx(qr/\d/)';
ok is_value("foo"), 'is_value("foo")';
ok is_string("foo"), 'is_string("foo")';
t/03-refutil.t view on Meta::CPAN
ok(is_true_flag("Y"), 'Y too');
ok(is_true_flag("YEP"), 'And YEP too');
ok(is_true_flag(1), 'And 1 too');
# False flags
ok(is_false_flag("Nope"), 'Nope is false');
ok(is_false_flag(0), 'And 0 too');
ok(is_false_flag("disabled"), 'And disabled too');
# Void
ok(is_void(undef),'undef - void value');
ok(is_void(\undef),'\\undef - void value');
ok(isnt_void(""),'null - void value');
ok(isnt_void("0"),'"0" - NOT void value');
ok(isnt_void(\"0"),'\\"0" - NOT void value');
ok(isnt_void(0),'0 - NOT void value');
ok(is_void([]),'[] - void value');
ok(isnt_void([0]),'[0] - NOT void value');
ok(is_void([undef]),'[undef] - void value');
ok(isnt_void([undef,0]),'[undef,0] - NOT void value');
ok(is_void([{}]),'[{}] - void value');
ok(isnt_void([{foo=>undef}]),'[{foo=>undef}] - NOT void value');
ok(isnt_void([[{foo=>undef}]]),'\\[{foo=>undef}] - NOT void value');
ok(is_void([[[[[]]]]]),'[[[[[]]]]] - void value');
ok(isnt_void([[[[[]],0]]]),'[[[[[]],0]]] - NOT void value');
ok(is_void([[[[[{}]]]]]),'[[[[[{}]]]]] - void value');
ok(isnt_void([[[[[{bar=>undef}]]]]]),'[[[[[{bar=>undef}]]]]] - NOT void value');
ok(isnt_void(qr/./),'qr/./ - NOT void value');
ok(isnt_void(sub {1}),'sub{1} - NOT void value');
#
# As
#
# First value
{
is(as_first([qw/foo bar baz/]), 'foo', 'First value if foo');
is(as_first(qw/foo bar baz/), 'foo', 'First value if foo of an list');
is(as_first("bar"), 'bar', 'First value if bar of an scalar');
is(as_first(undef), undef, 'First value if undef');
is(as_first(''), '', 'First value if void');
}
# Last value
{
is(as_last([qw/foo bar baz/]), 'baz', 'Last value if baz');
is(as_last(qw/foo bar baz/), 'baz', 'Last value if baz of an list');
is(as_last("bar"), 'bar', 'Last value if bar of an scalar');
}
# Array ref
{
is_deeply(as_array_ref( "foo" ), ['foo'], 'One scalar');
is_deeply(as_array_ref( qw/foo bar baz/ ), ['foo', 'bar', 'baz'], 'Three scalars');
is_deeply(as_array_ref(), [], 'No args');
is_deeply(as_array_ref(undef), [], 'Undef args');
is_deeply(as_array_ref( [undef] ), [undef], 'First arg is undef');
}
# Hash ref
{
is_deeply(as_hash_ref( {foo => 'one'} ), {foo => 'one'}, 'Simple hash');
is_deeply(as_hash_ref( foo => 'one', bar => 2 ), {foo => 'one', bar => 2 }, 'Hash');
is_deeply(as_hash_ref(undef), {}, 'Undef args (hash)');
is_deeply(as_hash_ref(), {}, 'No args (hash)');
}
done_testing;
1;
__END__
t/11-strf.t view on Meta::CPAN
use Test::More;
use Acrux::Util qw/strf/;
plan skip_all => "Currently a developer-only test" unless -d '.svn' || -d ".git";
my %d = (
f => 'foo',
b => 'bar',
baz => 'test',
u => undef,
t => time,
d => 1,
i => 2000,
n => "\n",
);
is( strf(">test %f string<", %d), ">test foo string<", "test foo string" );
ok( strf(">%{baz} time string = %t<", %d), "time string" )
and note strf(">%{baz} time string = %t<", %d);
is( strf(">test %f%b%i string<", %d), ">test foobar2000 string<", "test foobar2000 string" );
is( strf(">%d%% %{baz}<", \%d), ">1% test<", "1% test" );
is( strf(">%f%n%b<", \%d), ">foo\nbar<", "new line test" );
is( strf(">%f%u%b<", \%d), ">foobar<", "undef test" );
is( strf(">%f%X%b<", \%d), ">foo%Xbar<", "not exists test" );
#diag strf(">%f%X%b<", \%d);
# Strftime (short version)
# See: https://cplusplus.com/reference/ctime/strftime/
# https://www.programiz.com/python-programming/datetime/strftime
#
# a Abbreviated weekday name Sun, Mon, ...
# A Full weekday name Sunday, Monday, ...
( run in 2.068 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )