Acrux
view release on metacpan or search on metacpan
lib/Acrux/Util.pm view on Meta::CPAN
=head2 human2bytes
my $bytes = human2bytes("100 kB");
Converts a human readable byte count into the pure number of bytes without any suffix
See also L<Mojo::Util/humanize_bytes>
=head2 indent
my $indented = indent($str, 4, ' ');
my $indented = indent($str, 1, "\t");
Indent multi-line string
# " foo\n bar\n baz\n"
print indent("foo\nbar\nbaz\n", 2);
You can use number of indent-chars and indent-symbol manuality:
# "> foo\n> bar\n> baz\n"
my $data = indent("foo\nbar\nbaz\n", 1, '> ');
See also L<Mojo::Util/unindent> to unindent multi-line strings
=head2 is_os_type
$is_windows = is_os_type('Windows');
$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.
With no arguments, returns the OS type for the current value of $^O.
If the operating system is not recognized, the function will return the empty string.
Original this function see in L<Perl::OSType/os_type>
=head2 parse_expire
print parse_expire("+1d"); # 86400
print parse_expire("-1d"); # -86400
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 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.
lib/Acrux/Util.pm view on Meta::CPAN
=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.
Can optionally take these named arguments:
=over 4
=item append
This argument is a boolean option, defaulted to false (C<0>).
Setting this argument to true (C<1>) will cause the data to be be written at the end of the current file.
Internally this sets the sysopen mode flag C<O_APPEND>
=item binmode
Set the layers to write the file with. The default will be something sensible on your platform
=item locked
This argument is a boolean option, defaulted to false (C<0>).
Setting this argument to true (C<1>) will ensure an that existing file will not be overwritten
=item mode
This numeric argument sets the default mode of opening files to write.
By default this argument to C<(O_WRONLY | O_CREAT)>.
Please DO NOT set this argument unless really necessary!
=item perms
This argument sets the permissions of newly-created files.
This value is modified by your process's umask and defaults to 0666 (same as sysopen)
=back
See also L</slurp> to reading data from file
=head2 spurt
See L</spew>
=head2 strf
print strf( $format, %data );
print strf( $format, \%data );
The C<strf> function returns a string representing hash-data as string in specified C<$format>.
This function is somewhat similar to the C function strftime(), except that the data source
is not the date and time, but the set of data passed to the function.
The format string may be containing any combination of regular characters and special format
specifiers (patterns). These patterns are replaced to the corresponding values to represent
the data passed as second function argument. They all begin with a percentage (%) sign,
and are: '%c' or '%{word}'. The "c" is single character specifier like %d, the "word" is
regular word like "month" or "filename"
If you give a pattern that doesn't exist, then it is simply treated as text.
If you give a pattern that doesn't defined but is exist in data set, then it will be
replaced to empty text string ('')
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"
print strf("%f%n%b", \%d); # "foo\nbar"
print strf("%f%u%b", \%d); # "foobar"
print strf("%f%X%b", \%d); # "foo%Xbar"
=head2 touch
touch( "file" ) or die "Can't touch file";
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
print truncstr( "qwertyuiop", 7, '.' ); # qw...op
print truncstr( "qwertyuiop", 7, '*' ); # qw***op
Returns a line the fixed length from 3 to the n chars
lib/Acrux/Util.pm view on Meta::CPAN
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);
} elsif ($secs < 2*60) {
return sprintf("%.4f seconds", $msecs);
} else {
$secs += $mins * 60;
return sprintf("%d seconds", $secs);
}
}
sub humanize_number {
my $var = shift || 0;
my $sep = shift || "`";
1 while $var=~s/(\d)(\d\d\d)(?!\d)/$1$sep$2/;
return $var;
}
# Date and Time utils
sub fdate {
my $t = shift || time;
return strftime(DATE_FORMAT, localtime($t));
}
sub fdatetime {
my $t = shift || time;
return strftime(DATETIME_FORMAT, localtime($t));
}
sub parse_expire {
my $t = trim(shift(@_) // 0);
my %mult = (
's' => 1,
'm' => 60,
'h' => 60*60,
'd' => 60*60*24,
'w' => 60*60*24*7,
'M' => 60*60*24*30,
'y' => 60*60*24*365
);
if (!$t || (lc($t) eq 'now')) {
return 0;
} elsif ($t =~ /^\d+$/) {
return $t; # secs
} elsif ($t=~/^([+-]?(?:\d+|\d*\.\d*))([smhdwMy])/) {
return ($mult{$2} || 1) * $1;
}
return $t;
}
sub parse_time_offset {
my $s = trim(shift(@_) // 0);
return $s if $s =~ /^\d+$/;
my $r = 0;
my $c = 0;
while ($s =~ s/([+-]?(?:\d+|\d*\.\d*)[smhdMy])//) {
my $i = parse_expire("$1");
$c++ if $i < 0;
$r += $i < 0 ? $i*-1 : $i;
}
return $c ? $r*-1 : $r;
}
sub fdt {
my $f = shift || ''; # Format
my $t = shift || time(); # Time
my $g = shift || 0; # 0 - Local time; 1 - GMT time
my (@dt, %dth, %dth2);
@dt = $g ? gmtime($t) : localtime($t);
$dth{'%s'} = $dt[0] || 0;
$dth{'%ss'} = sprintf('%02d',$dth{'%s'});
$dth{'%_s'} = sprintf('%2d',$dth{'%s'});
$dth{'%m'} = $dt[1] || 0;
$dth{'%mm'} = sprintf('%02d',$dth{'%m'});
$dth{'%_m'} = sprintf('%2d',$dth{'%m'});
$dth{'%h'} = $dt[2] || 0;
$dth{'%hh'} = sprintf('%02d',$dth{'%h'});
$dth{'%_h'} = sprintf('%2d',$dth{'%h'});
$dth{'%D'} = $dt[3] || 0;
$dth{'%DD'} = sprintf('%02d',$dth{'%D'});
$dth{'%_D'} = sprintf('%2d',$dth{'%D'});
$dth{'%M'} = $dt[4] || 0; $dth{'%M'}++;
$dth{'%MM'} = sprintf('%02d',$dth{'%M'});
$dth{'%_M'} = sprintf('%2d',$dth{'%M'});
$dth{'%Y'} = $dt[5] || 0; $dth{'%Y'}+=1900;
$dth{'%YY'} = sprintf('%02d',$dth{'%Y'}%100);
$dth{'%YYY'} = sprintf('%03d',$dth{'%Y'}%1000);
$dth{'%YYYY'} = sprintf('%04d',$dth{'%Y'});
$dth{'%_Y'} = sprintf('%2d',$dth{'%Y'}%100);
$dth{'%_YY'} = sprintf('%3d',$dth{'%Y'}%1000);
$dth{'%w'} = DTF->{DOWS}->[$dt[6] || 0];
$dth{'%W'} = DTF->{DOW}->[$dt[6] || 0];
$dth{'%MON'} = DTF->{MOYS}->[$dt[4] || 0];
$dth{'%mon'} = DTF->{MOYS}->[$dt[4] || 0];
$dth{'%MONTH'} = DTF->{MOY}->[$dt[4] || 0];
$dth{'%month'} = DTF->{MOY}->[$dt[4] || 0];
# Second block
$dth2{'%G'} = 'GMT' if $g;
$dth2{'%U'} = 'UTC' if $g;
$dth2{'%z'} = tz_diff($t, ':');
$dth2{'%Z'} = $dth2{'%z'}; $dth2{'%Z'} =~ s/\://;
$dth2{'%%'} = '%';
( run in 2.396 seconds using v1.01-cache-2.11-cpan-0d23b851a93 )