File Coverage

blib/lib/Parse/Crontab/Schedule.pm
Criterion Covered Total %
statement 68 68 100.0
branch 22 24 91.6
condition 3 3 100.0
subroutine 14 14 100.0
pod 3 3 100.0
total 110 112 98.2


line stmt bran cond sub pod time code
1             package Parse::Crontab::Schedule;
2 5     5   63987 use 5.008_001;
  5         18  
  5         182  
3 5     5   24 use strict;
  5         9  
  5         149  
4 5     5   24 use warnings;
  5         9  
  5         124  
5 5     5   25 use Carp;
  5         16  
  5         368  
6 5     5   2058 use Try::Tiny;
  5         3608  
  5         325  
7              
8 5     5   4940 use Parse::Crontab::Schedule::Entity;
  5         479  
  5         188  
9              
10 5     5   44 use Mouse;
  5         12  
  5         26  
11              
12             my @SCHEDULES = qw/minute hour day month day_of_week/;
13              
14             has $_ => (
15             is => 'rw',
16             ) for @SCHEDULES;
17              
18             has user => (
19             is => 'ro',
20             isa => 'Maybe[Str]',
21             );
22              
23             has definition => (
24             is => 'ro',
25             isa => 'Str',
26             );
27              
28 5     5   1815 no Mouse;
  5         9  
  5         21  
29              
30             my %DEFINITIONS = (
31             yearly => '0 0 1 1 *',
32             annually => '0 0 1 1 *',
33             monthly => '0 0 1 * *',
34             weekly => '0 0 * * 0',
35             daily => '0 0 * * *',
36             hourly => '0 * * * *',
37             reboot => '@reboot',
38             );
39              
40             my %ENTITY_PARAMS = (
41             minute => {
42             range => [0,59],
43             },
44             hour => {
45             range => [0,23],
46             },
47             day => {
48             range => [1,31],
49             },
50             month => {
51             range => [1,12],
52             aliases => [qw/jan feb mar apr may jun jul aug sep oct nov dec/],
53             },
54             day_of_week => {
55             range => [0,7],
56             aliases => [qw/sun mon tue wed thu fri sat/],
57             },
58             );
59              
60             sub BUILD {
61 17     17 1 5106 my $self = shift;
62              
63 17         27 my %s;
64 17 100       74 if (my $def = $self->definition) {
65 6         52 my $definition = $DEFINITIONS{$def};
66 6 50       21 croak sprintf('bad time specifier: [%s]', $def) unless $definition;
67              
68 6 100       18 if ($def ne 'reboot') {
69 5         35 @s{@SCHEDULES} = split /\s+/, $definition;
70             }
71             }
72             else {
73 11         163 $s{$_} = $self->$_ for @SCHEDULES;
74             }
75              
76 17 100       67 if (exists $s{minute}) {
77 16         35 for my $schedule (@SCHEDULES) {
78 79         96 my $entity;
79             try {
80 79         1241 $entity = Parse::Crontab::Schedule::Entity->new(
81             entity => $s{$schedule},
82 79     79   2703 %{$ENTITY_PARAMS{$schedule}},
83             field => $schedule,
84             );
85             }
86             catch {
87 2     2   255 croak "bad $schedule: $_";
88 79         521 };
89 77         1440 $self->$schedule($entity);
90             }
91             }
92             }
93              
94             sub parse {
95 3     3 1 3501 my ($cls, $str) = @_;
96              
97 3         16 my @s = split /\s+/, $str;
98 3         5 my %args;
99 3         8 for my $schedule (@SCHEDULES) {
100 15         15 my $arg = shift @s;
101 15         39 $args{$schedule} = $arg;
102             }
103              
104 3         59 my $self = $cls->new(%args);
105              
106 3 100       16 if (my @warns = $self->_check_warnings) {
107 1         27 croak join "\n", @warns;
108             }
109 2         11 $self;
110             }
111              
112             sub _check_warnings {
113 11     11   19 my $self = shift;
114              
115 11         19 my @warnings;
116 11 100       337 if ($self->minute.'' eq '*') {
117 4         12 push @warnings,
118             q{Specifying '*' for minutes means EVERY MINUTES. You really want to do that and to remove this warning, specify '*/1' explicitly.}
119             }
120 11 100 100     51 if ($self->day_of_week.'' ne '*' && $self->day.'' ne '*') {
121 1         4 push @warnings,
122             q{Both specifying 'day_of_week' and 'day' field causes unexpected behavior. You should seperate job entries.}
123             }
124 11         43 @warnings;
125             }
126              
127             sub match {
128 7     7 1 1471 my ($self, %args) = @_;
129              
130 7         18 for my $s (qw/minute hour month/) {
131 19 100       264 return unless $self->$s->match($args{$s});
132             }
133              
134 5 100       32 if ($self->day_of_week.'' ne '*') {
135 2 50       6 croak q{args year is not specified. could detect day_of_week.} unless $args{year};
136              
137 2         95007 require Time::Piece;
138 2         33059 my $str = sprintf '%04d-%02d-%02d', $args{year}, $args{month}, $args{day};
139 2         9 my $day = Time::Piece->strptime($str, '%Y-%m-%d');
140              
141 2 100       75 return unless $self->day_of_week->match($day->day_of_week);
142             }
143             else {
144 3 100       14 return unless $self->day->match($args{day});
145             }
146              
147 3         25 1; # matched
148             }
149              
150             __PACKAGE__->meta->make_immutable;
151             __END__