view release on metacpan or  search on metacpan

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

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;
use Term::ANSIColor qw/ colored /;
use Text::ParseWords qw/quotewords/;
use Clone qw/clone/;
use IO::File;
use IPC::Cmd qw/run_forked/;

use CTK::ConfGenUtil;
use CTK::TFVals qw/ :ALL /;
use CTK::Util qw/ trim /;
use App::MonM::Const qw/IS_TTY/;

use constant {
        BIT_SET     => 1,
        BIT_UNSET   => 0,
    };

use base qw/Exporter/;
@EXPORT = qw/
        blue green red yellow cyan magenta gray
        yep nope skip wow
    /;
@EXPORT_OK = qw/
        explain
        parsewords
        getCheckitByName getExpireOffset getTimeOffset
        node2anode set2attr
        getBit setBit
        merge
        header_field_normalize
        slurp spurt spew
        run_cmd
    /;

sub explain {
    my $dumper = Data::Dumper->new( [shift] );
    $dumper->Indent(1)->Terse(1);
    $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
    return $dumper->Dump;
}
sub parsewords {
    my $s = shift;
    my @words = grep { defined && length } quotewords(qr/\s+|[\,\;]+/, 0, $s);
    return @words;
}
sub getExpireOffset {
    my $time = trim(shift // 0);
    my %mult = (
            's' => 1,
            'm' => 60,
            'h' => 60*60,
            'd' => 60*60*24,
            'M' => 60*60*24*30,
            'y' => 60*60*24*365
        );
    if (!$time || (lc($time) eq 'now')) {
        return 0;
    } elsif ($time =~ /^\d+$/) {
        return $time; # secs
    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([smhdMy])/) {
        return ($mult{$2} || 1) * $1;
    }
    return $time;
}
sub getTimeOffset {
    my $s = trim(shift // 0);
    return $s if $s =~ /^\d+$/;
    my $r = 0;
    my $c = 0;
    while ($s =~ s/([+-]?(?:\d+|\d*\.\d*)[smhdMy])//) {
        my $i = getExpireOffset("$1");
        $c++ if $i < 0;
        #print ">> $1 ($i)\n";
        $r += $i < 0 ? $i*-1 : $i;
    }
    return $c ? $r*-1 : $r;
}

sub getCheckitByName {
    my $sects = shift; # $app->config("checkit");
    my @names = @_; # names

    my $i = 0;
    my @j = ();
    if (ref($sects) eq 'ARRAY') { # Array
        foreach my $r (@$sects) {
            if ((ref($r) eq 'HASH') && exists $r->{enable}) { # Anonymous
                $r->{name} = sprintf("virtual%d", ++$i);
                next unless (!@names || grep {$r->{name} eq lc($_)} @names);
                push @j, $r;
            } elsif (ref($r) eq 'HASH') { # Named
                foreach my $k (keys %$r) {
                    my $v = $r->{$k};
                    next unless ref($v) eq 'HASH';
                    $v->{name} = lc($k);
                    next unless (!@names || grep {$v->{name} eq lc($_)} @names);
                    push @j, $v;
                }
            }
        }
    } elsif ((ref($sects) eq 'HASH') && !exists $sects->{enable}) { # Hash {name => {...}}
        foreach my $k (keys %$sects) {
            my $v = $sects->{$k};
            next unless ref($v) eq 'HASH';
            $v->{name} = lc($k);
            next unless (!@names || grep {$v->{name} eq lc($_)} @names);
            push @j, $v;
        }
    } 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;
}

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

    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",
                "friday"    => "fri",
                "saturday"  => "sat",
            },
        AT_DEFAULT      => 'Sun-Sat',
        SFT_DEFAULT     => '[00:00-23:59]',
        OFFSET_START    => 0,          # 00:00
        OFFSET_FINISH   => 60*60*24-1, # 23:59
    };

sub new {
    my $class = shift;
    my %args = @_;

    my $self = bless {
            calendar => {}, # { channel_name => [ { weekday_index => [start, finish] } ] }
            added    => {}, # { channel_name => at }
        }, $class;

    return $self;
}

sub getAtString {
    my $self = shift;
    my $chname = shift;
    croak("The channel name missing") unless $chname;
    my $added = $self->{added};
    return exists $added->{$chname} ? $added->{$chname} : '';
}
sub add {
    my $self = shift;
    my $chname = shift;
    my $at = lc(shift || AT_DEFAULT);
    croak("The channel name missing") unless $chname;
    $at =~ s/\s+//g; # remove spaces

    # Maybe already exists? - return
    my $added = $self->{added};
    return $self if $added->{$chname} && $added->{$chname} eq $at;
    $added->{$chname} = $at;

    # Split by days & times
    my @wdt_blocks = ();
    while ($at =~ /([a-z\-]{3,18}(\[([0-9\-:,;]+|none|no|off)\])?)/ig) {
        push @wdt_blocks, _parse_wdt($1);
    }
    $self->{calendar}{$chname} = [@wdt_blocks];

    return $self;
}
sub check {
    my $self = shift;
    my $chname = shift || "default";
    my $test = shift || time();

    # Exists
    return 1 unless exists $self->{calendar}{$chname}; # No calendar - no limits
    my $calendar = array($self->{calendar}, $chname);
    return 0 if is_void($calendar); # No allow intervals in the calendar - denied

    # Get test values
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($test);
    my $t = $hour*60*60 + $min*60 + $sec;

    # Check
    my $allow = 0; # denied by default
    foreach my $int (@$calendar) {
        next unless is_hash($int);