+++ /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_pending_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 )->epoch;
-
- ### 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 <= $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