DateTime-Event-Cron-0.09/0000755000175000017500000000000013071505457013627 5ustar sisksiskDateTime-Event-Cron-0.09/META.yml0000644000175000017500000000106113071505457015076 0ustar sisksisk--- abstract: 'DateTime extension for generating recurrence' author: - 'Matthew P. Sisk ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: DateTime-Event-Cron no_index: directory: - t - inc requires: DateTime: 0.21 DateTime::Set: 0.1406 Set::Crontab: 0 version: 0.09 DateTime-Event-Cron-0.09/Changes0000644000175000017500000000215713071505420015115 0ustar sisksiskRevision history: 0.09 Thu Apr 6 14:36:36 EDT 2017 - refactored increment/decrement in order to properly handle DST transitions as perl RT #120789 0.08 Thu Jun 10 16:54:11 EDT 2010 - Added match() for checking cron hits 0.07 Mon Mar 29 16:54:25 CST 2004 - Patched next() and previous() to work with new DateTime::Set 0.06 Tue Dec 30 14:28:32 CST 2003 - Added user-mode auto-detection - Added original() method to return original unparsed cron strings 0.05 Tue Nov 11 22:40:16 CST 2003 - Retains command and user strings if present - Switched to named parameters for constructors - Added 'user_mode' parameter for crontab formats that include user names before the command. - Added command() and user() methods 0.04 PAUSE fodder 0.03 Wed May 7 17:09:38 EDT 2003 - more edge cases detected/prevented - dependencies added - removal of 'our' 0.02 Fri May 2 00:22:52 EDT 2003 - changed API - fixed some boundary cases - streamlined, added some helper classes with cron sets - CPAN 0.01 Tue Apr 22 19:52:56 EDT 2003 - initial release DateTime-Event-Cron-0.09/README0000644000175000017500000000201513071504717014503 0ustar sisksiskDateTime::Event::Cron ===================== This module generates DateTime and DateTime::Set objects based on crontab-style entries. The crontab formats are the extended V7 standard as described in crontab(5) on linux systems and as noted in the documentation for Set::Crontab. Note that the module is still alpha status. Methods provided are likely to change in the future. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: DateTime DateTime::Duration DateTime::Set Set::Crontab SUPPORT Contact the author directly, or query the DateTime mailing list at . To subscribe to the list, send an empty message to . COPYRIGHT AND LICENSE Copyright (c) 2003 Matthew P. Sisk. All rights reserved. All wrongs revenged. This program is free software; you can distribute it and/or modify it under the same terms as Perl itself. DateTime-Event-Cron-0.09/META.json0000644000175000017500000000172313071505457015253 0ustar sisksisk{ "abstract" : "DateTime extension for generating recurrence", "author" : [ "Matthew P. Sisk " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "DateTime-Event-Cron", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "DateTime" : "0.21", "DateTime::Set" : "0.1406", "Set::Crontab" : "0" } } }, "release_status" : "stable", "version" : "0.09" } DateTime-Event-Cron-0.09/Makefile.PL0000644000175000017500000000065510641013006015567 0ustar sisksiskuse ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'DateTime::Event::Cron', 'VERSION_FROM' => 'lib/DateTime/Event/Cron.pm', 'PREREQ_PM' => { DateTime => 0.21, DateTime::Set => 0.1406, Set::Crontab => 0, }, 'ABSTRACT_FROM' => 'lib/DateTime/Event/Cron.pm', 'AUTHOR' => 'Matthew P. Sisk ', ); DateTime-Event-Cron-0.09/t/0000755000175000017500000000000013071505457014072 5ustar sisksiskDateTime-Event-Cron-0.09/t/basic.t0000644000175000017500000000013610641013006015320 0ustar sisksiskuse Test; BEGIN { plan tests => 1 } END { ok($loaded) } use DateTime::Event::Cron; $loaded++; DateTime-Event-Cron-0.09/t/dst.t0000755000175000017500000000402513071503356015051 0ustar sisksisk#!/usr/bin/perl -w use strict; use lib './lib'; use Test::More tests => 12; use DateTime; use DateTime::Event::Cron; sub make_datetime { @_ == 6 or die "Invalid argument count\n"; DateTime->new( year => $_[0], month => $_[1], day => $_[2], hour => $_[3], minute => $_[4], second => $_[5], time_zone => "America/New_York", ); } sub dcomp { is(shift->datetime, shift->datetime, shift) } my($desc, $dtc, $old, $new, $date); $desc = "DST minute increment"; $dtc = DateTime::Event::Cron->new_from_cron("*/5 * * * *"); ok($dtc, "$desc create"); $old = make_datetime(2017, 3, 12, 1, 55, 0); $new = $dtc->next($old); $date = make_datetime(2017, 3, 12, 3, 0, 0); dcomp($new, $date, "$desc next"); $desc = "DST minute decrement"; $dtc = DateTime::Event::Cron->new_from_cron("*/5 * * * *"); ok($dtc, "$desc create"); $old = make_datetime(2017, 3, 12, 3, 0, 0); $new = $dtc->previous($old); $date = make_datetime(2017, 3, 12, 1, 55, 0); dcomp($new, $date, "$desc next"); $desc = "DST hour increment"; $dtc = DateTime::Event::Cron->new_from_cron("30 * * * *"); ok($dtc, "$desc create"); $old = make_datetime(2017, 3, 12, 1, 30, 0); $new = $dtc->next($old); $date = make_datetime(2017, 3, 12, 3, 30, 0); dcomp($new, $date, "$desc next"); $desc = "DST hour decrement"; $dtc = DateTime::Event::Cron->new_from_cron("30 * * * *"); ok($dtc, "$desc create"); $old = make_datetime(2017, 3, 12, 3, 30, 0); $new = $dtc->previous($old); $date = make_datetime(2017, 3, 12, 1, 30, 0); dcomp($new, $date, "$desc next"); $desc = "DST day increment"; $dtc = DateTime::Event::Cron->new_from_cron("30 2 * * *"); ok($dtc, "$desc create"); $old = make_datetime(2017, 3, 11, 2, 30, 0); $new = $dtc->next($old); $date = make_datetime(2017, 3, 13, 2, 30, 0); dcomp($new, $date, "$desc next"); $desc = "DST day decrement"; $dtc = DateTime::Event::Cron->new_from_cron("*/5 * * * *"); ok($dtc, "$desc create"); $old = make_datetime(2017, 3, 12, 3, 0, 0); $new = $dtc->previous($old); $date = make_datetime(2017, 3, 12, 1, 55, 0); dcomp($new, $date, "$desc next"); # End test DateTime-Event-Cron-0.09/t/cascade.t0000755000175000017500000000637311404236037015647 0ustar sisksisk#!/usr/bin/perl -w use strict; use lib './lib'; use Test::More tests => 21; use DateTime; use DateTime::Event::Cron; sub make_datetime { @_ == 6 or die "Invalid argument count\n"; DateTime->new( year => $_[0], month => $_[1], day => $_[2], hour => $_[3], minute => $_[4], second => $_[5], ); } sub dcomp { is(shift->datetime, shift->datetime, shift) } my($date, $new, $dts, $desc); $desc = 'cascade minute to hour'; $dts = DateTime::Event::Cron->from_cron(cron => '30 10,14,18 * * *'); ok($dts, "$desc create"); $date = make_datetime(2003,1,1,14,40,0); $new = $dts->next($date); $date = make_datetime(2003,1,1,18,30,0); dcomp($new, $date, "$desc next"); $date = make_datetime(2003,1,1,14,20,0); $new = $dts->previous($date); $date = make_datetime(2003,1,1,10,30,0); dcomp($new, $date, "$desc prev"); $desc = "cascade hour to day"; $dts = DateTime::Event::Cron->from_cron(cron => '0 12 10,15,20 * *'); ok($dts, "$desc create"); $date = make_datetime(2003,1,15,15,0,0); $new = $dts->next($date); $date = make_datetime(2003,1,20,12,0,0); dcomp($new, $date, "$desc next"); $date = make_datetime(2003,1,15,10,0,0); $new = $dts->previous($date); $date = make_datetime(2003,1,10,12,0,0); dcomp($new, $date, "$desc prev"); $desc = "cascade hour to dow"; $dts = DateTime::Event::Cron->from_cron(cron => '0 12 * * 2,4,6'); ok($dts, "$desc create"); $date = make_datetime(2003,1,16,15,0,0); $new = $dts->next($date); $date = make_datetime(2003,1,18,12,0,0); dcomp($new, $date, "$desc next"); $date = make_datetime(2003,1,16,10,0,0); $new = $dts->previous($date); $date = make_datetime(2003,1,14,12,0,0); dcomp($new, $date, "$desc prev"); $desc = "cascade day to month"; $dts = DateTime::Event::Cron->from_cron(cron => '0 0 15 5,7,9 *'); ok($dts, "$desc create"); $date = make_datetime(2003,7,20,0,0,0); $new = $dts->next($date); $date = make_datetime(2003,9,15,0,0,0); dcomp($new, $date, "$desc next"); $date = make_datetime(2003,7,10,0,0,0); $new = $dts->previous($date); $date = make_datetime(2003,5,15,0,0,0); dcomp($new, $date, "$desc prev"); $desc = "cascade dow to month"; $dts = DateTime::Event::Cron->from_cron(cron => '0 0 * 5,7,9 3'); ok($dts, "$desc create"); $date = make_datetime(2003,7,31,0,0,0); $new = $dts->next($date); $date = make_datetime(2003,9,3,0,0,0); dcomp($new, $date, "$desc next"); $date = make_datetime(2003,7,1,0,0,0); $new = $dts->previous($date); $date = make_datetime(2003,5,28,0,0,0); dcomp($new, $date, "$desc prev"); $desc = "cascade month to year"; $dts = DateTime::Event::Cron->from_cron(cron => '0 0 1 7 *'); ok($dts, "$desc create"); $date = make_datetime(2003,8,30,0,0,0); $new = $dts->next($date); $date = make_datetime(2004,7,1,0,0,0); dcomp($new, $date, "$desc next"); $date = make_datetime(2003,6,30,0,0,0); $new = $dts->previous($date); $date = make_datetime(2002,7,1,0,0,0); dcomp($new, $date, "$desc prev"); $desc = "cascade ripple minute to year"; $dts = DateTime::Event::Cron->from_cron(cron => '20 10,14,18 5,10,15 5,7,9 *'); ok($dts, "$desc create"); $date = make_datetime(2003,9,15,18,30,0); $new = $dts->next($date); $date = make_datetime(2004,5,5,10,20,0); dcomp($new, $date, "$desc next"); $date = make_datetime(2003,5,5,10,10,0); $new = $dts->previous($date); $date = make_datetime(2002,9,15,18,20,0); dcomp($new, $date, "$desc prev"); # End test DateTime-Event-Cron-0.09/t/crontab.t0000755000175000017500000000327411404236046015711 0ustar sisksisk#!/usr/bin/perl -w use strict; use lib './lib'; use Test::More tests => 9; use DateTime; use DateTime::Event::Cron; sub make_datetime { @_ == 6 or die "Invalid argument count\n"; DateTime->new( year => $_[0], month => $_[1], day => $_[2], hour => $_[3], minute => $_[4], second => $_[5], ); } sub dcomp { is(shift->datetime, shift->datetime, shift) } my($odate, $date, $new, $dts); my(@dts, @set); @dts = DateTime::Event::Cron->from_crontab(file => \*DATA); is(scalar @dts, 4, 'load crontab'); $odate = make_datetime(2004,8,8,8,8,8); $date = $odate->clone; $new = $dts[0]->next($date); $date = make_datetime(2004,8,8,9,1,0); dcomp($new, $date, 'next'); $new = $dts[0]->previous($date); $date = make_datetime(2004,8,8,8,1,0); dcomp($new, $date, 'prev'); $date = $odate->clone; $new = $dts[1]->next($date); $date = make_datetime(2004,8,9,4,2,0); dcomp($new, $date, 'next'); $new = $dts[1]->previous($date); $date = make_datetime(2004,8,8,4,2,0); dcomp($new, $date, 'prev'); $date = $odate->clone; $new = $dts[2]->next($date); $date = make_datetime(2004,8,15,4,22,0); dcomp($new, $date, 'next'); $new = $dts[2]->previous($date); $date = make_datetime(2004,8,8,4,22,0); dcomp($new, $date, 'prev'); $date = $odate->clone; $new = $dts[3]->next($date); $date = make_datetime(2004,9,1,4,42,0); dcomp($new, $date, 'next'); $new = $dts[3]->previous($date); $date = make_datetime(2004,8,1,4,42,0); dcomp($new, $date, 'prev'); # End of tests __DATA__ SHELL=/bin/bash PATH=/sbin:/bin:/usr/sbin:/usr/bin MAILTO=root HOME=/ # run-parts 01 * * * * root run-parts /etc/cron.hourly 02 4 * * * root run-parts /etc/cron.daily 22 4 * * 0 root run-parts /etc/cron.weekly 42 4 1 * * root run-parts /etc/cron.monthly DateTime-Event-Cron-0.09/t/leapyear.t0000755000175000017500000000745711404236051016066 0ustar sisksisk#!/usr/bin/perl -w use strict; use lib './lib'; use Test::More tests => 28; use DateTime; use DateTime::Event::Cron; sub make_datetime { @_ == 6 or die "Invalid argument count\n"; DateTime->new( year => $_[0], month => $_[1], day => $_[2], hour => $_[3], minute => $_[4], second => $_[5], ); } sub dcomp { is(shift->datetime, shift->datetime, shift) } my($odate, $date, $new, $dtc, $desc); # check some weird dates...Feb 29, non leap year $desc = "Feb 29 skip, non leap year"; $dtc = DateTime::Event::Cron->new('1 1 29 * *'); ok($dtc, "$desc create"); $odate = make_datetime(2001,2,14,15,0,0); $date = $odate->clone; $new = $dtc->next($date); $date = make_datetime(2001,3,29,1,1,0); dcomp($new, $date, "$desc next"); $new = $dtc->next($date); $date = make_datetime(2001,4,29,1,1,0); dcomp($new, $date, "$desc next"); $new = $dtc->next($date); $date = make_datetime(2001,5,29,1,1,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dtc->previous($date); $date = make_datetime(2001,1,29,1,1,0); dcomp($new, $date, "$desc prev"); $new = $dtc->previous($date); $date = make_datetime(2000,12,29,1,1,0); dcomp($new, $date, "$desc prev"); $new = $dtc->previous($date); $date = make_datetime(2000,11,29,1,1,0); dcomp($new, $date, "$desc prev"); # Feb 29, leap year. $desc = "Feb 29 hit, leap year"; $dtc = DateTime::Event::Cron->new('1 1 29 * *'); ok($dtc, "$desc create"); $odate = make_datetime(1996,2,14,15,0,0); $date = $odate->clone; $new = $dtc->next($date); $date = make_datetime(1996,2,29,1,1,0); dcomp($new, $date, "$desc next"); $new = $dtc->next($date); $date = make_datetime(1996,3,29,1,1,0); dcomp($new, $date, "$desc next"); $new = $dtc->next($date); $date = make_datetime(1996,4,29,1,1,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dtc->previous($date); $date = make_datetime(1996,1,29,1,1,0); dcomp($new, $date, "$desc prev"); $new = $dtc->previous($date); $date = make_datetime(1995,12,29,1,1,0); dcomp($new, $date, "$desc prev"); $new = $dtc->previous($date); $date = make_datetime(1995,11,29,1,1,0); dcomp($new, $date, "$desc prev"); # cron on 31st of the month, set date to february in a nonleap year $desc = "Feb 31 skip, non leap year"; $dtc = DateTime::Event::Cron->new('1 1 31 * *'); ok($dtc, "$desc create"); $odate = make_datetime(2001,2,14,15,0,0); $date = $odate->clone; $new = $dtc->next($date); $date = make_datetime(2001,3,31,1,1,0); dcomp($new, $date, "$desc next"); $new = $dtc->next($date); $date = make_datetime(2001,5,31,1,1,0); dcomp($new, $date, "$desc next"); $new = $dtc->next($date); $date = make_datetime(2001,7,31,1,1,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dtc->previous($date); $date = make_datetime(2001,1,31,1,1,0); dcomp($new, $date, "$desc prev"); $new = $dtc->previous($date); $date = make_datetime(2000,12,31,1,1,0); dcomp($new, $date, "$desc prev"); $new = $dtc->previous($date); $date = make_datetime(2000,10,31,1,1,0); dcomp($new, $date, "$desc prev"); # cron on 1st of the month, set date to february in a nonleap year $desc = "Mar 1 from Feb, non leap year"; $dtc = DateTime::Event::Cron->new('1 1 1 * *'); ok($dtc, "$desc create"); $odate = make_datetime(2001,2,14,15,0,0); $date = $odate->clone; $new = $dtc->next($date); $date = make_datetime(2001,3,1,1,1,0); dcomp($new, $date, "$desc next"); $new = $dtc->next($date); $date = make_datetime(2001,4,1,1,1,0); dcomp($new, $date, "$desc next"); $new = $dtc->next($date); $date = make_datetime(2001,5,1,1,1,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dtc->previous($date); $date = make_datetime(2001,2,1,1,1,0); dcomp($new, $date, "$desc prev"); $new = $dtc->previous($date); $date = make_datetime(2001,1,1,1,1,0); dcomp($new, $date, "$desc prev"); $new = $dtc->previous($date); $date = make_datetime(2000,12,1,1,1,0); dcomp($new, $date, "$desc prev"); # End test DateTime-Event-Cron-0.09/t/malformed.t0000644000175000017500000000406010641013006016205 0ustar sisksisk#!/usr/bin/perl -w use strict; use lib './lib'; use Test::More tests => 16; use DateTime; use DateTime::Event::Cron; my($dtc); # fail on sparse lines eval { $dtc = DateTime::Event::Cron->new('# commentary'); }; ok($@ ne '', 'reject comment line'); eval { $dtc = DateTime::Event::Cron->new('* * *'); }; ok($@ ne '', 'reject partial line'); eval { $dtc = DateTime::Event::Cron->new(''); }; ok($@ ne '', 'reject empty line'); eval { $dtc = DateTime::Event::Cron->new(undef); }; ok($@ ne '', 'reject undef'); # fail on environment variable lines from crontabs eval { $dtc = DateTime::Event::Cron->new('BUZZARDBAIT=$CHICKEN/plucked'); }; ok($@ ne '', 'reject environment variable line'); # fail on invalid lines with correct field counts eval { $dtc = DateTime::Event::Cron->new('hey exciting things * *'); }; ok($@ ne '', 'reject malformed entries'); eval { $dtc = DateTime::Event::Cron->new([qw(hey exciting things * *)]); }; ok($@ ne '', 'reject malformed entries as array ref'); # well-formed crontabs with invalid ranges eval { $dtc = DateTime::Event::Cron->new('69 * * * * /bin/bad'); }; ok($@ ne '', 'reject minute out of range'); eval { $dtc = DateTime::Event::Cron->new('* 24 * * * /bin/bad'); }; ok($@ ne '', 'reject hour out of range'); eval { $dtc = DateTime::Event::Cron->new('* * 77 * * /bin/bad'); }; ok($@ ne '', 'reject day out of range high'); eval { $dtc = DateTime::Event::Cron->new('* * 0 * * /bin/bad'); }; ok($@ ne '', 'reject day out of range low'); eval { $dtc = DateTime::Event::Cron->new('* * * 20 * /bin/bad'); }; ok($@ ne '', 'reject month out of range high'); eval { $dtc = DateTime::Event::Cron->new('* * * 0 * /bin/bad'); }; ok($@ ne '', 'reject month out of range low'); eval { $dtc = DateTime::Event::Cron->new('* * * * 11 /bin/bad'); }; ok($@ ne '', 'reject dow out of range'); eval { $dtc = DateTime::Event::Cron->new('* * 31 2,4,6,9,11 *'); }; ok($@ ne '', 'reject dom out of range for short months'); eval { $dtc = DateTime::Event::Cron->new('* * 30 2 *'); }; ok($@ ne '', 'reject dom out of range for feb'); # End of tests DateTime-Event-Cron-0.09/t/cron.t0000755000175000017500000002571311404236042015220 0ustar sisksisk#!/usr/bin/perl -w use strict; use lib './lib'; use Test::More tests => 86; use DateTime; use DateTime::Event::Cron; sub make_datetime { @_ == 6 or die "Invalid argument count\n"; DateTime->new( year => $_[0], month => $_[1], day => $_[2], hour => $_[3], minute => $_[4], second => $_[5], ); } sub dcomp { is(shift->datetime, shift->datetime, shift) } my($odate, $date, $new, $dts, $dtc, $dtd, $desc); # Next and previous, delta 60 secs or so. Explicit now() $dts = DateTime::Event::Cron->from_cron(cron => '* * * * *'); $desc = "delta span, explicit now"; $dtd = DateTime::Duration->new(seconds => 62); ok($dts, "$desc create"); $date = DateTime->now; $new = $dts->next($date); cmp_ok( ($new - $date)->seconds, '<', $dtd->seconds, "$desc next"); $new = $dts->previous($date); cmp_ok( ($date - $new)->seconds, '<', $dtd->seconds, "$desc prev"); # Next and previous, delta 60 secs or so. Implicit now() (not # possible using set methods so we go native) $desc = "delta span, implicit now"; $dtc = DateTime::Event::Cron->new_from_cron(cron => '* * * * *'); ok($dtc, "$desc create"); $date = DateTime->now; $new = $dtc->next(); cmp_ok( ($new - $date)->seconds, '<', $dtd->seconds, "$desc next"); $date = DateTime->now; $new = $dtc->previous(); cmp_ok( ($date - $new)->seconds, '<', $dtd->seconds, "$desc prev"); # cron on sunday once a week, 0-based dow $desc = 'every sunday, 0-based'; $dts = DateTime::Event::Cron->from_cron(cron => '12 21 * * 0'); ok($dts, "$desc create"); $odate = make_datetime(2002,9,9,15,10,0); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(2002,9,15,21,12,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2002,9,22,21,12,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2002,9,29,21,12,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(2002,9,8,21,12,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,9,1,21,12,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,8,25,21,12,0); dcomp($new, $date, "$desc prev"); # cron on sunday, once a week 7-based dow $desc = 'every sunday, 7-based'; $dts = DateTime::Event::Cron->from_cron(cron => '12 21 * * 7'); ok($dts, "$desc create"); $odate = make_datetime(2002,9,9,15,10,0); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(2002,9,15,21,12,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(2002,9,8,21,12,0); dcomp($new, $date, "$desc prev"); # cron twice a week on tuesdays and thursdays $desc = 'every tues/thurs'; $dts = DateTime::Event::Cron->from_cron(cron => '12 21 * * 2,4'); ok($dts, "$desc create"); $odate = make_datetime(2002,9,9,15,10,0); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(2002,9,10,21,12,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2002,9,12,21,12,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2002,9,17,21,12,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(2002,9,5,21,12,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,9,3,21,12,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,8,29,21,12,0); dcomp($new, $date, "$desc prev"); # job runs once a week on fridays and every 5 days $desc = 'every fri & 5 days'; $dts = DateTime::Event::Cron->from_cron(cron => '30 10 */5 * 5'); ok($dts, "$desc create"); $odate = make_datetime(2002,9,9,5,10,0); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(2002,9,11,10,30,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2002,9,13,10,30,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2002,9,16,10,30,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2002,9,20,10,30,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2002,9,21,10,30,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(2002,9,6,10,30,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,9,1,10,30,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,8,31,10,30,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,8,30,10,30,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,8,26,10,30,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(2002,8,23,10,30,0); dcomp($new, $date, "$desc prev"); # cron every hour $desc = 'every hour'; $dts = DateTime::Event::Cron->from_cron(cron => '42 * * * *'); ok($dts, "$desc create"); $odate = make_datetime(1987,6,21,9,51,0); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(1987,6,21,10,42,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1987,6,21,11,42,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1987,6,21,12,42,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(1987,6,21,9,42,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1987,6,21,8,42,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1987,6,21,7,42,0); dcomp($new, $date, "$desc prev"); # cron on assorted hours $desc = "assorted hours"; $dts = DateTime::Event::Cron->from_cron(cron => '42 13,15,22,23 * * *'); ok($dts, "$desc create"); $odate = make_datetime(1987,6,21,17,51,0); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(1987,6,21,22,42,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1987,6,21,23,42,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1987,6,22,13,42,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(1987,6,21,15,42,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1987,6,21,13,42,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1987,6,20,23,42,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1987,6,20,22,42,0); dcomp($new, $date, "$desc prev"); # cron every minute of 5pm $desc = "every minute of 5pm"; $dts = DateTime::Event::Cron->from_cron(cron => '* 17 * * *'); ok($dts, "$desc create"); $odate = make_datetime(1987,6,21,17,57,59); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(1987,6,21,17,58,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1987,6,21,17,59,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1987,6,22,17,0,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(1987,6,21,17,57,0); dcomp($new, $date, "$desc prev"); # cron on assorted minutes $desc = "assorted minutes"; $dts = DateTime::Event::Cron->from_cron(cron => '2,32 * * * *'); ok($dts, "$desc create"); $odate = make_datetime(1987,6,21,17,57,59); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(1987,6,21,18,2,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1987,6,21,18,32,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1987,6,21,19,2,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(1987,6,21,17,32,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1987,6,21,17,2,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1987,6,21,16,32,0); dcomp($new, $date, "$desc prev"); # cron after 1:20am on saturday 26th October, 1985 # on sundays and tuesdays, or on the 11th, in March and November. # every 37 minutes past 7pm $desc = '*/37 19 11 3,11 0,2'; $dts = DateTime::Event::Cron->from_cron(cron => $desc); ok($dts, "$desc create"); $odate = make_datetime(1985,10,26,1,20,0); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(1985,11,3,19,0,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1985,11,3,19,37,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1985,11,5,19,0,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1985,11,5,19,37,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1985,11,10,19,0,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1985,11,10,19,37,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1985,11,11,19,0,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1985,11,11,19,37,0); dcomp($new, $date, "$desc next"); for (1..10) { # skip nov 12, 17, 19, 24, 26 $date = $dts->next($date); } $new = $dts->next($date); $date = make_datetime(1986,3,2,19,0,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1986,3,2,19,37,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1986,3,4,19,0,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(1986,3,4,19,37,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(1985,3,31,19,37,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1985,3,31,19,0,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1985,3,26,19,37,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1985,3,26,19,0,0); dcomp($new, $date, "$desc prev"); # a very infrequent cron job $desc = "infrequent"; $dts = DateTime::Event::Cron->from_cron(cron => '0 13 29 2 *'); ok($dts, "$desc create"); $odate = make_datetime(1995,4,12,5,30,0); $date = $odate->clone; $new = $dts->next($date); $date = make_datetime(1996,2,29,13,0,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2000,2,29,13,0,0); dcomp($new, $date, "$desc next"); $new = $dts->next($date); $date = make_datetime(2004,2,29,13,0,0); dcomp($new, $date, "$desc next"); $date = $odate->clone; $new = $dts->previous($date); $date = make_datetime(1992,2,29,13,0,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1988,2,29,13,0,0); dcomp($new, $date, "$desc prev"); $new = $dts->previous($date); $date = make_datetime(1984,2,29,13,0,0); dcomp($new, $date, "$desc prev"); # End of tests DateTime-Event-Cron-0.09/MANIFEST0000644000175000017500000000046513071505457014765 0ustar sisksisklib/DateTime/Event/Cron.pm Changes Makefile.PL MANIFEST README t/basic.t t/cascade.t t/cron.t t/crontab.t t/dst.t t/leapyear.t t/malformed.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) DateTime-Event-Cron-0.09/lib/0000755000175000017500000000000013071505457014375 5ustar sisksiskDateTime-Event-Cron-0.09/lib/DateTime/0000755000175000017500000000000013071505457016071 5ustar sisksiskDateTime-Event-Cron-0.09/lib/DateTime/Event/0000755000175000017500000000000013071505457017152 5ustar sisksiskDateTime-Event-Cron-0.09/lib/DateTime/Event/Cron.pm0000644000175000017500000006112413071505257020413 0ustar sisksiskpackage DateTime::Event::Cron; use 5.006; use strict; use warnings; use Carp; use vars qw($VERSION); $VERSION = '0.09'; use constant DEBUG => 0; use DateTime; use DateTime::Set; use DateTime::Duration; use Set::Crontab; my %Object_Attributes; ### sub from_cron { # Return cron as DateTime::Set my $class = shift; my %sparms = @_ == 1 ? (cron => shift) : @_; my %parms; $parms{cron} = delete $sparms{cron}; $parms{user_mode} = delete $sparms{user_mode}; $parms{cron} or croak "Cron string parameter required.\n"; my $dtc = $class->new(%parms); $dtc->as_set(%sparms); } sub from_crontab { # Return list of DateTime::Sets based on entries from # a crontab file. my $class = shift; my %sparms = @_ == 1 ? (file => shift) : @_; my $file = delete $sparms{file}; delete $sparms{cron}; my $fh = $class->_prepare_fh($file); my @cronsets; while (<$fh>) { chomp; my $set; eval { $set = $class->from_cron(%sparms, cron => $_) }; push(@cronsets, $set) if ref $set && !$@; } @cronsets; } sub as_set { # Return self as DateTime::Set my $self = shift; my %sparms = @_; Carp::cluck "Recurrence callbacks overriden by ". ref $self . "\n" if $sparms{next} || $sparms{recurrence} || $sparms{previous}; delete $sparms{next}; delete $sparms{previous}; delete $sparms{recurrence}; $sparms{next} = sub { $self->next(@_) }; $sparms{previous} = sub { $self->previous(@_) }; DateTime::Set->from_recurrence(%sparms); } ### sub new { my $class = shift; my $self = {}; bless $self, $class; my %parms = @_ == 1 ? (cron => shift) : @_; my $crontab = $self->_make_cronset(%parms); $self->_cronset($crontab); $self; } sub new_from_cron { new(@_) } sub new_from_crontab { my $class = shift; my %parms = @_ == 1 ? (file => shift()) : @_; my $fh = $class->_prepare_fh($parms{file}); delete $parms{file}; my @dtcrons; while (<$fh>) { my $dtc; eval { $dtc = $class->new(%parms, cron => $_) }; if (ref $dtc && !$@) { push(@dtcrons, $dtc); $parms{user_mode} = 1 if defined $dtc->user; } } @dtcrons; } ### sub _prepare_fh { my $class = shift; my $fh = shift; if (! ref $fh) { my $file = $fh; local(*FH); $fh = do { local *FH; *FH }; # doubled *FH avoids warning open($fh, "<$file") or croak "Error opening $file for reading\n"; } $fh; } ### sub valid { # Is the given date valid according the current cron settings? my($self, $date) = @_; return if !$date || $date->second; $self->minute->contains($date->minute) && $self->hour->contains($date->hour) && $self->days_contain($date->day, $date->dow) && $self->month->contains($date->month); } sub match { # Does the given date match the cron spec? my($self, $date) = @_; $date = DateTime->now unless $date; $self->minute->contains($date->minute) && $self->hour->contains($date->hour) && $self->days_contain($date->day, $date->dow) && $self->month->contains($date->month); } ### Return adjacent dates without altering original date sub next { my($self, $date) = @_; $self->increment($date || DateTime->now); } sub previous { my($self, $date) = @_; $self->decrement($date || DateTime->now); } ### Change given date to adjacent dates sub increment { my($self, $date) = @_; $date = $date ? $date->clone : DateTime->now; return $date if $date->is_infinite; do { $self->_attempt_increment($date); } until $self->valid($date); $date; } sub decrement { my($self, $date) = @_; $date = $date ? $date->clone : DateTime->now; return $date if $date->is_infinite; do { $self->_attempt_decrement($date); } until $self->valid($date); $date; } ### sub _attempt_increment { my($self, $date) = @_; ref $date or croak "Reference to datetime object reqired\n"; $self->valid($date) ? $self->_valid_incr($date) : $self->_invalid_incr($date); } sub _attempt_decrement { my($self, $date) = @_; ref $date or croak "Reference to datetime object reqired\n"; $self->valid($date) ? $self->_valid_decr($date) : $self->_invalid_decr($date); } sub _valid_incr { shift->_incr(@_) } sub _valid_decr { shift->_decr(@_) } sub _invalid_incr { # If provided date is valid, return it. Otherwise return # nearest valid date after provided date. my($self, $date) = @_; ref $date or croak "Reference to datetime object reqired\n"; print STDERR "\nI GOT: ", $date->datetime, "\n" if DEBUG; $date->truncate(to => 'minute')->add(minutes => 1) if $date->second; print STDERR "RND: ", $date->datetime, "\n" if DEBUG; # Find our greatest invalid unit and clip if (!$self->month->contains($date->month)) { $date->truncate(to => 'month'); } elsif (!$self->days_contain($date->day, $date->dow)) { $date->truncate(to => 'day'); } elsif (!$self->hour->contains($date->hour)) { $date->truncate(to => 'hour'); } else { $date->truncate(to => 'minute'); } print STDERR "BBT: ", $date->datetime, "\n" if DEBUG; return $date if $self->valid($date); print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG; # Extraneous durations clipped. Start searching. while (!$self->valid($date)) { $date->add(months => 1) until $self->month->contains($date->month); print STDERR "MON: ", $date->datetime, "\n" if DEBUG; my $day_orig = $date->day; $date->add(days => 1) until $self->days_contain($date->day, $date->dow); $date->truncate(to => 'month') && next if $date->day < $day_orig; print STDERR "DAY: ", $date->datetime, "\n" if DEBUG; my $hour_orig = $date->hour; $date->add(hours => 1) until $self->hour->contains($date->hour); $date->truncate(to => 'day') && next if $date->hour < $hour_orig; print STDERR "HOR: ", $date->datetime, "\n" if DEBUG; my $min_orig = $date->minute; $date->add(minutes => 1) until $self->minute->contains($date->minute); $date->truncate(to => 'hour') && next if $date->minute < $min_orig; print STDERR "MIN: ", $date->datetime, "\n" if DEBUG; } print STDERR "SET: ", $date->datetime, "\n" if DEBUG; $date; } sub _invalid_decr { # If provided date is valid, return it. Otherwise # return the nearest previous valid date. my($self, $date) = @_; ref $date or croak "Reference to datetime object reqired\n"; print STDERR "\nD GOT: ", $date->datetime, "\n" if DEBUG; if (!$self->month->contains($date->month)) { $date->truncate(to => 'month'); } elsif (!$self->days_contain($date->day, $date->dow)) { $date->truncate(to => 'day'); } elsif (!$self->hour->contains($date->hour)) { $date->truncate(to => 'hour'); } else { $date->truncate(to => 'minute'); } print STDERR "BBT: ", $date->datetime, "\n" if DEBUG; return $date if $self->valid($date); print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG; # Extraneous durations clipped. Start searching. while (!$self->valid($date)) { if (!$self->month->contains($date->month)) { $date->subtract(months => 1) until $self->month->contains($date->month); $self->_unit_peak($date, 'month'); print STDERR "MON: ", $date->datetime, "\n" if DEBUG; } if (!$self->days_contain($date->day, $date->dow)) { my $day_orig = $date->day; $date->subtract(days => 1) until $self->days_contain($date->day, $date->dow); $self->_unit_peak($date, 'month') && next if ($date->day > $day_orig); $self->_unit_peak($date, 'day'); print STDERR "DAY: ", $date->datetime, "\n" if DEBUG; } if (!$self->hour->contains($date->hour)) { my $hour_orig = $date->hour; $date->subtract(hours => 1) until $self->hour->contains($date->hour); $self->_unit_peak($date, 'day') && next if ($date->hour > $hour_orig); $self->_unit_peak($date, 'hour'); print STDERR "HOR: ", $date->datetime, "\n" if DEBUG; } if (!$self->minute->contains($date->minute)) { my $min_orig = $date->minute; $date->subtract(minutes => 1) until $self->minute->contains($date->minute); $self->_unit_peak($date, 'hour') && next if ($date->minute > $min_orig); print STDERR "MIN: ", $date->datetime, "\n" if DEBUG; } } print STDERR "SET: ", $date->datetime, "\n" if DEBUG; $date; } ### sub _unit_peak { my($self, $date, $unit) = @_; $date && $unit or croak "DateTime ref and unit required.\n"; $date->truncate(to => $unit) ->add($unit . 's' => 1) ->subtract(minutes => 1); } sub _next_day { my($self, $year, $mon, $day) = @_; my $dt = DateTime->new(year => $year, month => $mon, day => $day); my $dur = DateTime::Duration->new(days => 1); $dt->add_duration($dur); while (! $self->days_contain($dt->day, $dt->day_of_week)) { $dt->add_duration($dur); } $dt->day; } sub _prev_day { my($self, $year, $mon, $day) = @_; my $dt = DateTime->new(year => $year, month => $mon, day => $day); my $dur = DateTime::Duration->new(days => 1); $dt->subtract_duration($dur); while (! $self->days_contain($dt->day, $dt->day_of_week)) { $dt->subtract_duration($dur); } $dt->day; } ### Unit cascades sub _incr { my($self, $date) = @_; my $last_min = $date->minute; my $last_hour = $date->hour; my $last_day = $date->day; my $last_month = $date->month; my $year = $date->year; my($next_min, $next_hour, $next_day, $next_month) = ($last_min, $last_hour, $last_day, $last_month); while (1) { $next_min = $self->minute->next($last_min); if ($next_min <= $last_min) { $next_hour = $self->hour->next($last_hour); if ($next_hour <= $last_hour) { eval { $next_day = $self->_next_day($year, $last_month, $last_day) }; if ($next_day <= $last_day || $@) { $next_month = $self->month->next($last_month); if ($next_month <= $last_month) { $year += 1; } $last_month = $next_month; } $last_day = $next_day; } $last_hour = $next_hour; } $last_min = $next_min; eval { $date->set( minute => $next_min, hour => $next_hour, day => $next_day, month => $next_month, year => $year, ); }; last unless $@; } $date; } sub _decr { my($self, $date) = @_; my $last_min = $date->minute; my $last_hour = $date->hour; my $last_day = $date->day; my $last_month = $date->month; my $year = $date->year; my($prev_min, $prev_hour, $prev_day, $prev_month) = ($last_min, $last_hour, $last_day, $last_month); while (1) { $prev_min = $self->minute->previous($last_min); if ($prev_min >= $last_min) { $prev_hour = $self->hour->previous($last_hour); if ($prev_hour >= $last_hour) { eval { $prev_day = $self->_prev_day($year, $last_month, $last_day) }; if ($prev_day >= $last_day || $@) { $prev_month = $self->month->previous($last_month); if ($prev_month >= $last_month) { $year -= 1; } $last_month = $prev_month; } $last_day = $prev_day; } $last_hour = $prev_hour; } $last_min = $prev_min; eval { $date->set( minute => $prev_min, hour => $prev_hour, day => $prev_day, month => $prev_month, year => $year, ); }; last unless $@; } $date; } ### Factories sub _make_cronset { shift; DateTime::Event::Cron::IntegratedSet->new(@_) } ### Shortcuts sub days_contain { shift->_cronset->days_contain(@_) } sub minute { shift->_cronset->minute } sub hour { shift->_cronset->hour } sub dom { shift->_cronset->dom } sub month { shift->_cronset->month } sub dow { shift->_cronset->dow } sub user { shift->_cronset->user } sub command { shift->_cronset->command } sub original { shift->_cronset->original } ### Static acessors/mutators sub _cronset { shift->_attr('cronset', @_) } sub _attr { my $self = shift; my $name = shift; if (@_) { $Object_Attributes{$self}{$name} = shift; } $Object_Attributes{$self}{$name}; } ### debugging sub _dump_sets { my($self, $date) = @_; foreach (qw(minute hour dom month dow)) { print STDERR "$_: ", join(',',$self->$_->list), "\n"; } if (ref $date) { $date = $date->clone; my @mod; my $mon = $date->month; $date->truncate(to => 'month'); while ($date->month == $mon) { push(@mod, $date->day) if $self->days_contain($date->day, $date->dow); $date->add(days => 1); } print STDERR "mod for month($mon): ", join(',', @mod), "\n"; } print STDERR "day_squelch: ", $self->_cronset->day_squelch, " ", "dow_squelch: ", $self->_cronset->dow_squelch, "\n"; $self; } ### sub DESTROY { delete $Object_Attributes{shift()} } ########## { package DateTime::Event::Cron::IntegratedSet; # IntegratedSet manages the collection of field sets for # each cron entry, including sanity checks. Individual # field sets are accessed through their respective names, # i.e., minute hour dom month dow. # # Also implements some merged field logic for dom/dow # interactions. use strict; use Carp; my %Range = ( minute => [0..59], hour => [0..23], dom => [1..31], month => [1..12], dow => [1..7], ); my @Month_Max = qw( 31 29 31 30 31 30 31 31 30 31 30 31 ); my %Object_Attributes; sub new { my $self = []; bless $self, shift; $self->_range(\%Range); $self->set_cron(@_); $self; } sub set_cron { # Initialize my $self = shift; my %parms = @_; my $cron = $parms{cron}; my $user_mode = $parms{user_mode}; defined $cron or croak "Cron entry fields required\n"; $self->_attr('original', $cron); my @line; if (ref $cron) { @line = grep(!/^\s*$/, @$cron); } else { $cron =~ s/^\s+//; $cron =~ s/\s+$//; @line = split(/\s+/, $cron); } @line >= 5 or croak "At least five cron entry fields required.\n"; my @entry = splice(@line, 0, 5); my($user, $command); unless (defined $user_mode) { # auto-detect if (@line > 1 && $line[0] =~ /^\w+$/) { $user_mode = 1; } } $user = shift @line if $user_mode; $command = join(' ', @line); $self->_attr('command', $command); $self->_attr('user', $user); my $i = 0; foreach my $name (qw( minute hour dom month dow )) { $self->_attr($name, $self->make_valid_set($name, $entry[$i])); ++$i; } my @dom_list = $self->dom->list; my @dow_list = $self->dow->list; my $dom_range = $self->range('dom'); my $dow_range = $self->range('dow'); $self->dom_squelch(scalar @dom_list == scalar @$dom_range && scalar @dow_list != scalar @$dow_range ? 1 : 0); $self->dow_squelch(scalar @dow_list == scalar @$dow_range && scalar @dom_list != scalar @$dom_range ? 1 : 0); unless ($self->dom_squelch) { my @doms = $self->dom->list; my $pass = 0; MONTH: foreach my $month ($self->month->list) { foreach (@doms) { ++$pass && last MONTH if $_ <= $Month_Max[$month - 1]; } } croak "Impossible last day for provided months.\n" unless $pass; } $self; } # Field range queries sub range { my($self, $name) = @_; my $val = $self->_range->{$name} or croak "Unknown field '$name'\n"; $val; } # Perform sanity checks when setting up each field set. sub make_valid_set { my($self, $name, $str) = @_; my $range = $self->range($name); my $set = $self->make_set($str, $range); my @list = $set->list; croak "Malformed cron field '$str'\n" unless @list; croak "Field value ($list[-1]) out of range ($range->[0]-$range->[-1])\n" if $list[-1] > $range->[-1]; if ($name eq 'dow' && $set->contains(0)) { shift(@list); push(@list, 7) unless $set->contains(7); $set = $self->make_set(join(',',@list), $range); } croak "Field value ($list[0]) out of range ($range->[0]-$range->[-1])\n" if $list[0] < $range->[0]; $set; } # No sanity checks sub make_set { shift; DateTime::Event::Cron::OrderedSet->new(@_) } # Flags for when dom/dow are applied. sub dom_squelch { shift->_attr('dom_squelch', @_ ) } sub dow_squelch { shift->_attr('dow_squelch', @_ ) } # Merged logic for dom/dow sub days_contain { my($self, $dom, $dow) = @_; defined $dom && defined $dow or croak "Day of month and day of week required.\n"; my $dom_c = $self->dom->contains($dom); my $dow_c = $self->dow->contains($dow); return $dow_c if $self->dom_squelch; return $dom_c if $self->dow_squelch; $dom_c || $dow_c; } # Set Accessors sub minute { shift->_attr('minute' ) } sub hour { shift->_attr('hour' ) } sub dom { shift->_attr('dom' ) } sub month { shift->_attr('month' ) } sub dow { shift->_attr('dow' ) } sub user { shift->_attr('user' ) } sub command { shift->_attr('command') } sub original { shift->_attr('original') } # Accessors/mutators sub _range { shift->_attr('range', @_) } sub _attr { my $self = shift; my $name = shift; if (@_) { $Object_Attributes{$self}{$name} = shift; } $Object_Attributes{$self}{$name}; } sub DESTROY { delete $Object_Attributes{shift()} } } ########## { package DateTime::Event::Cron::OrderedSet; # Extends Set::Crontab with some progression logic (next/prev) use strict; use Carp; use base 'Set::Crontab'; my %Object_Attributes; sub new { my $class = shift; my($string, $range) = @_; defined $string && ref $range or croak "Cron field and range ref required.\n"; my $self = Set::Crontab->new($string, $range); bless $self, $class; my @list = $self->list; my(%next, %prev); foreach (0 .. $#list) { $next{$list[$_]} = $list[($_+1)%@list]; $prev{$list[$_]} = $list[($_-1)%@list]; } $self->_attr('next', \%next); $self->_attr('previous', \%prev); $self; } sub next { my($self, $entry) = @_; my $hash = $self->_attr('next'); croak "Missing entry($entry) in set\n" unless exists $hash->{$entry}; my $next = $hash->{$entry}; wantarray ? ($next, $next <= $entry) : $next; } sub previous { my($self, $entry) = @_; my $hash = $self->_attr('previous'); croak "Missing entry($entry) in set\n" unless exists $hash->{$entry}; my $prev = $hash->{$entry}; wantarray ? ($prev, $prev >= $entry) : $prev; } sub _attr { my $self = shift; my $name = shift; if (@_) { $Object_Attributes{$self}{$name} = shift; } $Object_Attributes{$self}{$name}; } sub DESTROY { delete $Object_Attributes{shift()} } } ### 1; __END__ =head1 NAME DateTime::Event::Cron - DateTime extension for generating recurrence sets from crontab lines and files. =head1 SYNOPSIS use DateTime::Event::Cron; # check if a date matches (defaults to current time) my $c = DateTime::Event::Cron->new('* 2 * * *'); if ($c->match) { # do stuff } if ($c->match($date)) { # do something else for datetime $date } # DateTime::Set construction from crontab line $crontab = '*/3 15 1-10 3,4,5 */2'; $set = DateTime::Event::Cron->from_cron($crontab); $iter = $set->iterator(after => DateTime->now); while (1) { my $next = $iter->next; my $now = DateTime->now; sleep(($next->subtract_datetime_absolute($now))->seconds); # do stuff... } # List of DateTime::Set objects from crontab file @sets = DateTime::Event::Cron->from_crontab(file => '/etc/crontab'); $now = DateTime->now; print "Now: ", $now->datetime, "\n"; foreach (@sets) { my $next = $_->next($now); print $next->datetime, "\n"; } # DateTime::Set parameters $crontab = '* * * * *'; $now = DateTime->now; %set_parms = ( after => $now ); $set = DateTime::Event::Cron->from_cron(cron => $crontab, %set_parms); $dt = $set->next; print "Now: ", $now->datetime, " and next: ", $dt->datetime, "\n"; # Spans for DateTime::Set $crontab = '* * * * *'; $now = DateTime->now; $now2 = $now->clone; $span = DateTime::Span->from_datetimes( start => $now->add(minutes => 1), end => $now2->add(hours => 1), ); %parms = (cron => $crontab, span => $span); $set = DateTime::Event::Cron->from_cron(%parms); # ...do things with the DateTime::Set # Every RTFCT relative to 12am Jan 1st this year $crontab = '7-10 6,12-15 10-28/2 */3 3,4,5'; $date = DateTime->now->truncate(to => 'year'); $set = DateTime::Event::Cron->from_cron(cron => $crontab, after => $date); # Rather than generating DateTime::Set objects, next/prev # calculations can be made directly: # Every day at 10am, 2pm, and 6pm. Reference date # defaults to DateTime->now. $crontab = '10,14,18 * * * *'; $dtc = DateTime::Event::Cron->new_from_cron(cron => $crontab); $next_datetime = $dtc->next; $last_datetime = $dtc->previous; ... # List of DateTime::Event::Cron objects from # crontab file @dtc = DateTime::Event::Cron->new_from_crontab(file => '/etc/crontab'); # Full cron lines with user, such as from /etc/crontab # or files in /etc/cron.d, are supported and auto-detected: $crontab = '* * * * * gump /bin/date'; $dtc = DateTime::Event::Cron->new(cron => $crontab); # Auto-detection of users is disabled if you explicitly # enable/disable via the user_mode parameter: $dtc = DateTime::Event::Cron->new(cron => $crontab, user_mode => 1); my $user = $dtc->user; my $command = $dtc->command; # Unparsed original cron entry my $original = $dtc->original; =head1 DESCRIPTION DateTime::Event::Cron generated DateTime events or DateTime::Set objects based on crontab-style entries. =head1 METHODS The cron fields are typical crontab-style entries. For more information, see L and extensions described in L. The fields can be passed as a single string or as a reference to an array containing each field. Only the first five fields are retained. =head2 DateTime::Set Factories See L for methods provided by Set objects, such as C and C. =over 4 =item from_cron($cronline) =item from_cron(cron => $cronline, %parms, %set_parms) Generates a DateTime::Set recurrence for the cron line provided. See new() for details on %parms. Optionally takes parameters for DateTime::Set. =item from_crontab(file => $crontab_fh, %parms, %set_parms) Returns a list of DateTime::Set recurrences based on lines from a crontab file. C<$crontab_fh> can be either a filename or filehandle reference. See new() for details on %parm. Optionally takes parameters for DateTime::Set which will be passed along to each set for each line. =item as_set(%set_parms) Generates a DateTime::Set recurrence from an existing DateTime::Event::Cron object. =back =head2 Constructors =over 4 =item new_from_cron(cron => $cronstring, %parms) Returns a DateTime::Event::Cron object based on the cron specification. Optional parameters include the boolean 'user_mode' which indicates that the crontab entry includes a username column before the command. =item new_from_crontab(file => $fh, %parms) Returns a list of DateTime::Event::Cron objects based on the lines of a crontab file. C<$fh> can be either a filename or a filehandle reference. Optional parameters include the boolean 'user_mode' as mentioned above. =back =head2 Other methods =over 4 =item next() =item next($date) Returns the next valid datetime according to the cron specification. C<$date> defaults to DateTime->now unless provided. =item previous() =item previous($date) Returns the previous valid datetime according to the cron specification. C<$date> defaults to DateTime->now unless provided. =item increment($date) =item decrement($date) Same as C and C except that the provided datetime is modified to the new datetime. =item match($date) Returns whether or not the given datetime (defaults to current time) matches the current cron specification. Dates are truncated to minute resolution. =item valid($date) A more strict version of match(). Returns whether the given datetime is valid under the current cron specification. Cron dates are only accurate to the minute -- datetimes with seconds greater than 0 are invalid by default. (note: never fear, all methods accepting dates will accept invalid dates -- they will simply be rounded to the next nearest valid date in all cases except this particular method) =item command() Returns the command string, if any, from the original crontab entry. Currently no expansion is performed such as resolving environment variables, etc. =item user() Returns the username under which this cron command was to be executed, assuming such a field was present in the original cron entry. =item original() Returns the original, unparsed cron string including any user or command fields. =back =head1 AUTHOR Matthew P. Sisk Esisk@mojotoad.comE =head1 COPYRIGHT Copyright (c) 2003 Matthew P. Sisk. All rights reserved. All wrongs revenged. This program is free software; you can distribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO DateTime(3), DateTime::Set(3), DateTime::Event::Recurrence(3), DateTime::Event::ICal(3), DateTime::Span(3), Set::Crontab(3), crontab(5) =cut