view release on metacpan or  search on metacpan

lib/App/MonM/Util.pm  view on Meta::CPAN

    +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

=item B<getTimeOffset>

    my $off = getTimeOffset("1h2m24s"); # 4344
    my $off = getTimeOffset("1h 2m 24s"); # 4344

Returns offset of time (in secs)

=item B<getBit>

    print getBit(123, 3) ? "SET" : "UNSET"; # UNSET

Getting specified Bit

=item B<header_field_normalize>

    print header_field_normalize("content-type"); # Content-Type

Returns normalized header field

=item B<merge>

    my $a = {a => 1, c => 3, d => { i => 2 }, r => {}};
    my $b = {b => 2, a => 100, d => { l => 4 }};
    my $c = merge($a, $b);
    # $c is {a => 100, b => 2, c => 3, d => { i => 2, l => 4 }, r => {}}

Recursively merge two or more hashes, simply

This code was taken from L<Hash::Merge::Simple> (Thanks, Robert Krimen)

=item B<node2anode>

    my $anode = node2anode({});

Returns array of nodes

=item B<parsewords>

    my @b = parsewords("foo,bar baz"); # qw/foo bar baz/

Parses string and split it by words. See L<Text::ParseWords/quotewords>

=item B<run_cmd>

    my $hash = run_cmd($command, $timeout, $stdin);

Wrapped L<IPC::Cmd/run_forked> function

This function returns hash:

    {
        'cmd'     => 'perl -w',
        'code'    => 0, # Exit code (errorlevel)
        'message' => 'OK', # OK/ERROR
        'pgid'    => 176294, # Pid of child process
        'status'  => 1, # 1/0
        'stderr'  => '', # STDERR
        'stdout'  => '', # STDOUT
    }

=item B<set2attr>

    my $hash = set2attr({set => ["AttrName Value"]}); # {"AttrName" => "Value"}

Converts attributes from the "set" format to regular hash

=item B<setBit>

    printf("%08b", setBit(123, 3)); # 01111111

Setting specified Bit. Returns new value.

=item B<slurp>

    my $content = slurp($file);

Read all data at once from the file (utf8)

    my $content = slurp($file, 1);

Read all data at once from the file (binary)

=item B<spurt>, B<spew>

    my $error = spurt($file, qw/foo bar baz/);

Write all data at once to the file

=back

=head1 HISTORY

See C<Changes> file

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2022 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 vars qw/ $VERSION @EXPORT @EXPORT_OK /;
$VERSION = '1.02';

use Data::Dumper; #$Data::Dumper::Deparse = 1;

lib/App/MonM/Util.pm  view on Meta::CPAN

    my %m = %$l;
    for my $key (keys %$r) {
        my ($hr, $hl) = map { ref $_->{$key} eq 'HASH' } $r, $l;
        if ($hr and $hl){
            $m{$key} = merge($l->{$key}, $r->{$key});
        } else {
            $m{$key} = $r->{$key};
        }
    }
    return {%m};
}
sub header_field_normalize {
    my $s = shift // "";
    $s =~ s/\b(\w)/\u$1/g;
    return $s;
}
sub slurp {
    my $file = shift;
    my $isbin = shift || 0;
    return "" unless $file;
    my $fh = IO::File->new($file, "r");
    return unless defined $fh; # "Can't load file $file: $!"
    $isbin ? $fh->binmode : $fh->binmode(':raw:utf8');

    my $ret;
    my $content = "";
    my $buf;
    while ($ret = read($fh, $buf, 131072)) {
        $content .= $buf;
    }
    undef $fh;
    return unless defined $ret;
    return $content;
}
sub spurt {
    my $file = shift;
    my @arr = @_;
    my $fh = IO::File->new($file, "w");
    return "Can't write file $file: $!" unless defined $fh;
    $fh->binmode(':raw:utf8');
    $fh->print(join("\n", @arr));
    undef $fh;
    return "";
}
sub spew {goto &spurt}
sub run_cmd {
    my $cmd = shift;
    my $timeout = shift || 0;
    my $exe_in = shift;

    my %args = ();
    $args{timeout} = $timeout if $timeout;
    $args{child_stdin} = $exe_in if $exe_in;

    my $r = {};
    $r = run_forked( $cmd, \%args) if $cmd;


    my %ret = (
        cmd     => $r->{cmd} // $cmd,
        pgid    => $r->{child_pgid} || 0,
        code    => $r->{exit_code} || 0,
        stderr  => $r->{stderr} // '',
        stdout  => $r->{stdout} // '',
        status  => $r->{exit_code} ? 0 : 1,
        message => $r->{exit_code} ? 'ERROR' : 'OK',
    );
    chomp($ret{stderr});
    chomp($ret{stdout});

    # Time outed
    if ($r->{killed_by_signal}) {
        $ret{status} = 0;
        $ret{message} = 'ERROR';
        $ret{code} = -1;
        $ret{stderr} = sprintf("Timeouted: killed by signal [%s]", $r->{killed_by_signal});
    }

    # Exitval
    if ($ret{code} && !length($ret{stderr})) {
        $ret{stderr} = sprintf("Exitval=%d", $ret{code});
    }

    return {%ret};
}

####################
# Colored functions
####################
sub yep {
    print(green(sprintf(shift, @_)), "\n");
    return 1;
}
sub nope {
    print(red(sprintf(shift, @_)), "\n");
    return 0;
}
sub skip {
    print(gray(sprintf(shift, @_)), "\n");
    return 1;
}
sub wow {
    print(yellow(sprintf(shift, @_)), "\n");
    return 1;
}

# Colored helper functions
sub green {  IS_TTY ? colored(['bright_green'],  sprintf(shift, @_)) : sprintf(shift, @_) }
sub red {    IS_TTY ? colored(['bright_red'],    sprintf(shift, @_)) : sprintf(shift, @_) }
sub yellow { IS_TTY ? colored(['bright_yellow'], sprintf(shift, @_)) : sprintf(shift, @_) }
sub cyan {   IS_TTY ? colored(['bright_cyan'],   sprintf(shift, @_)) : sprintf(shift, @_) }
sub blue {   IS_TTY ? colored(['bright_blue'],   sprintf(shift, @_)) : sprintf(shift, @_) }
sub magenta {IS_TTY ? colored(['bright_magenta'],sprintf(shift, @_)) : sprintf(shift, @_) }
sub gray {   IS_TTY ? colored(['white'],         sprintf(shift, @_)) : sprintf(shift, @_) }

1;

package # hide me from PAUSE
    App::MonM::Util::Scheduler;
use strict;