use strict;
use warnings;
+use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
+use DateTime;
+use DateTime::Event::Cron;
+use DateTime::TimeZone;
+use File::stat;
use NEXT;
-use base qw/Class::Accessor::Fast Class::Data::Inheritable Catalyst::Base/;
-use Catalyst::Plugin::Scheduler::Base;
+use Set::Scalar;
+use Storable qw/lock_store lock_retrieve/;
-our $VERSION = '0.07_01';
+our $VERSION = '0.07';
+__PACKAGE__->mk_classdata( '_events' => [] );
+__PACKAGE__->mk_accessors('_event_state');
+
+sub schedule {
+ my ( $class, %args ) = @_;
+
+ unless ( $args{event} ) {
+ Catalyst::Exception->throw(
+ message => 'The schedule method requires an event parameter' );
+ }
+
+ my $conf = $class->config->{scheduler};
+
+ my $event = {
+ trigger => $args{trigger},
+ event => $args{event},
+ auto_run => ( defined $args{auto_run} ) ? $args{auto_run} : 1,
+ };
+
+ if ( $args{at} ) {
+
+ # replace keywords that Set::Crontab doesn't support
+ $args{at} = _prepare_cron( $args{at} );
+
+ # parse the cron entry into a DateTime::Set
+ my $set;
+ eval { $set = DateTime::Event::Cron->from_cron( $args{at} ) };
+ if ($@) {
+ Catalyst::Exception->throw(
+ "Scheduler: Unable to parse 'at' value "
+ . $args{at} . ': '
+ . $@ );
+ }
+ else {
+ $event->{at} = $args{at};
+ $event->{set} = $set;
+ }
+ }
+
+ push @{ $class->_events }, $event;
+}
+
+sub dispatch {
+ my $c = shift;
+
+ $c->NEXT::dispatch(@_);
+
+ $c->_get_event_state();
+
+ $c->_check_yaml();
+
+ # check if a minute has passed since our last check
+ # This check is not run if the user is manually triggering an event
+ if ( time - $c->_event_state->{last_check} < 60 ) {
+ return unless $c->req->params->{schedule_trigger};
+ }
+ my $last_check = $c->_event_state->{last_check};
+ $c->_event_state->{last_check} = time;
+ $c->_save_event_state();
+
+ my $conf = $c->config->{scheduler};
+ my $last_check_dt = DateTime->from_epoch(
+ epoch => $last_check,
+ time_zone => $conf->{time_zone}
+ );
+ my $now = DateTime->now( time_zone => $conf->{time_zone} );
+
+ EVENT:
+ for my $event ( @{ $c->_events } ) {
+ my $next_run;
+
+ if ( $event->{trigger} && $c->req->params->{schedule_trigger}
+ && $event->{trigger} eq $c->req->params->{schedule_trigger} )
+ {
+
+ # manual trigger, run it now
+ next EVENT unless $c->_event_authorized;
+ $next_run = $now;
+ }
+ else {
+ next EVENT unless $event->{set};
+ $next_run = $event->{set}->next($last_check_dt);
+ }
+
+ if ( $next_run <= $now ) {
+
+ # do some security checking for non-auto-run events
+ if ( !$event->{auto_run} ) {
+ next EVENT unless $c->_event_authorized;
+ }
+
+ # make sure we're the only process running this event
+ next EVENT unless $c->_mark_running($event);
+
+ my $event_name = $event->{trigger} || $event->{event};
+ $c->log->debug("Scheduler: Executing $event_name")
+ if $c->config->{scheduler}->{logging};
+
+ # trap errors
+ local $c->{error} = [];
+
+ # return value/output from the event, if any
+ my $output;
+
+ # run event
+ eval {
+
+ # do not allow the event to modify the response
+ local $c->res->{body};
+ local $c->res->{cookies};
+ local $c->res->{headers};
+ local $c->res->{location};
+ local $c->res->{status};
+
+ if ( ref $event->{event} eq 'CODE' ) {
+ $output = $event->{event}->($c);
+ }
+ else {
+ $output = $c->forward( $event->{event} );
+ }
+ };
+ my @errors = @{ $c->{error} };
+ push @errors, $@ if $@;
+ if (@errors) {
+ $c->log->error(
+ 'Scheduler: Error executing ' . "$event_name: $_" )
+ for @errors;
+ $output = join '; ', @errors;
+ }
+
+ $c->_mark_finished( $event, $output );
+ }
+ }
+}
+
+sub setup {
+ my $c = shift;
+
+ # initial configuration
+ $c->config->{scheduler}->{logging} ||= ( $c->debug ) ? 1 : 0;
+ $c->config->{scheduler}->{time_zone} ||= $c->_detect_timezone();
+ $c->config->{scheduler}->{state_file} ||= $c->path_to('scheduler.state');
+ $c->config->{scheduler}->{hosts_allow} ||= '127.0.0.1';
+ $c->config->{scheduler}->{yaml_file} ||= $c->path_to('scheduler.yml');
+
+ $c->NEXT::setup(@_);
+}
+
+sub dump_these {
+ my $c = shift;
+
+ return ( $c->NEXT::dump_these(@_) ) unless @{ $c->_events };
+
+ # for debugging, we dump out a list of all events with their next
+ # scheduled run time
+ return (
+ $c->NEXT::dump_these(@_),
+ [ 'Scheduled Events', $c->scheduler_state ],
+ );
+}
+
+sub scheduler_state {
+ my $c = shift;
+
+ $c->_get_event_state();
+
+ my $conf = $c->config->{scheduler};
+ my $now = DateTime->now( time_zone => $conf->{time_zone} );
+
+ my $last_check = $c->_event_state->{last_check};
+ my $last_check_dt = DateTime->from_epoch(
+ epoch => $last_check,
+ time_zone => $conf->{time_zone},
+ );
+
+ my $event_dump = [];
+ for my $event ( @{ $c->_events } ) {
+ my $dump = {};
+ for my $key ( qw/at trigger event auto_run/ ) {
+ $dump->{$key} = $event->{$key} if $event->{$key};
+ }
+
+ # display the next run time
+ if ( $event->{set} ) {
+ my $next_run = $event->{set}->next($last_check_dt);
+ $dump->{next_run}
+ = $next_run->ymd
+ . q{ } . $next_run->hms
+ . q{ } . $next_run->time_zone_short_name;
+ }
+
+ # display the last run time
+ my $last_run
+ = $c->_event_state->{events}->{ $event->{event} }->{last_run};
+ if ( $last_run ) {
+ $last_run = DateTime->from_epoch(
+ epoch => $last_run,
+ time_zone => $conf->{time_zone},
+ );
+ $dump->{last_run}
+ = $last_run->ymd
+ . q{ } . $last_run->hms
+ . q{ } . $last_run->time_zone_short_name;
+ }
+
+ # display the result of the last run
+ my $output
+ = $c->_event_state->{events}->{ $event->{event} }->{last_output};
+ if ( $output ) {
+ $dump->{last_output} = $output;
+ }
+
+ push @{$event_dump}, $dump;
+ }
+
+ return $event_dump;
+}
+
+# check and reload the YAML file with schedule data
+sub _check_yaml {
+ my ($c) = @_;
+
+ # each process needs to load the YAML file independently
+ if ( $c->_event_state->{yaml_mtime}->{$$} ||= 0 ) {
+ return if ( time - $c->_event_state->{last_check} < 60 );
+ }
+
+ return unless -e $c->config->{scheduler}->{yaml_file};
+
+ eval {
+ my $mtime = ( stat $c->config->{scheduler}->{yaml_file} )->mtime;
+ if ( $mtime > $c->_event_state->{yaml_mtime}->{$$} ) {
+ $c->_event_state->{yaml_mtime}->{$$} = $mtime;
+
+ # clean up old PIDs listed in yaml_mtime
+ foreach my $pid ( keys %{ $c->_event_state->{yaml_mtime} } ) {
+ if ( $c->_event_state->{yaml_mtime}->{$pid} < $mtime ) {
+ delete $c->_event_state->{yaml_mtime}->{$pid};
+ }
+ }
+ $c->_save_event_state();
+
+ # wipe out all current events and reload from YAML
+ $c->_events( [] );
+
+ my $file = $c->config->{scheduler}->{yaml_file};
+ my $yaml;
+
+ eval { require YAML::Syck; };
+ if( $@ ) {
+ require YAML;
+ $yaml = YAML::LoadFile( "$file" );
+ }
+ else {
+ open( my $fh, $file ) or die $!;
+ my $content = do { local $/; <$fh> };
+ close $fh;
+ $yaml = YAML::Syck::Load( $content );
+ }
+
+ foreach my $event ( @{$yaml} ) {
+ $c->schedule( %{$event} );
+ }
+
+ $c->log->info( "Scheduler: PID $$ loaded "
+ . scalar @{$yaml}
+ . ' events from YAML file' )
+ if $c->config->{scheduler}->{logging};
+ }
+ };
+ if ($@) {
+ $c->log->error("Scheduler: Error reading YAML file: $@");
+ }
+}
+
+# Detect the current time zone
+sub _detect_timezone {
+ my $c = shift;
+
+ my $tz;
+ eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
+ if ($@) {
+ $c->log->warn(
+ 'Scheduler: Unable to autodetect local time zone, using UTC')
+ if $c->config->{scheduler}->{logging};
+ return 'UTC';
+ }
+ else {
+ $c->log->debug(
+ 'Scheduler: Using autodetected time zone: ' . $tz->name )
+ if $c->config->{scheduler}->{logging};
+ return $tz->name;
+ }
+}
+
+# Check for authorized users on non-auto events
+sub _event_authorized {
+ my $c = shift;
+
+ # this should never happen, but just in case...
+ return unless $c->req->address;
+
+ my $hosts_allow = $c->config->{scheduler}->{hosts_allow};
+ $hosts_allow = [$hosts_allow] unless ref($hosts_allow) eq 'ARRAY';
+ my $allowed = Set::Scalar->new( @{$hosts_allow} );
+ return $allowed->contains( $c->req->address );
+}
+
+# get the state from the state file
+sub _get_event_state {
+ my $c = shift;
+
+ if ( -e $c->config->{scheduler}->{state_file} ) {
+ $c->_event_state(
+ lock_retrieve $c->config->{scheduler}->{state_file} );
+ }
+ else {
+
+ # initialize the state file
+ $c->_event_state(
+ { last_check => time,
+ events => {},
+ yaml_mtime => {},
+ }
+ );
+ $c->_save_event_state();
+ }
+}
+
+# Check the state file to ensure we are the only process running an event
+sub _mark_running {
+ my ( $c, $event ) = @_;
+
+ $c->_get_event_state();
+
+ return if
+ $c->_event_state->{events}->{ $event->{event} }->{running};
+
+ # this is a 2-step process to prevent race conditions
+ # 1. write the state file with our PID
+ $c->_event_state->{events}->{ $event->{event} }->{running} = $$;
+ $c->_save_event_state();
+
+ # 2. re-read the state file and make sure it's got the same PID
+ $c->_get_event_state();
+ if ( $c->_event_state->{events}->{ $event->{event} }->{running} == $$ ) {
+ return 1;
+ }
+
+ return;
+}
+
+# Mark an event as finished
+sub _mark_finished {
+ my ( $c, $event, $output ) = @_;
+
+ $c->_event_state->{events}->{ $event->{event} }->{running} = 0;
+ $c->_event_state->{events}->{ $event->{event} }->{last_run} = time;
+ $c->_event_state->{events}->{ $event->{event} }->{last_output} = $output;
+ $c->_save_event_state();
+}
+
+# update the state file on disk
+sub _save_event_state {
+ my $c = shift;
+
+ lock_store $c->_event_state, $c->config->{scheduler}->{state_file};
+}
+
+# Set::Crontab does not support day names, or '@' shortcuts
+sub _prepare_cron {
+ my $cron = shift;
+
+ return $cron unless $cron =~ /\w/;
+
+ my %replace = (
+ jan => 1,
+ feb => 2,
+ mar => 3,
+ apr => 4,
+ may => 5,
+ jun => 6,
+ jul => 7,
+ aug => 8,
+ sep => 9,
+ 'oct' => 10,
+ nov => 11,
+ dec => 12,
+
+ sun => 0,
+ mon => 1,
+ tue => 2,
+ wed => 3,
+ thu => 4,
+ fri => 5,
+ sat => 6,
+ );
+
+ my %replace_at = (
+ 'yearly' => '0 0 1 1 *',
+ 'annually' => '0 0 1 1 *',
+ 'monthly' => '0 0 1 * *',
+ 'weekly' => '0 0 * * 0',
+ 'daily' => '0 0 * * *',
+ 'midnight' => '0 0 * * *',
+ 'hourly' => '0 * * * *',
+ );
+
+ if ( $cron =~ /^\@/ ) {
+ $cron =~ s/^\@//;
+ return $replace_at{ $cron };
+ }
+
+ for my $name ( keys %replace ) {
+ my $value = $replace{$name};
+ $cron =~ s/$name/$value/i;
+ last unless $cron =~ /\w/;
+ }
+ return $cron;
+}
+
+1;
+__END__
=pod
trigger => 'rebuild_search_index',
event => '/cron/rebuild_search_index',
);
-
$ wget -q http://www.myapp.com/?schedule_trigger=rebuild_search_index
-
=head1 DESCRIPTION
This plugin allows you to schedule events to run at recurring intervals.
not run at exactly the correct time, but it should be enough to satisfy many
basic scheduling needs.
-
=head1 CONFIGURATION
Configuration is optional and is specified in MyApp->config->{scheduler}.
'192.168.1.1'
];
-=head2 check_every
-
-This option allows you to configure how often the scheduler should check
-for pending events. By default this is set to C<60> which means C<no more>
-than once per 60 seconds.
-
-=cut
-
-### set some defaults at start up time
-sub setup {
- my $c = shift;
-
- # store the app, for usage in the base class
- $c->scheduler->_app( $c );
-
- # initial configuration
- $c->config->{scheduler}->{logging} ||= ( $c->debug ) ? 1 : 0;
- $c->config->{scheduler}->{time_zone} ||= $c->scheduler->_detect_timezone;
- $c->config->{scheduler}->{state_file} ||= $c->path_to('scheduler.state');
- $c->config->{scheduler}->{yaml_file} ||= $c->path_to('scheduler.yml');
- $c->config->{scheduler}->{hosts_allow} ||= '127.0.0.1';
- $c->config->{scheduler}->{check_every} ||= 60;
-
- ### make sure we run our own setup FIRST, so other plugins /could/
- ### schedule things in /their/ setup
- $c->NEXT::setup(@_);
-}
-
-### for debugging purposes
-sub dump_these {
- my $c = shift;
-
- return ( $c->NEXT::dump_these(@_) ) unless @{ $c->scheduler->_events };
-
- # for debugging, we dump out a list of all events with their next
- # scheduled run time
- return (
- $c->NEXT::dump_these(@_),
- [ 'Scheduled Events', $c->scheduler_state ],
- );
-}
-
-=head1 METHODS
-
-=head2 $scheduler = MyApp->scheduler;
-
-This the actual C<Scheduler> object that you can query for a lot of
-information. See C<Catalyst::Plugin::Scheduler::Base> for usage information.
-
-The below methods are shorthand methods on this object.
-
-=head2 $aref = MyApp->scheduler_state
-
-The current state of all scheduled events is available in an easy-to-use
-format by calling $c->scheduler_state. You can use this data to build an
-admin view into the scheduling engine, for example. This same data is also
-displayed on the Catalyst debug screen.
-
-This method returns an array reference containing a hash reference for each
-event.
-
- [
- {
- 'last_run' => '2005-12-29 16:29:33 EST',
- 'auto_run' => 1,
- 'last_output' => 1,
- 'at' => '0 0 * * *',
- 'next_run' => '2005-12-30 00:00:00 EST',
- 'event' => '/cron/session_cleanup'
- },
- {
- 'auto_run' => 1,
- 'at' => '0 0 * * *',
- 'next_run' => '2005-12-30 00:00:00 EST',
- 'event' => '/cron/build_rss'
- },
- ]
-
-=head2 MyApp->schedule( event => CODE|/path, (at => CRONTIME, auto_run => BOOL) | (trigger => GET_PARAMETER) )
-
-Schedule is a class method for adding scheduled events. You can schedule
-both automated and manual events, which are discussed below. For extended
-options to C<shedule>, consult the C<Catalyst::Plugin::Scheduler::Event>
-documentation on the C<new> method.
+=head1 SCHEDULING
-=head3 SCHEDULING AUTOMATED EVENTS
+=head2 AUTOMATED EVENTS
Events are scheduled by calling the class method C<schedule>.
$c->delete_expired_sessions;
}
-=head4 at
+=head3 at
The time to run an event is specified using L<crontab(5)>-style syntax.
month 0-12 (or names, see below)
day of week 0-7 (0 or 7 is Sun, or use names)
-Instead of the first five fields, one of the following special strings
-may appear:
+Instead of the first five fields, one of seven special strings may appear:
string meaning
------ -------
@daily Run once a day, "0 0 * * *".
@midnight (same as @daily)
@hourly Run once an hour, "0 * * * *".
- @always Run every minute, "* * * * *".
-=head4 event
+=head3 event
The event to run at the specified time can be either a Catalyst private
action path or a coderef. Both types of event methods will receive the $c
Important: Methods used for events should be marked C<Private> so that
they can not be executed via the browser.
-=head4 auto_run
+=head3 auto_run
The auto_run parameter specifies when the event is allowed to be executed.
By default this option is set to 1, so the event will be executed during the
0 0 * * * wget -q http://www.myapp.com/
-=head3 SCHEDULING MANUAL EVENTS
+=head2 MANUAL EVENTS
To create an event that does not run on a set schedule and must be manually
triggered, you can specify the C<trigger> option instead of C<at>.
localhost (127.0.0.1). To allow other addresses to run events, use the
configuration option L</hosts_allow>.
-
-=cut
-
-__PACKAGE__->mk_classdata( scheduler => do { bless {}, __PACKAGE__ .'::Base'} );
-
-{ ### convenience wrapper
- sub schedule {
- my $c = shift;
- return $c->scheduler->schedule(
- scheduled_by => $c->scheduler->_caller_string, @_ );
- }
-
- sub scheduler_state {
- my $c = shift;
- return $c->scheduler->state( @_ );
- }
-}
-
-=head1 INTERNAL METHODS
-
-The following methods are extended by this plugin.
-
-=over 4
-
-=item dispatch
-
-The main scheduling logic takes place during the dispatch phase.
-
-=item dump_these
-
-On the Catalyst debug screen, all scheduled events are displayed along with
-the next time they will be executed.
-
-=item setup
-
-Configuration is initialized during setup time.
-
-=back
-
-=cut
-
-### run stuff at dispatch time
-sub dispatch {
- my $c = shift;
-
- $c->NEXT::dispatch(@_);
-
- $c->scheduler->_run_events;
-}
-
-### store the BLESSED $c for us to work with, at the begining of every
-### request... otherwise, we just have a class name, and no request info.
-sub prepare_action {
- my $c = shift;
-
- $c->scheduler->_app( $c );
-
- $c->NEXT::prepare_action( @_ );
-}
-
-1;
-
-__END__
-
=head1 SCHEDULING USING A YAML FILE
As an alternative to using the schedule() method, you may define scheduled
directory. You can change the filename using the configuration option
L</yaml_file>.
-Modifications to this file will be re-read during the normal event checking
-process, which occurs once per minute (or whatever you set C<check_every>
-to in your configuration).
+Modifications to this file will be re-read once per minute during the normal
+event checking process.
Here's an example YAML configuration file with 4 events. Each event is
denoted with a '-' character, followed by the same parameters used by the
);
}
}
-
-
-
+
=head1 CAVEATS
The time at which an event will run is determined completely by the requests
=head1 PERFORMANCE
-The plugin only checks once per minute (or whatever you set C<check_every>
-to in your configuration) if any events need to be run, so the overhead on
-each request is minimal. On my test server, the difference between running
-with Scheduler and without was only around 0.02% (0.004 seconds).
+The plugin only checks once per minute if any events need to be run, so the
+overhead on each request is minimal. On my test server, the difference
+between running with Scheduler and without was only around 0.02% (0.004
+seconds).
Of course, when a scheduled event runs, performance will depend on what's
being run in the event.
+
+=head1 METHODS
+
+=head2 schedule
+
+Schedule is a class method for adding scheduled events. See the
+L<"/SCHEDULING"> section for more information.
+
+=head2 scheduler_state
+
+The current state of all scheduled events is available in an easy-to-use
+format by calling $c->scheduler_state. You can use this data to build an
+admin view into the scheduling engine, for example. This same data is also
+displayed on the Catalyst debug screen.
+
+This method returns an array reference containing a hash reference for each
+event.
+
+ [
+ {
+ 'last_run' => '2005-12-29 16:29:33 EST',
+ 'auto_run' => 1,
+ 'last_output' => 1,
+ 'at' => '0 0 * * *',
+ 'next_run' => '2005-12-30 00:00:00 EST',
+ 'event' => '/cron/session_cleanup'
+ },
+ {
+ 'auto_run' => 1,
+ 'at' => '0 0 * * *',
+ 'next_run' => '2005-12-30 00:00:00 EST',
+ 'event' => '/cron/build_rss'
+ },
+ ]
+
+=head1 INTERNAL METHODS
+
+The following methods are extended by this plugin.
+
+=over 4
+
+=item dispatch
+
+The main scheduling logic takes place during the dispatch phase.
+
+=item dump_these
+
+On the Catalyst debug screen, all scheduled events are displayed along with
+the next time they will be executed.
+
+=item setup
+
+=back
=head1 SEE ALSO
-L<Catalyst::Plugin::Scheduler::Base>, L<Catalyst::Plugin::Scheduler::Event>, L<crontab(5)>
+L<crontab(5)>
-=head1 AUTHORS
+=head1 AUTHOR
Andy Grundman, <andy@hybridized.org>
-Jos I. Boumans, <kane@cpan.org>
=head1 COPYRIGHT
under the same terms as Perl itself.
=cut
-
-Changes:
-* split out C::P::Scheduler to ::Base and ::Event
-* Implement all core functionality in ::Base
- * C::P::Scheduler provides convenience functions to ::Base
- and the hooks into catalyst to do the scheduling
- * Pollute $c less
-* Introduce event objects
- * No longer hash based
- * ->next_run and ->last_run are now accessors
- * running events goes via $event->run, called from the dispatch hook
-* Use $self->_config to retrieve config, rather than accessing $c directly
-* Add tests for schedule_state();
-* Add '@always' as a cron shorcut
-* made _event_state class data rather than instance data, so it is
- accessible from the ::Event objects
-* made 'once every 60 seconds' check configurable using 'check_every'
- XXX add to docs
-* made tests no longer need to hack the state file, but provide
- $BASE->_last_check_time( 0 ) to reset the last checked time
-* Moved _event_state toe ::Event from ::Base, as it's the _event_ state
-* All tested & documented
-
-TODO:
-* fix t/09long.t to use time::warp or somesuch
-
-
projects / catagits/Catalyst-Plugin-Scheduler.git / blobdiff