tags 724137 + patch thanks Dear maintainer,
I've uploaded an NMU for libschedule-cron-perl (versioned as 1.01-0.1). The diff is attached to this message. Regards. -- .''`. Homepage: http://info.comodo.priv.at/ - OpenPGP key 0xBB3A68018649AA06 : :' : Debian GNU/Linux user, admin, and developer - http://www.debian.org/ `. `' Member of VIBE!AT & SPI, fellow of the Free Software Foundation Europe `-
diff -Nru libschedule-cron-perl-0.99/Build.PL libschedule-cron-perl-1.01/Build.PL
--- libschedule-cron-perl-0.99/Build.PL 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/Build.PL 2011-06-06 12:12:08.000000000 +0200
@@ -11,7 +11,7 @@
license => "perl",
requires => {
- "Time::ParseDate" => "99.00",
+ "Time::ParseDate" => "2011.0505",
"Data::Dumper" => "0"
},
@@ -19,16 +19,12 @@
"Test::More" => "0",
"Test" => "0",
},
- recommends => {
- "ioctl.ph" => 0,
- "sys::ioctl.ph" => 0,
- "Module::Build" => 0
- },
keywords => [ "Cron", "Scheduler", "Job" ],
provides => {
"Schedule::Cron" => {
file => "lib/Schedule/Cron.pm"
}
- }
+ },
+ configure_requires => { 'Module::Build' => 0}
);
$build->create_build_script;
diff -Nru libschedule-cron-perl-0.99/CHANGES libschedule-cron-perl-1.01/CHANGES
--- libschedule-cron-perl-0.99/CHANGES 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/CHANGES 2011-06-06 12:12:08.000000000 +0200
@@ -1,3 +1,28 @@
+1.01
+
+- 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
+
+- 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
- Fixed issue when switching back DST which can result into amok
diff -Nru libschedule-cron-perl-0.99/ChangeLog libschedule-cron-perl-1.01/ChangeLog
--- libschedule-cron-perl-0.99/ChangeLog 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/ChangeLog 2011-06-06 12:12:08.000000000 +0200
@@ -1,3 +1,16 @@
+2011-06-02 Roland Huss <rol...@consol.de>
+
+ * lib/Schedule/Cron.pm: Applied jumbo patch from RT #68533.
+
+ * (_update_queue): fixed DST detection (RT #63089)
+
+2010-05-14 Roland Huss <rol...@consol.de>
+
+ * Released Version 1.00. This is considered to be the final
+ release. After 10+ years, Schedule::Cron is now feature complete,
+ only bug fixes might lead to an additional release. Thanks for
+ your patience ;-)
+
2009-09-12 Roland Huss <rol...@consol.de>
* Released Version 0.99
diff -Nru libschedule-cron-perl-0.99/MANIFEST libschedule-cron-perl-1.01/MANIFEST
--- libschedule-cron-perl-0.99/MANIFEST 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/MANIFEST 2011-06-06 12:12:08.000000000 +0200
@@ -2,6 +2,8 @@
ChangeLog
CHANGES
examples/simple.pl
+examples/cron.tab
+examples/custom_sleep.pl
lib/Schedule/Cron.pm
Makefile.PL
MANIFEST This list of files
@@ -21,3 +23,5 @@
t/sighandler.t
t/startup.t
t/test.crontab
+t/delete_entry.t
+META.json
diff -Nru libschedule-cron-perl-0.99/META.json libschedule-cron-perl-1.01/META.json
--- libschedule-cron-perl-0.99/META.json 1970-01-01 01:00:00.000000000 +0100
+++ libschedule-cron-perl-1.01/META.json 2011-06-06 12:12:08.000000000 +0200
@@ -0,0 +1,48 @@
+{
+ "abstract" : "cron-like scheduler for Perl subroutines",
+ "author" : [
+ "Roland Huss (rol...@cpan.org)"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.110580",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
+ "version" : "2"
+ },
+ "name" : "Schedule-Cron",
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "Test" : 0,
+ "Test::More" : 0
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "Module::Build" : 0
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Data::Dumper" : 0,
+ "Time::ParseDate" : "2011.0505"
+ }
+ }
+ },
+ "provides" : {
+ "Schedule::Cron" : {
+ "file" : "lib/Schedule/Cron.pm",
+ "version" : "1.01"
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "license" : [
+ "http://dev.perl.org/licenses/";
+ ]
+ },
+ "version" : "1.01"
+}
diff -Nru libschedule-cron-perl-0.99/META.yml libschedule-cron-perl-1.01/META.yml
--- libschedule-cron-perl-0.99/META.yml 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/META.yml 2011-06-06 12:12:08.000000000 +0200
@@ -1,29 +1,26 @@
---
-name: Schedule-Cron
-version: 0.99
+abstract: 'cron-like scheduler for Perl subroutines'
author:
- - Roland Huss (rol...@cpan.org)
-abstract: cron-like scheduler for Perl subroutines
-license: perl
-resources:
- license: http://dev.perl.org/licenses/
+ - 'Roland Huss (rol...@cpan.org)'
build_requires:
Test: 0
Test::More: 0
-requires:
- Data::Dumper: 0
- Time::ParseDate: 99.00
-recommends:
- Module::Build: 0
- ioctl.ph: 0
- sys::ioctl.ph: 0
configure_requires:
- Module::Build: 0.34
-provides:
- Schedule::Cron:
- file: lib/Schedule/Cron.pm
- version: 0.99
-generated_by: Module::Build version 0.34
+ Module::Build: 0
+dynamic_config: 1
+generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.110580'
+license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
+name: Schedule-Cron
+provides:
+ Schedule::Cron:
+ file: lib/Schedule/Cron.pm
+ version: 1.01
+requires:
+ Data::Dumper: 0
+ Time::ParseDate: 2011.0505
+resources:
+ license: http://dev.perl.org/licenses/
+version: 1.01
diff -Nru libschedule-cron-perl-0.99/Makefile.PL libschedule-cron-perl-1.01/Makefile.PL
--- libschedule-cron-perl-0.99/Makefile.PL 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/Makefile.PL 2011-06-06 12:12:08.000000000 +0200
@@ -6,10 +6,16 @@
VERSION_FROM => "lib/Schedule/Cron.pm",
($] >= 5.005
? (ABSTRACT => 'Cron-like scheduler for Perl subroutines',
- AUTHOR => 'Roland Huss (rol...@cpan.org)')
+ AUTHOR => 'Roland Huss (rol...@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" => '99.00',"Data::Dumper" => 0},
+ PREREQ_PM => { "Time::ParseDate" => '2011.0505',"Data::Dumper" => 0},
'dist' => {COMPRESS=>'gzip',SUFFIX=>'gz'}
);
diff -Nru libschedule-cron-perl-0.99/README libschedule-cron-perl-1.01/README
--- libschedule-cron-perl-0.99/README 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/README 2011-06-06 12:12:08.000000000 +0200
@@ -122,17 +122,13 @@
REPORTING BUGS
--------------
-This module is still in alpha stage, so I expect probably some bugs
-showing up. I.e. the calculation of the next execution time of a
-specific crontab entry might fail in some obscure circumstances
-(though I did what I could to test it thoroughly).
-
-If you meet a bug (say hello to it ;-), please report it to
-rol...@consol.de with a subject like "Schedule::Cron Bug-Report". In
-addition of a problem description, please add a short description of
-you OS, your Perl version and the version of Time::ParseDate you are
-using. If some of the provided tests fail, include the output of 'make
-test TEST_VERBOSE=1' as well.
+If you meet a bug (say hello to it ;-), open a ticket at
+https://rt.cpan.org/Ticket/Create.html?Queue=Schedule-Cron.
+
+In addition of a problem description, please add a short description
+of you OS, your Perl version and the version of Time::ParseDate you
+are using. If some of the provided tests fail, include the output of
+'make test TEST_VERBOSE=1' as well.
If you suspect, that the date calculation of the next execution time
is buggy, please use the following interactive command to generate a
@@ -149,7 +145,7 @@
LICENSE
-------
-Copyright 1999-2009 Roland Huss.
+Copyright 1999-2011 Roland Huss.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff -Nru libschedule-cron-perl-0.99/debian/changelog libschedule-cron-perl-1.01/debian/changelog
--- libschedule-cron-perl-0.99/debian/changelog 2014-03-11 19:29:59.000000000 +0100
+++ libschedule-cron-perl-1.01/debian/changelog 2014-03-11 19:29:59.000000000 +0100
@@ -1,3 +1,16 @@
+libschedule-cron-perl (1.01-0.1) unstable; urgency=medium
+
+ * Non-maintainer upload.
+ * New upstream release.
+ Fixes "FTBFS: Tests failures" (Closes: #724137)
+ * debian/rules: reduce to three-line version to get build-{arch,indep}
+ targets.
+ * Make (build) dependency on libtime-modules-perl versioned, as per new
+ upstream requirements.
+ * Update years of upstream copyright, and fix link to GPL-1.
+
+ -- gregor herrmann <gre...@debian.org> Tue, 11 Mar 2014 18:56:44 +0100
+
libschedule-cron-perl (0.99-1) unstable; urgency=low
* New upstream version.
diff -Nru libschedule-cron-perl-0.99/debian/control libschedule-cron-perl-1.01/debian/control
--- libschedule-cron-perl-0.99/debian/control 2014-03-11 19:29:59.000000000 +0100
+++ libschedule-cron-perl-1.01/debian/control 2014-03-11 19:29:59.000000000 +0100
@@ -2,14 +2,14 @@
Section: perl
Priority: optional
Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl (>= 5.6.0-16), libtime-modules-perl, libtest-pod-perl (>= 1.00), libtest-pod-coverage-perl, libtest-kwalitee-perl
+Build-Depends-Indep: perl (>= 5.6.0-16), libtime-modules-perl (>= 2011.0505), libtest-pod-perl (>= 1.00), libtest-pod-coverage-perl, libtest-kwalitee-perl
Maintainer: Miguelangel Jose Freitas Loreto <miguelangel.frei...@gmail.com>
Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/Schedule-Cron/
Package: libschedule-cron-perl
Architecture: all
-Depends: ${perl:Depends}, ${misc:Depends}, libtime-modules-perl
+Depends: ${perl:Depends}, ${misc:Depends}, libtime-modules-perl (>= 2011.0505)
Description: Simple but complete cron like scheduler
This perl module can be used for periodically executing perl
subroutines. The dates and parameters for the subroutines to be
diff -Nru libschedule-cron-perl-0.99/debian/copyright libschedule-cron-perl-1.01/debian/copyright
--- libschedule-cron-perl-0.99/debian/copyright 2014-03-11 19:29:59.000000000 +0100
+++ libschedule-cron-perl-1.01/debian/copyright 2014-03-11 19:29:59.000000000 +0100
@@ -7,7 +7,7 @@
Upstream-Source: http://search.cpan.org/dist/Schedule-Cron/
Files: *
-Copyright: Copyright 1999-2006 Roland Huss.
+Copyright: Copyright 1999-2011 Roland Huss.
License: Perl
Files: debian/*
@@ -19,7 +19,7 @@
License: GPL-1+
On Debian systems, a copy of the GPL licenses are found in
- /usr/share/common-licenses/GPL
+ /usr/share/common-licenses/GPL-1
License: Artistic
On Debian systems, a copy of the Artistic licenses are found in
diff -Nru libschedule-cron-perl-0.99/debian/rules libschedule-cron-perl-1.01/debian/rules
--- libschedule-cron-perl-0.99/debian/rules 2014-03-11 19:29:59.000000000 +0100
+++ libschedule-cron-perl-1.01/debian/rules 2014-03-11 19:29:59.000000000 +0100
@@ -1,23 +1,4 @@
#!/usr/bin/make -f
-build: build-stamp
-build-stamp:
- dh build
- touch $@
-
-clean:
+%:
dh $@
-
-install: install-stamp
-install-stamp: build-stamp
- dh install
- touch $@
-
-binary-arch:
-
-binary-indep: install
- dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build
diff -Nru libschedule-cron-perl-0.99/examples/cron.tab libschedule-cron-perl-1.01/examples/cron.tab
--- libschedule-cron-perl-0.99/examples/cron.tab 1970-01-01 01:00:00.000000000 +0100
+++ libschedule-cron-perl-1.01/examples/cron.tab 2011-06-06 12:12:08.000000000 +0200
@@ -0,0 +1,3 @@
+# Sample cron tab used for custom_sleep.pl
+34 2 * * Mon "make_stats"
+43 8 * * Wed "Make Peace"
diff -Nru libschedule-cron-perl-0.99/examples/custom_sleep.pl libschedule-cron-perl-1.01/examples/custom_sleep.pl
--- libschedule-cron-perl-0.99/examples/custom_sleep.pl 1970-01-01 01:00:00.000000000 +0100
+++ libschedule-cron-perl-1.01/examples/custom_sleep.pl 2011-06-06 12:12:08.000000000 +0200
@@ -0,0 +1,389 @@
+#!/usr/bin/perl
+
+# Copyright (c) 2011 Timothe Litt <litt at acm dot org>
+#
+# 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<Schedule::Cron> 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] || '<Unnamed>', # 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;
+}
diff -Nru libschedule-cron-perl-0.99/lib/Schedule/Cron.pm libschedule-cron-perl-1.01/lib/Schedule/Cron.pm
--- libschedule-cron-perl-0.99/lib/Schedule/Cron.pm 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/lib/Schedule/Cron.pm 2011-06-06 12:12:08.000000000 +0200
@@ -41,15 +41,15 @@
The philosophy behind C<Schedule::Cron> is to call subroutines periodically
from within one single Perl program instead of letting C<cron> trigger several
-(possibly different) perl scripts. Everything under one roof. Furthermore
+(possibly different) Perl scripts. Everything under one roof. Furthermore,
C<Schedule::Cron> provides mechanism to create crontab entries dynamically,
which isn't that easy with C<cron>.
C<Schedule::Cron> 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. And even a bit more
-(like lists and ranges with symbolic names).
+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
@@ -79,7 +79,7 @@
}
-$VERSION = "0.99";
+$VERSION = "1.01";
our $DEBUG = 0;
my %STARTEDCHILD = ();
@@ -110,7 +110,7 @@
[ 0,31 ],
[ 0,12 ],
[ 0,7 ],
- [ 0,60 ]
+ [ 0,59 ]
);
my @LOWMAP = (
@@ -122,15 +122,33 @@
{},
);
+
+# Currently, there are two ways for reaping. One, which only waits explicitely
+# 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
+# one. 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)
{
- # Only on platforms supporting POSIX semantisc
foreach my $pid (keys %STARTEDCHILD) {
- my $res = $HAS_POSIX ? waitpid($pid, WNOHANG) : waitpid($pid,0);
- if ($res > 0) {
- # We reaped a truly running process
- delete $STARTEDCHILD{$pid};
+ 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;
+ }
}
}
}
@@ -143,6 +161,58 @@
}
}
+# Catch all reaper
+sub _reaper_all {
+ 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;
+ print "Kid: $kid\n";
+ if ($kid != 0 && $kid != -1 && defined $STARTEDCHILD{$kid})
+ {
+ # We don't delete the hash entry here to avoid an issue
+ # when modifyinga 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<Cron> object. C<$dispatcher> is a reference to a subroutine,
@@ -181,6 +251,11 @@
independent of each other job and the main process. This is due to the nature
of the C<fork> 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
@@ -231,13 +306,51 @@
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 => <name>
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<Schedule::Cron>. With this
option you can set it to something different. You can e.g. use C<$0> to include
-the original process name.
+the original process name. You can inhibit this with the C<nostatus> option, and
+prevent the argument display by setting C<loglevel> to zero or higher.
+
+=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
@@ -504,7 +617,7 @@
{
die "You have to provide a simple scalar if using eval" if (ref($args));
my $orig_args = $args;
- dbg "Evaled args ",Dumper($args);
+ dbg "Evaled args ",Dumper($args) if $DEBUG;
$args = [ eval $args ];
die "Cannot evaluate args (\"$orig_args\")"
if $@;
@@ -625,6 +738,19 @@
if ($idx <= $#{$self->{time_table}})
{
$self->{entries_changed} = 1;
+
+ # Remove entry from $self->{map} which
+ # remembers the index in the timetable by name (==id)
+ # and update all larger indexes appropriately
+ # Fix for #54692
+ my $map = $self->{map};
+ foreach my $key (keys %{$map}) {
+ if ($map->{$key} > $idx) {
+ $map->{$key}--;
+ } elsif ($map->{$key} == $idx) {
+ delete $map->{$key};
+ }
+ }
return splice @{$self->{time_table}},$idx,1;
}
else
@@ -636,8 +762,8 @@
=item $cron->update_entry($idx,$entry)
Updates the entry with index C<$idx>. C<$entry> is a hash ref as descibed in
-C<list_entries()> and must contain at least a value C<$entry->{time}>. If no
-C<$entry->{dispatcher}> is given, then the default dispatcher is used. This
+C<list_entries()> and must contain at least a value C<$entry-E<gt>{time}>. If no
+C<$entry-E<gt>{dispatcher}> is given, then the default dispatcher is used. This
method returns the old entry on success, C<undef> otherwise.
=cut
@@ -693,7 +819,7 @@
the scheduler process should be written. By default, no PID File will be
created.
-=item nofork, skip, catch, log
+=item nofork, skip, catch, log, loglevel, nostatus, sleep
See C<new()> for a description of these configuration parameters, which can be
provided here as well. Note, that the options given here overrides those of the
@@ -721,25 +847,36 @@
$cfg = { %{$self->{cfg}}, %$cfg }; # Merge in global config;
my $log = $cfg->{log};
+ my $loglevel = $cfg->{loglevel};
+ $loglevel = 0 unless defined $loglevel;
+ my $sleeper = $cfg->{sleep};
- $self->_build_initial_queue;
+ $self->_rebuild_queue;
delete $self->{entries_changed};
die "Nothing in schedule queue" unless @{$self->{queue}};
# Install reaper now.
- my $old_child_handler = $SIG{'CHLD'};
- $SIG{'CHLD'} = sub {
- &REAPER();
- if ($old_child_handler && ref $old_child_handler eq 'CODE')
- {
- &$old_child_handler();
- }
- };
-
- my $mainloop = sub
- {
- while (42)
+ unless ($cfg->{nofork}) {
+ my $old_child_handler = $SIG{'CHLD'};
+ $SIG{'CHLD'} = sub {
+ &REAPER();
+ if ($old_child_handler && ref $old_child_handler eq 'CODE')
+ {
+ &$old_child_handler();
+ }
+ };
+ }
+
+ my $mainloop = sub {
+ MAIN:
+ while (42)
{
+ unless (@{$self->{queue}}) # Queue length
+ {
+ # Last job deleted itself, or we were run with no entries.
+ # We can't return, so throw an exception - perhaps somone will catch.
+ die "No more jobs to run\n";
+ }
my ($index,$time) = @{shift @{$self->{queue}}};
my $now = time;
my $sleep = 0;
@@ -748,7 +885,7 @@
if ($cfg->{skip})
{
$log->(0,"Schedule::Cron - Skipping job $index")
- if $log;
+ if $log && $loglevel <= 0;
$self->_update_queue($index);
next;
}
@@ -759,23 +896,36 @@
{
$sleep = $time - $now;
}
- $0 = $self->_get_process_prefix()." MainLoop - next: ".scalar(localtime($time));
+ $0 = $self->_get_process_prefix()." MainLoop - next: ".scalar(localtime($time)) unless $cfg->{nostatus};
if (!$time) {
die "Internal: No time found, self: ",$self->{queue},"\n" unless $time;
}
- dbg "R: sleep = $sleep | ",scalar(localtime($time))," (",scalar(localtime($now)),")";
+ dbg "R: sleep = $sleep | ",scalar(localtime($time))," (",scalar(localtime($now)),")" if $DEBUG;
+
while ($sleep > 0)
{
- sleep($sleep);
+ if ($sleeper)
+ {
+ $sleeper->($sleep,$self);
+ if ($self->{entries_changed})
+ {
+ $self->_rebuild_queue;
+ delete $self->{entries_changed};
+ redo MAIN;
+ }
+ } else {
+ sleep($sleep);
+ }
$sleep = $time - time;
}
$self->_execute($index,$cfg);
+ $self->_cleanup_process_list($cfg);
if ($self->{entries_changed}) {
- dbg "rebuilding queue";
- $self->_build_initial_queue;
+ dbg "rebuilding queue" if $DEBUG;
+ $self->_rebuild_queue;
delete $self->{entries_changed};
} else {
$self->_update_queue($index);
@@ -840,7 +990,7 @@
}
open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
- $0 = $self->_get_process_prefix()." MainLoop";
+ $0 = $self->_get_process_prefix()." MainLoop" unless $cfg->{nostatus};
&$mainloop();
}
}
@@ -1002,7 +1152,7 @@
$expanded[4] = \@bak;
$expanded[2] = [ '*' ];
my $t2 = $self->_calc_time($now,\@expanded);
- dbg "MDay : ",scalar(localtime($t1))," -- WDay : ",scalar(localtime($t2));
+ dbg "MDay : ",scalar(localtime($t1))," -- WDay : ",scalar(localtime($t2)) if $DEBUG;
return $t1 < $t2 ? $t1 : $t2;
}
else
@@ -1018,7 +1168,7 @@
# Build up executing queue and delete any
# existing entries
-sub _build_initial_queue
+sub _rebuild_queue
{
my $self = shift;
$self->{queue} = [ ];
@@ -1053,13 +1203,14 @@
my $log = $cfg->{log};
+ my $loglevel = $cfg->{loglevel} || 0;
unless ($cfg->{nofork})
{
- if ($pid = fork)
+ if ($pid = fork)
{
# Parent
- $log->(0,"Schedule::Cron - Forking child PID $pid") if $log;
+ $log->(0,"Schedule::Cron - Forking child PID $pid") if $log && $loglevel <= 0;
# Register PID
$STARTEDCHILD{$pid} = 1;
return;
@@ -1079,12 +1230,13 @@
}
- my $args_label = @args ? "with (".join(",",$self->_format_args(@args)).")" : "";
- $0 = $self->_get_process_prefix()." Dispatched with $args_label"
- unless $cfg->{nofork};
- $log->(0,"Schedule::Cron - Starting job $index $args_label")
- if $log;
-
+ if ($log && $loglevel <= 0 || !$cfg->{nofork} && !$cfg->{nostatus}) {
+ my $args_label = (@args && $loglevel <= -1) ? " with (".join(",",$self->_format_args(@args)).")" : "";
+ $0 = $self->_get_process_prefix()." Dispatched job $index$args_label"
+ unless $cfg->{nofork} || $cfg->{nostatus};
+ $log->(0,"Schedule::Cron - Starting job $index$args_label")
+ if $log && $loglevel <= 0;
+ }
my $dispatch_result;
if ($cfg->{catch})
{
@@ -1096,7 +1248,7 @@
if ($@)
{
$log->(2,"Schedule::Cron - Error within job $index: $@")
- if $log;
+ if $log && $loglevel <= 2;
}
}
else
@@ -1115,14 +1267,15 @@
if ($@)
{
$log->(2,"Schedule::Cron - Error while calling after_job callback with retval = $dispatch_result: $@")
- if $log;
+ if $log && $loglevel <= 2;
}
} else {
- $log->(2,"Schedule::Cron - Invalid after_job callback, it's not a code ref (but ",$job,")");
+ $log->(2,"Schedule::Cron - Invalid after_job callback, it's not a code ref (but ",$job,")")
+ if $log && $loglevel <= 2;
}
}
- $log->(0,"Schedule::Cron - Finished job $index") if $log;
+ $log->(0,"Schedule::Cron - Finished job $index") if $log && $loglevel <= 0;
exit unless $cfg->{nofork};
}
@@ -1137,15 +1290,15 @@
# Check, whether next execution time is *smaller* than the current time.
# This can happen during DST backflip:
my $now = time;
- if ($new_time < $now) {
- dbg "Adjusting time calculation because of DST back flip (new_time - now = ",$new_time - $now,")";
+ if ($new_time <= $now) {
+ dbg "Adjusting time calculation because of DST back flip (new_time - now = ",$new_time - $now,")" if $DEBUG;
# We are adding hours as long as our target time is in the future
- while ($new_time < $now) {
+ while ($new_time <= $now) {
$new_time += 3600;
}
}
- dbg "Updating Queue: ",scalar(localtime($new_time));
+ dbg "Updating Queue: ",scalar(localtime($new_time)) if $DEBUG;
$self->{queue} = [ sort { $a->[1] <=> $b->[1] } @{$self->{queue}},[$index,$new_time] ];
# dbg "Queue now: ",Dumper($self->{queue});
}
@@ -1179,7 +1332,7 @@
# Airbag...
while ($dest_year <= $now_year + 1)
{
- dbg "Parsing $dest_hour:$dest_min:$dest_sec $dest_year/$dest_mon/$dest_mday";
+ dbg "Parsing $dest_hour:$dest_min:$dest_sec $dest_year/$dest_mon/$dest_mday" if $DEBUG;
# Check month:
if ($expanded->[3]->[0] ne '*')
@@ -1210,7 +1363,7 @@
$dest_mon = 1;
$dest_year++;
}
- dbg "Backtrack mday: $dest_mday/$dest_mon/$dest_year";
+ dbg "Backtrack mday: $dest_mday/$dest_mon/$dest_year" if $DEBUG;
next;
}
}
@@ -1235,9 +1388,9 @@
$mon++;
$year += 1900;
- dbg "Calculated $mday/$mon/$year for weekday ",$WDAYS[$dest_wday];
+ dbg "Calculated $mday/$mon/$year for weekday ",$WDAYS[$dest_wday] if $DEBUG;
if ($mon != $dest_mon || $year != $dest_year) {
- dbg "backtracking";
+ dbg "backtracking" if $DEBUG;
$dest_mon = $mon;
$dest_year = $year;
$dest_mday = 1;
@@ -1355,7 +1508,7 @@
# We did it !!
my $date = sprintf("%2.2d:%2.2d:%2.2d %4.4d/%2.2d/%2.2d",
$dest_hour,$dest_min,$dest_sec,$dest_year,$dest_mon,$dest_mday);
- dbg "Next execution time: $date ",$WDAYS[$dest_wday];
+ dbg "Next execution time: $date ",$WDAYS[$dest_wday] if $DEBUG;
my $result = parsedate($date, VALIDATE => 1);
# Check for a valid date
if ($result)
@@ -1422,6 +1575,9 @@
# our very own debugging routine
# ('guess everybody has its own style ;-)
+# Callers check $DEBUG on the critical path to save the computes
+# used to produce expensive arguments. Omitting those would be
+# functionally correct, but rather wasteful.
sub dbg
{
if ($DEBUG)
@@ -1643,8 +1799,8 @@
Daylight saving occurs typically twice a year: In the first switch, one hour is
skipped. Any job which which triggers in this skipped hour will be fired in the
-next hour. So, when the DST switch goes from 2:00 to 3:00 a job would is
-scheduled for 2:43, then it will be executed at 3:43.
+next hour. So, when the DST switch goes from 2:00 to 3:00 a job which is
+scheduled for 2:43 will be executed at 3:43.
For the reverse backwards switch later in the year, the behaviour is
undefined. Two possible behaviours can occur: For jobs triggered in short
@@ -1673,7 +1829,7 @@
=head1 LICENSE
-Copyright 1999-2009 Roland Huss.
+Copyright 1999-2011 Roland Huss.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff -Nru libschedule-cron-perl-0.99/t/delete_entry.t libschedule-cron-perl-1.01/t/delete_entry.t
--- libschedule-cron-perl-0.99/t/delete_entry.t 1970-01-01 01:00:00.000000000 +0100
+++ libschedule-cron-perl-1.01/t/delete_entry.t 2011-06-06 12:12:08.000000000 +0200
@@ -0,0 +1,46 @@
+#!/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;
+}
diff -Nru libschedule-cron-perl-0.99/t/execution_time.t libschedule-cron-perl-1.01/t/execution_time.t
--- libschedule-cron-perl-0.99/t/execution_time.t 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/t/execution_time.t 2011-06-06 12:12:08.000000000 +0200
@@ -20,7 +20,6 @@
my $skip = 0;
while (defined($_=<DATA>) && $_ !~ /^end/i) {
chomp;
- next if $skip;
if (/^Reftime:\s*(.*)$/) {
$time = $1;
$time =~ s/\#.*$//;
@@ -35,6 +34,7 @@
$skip = 0;
next;
}
+ next if $skip;
s/^\s*(.*)\s*/$1/;
next if /^\#/ || /^$/;
my @args = split(/\s+/,$_,6);
@@ -207,6 +207,11 @@
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
diff -Nru libschedule-cron-perl-0.99/t/kwalitee.t libschedule-cron-perl-1.01/t/kwalitee.t
--- libschedule-cron-perl-0.99/t/kwalitee.t 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/t/kwalitee.t 2011-06-06 12:12:08.000000000 +0200
@@ -1,6 +1,12 @@
#!/usr/bin/perl
use Test::More;
-eval { require Test::Kwalitee; Test::Kwalitee->import() };
+eval {
+ require Test::Kwalitee;
+};
-plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
+if ($@) {
+ plan( skip_all => 'Test::Kwalitee not installed; skipping' );
+} else {
+ Test::Kwalitee->import();
+}
diff -Nru libschedule-cron-perl-0.99/t/sighandler.t libschedule-cron-perl-1.01/t/sighandler.t
--- libschedule-cron-perl-0.99/t/sighandler.t 2009-09-12 09:19:15.000000000 +0200
+++ libschedule-cron-perl-1.01/t/sighandler.t 2011-06-06 12:12:08.000000000 +0200
@@ -4,8 +4,13 @@
# $Id: sighandler.t,v 1.2 2006/11/27 13:42:52 roland Exp $
use Schedule::Cron;
-use Test::More tests => 1;
+use Test::More;
+if ($^O =~ /Win32/i) {
+ plan skip_all => "Test doesn't work on Win32";
+} else {
+ plan tests => 1;
+}
$| = 1;
SKIP: {
signature.asc
Description: Digital Signature
