Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 257207bd

Von Moritz Bunkus vor mehr als 5 Jahren hinzugefügt

  • ID 257207bd5622fd2f5dc8d83334e6be2e8c33f370
  • Vorgänger f9e8a51e
  • Nachfolger d17039f0

Module: Fallback-Version von DateTime::Event::Cron entfernt

Ist in Debian/Ubuntu inzwischen paketiert.

Unterschiede anzeigen:

modules/fallback/DateTime/Event/Cron.pm
1
package DateTime::Event::Cron;
2

  
3
use 5.006;
4
use strict;
5
use warnings;
6
use Carp;
7

  
8
use vars qw($VERSION);
9

  
10
$VERSION = '0.08';
11

  
12
use constant DEBUG => 0;
13

  
14
use DateTime;
15
use DateTime::Set;
16
use Set::Crontab;
17

  
18
my %Object_Attributes;
19

  
20
###
21

  
22
sub from_cron {
23
  # Return cron as DateTime::Set
24
  my $class = shift;
25
  my %sparms = @_ == 1 ? (cron => shift) : @_;
26
  my %parms;
27
  $parms{cron}      = delete $sparms{cron};
28
  $parms{user_mode} = delete $sparms{user_mode};
29
  $parms{cron} or croak "Cron string parameter required.\n";
30
  my $dtc = $class->new(%parms);
31
  $dtc->as_set(%sparms);
32
}
33

  
34
sub from_crontab {
35
  # Return list of DateTime::Sets based on entries from
36
  # a crontab file.
37
  my $class = shift;
38
  my %sparms = @_ == 1 ? (file => shift) : @_;
39
  my $file = delete $sparms{file};
40
  delete $sparms{cron};
41
  my $fh = $class->_prepare_fh($file);
42
  my @cronsets;
43
  while (<$fh>) {
44
    chomp;
45
    my $set;
46
    eval { $set = $class->from_cron(%sparms, cron => $_) };
47
    push(@cronsets, $set) if ref $set && !$@;
48
  }
49
  @cronsets;
50
}
51

  
52
sub as_set {
53
  # Return self as DateTime::Set
54
  my $self = shift;
55
  my %sparms = @_;
56
  Carp::cluck "Recurrence callbacks overriden by ". ref $self . "\n"
57
    if $sparms{next} || $sparms{recurrence} || $sparms{previous};
58
  delete $sparms{next};
59
  delete $sparms{previous};
60
  delete $sparms{recurrence};
61
  $sparms{next}     = sub { $self->next(@_) };
62
  $sparms{previous} = sub { $self->previous(@_) };
63
  DateTime::Set->from_recurrence(%sparms);
64
}
65

  
66
###
67

  
68
sub new {
69
  my $class = shift;
70
  my $self = {};
71
  bless $self, $class;
72
  my %parms = @_ == 1 ? (cron => shift) : @_;
73
  my $crontab = $self->_make_cronset(%parms);
74
  $self->_cronset($crontab);
75
  $self;
76
}
77

  
78
sub new_from_cron { new(@_) }
79

  
80
sub new_from_crontab {
81
  my $class = shift;
82
  my %parms = @_ == 1 ? (file => shift()) : @_;
83
  my $fh = $class->_prepare_fh($parms{file});
84
  delete $parms{file};
85
  my @dtcrons;
86
  while (<$fh>) {
87
    my $dtc;
88
    eval { $dtc = $class->new(%parms, cron => $_) };
89
    if (ref $dtc && !$@) {
90
      push(@dtcrons, $dtc);
91
      $parms{user_mode} = 1 if defined $dtc->user;
92
    }
93
  }
94
  @dtcrons;
95
}
96

  
97
###
98

  
99
sub _prepare_fh {
100
  my $class = shift;
101
  my $fh = shift;
102
  if (! ref $fh) {
103
    my $file = $fh;
104
    local(*FH);
105
    $fh = do { local *FH; *FH }; # doubled *FH avoids warning
106
    open($fh, "<$file")
107
      or croak "Error opening $file for reading\n";
108
  }
109
  $fh;
110
}
111

  
112
###
113

  
114
sub valid {
115
  # Is the given date valid according the current cron settings?
116
  my($self, $date) = @_;
117
  return if !$date || $date->second;
118
  $self->minute->contains($date->minute)      &&
119
  $self->hour->contains($date->hour)          &&
120
  $self->days_contain($date->day, $date->dow) &&
121
  $self->month->contains($date->month);
122
}
123

  
124
sub match {
125
  # Does the given date match the cron spec?
126
  my($self, $date) = @_;
127
  $date = DateTime->now unless $date;
128
  $self->minute->contains($date->minute)      &&
129
  $self->hour->contains($date->hour)          &&
130
  $self->days_contain($date->day, $date->dow) &&
131
  $self->month->contains($date->month);
132
}
133

  
134
### Return adjacent dates without altering original date
135

  
136
sub next {
137
  my($self, $date) = @_;
138
  $date = DateTime->now unless $date;
139
  $self->increment($date->clone);
140
}
141

  
142
sub previous {
143
  my($self, $date) = @_;
144
  $date = DateTime->now unless $date;
145
  $self->decrement($date->clone);
146
}
147

  
148
### Change given date to adjacent dates
149

  
150
sub increment {
151
  my($self, $date) = @_;
152
  $date = DateTime->now unless $date;
153
  return $date if $date->is_infinite;
154
  do {
155
    $self->_attempt_increment($date);
156
  } until $self->valid($date);
157
  $date;
158
}
159

  
160
sub decrement {
161
  my($self, $date) = @_;
162
  $date = DateTime->now unless $date;
163
  return $date if $date->is_infinite;
164
  do {
165
    $self->_attempt_decrement($date);
166
  } until $self->valid($date);
167
  $date;
168
}
169

  
170
###
171

  
172
sub _attempt_increment {
173
  my($self, $date) = @_;
174
  ref $date or croak "Reference to datetime object reqired\n";
175
  $self->valid($date) ?
176
    $self->_valid_incr($date) :
177
    $self->_invalid_incr($date);
178
}
179

  
180
sub _attempt_decrement {
181
  my($self, $date) = @_;
182
  ref $date or croak "Reference to datetime object reqired\n";
183
  $self->valid($date) ?
184
    $self->_valid_decr($date) :
185
    $self->_invalid_decr($date);
186
}
187

  
188
sub _valid_incr { shift->_minute_incr(@_) }
189

  
190
sub _valid_decr { shift->_minute_decr(@_) }
191

  
192
sub _invalid_incr {
193
  # If provided date is valid, return it. Otherwise return
194
  # nearest valid date after provided date.
195
  my($self, $date) = @_;
196
  ref $date or croak "Reference to datetime object reqired\n";
197

  
198
  print STDERR "\nI GOT: ", $date->datetime, "\n" if DEBUG;
199

  
200
  $date->truncate(to => 'minute')->add(minutes => 1)
201
    if $date->second;
202

  
203
  print STDERR "RND: ", $date->datetime, "\n" if DEBUG;
204

  
205
  # Find our greatest invalid unit and clip
206
  if (!$self->month->contains($date->month)) {
207
    $date->truncate(to => 'month');
208
  }
209
  elsif (!$self->days_contain($date->day, $date->dow)) {
210
    $date->truncate(to => 'day');
211
  }
212
  elsif (!$self->hour->contains($date->hour)) {
213
    $date->truncate(to => 'hour');
214
  }
215
  else {
216
    $date->truncate(to => 'minute');
217
  }
218

  
219
  print STDERR "BBT: ", $date->datetime, "\n" if DEBUG;
220

  
221
  return $date if $self->valid($date);
222

  
223
  print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG;
224

  
225
  # Extraneous durations clipped. Start searching.
226
  while (!$self->valid($date)) {
227
    $date->add(months => 1) until $self->month->contains($date->month);
228
    print STDERR "MON: ", $date->datetime, "\n" if DEBUG;
229

  
230
    my $day_orig = $date->day;
231
    $date->add(days => 1) until $self->days_contain($date->day, $date->dow);
232
    $date->truncate(to => 'month') && next if $date->day < $day_orig;
233
    print STDERR "DAY: ", $date->datetime, "\n" if DEBUG;
234

  
235
    my $hour_orig = $date->hour;
236
    $date->add(hours => 1) until $self->hour->contains($date->hour);
237
    $date->truncate(to => 'day') && next if $date->hour < $hour_orig;
238
    print STDERR "HOR: ", $date->datetime, "\n" if DEBUG;
239

  
240
    my $min_orig = $date->minute;
241
    $date->add(minutes => 1) until $self->minute->contains($date->minute);
242
    $date->truncate(to => 'hour') && next if $date->minute < $min_orig;
243
    print STDERR "MIN: ", $date->datetime, "\n" if DEBUG;
244
  }
245
  print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
246
  $date;
247
}
248

  
249
sub _invalid_decr {
250
  # If provided date is valid, return it. Otherwise
251
  # return the nearest previous valid date.
252
  my($self, $date) = @_;
253
  ref $date or croak "Reference to datetime object reqired\n";
254

  
255
  print STDERR "\nD GOT: ", $date->datetime, "\n" if DEBUG;
256

  
257
  if (!$self->month->contains($date->month)) {
258
    $date->truncate(to => 'month');
259
  }
260
  elsif (!$self->days_contain($date->day, $date->dow)) {
261
    $date->truncate(to => 'day');
262
  }
263
  elsif (!$self->hour->contains($date->hour)) {
264
    $date->truncate(to => 'hour');
265
  }
266
  else {
267
    $date->truncate(to => 'minute');
268
  }
269

  
270
  print STDERR "BBT: ", $date->datetime, "\n" if DEBUG;
271

  
272
  return $date if $self->valid($date);
273

  
274
  print STDERR "ZZT: ", $date->datetime, "\n" if DEBUG;
275

  
276
  # Extraneous durations clipped. Start searching.
277
  while (!$self->valid($date)) {
278
    if (!$self->month->contains($date->month)) {
279
      $date->subtract(months => 1) until $self->month->contains($date->month);
280
      $self->_unit_peak($date, 'month');
281
      print STDERR "MON: ", $date->datetime, "\n" if DEBUG;
282
    }
283
    if (!$self->days_contain($date->day, $date->dow)) {
284
      my $day_orig = $date->day;
285
      $date->subtract(days => 1)
286
        until $self->days_contain($date->day, $date->dow);
287
      $self->_unit_peak($date, 'month') && next if ($date->day > $day_orig);
288
      $self->_unit_peak($date, 'day');
289
      print STDERR "DAY: ", $date->datetime, "\n" if DEBUG;
290
    }
291
    if (!$self->hour->contains($date->hour)) {
292
      my $hour_orig = $date->hour;
293
      $date->subtract(hours => 1) until $self->hour->contains($date->hour);
294
      $self->_unit_peak($date, 'day') && next if ($date->hour > $hour_orig);
295
      $self->_unit_peak($date, 'hour');
296
      print STDERR "HOR: ", $date->datetime, "\n" if DEBUG;
297
    }
298
    if (!$self->minute->contains($date->minute)) {
299
      my $min_orig = $date->minute;
300
      $date->subtract(minutes => 1)
301
        until $self->minute->contains($date->minute);
302
      $self->_unit_peak($date, 'hour') && next if ($date->minute > $min_orig);
303
      print STDERR "MIN: ", $date->datetime, "\n" if DEBUG;
304
    }
305
  }
306
  print STDERR "SET: ", $date->datetime, "\n" if DEBUG;
307
  $date;
308
}
309

  
310
###
311

  
312
sub _unit_peak {
313
  my($self, $date, $unit) = @_;
314
  $date && $unit or croak "DateTime ref and unit required.\n";
315
  $date->truncate(to => $unit)
316
       ->add($unit . 's' => 1)
317
       ->subtract(minutes => 1);
318
}
319

  
320
### Unit cascades
321

  
322
sub _minute_incr {
323
  my($self, $date) = @_;
324
  croak "datetime object required\n" unless $date;
325
  my $cur = $date->minute;
326
  my $next = $self->minute->next($cur);
327
  $date->set(minute => $next);
328
  $next <= $cur ? $self->_hour_incr($date) : $date;
329
}
330

  
331
sub _hour_incr {
332
  my($self, $date) = @_;
333
  croak "datetime object required\n" unless $date;
334
  my $cur = $date->hour;
335
  my $next = $self->hour->next($cur);
336
  $date->set(hour => $next);
337
  $next <= $cur ? $self->_day_incr($date) : $date;
338
}
339

  
340
sub _day_incr {
341
  my($self, $date) = @_;
342
  croak "datetime object required\n" unless $date;
343
  $date->add(days => 1);
344
  $self->_invalid_incr($date);
345
}
346

  
347
sub _minute_decr {
348
  my($self, $date) = @_;
349
  croak "datetime object required\n" unless $date;
350
  my $cur = $date->minute;
351
  my $next = $self->minute->previous($cur);
352
  $date->set(minute => $next);
353
  $next >= $cur ? $self->_hour_decr($date) : $date;
354
}
355

  
356
sub _hour_decr {
357
  my($self, $date) = @_;
358
  croak "datetime object required\n" unless $date;
359
  my $cur = $date->hour;
360
  my $next = $self->hour->previous($cur);
361
  $date->set(hour => $next);
362
  $next >= $cur ? $self->_day_decr($date) : $date;
363
}
364

  
365
sub _day_decr {
366
  my($self, $date) = @_;
367
  croak "datetime object required\n" unless $date;
368
  $date->subtract(days => 1);
369
  $self->_invalid_decr($date);
370
}
371

  
372
### Factories
373

  
374
sub _make_cronset { shift; DateTime::Event::Cron::IntegratedSet->new(@_) }
375

  
376
### Shortcuts
377

  
378
sub days_contain { shift->_cronset->days_contain(@_) }
379

  
380
sub minute   { shift->_cronset->minute  }
381
sub hour     { shift->_cronset->hour    }
382
sub day      { shift->_cronset->day     }
383
sub month    { shift->_cronset->month   }
384
sub dow      { shift->_cronset->dow     }
385
sub user     { shift->_cronset->user    }
386
sub command  { shift->_cronset->command }
387
sub original { shift->_cronset->original }
388

  
389
### Static acessors/mutators
390

  
391
sub _cronset { shift->_attr('cronset', @_) }
392

  
393
sub _attr {
394
  my $self = shift;
395
  my $name = shift;
396
  if (@_) {
397
    $Object_Attributes{$self}{$name} = shift;
398
  }
399
  $Object_Attributes{$self}{$name};
400
}
401

  
402
### debugging
403

  
404
sub _dump_sets {
405
  my($self, $date) = @_;
406
  foreach (qw(minute hour day month dow)) {
407
    print STDERR "$_: ", join(',',$self->$_->list), "\n";
408
  }
409
  if (ref $date) {
410
    $date = $date->clone;
411
    my @mod;
412
    my $mon = $date->month;
413
    $date->truncate(to => 'month');
414
    while ($date->month == $mon) {
415
      push(@mod, $date->day) if $self->days_contain($date->day, $date->dow);
416
      $date->add(days => 1);
417
    }
418
    print STDERR "mod for month($mon): ", join(',', @mod), "\n";
419
  }
420
  print STDERR "day_squelch: ", $self->_cronset->day_squelch, " ",
421
               "dow_squelch: ", $self->_cronset->dow_squelch, "\n";
422
  $self;
423
}
424

  
425
###
426

  
427
sub DESTROY { delete $Object_Attributes{shift()} }
428

  
429
##########
430

  
431
{
432

  
433
package DateTime::Event::Cron::IntegratedSet;
434

  
435
# IntegratedSet manages the collection of field sets for
436
# each cron entry, including sanity checks. Individual
437
# field sets are accessed through their respective names,
438
# i.e., minute hour day month dow.
439
#
440
# Also implements some merged field logic for day/dow
441
# interactions.
442

  
443
use strict;
444
use Carp;
445

  
446
my %Range = (
447
  minute => [0..59],
448
  hour   => [0..23],
449
  day    => [1..31],
450
  month  => [1..12],
451
  dow    => [1..7],
452
);
453

  
454
my @Month_Max = qw( 31 29 31 30 31 30 31 31 30 31 30 31 );
455

  
456
my %Object_Attributes;
457

  
458
sub new {
459
  my $self = [];
460
  bless $self, shift;
461
  $self->_range(\%Range);
462
  $self->set_cron(@_);
463
  $self;
464
}
465

  
466
sub set_cron {
467
  # Initialize
468
  my $self = shift;
469
  my %parms = @_;
470
  my $cron = $parms{cron};
471
  my $user_mode = $parms{user_mode};
472
  defined $cron or croak "Cron entry fields required\n";
473
  $self->_attr('original', $cron);
474
  my @line;
475
  if (ref $cron) {
476
    @line = grep(!/^\s*$/, @$cron);
477
  }
478
  else {
479
    $cron =~ s/^\s+//;
480
    $cron =~ s/\s+$//;
481
    @line = split(/\s+/, $cron);
482
  }
483
  @line >= 5 or croak "At least five cron entry fields required.\n";
484
  my @entry = splice(@line, 0, 5);
485
  my($user, $command);
486
  unless (defined $user_mode) {
487
    # auto-detect
488
    if (@line > 1 && $line[0] =~ /^\w+$/) {
489
      $user_mode = 1;
490
    }
491
  }
492
  $user = shift @line if $user_mode;
493
  $command = join(' ', @line);
494
  $self->_attr('command', $command);
495
  $self->_attr('user', $user);
496
  my $i = 0;
497
  foreach my $name (qw( minute hour day month dow )) {
498
    $self->_attr($name, $self->make_valid_set($name, $entry[$i]));
499
    ++$i;
500
  }
501
  my @day_list  = $self->day->list;
502
  my @dow_list  = $self->dow->list;
503
  my $day_range = $self->range('day');
504
  my $dow_range = $self->range('dow');
505
  $self->day_squelch(scalar @day_list == scalar @$day_range &&
506
                     scalar @dow_list != scalar @$dow_range ? 1 : 0);
507
  $self->dow_squelch(scalar @dow_list == scalar @$dow_range &&
508
                     scalar @day_list != scalar @$day_range ? 1 : 0);
509
  unless ($self->day_squelch) {
510
    my @days = $self->day->list;
511
    my $pass = 0;
512
    MONTH: foreach my $month ($self->month->list) {
513
      foreach (@days) {
514
        ++$pass && last MONTH if $_ <= $Month_Max[$month - 1];
515
      }
516
    }
517
    croak "Impossible last day for provided months.\n" unless $pass;
518
  }
519
  $self;
520
}
521

  
522
# Field range queries
523
sub range {
524
  my($self, $name) = @_;
525
  my $val = $self->_range->{$name} or croak "Unknown field '$name'\n";
526
  $val;
527
}
528

  
529
# Perform sanity checks when setting up each field set.
530
sub make_valid_set {
531
  my($self, $name, $str) = @_;
532
  my $range = $self->range($name);
533
  my $set = $self->make_set($str, $range);
534
  my @list = $set->list;
535
  croak "Malformed cron field '$str'\n" unless @list;
536
  croak "Field value ($list[-1]) out of range ($range->[0]-$range->[-1])\n"
537
    if $list[-1] > $range->[-1];
538
  if ($name eq 'dow' && $set->contains(0)) {
539
    shift(@list);
540
    push(@list, 7) unless $set->contains(7);
541
    $set = $self->make_set(join(',',@list), $range);
542
  }
543
  croak "Field value ($list[0]) out of range ($range->[0]-$range->[-1])\n"
544
    if $list[0] < $range->[0];
545
  $set;
546
}
547

  
548
# No sanity checks
549
sub make_set { shift; DateTime::Event::Cron::OrderedSet->new(@_) }
550

  
551
# Flags for when day/dow are applied.
552
sub day_squelch { shift->_attr('day_squelch', @_ ) }
553
sub dow_squelch { shift->_attr('dow_squelch', @_ ) }
554

  
555
# Merged logic for day/dow
556
sub days_contain {
557
  my($self, $day, $dow) = @_;
558
  defined $day && defined $dow
559
    or croak "Day of month and day of week required.\n";
560
  my $day_c = $self->day->contains($day);
561
  my $dow_c = $self->dow->contains($dow);
562
  return $dow_c if $self->day_squelch;
563
  return $day_c if $self->dow_squelch;
564
  $day_c || $dow_c;
565
}
566

  
567
# Set Accessors
568
sub minute   { shift->_attr('minute' ) }
569
sub hour     { shift->_attr('hour'   ) }
570
sub day      { shift->_attr('day'    ) }
571
sub month    { shift->_attr('month'  ) }
572
sub dow      { shift->_attr('dow'    ) }
573
sub user     { shift->_attr('user'   ) }
574
sub command  { shift->_attr('command') }
575
sub original { shift->_attr('original') }
576

  
577
# Accessors/mutators
578
sub _range       { shift->_attr('range', @_) }
579

  
580
sub _attr {
581
  my $self = shift;
582
  my $name = shift;
583
  if (@_) {
584
    $Object_Attributes{$self}{$name} = shift;
585
  }
586
  $Object_Attributes{$self}{$name};
587
}
588

  
589
sub DESTROY { delete $Object_Attributes{shift()} }
590

  
591
}
592

  
593
##########
594

  
595
{
596

  
597
package DateTime::Event::Cron::OrderedSet;
598

  
599
# Extends Set::Crontab with some progression logic (next/prev)
600

  
601
use strict;
602
use Carp;
603
use base 'Set::Crontab';
604

  
605
my %Object_Attributes;
606

  
607
sub new {
608
  my $class = shift;
609
  my($string, $range) = @_;
610
  defined $string && ref $range
611
    or croak "Cron field and range ref required.\n";
612
  my $self = Set::Crontab->new($string, $range);
613
  bless $self, $class;
614
  my @list = $self->list;
615
  my(%next, %prev);
616
  foreach (0 .. $#list) {
617
    $next{$list[$_]} = $list[($_+1)%@list];
618
    $prev{$list[$_]} = $list[($_-1)%@list];
619
  }
620
  $self->_attr('next', \%next);
621
  $self->_attr('previous', \%prev);
622
  $self;
623
}
624

  
625
sub next {
626
  my($self, $entry) = @_;
627
  my $hash = $self->_attr('next');
628
  croak "Missing entry($entry) in set\n" unless exists $hash->{$entry};
629
  my $next = $hash->{$entry};
630
  wantarray ? ($next, $next <= $entry) : $next;
631
}
632

  
633
sub previous {
634
  my($self, $entry) = @_;
635
  my $hash = $self->_attr('previous');
636
  croak "Missing entry($entry) in set\n" unless exists $hash->{$entry};
637
  my $prev = $hash->{$entry};
638
  wantarray ? ($prev, $prev >= $entry) : $prev;
639
}
640

  
641
sub _attr {
642
  my $self = shift;
643
  my $name = shift;
644
  if (@_) {
645
    $Object_Attributes{$self}{$name} = shift;
646
  }
647
  $Object_Attributes{$self}{$name};
648
}
649

  
650
sub DESTROY { delete $Object_Attributes{shift()} }
651

  
652
}
653

  
654
###
655

  
656
1;
657

  
658
__END__
659

  
660
=head1 NAME
661

  
662
DateTime::Event::Cron - DateTime extension for generating recurrence
663
sets from crontab lines and files.
664

  
665
=head1 SYNOPSIS
666

  
667
  use DateTime::Event::Cron;
