File Coverage

blib/lib/AnyEvent/DateTime/Cron.pm
Criterion Covered Total %
statement 18 110 16.3
branch 0 48 0.0
condition 0 8 0.0
subroutine 6 17 35.2
pod 7 7 100.0
total 31 190 16.3


line stmt bran cond sub pod time code
1             package AnyEvent::DateTime::Cron;
2              
3 1     1   36526 use warnings;
  1         3  
  1         34  
4 1     1   6 use strict;
  1         2  
  1         35  
5 1     1   456665 use DateTime();
  1         384706  
  1         33  
6 1     1   1005 use DateTime::Event::Cron();
  1         77507  
  1         30  
7 1     1   1385 use DateTime::Event::Cron::Quartz();
  1         35807  
  1         37  
8 1     1   1903 use AnyEvent();
  1         6540  
  1         1550  
9             our $VERSION = 0.08;
10              
11             #===================================
12             sub new {
13             #===================================
14 0     0 1   my ( $class, %params ) = @_;
15              
16 0           foreach my $key ( keys %params ) {
17 0 0         die "Unknown param '$key'" unless $key =~ /^(time_zone|quartz)$/;
18             }
19              
20 0 0         $params{time_zone} = DateTime::TimeZone->new(name => $params{time_zone})
21             if $params{time_zone};
22              
23 0 0         $params{quartz} = 0 unless defined $params{quartz};
24              
25 0           return bless {
26             _jobs => {},
27             _debug => 0,
28             _id => 0,
29             _running => 0,
30             _time_zone => $params{time_zone},
31             _quartz => $params{quartz},
32             }, $class;
33             }
34              
35             #===================================
36             sub add {
37             #===================================
38 0     0 1   my $self = shift;
39 0 0         my @args = ref $_[0] eq 'ARRAY' ? @{ shift() } : @_;
  0            
40 0           while (@args) {
41 0           my $cron = shift @args;
42 0           my ( $cb, %params );
43 0           while (@args) {
44 0           my $key = shift @args;
45 0 0         if ( ref $key eq 'CODE' ) {
46 0           $cb = $key;
47 0           last;
48             }
49 0 0         die "Unknown param '$key'"
50             unless $key =~ /^(name|single)$/;
51 0           $params{$key} = shift @args;
52             }
53 0 0         die "No callback found for cron entry '$cron'"
54             unless $cb;
55              
56 0           my $event;
57 0 0         if ($self->{_quartz}) {
58 0           $event = DateTime::Event::Cron::Quartz->new($cron);
59             }
60             else {
61 0           $event = DateTime::Event::Cron->new($cron);
62             }
63              
64 0           my $id = ++$self->{_id};
65 0   0       $params{name} ||= $id;
66 0           my $job = $self->{_jobs}{$id} = {
67             event => $event,
68             cb => $cb,
69             id => $id,
70             watchers => {},
71             %params,
72             };
73              
74 0 0         $self->_schedule($job)
75             if $self->{_running};
76             }
77 0           return $self;
78             }
79              
80             #===================================
81             sub delete {
82             #===================================
83 0     0 1   my $self = shift;
84 0 0         my @ids = ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;
  0            
85              
86 0           for (@ids) {
87 0 0         print STDERR "Deleting job '$_'\n"
88             if $self->{_debug};
89              
90 0 0         if ( my $job = delete $self->{_jobs}{$_} ) {
    0          
91 0           $job->{watchers} = {};
92             }
93             elsif ( $self->{_debug} ) {
94 0           print STDERR "Job '$_' not found\n";
95             }
96             }
97 0           return $self;
98             }
99              
100             #===================================
101             sub start {
102             #===================================
103 0     0 1   my $self = shift;
104 0           my $cv = $self->{_cv} = AnyEvent->condvar;
105              
106 0     0     $cv->begin( sub { $self->stop } );
  0            
107              
108             $self->{_signal} = AnyEvent->signal(
109             signal => 'TERM',
110             cb => sub {
111 0 0   0     print STDERR "Shutting down\n" if $self->{_debug};
112 0           $cv->end;
113             }
114 0           );
115 0           $self->{_running} = 1;
116 0           $self->_schedule( values %{ $self->{_jobs} } );
  0            
117              
118 0           return $cv;
119             }
120              
121             #===================================
122             sub stop {
123             #===================================
124 0     0 1   my $self = shift;
125 0           $_->{watchers} = {} for values %{ $self->{_jobs} };
  0            
126              
127 0           my $cv = delete $self->{_cv};
128 0           delete $self->{_signal};
129 0           $self->{_running} = 0;
130              
131 0           $cv->send;
132 0           return $self;
133             }
134              
135             #===================================
136             sub _schedule {
137             #===================================
138 0     0     my $self = shift;
139              
140 0           my $time_zone = $self->{_time_zone};
141              
142 0           AnyEvent->now_update();
143 0           my $now_epoch = AnyEvent->now;
144 0           my $now = DateTime->from_epoch( epoch => $now_epoch );
145 0           my $debug = $self->{_debug};
146              
147 0 0         $now->set_time_zone($time_zone) if $time_zone;
148              
149 0           for my $job (@_) {
150 0           my $name = $job->{name};
151              
152 0           my $next_run;
153 0 0         if ($self->{_quartz}) {
154 0           $next_run = $job->{event}->get_next_valid_time_after($now);
155             }
156             else {
157 0           $next_run = $job->{event}->next($now);
158             }
159              
160 0 0         $next_run->set_time_zone($time_zone) if $time_zone;
161              
162 0           my $next_epoch = $next_run->epoch;
163 0           my $delay = $next_epoch - $now_epoch;
164              
165 0 0         print STDERR "Scheduling job '$name' for: $next_run\n"
166             if $debug;
167              
168             my $run_event = sub {
169 0 0   0     print STDERR "Starting job '$name'\n"
170             if $debug;
171              
172 0           $self->{_cv}->begin;
173 0           delete $job->{watchers}{$next_epoch};
174              
175 0           $self->_schedule($job);
176              
177 0 0 0       if ( $job->{single} && $job->{running}++ ) {
178 0 0         print STDERR "Skipping job '$name' - still running\n"
179             if $debug;
180             }
181             else {
182 0 0 0       eval { $job->{cb}->( $self->{_cv}, $job ); 1 }
  0            
  0            
183             or warn $@ || 'Unknown error';
184 0           delete $job->{running};
185 0 0         print STDERR "Finished job '$name'\n"
186             if $debug;
187             }
188              
189 0           $self->{_cv}->end;
190 0           };
191              
192 0           $job->{watchers}{$next_epoch} = AnyEvent->timer(
193             after => $delay,
194             cb => $run_event
195             );
196             }
197             }
198              
199             #===================================
200             sub debug {
201             #===================================
202 0     0 1   my $self = shift;
203 0 0         $self->{_debug} = shift if @_;
204 0           return $self;
205             }
206              
207             #===================================
208 0     0 1   sub jobs { shift->{_jobs} }
209             #===================================
210              
211             1;
212              
213             =pod
214              
215             =encoding UTF-8
216              
217             =head1 NAME
218              
219             AnyEvent::DateTime::Cron - AnyEvent crontab with DateTime::Event::Cron
220              
221             =head1 VERSION
222              
223             version 0.08
224              
225             =head1 SYNOPSIS
226              
227             AnyEvent::DateTime::Cron->new()
228             ->add(
229             '* * * * *' => sub { warn "Every minute"},
230             '*/2 * * * *' => sub { warn "Every second minute"},
231             )
232             ->start
233             ->recv
234              
235             $cron = AnyEvent::DateTime::Cron->new();
236             $cron->debug(1)->add(
237             '* * * * *', name => 'job_name', single => 1, sub {'foo'},
238             ...
239             );
240              
241             $cron->delete($job_id,$job_id...)
242              
243             $cv = $cron->start;
244             $cv->recv;
245              
246             AnyEvent::DateTime::Cron->new(time_zone => 'local');
247             ->add(
248             '* * * * *' => sub { warn "Every minute"},
249             '*/2 * * * *' => sub { warn "Every second minute"},
250             )
251             ->start
252             ->recv
253              
254             =head1 DESCRIPTION
255              
256             L is an L based crontab, which supports
257             all crontab formats recognised by L.
258              
259             It allows you to shut down a running instance gracefully, by waiting for
260             any running cron jobs to finish before exiting.
261              
262             =head1 METHODS
263              
264             =head2 new()
265              
266             $cron = AnyEvent::DateTime::Cron->new(
267             time_zone => ...
268             quartz => 0/1
269             );
270              
271             Creates a new L instance - takes optional parameters
272             time_zone and quartz.
273              
274             time_zone can will be used to set the time_zone for any DateTime objects that
275             are used internally.
276              
277             if quartz is set to a true value then this class will use switch to using
278             L internally, which will allow the use of seconds
279             in the cron expression. See the DateTime::Event::Cron::Quartz for details on
280             writing a proper quartz cron expression.
281              
282             =head2 add()
283              
284             $cron->add(
285             '* * * * *', sub {...},
286             '* * * * *', name => 'job_name', single => 1, sub {...},
287             ...
288             );
289              
290             Use C to add new cron jobs. It accepts a list of crontab entries,
291             optional paremeters and callbacks.
292              
293             The C parameter is useful for debugging, otherwise the auto-assigned
294             C is used instead.
295              
296             The C parameter, if C, will only allow a single instance of
297             a job to run at any one time.
298              
299             New jobs can be added before running, or while running.
300              
301             See L for more.
302              
303             =head2 delete()
304              
305             $cron->delete($job_id,$job_id,....)
306              
307             Delete one or more existing jobs, before starting or while running.
308              
309             =head2 start()
310              
311             my $cv = $cron->start;
312             $cv->recv;
313              
314             Schedules all jobs to start at the next scheduled time, and returns an
315             L.
316              
317             The cron loop can be started by calling C on the condvar.
318              
319             =head2 stop()
320              
321             $cron->stop()
322              
323             Used to shutdown the cron loop gracefully. You can also shutdown the cron loop
324             by sending a C signal to the process.
325              
326             =head2 jobs()
327              
328             $job = $cron->jobs
329              
330             Returns a hashref containing all the current cron jobs.
331              
332             =head2 debug()
333              
334             $cron->debug(1|0)
335              
336             Turn on debugging.
337              
338             =head1 CALLBACKS
339              
340             A callback is a coderef (eg an anonymous subroutine) which will be called
341             every time your job is triggered. Callbacks should use C themselves,
342             so that they run asynchronously, otherwise they can block the execution
343             of the cron loop, delaying other jobs.
344              
345             Two parameters are passed to your callback: the main C<$cv> of the cron loop,
346             and the C<$job_description> which contains various details about the current
347             job.
348              
349             The C<$cv> is the most important parameter, as it allows you to control how
350             your cron loop will shut down. If your callback doesn't use
351             C and is blocking, then your callback will complete before it
352             returns to the cron loop.
353              
354             However, if your callback is running asynchronously (and it really should),
355             then you can block the cron loop from responding to a L request
356             until your job has completed:
357              
358             sub {
359             my $cv = shift;
360             $cv->begin;
361             do_something_asynchronous( cb => sub { $cv->end })
362             }
363              
364             Callbacks are called inside an C so if they throw an error, they
365             will warn, but won't cause the cron loop to exit.
366              
367             =head1 AUTHORS
368              
369             =over 4
370              
371             =item *
372              
373             Clinton Gormley
374              
375             =item *
376              
377             Andy Gorman
378              
379             =back
380              
381             =head1 COPYRIGHT AND LICENSE
382              
383             This software is copyright (c) 2013 by Clinton Gormley.
384              
385             This is free software; you can redistribute it and/or modify it under
386             the same terms as the Perl 5 programming language system itself.
387              
388             =cut
389              
390             __END__