Schedule-Cron-1.05/0000755000175000001440000000000014375560071012411 5ustar _73usersSchedule-Cron-1.05/t/0000755000175000001440000000000014375560071012654 5ustar _73usersSchedule-Cron-1.05/t/after_job.t0000644000175000001440000000122314317716316014773 0ustar _73users#!/usr/bin/perl # Test for after_job callbak use Test::More tests => 3; use Schedule::Cron; use strict; my $count = 0; my $cron =new Schedule::Cron(\&dispatch,{nofork => 1,after_job => \&after_callback}); $cron->add_entry("* * * * * 0-59/1",{args => [ "eins", "zwei"]}); eval { $cron->run(); }; is($@,"e1\n","Second call must finish test"); sub dispatch { my @args; if ($count == 0) { $count = 1; return "t1"; } elsif ($count == 1) { die "e1\n"; } } sub after_callback { my ($ret,@args) = @_; is($ret,"t1","Return value must match"); is_deeply(\@args,["eins","zwei" ],"Arguments must match"); } Schedule-Cron-1.05/t/startup.t0000644000175000001440000000106014317716316014541 0ustar _73users#!perl -w # Startup Test: # $Id: startup.t,v 1.7 2006/11/27 13:42:52 roland Exp $ use Schedule::Cron; use Test::More tests => 1; our %SKIP; $| = 1; #print STDERR " (may take a minute) "; SKIP: { eval { alarm 0 }; skip "alarm() not available", 1 if $@; $SIG{QUIT} = sub { alarm(0); pass; exit; }; $SIG{ALRM} = sub { fail; exit; }; $cron = new Schedule::Cron(sub { kill QUIT, shift; alarm 1; }); $cron->add_entry("* * * * * */2",$$); alarm(6); $cron->run; } Schedule-Cron-1.05/t/pretty_print_args.t0000644000175000001440000000062014317716316016617 0ustar _73users#!/usr/bin/perl use Test::More tests => 1; use Schedule::Cron; use strict; my @args = ( [ "bla", "blub", { "deeper" => 1, "and" => {deeper => "stop" } } ], 3, { "blub" => "bla", 3 => 2 } ); my $out = join(",",Schedule::Cron->_format_args(@args)); like($out,qr/\['bla','blub',\{.*?'and'\s*=>\s*'HASH\(.*?\)'.*?}\],3,\{.*?'blub'\s*=>\s*'bla'.*?}/); Schedule-Cron-1.05/t/entry.t0000644000175000001440000000473614317716316014215 0ustar _73users#!/usr/bin/perl # # Test management methods for adding/deleting/updating entries use Test::More tests => 19; use Schedule::Cron; use Data::Dumper; use strict; my $dispatcher = sub { print "Dispatcher\n"}; my $special_dispatch = sub { print "Special Dispatcher\n"}; my $cron = new Schedule::Cron($dispatcher); eval { $cron->add_entry("*"); }; ok($@," invalid add arguments: $@"); eval { $cron->add_entry("* * * * *",{'subroutine' => \&dispatch, 'arguments' => [ "first",2,"third" ], 'eval' => 1}); }; ok($@," invalid add arguments: $@"); # get my $timespec = "5 * * * *"; $cron->add_entry($timespec,"doit"); ok (scalar($cron->list_entries()) == 1,"3 list entries"); my $entry = $cron->get_entry(0); ok ($entry->{time} eq $timespec,"entry 0 timespec"); ok ($entry->{dispatcher} eq $dispatcher,"entry 0 dispatcher"); ok ($entry->{args}->[0] eq "doit","entry 0 args"); ok (!defined($cron->get_entry(2)),"entry: invalid index"); # Add two extras $cron->add_entry($timespec,$special_dispatch); my $timespec3 = "* * * * * */2"; $cron->add_entry($timespec3,"yet","some","arguments"); ok (scalar($cron->list_entries()) == 3,"3 list entries"); ok ($cron->get_entry(1)->{dispatcher} eq $special_dispatch,"entry 1 dispatcher"); my $args_2 = [ 10,12,13 ]; my $timespec_2 = "12 13 7 7 *"; my $old_entry = $cron->update_entry(1,{time => $timespec_2,args => $args_2}); # Update ok ($old_entry->{time} eq $timespec && $old_entry->{dispatcher} == $special_dispatch && @{$old_entry->{args}} == 0, "update: old entry"); $entry = $cron->get_entry(1); ok ($entry->{time} eq $timespec_2 && $entry->{dispatcher} eq $dispatcher, "update: new entry"); ok ($entry->{args} != $args_2,"update: deep copy"); ok (scalar(grep { $args_2->[$_] == $entry->{args}->[$_] } (0,1,2)) == 3,"update: deep copy 2"); # Delete $old_entry = $cron->delete_entry(1); ok ($old_entry->{time} eq $timespec_2 && $entry->{dispatcher} eq $dispatcher,"delete: old entry"); ok (scalar($cron->list_entries) == 2,"delete: nr. entries"); $entry = $cron->get_entry(1); ok ($entry->{time} eq $timespec3 && $entry->{dispatcher} == $dispatcher && $entry->{args}->[1] eq "some","delete: splicing"); $old_entry = $cron->delete_entry(0); ok ($old_entry->{time} eq $timespec && $entry->{dispatcher} eq $dispatcher,"delete: old entry (2)"); ok (scalar($cron->list_entries) == 1,"delete: nr. entries"); # Clean all $cron->clean_timetable; ok (scalar($cron->list_entries) == 0,"clean"); Schedule-Cron-1.05/t/dst_back.t0000644000175000001440000000174214317716316014620 0ustar _73users#!perl -w use strict; use warnings; use Test::More; use Schedule::Cron; plan tests => 3; my %available = (); my @refs = ( [ "MET", 1256432100, 1256436000], [ "Europe/Berlin", 1256432100, 1256436000], [ "PST8PDT", 1257065700, 1257062400] ); # First check for timezones available: no warnings; $ENV{TZ} = undef; my $tt = time; my $local = scalar(localtime($tt)); for my $r (@refs) { my $tz = $r->[0]; $ENV{TZ} = $tz; my $calc = scalar(localtime($tt)); #print "C: $calc L: $local\n"; $available{$tz} = 1 if $calc ne $local; } my $cron = new Schedule::Cron(sub { }); for my $r (@refs) { my $tz = $r->[0]; if (!$available{$tz}) { ok(1,"Timezone $tz not available"); next; } $ENV{TZ} = $tz; my $next = $cron->get_next_execution_time("0-59/5 * * * *",$r->[1]); is($next,$r->[2],"Expected time for $tz ( Ref: " . scalar(localtime($r->[1])) . ", Calc: " . scalar(localtime($next))); } Schedule-Cron-1.05/t/nofork.t0000644000175000001440000000400014317716316014332 0ustar _73users#!perl -w # Check no-fork option: use Test::More tests => 5; use Schedule::Cron; $| = 1; # Simple no fork execution my $toggle = 0; my $count = 0; my $dispatch_1 = sub { print "# Job 1.1\n"; $toggle = 1; }; my $dispatch_2 = sub { print "# Job 1.2\n"; if ($toggle) { pass("Simple nofork - Second Job finished"); die "ok\n"; } $count++; fail("Job 1 has not run") if $count == 2; sleep 2; }; my $cron = new Schedule::Cron($dispatch_1,{nofork => 1}); $cron->add_entry("* * * * * *",$dispatch_2); $cron->add_entry("* * * * * *"); eval { $cron->run(); }; my $error = $@; chomp $error; ok($error eq "ok","Simple nofork - Cron has been run: $error"); # No fork with 'skip' option $count = 0; $dispatch_1 = sub { print "# Job 2.1 ",scalar(localtime),"\n"; if ($count == 1) { pass("Nofork with skip - Skip test passed"); die "ok\n"; } $count++; sleep(3); sleep(1) if ((localtime)[0] % 3 == 0); }; $dispatch_2 = sub { print "# Job 2.2 ",scalar(localtime),"\n"; die "Job 2.2 should never run\n"; }; $cron = new Schedule::Cron($dispatch_1,{nofork => 1,log => sub {print "# ",$_[1],"\n"}}); $cron->add_entry("* * * * * *"); $cron->add_entry("* * * * * */3",$dispatch_2); eval { $cron->run(skip => 1); }; $error = $@; chomp $error; ok($error eq "ok","Nofork with skip - Cron has been run: $error"); # No-Fork with 'catch' option. $count = 0; SKIP: { eval { alarm 0 }; skip "alarm() not available", 1 if $@; $dispatch_1 = sub { $count++; die "Exception"; }; $SIG{ALRM} = sub { ok($count > 0,"Nofork with skip - Job has run"); exit; }; $cron = new Schedule::Cron($dispatch_1,{nofork => 1,log => sub {print "# ",$_[1],"\n"}}); $cron->add_entry("* * * * * *"); eval { alarm(3); $cron->run(catch => 1); }; ok(!$@,"Nofork with skip - Job has died: $@"); } Schedule-Cron-1.05/t/test.crontab0000644000175000001440000000620014317716316015204 0ustar _73users# Minutes: # ======== * * * * * qw(20:15 27/12/1999 Monday) 20 * * * * qw(20:20 27/12/1999 Monday) 10-50 * * * * qw(20:15 27/12/1999 Monday) 13-30/4 * * * * qw(20:17 27/12/1999 Monday) 10 * * * * qw(21:10 27/12/1999 Monday) 18,20 * * * * qw(20:18 27/12/1999 Monday) # Hours: # ====== * 21 * * * qw(21:00 27/12/1999 Monday) * 19 * * * qw(19:00 28/12/1999 Tuesday) * 10-23/5 * * * qw(20:15 27/12/1999 Monday) * 10-23/7 * * * qw(10:00 28/12/1999 Tuesday) # Days-of-Month: # ============== * * 29 2 * qw(00:00 29/02/2000 Tuesday) 23 4 23-30/3 * * qw(04:23 29/12/1999 Wednesday) 12 21 27 * * qw(21:12 27/12/1999 Monday) 12 19 27 * * qw(19:12 27/01/2000 Thursday) * 18 21,15,8 * * qw(18:00 08/01/2000 Saturday) # Months: # ======= * * * 11 * qw(00:00 01/11/2000 Wednesday) * * * 12 * qw(20:15 27/12/1999 Monday) * * * 0 * qw(00:00 01/01/2000 Saturday) 42 0 4 Jan-Dec * qw(00:42 04/01/2000 Tuesday) 42 21 4 Jan-Dec/2 * qw(21:42 04/01/2000 Tuesday) 42 21 * Feb-Dec/2 * qw(21:42 27/12/1999 Monday) 42 19 * Feb-Dec/2 * qw(19:42 28/12/1999 Tuesday) 42 19 27 Feb-Dec/2 * qw(19:42 27/02/2000 Sunday) # Days-of-Week: # ============= 14 15 * Dec,Jan 0 qw(15:14 02/01/2000 Sunday) 14 15 * Dec,Jan 7 qw(15:14 02/01/2000 Sunday) 0 12 * * Mon-Fri qw(12:00 28/12/1999 Tuesday) * * * * Mon qw(20:15 27/12/1999 Monday) 0 21 * * Mon qw(21:00 27/12/1999 Monday) 0 19 * * Mon qw(19:00 03/01/2000 Monday) 13 14 * * Sun-Sat/2 qw(14:13 28/12/1999 Tuesday) # Horrible combinations ;-): # ========================== 0 21 27 * Wed qw(21:00 27/12/1999 Monday) 0 19 27 * Wed qw(19:00 29/12/1999 Wednesday) 0 19,21 27 * Wed qw(21:00 27/12/1999 Monday) 20-30/5,17 19,21 27 * Wed qw(21:17 27/12/1999 Monday) # With seconds (6th column) # ========================= * * * * * * qw(seconds_test) * * * * * 0-59/2 qw(seconds_test) * * * * * 2,4,6 (5 + 4)."seconds_test" Schedule-Cron-1.05/t/sighandler.t0000644000175000001440000000126214317716316015163 0ustar _73users#!perl -w # Startup Test: # $Id: sighandler.t,v 1.2 2006/11/27 13:42:52 roland Exp $ use Schedule::Cron; use Test::More; if ($^O =~ /Win32/i) { plan skip_all => "Test doesn't work on Win32"; } else { plan tests => 1; } $| = 1; SKIP: { eval { alarm 0 }; skip "alarm() not available", 1 if $@; # Check, whether an already installed signalhandler is called $SIG{CHLD} = sub { pass "SIGCHLD received"; exit 0; }; $SIG{ALRM} = sub { fail "SIGALRM received"; exit 0; }; my $cron = new Schedule::Cron(sub { sleep(1); }); $cron->add_entry("* * * * * *"); alarm(5); $cron->run; } Schedule-Cron-1.05/t/kwalitee.t0000644000175000001440000000027614317716316014654 0ustar _73users#!/usr/bin/perl use Test::More; eval { require Test::Kwalitee; }; if ($@) { plan( skip_all => 'Test::Kwalitee not installed; skipping' ); } else { Test::Kwalitee->import(); } Schedule-Cron-1.05/t/timeshift.t0000644000175000001440000000063414317716316015041 0ustar _73users#!/usr/bin/perl use Test::More tests => 1; use Schedule::Cron; use strict; my $count = 0; my $second = (localtime)[0]; my $cron = new Schedule::Cron(sub {},{nofork => 1,timeshift => 10}); $cron->add_entry("* * * * * " . ($second + 12) % 60,{subroutine => sub { die } }); my $now = time; eval { $cron->run(); }; my $delta = time - $now; ok($delta <= 3,"Call was shifted by " . $delta . " seconds (<= 3)"); Schedule-Cron-1.05/t/delete_entry.t0000644000175000001440000000173414317716316015532 0ustar _73users#!/usr/bin/perl # # ============================================= # Adapted from patch provided with RT #54692 use Test::More tests => 3; use Schedule::Cron; use Data::Dumper; use strict; use warnings; $| = 1; #System::Proc::Simple->debug(0); my $cron = new Schedule::Cron( \&dispatcher, nofork => 1, catch => 0, ); $cron->add_entry("* * * * * *", 'Test1'); $cron->add_entry("* * * * * *", 'Test2'); my $e_idx = $cron->check_entry('Test2'); $cron->delete_entry($e_idx); $cron->add_entry("* * * * * *", 'Test3'); foreach my $e_name (qw/Test1 Test2 Test3/) { my $e_idx = $cron->check_entry($e_name); if (defined($e_idx)) { my $entry = $cron->get_entry($e_idx); is($entry->{args}->[0],$e_name,"$e_name defined"); } else { is($e_name,"Test2","Test2 not found"); } } sub dispatcher { my $name = shift; printf "Running %s.\n", $name; } Schedule-Cron-1.05/t/callbackreschedule.t0000644000175000001440000000175414317716316016651 0ustar _73users#!perl -w # Check that rescheduling entries within an entry callback works properly # in nofork mode. # # by Andrew Danforth based on existing testcases use Test::More tests => 1; use Schedule::Cron; $| = 1; my $cron = new Schedule::Cron(\&dispatch_1,{nofork => 1}); my $job1count = 0; my $job2count = 0; sub dispatch_1 { print "# Job 1.1, job1count: $job1count, job2count: $job2count\n"; if ($job1count++ == 0) { $cron->clean_timetable; $cron->add_entry("* * * * * 0-59/4", \&dispatch_2); $cron->add_entry("* * * * * 2-59/4"); } else { die "ok\n" if $job2count; die "job2 never ran"; } } sub dispatch_2 { print "# Job 1.2, job1count: $job1count, job2count: $job2count\n"; if ($job2count++) { die "job1 got lost -- job2 ran again before job1 a second time"; } } $cron->add_entry("* * * * * 2-59/4"); eval { $cron->run(); }; my $error = $@; chomp $error; ok($error eq "ok","rescheduled jobs work properly ($error)"); Schedule-Cron-1.05/t/same_time_with_reschedule.t0000644000175000001440000000263214317716316020246 0ustar _73users#!/usr/bin/perl use Test::More tests => 6; use Schedule::Cron; use strict; #!/usr/bin/perl use Schedule::Cron; use Data::Dumper; my $CALLED = {}; # Create new object with default dispatcher my $scheduler = Schedule::Cron->new( sub { warn "unknown action"; }); my $other = sub { $CALLED->{OTHER}++ }; my $sec = (localtime)[0]; my $e = entry(2,3,4); my $tasknum = 0; my $do = sub { $CALLED->{DO}++; if ($tasknum < 2) { # print "adding something\n"; my $string = "task" . $tasknum ."\n"; $scheduler->add_entry($e, { subroutine => &task($tasknum + 1)}); $tasknum++; } }; sub task { my $num = shift; return sub { $CALLED->{"T" . $num}++; }; } #print $e,"\n";; $scheduler->add_entry($e, { subroutine => $do }); $scheduler->add_entry($e, { subroutine => $other }); $scheduler->add_entry(entry(5), { subroutine => sub { die "E1\n" }}); eval { $scheduler->run({ nofork => 1 }); }; is($@,"E1\n","Finished by last action"); ok($CALLED->{DO} > 0,'$do called ' . $CALLED->{DO}); ok($CALLED->{OTHER} > 0,'$other called ' . $CALLED->{OTHER}); ok($CALLED->{T1} > 0,"T1 called"); ok($CALLED->{T2} > 0,"T2 called"); is($CALLED->{DO},$CALLED->{OTHER}, '$do and $other are the same'); #print Dumper($CALLED); sub entry { return "* * * * * " . join (",",map { ($sec + $_) % 60 } @_); } Schedule-Cron-1.05/t/pod_coverage.t0000644000175000001440000000044614317716316015503 0ustar _73users#!/usr/bin/perl use Test::More; eval "use Test::Pod::Coverage"; plan skip_all => "Test::Pod::Coverage required for testing pod coverage" if $@; plan tests => 1; pod_coverage_ok( "Schedule::Cron",{trustme => [qr/^REAPER$/, qr/^bug$/, qr/^report_exectime_bug/]}, "Schedule::Cron is covered" ); Schedule-Cron-1.05/t/pod.t0000644000175000001440000000022214317716316013620 0ustar _73users#!/usr/bin/perl use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Schedule-Cron-1.05/t/process_name.t0000644000175000001440000000615714317716316015531 0ustar _73users#!/usr/bin/perl # Test the process naming options: processname, processprefix, and nostatus. use Test::More tests => 6; use Schedule::Cron; use strict; use warnings; my $orig_proc_name = $0; my $dispatch_1 = sub { my $test_msg = 'process name suffixed with debug status by default'; my $process_name_rx = '^Schedule::Cron MainLoop - next: '.scalar(localtime).'$'; if ($0 =~ /$process_name_rx/) { die "1-$test_msg\n"; } else { die "0-$test_msg\n"; } }; my $cron = Schedule::Cron->new( $dispatch_1, nofork => 1, ); $cron->add_entry('* * * * * 0-59'); eval { $cron->run(); }; my $error = $@; chomp $error; my ($ok, $msg) = split '-', $error, 2; ok $ok, $msg; $0 = $orig_proc_name; my $dispatch_2 = sub { my $test_msg = q(process name doesn't change with nostatus); if ($0 eq $orig_proc_name) { die "1-$test_msg\n"; } else { die "0-$test_msg\n"; } }; $cron = Schedule::Cron->new( $dispatch_2, nofork => 1, nostatus => 1 ); $cron->add_entry('* * * * * 0-59'); eval { $cron->run(); }; $error = $@; chomp $error; ($ok, $msg) = split '-', $error, 2; ok $ok, $msg; $0 = $orig_proc_name; my $dispatch_3 = sub { my $test_msg = 'nostatus overrides processprefix'; if ($0 eq $orig_proc_name) { die "1-$test_msg\n"; } else { print "\$0 = $0\n"; die "0-$test_msg\n"; } }; $cron = Schedule::Cron->new( $dispatch_3, nofork => 1, nostatus => 1, processprefix => 'foo' ); $cron->add_entry('* * * * * 0-59'); eval { $cron->run(); }; $error = $@; chomp $error; ($ok, $msg) = split '-', $error, 2; ok $ok, $msg; $0 = $orig_proc_name; my $dispatch_4 = sub { my $test_msg = 'process name prefixed with string when using processprefix'; my $rx = '^foo MainLoop - next: '.scalar(localtime).'$'; if ($0 =~ /$rx/) { die "1-$test_msg\n"; } else { die "0-test_msg\n"; } }; $cron = Schedule::Cron->new( $dispatch_4, nofork => 1, processprefix => 'foo' ); $cron->add_entry('* * * * * 0-59'); eval { $cron->run(); }; $error = $@; chomp $error; ($ok, $msg) = split '-', $error, 2; ok $ok, $msg; $0 = $orig_proc_name; my $dispatch_5 = sub { my $test_msg = 'process name set to constant string when using processname'; if ($0 eq 'foo') { die "1-$test_msg\n"; } else { die "0-$test_msg\n"; } }; $cron = Schedule::Cron->new( $dispatch_5, nofork => 1, processname => 'foo' ); $cron->add_entry('* * * * * 0-59'); eval { $cron->run(); }; $error = $@; chomp $error; ($ok, $msg) = split '-', $error, 2; ok $ok, $msg; $0 = $orig_proc_name; my $dispatch_6 = sub { my $test_msg = 'processname overrides nostatus and processprefix'; if ($0 eq 'foo') { die "1-$test_msg\n"; } else { die "0-$test_msg\n"; } }; $cron = Schedule::Cron->new( $dispatch_6, nofork => 1, processname => 'foo', nostatus => 1, processprefix => 'bar' ); $cron->add_entry('* * * * * 0-59'); eval { $cron->run(); }; $error = $@; chomp $error; ($ok, $msg) = split '-', $error, 2; ok $ok, $msg; $0 = $orig_proc_name; Schedule-Cron-1.05/t/load_crontab.t0000644000175000001440000000217214317716316015473 0ustar _73users#!perl -w use Schedule::Cron; use File::Basename; use strict; my $crontab = dirname($0)."/test.crontab"; my $cron; my @tests = ( qq( \$cron = new Schedule::Cron( sub {}, file => "$crontab", eval => 1) ), qq( \$cron = new Schedule::Cron(sub {}); \$cron->load_crontab("$crontab"); ), qq( \$cron = new Schedule::Cron(sub {}); \$cron->load_crontab(file=>"$crontab",eval=>1); ), qq( \$cron = new Schedule::Cron(sub {}); \$cron->load_crontab({file=>"$crontab",eval=>1}); ) ); print "1..",scalar(@tests),"\n"; my $i = 1; foreach (@tests) { eval $_; if ($@) { print "Error during loading of crontab file: $@\n"; print "not ok $i\n"; } else { print "ok $i\n"; } # print "Cron:\n",Dumper($cron); $i++; } # Check for time parsing $cron = new Schedule::Cron(sub {}); $cron->load_crontab($crontab); Schedule-Cron-1.05/t/execution_time.t0000644000175000001440000002026114317716316016064 0ustar _73users#!perl -w use Test::More; use Schedule::Cron; use Time::ParseDate; use Data::Dumper; eval "use DateTime::TimeZone::Local"; my $local_tz; if (!$@) { eval { my $t = DateTime::TimeZone::Local->TimeZone(); if ($t) { $local_tz = $t->name(); } }; # Needs to eval because a time zone might not be set } my $time; my $skip = 0; while (defined($_=) && $_ !~ /^end/i) { chomp; if (/^Reftime:\s*(.*)$/) { $time = $1; $time =~ s/\#.*$//; $time = parsedate($time,UK=>1); next; } elsif (/^TZBEGIN:\s*(.*)$/) { if (!$local_tz || $1 ne $local_tz) { $skip = 1; } next; } elsif (/^TZEND:/) { $skip = 0; next; } next if $skip; s/^\s*(.*)\s*/$1/; next if /^\#/ || /^$/; my @args = split(/\s+/,$_,6); my $date; my $rest = pop @args; my ($col6,$more_args) = split(/\s+/,$rest,2); if ($col6 =~ /^[\d\-\*\,\/]+$/) { push @args,$col6; $date = $more_args; } else { $date = $rest; } push @entries,[$time, \@args]; my $res_date = parsedate($date,UK=>1); die "Internal error" unless $res_date; push @results,$res_date; } my $cron = new Schedule::Cron(sub {}); plan tests => scalar(@entries); my $i; for ($i=0;$i<=$#entries;$i++) { my $t = $cron->get_next_execution_time($entries[$i]->[1],$entries[$i]->[0]); print "# Cron-Entry: ",join(" ",@{$entries[$i]->[1]}),"\n"; print "# Ref-Time: ",scalar(localtime($entries[$i]->[0])),"\n"; print "# Calculated: ",scalar(localtime($t)),"\n"; print "# Expected: ",scalar(localtime($results[$i])),"\n"; ok($t == $results[$i]); } __DATA__ Reftime: Mon Dec 27 20:14:14 1999 # Minutes: # ======== * * * * * 0 20:15 27/12/1999 Monday 20 * * * * 20:20 27/12/1999 Monday 10-50 * * * * 20:15 27/12/1999 Monday 13-30/4 * * * * 20:17 27/12/1999 Monday 10 * * * * 21:10 27/12/1999 Monday 18,20 * * * * 20:18 27/12/1999 Monday # Hours: # ====== * 21 * * * 21:00 27/12/1999 Monday * 19 * * * 19:00 28/12/1999 Tuesday * 10-23/5 * * * 20:15 27/12/1999 Monday * 10-23/7 * * * 10:00 28/12/1999 Tuesday # Days-of-Month: # ============== * * 29 2 * 00:00 29/02/2000 Tuesday 23 4 23-30/3 * * 04:23 29/12/1999 Wednesday 12 21 27 * * 21:12 27/12/1999 Monday 12 19 27 * * 19:12 27/01/2000 Thursday * 18 21,15,8 * * 18:00 08/01/2000 Saturday # Months: # ======= * * * 11 * 00:00 01/11/2000 Wednesday * * * 12 * 20:15 27/12/1999 Monday * * * 0 * 00:00 01/01/2000 Saturday 42 0 4 Jan-Dec * 00:42 04/01/2000 Tuesday 42 21 4 Jan-Dec/2 * 21:42 04/01/2000 Tuesday 42 21 * Feb-Dec/2 * 21:42 27/12/1999 Monday 42 19 * Feb-Dec/2 * 19:42 28/12/1999 Tuesday 42 19 27 Feb-Dec/2 * 19:42 27/02/2000 Sunday # Days-of-Week: # ============= 14 15 * Dec,Jan 0 15:14 02/01/2000 Sunday 14 15 * Dec,Jan 7 15:14 02/01/2000 Sunday 0 12 * * Mon-Fri 12:00 28/12/1999 Tuesday * * * * Mon 20:15 27/12/1999 Monday 0 21 * * Mon 21:00 27/12/1999 Monday 0 19 * * Mon 19:00 03/01/2000 Monday 13 14 * * Sun-Sat/2 14:13 28/12/1999 Tuesday # Seconds * * * * * * 20:14:15 27/12/1999 Monday * * * * * 5-10 20:15:05 27/12/1999 Monday * * * * * 13-30/4 20:14:17 27/12/1999 Monday * * * * * 18 20:14:18 27/12/1999 Monday # Horrible combinations ;-): # ========================== 0 21 27 * Wed 21:00 27/12/1999 Monday 0 19 27 * Wed 19:00 29/12/1999 Wednesday 0 19,21 27 * Wed 21:00 27/12/1999 Monday 20-30/5,17 19,21 27 * Wed 21:17 27/12/1999 Monday # Check for parsedate-normalization # (thanx to Lars Holokowo) # ================================= 1 3 30 6 * 03:01 30/06/2000 Monday 0 03 30 6 * 03:00 30/06/2000 Monday 00 3 30 6 * 03:00 30/06/2000 Monday 0 3 30 6 * 03:00 30/06/2000 Monday # Bug reported by Loic Paillotin # ============================== 5,10,25,30,35,40,45,50,55 * * * * 20:25 27/12/1999 Monday 5,10,25,30,35,40,45,50,55 * * * * 20:25 27/12/1999 Monday */5 * * * * 20:15 27/12/1999 Monday # Runs only if running if in Germany (since the DST is TZ specific) TZBEGIN: Europe/Berlin # DST Checks (for MEZ) # ==================== # Normal behaviour (non-DST related) Reftime: Sun Mar 29 03:10:00 2009 10 * * * * Sun Mar 29 04:10:00 2009 10 2 * * * Mon Mar 30 02:10:00 2009 10 2 * * 0 Sun Apr 05 02:10:00 2009 10 2 29 * * Wed Apr 29 02:10:00 2009 # Cron triggers within the DST switch. It should fire right after the hours has # changed Reftime: Sun Mar 29 01:10:00 2009 10 * * * * Sun Mar 29 03:10:00 2009 Reftime: Sat Mar 28 02:10:00 2009 10 2 * * * Sun Mar 29 03:10:00 2009 Reftime: Sun Mar 22 02:10:00 2009 10 2 * * 0 Sun Mar 29 03:10:00 2009 Reftime: Sun Feb 29 02:10:00 2009 10 2 29 * * Sun Mar 29 03:10:00 2009 # Checks for reverse DST switch. It should skip the extra hour. This works for # MET only, though. Actually for other TZs (like PST8PDT), where parsedate() # delivers the 'first' UTC time instead of the 'second' (as it is for MET). # This is not Time::ParseDate's fault but ours because of the way, how we # calculate the next execution time. It's unlikely that this will get fixed # very soon. Reftime: Sun Oct 25 02:10:00 2009 10 * * * * Sun Oct 25 03:10:00 2009 Reftime: Sun Oct 25 02:10:00 2009 5 * * * * Sun Oct 25 03:05:00 2009 Reftime: Sun Oct 25 02:55:00 2009 25 * * * * Sun Oct 25 03:25:00 2009 TZEND: Europe/Berlin # ---------------------------------------------------------------------------- # Leave out invalid dates Reftime: Fri Feb 27 12:00:00 2009 0 12 30 * * Sun Mar 30 12:00:00 2009 # Check '*' at minute level Reftime: Fri Jan 27 12:01:00 2009 * 12 30 * * Sun Jan 30 12:00:00 2009 * 12 27 * * Sun Jan 27 12:02:00 2009 * 12 * * * Sun Jan 27 12:02:00 2009 * 13 * * * Sun Jan 27 13:00:00 2009 # ----------------------------------------------------------------------------- # Reported by : tenbrink Reftime: 23:00 2007/09/01 0 23 * * 1 23:00 03/09/2007 Monday # ----------------------------------------------------------------------------- # Reported by : tenbrink Reftime: 23:00:55 2007/09/01 * * * * * */10 23:01:00 01/09/2007 Saturday end Schedule-Cron-1.05/Changes0000644000175000001440000001404214375557611013713 0ustar _73users1.05 2023-02-22 - Fixed POD error from using UTF8 char without setting =encoding (ticket 144709) - Fixed minor undefined warning bug (ticket 145506) - Fixed spelling and grammar issues in the documentation - Removed handwritten META.yml in favor of EU::MM generated META.yml - Removed support for Module::Build in favor of ExtUtils::MakeMaker 1.04 2022-10-08 - Merged "CHANGES" and "ChangeLog" into "Changes". - Updated documenation sections: "AUTHORS", "CONTRIBUTORS", and "COPYRIGHT AND LICENSE" 1.03 2022-10-04 - Added option "processname" to set $0 to constant string (#9) - Added tests for options "processname", "processprefix", and "nostatus" (#10) - Added "Contributors" section to the documentation. 1.02_2 2013-12-19 - Fixed typos in the documentation (#88521). - Fixed debug output slipped id (#83462). - Fixed crontab with empty lines (#75176). - Fixed skipping of jobs triggered at the same time when rescheduling (#70975). - Added option "timeshift" in order to shift the execution point a bit (#69177). - Made $? local in the reaper sub (#69110 and #69116). 1.01 2011-06-06 - Fix for RT #56926 which causes systems without SIGCHLD to exit on after 64 forked processes. - Patch for Makefile.PL applied which seems to have problems after the reorganisation of the directory layout (RT #57914). - Fix for RT #63089 which left over a time-window of 1 sec where Schedule::Cron could run havoc. - Fixes for RT #68530 ("Exposing too much information..."), #68450 ("Crash scheduling empty queue") and #68533 ("Thou shalt not REAP what thou has not forked...") provided by tlhackque. Thanks a lot! - New options: * loglevel: Tuning of logoutput. * nostatus: Avoid setting $0 to next schedule time. * sleep: Custom sleep() function between two calls. 1.00 2010-05-14 - Fix for RT #54692 occured when removing an entry. - Fixed #55741 with help from Clinton Gormley (a perl bug occuring when modyfing global hashes in an event handler). - Fixed RT #50325 which could cause an infinite loop when calculating the next execution time - Further bug fixes. 0.99 2009-09-12 * lib/Schedule/Cron.pm: Fixed issue for certain timeszone (like PST8PDT) where a backward DST switch make Cron.pm running amok by firing each job triggered in the extra hour without a delay between. Thanks A LOT to Eric Wilhelm for spotting and analysing this issue. 0.98 2009-04-03 - New option 'after_job' for new() which allows for a callback run after a job has been sucessfully run (RT #29040). - Argument logging is done using data dumper (RT #39499). - Private methods are now marked with '_'. - Added tests for increased kwallitee. - Switched over to Build.PL (Makefile.PL is still supported). - Fixed some time calculation times (e.g. for the first DST switch in the year). - Allow comments at the end of a crontab line. * lib/Schedule/Cron.pm (_calc_time): fixed some issues when calculating times for '*' entries. * t/execution_time.t: Added test for checking proper DST behaviour. * lib/Schedule/Cron.pm (load_crontab): Allow comment at the end of a crontab line. 0.97 2006-11-27 - Use POSIX only where available, otherwise fallback to an emulation of waipid. - Fixed bug when previous SIGCHLD handler was not a coderef, but a tring value like "DEFAULT" or "IGNORE" - Added tests - Made test more robust so they work now also on system without alarm() functionality (Win32). - Cron.pm:(run): Removed leading space when no process prefix is used (for backwards compatibility). 0.96 2006-11-05 - Applied patch for #4917 in order to be smarter to existing SIGCHLD handler and to reap only own childs. 0.95 2006-11-05 - If a scheduled method in 'nofork' manipulates the execution queue with add_entry or delete_entry, it will be picked up during the next run. - Clarified different behaviour of global variables within the fork/nofork mode in the documentation. - Fixed warning about non-numeric arguments when sorting. - Fixed bug which called to an undefined methods in a die-message - Pretty print a hashref in $0 if provided as argument and the prefix for the name to be shown in the process list can be configured with the option "processprefix". - CHANGES: added patches and suggestions from - Andrew Danforth - Frank Mayer - Jamie McCarthy - Andy Ford - Cron.pm: Worked on: Reexamination of crontabs entry in 'nofork' mode if someone has added a new entry. 0.9 2005-01-03 - Logging: It is now possible to add a reference to a custom logging subroutine to the constructor which will be used for logging certain events. - NoFork: The option 'nofork' prevents Cron.pm from creating a new child process. Instead, the job is run within the current process. You can use the 'skip' and 'catch' options to tune the behaviour. - Cron.pm: added new options 'nofork', 'skip', 'catch' and 'log'. - t/entry.t (Module): added and extended tests. - Cron.pm (add_entry): added heuristic for parsing crontab with 6 time columns. - (get_next_execution_time): allow a sixth column for specifing the second to start up. - Cron.pm:(get_next_execution_time): added recognition of "*/5" notations (thanks to Loic Paillotin for spotting this problem). 0.05 2002-04-02 - Other bugfixes for parsedate problem with single digit hours/minutes and warnings if argumentlist of command to execute is empty. - Cron.pm: added patch from Lars Holokowo for working around a bug in parsedate, which has trouble in parsing times in the form "3:1 2000/6/30". Added tests to check for those dates. - Cron.pm: added additional check for arguments to avoid warnings as suggested by David Parker. - Makefile.PL: added check for Time::ParseDate as suggested by Philippe Verdret. 0.03 2000-06-12 - Cron.pm: Fixed bug in regexp splitting the crontab entry in get_next_execution_time() report by Peter Vary. - Cron.pm: Fixed problem when reaping childs: Now SIGCHLD handler can handle more than one finished child at once (thanx to Bray Jones for discovering this bug). 0.01 2000-01-09 - Initial Release Schedule-Cron-1.05/Makefile.PL0000644000175000001440000000130714375556667014404 0ustar _73usersuse ExtUtils::MakeMaker; WriteMakefile ( NAME => "Schedule::Cron", VERSION_FROM => "lib/Schedule/Cron.pm", ($] >= 5.005 ? (ABSTRACT => 'Cron-like scheduler for Perl subroutines', AUTHOR => 'Roland Huss (roland@cpan.org)', META_MERGE => { resources => { repository => 'https://github.com/rhuss/schedule-cron', }, }, PL_FILES => {}) : ()), ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE' => 'perl', ) : ()), PREREQ_PM => { "Time::ParseDate" => '2011.0505',"Data::Dumper" => 0}, 'dist' => {COMPRESS=>'gzip',SUFFIX=>'gz'} ); Schedule-Cron-1.05/examples/0000755000175000001440000000000014375560071014227 5ustar _73usersSchedule-Cron-1.05/examples/simple.pl0000644000175000001440000000153514317716316016062 0ustar _73users#!/usr/bin/perl # Very simple examples which print the current # time every 10 Minutes. # # The purpose is to show a common usage pattern # using a single dispatcher subroutine provided # at construction time use lib "../lib"; use Schedule::Cron; # Create new object with default dispatcher my $cron = new Schedule::Cron(\&dispatcher); # The cron entry which fires every 10 minutes my $entry = "0-59/5 * * * *"; # Dispatcher subroutine called from cron sub dispatcher { open(T,">>timestamps.txt"); print T "Current: ",scalar(localtime),"\n"; print T "Next: ",scalar(localtime($cron->get_next_execution_time($entry))),"\n"; close T; sleep(30); } # Call &dispatcher() every ten minutes $cron->add_entry($entry); # Run scheduler and block. 'nofork' forces the subroutine to # be called in the main process $cron->run(nofork=>1); Schedule-Cron-1.05/examples/custom_sleep.pl0000644000175000001440000002656114317716316017301 0ustar _73users#!/usr/bin/perl # Copyright (c) 2011 Timothe Litt # # May be used on the same terms as Perl. # Sleep hook demo, showing how it enables a background thread # to provide a simple command interface to a daemon. =head1 custom_sleep - Demo for a custom 'sleep' function This example demonstrates the usage of the 'sleep' option for L with a custom sleep method which can dynamically modify the crontab even inbetween to cron events. It provides a cron daemon which listens on a TCP port for commands. Please note that this is an example only and should obviously not used for production ! When started, this script will listen on port 65331 and will first ask for a password. Use 'Purfect' here. Then the following commands are available: status -- Print internal job queue add id "cron spec" name -- Add a sample jon which will bring "id: name" each time "cron spec" fires load /path/to/crontab -- Load a crontab as with Schedule::Cron->load_crontab delete id -- Delete job entry quit -- Disconect A sample session looks like: First start the server: ./custom_sleep.pl Please wait while initialization is scheduled Schedule::Cron - Starting job 0 Ready, my port is localhost::65331 Schedule::Cron - Finished job 0 Schedule::Cron - Starting job 5 Now: Periodic Schedule::Cron - Finished job 5 And then a client: $ telnet localhost 65331 Trying 127.0.0.1... Connected to localhost.localdomain (127.0.0.1). Escape character is '^]'. Password: Purfect Password accepted status Job 0 0 0 1 1 * Next: Sun Jan 1 00:00:00 2012 - NewYear( ) End of job queue load cron.tab Loaded cron.tab status Job 1 34 2 * * Mon Next: Mon Jun 6 02:34:00 2011 - "make_stats"( ) Job 2 43 8 * * Wed Next: Wed Jun 8 08:43:00 2011 - "Make Peace"( ) Job 0 0 0 1 1 * Next: Sun Jan 1 00:00:00 2012 - NewYear( ) End of job queue add Halloween "30 18 31 10 *" Pumpkin time Added 30 18 31 10 * add Today "11 15 * * *" Something to do Added 11 15 * * * add Now "*/2 * * * * 30" Periodic Added */2 * * * * 30 status Job 5 */2 * * * * 30 Next: Thu Jun 2 13:40:30 2011 - Now( Periodic ) Job 4 11 15 * * * Next: Thu Jun 2 15:11:00 2011 - Today( Something to do ) Job 1 34 2 * * Mon Next: Mon Jun 6 02:34:00 2011 - "make_stats"( ) Job 2 43 8 * * Wed Next: Wed Jun 8 08:43:00 2011 - "Make Peace"( ) Job 3 30 18 31 10 * Next: Mon Oct 31 18:30:00 2011 - Halloween( Pumpkin time ) Job 0 0 0 1 1 * Next: Sun Jan 1 00:00:00 2012 - NewYear( ) End of job queue delete Today Deleted Today status Job 4 */2 * * * * 30 Next: Thu Jun 2 13:42:30 2011 - Now( Periodic ) Job 1 34 2 * * Mon Next: Mon Jun 6 02:34:00 2011 - "make_stats"( ) Job 2 43 8 * * Wed Next: Wed Jun 8 08:43:00 2011 - "Make Peace"( ) Job 3 30 18 31 10 * Next: Mon Oct 31 18:30:00 2011 - Halloween( Pumpkin time ) Job 0 0 0 1 1 * Next: Sun Jan 1 00:00:00 2012 - NewYear( ) End of job queue q Connection closed by foreign host. =cut use strict; use warnings; use Schedule::Cron; use Socket ':crlf'; use IO::Socket::INET; my $port = 65331; our $password = 'Purfect'; our( $lsock, $rin, $win, $maxfd, %servers ); my $cron = new Schedule::Cron( sub { print 'Loaded entry: ', join('', @_ ), "\n"; }, { nofork => 1, loglevel => 0, log => sub { print $_[1], "\n"; }, sleep => \&idler } ); $cron->add_entry( "* * * * * *", \&init, 'Init', $cron ); $cron->add_entry( "0 0 1 1 *", sub { print "Happy New Year\n"; }, "NewYear" ); print "Please wait while initialization is scheduled\n"; print help(); $cron->run( { detach => 0 } ); exit; sub idler { my( $time ) = @_; my( $rout, $wout ); my( $nfound, $ttg ) = select( $rout=$rin, $wout=$win, undef, $time ); if( $nfound ) { if( $nfound == -1 ) { die "select() error: $!\n"; # This will be an internal error, such as a stale fd. } for( my $n = 0; $n <= $maxfd; $n++ ) { if( vec( $rout, $n, 1 ) ) { my $s = $servers{$n}; $s->{rsub}->( ); } } for( my $n = 0; $n <= $maxfd; $n++ ) { if( vec( $wout, $n, 1 ) ) { my $s = $servers{$n}; $s->{wsub}->( ); } } } } # First task run initializes (usually in daemon, after forking closed open files) # I suppose this could be a postfork callback, but there isn't one... sub init { my( $name, $cron ) = @_; $cron->delete_entry( 'Init' ); $rin = ''; $win = ''; $lsock = IO::Socket::INET->new( LocalAddr => "localhost:$port", Proto => 'tcp', Type => SOCK_STREAM, Listen => 5, ReuseAddr => 1, Blocking => 0, ), or die "Unable to open status port $port $!\n"; vec( $rin, ($maxfd = $lsock->fileno()), 1 ) = 1; $servers{$maxfd} = { rsub=>sub { newConn( $lsock, $cron ); } }; print "Ready, my port is localhost:$port\nTo connect:\n telnet localhost $port\n"; return; } sub newConn { my( $lsock, $cron ) = @_; my $sock = $lsock->accept(); $sock->blocking(0); my $cx = { rbuf => '', wbuf => 'Password: ', }; my $fd = $sock->fileno(); $maxfd = $fd if( $maxfd < $fd ); vec( $rin, $fd, 1 ) = 1; vec( $win, $fd, 1 ) = 1; $servers{$fd} = { rsub=>sub { serverRd( $sock, $cx, $fd ); }, wsub=>sub { serverWr( $sock, $cx, $fd ); }, cron=>$cron, }; } sub serverRd { my( $sock, $cx, $fd ) = @_; # Read whatever is available. 1000 is arbitrary, 1 will work (with lots of overhead). # Huge will prevent any other thread from running. my $rn= $sock->sysread( $cx ->{rbuf}, 1000, length $cx->{rbuf} ); unless( defined $rn ) { print "Read error: $!\n"; } unless( $rn ) { # Connection closed by client vec( $rin, $fd, 1 ) = 0; vec( $win, $fd, 1 ) = 0; $sock->close(); undef $cx; return; } # Assemble reads to form whole lines # Decode each line as a command. while( $cx->{rbuf} =~ /$LF/sm ) { $cx->{rbuf} =~ s/$CR//g; my( $line, $rest ); ($line, $rest) = split( /$LF/, $cx->{rbuf}, 2 ); $rest = '' unless( defined $rest ); $cx->{rbuf} = $rest; # This is not secure, but one has to do something. # Demos always get used for more than they should.. # Please do better...like user/account validation # using the system services. unless( $cx->{authenticated} ){ if( $line eq $password ) { $cx->{authenticated} = 1; $cx->{wbuf} .= "Password accepted$CR$LF"; } else { $cx->{wbuf} .= "Password refused.$CR${LF}Password: "; } next; } if( $line =~ /^STAT(?:US)?(?: (\w+))?$/i ) { $cx->{wbuf} .= status( $cron, ($1 || 'normal') ); } elsif( $line =~ /^ADD\s+(\w+)\s+"(.*?)"\s+(.*)$/i ) { my( $name, $sched ) = ($1, $2); $cron->add_entry( $sched, \&announce, $1, $3 ); $cx->{wbuf} .= "Added $name '$sched'$CR$LF"; } elsif( $line =~ /^DEL(?:ETE)?\s+(["\w]+)$/i ) { my $name = $1; my $idx = $cron->check_entry( $name ); if( defined $idx ) { $cron->delete_entry( $idx ); $cx->{wbuf} .= "Deleted $name$CR$LF"; } else { $cx->{wbuf} .= "$name not found$CR$LF"; } } elsif( $line =~ /^HELP$/i ) { $cx->{wbuf} .= help(); } elsif( $line =~ /^LOAD\s([\w\._-]+)$/i ) { my $cfg = $1; # Danger: File permissions of server are used here. eval { $cron->load_crontab( $cfg ); }; my $emsg = $@; $emsg =~ s/\n/$CR$LF/gms; $cx->{wbuf} .= $emsg || "Loaded $cfg$CR$LF"; } elsif( $line =~ /^Q(?:uit)?$/i ) { $cx->{wbuf} .= "Bye$CR$LF"; $cx->{wend} = 1; } else { $cx->{wbuf} .= "Unrecognized command: $line$CR$LF"; } } serverWr( $sock, $cx, $fd ); } # Server write process # # Output as much as possible from our buffer. # If more remains, keep select mask active # If done, clear select mask. If last write, close socket. sub serverWr { my( $sock, $cx, $fd ) = @_; if( length $cx->{wbuf} ) { my $written = $sock->syswrite( $cx->{wbuf} ); $cx->{wbuf} = substr( $cx->{wbuf}, $written ); } if( length $cx->{wbuf} ) { vec( $win, $fd, 1 ) = 1; return; } else { vec( $win, $fd, 1 ) = 0; if( $cx->{wend} ) { vec( $rin, $fd, 1 ) = 0; $sock->close(); return; } } } sub announce { my( $id, $msg ) = @_; print "$id: $msg\n"; return; } sub status { my $cron = shift; my $level = shift; my $maxtwid = 0; my @entries = map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { my $time = $_->{time}; $maxtwid = length $time if( $maxtwid < length $time ); [ $_, $cron->get_next_execution_time( $time ), ] } $cron->list_entries(); my $msg = "Job queue\n"; foreach my $qe ( @entries ) { my $job = $cron->check_entry( $qe->{args}->[0] ); next unless( defined $job ); #?? $msg .= sprintf( "Job %-4s %-*s Next: %s - %s", $job, $maxtwid, $qe->{time}, (scalar localtime( $cron->get_next_execution_time( $qe->{time}, 0 ) )), $qe->{args}->[0] || '', # Task name ); if( $level =~ /^debug$/i ) { $msg .= '( '; my @uargs = @{$qe->{args}}; $msg .= join( ', ', @uargs[1..$#uargs] ) . ' )'; } $msg .= "\n"; } $msg .= "End of job queue\n"; $msg =~ s/\n/$CR$LF/mgs; return $msg; } use Cwd 'getcwd'; sub help { my $wd = getcwd(); my $msg = <<"HELP"; CAUTION: Not production code. NOT secure. Do NOT run from privileged account. Commands: status Shows queue status debug With argument lists add name "schedule" A string to be printed when executed Adds a new task on specified schedule delete name Deletes a task (by name) help This message. load file Loads a crontab file from $wd CAUTION, this is with server permissions. If the server can read /etc/passwd (or anything else), it will display it in the error messages. As I said, NOT production... quit Exits. HELP $msg =~ s/\n/$CRLF/gms; return $msg; } Schedule-Cron-1.05/examples/cron.tab0000644000175000001440000000013714317716316015662 0ustar _73users# Sample cron tab used for custom_sleep.pl 34 2 * * Mon "make_stats" 43 8 * * Wed "Make Peace" Schedule-Cron-1.05/MANIFEST0000644000175000001440000000112314375560071013537 0ustar _73usersChanges examples/simple.pl examples/cron.tab examples/custom_sleep.pl lib/Schedule/Cron.pm Makefile.PL MANIFEST This list of files README t/after_job.t t/callbackreschedule.t t/dst_back.t t/entry.t t/execution_time.t t/kwalitee.t t/load_crontab.t t/nofork.t t/pod.t t/pod_coverage.t t/pretty_print_args.t t/process_name.t t/sighandler.t t/startup.t t/test.crontab t/delete_entry.t t/same_time_with_reschedule.t t/timeshift.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Schedule-Cron-1.05/lib/0000755000175000001440000000000014375560071013157 5ustar _73usersSchedule-Cron-1.05/lib/Schedule/0000755000175000001440000000000014375560071014713 5ustar _73usersSchedule-Cron-1.05/lib/Schedule/Cron.pm0000644000175000001440000016371114375552114016162 0ustar _73users#!/usr/bin/perl -w =encoding utf8 =head1 NAME Cron - cron-like scheduler for Perl subroutines =head1 SYNOPSIS use Schedule::Cron; # Subroutines to be called sub dispatcher { print "ID: ",shift,"\n"; print "Args: ","@_","\n"; } sub check_links { # do something... } # Create new object with default dispatcher my $cron = new Schedule::Cron(\&dispatcher); # Load a crontab file $cron->load_crontab("/var/spool/cron/perl"); # Add dynamically crontab entries $cron->add_entry("3 4 * * *",ROTATE => "apache","sendmail"); $cron->add_entry("0 11 * * Mon-Fri",\&check_links); # Run scheduler $cron->run(detach=>1); =head1 DESCRIPTION This module provides a simple but complete cron like scheduler. I.e this module can be used for periodically executing Perl subroutines. The dates and parameters for the subroutines to be called are specified with a format known as crontab entry (see L<"METHODS">, C and L) The philosophy behind C is to call subroutines periodically from within one single Perl program instead of letting C trigger several (possibly different) Perl scripts. Everything under one roof. Furthermore, C provides mechanism to create crontab entries dynamically, which isn't that easy with C. C knows about all extensions (well, at least all extensions I'm aware of, i.e those of the so called "Vixie" cron) for crontab entries like ranges including 'steps', specification of month and days of the week by name, or coexistence of lists and ranges in the same field. It even supports a bit more (like lists and ranges with symbolic names). =head1 METHODS =over 4 =cut #' package Schedule::Cron; use Time::ParseDate; use Data::Dumper; use strict; use vars qw($VERSION $DEBUG); use subs qw(dbg); my $HAS_POSIX; BEGIN { eval { require POSIX; import POSIX ":sys_wait_h"; }; $HAS_POSIX = $@ ? 0 : 1; } $VERSION = "1.05"; our $DEBUG = 0; my %STARTEDCHILD = (); my @WDAYS = qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sunday ); my @ALPHACONV = ( { }, { }, { }, { qw(jan 1 feb 2 mar 3 apr 4 may 5 jun 6 jul 7 aug 8 sep 9 oct 10 nov 11 dec 12) }, { qw(sun 0 mon 1 tue 2 wed 3 thu 4 fri 5 sat 6)}, { } ); my @RANGES = ( [ 0,59 ], [ 0,23 ], [ 0,31 ], [ 0,12 ], [ 0,7 ], [ 0,59 ] ); my @LOWMAP = ( {}, {}, { 0 => 1}, { 0 => 1}, { 7 => 0}, {}, ); # Currently, there are two ways for reaping. One, which only waits explicitly # on PIDs it forked on its own, and one which waits on all PIDs (even on those # it doesn't forked itself). The later has been proved to work on Win32 with # the 64 threads limit (RT #56926), but not when one creates forks on ones # own. The specific reaper works for RT #55741. # It tend to use the specific one, if it also resolves RT #56926. Both are left # here for reference until a decision has been done for 1.01 sub REAPER { &_reaper_all(); } # Specific reaper sub _reaper_specific { local ($!,%!,$?); if ($HAS_POSIX) { foreach my $pid (keys %STARTEDCHILD) { if ($STARTEDCHILD{$pid}) { my $res = $HAS_POSIX ? waitpid($pid, WNOHANG) : waitpid($pid,0); if ($res > 0) { # We reaped a truly running process $STARTEDCHILD{$pid} = 0; dbg "Reaped child $res" if $DEBUG; } } } } else { my $waitedpid = 0; while($waitedpid != -1) { $waitedpid = wait; } } } # Catch all reaper sub _reaper_all { #local ($!,%!,$?,${^CHILD_ERROR_NATIVE}); # Localizing ${^CHILD_ERROR_NATIVE} breaks signalhander.t which checks that # chained SIGCHLD handlers are called. I don't know why, though, hence I # leave it out for now. See #69916 for some discussion why this handler # might be needed. local ($!,%!,$?); my $kid; do { # Only on POSIX systems the wait will return immediately # if there are no finished child processes. Simple 'wait' # waits blocking on childs. $kid = $HAS_POSIX ? waitpid(-1, WNOHANG) : wait; dbg "Kid: $kid" if $DEBUG; if ($kid != 0 && $kid != -1 && defined $STARTEDCHILD{$kid}) { # We don't delete the hash entry here to avoid an issue # when modifying global hash from multiple threads $STARTEDCHILD{$kid} = 0; dbg "Reaped child $kid" if $DEBUG; } } while ($kid != 0 && $kid != -1); # Note to myself: Is the %STARTEDCHILD hash really necessary if we use -1 # for waiting (i.e. for waiting on any child ?). In the current # implementation, %STARTEDCHILD is not used at all. It would be only # needed if we iterate over it to wait on pids specifically. } # Cleaning is done in extra method called from the main # process in order to avoid event handlers modifying this # global hash which can lead to memory errors. # See RT #55741 for more details on this. # This method is called in strategic places. sub _cleanup_process_list { my ($self, $cfg) = @_; # Cleanup processes even on those systems, where the SIGCHLD is not # propagated. Only do this for POSIX, otherwise this call would block # until all child processes would have been finished. # See RT #56926 for more details. # Do not cleanup if nofork because jobs that fork will do their own reaping. &REAPER() if $HAS_POSIX && !$cfg->{nofork}; # Delete entries from this global hash only from within the main # thread/process. Hence, this method must not be called from within # a signalhandler for my $k (keys %STARTEDCHILD) { delete $STARTEDCHILD{$k} unless $STARTEDCHILD{$k}; } } =item $cron = new Schedule::Cron($dispatcher,[extra args]) Creates a new C object. C<$dispatcher> is a reference to a subroutine, which will be called by default. C<$dispatcher> will be invoked with the arguments parameter provided in the crontab entry if no other subroutine is specified. This can be either a single argument containing the argument parameter literally has string (default behavior) or a list of arguments when using the C option described below. The date specifications must be either provided via a crontab like file or added explicitly with C (L<"add_entry">). I can be a hash or hash reference for additional arguments. The following parameters are recognized: =over =item file => Load the crontab entries from =item eval => 1 Eval the argument parameter in a crontab entry before calling the subroutine (instead of literally calling the dispatcher with the argument parameter as string) =item nofork => 1 Don't fork when starting the scheduler. Instead, the jobs are executed within current process. In your executed jobs, you have full access to the global variables of your script and hence might influence other jobs running at a different time. This behavior is fundamentally different to the 'fork' mode, where each jobs gets its own process and hence a B of the process space, independent of each other job and the main process. This is due to the nature of the C system call. =item nostatus => 1 Do not update status in $0. Set this if you don't want ps to reveal the internals of your application, including job argument lists. Default is 0 (update status). =item skip => 1 Skip any pending jobs whose time has passed. This option is only useful in combination with C where a job might block the execution of the following jobs for quite some time. By default, any pending job is executed even if its scheduled execution time has already passed. With this option set to true all pending which would have been started in the meantime are skipped. =item catch => 1 Catch any exception raised by a job. This is especially useful in combination with the C option to avoid stopping the main process when a job raises an exception (dies). =item after_job => \&after_sub Call a subroutine after a job has been run. The first argument is the return value of the dispatched job, the reminding arguments are the arguments with which the dispatched job has been called. Example: my $cron = new Schedule::Cron(..., after_job => sub { my ($ret,@args) = @_; print "Return value: ",$ret," - job arguments: (",join ":",@args,")\n"; }); =item log => \&log_sub Install a logging subroutine. The given subroutine is called for several events during the lifetime of a job. This method is called with two arguments: A log level of 0 (info),1 (warning) or 2 (error) depending on the importance of the message and the message itself. For example, you could use I (L) for logging purposes for example like in the following code snippet: use Log::Log4perl; use Log::Log4perl::Level; my $log_method = sub { my ($level,$msg) = @_; my $DBG_MAP = { 0 => $INFO, 1 => $WARN, 2 => $ERROR }; my $logger = Log::Log4perl->get_logger("My::Package"); $logger->log($DBG_MAP->{$level},$msg); } my $cron = new Schedule::Cron(.... , log => $log_method); =item loglevel => <-1,0,1,2> Restricts logging to the specified severity level or below. Use 0 to have all messages generated, 1 for only warnings and errors and 2 for errors only. Default is 0 (all messages). A loglevel of -1 (debug) will include job argument lists (also in $0) in the job start message logged with a level of 0 or above. You may have security concerns with this. Unless you are debugging, use 0 or higher. A value larger than 2 will disable logging completely. Although you can filter in your log routine, generating the messages can be expensive, for example if you pass arguments pointing to large hashes. Specifying a loglevel avoids formatting data that your routine would discard. =item processprefix => Cron::Schedule sets the process' name (i.e. C<$0>) to contain some informative messages like when the next job executes or with which arguments a job is called. By default, the prefix for this labels is C. With this option you can set it to something different. You can e.g. use C<$0> to include the original process name. You can inhibit this with the C option, and prevent the argument display by setting C to zero or higher. =item processname => Set the process name (i.e. C<$0>) to a literal string. Using this setting overrides C and C. =item sleep => \&hook If specified, &hook will be called instead of sleep(), with the time to sleep in seconds as first argument and the Schedule::Cron object as second. This hook allows you to use select() instead of sleep, so that you can handle IO, for example job requests from a network connection. e.g. $cron->run( { sleep => \&sleep_hook, nofork => 1 } ); sub sleep_hook { my ($time, $cron) = @_; my ($rin, $win, $ein) = ('','',''); my ($rout, $wout, $eout); vec($rin, fileno(STDIN), 1) = 1; my ($nfound, $ttg) = select($rout=$rin, $wout=$win, $eout=$ein, $time); if ($nfound) { handle_io($rout, $wout, $eout); } return; } =back =cut sub new { my $class = shift; my $dispatcher = shift || die "No dispatching sub provided"; die "Dispatcher not a ref to a subroutine" unless ref($dispatcher) eq "CODE"; my $cfg = ref($_[0]) eq "HASH" ? $_[0] : { @_ }; $cfg->{processprefix} = "Schedule::Cron" unless $cfg->{processprefix}; my $timeshift = $cfg->{timeshift} || 0; my $self = { cfg => $cfg, dispatcher => $dispatcher, timeshift => $timeshift, queue => [ ], map => { } }; bless $self,(ref($class) || $class); $self->load_crontab if $cfg->{file}; $self; } =item $cron->load_crontab($file) =item $cron->load_crontab(file=>$file,[eval=>1]) Loads and parses the crontab file C<$file>. The entries found in this file will be B to the current time table with C<$cron-Eadd_entry>. The format of the file consists of cron commands containing of lines with at least 5 columns, whereas the first 5 columns specify the date. The rest of the line (i.e columns 6 and greater) contains the argument with which the dispatcher subroutine will be called. By default, the dispatcher will be called with one single string argument containing the rest of the line literally. Alternatively, if you call this method with the optional argument C1> (you must then use the second format shown above), the rest of the line will be evaled before used as argument for the dispatcher. For the format of the first 5 columns, please see L<"add_entry">. Blank lines and lines starting with a C<#> will be ignored. There's no way to specify another subroutine within the crontab file. All calls will be made to the dispatcher provided at construction time. If you want to start up fresh, you should call C<$cron-Eclean_timetable()> before. Example of a crontab fiqw(le:) # The following line runs on every Monday at 2:34 am 34 2 * * Mon "make_stats" # The next line should be best read in with an eval=>1 argument * * 1 1 * { NEW_YEAR => '1',HEADACHE => 'on' } =cut #' sub load_crontab { my $self = shift; my $cfg = shift; if ($cfg) { if (@_) { $cfg = ref($cfg) eq "HASH" ? $cfg : { $cfg,@_ }; } elsif (!ref($cfg)) { my $new_cfg = { }; $new_cfg->{file} = $cfg; $cfg = $new_cfg; } } my $file = $cfg->{file} || $self->{cfg}->{file} || die "No filename provided"; my $eval = $cfg->{eval} || $self->{cfg}->{eval}; open(F,$file) || die "Cannot open schedule $file : $!"; my $line = 0; while () { $line++; # Strip off trailing comments and ignore empty # or pure comments lines: s/#.*$//; next if /^\s*$/; next if /^\s*#/; chomp; s/\s*(.*)\s*$/$1/; my ($min,$hour,$dmon,$month,$dweek,$rest) = split (/\s+/,$_,6); my $time = [ $min,$hour,$dmon,$month,$dweek ]; # Try to check, whether an optional 6th column specifying seconds # exists: my $args; if ($rest) { my ($col6,$more_args) = split(/\s+/,$rest,2); if ($col6 =~ /^[\d\-\*\,\/]+$/) { push @$time,$col6; dbg "M: $more_args"; $args = $more_args; } else { $args = $rest; } } $self->add_entry($time,{ 'args' => $args, 'eval' => $eval}); } close F; } =item $cron->add_entry($timespec,[arguments]) Adds a new entry to the list of scheduled cron jobs. B