view release on metacpan or  search on metacpan

lib/Acrux/Util.pm  view on Meta::CPAN

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

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

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

lib/Acrux/Util.pm  view on Meta::CPAN

    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);
    } elsif ($secs < 2*60) {
        return sprintf("%.4f seconds", $msecs);
    } else {
        $secs += $mins * 60;
        return sprintf("%d seconds", $secs);