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 Set::Scalar;
-use Storable qw/lock_store lock_retrieve/;
+use base qw/Class::Accessor::Fast Class::Data::Inheritable Catalyst::Base/;
+use Catalyst::Plugin::Scheduler::Base;
-our $VERSION = '0.07';
+our $VERSION = '0.07_01';
-__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'
];
-=head1 SCHEDULING
+=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.
-=head2 AUTOMATED EVENTS
+=head3 SCHEDULING AUTOMATED EVENTS
Events are scheduled by calling the class method C<schedule>.
$c->delete_expired_sessions;
}
-=head3 at
+=head4 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 seven special strings may appear:
+Instead of the first five fields, one of the following 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, "* * * * *".
-=head3 event
+=head4 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.
-=head3 auto_run
+=head4 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/
-=head2 MANUAL EVENTS
+=head3 SCHEDULING 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 once per minute during the normal
-event checking process.
+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).
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 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 (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).
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<crontab(5)>
+L<Catalyst::Plugin::Scheduler::Base>, L<Catalyst::Plugin::Scheduler::Event>, L<crontab(5)>
=head1 AUTHOR
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
+
+
--- /dev/null
+package Catalyst::Plugin::Scheduler::Base;
+
+use Data::Dumper;
+use DateTime;
+use DateTime::Event::Cron;
+use DateTime::TimeZone;
+use File::stat;
+use Set::Scalar;
+use base qw/Catalyst::Plugin::Scheduler/;
+use Catalyst::Plugin::Scheduler::Event;
+
+__PACKAGE__->mk_classdata(_events => []);
+__PACKAGE__->mk_classdata(_event_class => 'Catalyst::Plugin::Scheduler::Event');
+__PACKAGE__->mk_classdata('_app' );
+
+=head1 NAME
+
+Catalyst::Plugin::Scheduler::Base - Base class for the Catalyst Scheduler
+
+=head1 SYNOPSIS
+
+ MyApp->scheduler->schedule( at => '0 0 * * *', event => '/cron/ping' );
+
+ ### return all scheduled events as ::Event objects
+ @events = MyApp->scheduler->list_events;
+
+ ### return all pending scheduled events as ::Event objects
+ @pending = MyApp->scheduler->list_pending_events;
+
+ ### a dump of the current scheduler state
+ $aref = MyApp->scheduler->state;
+
+=head1 METHODS
+
+=head2 $bool = MyApp->scheduler->schedule
+
+Allows you to schedule events. For full usage and documentation, consult
+the C<Catalyst::Plugin::Scheduler> documentation on method C<schedule>.
+
+=cut
+
+sub schedule {
+ my $self = shift;
+ my $c = $self->_app;
+ my %args = @_;
+
+ ### XXX more input checks?
+
+ unless ( $args{event} ) {
+ Catalyst::Exception->throw(
+ message => 'The schedule method requires an event parameter' );
+ }
+
+ ### default to '1'
+ $args{'auto_run'} = 1 unless defined $args{'auto_run'};
+
+ if ( $args{at} ) {
+
+ # replace keywords that Set::Crontab doesn't support
+ $args{at} = $self->_prepare_cron( $args{at} );
+
+ # parse the cron entry into a DateTime::Set
+ $args{set} = eval { DateTime::Event::Cron->from_cron( $args{at} ) };
+
+ Catalyst::Exception->throw(
+ "Scheduler: Unable to parse 'at' value $args{at}: $@"
+ ) if $@;
+
+ }
+
+ my $who = $self->_caller_string;
+ push @{ $self->_events },
+ Catalyst::Plugin::Scheduler::Event->new( scheduled_by => $who, %args );
+
+ return 1;
+}
+
+### create a caller string like: "package (file.pm:#line)"
+sub _caller_string { return sprintf "%s (%s:%s)", @{[caller(1)]}[0,1,2]; }
+
+=head2 @events = $c->scheduler->list_events;
+
+Returns an array of C<Catalyst::Plugin::Scheduler::Event> objects,
+representing all the scheduled events in this application.
+
+See the C<Catalyst::Plugin::Scheduler::Event> documentation on how to use
+these objects.
+
+=cut
+
+sub list_events {
+ my $self = shift;
+ return @{ $self->_events || [] };
+};
+
+=head2 @events = $c->scheduler->list_events;
+
+Returns an array of C<Catalyst::Plugin::Scheduler::Event> objects,
+representing all the pending events in this application. They are the
+events that are due according to your cron specification, and will be run
+at the next dispatch, or can be run by you explicitly.
+
+See the C<Catalyst::Plugin::Scheduler::Event> documentation on how to use
+these objects.
+
+=cut
+
+sub list_pending_events {
+ my $self = shift;
+ my $c = $self->_app;
+ my $tz = $self->_config('time_zone');
+
+ ### there are no events scheduled?
+ my @events = $self->list_events or return;
+ my $now = DateTime->now( time_zone => $tz );
+
+ ### list of pending events
+ my @pending;
+
+ ### XXX need NEXT RUN TIME??
+ EVENT:
+ for my $event (@events) {
+
+ ### this event is not active, so skip it
+ next EVENT unless $event->active;
+
+ ### the proper trigger is being called
+ if( $event->trigger && $c->req->params->{schedule_trigger} &&
+ $event->trigger eq $c->req->params->{schedule_trigger}
+ ) {
+
+ ### if you're not authorized to call the trigger, skip it
+ next EVENT unless $self->_event_authorized;
+
+ push @pending, $event;
+ next EVENT;
+ }
+
+ ### we're due according to our cron-entry...
+ if( $event->set ) {
+ ### is the next run time now, or even before now?
+ push @pending, $event if $event->next_run_as_dt <= $now;
+ }
+ }
+
+ ### sort them by priority
+ return sort { $a->priority <=> $b->priority } @pending;
+}
+
+
+
+sub _run_events {
+ my $self = shift;
+ my $c = $self->_app;
+ my %args = @_;
+
+ $self->_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 - $self->_last_check_time < $self->_config('check_every') ) {
+ return unless $c->req->params->{schedule_trigger};
+ }
+
+ my @events = $self->list_pending_events;
+
+ ### update the 'checked' time and save the state, so no more
+ ### processes are going to be running these events
+ ### the small race condition between the 'list_pending_events' call
+ ### and the updating of the check time is resolved by checking if a
+ ### job is running before executing it, so at worst, we have several
+ ### processes sharing the load of this cron run. --kane
+ $self->_last_check_time( time );
+
+ EVENT:
+ for my $event ( @events ) {
+
+ # do some security checking for non-auto-run events
+ ### XXX move this to $event->run? --kane
+ if ( !$event->auto_run ) {
+ next EVENT unless $self->_event_authorized;
+ }
+
+ $event->run;
+ }
+}
+
+=head2 $aref = MyApp->scheduler->state
+
+A dump of the current state of the scheudler. For full usage and
+documentation, consult the C<Catalyst::Plugin::Scheduler> documentation on
+method C<scheduler+state>.
+
+=cut
+
+sub state {
+ my $self = shift;
+ my $c = $self->_app;
+
+ my $event_dump = [];
+ for my $event ( $self->list_events ) {
+ my $dump = {};
+ for my $key ( qw/at trigger event auto_run/ ) {
+ $dump->{$key} = $event->$key if $event->$key;
+ }
+
+ # display the next run time
+ $dump->{next_run} = $event->next_run_as_string;
+
+ # display the last run time
+ $dump->{last_run} = $event->last_run_as_string;
+
+ # display the result of the last run
+ my $output = $event->output;
+ if ( $output ) {
+ $dump->{last_output} = $output;
+ }
+
+ push @{$event_dump}, $dump;
+ }
+
+ return $event_dump;
+}
+
+sub _config {
+ my $self = shift;
+ my $key = shift;
+ my $c = $self->_app;
+ my $conf = $c->config->{scheduler};
+ my $rv = $key ? $conf->{$key} : $conf;
+
+ return $rv;
+}
+
+### shorthand form
+sub _last_check_time {
+ my $self = shift;
+ return $self->_event_class->_last_check_time( @_ );
+}
+
+# check and reload the YAML file with schedule data
+sub _check_yaml {
+ my $self = shift;
+ my $c = $self->_app;
+
+ $self->_event_class->_get_event_state();
+
+ # each process needs to load the YAML file independently
+ if ( $self->_event_class->_event_state->{yaml_mtime}->{$$} ||= 0 ) {
+ return if ( time - $self->_last_check_time < 60 );
+ }
+
+ my $file = $self->_config('yaml_file');
+ return unless -e $file;
+
+ eval {
+ my $mtime = ( stat $file )->mtime;
+ if ( $mtime > $self->_event_class->_event_state->{yaml_mtime}->{$$} ) {
+ $self->_event_class->_event_state->{yaml_mtime}->{$$} = $mtime;
+
+ # clean up old PIDs listed in yaml_mtime
+ for my $pid (
+ keys %{ $self->_event_class->_event_state->{yaml_mtime} }
+ ) {
+ delete $self->_event_class->_event_state->{yaml_mtime}->{$pid}
+ if $self->_event_class->_event_state->{yaml_mtime}->{$pid}
+ < $mtime
+ }
+ $self->_event_class->_save_event_state();
+
+ # wipe out all current events and reload from YAML
+ $self->_events( [] );
+
+ 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} ) {
+ $self->schedule( %{$event} );
+ }
+
+ $c->log->info( "Scheduler: PID $$ loaded "
+ . scalar @{$yaml}
+ . ' events from YAML file' )
+ if $self->_config('logging');
+ }
+ };
+
+ $c->log->error("Scheduler: Error reading YAML file: $@") if $@;
+}
+
+# Detect the current time zone
+sub _detect_timezone {
+ my $self = shift;
+ my $c = $self->_app;
+
+ my $tz;
+ eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
+ if ($@) {
+ $c->log->warn(
+ 'Scheduler: Unable to autodetect local time zone, using UTC')
+ if $self->_config('logging');
+ return 'UTC';
+ }
+ else {
+ $c->log->debug(
+ 'Scheduler: Using autodetected time zone: ' . $tz->name )
+ if $self->_config('logging');
+ return $tz->name;
+ }
+}
+
+# Check for authorized users on non-auto events
+sub _event_authorized {
+ my $self = shift;
+ my $c = $self->_app;
+
+ # this should never happen, but just in case...
+ return unless $c->req->address;
+
+ my $hosts_allow = $self->_config('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 );
+}
+
+# Set::Crontab does not support day names, or '@' shortcuts
+{ 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 * * * *',
+ 'always' => '* * * * *',
+ );
+
+ sub _prepare_cron {
+ my $self = shift;
+ my $c = $self->_app;
+ my $cron = shift;
+
+ return $cron unless $cron =~ /\w/;
+
+ 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__
+
+=head1 SEE ALSO
+
+C<Catalyst::Plugin::Scheduler>, C<Catalyst::Plugin::Scheduler::Event>,
+
+=cut
+
--- /dev/null
+package Catalyst::Plugin::Scheduler::Event;
+
+use strict;
+use warnings;
+use DateTime;
+use Storable qw/lock_store lock_retrieve/;
+use base qw[Class::Accessor::Fast Class::Data::Inheritable];
+
+=head1 NAME
+
+Catalyst::Plugin::Scheduler::Event - Event objects for the scheduler
+
+=head1 SYNOPSIS
+
+ ### retrieve all events
+ @events = MyApp->scheduler->events;
+
+ ### access event information
+ print $event->at;
+ print $event->output;
+ print $event->error;
+
+ ### run an event explicitly
+ $event->run or die $event->error;
+
+ MyApp->scheduler->last_check_time;
+ MyApp->scheduler->last_check_time_as_string;
+
+=cut
+
+=head1 ACCESSORS
+
+These are accessors on the event objects that give you information on or
+let you change the behaviour of the scheduled event objects.
+
+All these accessors can be provided as arguments to the C<new> function
+directly, or via the C<< MyApp->schedule >> method indirectly.
+
+=head2 $event->at
+
+Time the event should be triggered, in C<crontab> notation.
+
+If empty, $event->trigger should be filled.
+
+=head2 $event->trigger
+
+C<GET> parameter that will trigger this event.
+
+If empty, $event->at should be filled.
+
+=head2 $event->auto_run
+
+Boolean indicating if the event should be automatically run at the end
+of a dispatch cycle when the event is due, or not.
+
+See C<Catalyst::Plugin::Scheduler> documentation on method C<schedule>
+for an example of C<auto_run> use.
+
+=head2 $event->event
+
+The event that will be triggered by this event object. This would be
+either a C<CODE> ref, or an absolute path in your application.
+
+=head2 $event->label
+
+A pretty print name for your event. Defaults to the C<trigger> or
+C<event> accessors if not explicitly defined.
+
+=head2 $event->priority
+
+Pending events are executed in order of priority, where the highest
+priority comes first. The priority defaults to C<0> but can be set
+explicitly when scheduling an event to make it run earlier or later
+in the dispatch cycle.
+
+=head2 $event->active
+
+Marks whether the event is active or not. Defaults to C<1> but you can
+(temporarily) disable an event by setting active to C<0>. Inactive
+events are never present in the C<< MyApp->scheduler->list_pending_events >>
+call.
+
+=head2 $event->scheduled_by
+
+A text string containing details on the code that scheduled this event.
+Useful for debugging purposes or for accountability.
+
+=cut
+
+my $Base = 'Catalyst::Plugin::Scheduler::Base';
+my @EventAcc = qw[output error last_run running];
+my @ExtraAcc = qw[
+ next_run
+ next_run_as_dt
+ next_run_as_string
+ last_run_as_string
+];
+my @Acc = qw[
+ auto_run
+ at
+ event
+ trigger
+ set
+ priority
+ label
+ active
+ scheduled_by
+];
+
+
+
+__PACKAGE__->mk_accessors( @Acc );
+__PACKAGE__->mk_classdata( _event_state => {} );
+
+sub ls_accessors { return ( @Acc, @EventAcc, @ExtraAcc ) };
+
+=head1 METHODS
+
+=head2 $event = Catalyst::Plugin::Scheduler::Event->new( ... );
+
+Creates a new C<Event> object from it's arguments. All possible arguments
+and their meaning are listed in the C<ACCESSORS> section above.
+
+C<new> should usually not be called directly, but via the interface
+provided via the scheduler object:
+
+ MyApp->scheduler->schedule(
+ at => ...
+ event => ...
+ ...
+ );
+
+=cut
+
+sub new {
+ my $self = shift;
+ my %args = @_;
+
+ my $obj = $self->SUPER::new({
+ active => 1,
+ prioirity => 0,
+ scheduled_by => $Base->_caller_string,
+ %args
+ });
+
+ ### make sure it has a name
+ $obj->label( $obj->trigger || $obj->event ) unless $obj->label;
+
+ return $obj;
+}
+
+=head2 $str = $event->output
+
+Output of the event the B<last time> it was run. This is the return
+value of the executed event.
+
+=head2 $str = $event->error
+
+Fatal errors encountered the B<last time> this event was run.
+
+If $event->error returns a string, you can be sure that the event
+did not complete succesfully.
+
+=head2 $pid = $event->running
+
+Returns the pid of the process that is running the event currently.
+
+If a pid is returned, the event is running B<right now>. If the
+pid is different from your pid, another process is running the event.
+
+=head2 $time = $event->last_run
+
+The output of C<time()> the last time the event was run.
+
+=cut
+
+### we want these items available via the event objects,
+### however, they need to be stored in the state file.. so we
+### are basically passing thru from here to the state file..
+### this provides a nicer api, but also means our state is guaranteed
+### to be correct, even if the YAML file is being reloaded or
+### schedules are being altered
+for my $acc ( @EventAcc ) {
+ no strict 'refs';
+
+ my $priv_method = "_$acc";
+ *$acc = sub { shift->$priv_method };
+ *$priv_method = sub {
+ my $self = shift;
+
+ ### make sure the event state is initialized
+ $self->_get_event_state;
+
+ ### access like this, so we're sure we're using the right hashref
+ ### to write into, even if it's not defined yet
+ if( @_ ) {
+ $self->_event_state->{'events'}->{ $self->event }->{$acc} = $_[0];
+ $self->_save_event_state;
+ }
+
+ return $self->_event_state->{'events'}->{ $self->event }->{$acc};
+ }
+}
+
+=head2 $str = $event->last_run_as_string
+
+A pretty-printable version of the C<last_run>
+
+=cut
+
+sub last_run_as_string {
+ my $self = shift;
+
+ if( my $last_run = $self->last_run ) {
+
+ my $dt = DateTime->from_epoch(
+ epoch => $last_run,
+ time_zone => $Base->_config('time_zone'),
+ );
+ return join ' ', $dt->ymd, $dt->hms, $dt->time_zone_short_name;
+ }
+
+ return;
+}
+
+=head2 $time = $event->next_run
+
+The output of C<time()> the next time the event is due to be run.
+
+=cut
+
+sub next_run {
+ my $self = shift;
+ my $dt = $self->next_run_as_dt or return;
+ return $dt->epoch;
+}
+
+=head2 $str = $event->next_run_as_string
+
+A pretty-printable version of the C<next_run>
+
+=cut
+
+sub next_run_as_string {
+ my $self = shift;
+
+ if( $self->set ) {
+ my $next = $self->next_run_as_dt;
+ return join ' ', $next->ymd, $next->hms, $next->time_zone_short_name;
+ }
+
+ return;
+}
+
+=head2 $dt = $event->next_run_as_dt
+
+Returns the time that this event is due to be run as a C<DateTime> object
+
+=cut
+
+sub next_run_as_dt {
+ my $self = shift;
+
+ if( $self->set ) {
+ my $dt = DateTime->from_epoch(
+ epoch => $self->_last_check_time,
+ time_zone => $Base->_config('time_zone'),
+ );
+ return $self->set->next( $dt );
+ }
+ return;
+}
+
+=head2 $bool = $event->run( ... )
+
+Run the event. Any arguments passed to C<run> will be passed along to
+the event that is being run. If C<run> returns true, running the event
+completed without fatal errors. If C<run> returns false, a fatal error
+was encountered while running the event.
+
+You can inspect the following accessors after running the event for
+output and diagnostics:
+
+ $event->output; # any output returned from the event
+ $event->error; # any fatal errors caught while running the event
+
+B<NOTE> that you can only C<run> an event during a C<Catalyst> action,
+as the events need access to the C<Catalyst> object. In short, this means
+that your C<$c> needs to be an object rather than a class name. If C<$c>
+is not an object, C<run> will throw an exception.
+
+=cut
+
+sub run {
+ my $self = shift;
+ my $c = $Base->_app;
+
+ Catalyst::Exception->throw(
+ message => "Can not run scheduled events -- $c is not an object"
+ ) unless ref $c;
+
+ ### XXX mark running
+ # make sure we're the only process running this event
+ ### XXX is 'return' the right thing to do? --kane
+ ### mark_runnign will return true if we are the ones (exclusively)
+ ### running this process.
+ return unless $self->_mark_running;
+
+ ### reset any output/errors
+ $self->_output( undef );
+ $self->_error( undef );
+
+ my $event_name = $self->label;
+ $c->log->debug("Scheduler: Executing $event_name")
+ if $Base->_config('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};
+
+ ### XXX events can not set output without RETURNING
+ ### their output... is this good? --kane
+ $output = ref $self->event eq 'CODE'
+ ? $self->event->($c, @_ )
+ : $c->forward( $self->event, [@_] );
+ };
+
+ my @errors = @{ $c->{error} };
+ push @errors, $@ if $@;
+
+ if (@errors) {
+ ### we check for this error in the tests -- if you alter
+ ### it, tests will starting spewing errors
+ $c->log->error(
+ 'Scheduler: Error executing ' . "$event_name: $_"
+ ) for @errors;
+
+ my $error = join '; ', @errors;
+
+ $self->_error( $error );
+ $output .= $error;
+ }
+
+ $self->_output( $output );
+
+ $self->_mark_finished( );
+
+ return if @errors;
+ return 1;
+}
+
+sub _mark_running {
+ my $self = shift;
+
+ $self->_get_event_state();
+
+ return if $self->running;
+
+ # this is a 2-step process to prevent race conditions
+ # 1. write the state file with our PID
+ $self->_running( $$ );
+ $self->_save_event_state();
+
+ # 2. re-read the state file and make sure it's got the same PID
+ $self->_get_event_state();
+ if ( $self->running == $$ ) {
+ return 1;
+ }
+
+ return;
+}
+
+sub _mark_finished {
+ my $self = shift;
+
+ $self->_running( 0 );
+ $self->_last_run( time );
+
+ $self->_save_event_state();
+
+ return 1;
+}
+
+=head1 CLASS METHODS
+
+=head2 $time = MyApp->scheduler->last_check_time
+
+Returns the C<time()> the last check was made for pending events from
+the dispatcher.
+
+=cut
+
+### dont pass arguments, so it becomes read only
+sub last_check_time {
+ my $self = shift;
+ return $self->_last_check_time;
+}
+
+=head2 $str = MyApp->scheduler->last_check_time_as_string
+
+Returns a pretty-printable version of C<last_check_time>.
+
+=cut
+
+sub last_check_time_as_string {
+ my $self = shift;
+
+ if( my $last = $self->last_check_time ) {
+
+ my $dt = DateTime->from_epoch(
+ epoch => $last,
+ time_zone => $Base->_config('time_zone'),
+ );
+ return join ' ', $dt->ymd, $dt->hms, $dt->time_zone_short_name;
+ }
+
+ return;
+}
+
+sub _last_check_time {
+ my $self = shift;
+
+ $self->_get_event_state();
+
+ if( @_ ) {
+ $self->_event_state->{'last_check'} = $_[0];
+ $self->_save_event_state;
+ }
+
+ return $self->_event_state->{'last_check'};
+}
+
+{ my $key = 'state_file';
+
+ # get the state from the state file
+ sub _get_event_state {
+ my $self = shift;
+ my $file = $Base->_config($key);
+
+ if ( -e $file ) {
+ $self->_event_state( lock_retrieve $file );
+
+ } else {
+ # initialize the state file
+ $self->_event_state(
+ { last_check => time,
+ events => {},
+ yaml_mtime => {},
+ }
+ );
+ $self->_save_event_state();
+ }
+ }
+
+ # update the state file on disk
+ sub _save_event_state {
+ my $self = shift;
+ lock_store( $self->_event_state, $Base->_config($key) );
+ }
+}
+
+1;
+
+__END__
+
+=head1 SEE ALSO
+
+C<Catalyst::Plugin::Scheduler>, C<Catalyst::Plugin::Scheduler::Base>,
+
+=cut
#!perl
-
use strict;
use warnings;
use FindBin;
-use lib "$FindBin::Bin/lib";
-use Test::More;
-use Storable qw/lock_store lock_retrieve/;
-
-plan tests => 10;
+use lib "$FindBin::Bin/lib";
+use Test::More 'no_plan';
use Catalyst::Test 'TestApp';
-our $STATE = "$FindBin::Bin/lib/TestApp/scheduler.state";
-
-TestApp->schedule(
- at => '* * * * *',
- event => '/cron/every_minute',
+our $HOME = "$FindBin::Bin/lib/TestApp";
+our $STATE = "$HOME/scheduler.state";
+our $URL = 'http://localhost/';
+our $BASE = 'Catalyst::Plugin::Scheduler::Base';
+our $Error = 'oops';
+our $Filter = 0;
+our @Map = (
+ # at # event # output
+ [ '* * * * *' , '/cron/every_minute' , qr/every_minute/ ],
+ [ '@hourly' , \&every_hour , qr/every_hour/ ],
+ [ '*/2 * * * *' , '/cron/test_errors' , qr/$Error/ ],
+ [ '0 * * * *' , \&broken_event , qr/$Error/ ],
);
-TestApp->schedule(
- at => '@hourly',
- event => \&every_hour,
-);
+### clean up
+END { 1 while unlink $STATE }
-# events with errors to test the error handling
-TestApp->schedule(
- at => '*/2 * * * *',
- event => '/cron/test_errors',
-);
+### filter expected error messages, when needed...
+{ my $org = Catalyst::Log->can('_send_to_log');
+
+ no warnings 'redefine';
+ *Catalyst::Log::_send_to_log = sub {
+ return if $Filter and "@_" =~ /Scheduler: Error executing/;
+ $org->( @_ );
+ };
+}
+
+### set up some schedules
+{ for my $aref ( @Map ) {
+ my($at,$event) = @$aref;
+
+ TestApp->schedule(
+ at => $at,
+ event => $event,
+ );
+ }
+
+ sub every_hour {
+ my $c = shift;
+
+ # write out a file so the test knows we did something
+ my $fh = IO::File->new( $c->path_to( 'every_hour.log' ), 'w' )
+ or die "Unable to write log file: $!";
+ close $fh;
+ return 'every_hour';
+ }
+
+ sub broken_event { die $Error; }
+}
-TestApp->schedule(
- at => '0 * * * *',
- event => \&broken_event,
-);
# hack the last event check to make all events execute immediately
-my $state = { last_check => 0 };
-lock_store $state, $STATE;
-
-# test that all events execute, and that the error test doesn't break the app
-{
- open STDERR, '>/dev/null';
- 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";
- is( -e "$FindBin::Bin/lib/TestApp/every_hour.log", 1, 'every_hour executed ok' );
- unlink "$FindBin::Bin/lib/TestApp/every_hour.log";
+$BASE->_last_check_time( 0 );
+
+### test that all events execute, and that the error test doesn't break the app
+{ ### there's an event that dies on purpose. dont have the error message
+ ### appear on the terminal
+ { local $Filter = 1;
+ ok( my $res = request($URL), 'request ok' );
+ is( $res->content, 'default',' response ok' );
+ }
+
+ ok( -e "$HOME/every_minute.log", ' every_minute executed ok' );
+ 1 while unlink "$HOME/every_minute.log";
+
+ ok( -e "$HOME/every_hour.log", ' every_hour executed ok' );
+ 1 while unlink "$HOME/every_hour.log";
}
-# run again, the events should not execute
-{
- 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";
+
+
+### run again, the events should not execute
+{ ok( request($URL), 'request ok' );
+
+ ok( !-e "$HOME/every_minute.log", ' every_minute did not execute, ok' );
+ 1 while unlink "$HOME/every_minute.log";
+
+ ok( !-e "$HOME/every_hour.log", ' every_hour did not execute, ok' );
+ 1 while unlink "$HOME/every_hour.log";
}
-# jump back in time by 2 hours, make sure both events run
-{
- my $state = lock_retrieve $STATE;
- $state->{last_check} -= 60 * 120;
- lock_store $state, $STATE;
+### jump back in time by 2 hours, make sure both events run
+{ $BASE->_last_check_time( time - 60 * 120 );
+
+ ### there's an event that dies on purpose. dont have the error message
+ ### appear on the terminal
+ { local $Filter = 1;
+ ok( request($URL), 'request ok' );
+ }
- ok( my $res = request('http://localhost/'), 'request ok' );
- is( -e "$FindBin::Bin/lib/TestApp/every_minute.log", 1, 'every_minute executed ok' );
- unlink "$FindBin::Bin/lib/TestApp/every_minute.log";
- is( -e "$FindBin::Bin/lib/TestApp/every_hour.log", 1, 'every_hour executed ok' );
- unlink "$FindBin::Bin/lib/TestApp/every_hour.log";
+ ok( -e "$HOME/every_minute.log", ' every_minute executed ok' );
+ 1 while unlink "$HOME/every_minute.log";
+
+ ok( -e "$HOME/every_hour.log", ' every_hour executed ok' );
+ 1 while unlink "$HOME/every_hour.log";
}
-###
+### check the scheduler state
+{ my $ss = TestApp->scheduler_state;
-sub every_hour {
- my $c = shift;
-
- # write out a file so the test knows we did something
- my $fh = IO::File->new( $c->path_to( 'every_hour.log' ), 'w' )
- or die "Unable to write log file: $!";
- close $fh;
+ ok( $ss, 'Scheduler state retrieved' );
+ isa_ok( $ss, 'ARRAY' );
+ is( scalar(@$ss), scalar(@Map), " All events found" );
+
+ ### key entries on 'event';
+ my %map = map { $_->{event} => $_ } @$ss;
+
+ for my $aref ( @Map ) {
+ my($at,$event,$expect) = @$aref;
+
+ my $entry = $map{$event};
+ ok( $entry, " Event found for $event" );
+ ok( $entry->{'last_run'}, " Event was run" );
+ like( $entry->{'last_output'}, $expect,
+ " Output as expected" );
+ }
+}
+
+### extended API tests
+### test event listing
+{ my @events = TestApp->scheduler->list_events;
+ is( scalar(@events), scalar(@Map), "list_events() returns all events" );
+ isa_ok( $_, "Catalyst::Plugin::Scheduler::Event" )
+ for @events;
}
-sub broken_event {
- my $c = shift;
+### test pending events
+{ ### all events should have run now
+
+ { my @pending = TestApp->scheduler->list_pending_events;
+ is( scalar(@pending), 0, "No more pending events" );
+ }
+
+ # hack the last event check to make all events execute immediately
+ { $BASE->_last_check_time( 0 );
- die 'oops';
+ my @pending = TestApp->scheduler->list_pending_events;
+ is( scalar(@pending), scalar(@Map),
+ " Events found after state reset" );
+ }
+}
+
+### clean up
+{ ok( -e $STATE, "State file exists" );
+ 1 while unlink $STATE;
+ ok(!-e $STATE, " State file removed" );
}
+
+
+
+
+
+
+
+
+
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More;
-use Storable qw/lock_store lock_retrieve/;
-
-plan tests => 6;
+use Test::More tests => 6;
use Catalyst::Test 'TestApp';
our $STATE = "$FindBin::Bin/lib/TestApp/scheduler.state";
+our $BASE = 'Catalyst::Plugin::Scheduler::Base';
+
+# hack the last event check to make all events execute immediately
+$BASE->_last_check_time( 0 );
TestApp->schedule(
at => '* * * * *',
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';
}
# hack the last event check to make all events execute immediately
-$state = lock_retrieve $STATE;
-$state->{last_check} = 0;
-lock_store $state, $STATE;
+$BASE->_last_check_time( 0 );
# allow localhost
TestApp->config->{scheduler}->{hosts_allow} = [ '1.2.3.4', '127.0.0.1' ];
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::More;
-use Storable qw/lock_store lock_retrieve/;
plan tests => 6;
use Catalyst::Test 'TestApp';
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More;
-use Storable qw/lock_store lock_retrieve/;
-
-plan tests => 3;
+use Test::More tests => 3;
use Catalyst::Test 'PluginTestApp';
our $STATE = "$FindBin::Bin/lib/TestApp/scheduler.state";
+our $BASE = 'Catalyst::Plugin::Scheduler::Base';
# hack the last event check to make all events execute immediately
-my $state = { last_check => 0 };
-lock_store $state, $STATE;
+$BASE->_last_check_time( 0 );
# test that the plugin event executes
{
use Catalyst::Test 'TestApp';
our $STATE = "$FindBin::Bin/lib/TestApp/scheduler.state";
+our $BASE = 'Catalyst::Plugin::Scheduler::Base';
# hack the last event check to make all events execute immediately
-my $state = { last_check => 0 };
-lock_store $state, $STATE;
+$BASE->_last_check_time( 0 );
# configure a yaml file
TestApp->config->{scheduler}->{yaml_file}
--- /dev/null
+#!perl
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More 'no_plan';
+use Storable qw/lock_store lock_retrieve/;
+use Catalyst::Test 'TestApp';
+
+our $HOME = "$FindBin::Bin/lib/TestApp";
+our $STATE = "$HOME/scheduler.state";
+our $URL = 'http://localhost/';
+our $BASE = 'Catalyst::Plugin::Scheduler::Base';
+our $Error = 'oops';
+our @Map = (
+ # event # prio # label
+ [ '/cron/every_minute', -10, ],
+ [ TestApp::Controller::Cron->can('every_minute'), 10, "EM" ],
+);
+
+### clean up
+END { 1 while unlink $STATE }
+
+### set up some schedules
+{ for my $aref ( @Map ) {
+
+ my %args;
+ my $i = 0;
+ for my $key ( qw[event priority label] ) {
+ my $val = $aref->[ $i++ ] or next;
+ $args{ $key } = $val;
+ };
+
+ TestApp->schedule( at => '@always', %args );
+ }
+}
+
+### get events, inspect them
+{ my @events = TestApp->scheduler->list_events;
+ ok( scalar(@events), "Found events" );
+ is( scalar(@events), scalar(@Map),
+ " All events retrieved" );
+ isa_ok( $_, "Catalyst::Plugin::Scheduler::Event" ) for @events;
+
+ { # hack the last event check to make all events execute immediately
+ $BASE->_last_check_time( 0 );
+
+ my @pending_events = TestApp->scheduler->list_pending_events;
+ is( scalar( @pending_events ), scalar( @events ),
+ " All pending events retrieved" );
+
+ ### key our template on event name.
+ my %map = map { $_->[0] => $_ } @Map;
+
+ my $prio;
+ for my $event ( @pending_events ) {
+
+ ### check our accessors
+ { my $meth = 'ls_accessors';
+ can_ok( $event, $meth );
+ can_ok( $event, $event->$meth );
+ }
+
+ ### check caller
+ { my $re = __PACKAGE__ # package that sheduled
+ . '.+?'
+ . quotemeta($0) # this file
+ . ':\d+'; # the line number
+ my $by = $event->scheduled_by;
+ like( $by, qr/$re/,
+ " Caller registered: '$by'" );
+ }
+
+ ### check activity
+ ok( $event->active, " Event is active" );
+
+ ### check prio
+ cmp_ok( $prio, '>=', $event->priority,
+ " Sorted in right order"
+ ) unless defined $prio; # first in the chain.
+ $prio = $event->priority;
+
+ ### check some properties
+ my $aref = $map{ $event->event };
+ ok( $aref, " Event retrieved from template" );
+ is( $event->event, $aref->[0],
+ " Right event: ".$event->event );
+ is( $event->priority, $aref->[1],
+ " Right priority: ".$event->priority );
+ is( $event->label, ($aref->[2] || $aref->[0]),
+ " Right label: ".$event->label );
+
+
+ ### this should fail, our $c is not an object
+ eval { $event->run };
+ ok( $@, " Can not run event" );
+ like( $@, qr/not an object/,
+ ' $c is not an object' );
+
+
+ }
+
+ # hack the last event check to make all events execute immediately
+ $BASE->_last_check_time( 0 );
+ { $_->active(0) for @events;
+ ok( !scalar(TestApp->scheduler->list_pending_events),
+ " All events disabled" );
+ $_->active(1) for @events;
+ }
+ }
+}
+
projects / catagits/Catalyst-Plugin-Scheduler.git / commitdiff