view release on metacpan or  search on metacpan

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

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.

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>

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

    $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{'%%'}    = '%';

    $f =~ s/$_/$dth{$_}/sge for sort { length($b) <=> length($a) } keys %dth;
    $f =~ s/$_/$dth2{$_}/sge for qw/%G %U %Z %z %%/;

    return $f
}
sub dtf { goto &fdt }
sub tz_diff {
    my $tm = shift || time;
    my $chr = shift // '';
    my $diff = Time::Local::timegm(localtime($tm)) - Time::Local::timegm(gmtime($tm));
       $diff  = abs($diff);
    my $direc = $diff < 0 ? '-' : '+';
    my $tz_hr = int( $diff / 3600 );
    my $tz_mi = int( $diff / 60 - $tz_hr * 60 );
    return sprintf("%s%02d%s%02d", $direc, $tz_hr, $chr, $tz_mi);
}

# Text utils
sub trim {
    my $val = shift;
    return unless defined $val;
    $val =~ s|^\s+||s; # trim left
    $val =~ s|\s+$||s; # trim right
    return $val;
}
sub dformat { # Simple templating processor
    my $f = shift;
    my $d = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    $f =~ s/\[([A-Z0-9_\-.]+?)\]/(defined($d->{$1}) ? $d->{$1} : "[$1]")/eg;
    return $f;
}
sub strf { # Yet another simple templating processor
    my $s = shift // '';
    my $h = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
    return '' unless length $s;
    $h->{'%'} //= '%'; # by default '%' eq '%''

    $s =~ s/
            (?:
              %\{(\w+)\}       # short name like %{name}
              |
              %([%a-zA-Z])     # single character specifier like %d
            )
           /
            ( $1
              ? ( defined($h->{$1}) ? $h->{$1} : exists($h->{$1}) ? '' : "\%{$1}" )
              : $2
              ? ( defined($h->{$2}) ? $h->{$2} : exists($h->{$2}) ? '' : "\%$2" )
              : ''
            )
        /sgex;

    return $s;
}
sub randchars {
    my $l = shift || return '';
    return '' unless $l =~/^\d+$/;
    my $arr = shift;
    my $r = '';
    my @chars = ($arr && ref($arr) eq 'ARRAY') ? (@$arr) : (0..9,'a'..'z','A'..'Z');
    $r .= $chars[(int(rand($#chars+1)))] for (1..$l);
    return $r;
}
sub truncstr {
    my $string = shift // '';
    my $cutoff = shift || 0;
    my $marker = shift // '.';

    # Get dots dumber
    my $dots = 0;
    $cutoff = 3 if $cutoff < 3;
    if ($cutoff < 6) { $dots = $cutoff - 2 }
    else { $dots = 3 }

    # Real length of cutted string
    my $reallenght = $cutoff - $dots;

    # Input string is too short
    return $string if length($string) <= $cutoff;

    # Truncate
    my $fix = floor($reallenght / 2);
    my $new_start = substr($string, 0, ($reallenght - $fix)); # Start part of string
       $new_start =~ s/\s+$//; # trim
    my $new_midle = $marker x $dots; # Middle part of string
    my $new_end   = substr($string, (length($string) - $fix), $fix); # Last part of string
       $new_end   =~ s/^\s+//; # trim
    return sprintf ("%s%s%s", $new_start, $new_midle, $new_end);
}
sub indent {
    my $str = shift // '';
    my $ind = floor(shift || 0);