668

  
669
  # check if a date matches (defaults to current time)
670
  my $c = DateTime::Event::Cron->new('* 2 * * *');
671
  if ($c->match) {
672
    # do stuff
673
  }
674
  if ($c->match($date)) {
675
    # do something else for datetime $date
676
  }
677

  
678
  # DateTime::Set construction from crontab line
679
  $crontab = '*/3 15 1-10 3,4,5 */2';
680
  $set = DateTime::Event::Cron->from_cron($crontab);
681
  $iter = $set->iterator(after => DateTime->now);
682
  while (1) {
683
    my $next = $iter->next;
684
    my $now  = DateTime->now;
685
    sleep(($next->subtract_datetime_absolute($now))->seconds);
686
    # do stuff...
687
  }
688

  
689
  # List of DateTime::Set objects from crontab file
690
  @sets = DateTime::Event::Cron->from_crontab(file => '/etc/crontab');
691
  $now = DateTime->now;
692
  print "Now: ", $now->datetime, "\n";
693
  foreach (@sets) {
694
    my $next = $_->next($now);
695
    print $next->datetime, "\n";
696
  }
697

  
698
  # DateTime::Set parameters
699
  $crontab = '* * * * *';
700

  
701
  $now = DateTime->now;
702
  %set_parms = ( after => $now );
