modules/fallback/Set/Crontab.pm

   1 # Copyright 2001 Abhijit Menon-Sen <ams@toroid.org>
   2
   3 package Set::Crontab;
   4
   5 use strict;
   6 use Carp;
   7 use vars qw( $VERSION );
   8
   9 $VERSION = '1.03';
  10
  11 sub _expand
  12 {
  13     my (@list, @and, @not);
  14     my ($self, $spec, $range) = @_;
  15
  16     # 1,2-4,*/3,!13,>9,<15
  17     foreach (split /,/, $spec) {
  18         my @pick;
  19         my $step = $1 if s#/(\d+)$##;
  20
  21         # 0+"01" == 1
  22         if    (/^(\d+)$/)       { push @pick, 0+$1;          }
  23         elsif (/^\*$/)          { push @pick, @$range;       }
  24         elsif (/^(\d+)-(\d+)$/) { push @pick, 0+$1..0+$2;    }
  25         elsif (/^!(\d+)$/)      { push @not,  "\$_ != 0+$1"; }
  26         elsif (/^([<>])(\d+)$/) { push @and,  "\$_ $1 0+$2"; }
  27
  28         if ($step) {
  29             my $i;
  30             @pick = grep { defined $_ if $i++ % $step == 0 } @pick;
  31         }
  32
  33         push @list, @pick;
  34     }
  35
  36     if (@and) {
  37         my $and = join q{ && }, @and;
  38         push @list, grep { defined $_ if eval $and } @$range;
  39     }
  40
  41     if (@not) {
  42         my $not = join q{ && }, @not;
  43         @list = grep { defined $_ if eval $not } (@list ? @list : @$range);
  44     }
  45
  46     @list = sort { $a <=> $b } @list;
  47     return \@list;
  48 }
  49
  50 sub _initialise
  51 {
  52     my ($self, $spec, $range) = @_;
  53     return undef unless ref($self);
  54
  55     croak "Usage: ".__PACKAGE__."->new(\$spec, [\@range])"
  56         unless defined $spec && ref($range) eq "ARRAY";
  57
  58     $self->{LIST} = $self->_expand($spec, $range);
  59     $self->{HASH} = {map {$_ => 1} @{$self->{LIST}}};
  60
  61     return $self;
  62 };
  63
  64 sub new
  65 {
  66     my $class = shift;
  67     my $self  = bless {}, ref($class) || $class;
  68     return $self->_initialise(@_);
  69 }
  70
  71 sub contains
  72 {
  73     my ($self, $num) = @_;
  74
  75     croak "Usage: \$set->contains(\$num)" unless ref($self) && defined $num;
  76     return exists $self->{HASH}{$num};
  77 }
  78
  79 sub list
  80 {
  81     my $self = shift;
  82
  83     croak "Usage: \$set->list()" unless ref($self);
  84     return @{$self->{LIST}};
  85 }
  86
  87 1;
  88 __END__
  89
  90 =head1 NAME
  91
  92 Set::Crontab - Expand crontab(5)-style integer lists
  93
  94 =head1 SYNOPSIS
  95
  96 $s = Set::Crontab->new("1-9/3,>15,>30,!23", [0..30]);
  97
  98 if ($s->contains(3)) { ... }
  99
 100 =head1 DESCRIPTION
 101
 102 Set::Crontab parses crontab-style lists of integers and defines some
 103 utility functions to make it easier to deal with them.
 104
 105 =head2 Syntax
 106
 107 Numbers, ranges, *, and step values all work exactly as described in
 108 L<crontab(5)>. A few extensions to the standard syntax are described
 109 below.
 110
 111 =over 4
 112
 113 =item < and >
 114
 115 <N selects the elements smaller than N from the entire range, and adds
 116 them to the set. >N does likewise for elements larger than N.
 117
 118 =item !
 119
 120 !N excludes N from the set. It applies to the other specified
 121 range; otherwise it applies to the specified ranges (i.e. "!3" with a
 122 range of "1-10" corresponds to "1-2,4-10", but ">3,!7" in the same range
 123 means "4-6,8-10").
 124
 125 =back
 126
 127 =head2 Functions
 128
 129 =over 4
 130
 131 =item new($spec, [@range])
 132
 133 Creates a new Set::Crontab object and returns a reference to it.
 134
 135 =item contains($num)
 136
 137 Returns true if C<$num> exists in the set.
 138
 139 =item list()
 140
 141 Returns the expanded list corresponding to the set. Elements are in
 142 ascending order.
 143
 144 =back
 145
 146 The functions described above croak if they are called with incorrect
 147 arguments.
 148
 149 =head1 SEE ALSO
 150
 151 L<crontab(5)>
 152
 153 =head1 AUTHOR
 154
 155 Abhijit Menon-Sen <ams@toroid.org>
 156
 157 Copyright 2001 Abhijit Menon-Sen <ams@toroid.org>
 158
 159 This module is free software; you can redistribute it and/or modify it
 160 under the same terms as Perl itself.