view release on metacpan or  search on metacpan

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

        }
    } elsif (ref($sects) eq 'HASH') { # Hash {...}
        $sects->{name} = sprintf("virtual%d", ++$i);
        push @j, $sects if (!@names || grep {$sects->{name} eq lc($_)} @names);
    }
    return grep {$_->{enable}} @j;
}
sub node2anode {
    my $n = shift;
    return [] unless $n && ref($n) =~ /ARRAY|HASH/;
    return [$n] if ref($n) eq 'HASH';
    return $n;
}
sub set2attr {
    my $in = shift;
    my $attr = is_array($in) ? $in : array($in => "set");
    my %attrs;
    foreach (@$attr) {
        $attrs{$1} = $2 if $_ =~ /^\s*(\S+)\s+(.+)$/;
    }
    return {%attrs};
}
sub setBit {
    my $v = fv2zero(shift);
    my $n = fv2zero(shift);
    return $v | (2**$n);
}
sub getBit {
    my $v = fv2zero(shift);
    my $n = fv2zero(shift);
    return ($v & (1 << $n)) ? BIT_SET : BIT_UNSET;
}
sub merge {
    my ($left, @right) = @_;
    return clone($left) unless @right; # Nothing to do
    return merge($left, merge(@right)) if @right > 1; # More than 2
    my ($r) = @right; # Get worked right
    my $l = clone($left);
    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;