#!/usr/bin/perl
my
$now
;
my
%links
= (
map
({
$_
=>
$_
}
qw(today yesterday tomorrow)
),
);
sub
main {
my
(
@args
) =
@_
;
my
$name
= File::Basename::basename($0);
if
(
my
$link
=
$links
{
$name
}) {
unshift
(
@args
,
$link
);
}
print_date(
@args
);
}
sub
print_date {
print
join
(
"\n"
, string_dates(
@_
)),
"\n"
;
}
sub
string_dates {
my
(
@args
) =
@_
;
my
$spec
;
if
(
$args
[0] eq
'-s'
) {
$spec
=
shift
(
@args
);
}
$now
= today;
my
@dates
= make_date(
$now
,
@args
);
if
(
$spec
and
$#dates
) {
@dates
= (
$dates
[0],
'thru'
,
$dates
[-1]);
}
return
(
@dates
);
}
sub
make_date {
my
(
$date
,
@args
) =
@_
;
@args
or
return
(
$date
);
my
%dispatch
= (
'today'
=>
sub
{
$date
},
'tomorrow'
=>
sub
{
$date
+ 1
*days
},
'yesterday'
=>
sub
{
$date
- 1
*days
},
'last'
=>
sub
{next_last(
'last'
,
@_
)},
'this'
=>
sub
{next_last(
'this'
,
@_
)},
'next'
=>
sub
{next_last(
'next'
,
@_
)},
'from'
=>
sub
{
shift
(
@_
); from(
$date
,
@_
)},
);
my
$cmd
=
shift
(
@args
);
if
(
$cmd
=~ m/^\d+$/) {
my
$lookup
=
join
(
"_"
,
@args
);
if
(
my
$sub
= I->can(
$lookup
)) {
return
(
$sub
->(
$cmd
));
}
else
{
die
"don't know what to do with '$cmd @args'"
;
}
}
if
(
$dispatch
{
$cmd
}) {
return
(
$dispatch
{
$cmd
}->(
$date
,
@args
));
}
die
"the rest is unfinished"
}
sub
days_ago {
my
(
$number
) =
@_
;
return
(
$now
-
$number
*days
);
}
sub
next_last {
my
(
$dir
,
$date
,
@args
) =
@_
;
my
$cmd
=
shift
(
@args
);
my
%dirmap
= (
'this'
=> 0,
'next'
=> 1,
'last'
=> -1);
my
%dispatch
= (
iso_week
=>
sub
{
my
(
$date
,
$count
) =
@_
;
$count
||= 1;
$date
+=
$dirmap
{
$dir
}
*$count
*weeks
;
my
$diff
= 1 -
$date
->iso_dow;
$date
+=
$diff
*days
;
my
@days
=
map
({
$date
+
$_
*days
} 0..6);
@days
=
grep
({
$_
<=
$now
}
@days
)
if
(
$dir
eq
'this'
);
return
(
@days
);
},
'week'
=>
sub
{
my
(
$date
,
$count
) =
@_
;
$count
||= 1;
$date
+=
$dirmap
{
$dir
}
*$count
*weeks
;
my
$diff
= 1 -
$date
->day_of_week;
$date
+=
$diff
*days
;
my
@days
=
map
({
$date
+
$_
*days
} 0..6);
@days
=
grep
({
$_
<=
$now
}
@days
)
if
(
$dir
eq
'this'
);
return
(
@days
);
},
'work'
=>
sub
{
my
(
$date
,
$count
) =
@_
;
$count
||= 1;
$date
+=
$dirmap
{
$dir
}
*$count
*weeks
;
my
$base
= -2;
my
$dow
=
$date
->day_of_week;
my
$diff
= 1 +
$base
-
$dow
;
$diff
+= 7
unless
(
$diff
> -7);
$date
+=
$diff
*days
;
my
@days
=
map
({
$date
+
$_
*days
} 0..6);
@days
=
grep
({
$_
<=
$now
}
@days
)
if
(
$dir
eq
'this'
);
return
(
@days
);
},
month
=>
sub
{
my
(
$date
,
$count
) =
@_
;
$count
||= 1;
my
$start
=
$date
+
$dirmap
{
$dir
}
*$count
*months
;
$start
=
$start
->start_of_month;
my
$end
=
$start
->end_of_month;
return
(
$start
->thru(
$end
));
},
);
my
@dow
=
qw(mo tu we th fr sa su)
;
if
(
$dispatch
{
$cmd
}) {
return
(
$dispatch
{
$cmd
}->(
$date
,
@args
));
}
elsif
(
my
(
$dow
) =
grep
({
$cmd
=~ m/^
$dow
[
$_
-1]/i} 1..
@dow
)) {
my
$ndow
=
$now
->day_of_week;
if
(
$dir
eq
'this'
) {
}
else
{
$dow
+= 7 *
$dirmap
{
$dir
}
if
(
$ndow
<=
$dow
);
return
(
$date
- (
$ndow
-
$dow
)
*days
);
}
}
die
"the rest is unfinished"
}
sub
from {
my
(
$now
,
$from
,
@opt
) =
@_
;
my
%args
;
if
(
@opt
) {
unless
(
@opt
% 2) {
%args
=
@opt
;
}
else
{
(
@opt
== 1) or croak(
"odd number of arguments"
);
$args
{to} =
shift
(
@opt
);
}
}
else
{
$args
{to} =
$now
;
}
return
sort
(date(
$from
)->thru(
$args
{to}));
}
if
($0 eq __FILE__) {
bin::day::main(
@ARGV
);
}
my
$package
=
'bin::day'
;