[Catalyst-commits] r7375 - in trunk/Catalyst-Plugin-Scheduler:
lib/Catalyst/Plugin t
andyg at dev.catalyst.perl.org
andyg at dev.catalyst.perl.org
Sat Jan 12 15:19:42 GMT 2008
Author: andyg
Date: 2008-01-12 15:19:42 +0000 (Sat, 12 Jan 2008)
New Revision: 7375
Removed:
trunk/Catalyst-Plugin-Scheduler/lib/Catalyst/Plugin/Scheduler/
trunk/Catalyst-Plugin-Scheduler/t/10events.t
Modified:
trunk/Catalyst-Plugin-Scheduler/lib/Catalyst/Plugin/Scheduler.pm
trunk/Catalyst-Plugin-Scheduler/t/04schedule.t
trunk/Catalyst-Plugin-Scheduler/t/05auto_run.t
trunk/Catalyst-Plugin-Scheduler/t/06trigger.t
trunk/Catalyst-Plugin-Scheduler/t/07plugin.t
trunk/Catalyst-Plugin-Scheduler/t/08yaml.t
Log:
Revert Scheduler plugin back to 0.07 release state
Modified: trunk/Catalyst-Plugin-Scheduler/lib/Catalyst/Plugin/Scheduler.pm
===================================================================
--- trunk/Catalyst-Plugin-Scheduler/lib/Catalyst/Plugin/Scheduler.pm 2008-01-12 14:57:44 UTC (rev 7374)
+++ trunk/Catalyst-Plugin-Scheduler/lib/Catalyst/Plugin/Scheduler.pm 2008-01-12 15:19:42 UTC (rev 7375)
@@ -2,13 +2,441 @@
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
=head1 NAME
@@ -37,10 +465,8 @@
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.
@@ -49,7 +475,6 @@
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}.
@@ -90,93 +515,10 @@
'192.168.1.1'
];
-=head2 check_every
+=head1 SCHEDULING
-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.
+=head2 AUTOMATED EVENTS
-=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.
-
-=head3 SCHEDULING AUTOMATED EVENTS
-
Events are scheduled by calling the class method C<schedule>.
MyApp->schedule(
@@ -192,7 +534,7 @@
$c->delete_expired_sessions;
}
-=head4 at
+=head3 at
The time to run an event is specified using L<crontab(5)>-style syntax.
@@ -211,8 +553,7 @@
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
------ -------
@@ -223,9 +564,8 @@
@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
@@ -236,7 +576,7 @@
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
@@ -266,7 +606,7 @@
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>.
@@ -286,70 +626,6 @@
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
@@ -358,9 +634,8 @@
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
@@ -401,9 +676,7 @@
);
}
}
-
-
-
+
=head1 CAVEATS
The time at which an event will run is determined completely by the requests
@@ -420,22 +693,74 @@
=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 at hybridized.org>
-Jos I. Boumans, <kane at cpan.org>
=head1 COPYRIGHT
@@ -443,30 +768,3 @@
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
-
-
Modified: trunk/Catalyst-Plugin-Scheduler/t/04schedule.t
===================================================================
--- trunk/Catalyst-Plugin-Scheduler/t/04schedule.t 2008-01-12 14:57:44 UTC (rev 7374)
+++ trunk/Catalyst-Plugin-Scheduler/t/04schedule.t 2008-01-12 15:19:42 UTC (rev 7375)
@@ -1,165 +1,89 @@
#!perl
+
use strict;
use warnings;
use FindBin;
-use lib "$FindBin::Bin/lib";
-use Test::More 'no_plan';
+use lib "$FindBin::Bin/lib";
+use Test::More;
+use Storable qw/lock_store lock_retrieve/;
+
+plan tests => 10;
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 $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/ ],
+our $STATE = "$FindBin::Bin/lib/TestApp/scheduler.state";
+
+TestApp->schedule(
+ at => '* * * * *',
+ event => '/cron/every_minute',
);
-### clean up
-END { 1 while unlink $STATE }
+TestApp->schedule(
+ at => '@hourly',
+ event => \&every_hour,
+);
-### filter expected error messages, when needed...
-{ my $org = Catalyst::Log->can('_send_to_log');
+# events with errors to test the error handling
+TestApp->schedule(
+ at => '*/2 * * * *',
+ event => '/cron/test_errors',
+);
- no warnings 'redefine';
- *Catalyst::Log::_send_to_log = sub {
- return if $Filter and "@_" =~ /Scheduler: Error executing/;
- $org->( @_ );
- };
-}
+TestApp->schedule(
+ at => '0 * * * *',
+ event => \&broken_event,
+);
-### 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; }
-}
-
-
# hack the last event check to make all events execute immediately
-$BASE->_last_check_time( 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
-{ ### 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";
+# 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";
}
-
-
-### 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";
+# 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";
}
-### 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' );
- }
+# 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;
- 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";
+ 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";
}
-### check the scheduler state
-{ my $ss = TestApp->scheduler_state;
+###
- 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" );
- }
+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;
}
-### 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;
-}
-
-### 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 );
+sub broken_event {
+ my $c = shift;
- my @pending = TestApp->scheduler->list_pending_events;
- is( scalar(@pending), scalar(@Map),
- " Events found after state reset" );
- }
+ die 'oops';
}
-
-### clean up
-{ ok( -e $STATE, "State file exists" );
- 1 while unlink $STATE;
- ok(!-e $STATE, " State file removed" );
-}
-
-
-
-
-
-
-
-
-
Modified: trunk/Catalyst-Plugin-Scheduler/t/05auto_run.t
===================================================================
--- trunk/Catalyst-Plugin-Scheduler/t/05auto_run.t 2008-01-12 14:57:44 UTC (rev 7374)
+++ trunk/Catalyst-Plugin-Scheduler/t/05auto_run.t 2008-01-12 15:19:42 UTC (rev 7375)
@@ -5,21 +5,23 @@
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 6;
+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";
-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 => '* * * * *',
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';
@@ -33,7 +35,9 @@
}
# hack the last event check to make all events execute immediately
-$BASE->_last_check_time( 0 );
+$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' ];
Modified: trunk/Catalyst-Plugin-Scheduler/t/06trigger.t
===================================================================
--- trunk/Catalyst-Plugin-Scheduler/t/06trigger.t 2008-01-12 14:57:44 UTC (rev 7374)
+++ trunk/Catalyst-Plugin-Scheduler/t/06trigger.t 2008-01-12 15:19:42 UTC (rev 7375)
@@ -6,6 +6,7 @@
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::More;
+use Storable qw/lock_store lock_retrieve/;
plan tests => 6;
use Catalyst::Test 'TestApp';
Modified: trunk/Catalyst-Plugin-Scheduler/t/07plugin.t
===================================================================
--- trunk/Catalyst-Plugin-Scheduler/t/07plugin.t 2008-01-12 14:57:44 UTC (rev 7374)
+++ trunk/Catalyst-Plugin-Scheduler/t/07plugin.t 2008-01-12 15:19:42 UTC (rev 7375)
@@ -5,14 +5,17 @@
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 3;
+use Test::More;
+use Storable qw/lock_store lock_retrieve/;
+
+plan 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
-$BASE->_last_check_time( 0 );
+my $state = { last_check => 0 };
+lock_store $state, $STATE;
# test that the plugin event executes
{
Modified: trunk/Catalyst-Plugin-Scheduler/t/08yaml.t
===================================================================
--- trunk/Catalyst-Plugin-Scheduler/t/08yaml.t 2008-01-12 14:57:44 UTC (rev 7374)
+++ trunk/Catalyst-Plugin-Scheduler/t/08yaml.t 2008-01-12 15:19:42 UTC (rev 7375)
@@ -12,10 +12,10 @@
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 );
+my $state = { last_check => 0 };
+lock_store $state, $STATE;
# configure a yaml file
TestApp->config->{scheduler}->{yaml_file}
Deleted: trunk/Catalyst-Plugin-Scheduler/t/10events.t
===================================================================
--- trunk/Catalyst-Plugin-Scheduler/t/10events.t 2008-01-12 14:57:44 UTC (rev 7374)
+++ trunk/Catalyst-Plugin-Scheduler/t/10events.t 2008-01-12 15:19:42 UTC (rev 7375)
@@ -1,113 +0,0 @@
-#!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;
- }
- }
-}
-
More information about the Catalyst-commits
mailing list