lib/Catalyst/Plugin/Scheduler.pm

   1 package Catalyst::Plugin::Scheduler;
   2
   3 use strict;
   4 use warnings;
   5 use base 'Class::Data::Inheritable';
   6 use DateTime;
   7 use DateTime::Event::Cron;
   8 use DateTime::TimeZone;
   9 use NEXT;
  10
  11 our $VERSION = '0.01';
  12
  13 __PACKAGE__->mk_classdata( '_events' => [] );
  14 __PACKAGE__->mk_classdata( '_last_event_check' );
  15
  16 sub schedule {
  17     my ( $class, %args ) = @_;
  18
  19     my $event = {
  20         event    => $args{event},
  21         trigger  => $args{trigger},
  22         auto_run => ( defined $args{auto_run} ) ? $args{auto_run} : 1,
  23     };
  24
  25     if ( $args{at} ) {
  26         # replace keywords that Set::Crontab doesn't support
  27         $args{at} = _prepare_cron( $args{at} );
  28
  29         # parse the cron entry into a DateTime::Set
  30         my $set;
  31         eval { $set = DateTime::Event::Cron->from_cron( $args{at} ) };
  32         if ( $@ ) {
  33             Catalyst::Exception->throw(
  34                 "Scheduler: Unable to parse 'at' value "
  35                 . $args{at} . ': ' . $@
  36             );
  37         }
  38         else {
  39             $event->{set} = $set;
  40         }
  41     }
  42
  43     push @{ $class->_events }, $event;
  44 }
  45
  46 sub dispatch {
  47     my $c = shift;
  48
  49     $c->NEXT::dispatch(@_);
  50
  51     # check if a minute has passed since our last check
  52     if ( time - $c->_last_event_check < 60 ) {
  53         return;
  54     }
  55
  56     my $conf = $c->config->{scheduler};
  57
  58     # check for events to execute
  59     my $last_check = DateTime->from_epoch(
  60         epoch     => $c->_last_event_check,
  61         time_zone => $conf->{time_zone}
  62     );
  63     my $now = DateTime->now( time_zone => $conf->{time_zone} );
  64     $c->_last_event_check( $now->epoch );
  65
  66     EVENT:
  67     for my $event ( @{ $c->_events } ) {
  68         next EVENT unless $event->{set};
  69
  70         my $next_run = $event->{set}->next( $last_check );
  71         if ( $next_run <= $now ) {
  72
  73             # do some security checking for non-auto-run events
  74             if ( !$event->{auto_run} ) {
  75                 next EVENT unless $c->_event_authorized;
  76             }
  77
  78             # update the state file to make sure we're the only process
  79             # running this event
  80             next EVENT unless $c->_mark_state( $event, $next_run );
  81
  82             my $event_name = $event->{trigger} || $event->{event};
  83             $c->log->info( "Scheduler: Executing $event_name" )
  84                 if $conf->{logging};
  85
  86             # trap errors
  87             local $c->{error} = [];
  88
  89             # run event
  90             eval {
  91                 # do not allow the event to modify the response
  92                 local $c->res->{body};
  93                 local $c->res->{cookies};
  94                 local $c->res->{headers};
  95                 local $c->res->{location};
  96                 local $c->res->{status};
  97
  98                 if ( ref $event->{event} eq 'CODE' ) {
  99                     $event->{event}->( $c );
 100                 }
 101                 else {
 102                     $c->forward( $event->{event} );
 103                 }
 104             };
 105             my @errors = @{ $c->{error} };
 106             push @errors, $@ if $@;
 107             if ( @errors ) {
 108                 $c->log->error( 'Scheduler: Error executing '
 109                     . "$event_name: $_" ) for @errors;
 110             }
 111         }
 112     }
 113 }
 114
 115 sub setup {
 116     my $c = shift;
 117
 118     $c->NEXT::setup(@_);
 119
 120     # initial configuration
 121     $c->config->{scheduler}->{logging}     ||= ( $c->debug ) ? 1 : 0;
 122     $c->config->{scheduler}->{time_zone}   ||= $c->_detect_timezone();
 123     $c->config->{scheduler}->{state_file}  ||= $c->path_to('scheduler.state');
 124     $c->config->{scheduler}->{hosts_allow} ||= '127.0.0.1';
 125
 126     $c->_last_event_check(
 127         DateTime->now(
 128             time_zone => $c->config->{scheduler}->{time_zone}
 129         )->epoch
 130     );
 131 }
 132
 133 # Detect the current time zone
 134 sub _detect_timezone {
 135     my $c = shift;
 136
 137     my $tz;
 138     eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
 139     if ($@) {
 140         $c->log->warn(
 141             'Scheduler: Unable to determine local time zone, using UTC' );
 142         return 'UTC';
 143     }
 144     else {
 145         return $tz->name;
 146     }
 147 }
 148
 149 # Check for authorized users on non-auto events
 150 # XXX: TODO
 151 sub _event_authorized {
 152     my $c = shift;
 153
 154 }
 155
 156 # Update the state file
 157 # XXX: TODO
 158 sub _mark_state {
 159     my ( $c, $event, $next_run ) = @_;
 160
 161 }
 162
 163 # Set::Crontab does not support day names, or '@' shortcuts
 164 sub _prepare_cron {
 165     my $cron = shift;
 166
 167     return $cron unless $cron =~ /\w/;
 168
 169     my %replace = (
 170         jan   => 1,
 171         feb   => 2,
 172         mar   => 3,
 173         apr   => 4,
 174         may   => 5,
 175         jun   => 6,
 176         jul   => 7,
 177         aug   => 8,
 178         sep   => 9,
 179         'oct' => 10,
 180         nov   => 11,
 181         dec   => 12,
 182
 183         sun => 0,
 184         mon => 1,
 185         tue => 2,
 186         wed => 3,
 187         thu => 4,
 188         fri => 5,
 189         sat => 6,
 190
 191         'yearly'   => '0 0 1 1 *',
 192         'annually' => '0 0 1 1 *',
 193         'monthly'  => '0 0 1 * *',
 194         'weekly'   => '0 0 * * 0',
 195         'daily'    => '0 0 * * *',
 196         'midnight' => '0 0 * * *',
 197         'hourly'   => '0 * * * *',
 198     );
 199
 200     for my $name ( keys %replace ) {
 201         my $value = $replace{$name};
 202
 203         if ( $cron =~ /^\@$name/ ) {
 204             $cron = $value;
 205             last;
 206         }
 207         else {
 208             $cron =~ s/$name/$value/i;
 209             last unless $cron =~ /\w/;
 210         }
 211     }
 212
 213     return $cron;
 214 }
 215
 216 1;
 217 __END__
 218
 219 =pod
 220
 221 =head1 NAME
 222
 223 Catalyst::Plugin::Scheduler - Schedule events to run in a cron-like fashion
 224
 225 =head1 SYNOPSIS
 226
 227     use Catalyst qw/Scheduler/;
 228
 229     # run remove_sessions in the Cron controller every hour
 230     __PACKAGE__->schedule(
 231         at    => '0 * * * *',
 232         event => '/cron/remove_sessions'
 233     );
 234
 235     # Run a subroutine at 4:05am every Sunday
 236     __PACKAGE__->schedule(
 237         at    => '5 4 * * sun',
 238         event => \&do_stuff,
 239     );
 240
 241 =head1 DESCRIPTION
 242
 243 This plugin allows you to schedule events to run at recurring intervals.
 244 Events will run during the first request which meets or exceeds the specified
 245 time.  Depending on the level of traffic to the application, events may or may
 246 not run at exactly the correct time, but it should be enough to satisfy many
 247 basic scheduling needs.
 248
 249 =head1 CONFIGURATION
 250
 251 Configuration is optional and is specified in MyApp->config->{scheduler}.
 252
 253 =head2 logging
 254
 255 Set to 1 to enable logging of events as they are executed.  This option is
 256 enabled by default when running under -Debug mode.  Errors are always logged
 257 regardless of the value of this option.
 258
 259 =head2 time_zone
 260
 261 The time zone of your system.  This will be autodetected where possible, or
 262 will default to UTC (GMT).  You can override the detection by providing a
 263 valid L<DateTime> time zone string, such as 'America/New_York'.
 264
 265 =head2 state_file
 266
 267 The current state of every event is stored in a file.  By default this is
 268 $APP_HOME/scheduler.state.  If this file cannot be read or created at
 269 startup, your app will die.
 270
 271 =head2 hosts_allow
 272
 273 This option specifies IP addresses for trusted users.  This option defaults
 274 to 127.0.0.1.  Multiple addresses can be specified by using an array
 275 reference.  This option is used for both events where auto_run is set to 0
 276 and for manually-triggered events.
 277
 278     __PACKAGE__->config->{scheduler}->{hosts_allow} = '192.168.1.1';
 279     __PACKAGE__->config->{scheduler}->{hosts_allow} = [
 280         '127.0.0.1',
 281         '192.168.1.1'
 282     ];
 283
 284 =head1 SCHEDULING
 285
 286 =head2 AUTOMATED EVENTS
 287
 288 Events are scheduled by calling the class method C<schedule>.
 289
 290     MyApp->schedule(
 291         at       => '0 * * * *',
 292         event    => '/cron/remove_sessions',
 293     );
 294
 295     package MyApp::Controller::Cron;
 296
 297     sub remove_sessions : Private {
 298         my ( $self, $c ) = @_;
 299
 300         $c->delete_expired_sessions;
 301     }
 302
 303 =head3 at
 304
 305 The time to run an event is specified using L<crontab(5)>-style syntax.
 306
 307     5 0 * * *      # 5 minutes after midnight, every day
 308     15 14 1 * *    # run at 2:15pm on the first of every month
 309     0 22 * * 1-5   # run at 10 pm on weekdays
 310     5 4 * * sun    # run at 4:05am every Sunday
 311
 312 From crontab(5):
 313
 314     field          allowed values
 315     -----          --------------
 316     minute         0-59
 317     hour           0-23
 318     day of month   1-31
 319     month          0-12 (or names, see below)
 320     day of week    0-7 (0 or 7 is Sun, or use names)
 321
 322 Instead of the first five fields, one of seven special strings may appear:
 323
 324     string         meaning
 325     ------         -------
 326     @yearly        Run once a year, "0 0 1 1 *".
 327     @annually      (same as @yearly)
 328     @monthly       Run once a month, "0 0 1 * *".
 329     @weekly        Run once a week, "0 0 * * 0".
 330     @daily         Run once a day, "0 0 * * *".
 331     @midnight      (same as @daily)
 332     @hourly        Run once an hour, "0 * * * *".
 333
 334 =head3 event
 335
 336 The event to run at the specified time can be either a Catalyst private
 337 action path or a coderef.  Both types of event methods will receive the $c
 338 object from the current request, but you must not rely on any request-specific
 339 information present in $c as it will be from a random user request at or near
 340 the event's specified run time.
 341
 342 Important: Methods used for events should be marked C<Private> so that
 343 they can not be executed via the browser.
 344
 345 =head3 auto_run
 346
 347 The auto_run parameter specifies when the event is allowed to be executed.
 348 By default this option is set to 1, so the event will be executed during the
 349 first request that matches the specified time in C<at>.
 350
 351 If set to 0, the event will only run when a request is made by a user from
 352 an authorized address.  The purpose of this option is to allow long-running
 353 tasks to execute only for certain users.
 354
 355     MyApp->schedule(
 356         at       => '0 0 * * *',
 357         event    => '/cron/rebuild_search_index',
 358         auto_run => 0,
 359     );
 360
 361     package MyApp::Controller::Cron;
 362
 363     sub rebuild_search_index : Private {
 364         my ( $self, $c ) = @_;
 365
 366         # rebuild the search index, this may take a long time
 367     }
 368
 369 Now, the search index will only be rebuilt when a request is made from a user
 370 whose IP address matches the list in the C<hosts_allow> config option.  To
 371 run this event, you probably want to ping the app from a cron job.
 372
 373     0 0 * * * wget -q http://www.myapp.com/
 374
 375 =head2 MANUAL EVENTS
 376
 377 To create an event that does not run on a set schedule and must be manually
 378 triggered, you can specify the C<trigger> option instead of C<at>.
 379
 380     __PACKAGE__->schedule(
 381         trigger => 'send_email',
 382         event   => '/events/send_email',
 383     );
 384
 385 The event may then be triggered by a standard web request from an authorized
 386 user.  The trigger to run is specified by using a special GET parameter,
 387 'schedule_trigger'; the path requested does not matter.
 388
 389     http://www.myapp.com/?schedule_trigger=send_email
 390
 391 By default, manual events may only be triggered by requests made from
 392 localhost (127.0.0.1).  To allow other addresses to run events, use the
 393 configuration option C<hosts_allow>.
 394
 395 =head1 SECURITY
 396
 397 All events are run inside of an eval container.  This protects the user from
 398 receiving any error messages or page crashes if an event fails to run
 399 properly.  All event errors are logged, even if logging is disabled.
 400
 401 =head1 CAVEATS
 402
 403 The time at which an event will run is determined completely by the requests
 404 made to the application.  Apps with heavy traffic may have events run at very
 405 close to the correct time, whereas apps with low levels of traffic may see
 406 events running much later than scheduled.  If this is a problem, you can use
 407 a real cron entry that simply hits your application at the desired time.
 408
 409     0 * * * * wget -q http://www.myapp.com/
 410
 411 Events which consume a lot of time will slow the request processing for the
 412 user who triggers the event.  For these types of events, you should use
 413 auto_run => 0 or manual event triggering.
 414
 415 =head1 PLUGIN SUPPORT
 416
 417 Other plugins may register scheduled events if they need to perform periodic
 418 maintenance.  Plugin authors, B<be sure to inform your users> if you do this!
 419 Events should be registered from a plugin's C<setup> method.
 420
 421     sub setup {
 422         my $c = shift;
 423         $c->NEXT::setup(@_);
 424
 425         if ( $c->can('schedule') ) {
 426             $c->schedule(
 427                 at    => '0 * * * *',
 428                 event => \&cleanup,
 429             );
 430         }
 431     }
 432
 433 =head1 TODO
 434
 435 Support storing all scheduled events in an external YAML file.  This would
 436 only allow private actions, not coderefs.  It would also allow changes to
 437 the schedule to take effect in realtime.
 438
 439 =head1 SEE ALSO
 440
 441 L<crontab(5)>
 442
 443 =head1 AUTHOR
 444
 445 Andy Grundman, <andy@hybridized.org>
 446
 447 =head1 COPYRIGHT
 448
 449 This program is free software, you can redistribute it and/or modify it
 450 under the same terms as Perl itself.
 451
 452 =cut