703
  $set = DateTime::Event::Cron->from_cron(cron => $crontab, %set_parms);
704
  $dt = $set->next;
705
  print "Now: ", $now->datetime, " and next: ", $dt->datetime, "\n";
706

  
707
  # Spans for DateTime::Set
708
  $crontab = '* * * * *';
709
  $now = DateTime->now;
710
  $now2 = $now->clone;
711
  $span = DateTime::Span->from_datetimes(
712
            start => $now->add(minutes => 1),
713
	    end   => $now2->add(hours => 1),
714
	  );
715
  %parms = (cron => $crontab, span => $span);
716
  $set = DateTime::Event::Cron->from_cron(%parms);
717
  # ...do things with the DateTime::Set
718

  
719
  # Every RTFCT relative to 12am Jan 1st this year
720
  $crontab = '7-10 6,12-15 10-28/2 */3 3,4,5';
721
  $date = DateTime->now->truncate(to => 'year');
722
  $set = DateTime::Event::Cron->from_cron(cron => $crontab, after => $date);
723

  
724
  # Rather than generating DateTime::Set objects, next/prev
725
  # calculations can be made directly:
726

  
727
  # Every day at 10am, 2pm, and 6pm. Reference date
728
  # defaults to DateTime->now.
729
  $crontab = '10,14,18 * * * *';
