Schedule-Cron-1.01000755000765000024 011573123770 13637 5ustar00rolandstaff000000000000Schedule-Cron-1.01/Build.PL000444000765000024 155711573123770 15300 0ustar00rolandstaff000000000000#!/usr/bin/perl use Module::Build; my $build = Module::Build->new ( module_name => "Schedule::Cron", dist_author => 'Roland Huss (roland@cpan.org)', abstract => 'Cron-like scheduler for Perl subroutines', distribution_type => 'module', installdirs => 'site', license => "perl", requires => { "Time::ParseDate" => "2011.0505", "Data::Dumper" => "0" }, build_requires => { "Test::More" => "0", "Test" => "0", }, keywords => [ "Cron", "Scheduler", "Job" ], provides => { "Schedule::Cron" => { file => "lib/Schedule/Cron.pm" } }, configure_requires => { 'Module::Build' => 0} ); $build->create_build_script; Schedule-Cron-1.01/ChangeLog000444000765000024 755411573123770 15561 0ustar00rolandstaff0000000000002011-06-02 Roland Huss * lib/Schedule/Cron.pm: Applied jumbo patch from RT #68533. * (_update_queue): fixed DST detection (RT #63089) 2010-05-14 Roland Huss * 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 * Released Version 0.99 2009-09-05 Roland Huss * 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. 2009-04-03 Roland Huss * Released Version 0.98 2009-03-24 Roland Huss * lib/Schedule/Cron.pm (load_crontab): Allow comment at the end of a crontab line 2009-03-23 Roland Huss * 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 2009-03-21 Roland Huss * Cron.pm (_time_as_string): marked all private subs to start with '_' 2009-03-20 Roland Huss * t/pretty_print_args.t: Arguments are logged using Data::Dumper in a terse format * t/after_job.t: Added new option 'after_job' and test for it which allows for a single callback after any job has been run. 2006-11-27 Roland Huss * Cron.pm (REAPER): Added support for plattforms where POSIX is not available. (run): Call previous childhandler only if it is a coderef 2006-11-08 Roland Huss * Cron.pm (run): Removed leading space when no process prefix is used (for backwards compatibility) 2006-11-05 Roland Huss * CHANGES: added long forgotten patch for child process handling 2006-11-05 Roland Huss * CHANGES: added patches and suggestions from - Andrew Danforth - Frank Mayer - Jamie McCarthy - Andy Ford Thanks ! 2006-11-04 Roland Huss * Cron.pm: Worked on: - Reexamination of crontabs entry in 'nofork' mode if someone has added a new entry 2004-01-30 Roland Huss * t/entry.t (Module): added and extended tests 2004-01-29 Roland Huss * Cron.pm (add_entry): added heuristic for parsing crontab with 6 time columns 2004-01-28 Roland Huss * Cron.pm (new): added new options 'nofork', 'skip', 'catch' and 'log' (get_next_execution_time): allow a sixth column for specifing the second to start up 2002-08-09 Roland Huss * Cron.pm (get_next_execution_time): added recognition of "*/5" notations (thanks to Loic Paillotin for spotting this problem) 2002-04-02 Roland Huss * Released 0.0.5 2000-07-05 Roland Huss * 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 2000-06-14 Roland Huss * 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 2000-06-12 Roland Huss * Cron.pm: Fixed bug in regexp splitting the crontab entry in get_next_execution_time() report by Peter Vary 2000-03-23 Roland Huss * 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) 2000-01-02 Roland Huss * Initial release 0.001 Schedule-Cron-1.01/CHANGES000444000765000024 647411573123770 15002 0ustar00rolandstaff0000000000001.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 running jobs during this period. The behaviour for jobs triggered within this rewinded hour is still not defined properly (yet). 0.98 - 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 0.97 - Use POSIX only where available, otherwise fallback to an emulation of waipid. - Fixed bug when previous SIGCHLD handler was not a coderef, but a String value like "DEFAULT" or "IGNORE" - Added tests - Made test more robust so they work now also on system without alarm() functionality (Win32) 0.96 - Applied patch for #4917 in order to be smarter to existing SIGCHLD handler and to reap only own childs. 0.95 - 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/norfork 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" 0.9 - 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. - Seconds granularity: Cron times can now be specified up to the second. - Bugfix: Thinks like "*/5" now work like expected 0.05 - Other bugfixes for parsedate problem with single digit hours/minutes and warnings if argumentlist of command to execute is empty 0.03 - Minor bug fixes (reaping of child processes improved, fixed regexp in get_next_execution_time()) 0.01 - Initial Release Schedule-Cron-1.01/Makefile.PL000444000765000024 133011573123770 15743 0ustar00rolandstaff000000000000use ExtUtils::MakeMaker; WriteMakefile ( NO_META => 1, 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.01/MANIFEST000444000765000024 62411573123770 15107 0ustar00rolandstaff000000000000Build.PL ChangeLog CHANGES examples/simple.pl examples/cron.tab examples/custom_sleep.pl lib/Schedule/Cron.pm Makefile.PL MANIFEST This list of files META.yml 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/sighandler.t t/startup.t t/test.crontab t/delete_entry.t META.json Schedule-Cron-1.01/META.json000444000765000024 205611573123770 15420 0ustar00rolandstaff000000000000{ "abstract" : "cron-like scheduler for Perl subroutines", "author" : [ "Roland Huss (roland@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" } Schedule-Cron-1.01/META.yml000444000765000024 113611573123770 15246 0ustar00rolandstaff000000000000--- abstract: 'cron-like scheduler for Perl subroutines' author: - 'Roland Huss (roland@cpan.org)' build_requires: Test: 0 Test::More: 0 configure_requires: 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 Schedule-Cron-1.01/README000444000765000024 1244411573123770 14701 0ustar00rolandstaff000000000000 Schedule::Cron ============== This module provides a simple but complete cron like scheduler. I.e this modules 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 manpage crontab(5) or documentation of Schedule::Cron). The philosophy behind Schedule::Cron is to call subroutines periodically from within one single Perl program instead of letting cron trigger several (possibly different) Perl scripts. Everything under one roof. Furthermore Schedule::Cron provides mechanism to create crontab entries dynamically, which isn't that easy with cron. 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). This module is rather effective concerning system load. It calculates the execution dates in advance and will sleep until those dates are reached (and wont wake up every minute to check for execution like cron). However, it relies on the accuracy of your sleep() system call. EXAMPLES -------- * Minimalistic: use Schedule::Cron; my $dispatcher = sub { print "Time to start...\n"}; my $cron = new Schedule::Cron($dispatcher); $cron->add_entry("0 7 * * *"); $cron->run; # Runs forever... * A bit more complex: use Schedule::Cron; my $cron = new Schedule::Cron( sub { print "@_","\n" }, file => "check_links.sched", eval => 1); sub check_links { my $args = shift; print "URL: ",$args->{url},"\n"; print "Depth: ",$args->{depth},"\n"; } $cron->add_entry("0-40/5,55 3,22 * Jan-Nov Fri", { sub => \&check_links, args => [ { url => "http://www.consol.de", depth => 2 } ], eval => 0 }); # ... add more .... $cron->run(detach=>1,pid_file=>"/var/run/checker.pid"); # ... continue ... * simple cron replacement (for a single crontab file): use Schedule::Cron; my $cron = new Schedule::Cron(sub { system(shift) }, file => "/var/spool/crontab.perl"); $cron->run(); PREREQUISITES ------------- In order to install and use this package you will need Perl version 5.005 or better. Furthermore you need the module Time::ParseDate (contained in the Time-modules-xx.xxxxx) available on CPAN. You need a fork()-aware Perl for dispatching the cron jobs. This might change in the future. On systems without a fork() system call you can use the 'nofork' option to run your jobs within the current process. OS-DEPENDENCIES --------------- Schedule::Cron was tested on a Redhat Linux-Box, but it should work on any UNIX Box. In depends on some original UNIX system calls for starting jobs and detaching itself to the background: * It uses fork() for starting jobs * For detaching it uses either setsid (POSIX) or the ioctl call TIOCNOTTY The roadmap include plans for porting the fork mechanism over to a thread based scheme, which should make dynamic update much easier. If the system calls mentioned above are not available (which should hapen nowadays only under rare circumstances), you can still use the 'nofork' option to run all jobs within a single process/thread. Please refer to the documentation for further reading. INSTALLATION ------------ Installation can be don either in the old fashioned way perl Makefile.PL make make test make install or alternatively with Module::Build perl Build.PL ./Build ./Build test ./Build install See the documentation for Schedule::Cron for a detailed description and further usage examples. REPORTING BUGS -------------- 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 bug report. perl -MSchedule::Cron -e 'bug Schedule::Cron' You will be asked for a reference time (default: the current time), a crontab date pattern (with five columns) and the expected next execution date (relative to the reference time). The dates can be specified in a format understood by 'parsedate' from Time::ParseDate (like 'now + 5 days'). Please include the output of this command. LICENSE ------- 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. Enjoy it... ...roland (roland@cpan.org) Schedule-Cron-1.01/examples000755000765000024 011573123770 15455 5ustar00rolandstaff000000000000Schedule-Cron-1.01/examples/cron.tab000444000765000024 13711573123770 17224 0ustar00rolandstaff000000000000# Sample cron tab used for custom_sleep.pl 34 2 * * Mon "make_stats" 43 8 * * Wed "Make Peace" Schedule-Cron-1.01/examples/custom_sleep.pl000444000765000024 2656111573123770 20703 0ustar00rolandstaff000000000000#!/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.01/examples/simple.pl000444000765000024 153511573123770 17444 0ustar00rolandstaff000000000000#!/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.01/lib000755000765000024 011573123770 14405 5ustar00rolandstaff000000000000Schedule-Cron-1.01/lib/Schedule000755000765000024 011573123770 16141 5ustar00rolandstaff000000000000Schedule-Cron-1.01/lib/Schedule/Cron.pm000444000765000024 15552111573123770 17606 0ustar00rolandstaff000000000000#!/usr/bin/perl -w =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.01"; 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 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) { 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 ($!,%!); 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 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 behaviour 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 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 $self = { cfg => $cfg, dispatcher => $dispatcher, 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 /^$/; next if /^$/; 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