Acrux
view release on metacpan or search on metacpan
lib/Acrux/Util.pm view on Meta::CPAN
say color("red on_bright_yellow" => "text");
say STDERR color("red on_bright_yellow" => "text");
Returns colored formatted string if is session was runned from terminal
Supported normal foreground colors:
black, red, green, yellow, blue, magenta, cyan, white
Bright foreground colors:
bright_black, bright_red, bright_green, bright_yellow
bright_blue, bright_magenta, bright_cyan, bright_white
Normal background colors:
on_black, on_red, on_green, on yellow
on_blue, on_magenta, on_cyan, on_white
Bright background color:
on_bright_black, on_bright_red, on_bright_green, on_bright_yellow
on_bright_blue, on_bright_magenta, on_bright_cyan, on_bright_white
See also L<Term::ANSIColor>
=head2 deprecated
deprecated('foo is DEPRECATED in favor of bar');
Warn about deprecated feature from perspective of caller.
You can also set the C<ACRUX_FATAL_DEPRECATIONS> environment
variable to make them die instead with L<Carp>
=head2 dformat
$string = dformat( $mask, \%replacehash );
$string = dformat( $mask, %replacehash );
Replace substrings "[...]" in mask and
returns replaced result. Data for replacing get from \%replacehash
For example:
# -> 01-foo-bar.baz.tgz
$string = dformat( "01-[NAME]-bar.[EXT].tgz", {
NAME => 'foo',
EXT => 'baz',
});
See also L<CTK::Util/dformat>
=head2 dtf
See L</fdt>
=head2 dumper
my $perl = dumper({some => 'data'});
Dump a Perl data structure with L<Data::Dumper>
=head2 eqtime
eqtime("from/file", "to/file") or die "Oops";
Sets modified time of destination to that of source
=head2 fbytes
print fbytes( 123456 );
Returns formatted size value
=head2 fdate
print fdate( time );
Returns formatted date value
=head2 fdatetime
print fdatetime( time );
Returns formatted date value
=head2 fdt
print fdt( $format, $time );
print fdt( $format, $time, 1 ); # in GMT context
Returns time in your format.
Each conversion specification is replaced by appropriate characters as described in the following list
s, ss, _s - Seconds
m, mm, _m - Minutes
h, hh, _h - Hours
D, DD, _D - Day of month
M, MM, _M - Month
Y, YY, YYY, YYYY - Year
w - Short form of week day (Sat, Tue and etc)
W - Week day (Saturdat, Tuesday and etc)
MON, mon - Short form of month (Apr, May and etc)
MONTH, month - Month (April, May and etc)
Z - Diff of TimeZone in short format (+0300)
z - Diff of TimeZone in lomg format (+03:00)
G - Short name of TimeZone GMT (for GMT context only)
U - Short name of TimeZone UTC (for GMT context only)
Examples:
# RFC822 (RSS)
say fdt("%w, %D %MON %YY %hh:%mm:%ss %G", time(), 1); # Tue, 3 Sep 2013 12:31:40 GMT
# RFC850
say fdt("%W, %DD-%MON-%YY %hh:%mm:%ss %G", time(), 1); # Tuesday, 03-Sep-13 12:38:41 GMT
# RFC1036
say fdt("%w, %D %MON %YY %hh:%mm:%ss %G", time(), 1); # Tue, 3 Sep 13 12:44:08 GMT
# RFC1123
lib/Acrux/Util.pm view on Meta::CPAN
See also L<CTK::Util/variant_stf>
=head2 tz_diff
print tz_diff( time ); # +0300
print tz_diff( time, ':' ); # +03:00
Returns TimeZone difference value
print fdt("%w, %DD %MON %YYYY %hh:%mm:%ss ".tz_diff(time), time);
Prints RFC-2822 format date
=head2 words
my $arr = words( ' foo bar, baz bar ' ); # ['foo', 'bar', 'baz']
my $arr = words( ' foo bar ', ' baz' ); # ['foo', 'bar', 'baz']
my $arr = words( [' foo bar ', ' baz'] ); # ['foo', 'bar', 'baz']
my $arr = words( ['foo, bar'], ['baz bar '] ); # ['foo', 'bar', 'baz']
This function parse string by words and returns as an anonymous array.
All words in the resultating array are unique and arranged
in the order of the input string
=head1 HISTORY
See C<Changes> file
=head1 TO DO
See C<TODO> file
=head1 SEE ALSO
L<Mojo::Util>
=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
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See C<LICENSE> file and L<https://dev.perl.org/licenses/>
=cut
use Carp qw/ carp croak /;
use IO::File qw//;
use Term::ANSIColor qw/ colored /;
use POSIX qw/ :fcntl_h ceil floor strftime /;
use Fcntl qw/ O_WRONLY O_CREAT O_APPEND O_EXCL SEEK_END /;
use Time::Local;
use Data::Dumper qw//;
use Storable qw/dclone/;
use Acrux::Const qw/ IS_TTY DATE_FORMAT DATETIME_FORMAT /;
use base qw/Exporter/;
our @EXPORT = (qw/
deprecated
dumper
clone
/);
our @EXPORT_OK = (qw/
fbytes human2bytes humanize_duration humanize_number
fdt dtf tz_diff fdate fdatetime fduration
randchars
dformat strf trim truncstr indent words
touch eqtime slurp spew spurt
parse_expire parse_time_offset
os_type is_os_type
color load_class
prompt
/, @EXPORT);
use constant HUMAN_SUFFIXES => {
'B' => 0,
'K' => 10, 'KB' => 10, 'KIB' => 10,
'M' => 20, 'MB' => 20, 'MIB' => 20,
'G' => 30, 'GB' => 30, 'GIB' => 30,
'T' => 40, 'TB' => 40, 'TIB' => 40,
'P' => 50, 'PB' => 50, 'PIB' => 50,
'E' => 60, 'EB' => 60, 'EIB' => 60,
'Z' => 70, 'ZB' => 70, 'ZIB' => 70,
'Y' => 80, 'YB' => 80, 'YIB' => 80,
};
use constant DTF => {
DOW => [qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/],
DOWS => [qw/Sun Mon Tue Wed Thu Fri Sat/], # Short
MOY => [qw/January February March April May June July August September October November December/],
MOYS => [qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/], # Short
};
# See Perl::OSType and Devel::CheckOS
my %OSTYPES = qw(
aix Unix
bsdos Unix
beos Unix
bitrig Unix
dgux Unix
dragonfly Unix
dynixptx Unix
freebsd Unix
linux Unix
haiku Unix
hpux Unix
iphoneos Unix
irix Unix
darwin Unix
machten Unix
midnightbsd Unix
minix Unix
mirbsd Unix
next Unix
openbsd Unix
netbsd Unix
dec_osf Unix
nto Unix
svr4 Unix
svr5 Unix
sco Unix
sco_sv Unix
unicos Unix
unicosmk Unix
solaris Unix
sunos Unix
cygwin Unix
msys Unix
os2 Unix
interix Unix
gnu Unix
gnukfreebsd Unix
nto Unix
qnx Unix
android Unix
dos Windows
MSWin32 Windows
os390 EBCDIC
os400 EBCDIC
posix-bc EBCDIC
vmesa EBCDIC
MacOS MacOS
VMS VMS
vos VOS
riscos RiscOS
amigaos Amiga
mpeix MPEiX
);
# 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) {
return sprintf "%.3g MiB", $n / (1024.0 * 1024);
} elsif ($n >= 1024) {
return sprintf "%.3g KiB", $n / 1024.0;
} else {
return "$n B"; # bytes
}
}
sub human2bytes {
my $h = shift || 0;
return 0 unless $h;
my ($bts, $sfx) = $h =~ /([0-9.]+)\s*([a-zA-Z]*)/;
return 0 unless $bts;
my $exp = HUMAN_SUFFIXES->{($sfx ? uc($sfx) : "B")} || 0;
return ceil($bts * (2 ** $exp));
}
sub humanize_duration {
my $msecs = shift || 0;
my $secs = int($msecs);
my $years = int($secs / (60*60*24*365));
$secs -= $years * 60*60*24*365;
my $days = int($secs / (60*60*24));
$secs -= $days * 60*60*24;
my $hours = int($secs / (60*60));
$secs -= $hours * 60*60;
my $mins = int($secs / 60);
$secs %= 60;
if ($years) { return sprintf("%d years %d days %s hours", $years, $days, $hours) }
elsif ($days) { return sprintf("%d days %s hours %d minutes", $days, $hours, $mins) }
elsif ($hours) { return sprintf("%d hours %d minutes %d seconds", $hours, $mins, $secs) }
elsif ($mins >= 2) { return sprintf("%d minutes %d seconds", $mins, $secs) }
elsif ($secs > 5) { return sprintf("%d seconds", $secs + $mins * 60) }
elsif ($msecs - $secs) { return sprintf("%.4f seconds", $msecs) }
return sprintf("%d seconds", $secs);
}
sub fduration {
my $msecs = shift || 0;
my $secs = int($msecs);
my $hours = int($secs / (60*60));
$secs -= $hours * 60*60;
my $mins = int($secs / 60);
$secs %= 60;
if ($hours) {
return sprintf("%d hours %d minutes", $hours, $mins);
} elsif ($mins >= 2) {
return sprintf("%d minutes", $mins);
( run in 0.240 second using v1.01-cache-2.11-cpan-ec4f86ec37b )