view release on metacpan or  search on metacpan

lib/Developer/Dashboard/CollectorRunner.pm  view on Meta::CPAN

    $self->_write_loop_state( $name, { last_cron_slot => $stamp } );
    return 1;
}

# _parse_cron_expression($expr)
# Validates a five-field crontab expression and expands each field into a set
# of matching values, including standard names, lists, ranges and step values.
# Input: cron expression string.
# Output: array reference of five match-set hashes and an empty error string,
# or undef and a visible validation message.
sub _parse_cron_expression {
    my ($expr) = @_;
    return ( undef, 'expression is missing' ) if !defined $expr || $expr !~ /\S/;
    return ( undef, 'expression is longer than 256 characters' ) if length($expr) > 256;
    $expr =~ s/\A\s+|\s+\z//g;
    my @specs = split /\s+/, $expr;
    return ( undef, 'expected exactly five fields' ) if @specs != 5;

    my @limits = ( [ 0, 59, {} ], [ 0, 23, {} ], [ 1, 31, {} ],
        [ 1, 12, { JAN => 1, FEB => 2, MAR => 3, APR => 4, MAY => 5, JUN => 6, JUL => 7, AUG => 8, SEP => 9, OCT => 10, NOV => 11, DEC => 12 } ],
        [ 0, 7, { SUN => 0, MON => 1, TUE => 2, WED => 3, THU => 4, FRI => 5, SAT => 6 } ], );
    my @fields;
    for my $index ( 0 .. 4 ) {
        my ( $set, $error ) = _parse_cron_field( $specs[$index], @{$limits[$index]} );
        return ( undef, sprintf( 'field %d (%s): %s', $index + 1, $specs[$index], $error ) ) if $error;
        $set->{_wildcard} = $specs[$index] eq '*' ? 1 : 0;
        if ( $index == 4 && delete $set->{7} ) {
            $set->{0} = 1;
        }
        push @fields, $set;
    }
    return ( \@fields, '' );
}

# _parse_cron_field($spec, $minimum, $maximum, $names)
# Parses one crontab field and returns its finite set of matching numeric values.
# Input: field string, inclusive numeric bounds, and optional name-to-number map.
# Output: hash reference and empty error string, or undef and validation message.
sub _parse_cron_field {
    my ( $spec, $minimum, $maximum, $names ) = @_;
    return ( undef, 'field is empty' ) if !defined $spec || $spec eq '';
    my %values;
    for my $item ( split /,/, $spec, -1 ) {
        return ( undef, 'empty list item' ) if $item eq '';
        my ( $base, $step ) = split m{/}, $item, -1;
        return ( undef, 'multiple step separators' ) if $item =~ m{/.*\/};
        if ( defined $step ) {
            return ( undef, 'step must be a positive integer' )
              if length($step) > 4 || $step !~ /\A\d+\z/ || $step < 1;
        }
        else {
            $step = 1;
        }

        my ( $start, $end );
        if ( $base eq '*' ) {
            ( $start, $end ) = ( $minimum, $maximum );
        }
        elsif ( $base =~ /\A([^,-]+)-([^,-]+)\z/ ) {
            ( $start, $end ) = ( _cron_value( $1, $names ), _cron_value( $2, $names ) );
            return ( undef, 'range endpoint is not a valid number or name' ) if !defined $start || !defined $end;
            return ( undef, 'range start exceeds range end' ) if $start > $end;
        }
        else {
            $start = _cron_value( $base, $names );
            return ( undef, 'value is not a valid number or name' ) if !defined $start;
            # Wildcards and ranges were handled above, so a slash remaining
            # here can only be an invalid scalar step (for example, 5/2).
            return ( undef, 'a step requires a wildcard or range' ) if $item =~ m{/};
            $end = $start;
        }

        return ( undef, 'value is outside the field limits' ) if $start < $minimum || $end > $maximum;
        for ( my $value = $start; $value <= $end; $value += $step ) {
            $values{$value} = 1;
        }
    }
    return ( \%values, '' );
}

# _cron_value($token, $names)
# Resolves a numeric token or case-insensitive crontab name.
# Input: field token and optional name-to-number hash reference.
# Output: numeric value, or undef when the token is invalid.
sub _cron_value {
    my ( $token, $names ) = @_;
    return 0 + $token if defined($token) && length($token) <= 3 && $token =~ /\A\d+\z/;
    return undef if ref($names) ne 'HASH';
    return $names->{ uc($token // '') };
}

# _cron_wday_normalize($spec)
# Aliases crontab's weekday value 7 to 0 (Sunday) in numeric lists.
# Input: weekday field string, possibly undefined.
# Output: weekday string with each bare 7 token normalized to 0.
sub _cron_wday_normalize {
    my ($spec) = @_;
    return $spec if !defined $spec;
    return join( ',', map { $_ eq '7' ? '0' : $_ } split /,/, $spec );
}

# _cron_match($spec, $value, $minimum, $maximum, $names)
# Matches one cron field by parsing its numeric, name, range or step syntax.
# Input: field string, numeric value, optional inclusive bounds, and name map.
# Output: boolean match flag.
sub _cron_match {
    my ( $spec, $value, $minimum, $maximum, $names ) = @_;
    $minimum = 0 if !defined $minimum;
    $maximum = 60 if !defined $maximum;
    return 0 if !defined($value) || length($value) > 3 || $value !~ /\A\d+\z/ || $value < $minimum || $value > $maximum;
    return 1 if !defined($spec) || $spec eq '' || $spec eq '*';
    my ( $values, $error ) = _parse_cron_field( $spec, $minimum, $maximum, $names );
    return 0 if $error;
    return $values->{$value} ? 1 : 0;
}

# DD-947: this cluster (run_command through exit_code_from_status) was
# extracted into Developer::Dashboard::CommandRunner - confirmed zero
# instance-state ($self->{...}) dependency before the move. These are
# thin one-line forwarders so every existing caller of $self->_run_command
# etc. keeps working unchanged.