X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FPlugin%2FScheduler%2FBase.pm;fp=lib%2FCatalyst%2FPlugin%2FScheduler%2FBase.pm;h=4a52bdd9a8ed5cd36ac738a95f2d1e6eb8595a54;hb=ba2735b6164f953e9d590a8671aec8799e615327;hp=0000000000000000000000000000000000000000;hpb=4aa6d1df60ed0badf3b74ec4ffc3ce45074c92be;p=catagits%2FCatalyst-Plugin-Scheduler.git diff --git a/lib/Catalyst/Plugin/Scheduler/Base.pm b/lib/Catalyst/Plugin/Scheduler/Base.pm new file mode 100755 index 0000000..4a52bdd --- /dev/null +++ b/lib/Catalyst/Plugin/Scheduler/Base.pm @@ -0,0 +1,404 @@ +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 documentation on method C. + +=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 objects, +representing all the scheduled events in this application. + +See the C 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 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 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 documentation on +method C. + +=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, C, + +=cut +