Acrux
view release on metacpan or search on metacpan
lib/Acrux/Util.pm view on Meta::CPAN
Returns offset of expires time (in secs).
Original this function is the part of CGI::Util::expire_calc!
This internal routine creates an expires time exactly some number of hours from the current time.
It incorporates modifications from Mark Fisher.
format for time can be in any of the forms:
now -- expire immediately
+180s -- in 180 seconds
+2m -- in 2 minutes
+12h -- in 12 hours
+1d -- in 1 day
+3M -- in 3 months
+2y -- in 2 years
-3m -- 3 minutes ago(!)
If you don't supply one of these forms, we assume you are specifying the date yourself
=head2 parse_time_offset
my $off = parse_time_offset("1h2m24s"); # 4344
my $off = parse_time_offset("1h 2m 24s"); # 4344
Returns offset of time (in secs)
=head2 parse_words
my $words = parse_words("foo,bar baz");
my $words = parse_words(@strings);
my $words = parse_words(\@strings);
Parses one or more strings into a list of words.
Input may be a single string, a list of strings or an array reference.
Words are separated by whitespace, commas and semicolons.
Double-quoted strings are preserved as a single word, allowing separators
and whitespace to be embedded in a value.
Empty tokens are discarded.
Always returns an array reference.
Examples:
parse_words("foo,bar baz"); # [qw(foo bar baz)]
parse_words(["foo; bar", "baz qux"]);
# [qw(foo bar baz qux)]
parse_words(q{foo "bar baz" qux});
# ['foo', 'bar baz', 'qux']
parse_words([
q{foo,bar},
q{"baz qux"},
]); # ['foo', 'bar', 'baz qux']
See also L</words> for simply parsing
=head2 prompt
my $value = prompt($message);
my $value = prompt($message, $default);
The C<prompt()> is an extremely simple function, based on the extremely simple prompt
offered by L<ExtUtils::MakeMaker>. In many cases this function just to prompt for input
This function displays the message as a prompt for input and returns the (chomped)
response from the user, or the default if the response was empty
If the program is not running interactively, the default will be used without prompting.
If no default is provided, an empty string will be used instead
See also: L<ExtUtils::MakeMaker/prompt>, L<IO::Prompt::Tiny>
=head2 randchars
$rand = randchars( $n ); # default chars collection: 0..9,'a'..'z','A'..'Z'
$rand = randchars( $n, \@collection ); # Defined chars collection
Returns random sequence of casual characters by the amount of n
For example:
$rand = randchars( 8, [qw/a b c d e f/]); # -> cdeccfdf
=head2 slurp
my $data = slurp($file, %args);
my $data = slurp($file, { %args });
slurp($file, { buffer => \my $data });
my $data = slurp($file, { binmode => ":raw:utf8" });
Reads file $filename into a scalar
my $data = slurp($file, { binmode => ":unix" });
Reads file in fast, unbuffered, raw mode
my $data = slurp($file, { binmode => ":unix:encoding(UTF-8)" });
Reads file with UTF-8 encoding
By default it returns this scalar. Can optionally take these named arguments:
=over 4
=item binmode
Set the layers to read the file with. The default will be something sensible on your platform
=item block_size
Set the buffered block size in bytes, default to 1048576 bytes (1 MiB)
=item buffer
Pass a reference to a scalar to read the file into, instead of returning it by value.
This has performance benefits
=back
See also L</spew> to writing data to file
=head2 spew
spew($file, $data, %args);
spew($file, $data, { %args });
spew($file, \$data, { %args });
spew($file, \@data, { %args });
spew($file, $data, { binmode => ":raw:utf8" });
Writes data to a file atomically. The only argument is C<binmode>, which is passed to
C<binmode()> on the handle used for writing.
lib/Acrux/Util.pm view on Meta::CPAN
All words in the resultating array are unique and arranged
in the order of the input string
See also L</parse_words> for extended parsing
=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-2026 D&D Corporation
=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 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 Text::ParseWords qw/quotewords/;
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 parse_words
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
lib/Acrux/Util.pm view on Meta::CPAN
my $mode = $args->{mode} // O_WRONLY | O_CREAT;
$mode |= O_APPEND if $args->{append};
$mode |= O_EXCL if $args->{locked};
# Open filehandle
my $fh;
if (ref($file)) {
$fh = $file;
$cleanup = 0; # Disable closing filehandle for passed filehandle
} else {
$fh = IO::File->new($file, $mode, $perms);
unless (defined $fh) {
carp qq/Can't open file "$file": $!/;
return;
}
}
# Set binmode layer
$fh->binmode($bm);
# Set buffer
my $buf;
my $buf_ref = \$buf;
if (ref($data) eq 'SCALAR') {
$buf_ref = $data;
} elsif (ref($data) eq 'ARRAY') {
${$buf_ref} = join '', @$data;
} else {
$buf_ref = \$data;
}
# Seek, print, truncate and close
$fh->seek(0, SEEK_END) if $args->{append}; # SEEK_END == 2
$fh->print(${$buf_ref}) or return;
$fh->truncate($fh->tell) if $cleanup;
$fh->close if $cleanup;
return 1;
}
sub spurt { goto &spew }
# Colored helper function
sub color {
my $clr = shift;
my $txt = (scalar(@_) == 1) ? shift(@_) : sprintf(shift(@_), @_);
return $txt unless defined($clr) && length($clr);
return IS_TTY ? colored([$clr], $txt) : $txt;
}
# Misc
sub os_type {
my $os = shift // $^O;
return $OSTYPES{$os} || '';
}
sub is_os_type {
my $type = shift || return;
return os_type(shift) eq $type;
}
# Copied from ExtUtils::MakeMaker and IO::Prompt::Tiny
sub prompt {
my $msg = shift // '';
my $def = shift // '';
my $dispdef = length($def) ? "[$def] " : " ";
# Flush vars
local $|=1;
local $\;
# Prompt message
print length($msg) ? "$msg $dispdef" : "$dispdef";
my $ans;
if (!IS_TTY && eof STDIN) {
print "$def\n";
} else {
$ans = <STDIN>;
if( defined $ans ) {
chomp $ans;
} else { # user hit ctrl-D
print "\n";
}
}
return (!defined $ans || $ans eq '') ? $def : $ans;
}
sub parse_words {
return [] unless @_;
my $in = @_
? @_ > 1
? [@_]
: ref $_[0] eq 'ARRAY'
? $_[0]
: [$_[0]]
: [];
my @w = ();
foreach my $it (@$in) {
push @w, grep { defined && length } quotewords(qr/\s+|[\,\;]+/, 0, $it);
}
return [@w];
}
1;
__END__
( run in 1.771 second using v1.01-cache-2.11-cpan-6aa56a78535 )