public
Created

Recurring date calculation (for the Perl 6 advent calendar)

  • Download Gist
01-recurring-dates.pl
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
use v6;
 
grammar DateSpec::Grammar {
rule TOP {
[<count><.quant>?]?
<day-of-week>
[<sign>? <offset=count>]?
}
token count { \d+ }
token quant { st | nd | rd | th }
token day-of-week { :i
[ mon | tue | wed | thu | fri | sat | sun ]
}
token sign { '+' | '-' }
}
 
my %dow = (mon => 1, tue => 2, wed => 3, thu => 4,
fri => 5, sat => 6, sun => 7);
 
class DateSpec {
has $.day-of-week;
has $.count;
has $.offset;
 
multi method new(Str $s) {
my $m = DateSpec::Grammar.parse($s);
die "Invalid date specification '$s'\n" unless $m;
self.bless(
:day-of-week(%dow{lc $m<day-of-week>}),
:count($m<count> ?? +$m<count>[0] !! 1),
:offset( ($m<sign> eq '-' ?? -1 !! 1)
* ($m<offset> ?? +$m<offset> !! 0)),
);
}
method based-on(Date $d is copy where { .day == 1}) {
++$d until $d.day-of-week == $.day-of-week;
$d += 7 * ($.count - 1) + $.offset;
return $d;
}
method next(Date $d = Date.today) {
my $month-start = $d.truncated-to(month);
my $candidate = $.based-on($month-start);
if $candidate ge $d {
return $candidate;
}
else {
return $.based-on($month-start + $month-start.days-in-month);
}
}
}
 
my $spec = DateSpec.new('3rd Tue + 2');
say $spec.next;
say $spec.next(Date.new(2013, 12, 25));
02-recurring-dates-with-actions.pl
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
use v6;
 
class DateSpec { ... };
 
grammar DateSpec::Grammar {
rule TOP {
[<count><.quant>?]?
<day-of-week>
[<sign>? <offset=count>]?
}
token count { \d+ }
token quant { st | nd | rd | th }
token day-of-week { :i
[ mon | tue | wed | thu | fri | sat | sun ]
}
token sign { '+' | '-' }
}
class DateSpec::Actions {
method count($/) { make +$/ }
my %dow = (mon => 1, tue => 2, wed => 3, thu => 4,
fri => 5, sat => 6, sun => 7);
method day-of-week($/) { make %dow{lc $/} }
method sign($/) { make $/ eq '+' ?? 1 !! -1 };
method TOP($/) {
make DateSpec.new(
:day-of-week($<day-of-week>.ast),
:offset( ($<sign>.?ast // 1) * ($<offset>.?ast // 0)),
:count( $<count>[0].?ast),
);
}
}
class DateSpec {
has $.day-of-week;
has $.count;
has $.offset;
 
multi method new(Str $s) {
my $res = DateSpec::Grammar.parse($s,
:actions(DateSpec::Actions),
);
return $res.ast if $res;
die "Invalid date specification '$s'\n";
}
method based-on(Date $d is copy) {
++$d until $d.day-of-week == $.day-of-week;
$d += 7 * ($.count - 1) + $.offset;
return $d;
}
method next(Date $d = Date.today) {
my $month-start = $d.truncated-to(month);
my $candidate = $.based-on($month-start);
if $candidate ge $d {
return $candidate;
}
else {
return $.based-on($month-start + $month-start.days-in-month);
}
}
}
 
my $spec = DateSpec.new('3rd Tue + 2');
say $spec.next;
say $spec.next(Date.new(2013, 12, 24));

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.