--- /dev/null
+package Catalyst::Plugin::Scheduler::Base;
+
+use Data::Dumper;
+use DateTime;
+use DateTime::Event::Cron;
+use DateTime::TimeZone;
+use File::stat;
+use Set::Scalar;
+use base qw/Catalyst::Plugin::Scheduler/;
+use Catalyst::Plugin::Scheduler::Event;
+
+__PACKAGE__->mk_classdata(_events => []);
+__PACKAGE__->mk_classdata(_event_class => 'Catalyst::Plugin::Scheduler::Event');
+__PACKAGE__->mk_classdata('_app' );
+
+=head1 NAME
+
+Catalyst::Plugin::Scheduler::Base - Base class for the Catalyst Scheduler
+
+=head1 SYNOPSIS
+
+ MyApp->scheduler->schedule( at => '0 0 * * *', event => '/cron/ping' );
+
+ ### return all scheduled events as ::Event objects
+ @events = MyApp->scheduler->list_events;
+
+ ### return all pending scheduled events as ::Event objects
+ @pending = MyApp->scheduler->list_pending_events;
+
+ ### a dump of the current scheduler state
+ $aref = MyApp->scheduler->state;
+
+=head1 METHODS
+
+=head2 $bool = MyApp->scheduler->schedule
+
+Allows you to schedule events. For full usage and documentation, consult
+the C<Catalyst::Plugin::Scheduler> documentation on method C<schedule>.
+
+=cut
+
+sub schedule {
+ my $self = shift;
+ my $c = $self->_app;
+ my %args = @_;
+
+ ### XXX more input checks?
+
+ unless ( $args{event} ) {
+ Catalyst::Exception->throw(
+ message => 'The schedule method requires an event parameter' );
+ }
+
+ ### default to '1'
+ $args{'auto_run'} = 1 unless defined $args{'auto_run'};
+
+ if ( $args{at} ) {
+
+ # replace keywords that Set::Crontab doesn't support
+ $args{at} = $self->_prepare_cron( $args{at} );
+
+ # parse the cron entry into a DateTime::Set
+ $args{set} = eval { DateTime::Event::Cron->from_cron( $args{at} ) };
+
+ Catalyst::Exception->throw(
+ "Scheduler: Unable to parse 'at' value $args{at}: $@"
+ ) if $@;
+
+ }
+
+ my $who = $self->_caller_string;
+ push @{ $self->_events },
+ Catalyst::Plugin::Scheduler::Event->new( scheduled_by => $who, %args );
+
+ return 1;
+}
+
+### create a caller string like: "package (file.pm:#line)"
+sub _caller_string { return sprintf "%s (%s:%s)", @{[caller(1)]}[0,1,2]; }
+
+=head2 @events = $c->scheduler->list_events;
+
+Returns an array of C<Catalyst::Plugin::Scheduler::Event> objects,
+representing all the scheduled events in this application.
+
+See the C<Catalyst::Plugin::Scheduler::Event> documentation on how to use
+these objects.
+
+=cut
+
+sub list_events {
+ my $self = shift;
+ return @{ $self->_events || [] };
+};
+
+=head2 @events = $c->scheduler->list_events;
+
+Returns an array of C<Catalyst::Plugin::Scheduler::Event> objects,
+representing all the pending events in this application. They are the
+events that are due according to your cron specification, and will be run
+at the next dispatch, or can be run by you explicitly.
+
+See the C<Catalyst::Plugin::Scheduler::Event> documentation on how to use
+these objects.
+
+=cut
+
+sub list_pending_events {
+ my $self = shift;
+ my $c = $self->_app;
+ my $tz = $self->_config('time_zone');
+
+ ### there are no events scheduled?
+ my @events = $self->list_events or return;
+ my $now = DateTime->now( time_zone => $tz );
+
+ ### list of pending events
+ my @pending;
+
+ ### XXX need NEXT RUN TIME??
+ EVENT:
+ for my $event (@events) {
+
+ ### this event is not active, so skip it
+ next EVENT unless $event->active;
+
+ ### the proper trigger is being called
+ if( $event->trigger && $c->req->params->{schedule_trigger} &&
+ $event->trigger eq $c->req->params->{schedule_trigger}
+ ) {
+
+ ### if you're not authorized to call the trigger, skip it
+ next EVENT unless $self->_event_authorized;
+
+ push @pending, $event;
+ next EVENT;
+ }
+
+ ### we're due according to our cron-entry...
+ if( $event->set ) {
+ ### is the next run time now, or even before now?
+ push @pending, $event if $event->next_run_as_dt <= $now;
+ }
+ }
+
+ ### sort them by priority
+ return sort { $a->priority <=> $b->priority } @pending;
+}
+
+
+
+sub _run_events {
+ my $self = shift;
+ my $c = $self->_app;
+ my %args = @_;
+
+ $self->_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 - $self->_last_check_time < $self->_config('check_every') ) {
+ return unless $c->req->params->{schedule_trigger};
+ }
+
+ my @events = $self->list_pending_events;
+
+ ### update the 'checked' time and save the state, so no more
+ ### processes are going to be running these events
+ ### the small race condition between the 'list_pending_events' call
+ ### and the updating of the check time is resolved by checking if a
+ ### job is running before executing it, so at worst, we have several
+ ### processes sharing the load of this cron run. --kane
+ $self->_last_check_time( time );
+
+ EVENT:
+ for my $event ( @events ) {
+
+ # do some security checking for non-auto-run events
+ ### XXX move this to $event->run? --kane
+ if ( !$event->auto_run ) {
+ next EVENT unless $self->_event_authorized;
+ }
+
+ $event->run;
+ }
+}
+
+=head2 $aref = MyApp->scheduler->state
+
+A dump of the current state of the scheudler. For full usage and
+documentation, consult the C<Catalyst::Plugin::Scheduler> documentation on
+method C<scheduler+state>.
+
+=cut
+
+sub state {
+ my $self = shift;
+ my $c = $self->_app;
+
+ my $event_dump = [];
+ for my $event ( $self->list_events ) {
+ my $dump = {};
+ for my $key ( qw/at trigger event auto_run/ ) {
+ $dump->{$key} = $event->$key if $event->$key;
+ }
+
+ # display the next run time
+ $dump->{next_run} = $event->next_run_as_string;
+
+ # display the last run time
+ $dump->{last_run} = $event->last_run_as_string;
+
+ # display the result of the last run
+ my $output = $event->output;
+ if ( $output ) {
+ $dump->{last_output} = $output;
+ }
+
+ push @{$event_dump}, $dump;
+ }
+
+ return $event_dump;
+}
+
+sub _config {
+ my $self = shift;
+ my $key = shift;
+ my $c = $self->_app;
+ my $conf = $c->config->{scheduler};
+ my $rv = $key ? $conf->{$key} : $conf;
+
+ return $rv;
+}
+
+### shorthand form
+sub _last_check_time {
+ my $self = shift;
+ return $self->_event_class->_last_check_time( @_ );
+}
+
+# check and reload the YAML file with schedule data
+sub _check_yaml {
+ my $self = shift;
+ my $c = $self->_app;
+
+ $self->_event_class->_get_event_state();
+
+ # each process needs to load the YAML file independently
+ if ( $self->_event_class->_event_state->{yaml_mtime}->{$$} ||= 0 ) {
+ return if ( time - $self->_last_check_time < 60 );
+ }
+
+ my $file = $self->_config('yaml_file');
+ return unless -e $file;
+
+ eval {
+ my $mtime = ( stat $file )->mtime;
+ if ( $mtime > $self->_event_class->_event_state->{yaml_mtime}->{$$} ) {
+ $self->_event_class->_event_state->{yaml_mtime}->{$$} = $mtime;
+
+ # clean up old PIDs listed in yaml_mtime
+ for my $pid (
+ keys %{ $self->_event_class->_event_state->{yaml_mtime} }
+ ) {
+ delete $self->_event_class->_event_state->{yaml_mtime}->{$pid}
+ if $self->_event_class->_event_state->{yaml_mtime}->{$pid}
+ < $mtime
+ }
+ $self->_event_class->_save_event_state();
+
+ # wipe out all current events and reload from YAML
+ $self->_events( [] );
+
+ 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} ) {
+ $self->schedule( %{$event} );
+ }
+
+ $c->log->info( "Scheduler: PID $$ loaded "
+ . scalar @{$yaml}
+ . ' events from YAML file' )
+ if $self->_config('logging');
+ }
+ };
+
+ $c->log->error("Scheduler: Error reading YAML file: $@") if $@;
+}
+
+# Detect the current time zone
+sub _detect_timezone {
+ my $self = shift;
+ my $c = $self->_app;
+
+ my $tz;
+ eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
+ if ($@) {
+ $c->log->warn(
+ 'Scheduler: Unable to autodetect local time zone, using UTC')
+ if $self->_config('logging');
+ return 'UTC';
+ }
+ else {
+ $c->log->debug(
+ 'Scheduler: Using autodetected time zone: ' . $tz->name )
+ if $self->_config('logging');
+ return $tz->name;
+ }
+}
+
+# Check for authorized users on non-auto events
+sub _event_authorized {
+ my $self = shift;
+ my $c = $self->_app;
+
+ # this should never happen, but just in case...
+ return unless $c->req->address;
+
+ my $hosts_allow = $self->_config('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 );
+}
+
+# Set::Crontab does not support day names, or '@' shortcuts
+{ 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 * * * *',
+ 'always' => '* * * * *',
+ );
+
+ sub _prepare_cron {
+ my $self = shift;
+ my $c = $self->_app;
+ my $cron = shift;
+
+ return $cron unless $cron =~ /\w/;
+
+ 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__
+
+=head1 SEE ALSO
+
+C<Catalyst::Plugin::Scheduler>, C<Catalyst::Plugin::Scheduler::Event>,
+
+=cut
+
projects / catagits/Catalyst-Plugin-Scheduler.git / blobdiff