Scheduler, refactored to store last run time, last return value, and allow a public...
[catagits/Catalyst-Plugin-Scheduler.git] / lib / Catalyst / Plugin / Scheduler.pm
index 535d761..c85de68 100644 (file)
@@ -8,11 +8,11 @@ use DateTime::Event::Cron;
 use DateTime::TimeZone;
 use File::stat;
 use NEXT;
-use Set::Object;
+use Set::Scalar;
 use Storable qw/lock_store lock_retrieve/;
 use YAML;
 
-our $VERSION = '0.01';
+our $VERSION = '0.06';
 
 __PACKAGE__->mk_classdata( '_events' => [] );
 __PACKAGE__->mk_accessors('_event_state');
@@ -26,7 +26,7 @@ sub schedule {
     }
 
     my $conf = $class->config->{scheduler};
-
+    
     my $event = {
         trigger  => $args{trigger},
         event    => $args{event},
@@ -37,7 +37,7 @@ sub schedule {
 
         # 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} ) };
@@ -48,6 +48,7 @@ sub schedule {
                     . $@ );
         }
         else {
+            $event->{at}  = $args{at};
             $event->{set} = $set;
         }
     }
@@ -113,6 +114,9 @@ sub dispatch {
 
             # trap errors
             local $c->{error} = [];
+            
+            # return value/output from the event, if any
+            my $output;
 
             # run event
             eval {
@@ -125,10 +129,10 @@ sub dispatch {
                 local $c->res->{status};
 
                 if ( ref $event->{event} eq 'CODE' ) {
-                    $event->{event}->($c);
+                    $output = $event->{event}->($c);
                 }
                 else {
-                    $c->forward( $event->{event} );
+                    $output = $c->forward( $event->{event} );
                 }
             };
             my @errors = @{ $c->{error} };
@@ -137,9 +141,10 @@ sub dispatch {
                 $c->log->error(
                     'Scheduler: Error executing ' . "$event_name: $_" )
                     for @errors;
+                $output = join '; ', @errors;
             }
 
-            $c->_mark_finished($event);
+            $c->_mark_finished( $event, $output );
         }
     }
 }
@@ -152,11 +157,81 @@ sub setup {
     $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}        ||= $c->path_to('scheduler.yml');
+    $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) = @_;
@@ -166,19 +241,26 @@ sub _check_yaml {
         return if ( time - $c->_event_state->{last_check} < 60 );
     }
 
-    return unless -e $c->config->{scheduler}->{yaml};
+    return unless -e $c->config->{scheduler}->{yaml_file};
 
     eval {
-        my $mtime = ( stat $c->config->{scheduler}->{yaml} )->mtime;
+        my $mtime = ( stat $c->config->{scheduler}->{yaml_file} )->mtime;
         if ( $mtime > $c->_event_state->{yaml_mtime}->{$$} ) {
             $c->_event_state->{yaml_mtime}->{$$} = $mtime;
-            $c->_save_event_state();
 
+            # clean up old PID files 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 $yaml = YAML::LoadFile( $c->config->{scheduler}->{yaml} );
-
+            my $yaml = YAML::LoadFile( $c->config->{scheduler}->{yaml_file} );
+            
             foreach my $event ( @{$yaml} ) {
                 $c->schedule( %{$event} );
             }
@@ -190,7 +272,7 @@ sub _check_yaml {
         }
     };
     if ($@) {
-        $c->log->error("Error reading YAML file: $@");
+        $c->log->error("Scheduler: Error reading YAML file: $@");
     }
 }
 
@@ -202,7 +284,8 @@ sub _detect_timezone {
     eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
     if ($@) {
         $c->log->warn(
-            'Scheduler: Unable to autodetect local time zone, using UTC');
+            'Scheduler: Unable to autodetect local time zone, using UTC')
+            if $c->config->{scheduler}->{logging}; 
         return 'UTC';
     }
     else {
@@ -222,11 +305,8 @@ sub _event_authorized {
 
     my $hosts_allow = $c->config->{scheduler}->{hosts_allow};
     $hosts_allow = [$hosts_allow] unless ref($hosts_allow) eq 'ARRAY';
-
-    my $ip      = Set::Object->new( [ $c->req->address ] );
-    my $allowed = Set::Object->new( $hosts_allow );
-
-    return $ip->subset($allowed);
+    my $allowed = Set::Scalar->new( @{$hosts_allow} );
+    return $allowed->contains( $c->req->address );
 }
 
 # get the state from the state file
@@ -241,8 +321,9 @@ sub _get_event_state {
 
         # initialize the state file
         $c->_event_state(
-            {   last_check => time,
-                yaml_mtime => {},
+            {   last_check  => time,
+                events      => {},
+                yaml_mtime  => {},
             }
         );
         $c->_save_event_state();
@@ -255,16 +336,17 @@ sub _mark_running {
 
     $c->_get_event_state();
 
-    return if $c->_event_state->{ $event->{event} };
+    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->{ $event->{event} } = $$;
+    $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->{ $event->{event} } == $$ ) {
+    if ( $c->_event_state->{events}->{ $event->{event} }->{running} == $$ ) {
         return 1;
     }
 
@@ -273,9 +355,11 @@ sub _mark_running {
 
 # Mark an event as finished
 sub _mark_finished {
-    my ( $c, $event ) = @_;
+    my ( $c, $event, $output ) = @_;
 
-    $c->_event_state->{ $event->{event} } = 0;
+    $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();
 }
 
@@ -313,7 +397,9 @@ sub _prepare_cron {
         thu => 4,
         fri => 5,
         sat => 6,
-
+    );
+    
+    my %replace_at = (
         'yearly'   => '0 0 1 1 *',
         'annually' => '0 0 1 1 *',
         'monthly'  => '0 0 1 * *',
@@ -322,20 +408,17 @@ sub _prepare_cron {
         'midnight' => '0 0 * * *',
         'hourly'   => '0 * * * *',
     );
+    
+    if ( $cron =~ /^\@/ ) {
+        $cron =~ s/^\@//;
+        return $replace_at{ $cron };
+    }
 
     for my $name ( keys %replace ) {
         my $value = $replace{$name};
-
-        if ( $cron =~ /^\@$name/ ) {
-            $cron = $value;
-            last;
-        }
-        else {
-            $cron =~ s/$name/$value/i;
-            last unless $cron =~ /\w/;
-        }
+        $cron =~ s/$name/$value/i;
+        last unless $cron =~ /\w/;
     }
-
     return $cron;
 }
 
@@ -605,6 +688,59 @@ 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