App-datecalc
view release on metacpan or search on metacpan
lib/App/datecalc.pm view on Meta::CPAN
package App::datecalc;
use 5.010001;
use strict;
use warnings;
use DateTime;
use DateTime::Format::ISO8601;
use MarpaX::Simple qw(gen_parser);
use Scalar::Util qw(blessed);
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-02-18'; # DATE
our $DIST = 'App-datecalc'; # DIST
our $VERSION = '0.090'; # VERSION
# XXX there should already be an existing module that does this
sub __fmtduriso {
my $dur = shift;
my $res = join(
'',
"P",
($dur->years ? $dur->years . "Y" : ""),
($dur->months ? $dur->months . "M" : ""),
($dur->weeks ? $dur->weeks . "W" : ""),
($dur->days ? $dur->days . "D" : ""),
);
if ($dur->hours || $dur->minutes || $dur->seconds) {
$res .= join(
'',
'T',
($dur->hours ? $dur->hours . "H" : ""),
($dur->minutes ? $dur->minutes . "M" : ""),
($dur->seconds ? $dur->seconds . "S" : ""),
);
}
$res = "P0Y" if $res eq 'P';
$res;
}
sub new {
state $parser = gen_parser(
grammar => <<'_',
:default ::= action=>::first
lexeme default = latm=>1
:start ::= answer
answer ::= date_expr
| dur_expr
# | str_expr
| num_expr
num_expr ::= num_add
num_add ::= num_mult
| num_add op_addsub num_add action=>num_add
num_mult ::= num_unary
| num_mult op_multdiv num_mult action=>num_mult
num_unary ::= num_pow
|| op_unary num_unary action=>num_unary assoc=>right
num_pow ::= num_term
|| num_pow '**' num_pow action=>num_pow assoc=>right
num_term ::= num_literal
| func_inum_onum
| func_idate_onum
| func_idur_onum
| ('(') num_expr (')')
lib/App/datecalc.pm view on Meta::CPAN
idl_month ~ posnum 'M'
idl_month_opt ~ posnum 'M'
idl_month_opt ~
idl_week ~ posnum 'W'
idl_week_opt ~ posnum 'W'
idl_week_opt ~
idl_day ~ posnum 'D'
idl_day_opt ~ posnum 'D'
idl_day_opt ~
idl_hour ~ posnum 'H'
idl_hour_opt ~ posnum 'H'
idl_hour_opt ~
idl_minute ~ posnum 'M'
idl_minute_opt ~ posnum 'M'
idl_minute_opt ~
idl_second ~ posnum 'S'
idl_second_opt ~ posnum 'S'
idl_second_opt ~
# also need at least one element specified like in nat_dur_literal
iso_dur_literal ::= iso_dur_literal0 action=>durlit_iso
iso_dur_literal0 ~ 'P' idl_year idl_month_opt idl_week_opt idl_day_opt
| 'P' idl_year_opt idl_month idl_week_opt idl_day_opt
| 'P' idl_year_opt idl_month_opt idl_week idl_day_opt
| 'P' idl_year_opt idl_month_opt idl_week_opt idl_day
| 'P' idl_year_opt idl_month_opt idl_week_opt idl_day_opt 'T' idl_hour idl_minute_opt idl_second_opt
| 'P' idl_year_opt idl_month_opt idl_week_opt idl_day_opt 'T' idl_hour_opt idl_minute idl_second_opt
| 'P' idl_year_opt idl_month_opt idl_week_opt idl_day_opt 'T' idl_hour_opt idl_minute_opt idl_second
sign ~ [+-]
digits ~ [\d]+
num_literal ~ num
num ~ digits
| sign digits
| digits '.' digits
| sign digits '.' digits
posnum ~ digits
| digits '.' digits
op_unary ~ [+-]
op_addsub ~ [+-]
op_mult ~ [*]
op_multdiv ~ [*/]
:discard ~ ws
ws ~ [\s]+
ws_opt ~ [\s]*
_
actions => {
datelit_iso => sub {
my $h = shift;
my @date = split /-/, $_[0];
DateTime->new(year=>$date[0], month=>$date[1], day=>$date[2]);
},
date_sub_date => sub {
my $h = shift;
$_[0]->delta_days($_[2]);
},
datelit_special => sub {
my $h = shift;
if ($_[0] eq 'now') {
DateTime->now;
} elsif ($_[0] eq 'today') {
DateTime->today;
} elsif ($_[0] eq 'yesterday') {
DateTime->today->subtract(days => 1);
} elsif ($_[0] eq 'tomorrow') {
DateTime->today->add(days => 1);
} else {
die "BUG: Unknown date literal '$_[0]'";
}
},
date_add_dur => sub {
my $h = shift;
if ($_[1] eq '+') {
$_[0] + $_[2];
} else {
$_[0] - $_[2];
}
},
dur_add_dur => sub {
my $h = shift;
$_[0] + $_[2];
},
dur_mult_num => sub {
my $h = shift;
if (ref $_[0]) {
my $d0 = $_[0];
if ($_[1] eq '*') {
# dur*num
DateTime::Duration->new(
years => $d0->years * $_[2],
months => $d0->months * $_[2],
weeks => $d0->weeks * $_[2],
days => $d0->days * $_[2],
hours => $d0->hours * $_[2],
minutes => $d0->minutes * $_[2],
seconds => $d0->seconds * $_[2],
);
} else {
# dur/num
DateTime::Duration->new(
years => $d0->years / $_[2],
months => $d0->months / $_[2],
weeks => $d0->weeks / $_[2],
days => $d0->days / $_[2],
hours => $d0->hours / $_[2],
minutes => $d0->minutes / $_[2],
seconds => $d0->seconds / $_[2],
);
}
} else {
my $d0 = $_[2];
# num * dur
DateTime::Duration->new(
years => $d0->years * $_[0],
months => $d0->months * $_[0],
weeks => $d0->weeks * $_[0],
days => $d0->days * $_[0],
hours => $d0->hours * $_[0],
minutes => $d0->minutes * $_[0],
seconds => $d0->seconds * $_[0],
);
}
},
durlit_nat => sub {
my $h = shift;
local $_ = $_[0];
my %params;
$params{years} = $1 if /(-?\d+(?:\.\d+)?)\s*(years?|y)/;
$params{months} = $1 if /(-?\d+(?:\.\d+)?)\s*(mons?|months?)/;
$params{weeks} = $1 if /(-?\d+(?:\.\d+)?)\s*(weeks?|w)/;
$params{days} = $1 if /(-?\d+(?:\.\d+)?)\s*(days?|d)/;
$params{hours} = $1 if /(-?\d+(?:\.\d+)?)\s*(hours?|h)/;
$params{minutes} = $1 if /(-?\d+(?:\.\d+)?)\s*(mins?|minutes?)/;
$params{seconds} = $1 if /(-?\d+(?:\.\d+)?)\s*(s|secs?|seconds?)/;
DateTime::Duration->new(%params);
},
durlit_iso => sub {
my $h = shift;
# split between date and time
my $d = $_[0] =~ /P(.+?)(?:T|\z)/ ? $1 : '';
my $t = $_[0] =~ /T(.*)/ ? $1 : '';
#say "D = $d, T = $t";
my %params;
$params{years} = $1 if $d =~ /(-?\d+(?:\.\d+)?)Y/i;
$params{months} = $1 if $d =~ /(-?\d+(?:\.\d+)?)M/i;
$params{weeks} = $1 if $d =~ /(-?\d+(?:\.\d+)?)W/;
$params{days} = $1 if $d =~ /(-?\d+(?:\.\d+)?)D/;
$params{hours} = $1 if $t =~ /(-?\d+(?:\.\d+)?)H/i;
$params{minutes} = $1 if $t =~ /(-?\d+(?:\.\d+)?)M/i;
$params{seconds} = $1 if $t =~ /(-?\d+(?:\.\d+)?)S/i;
DateTime::Duration->new(%params);
},
func_inum_onum => sub {
my $h = shift;
my $fn = $_[0];
my $num = $_[1];
if ($fn eq 'abs') {
abs($num);
} elsif ($fn eq 'round') {
sprintf("%.0f", $num);
} else {
die "BUG: Unknown number function $fn";
}
},
func_idate_onum => sub {
my $h = shift;
my $fn = $_[0];
my $d = $_[1];
if ($fn eq 'year') {
$d->year;
} elsif ($fn eq 'month') {
$d->month;
} elsif ($fn eq 'day') {
$d->day;
} elsif ($fn eq 'dow') {
$d->day_of_week;
} elsif ($fn eq 'quarter') {
$d->quarter;
} elsif ($fn eq 'doy') {
$d->day_of_year;
} elsif ($fn eq 'wom') {
$d->week_of_month;
} elsif ($fn eq 'woy') {
$d->week_number;
} elsif ($fn eq 'doq') {
$d->day_of_quarter;
} elsif ($fn eq 'hour') {
$d->hour;
} elsif ($fn eq 'minute') {
$d->minute;
} elsif ($fn eq 'second') {
$d->second;
} else {
die "BUG: Unknown date function $fn";
}
},
func_idur_onum => sub {
my $h = shift;
my $fn = $_[0];
my $dur = $_[1];
if ($fn eq 'years') {
$dur->years;
} elsif ($fn eq 'months') {
$dur->months;
} elsif ($fn eq 'weeks') {
$dur->weeks;
} elsif ($fn eq 'days') {
$dur->days;
} elsif ($fn eq 'totdays') {
$dur->in_units("days");
} elsif ($fn eq 'hours') {
$dur->hours;
} elsif ($fn eq 'minutes') {
$dur->minutes;
} elsif ($fn eq 'seconds') {
$dur->seconds;
} else {
die "BUG: Unknown duration function $fn";
}
},
num_add => sub {
my $h = shift;
if ($_[1] eq '+') {
$_[0] + $_[2];
} else {
$_[0] - $_[2];
}
},
num_mult => sub {
my $h = shift;
if ($_[1] eq '*') {
$_[0] * $_[2];
} else {
$_[0] / $_[2];
}
},
num_unary => sub {
my $h = shift;
my $op = $_[0];
my $num = $_[1];
if ($op eq '+') {
$num;
} else {
# -
-$num;
}
},
num_pow => sub {
my $h = shift;
$_[0] ** $_[2];
},
},
trace_terminals => $ENV{DEBUG},
trace_values => $ENV{DEBUG},
);
bless {parser=>$parser}, shift;
}
sub eval {
my ($self, $str) = @_;
my $res = $self->{parser}->($str);
if (blessed($res) && $res->isa('DateTime::Duration')) {
__fmtduriso($res);
} elsif (blessed($res) && $res->isa('DateTime')) {
$res->ymd . "#".$res->day_abbr;
} else {
"$res";
}
}
1;
# ABSTRACT: Date calculator
__END__
=pod
=encoding UTF-8
=head1 NAME
App::datecalc - Date calculator
=head1 VERSION
This document describes version 0.090 of App::datecalc (from Perl distribution App-datecalc), released on 2023-02-18.
=head1 SYNOPSIS
use App::datecalc;
my $calc = App::datecalc->new;
say $calc->eval('2014-05-13 + 2 days'); # -> 2014-05-15
=head1 DESCRIPTION
B<This is an early release. More features and documentation will follow in
subsequent releases.>
This module provides a date calculator, for doing date-related calculations. You
can write date literals in ISO 8601 format (though not all format variants are
supported), e.g. C<2014-05-13>. Date duration can be specified using the natural
syntax e.g. C<2 days 13 hours> or using the ISO 8601 format e.g. C<P2DT13H>.
Currently supported calculations:
=over
=item * date literals
2014-05-19
now
today
tomorrow
=item * (NOT YET) time and date-time literals
=item * duration literals, either in ISO 8601 format or natural syntax
P3M2D
3 months 2 days
=item * date addition/subtraction with a duration
2014-05-19 - 2 days
lib/App/datecalc.pm view on Meta::CPAN
year(2014-05-20)
quarter(today)
month(today)
day(today)
dow(today)
doy(today)
doq(today)
wom(today)
woy(today)
hour(today)
minute(today)
second(today)
=item * extract elements from duration
years(P22D)
months(P22D)
weeks(P22D)
days(P22D) # 1, because P22D normalizes to P3W1D
totdays(P22D) # 22
days(P1M1D) # 1
totdays(P1M1D) # 1, because months cannot be converted to days
hours(P22D)
minutes(P22D)
seconds(P22D)
=item * some simple number arithmetics
3+4.5
2**3 * P1D
abs(2-5) # 3
round(1.6+3) # 5
=item * (NOT YET) date comparison
today >= 2014-05-20
=item * (NOT YET) duration comparison
P20D < P3W
=back
=head1 METHODS
=head2 new
=head2 eval
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/App-datecalc>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-App-datecalc>.
=head1 SEE ALSO
L<DateTime> and L<DateTime::Format::ISO8601>, the backend modules used to do the
actual date calculation.
L<Marpa::R2> is used to generate the parser.
L<Date::Calc> another date module on CPAN. No relation except the similarity of
name.
L<http://en.wikipedia.org/wiki/ISO_8601> for more information about the ISO 8601
format.
=head1 AUTHOR
perlancar <perlancar@cpan.org>
=head1 CONTRIBUTORS
=for stopwords Jeffrey Kegler Steven Haryanto
=over 4
=item *
Jeffrey Kegler <JKEGL@cpan.org>
=item *
Steven Haryanto <stevenharyanto@gmail.com>
=back
=head1 CONTRIBUTING
To contribute, you can send patches by email/via RT, or send pull requests on
GitHub.
Most of the time, you don't need to build the distribution yourself. You can
simply modify the code, then test via:
% prove -l
If you want to build the distribution (e.g. to try to install it locally on your
system), you can install L<Dist::Zilla>,
L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
that are considered a bug and can be reported to me.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2023, 2018, 2016, 2015, 2014 by perlancar <perlancar@cpan.org>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-datecalc>
When submitting a bug or request, please include a test-file or a
( run in 0.619 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )