view release on metacpan or  search on metacpan

lib/DateTime/Event/Cron.pm  view on Meta::CPAN

package DateTime::Event::Cron;

use 5.006;
use strict;
use warnings;
use Carp;

use vars qw($VERSION);

$VERSION = '0.09';

use constant DEBUG => 0;

use DateTime;
use DateTime::Set;
use DateTime::Duration;
use Set::Crontab;

my %Object_Attributes;

###

sub from_cron {
  # Return cron as DateTime::Set
  my $class = shift;
  my %sparms = @_ == 1 ? (cron => shift) : @_;
  my %parms;
  $parms{cron}      = delete $sparms{cron};
  $parms{user_mode} = delete $sparms{user_mode};
  $parms{cron} or croak "Cron string parameter required.\n";
  my $dtc = $class->new(%parms);
  $dtc->as_set(%sparms);
}

sub from_crontab {
  # Return list of DateTime::Sets based on entries from
  # a crontab file.
  my $class = shift;
  my %sparms = @_ == 1 ? (file => shift) : @_;
  my $file = delete $sparms{file};
  delete $sparms{cron};
  my $fh = $class->_prepare_fh($file);
  my @cronsets;
  while (<$fh>) {
    chomp;
    my $set;
    eval { $set = $class->from_cron(%sparms, cron => $_) };
    push(@cronsets, $set) if ref $set && !$@;
  }
  @cronsets;
}

sub as_set {
  # Return self as DateTime::Set
  my $self = shift;
  my %sparms = @_;
  Carp::cluck "Recurrence callbacks overriden by ". ref $self . "\n"
    if $sparms{next} || $sparms{recurrence} || $sparms{previous};
  delete $sparms{next};
  delete $sparms{previous};
  delete $sparms{recurrence};
  $sparms{next}     = sub { $self->next(@_) };
  $sparms{previous} = sub { $self->previous(@_) };
  DateTime::Set->from_recurrence(%sparms);
}

###

sub new {
  my $class = shift;
  my $self = {};
  bless $self, $class;
  my %parms = @_ == 1 ? (cron => shift) : @_;
  my $crontab = $self->_make_cronset(%parms);
  $self->_cronset($crontab);
  $self;
}

sub new_from_cron { new(@_) }

sub new_from_crontab {
  my $class = shift;
  my %parms = @_ == 1 ? (file => shift()) : @_;
  my $fh = $class->_prepare_fh($parms{file});
  delete $parms{file};
  my @dtcrons;
  while (<$fh>) {
    my $dtc;
    eval { $dtc = $class->new(%parms, cron => $_) };
    if (ref $dtc && !$@) {
      push(@dtcrons, $dtc);
      $parms{user_mode} = 1 if defined $dtc->user;
    }
  }
  @dtcrons;
}

###

sub _prepare_fh {
  my $class = shift;
  my $fh = shift;
  if (! ref $fh) {
    my $file = $fh;
    local(*FH);
    $fh = do { local *FH; *FH }; # doubled *FH avoids warning
    open($fh, "<$file")
      or croak "Error opening $file for reading\n";
  }
  $fh;
}

###

sub valid {
  # Is the given date valid according the current cron settings?
  my($self, $date) = @_;