view release on metacpan or  search on metacpan

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

    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);
        my $sec = $int->{$wday};
        next unless $sec && is_array($sec);
        my ($s, $f) = (($sec->[0] || 0), ($sec->[1] || 0));
        next unless $s+$f;
        if (($t >= $s and $t <= $f) || ($t >= $f and $t <= $s)) {
            $allow++;
            next;
        }
    }
    return $allow;
}

sub _parse_wdt { # parse week day blocks
    my $wdtin = shift;
    $wdtin =~ /([a-z\-]{3,18})(\[([0-9\-:,;]+|none|no|off)\])?/;
    my $wd = $1;
    my $t = $2 || SFT_DEFAULT;
       $t = '[off]' if $t =~ /\[\-+\]/;

    # Resolve week days (wd)
    my %dw_aliases = %{DAYS_ALIASES()};
    my %dw_map; my $i = 0;
    for (@{DAYS_OF_WEEK_S()}) {
        $dw_map{$_} = $i++;
    }

    #print App::MonM::Util::explain(\%dw_map);
    my @wdts;
    my @pt = _parse_t($t);
    if ($wd =~ /^[a-z]{3,9}$/) {
        $wd = $dw_aliases{$wd} if $dw_aliases{$wd};
        return () unless exists $dw_map{$wd};
        for (@pt) {
            push @wdts, {$dw_map{$wd} => $_};
        }
    } elsif ($wd =~ /([a-z]{3,9})[\-]+([a-z]{3,9})/) {
        my ($sd, $fd) = ($1, $2);
        $sd = $dw_aliases{$sd} if $dw_aliases{$sd};
        $fd = $dw_aliases{$fd} if $dw_aliases{$fd};
        return () unless exists $dw_map{$sd} and exists $dw_map{$fd};
        #print ">>$dw_map{$sd} -- $dw_map{$fd}\n";
        my $mx = 7; # Max days per wd-interval
        my $start_flag = 0;
        foreach my $wdi (0..6,0..6) { # 2 weeks!!
            # Start def
            $start_flag = 1 if !$start_flag && ($dw_map{$sd} == $wdi);
            next unless $start_flag;
            # only 7 days!
            next if $mx-- <= 0;
            # Proc
            #print ">>cnt=$mx; wdi=$wdi\n";
            for (@pt) {
                push @wdts, {$wdi => $_};
            }
            # Finish def
            last if $dw_map{$fd} == $wdi;
        }
    }
    return (@wdts);