Scheduler 0.05, fixed bug with @monthly
[catagits/Catalyst-Plugin-Scheduler.git] / lib / Catalyst / Plugin / Scheduler.pm
index 535d761..ab40733 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.05';
 
 __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;
         }
     }
@@ -152,11 +153,52 @@ 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
+
+    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};
+        }
+
+        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;
+        }
+        
+        push @{$event_dump}, $dump;
+    }
+    
+    return ( 
+        $c->NEXT::dump_these(@_),
+        [ 'Scheduled Events', $event_dump ],
+    );
+}        
+
 # check and reload the YAML file with schedule data
 sub _check_yaml {
     my ($c) = @_;
@@ -166,10 +208,10 @@ 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();
@@ -177,8 +219,8 @@ sub _check_yaml {
             # 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} );
             }
@@ -202,7 +244,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 +265,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
@@ -313,7 +353,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 +364,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 +644,32 @@ 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.
+
+=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