use strict;
use warnings;
-use base 'Class::Data::Inheritable';
+use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
use DateTime;
use DateTime::Event::Cron;
use DateTime::TimeZone;
use NEXT;
+use Set::Object;
+use Storable qw/lock_store lock_retrieve/;
+use YAML;
our $VERSION = '0.01';
__PACKAGE__->mk_classdata( '_events' => [] );
-__PACKAGE__->mk_classdata( '_last_event_check' );
+__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 = {
- event => $args{event},
trigger => $args{trigger},
+ event => $args{event},
auto_run => ( defined $args{auto_run} ) ? $args{auto_run} : 1,
};
$c->NEXT::dispatch(@_);
+ $c->_get_event_state();
+
# check if a minute has passed since our last check
- if ( time - $c->_last_event_check < 60 ) {
- return;
+ # 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};
-
- # check for events to execute
- my $last_check = DateTime->from_epoch(
- epoch => $c->_last_event_check,
+ my $last_check_dt = DateTime->from_epoch(
+ epoch => $last_check,
time_zone => $conf->{time_zone}
);
my $now = DateTime->now( time_zone => $conf->{time_zone} );
- $c->_last_event_check( $now->epoch );
EVENT:
for my $event ( @{ $c->_events } ) {
- next EVENT unless $event->{set};
+ my $next_run;
+
+ if ( $event->{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 );
+ }
- my $next_run = $event->{set}->next( $last_check );
if ( $next_run <= $now ) {
# do some security checking for non-auto-run events
next EVENT unless $c->_event_authorized;
}
- # update the state file to make sure we're the only process
- # running this event
- next EVENT unless $c->_mark_state( $event, $next_run );
+ # 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->info( "Scheduler: Executing $event_name" )
- if $conf->{logging};
+ $c->log->debug( "Scheduler: Executing $event_name" )
+ if $c->config->{scheduler}->{logging};
# trap errors
local $c->{error} = [];
$c->log->error( 'Scheduler: Error executing '
. "$event_name: $_" ) for @errors;
}
+
+ $c->_mark_finished( $event );
}
}
}
sub setup {
my $c = shift;
- $c->NEXT::setup(@_);
-
# 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->_last_event_check(
- DateTime->now(
- time_zone => $c->config->{scheduler}->{time_zone}
- )->epoch
- );
+ $c->NEXT::setup(@_);
}
# Detect the current time zone
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
if ($@) {
$c->log->warn(
- 'Scheduler: Unable to determine local time zone, using UTC' );
+ 'Scheduler: Unable to autodetect local time zone, using UTC' );
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
-# XXX: TODO
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 $ip = Set::Object->new( $c->req->address );
+ my $allowed = Set::Object->new( @{ $hosts_allow } );
+
+ return $ip->subset( $allowed );
+}
+
+# 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 } );
+ $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->{ $event->{event} };
+
+ # this is a 2-step process to prevent race conditions
+ # 1. write the state file with our PID
+ $c->_event_state->{ $event->{event} } = $$;
+ $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->{ $event->{event} } == $$ ) {
+ return 1;
+ }
+
+ return;
+}
+
+# Mark an event as finished
+sub _mark_finished {
+ my ( $c, $event ) = @_;
+
+ $c->_event_state->{ $event->{event} } = 0;
+ $c->_save_event_state();
}
-# Update the state file
-# XXX: TODO
-sub _mark_state {
- my ( $c, $event, $next_run ) = @_;
-
+# 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
event => \&do_stuff,
);
+ # Define a scheduled event that must be triggered manually
+
=head1 DESCRIPTION
This plugin allows you to schedule events to run at recurring intervals.
=head2 state_file
The current state of every event is stored in a file. By default this is
-$APP_HOME/scheduler.state. If this file cannot be read or created at
-startup, your app will die.
+$APP_HOME/scheduler.state. This file is created on the first request if it
+does not already exist.
=head2 hosts_allow
whose IP address matches the list in the C<hosts_allow> config option. To
run this event, you probably want to ping the app from a cron job.
- 0 0 * * * wget -q http://www.myapp.com/
+ 0 0 * * * wget -q http://www.myapp.com/
=head2 MANUAL EVENTS
receiving any error messages or page crashes if an event fails to run
properly. All event errors are logged, even if logging is disabled.
-=head1 CAVEATS
-
-The time at which an event will run is determined completely by the requests
-made to the application. Apps with heavy traffic may have events run at very
-close to the correct time, whereas apps with low levels of traffic may see
-events running much later than scheduled. If this is a problem, you can use
-a real cron entry that simply hits your application at the desired time.
-
- 0 * * * * wget -q http://www.myapp.com/
-
-Events which consume a lot of time will slow the request processing for the
-user who triggers the event. For these types of events, you should use
-auto_run => 0 or manual event triggering.
-
=head1 PLUGIN SUPPORT
Other plugins may register scheduled events if they need to perform periodic
);
}
}
+
+=head1 CAVEATS
+
+The time at which an event will run is determined completely by the requests
+made to the application. Apps with heavy traffic may have events run at very
+close to the correct time, whereas apps with low levels of traffic may see
+events running much later than scheduled. If this is a problem, you can use
+a real cron entry that simply hits your application at the desired time.
+
+ 0 * * * * wget -q http://www.myapp.com/
+
+Events which consume a lot of time will slow the request processing for the
+user who triggers the event. For these types of events, you should use
+auto_run => 0 or manual event triggering.
+
+=head1 PERFORMANCE
+
+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).
+
+When a scheduled event runs, performance will depend on the code being run in
+the event.
=head1 TODO
under the same terms as Perl itself.
=cut
+
+.171 - with scheduler
+.168 - without
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::More;
+use Storable qw/lock_store lock_retrieve/;
plan tests => 10;
-
use Catalyst::Test 'TestApp';
+our $STATE = "$FindBin::Bin/lib/TestApp/scheduler.state";
+
TestApp->schedule(
at => '* * * * *',
event => '/cron/every_minute',
);
# hack the last event check to make all events execute immediately
-TestApp->_last_event_check( 0 );
+my $state = { last_check => 0 };
+lock_store $state, $STATE;
# test that all events execute, and that the error test doesn't break the app
{
{
ok( my $res = request('http://localhost/'), 'request ok' );
is( -e "$FindBin::Bin/lib/TestApp/every_minute.log", undef, 'every_minute did not execute, ok' );
+ unlink "$FindBin::Bin/lib/TestApp/every_minute.log";
is( -e "$FindBin::Bin/lib/TestApp/every_hour.log", undef, 'every_hour did not execute, ok' );
+ unlink "$FindBin::Bin/lib/TestApp/every_hour.log";
}
# jump back in time by 2 hours, make sure both events run
{
- my $last = TestApp->_last_event_check;
- TestApp->_last_event_check( $last - ( 60 * 120 ) );
+ my $state = lock_retrieve $STATE;
+ $state->{last_check} -= 60 * 120;
+ lock_store $state, $STATE;
ok( my $res = request('http://localhost/'), 'request ok' );
is( -e "$FindBin::Bin/lib/TestApp/every_minute.log", 1, 'every_minute executed ok' );
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More;
+use Storable qw/lock_store lock_retrieve/;
+
+plan tests => 6;
+use Catalyst::Test 'TestApp';
+
+our $STATE = "$FindBin::Bin/lib/TestApp/scheduler.state";
+
+TestApp->schedule(
+ at => '* * * * *',
+ event => '/cron/every_minute',
+ auto_run => 0,
+);
+
+# hack the last event check to make all events execute immediately
+my $state = { last_check => 0 };
+lock_store $state, $STATE;
+
+# disallow localhost
+TestApp->config->{scheduler}->{hosts_allow} = '1.2.3.4';
+
+# test that the event does not execute
+{
+ ok( my $res = request('http://localhost/'), 'request ok' );
+ is( $res->content, 'default', 'response ok' );
+ is( -e "$FindBin::Bin/lib/TestApp/every_minute.log", undef, 'every_minute did not execute, ok' );
+ unlink "$FindBin::Bin/lib/TestApp/every_minute.log";
+}
+
+# hack the last event check to make all events execute immediately
+$state = lock_retrieve $STATE;
+$state->{last_check} = 0;
+lock_store $state, $STATE;
+
+# allow localhost
+TestApp->config->{scheduler}->{hosts_allow} = [ '1.2.3.4', '127.0.0.1' ];
+
+# test that the event does execute
+{
+ ok( my $res = request('http://localhost/'), 'request ok' );
+ is( $res->content, 'default', 'response ok' );
+ is( -e "$FindBin::Bin/lib/TestApp/every_minute.log", 1, 'every_minute executed ok' );
+ unlink "$FindBin::Bin/lib/TestApp/every_minute.log";
+}