lib/Catalyst/Plugin/Scheduler.pm

   1 package Catalyst::Plugin::Scheduler;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
   6 use DateTime;
   7 use DateTime::Event::Cron;
   8 use DateTime::TimeZone;
   9 use File::stat;
  10 use NEXT;
  11 use Set::Object;
  12 use Storable qw/lock_store lock_retrieve/;
  13 use YAML;
  14
  15 our $VERSION = '0.01';
  16
  17 __PACKAGE__->mk_classdata( '_events' => [] );
  18 __PACKAGE__->mk_accessors('_event_state');
  19
  20 sub schedule {
  21     my ( $class, %args ) = @_;
  22
  23     unless ( $args{event} ) {
  24         Catalyst::Exception->throw(
  25             message => 'The schedule method requires an event parameter' );
  26     }
  27
  28     my $conf = $class->config->{scheduler};
  29
  30     my $event = {
  31         trigger  => $args{trigger},
  32         event    => $args{event},
  33         auto_run => ( defined $args{auto_run} ) ? $args{auto_run} : 1,
  34     };
  35
  36     if ( $args{at} ) {
  37
  38         # replace keywords that Set::Crontab doesn't support
  39         $args{at} = _prepare_cron( $args{at} );
  40
  41         # parse the cron entry into a DateTime::Set
  42         my $set;
  43         eval { $set = DateTime::Event::Cron->from_cron( $args{at} ) };
  44         if ($@) {
  45             Catalyst::Exception->throw(
  46                       "Scheduler: Unable to parse 'at' value "
  47                     . $args{at} . ': '
  48                     . $@ );
  49         }
  50         else {
  51             $event->{set} = $set;
  52         }
  53     }
  54
  55     push @{ $class->_events }, $event;
  56 }
  57
  58 sub dispatch {
  59     my $c = shift;
  60
  61     $c->NEXT::dispatch(@_);
  62
  63     $c->_get_event_state();
  64
  65     $c->_check_yaml();
  66
  67     # check if a minute has passed since our last check
  68     # This check is not run if the user is manually triggering an event
  69     if ( time - $c->_event_state->{last_check} < 60 ) {
  70         return unless $c->req->params->{schedule_trigger};
  71     }
  72     my $last_check = $c->_event_state->{last_check};
  73     $c->_event_state->{last_check} = time;
  74     $c->_save_event_state();
  75
  76     my $conf          = $c->config->{scheduler};
  77     my $last_check_dt = DateTime->from_epoch(
  78         epoch     => $last_check,
  79         time_zone => $conf->{time_zone}
  80     );
  81     my $now = DateTime->now( time_zone => $conf->{time_zone} );
  82
  83     EVENT:
  84     for my $event ( @{ $c->_events } ) {
  85         my $next_run;
  86
  87         if (   $event->{trigger}
  88             && $event->{trigger} eq $c->req->params->{schedule_trigger} )
  89         {
  90
  91             # manual trigger, run it now
  92             next EVENT unless $c->_event_authorized;
  93             $next_run = $now;
  94         }
  95         else {
  96             next EVENT unless $event->{set};
  97             $next_run = $event->{set}->next($last_check_dt);
  98         }
  99
 100         if ( $next_run <= $now ) {
 101
 102             # do some security checking for non-auto-run events
 103             if ( !$event->{auto_run} ) {
 104                 next EVENT unless $c->_event_authorized;
 105             }
 106
 107             # make sure we're the only process running this event
 108             next EVENT unless $c->_mark_running($event);
 109
 110             my $event_name = $event->{trigger} || $event->{event};
 111             $c->log->debug("Scheduler: Executing $event_name")
 112                 if $c->config->{scheduler}->{logging};
 113
 114             # trap errors
 115             local $c->{error} = [];
 116
 117             # run event
 118             eval {
 119
 120                 # do not allow the event to modify the response
 121                 local $c->res->{body};
 122                 local $c->res->{cookies};
 123                 local $c->res->{headers};
 124                 local $c->res->{location};
 125                 local $c->res->{status};
 126
 127                 if ( ref $event->{event} eq 'CODE' ) {
 128                     $event->{event}->($c);
 129                 }
 130                 else {
 131                     $c->forward( $event->{event} );
 132                 }
 133             };
 134             my @errors = @{ $c->{error} };
 135             push @errors, $@ if $@;
 136             if (@errors) {
 137                 $c->log->error(
 138                     'Scheduler: Error executing ' . "$event_name: $_" )
 139                     for @errors;
 140             }
 141
 142             $c->_mark_finished($event);
 143         }
 144     }
 145 }
 146
 147 sub setup {
 148     my $c = shift;
 149
 150     # initial configuration
 151     $c->config->{scheduler}->{logging}     ||= ( $c->debug ) ? 1 : 0;
 152     $c->config->{scheduler}->{time_zone}   ||= $c->_detect_timezone();
 153     $c->config->{scheduler}->{state_file}  ||= $c->path_to('scheduler.state');
 154     $c->config->{scheduler}->{hosts_allow} ||= '127.0.0.1';
 155     $c->config->{scheduler}->{yaml}        ||= $c->path_to('scheduler.yml');
 156
 157     $c->NEXT::setup(@_);
 158 }
 159
 160 # check and reload the YAML file with schedule data
 161 sub _check_yaml {
 162     my ($c) = @_;
 163
 164     # each process needs to load the YAML file independently
 165     if ( $c->_event_state->{yaml_mtime}->{$$} ||= 0 ) {
 166         return if ( time - $c->_event_state->{last_check} < 60 );
 167     }
 168
 169     return unless -e $c->config->{scheduler}->{yaml};
 170
 171     eval {
 172         my $mtime = ( stat $c->config->{scheduler}->{yaml} )->mtime;
 173         if ( $mtime > $c->_event_state->{yaml_mtime}->{$$} ) {
 174             $c->_event_state->{yaml_mtime}->{$$} = $mtime;
 175             $c->_save_event_state();
 176
 177             # wipe out all current events and reload from YAML
 178             $c->_events( [] );
 179
 180             my $yaml = YAML::LoadFile( $c->config->{scheduler}->{yaml} );
 181
 182             foreach my $event ( @{$yaml} ) {
 183                 $c->schedule( %{$event} );
 184             }
 185
 186             $c->log->info( "Scheduler: PID $$ loaded "
 187                     . scalar @{$yaml}
 188                     . ' events from YAML file' )
 189                 if $c->config->{scheduler}->{logging};
 190         }
 191     };
 192     if ($@) {
 193         $c->log->error("Error reading YAML file: $@");
 194     }
 195 }
 196
 197 # Detect the current time zone
 198 sub _detect_timezone {
 199     my $c = shift;
 200
 201     my $tz;
 202     eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
 203     if ($@) {
 204         $c->log->warn(
 205             'Scheduler: Unable to autodetect local time zone, using UTC');
 206         return 'UTC';
 207     }
 208     else {
 209         $c->log->debug(
 210             'Scheduler: Using autodetected time zone: ' . $tz->name )
 211             if $c->config->{scheduler}->{logging};
 212         return $tz->name;
 213     }
 214 }
 215
 216 # Check for authorized users on non-auto events
 217 sub _event_authorized {
 218     my $c = shift;
 219
 220     # this should never happen, but just in case...
 221     return unless $c->req->address;
 222
 223     my $hosts_allow = $c->config->{scheduler}->{hosts_allow};
 224     $hosts_allow = [$hosts_allow] unless ref($hosts_allow) eq 'ARRAY';
 225
 226     my $ip      = Set::Object->new( [ $c->req->address ] );
 227     my $allowed = Set::Object->new( $hosts_allow );
 228
 229     return $ip->subset($allowed);
 230 }
 231
 232 # get the state from the state file
 233 sub _get_event_state {
 234     my $c = shift;
 235
 236     if ( -e $c->config->{scheduler}->{state_file} ) {
 237         $c->_event_state(
 238             lock_retrieve $c->config->{scheduler}->{state_file} );
 239     }
 240     else {
 241
 242         # initialize the state file
 243         $c->_event_state(
 244             {   last_check => time,
 245                 yaml_mtime => {},
 246             }
 247         );
 248         $c->_save_event_state();
 249     }
 250 }
 251
 252 # Check the state file to ensure we are the only process running an event
 253 sub _mark_running {
 254     my ( $c, $event ) = @_;
 255
 256     $c->_get_event_state();
 257
 258     return if $c->_event_state->{ $event->{event} };
 259
 260     # this is a 2-step process to prevent race conditions
 261     # 1. write the state file with our PID
 262     $c->_event_state->{ $event->{event} } = $$;
 263     $c->_save_event_state();
 264
 265     # 2. re-read the state file and make sure it's got the same PID
 266     $c->_get_event_state();
 267     if ( $c->_event_state->{ $event->{event} } == $$ ) {
 268         return 1;
 269     }
 270
 271     return;
 272 }
 273
 274 # Mark an event as finished
 275 sub _mark_finished {
 276     my ( $c, $event ) = @_;
 277
 278     $c->_event_state->{ $event->{event} } = 0;
 279     $c->_save_event_state();
 280 }
 281
 282 # update the state file on disk
 283 sub _save_event_state {
 284     my $c = shift;
 285
 286     lock_store $c->_event_state, $c->config->{scheduler}->{state_file};
 287 }
 288
 289 # Set::Crontab does not support day names, or '@' shortcuts
 290 sub _prepare_cron {
 291     my $cron = shift;
 292
 293     return $cron unless $cron =~ /\w/;
 294
 295     my %replace = (
 296         jan   => 1,
 297         feb   => 2,
 298         mar   => 3,
 299         apr   => 4,
 300         may   => 5,
 301         jun   => 6,
 302         jul   => 7,
 303         aug   => 8,
 304         sep   => 9,
 305         'oct' => 10,
 306         nov   => 11,
 307         dec   => 12,
 308
 309         sun => 0,
 310         mon => 1,
 311         tue => 2,
 312         wed => 3,
 313         thu => 4,
 314         fri => 5,
 315         sat => 6,
 316
 317         'yearly'   => '0 0 1 1 *',
 318         'annually' => '0 0 1 1 *',
 319         'monthly'  => '0 0 1 * *',
 320         'weekly'   => '0 0 * * 0',
 321         'daily'    => '0 0 * * *',
 322         'midnight' => '0 0 * * *',
 323         'hourly'   => '0 * * * *',
 324     );
 325
 326     for my $name ( keys %replace ) {
 327         my $value = $replace{$name};
 328
 329         if ( $cron =~ /^\@$name/ ) {
 330             $cron = $value;
 331             last;
 332         }
 333         else {
 334             $cron =~ s/$name/$value/i;
 335             last unless $cron =~ /\w/;
 336         }
 337     }
 338
 339     return $cron;
 340 }
 341
 342 1;
 343 __END__
 344
 345 =pod
 346
 347 =head1 NAME
 348
 349 Catalyst::Plugin::Scheduler - Schedule events to run in a cron-like fashion
 350
 351 =head1 SYNOPSIS
 352
 353     use Catalyst qw/Scheduler/;
 354
 355     # run remove_sessions in the Cron controller every hour
 356     __PACKAGE__->schedule(
 357         at    => '0 * * * *',
 358         event => '/cron/remove_sessions'
 359     );
 360
 361     # Run a subroutine at 4:05am every Sunday
 362     __PACKAGE__->schedule(
 363         at    => '5 4 * * sun',
 364         event => \&do_stuff,
 365     );
 366
 367     # A long-running scheduled event that must be triggered
 368     # manually by an authorized user
 369     __PACKAGE__->schedule(
 370         trigger => 'rebuild_search_index',
 371         event   => '/cron/rebuild_search_index',
 372     );
 373     $ wget -q http://www.myapp.com/?schedule_trigger=rebuild_search_index
 374
 375 =head1 DESCRIPTION
 376
 377 This plugin allows you to schedule events to run at recurring intervals.
 378 Events will run during the first request which meets or exceeds the specified
 379 time.  Depending on the level of traffic to the application, events may or may
 380 not run at exactly the correct time, but it should be enough to satisfy many
 381 basic scheduling needs.
 382
 383 =head1 CONFIGURATION
 384
 385 Configuration is optional and is specified in MyApp->config->{scheduler}.
 386
 387 =head2 logging
 388
 389 Set to 1 to enable logging of events as they are executed.  This option is
 390 enabled by default when running under -Debug mode.  Errors are always logged
 391 regardless of the value of this option.
 392
 393 =head2 time_zone
 394
 395 The time zone of your system.  This will be autodetected where possible, or
 396 will default to UTC (GMT).  You can override the detection by providing a
 397 valid L<DateTime> time zone string, such as 'America/New_York'.
 398
 399 =head2 state_file
 400
 401 The current state of every event is stored in a file.  By default this is
 402 $APP_HOME/scheduler.state.  This file is created on the first request if it
 403 does not already exist.
 404
 405 =head2 yaml_file
 406
 407 The location of the optional YAML event configuration file.  By default this
 408 is $APP_HOME/scheduler.yml.
 409
 410 =head2 hosts_allow
 411
 412 This option specifies IP addresses for trusted users.  This option defaults
 413 to 127.0.0.1.  Multiple addresses can be specified by using an array
 414 reference.  This option is used for both events where auto_run is set to 0
 415 and for manually-triggered events.
 416
 417     __PACKAGE__->config->{scheduler}->{hosts_allow} = '192.168.1.1';
 418     __PACKAGE__->config->{scheduler}->{hosts_allow} = [
 419         '127.0.0.1',
 420         '192.168.1.1'
 421     ];
 422
 423 =head1 SCHEDULING
 424
 425 =head2 AUTOMATED EVENTS
 426
 427 Events are scheduled by calling the class method C<schedule>.
 428
 429     MyApp->schedule(
 430         at       => '0 * * * *',
 431         event    => '/cron/remove_sessions',
 432     );
 433
 434     package MyApp::Controller::Cron;
 435
 436     sub remove_sessions : Private {
 437         my ( $self, $c ) = @_;
 438
 439         $c->delete_expired_sessions;
 440     }
 441
 442 =head3 at
 443
 444 The time to run an event is specified using L<crontab(5)>-style syntax.
 445
 446     5 0 * * *      # 5 minutes after midnight, every day
 447     15 14 1 * *    # run at 2:15pm on the first of every month
 448     0 22 * * 1-5   # run at 10 pm on weekdays
 449     5 4 * * sun    # run at 4:05am every Sunday
 450
 451 From crontab(5):
 452
 453     field          allowed values
 454     -----          --------------
 455     minute         0-59
 456     hour           0-23
 457     day of month   1-31
 458     month          0-12 (or names, see below)
 459     day of week    0-7 (0 or 7 is Sun, or use names)
 460
 461 Instead of the first five fields, one of seven special strings may appear:
 462
 463     string         meaning
 464     ------         -------
 465     @yearly        Run once a year, "0 0 1 1 *".
 466     @annually      (same as @yearly)
 467     @monthly       Run once a month, "0 0 1 * *".
 468     @weekly        Run once a week, "0 0 * * 0".
 469     @daily         Run once a day, "0 0 * * *".
 470     @midnight      (same as @daily)
 471     @hourly        Run once an hour, "0 * * * *".
 472
 473 =head3 event
 474
 475 The event to run at the specified time can be either a Catalyst private
 476 action path or a coderef.  Both types of event methods will receive the $c
 477 object from the current request, but you must not rely on any request-specific
 478 information present in $c as it will be from a random user request at or near
 479 the event's specified run time.
 480
 481 Important: Methods used for events should be marked C<Private> so that
 482 they can not be executed via the browser.
 483
 484 =head3 auto_run
 485
 486 The auto_run parameter specifies when the event is allowed to be executed.
 487 By default this option is set to 1, so the event will be executed during the
 488 first request that matches the specified time in C<at>.
 489
 490 If set to 0, the event will only run when a request is made by a user from
 491 an authorized address.  The purpose of this option is to allow long-running
 492 tasks to execute only for certain users.
 493
 494     MyApp->schedule(
 495         at       => '0 0 * * *',
 496         event    => '/cron/rebuild_search_index',
 497         auto_run => 0,
 498     );
 499
 500     package MyApp::Controller::Cron;
 501
 502     sub rebuild_search_index : Private {
 503         my ( $self, $c ) = @_;
 504
 505         # rebuild the search index, this may take a long time
 506     }
 507
 508 Now, the search index will only be rebuilt when a request is made from a user
 509 whose IP address matches the list in the C<hosts_allow> config option.  To
 510 run this event, you probably want to ping the app from a cron job.
 511
 512     0 0 * * * wget -q http://www.myapp.com/
 513
 514 =head2 MANUAL EVENTS
 515
 516 To create an event that does not run on a set schedule and must be manually
 517 triggered, you can specify the C<trigger> option instead of C<at>.
 518
 519     __PACKAGE__->schedule(
 520         trigger => 'send_email',
 521         event   => '/events/send_email',
 522     );
 523
 524 The event may then be triggered by a standard web request from an authorized
 525 user.  The trigger to run is specified by using a special GET parameter,
 526 'schedule_trigger'; the path requested does not matter.
 527
 528     http://www.myapp.com/?schedule_trigger=send_email
 529
 530 By default, manual events may only be triggered by requests made from
 531 localhost (127.0.0.1).  To allow other addresses to run events, use the
 532 configuration option L</hosts_allow>.
 533
 534 =head1 SCHEDULING USING A YAML FILE
 535
 536 As an alternative to using the schedule() method, you may define scheduled
 537 events in an external YAML file.  By default, the plugin looks for the
 538 existence of a file called C<schedule.yml> in your application's home
 539 directory.  You can change the filename using the configuration option
 540 L</yaml_file>.
 541
 542 Modifications to this file will be re-read once per minute during the normal
 543 event checking process.
 544
 545 Here's an example YAML configuration file with 4 events.  Each event is
 546 denoted with a '-' character, followed by the same parameters used by the
 547 C<schedule> method.  Note that coderef events are not supported by the YAML
 548 file.
 549
 550     ---
 551     - at: '* * * * *'
 552       event: /cron/delete_sessions
 553     - event: /cron/send_email
 554       trigger: send_email
 555     - at: '@hourly'
 556       event: /cron/hourly
 557     - at: 0 0 * * *
 558       auto_run: 0
 559       event: /cron/rebuild_search_index
 560
 561 =head1 SECURITY
 562
 563 All events are run inside of an eval container.  This protects the user from
 564 receiving any error messages or page crashes if an event fails to run
 565 properly.  All event errors are logged, even if logging is disabled.
 566
 567 =head1 PLUGIN SUPPORT
 568
 569 Other plugins may register scheduled events if they need to perform periodic
 570 maintenance.  Plugin authors, B<be sure to inform your users> if you do this!
 571 Events should be registered from a plugin's C<setup> method.
 572
 573     sub setup {
 574         my $c = shift;
 575         $c->NEXT::setup(@_);
 576
 577         if ( $c->can('schedule') ) {
 578             $c->schedule(
 579                 at    => '0 * * * *',
 580                 event => \&cleanup,
 581             );
 582         }
 583     }
 584
 585 =head1 CAVEATS
 586
 587 The time at which an event will run is determined completely by the requests
 588 made to the application.  Apps with heavy traffic may have events run at very
 589 close to the correct time, whereas apps with low levels of traffic may see
 590 events running much later than scheduled.  If this is a problem, you can use
 591 a real cron entry that simply hits your application at the desired time.
 592
 593     0 * * * * wget -q http://www.myapp.com/
 594
 595 Events which consume a lot of time will slow the request processing for the
 596 user who triggers the event.  For these types of events, you should use
 597 auto_run => 0 or manual event triggering.
 598
 599 =head1 PERFORMANCE
 600
 601 The plugin only checks once per minute if any events need to be run, so the
 602 overhead on each request is minimal.  On my test server, the difference
 603 between running with Scheduler and without was only around 0.02% (0.004
 604 seconds).
 605
 606 Of course, when a scheduled event runs, performance will depend on what's
 607 being run in the event.
 608
 609 =head1 SEE ALSO
 610
 611 L<crontab(5)>
 612
 613 =head1 AUTHOR
 614
 615 Andy Grundman, <andy@hybridized.org>
 616
 617 =head1 COPYRIGHT
 618
 619 This program is free software, you can redistribute it and/or modify it
 620 under the same terms as Perl itself.
 621
 622 =cut