view release on metacpan or  search on metacpan

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

}
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;

use Carp; # carp - warn; croak - die;
use CTK::TFVals qw/ is_void /;
use CTK::ConfGenUtil qw/ array is_array is_hash /;

our $VERSION = '1.00';

use constant {
        DAYS_OF_WEEK    => [qw/sunday monday tuesday wednesday thursday friday saturday/],
        DAYS_OF_WEEK_S  => [qw/sun mon tue wed thu fri sat/],
        DAYS_ALIASES    => {
                "sunday"    => "sun",
                "monday"    => "mon",
                "tuesday"   => "tue",
                "wednesday" => "wed",
                "thursday"  => "thu",