730
  $dtc = DateTime::Event::Cron->new_from_cron(cron => $crontab);
731
  $next_datetime = $dtc->next;
732
  $last_datetime = $dtc->previous;
733
  ...
734

  
735
  # List of DateTime::Event::Cron objects from
736
  # crontab file
737
  @dtc = DateTime::Event::Cron->new_from_crontab(file => '/etc/crontab');
738

  
739
  # Full cron lines with user, such as from /etc/crontab
740
  # or files in /etc/cron.d, are supported and auto-detected:
741
  $crontab = '* * * * * gump /bin/date';
742
  $dtc = DateTime::Event::Cron->new(cron => $crontab);
743

  
744
  # Auto-detection of users is disabled if you explicitly
745
  # enable/disable via the user_mode parameter:
746
  $dtc = DateTime::Event::Cron->new(cron => $crontab, user_mode => 1);
747
  my $user = $dtc->user;
748
  my $command = $dtc->command;
749

  
750
  # Unparsed original cron entry
751
  my $original = $dtc->original;
752

  
753
=head1 DESCRIPTION
754

  
755
DateTime::Event::Cron generated DateTime events or DateTime::Set objects
756
based on crontab-style entries.
757

  
758
=head1 METHODS
759

  
760
The cron fields are typical crontab-style entries. For more information,
761
see L<crontab(5)> and extensions described in L<Set::Crontab>. The
762
fields can be passed as a single string or as a reference to an array
763
containing each field. Only the first five fields are retained.
764

  
765
=head2 DateTime::Set Factories
766

  
767
See L<DateTime::Set> for methods provided by Set objects, such as
768
C<next()> and C<previous()>.
769

  
770
=over 4
771

  
772
=item from_cron($cronline)
773

  
774
=item from_cron(cron => $cronline, %parms, %set_parms)
775

  
776
Generates a DateTime::Set recurrence for the cron line provided. See
777
new() for details on %parms. Optionally takes parameters for
778
DateTime::Set.
779

  
780
=item from_crontab(file => $crontab_fh, %parms, %set_parms)
781

  
782
Returns a list of DateTime::Set recurrences based on lines from a
783
crontab file. C<$crontab_fh> can be either a filename or filehandle
784
reference. See new() for details on %parm. Optionally takes parameters
785
for DateTime::Set which will be passed along to each set for each line.
786

  
787
=item as_set(%set_parms)
788

  
789
Generates a DateTime::Set recurrence from an existing
790
DateTime::Event::Cron object.
791

  
792
=back
793

  
794
=head2 Constructors
795

  
796
=over 4
797

  
798
=item new_from_cron(cron => $cronstring, %parms)
799

  
800
Returns a DateTime::Event::Cron object based on the cron specification.
801
Optional parameters include the boolean 'user_mode' which indicates that
802
the crontab entry includes a username column before the command.
803

  
804
=item new_from_crontab(file => $fh, %parms)
805

  
806
Returns a list of DateTime::Event::Cron objects based on the lines of a
807
crontab file. C<$fh> can be either a filename or a filehandle reference.
808
Optional parameters include the boolean 'user_mode' as mentioned above.
809

  
810
=back
811

  
812
=head2 Other methods
813

  
814
=over 4
815

  
816
=item next()
817

  
818
=item next($date)
819

  
820
Returns the next valid datetime according to the cron specification.
821
C<$date> defaults to DateTime->now unless provided.
822

  
823
=item previous()
824

  
825
=item previous($date)
826

  
827
Returns the previous valid datetime according to the cron specification.
828
C<$date> defaults to DateTime->now unless provided.
829

  
830
=item increment($date)
831

  
832
=item decrement($date)
833

  
834
Same as C<next()> and C<previous()> except that the provided datetime is
835
modified to the new datetime.
836

  
837
=item match($date)
838

  
839
Returns whether or not the given datetime (defaults to current time)
840
matches the current cron specification. Dates are truncated to minute
841
resolution.
842

  
843
=item valid($date)
844

  
845
A more strict version of match(). Returns whether the given datetime is
846
valid under the current cron specification. Cron dates are only accurate
847
to the minute -- datetimes with seconds greater than 0 are invalid by
848
default. (note: never fear, all methods accepting dates will accept
849
invalid dates -- they will simply be rounded to the next nearest valid
850
date in all cases except this particular method)
851

  
852
=item command()
853

  
854
Returns the command string, if any, from the original crontab entry.
855
Currently no expansion is performed such as resolving environment
856
variables, etc.
857

  
858
=item user()
859

  
860
Returns the username under which this cron command was to be executed,
861
assuming such a field was present in the original cron entry.
862

  
863
=item original()
864

  
865
Returns the original, unparsed cron string including any user or
866
command fields.
867

  
868
=back
869

  
870
=head1 AUTHOR
871

  
872
Matthew P. Sisk E<lt>sisk@mojotoad.comE<gt>
873

  
874
=head1 COPYRIGHT
875

  
876
Copyright (c) 2003 Matthew P. Sisk. All rights reserved. All wrongs
877
revenged. This program is free software; you can distribute it and/or
878
modify it under the same terms as Perl itself.
879

  
880
=head1 SEE ALSO
881

  
882
DateTime(3), DateTime::Set(3), DateTime::Event::Recurrence(3),
883
DateTime::Event::ICal(3), DateTime::Span(3), Set::Crontab(3), crontab(5)
884

  
885
=cut

Auch abrufbar als: Unified diff