Date-Gregorian
view release on metacpan or search on metacpan
CONTRIBUTING view on Meta::CPAN
If your contribution is accepted, you will be mentioned by name under
ACKNOWLEDGEMENTS in the documentation. Please indicate if you prefer
to stay anonymous.
Development Guidelines
----------------------
This library is intended as a more object-oriented replacement for
Date::Calc, or for the subset of DateTime that deals with just dates
rather than dates and times. It should correctly and efficiently
implement the Gregorian calendar with very few prerequisites.
Topics of interest
------------------
Some of the plans for the library are outlined in the ROADMAP section
of the main documentation.
Other improvements could help the documentation to be clearer, or more
complete, or better formatted. And, of course, there is always room
for cool examples and references to application modules.
- perl5lib bug workaround: "use base" would not work in perl 5.9.x
when a constant named "FIELDS" was present
0.10 2007-06-15
- replaced Date::Gregorian::Exact by a dummy croaking when imported
- updated t/exact.t to reflect Date::Gregorian::Exact suspension
- added DateTime interoperability
- added methods get_string and set_string
- added methods get_days_until and compare
- added method get_localtime
- added calendar example script
- fixed a bug in get_ywd/check_ywd related to days late in December
- fixed return value of set_weekday
- revised documentation
- upgraded META.yml to conform to spec v1.3
- added checks in t/basic.t and t/business.t
- added t/datetime.t, t/localtime.t and t/string.t
- added t/pod-coverage.t
0.09 2006-01-21
- added iterators to Date::Gregorian and Date::Gregorian::Business
0.08 2006-01-20
- added t/pod.t
- fixed META.yml
0.07 2006-01-19
- added methods today and get_days_in_year
- added module Date::Gregorian::Business
- split test.pl into t/*.t
- fixed set_yd for years without Jan 1 (which can happen
close to a user-defined calendar reformation date)
- portability fix for set/get_gmtime where OS-specific gmtime(0)
is something else than 00:00:00, January 1, 1970.
0.06 2002-05-21
- revised POD documentation
- added rounding in Date::Gregorian::Exact
0.05 2002-04-19
- got rid of pseudo-hashes
CONTRIBUTING
Changes
LICENSE
MANIFEST
Makefile.PL
README
examples/calendar
examples/today
lib/Date/Gregorian.pm
lib/Date/Gregorian/Business.pm
lib/Date/Gregorian/Exact.pm
t/01_basics.t
t/02_string.t
t/03_localtime.t
t/04_datetime.t
t/05_business.t
t/06_exact.t
{
"abstract" : "Gregorian calendar",
"author" : [
"Martin Becker <becker-cpan-mp (at) cozap.com>"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.36, CPAN::Meta::Converter version 2.150010",
"license" : [
"artistic_2"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
---
abstract: 'Gregorian calendar'
author:
- 'Martin Becker <becker-cpan-mp (at) cozap.com>'
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '6.64'
File::Spec: '0'
dynamic_config: 0
generated_by: 'ExtUtils::MakeMaker version 7.36, CPAN::Meta::Converter version 2.150010'
license: artistic_2
Date::Gregorian - Gregorian calendar
====================================
Copyright (c) 1999-2019, Martin Becker <hasch-cpan-mp (at) cozap.com>.
Version
-------
This is Version 0.13 of Date::Gregorian.
DLSIP status
This package is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Description
-----------
Date::Gregorian performs date calculations, similar to Date::Calc
by Steffen Beyer. However, it has a pure object-oriented interface,
it does not use C code, and it extends the Gregorian calendar beyond
some configurable date in the past by its predecessor, the Julian
calendar. See the inline POD documentation for more details.
Y2K compliance
--------------
This package does not use nor permit two-digit abbreviations for
four-digit year numbers anywhere. In fact, it is designed to deal
with dates in many different centuries.
Y2038 compliance
----------------
iterators. Version 0.10 introduced limited DateTime interoperability.
For a detailed history of changes, see the Changes file.
Ongoing development
-------------------
The oversimplifying Date::Gregorian::Exact extension has been
abandoned. Look into the DateTime suite of modules for a more
comprehensive approach to handling timestamps and localization.
More samples of business calendars and better ways to define even
more of them will be added in the future.
Fractional business days are no longer supported.
They had been an experimental feature up to version 0.12.
Eventually, the essentials of Date::Gregorian::Business might
be put to work in a proper DateTime extension.
A couple of API additions are scheduled for version 1.00.
Old code should continue to work, though.
Hash: SHA512
SHA256 e6f57be628420e6eda9be4b358a3877b162a573c87baafe8d93dae7cff42fc39 CONTRIBUTING
SHA256 66266a1009f7c9f8c8620f5e201b670f1caba5429fd3145c587cde0b26476375 Changes
SHA256 c53c6b96081b0a5b9b2fb4d0133d55c20e5e00e4c127ade62f03434ee7b3d2de LICENSE
SHA256 ed9924653e3017ecd4e5bdb2999341a6ba698f78e06a0fd01a69e82828907744 MANIFEST
SHA256 ea54701e7b3faf3df8ef5140577dd8bf672d30f4dde3fa6f0e1417dcfc1874f7 META.json
SHA256 5737311883b7b39d880a5bfbc252e2c219e9961f810df0d90f94d2ffb9c0b716 META.yml
SHA256 0274ea21d7c83e9371fe62b19a880a03685ebbfcbd8de614061dff9706483778 Makefile.PL
SHA256 52989bb1aaa8acf4fd402ea1cf6ad8959ea1f6fdf6ea9d217d6bad19fc047307 README
SHA256 3826f7cf1252cb08ce6a8a347500604fb07668f5218d3d2195b4807f56557622 examples/calendar
SHA256 d7d9e8f5992b7d2652eb704c620a3924ab8910f08d61ccd564ebb4539a0f2be6 examples/today
SHA256 45f79694582d42c156fa5a3a4acbc989e585d41a1c0531db9bfc51216f24e8e9 lib/Date/Gregorian.pm
SHA256 75dc00f43e3c9804d79fcfa160b2b89fd7716dea548cd1898ede74a158cd9098 lib/Date/Gregorian/Business.pm
SHA256 a5c1c35674e8ee6edb9f9eb380cb6c6c0c671a4267580684d9b860980fa94454 lib/Date/Gregorian/Exact.pm
SHA256 48763647abd7f90cece52a0510443587341a363729d09a991e85d2373e117e1a t/01_basics.t
SHA256 e67e6b019bba586498b28ad6cdbf546cc345e052c75e17a7fe71f93cedaaf071 t/02_string.t
SHA256 f713cecdc6745e852b885e15e6523ec2338cc16e87e13ef20ded8d5bf2ee2606 t/03_localtime.t
SHA256 859a01555a38e5170606cf8270f06b9e46046421ab132b125c1b515b5bba08d5 t/04_datetime.t
SHA256 b264a4d465ec078cf50d937dc27db1f03c06f330723233d142852fce1751f61a t/05_business.t
SHA256 d5f7619bdc50551d47087a4b41c901f68d2a28e6a1a404729326f701df73c2eb t/06_exact.t
examples/calendar view on Meta::CPAN
#!/usr/bin/perl
# Copyright (c) 2007-2019 by Martin Becker, Blaubeuren.
# This package is free software; you can distribute it and/or modify it
# under the terms of the Artistic License 2.0 (see LICENSE file).
# calendar - display a calendar of the current month
#
# The current date will be indicated by square brackets.
# Non-business-days will be indicated by a trailing '*'.
use strict;
use warnings;
use Date::Gregorian qw(MONDAY JANUARY);
use Date::Gregorian::Business;
my @months = qw(
lib/Date/Gregorian.pm view on Meta::CPAN
# no DESTROY method, nothing to clean up
1;
__END__
=encoding utf8
=head1 NAME
Date::Gregorian - Gregorian calendar
=head1 VERSION
This documentation refers to version 0.13 of Date::Gregorian.
=head1 SYNOPSIS
use Date::Gregorian;
use Date::Gregorian qw(:weekdays :months);
lib/Date/Gregorian.pm view on Meta::CPAN
}
$date->configure(1752, 9, 14);
$date->configure(1752, 9, 14, 1753); # United Kingdom
$date2->configure(1918, 2, 14); # Russia
$date2->set_ymd(1917, 10, 25); # pre-Gregorian Oct 25, 1917
$date->set_date($date2); # Gregorian Nov 7, 1917 (same day)
if ($date->is_gregorian) {
# date is past configured calendar reformation,
# thus in Gregorian notation
}
else {
# date is before configured calendar reformation,
# thus in Julian notation
}
# get the first sunday in October:
$date->set_ymd($year, 10, 1)->set_weekday(6, '>=');
# get the last sunday in October:
$date->set_ymd($year, 11, 1)->set_weekday(6, '<');
# calculate number of days in 2000:
$days = $date->get_days_in_year(2000);
lib/Date/Gregorian.pm view on Meta::CPAN
$dt = DateTime->now(time_zone => 'Europe/Berlin');
$date->set_datetime($dt);
$dt = DateTime->from_object(object => $date);
$date = Date::Gregorian->from_object($dt);
($rata_die, $sec, $nanosec) = $date->utc_rd_values();
$date->truncate_to_day;
=head1 DESCRIPTION
Calendars define some notation to identify days in history. The
Gregorian calendar, now in wide use, was established by Pope
Gregory XIII in AD 1582 as an improvement over the less accurate
Julian calendar that had been in use before. Both of these calendars
also determine certain holidays. Unfortunately, the new one was
not adopted everywhere at the same time. Thus, the correct date
for a given historic event can depend on its location. Astronomers
usually expand the official Julian/Gregorian calendar backwards
beyond AD 1 using zero and negative numbers, so that year 0 is
1 BC, year -1 is 2 BC, etc.
This module provides an object class representing days in history.
You can get earlier or later dates by way of adding days to them,
determine the difference in days between two of them, and read out
the day, month and year number as the (astronomic) Gregorian calendar
defines them (numbers 1 through 12 representing January through
December). Moreover, you can find out weekdays, easter sundays,
week in year and day in year numbers.
For convenience, it is also possible to define the switching day
from Julian to Gregorian dates and the switching year from
pre-Gregorian to Gregorian easter schedule. Use configure with
the first valid date of the new calendar and optionally the first
year the new easter schedule was used (default 1583).
The module is based on an algorithm devised by C. F. Gauss (1777-1855).
It is completely written in Perl for maximum portability.
All methods except get_* and iterate_* return their object. This
allows for shortcuts like:
$pentecost = Date::Gregorian->new->set_easter(2000)->add_days(49);
lib/Date/Gregorian.pm view on Meta::CPAN
=head2 new
I<new> creates a Date::Gregorian object from scratch (if called as
a class method) or as a copy of an existing object. The latter is
more efficient than the former. I<new> does not take any arguments.
=head2 set_date
I<set_date> sets one Date::Gregorian object to the same day another
object represents. The objects do not need to share a common calendar
configuration.
=head2 set_ymd
I<set_ymd> sets year, month and day to new absolute values. Days
and months out of range are silently folded to standard dates, in
a way that is intended to preserve continuity: Month 13 is treated
as month 1 of the next year, month 14 as month 2 of the next year,
month 0 as month 12 of the previous year, day 0 as the last day of
the previous month, etc. Thus, e.g., the date 10000 days before
lib/Date/Gregorian.pm view on Meta::CPAN
=head2 check_ywd
I<check_ywd> checks a given combination of year, week in year and
weekday for validity. Given a valid date, the object is updated
and the object itself is returned, evaluating to true in boolean
context. Otherwise, the object remains untouched and B<undef> is
returned.
Note that year 1582 (or whatever year was configured to have the
Gregorian calendar reformation) was considerably shorter than a
normal year. Such a year has some invalid dates that otherwise
might seem utterly inconspicuos.
=head2 add_days
I<add_days> increases, or, given a negative argument, decreases, a
date by a number of days. Its new value represents a day that many
days later in history if a positive number of days was added. Adding
a negative number of days consequently shifts a date back towards
the past.
lib/Date/Gregorian.pm view on Meta::CPAN
depend on the environment and other dynamic configuration settings.
=head2 get_days_in_year
I<get_days_in_year> computes the number of days in a given year
(independent of the year stored in the date object, but taking
into account its configuration).
=head2 configure
I<configure> defines the way the Gregorian calendar reformation
should be handled in calculations with the date object and any new
ones later cloned with I<new> from this one. The first three
arguments specify the year, month and day of the first day the new
calendar was in use. The optional fourth argument defines the first
year the new easter schedule has to be used in easter calculations.
Re-configuring a date object is legal and does not change the day
in history it represents while possibly changing the year, month
and day values related to it.
=head2 is_gregorian
I<is_gregorian> returns a boolean value telling whether a date is
past the configured calendar reformation and thus will yield year,
month and day values in Gregorian mode.
=head2 get_string
I<get_string> returns a plaintext representation of the date represented
by an object.
=head2 set_string
I<set_string> restores a date value from a string returned by I<get_string>.
Strings of the form "YYYY-MM-DD" are also accepted. The return value
is B<undef> if the syntax could not be recognized, otherwise the object.
I<set_string> handles values out of range the same way I<set_ymd> does.
=head2 DateTime interoperability
Date::Gregorian objects can be converted to DateTime objects and
vice versa. From the view of DateTime, Date::Gregorian implements
a calendar operating in the floating timezone. From the view of
Date::Gregorian, DateTime objects represent days in history in a
way suitable for object initialization. Higher precision
components of DateTime objects, i.e. seconds and nanoseconds,
are preserved for reverse conversion but otherwise ignored.
=over 4
=item set_datetime
I<set_datetime> sets a Date::Gregorian object to the day represented
lib/Date/Gregorian.pm view on Meta::CPAN
=item *
Make date objects immutable.
=item *
Add time arguments to gmtime and localtime conversions.
=item *
Add more business calendars.
=item *
Name days and holidays.
=item *
Unify simple date arithmetic and business day arithmetic.
=item *
lib/Date/Gregorian/Business.pm view on Meta::CPAN
use Date::Gregorian qw(:weekdays);
our @ISA = qw(Date::Gregorian);
our $VERSION = '0.13';
# ----- object definition -----
# ............. index .............. # .......... value ..........
use constant F_OFFSET => Date::Gregorian::NFIELDS;
use constant F_ALIGNMENT => F_OFFSET+0; # 0 = morning, 1 = evening
use constant F_MAKE_CAL => F_OFFSET+1; # sub (date, year) => [calendar]
use constant F_YEAR => F_OFFSET+2; # currently initialized year
use constant F_CALENDAR => F_OFFSET+3; # list of: 1 = biz, 0 = holiday
use constant NFIELDS => F_OFFSET+4;
# ----- other constants -----
# index into calendar definition
use constant _WEEKLY => 0; # array of non-biz weekdays
use constant _YEARLY => 1; # array of holidays per year
# index into single holiday per year definition
use constant _D_MONTH => 0; # month number or 0 for easter
use constant _D_DAY => 1; # day number or easter difference
use constant _D_DELTA => 2; # array of deltas per weekday
use constant _D_YEARS => 3; # array of first and last year
# ----- predefined variables -----
# elements of default biz calendars
my $skip_weekend = [ 0, 0, 0, 0, 0, 2, 1]; # Sat, Sun -> Mon
my $avoid_weekend = [ 0, 0, 0, 0, 0, -1, 1]; # Sat -> Fri, Sun -> Mon
my $next_monday = [ 0, 6, 5, 4, 3, 2, 1]; # set_weekday(Mon, ">=")
my $prev_monday = [-7, -1, -2, -3, -4, -5, -6]; # set_weekday(Mon, "<")
my $next_wednesday = [ 2, 1, 0, 6, 5, 4, 3]; # set_weekday(Wed, ">=")
my $next_thursday = [ 3, 2, 1, 0, 6, 5, 4]; # set_weekday(Thu, ">=")
my $saturday_sunday = [SATURDAY, SUNDAY];
# some biz calendars known by default
my %samples = (
'us' => [
$saturday_sunday,
[
[ 1, 1, $skip_weekend], # New Year's day
[ 1, 15, $next_monday], # Martin Luther King
[ 2, 15, $next_monday], # President's day
[ 6, 1, $prev_monday], # Memorial day
[ 7, 4, $avoid_weekend], # Independence day
[ 9, 1, $next_monday], # Labor day
lib/Date/Gregorian/Business.pm view on Meta::CPAN
return $year == $selection;
}
if ('CODE' eq ref $selection) {
return $selection->($self, $year, @{$day}[0, 1]);
}
return
(!defined($selection->[0]) || $selection->[0] <= $year) &&
(!defined($selection->[1]) || $year <= $selection->[1]);
}
# make_cal factory, generating a calendar generator enclosing a configuration
sub _make_make_cal {
my ($weekly, $yearly) = @_;
return sub {
my ($date, $year) = @_;
my $firstday = $date->new->set_yd($year, 1, 1);
my $first_wd = $firstday->get_weekday;
my $someday = @$yearly && $firstday->new;
my $easter = undef;
my $index;
my $calendar = $firstday->get_empty_calendar($year, $weekly);
foreach my $day (@$yearly) {
if (!defined($day->[3]) || _select_year($someday, $day, $year)) {
if ($day->[0]) {
$index =
$someday->set_ymd($year, @{$day}[0, 1])
->get_days_since($firstday);
$index += $day->[2]->[$someday->get_weekday] if $day->[2];
}
else {
if (!defined $easter) {
$easter =
$someday->set_easter($year)
->get_days_since($firstday);
}
$index = $easter + $day->[1];
$index += $day->[2]->[(496 + $day->[1]) % 7] if $day->[2];
}
$calendar->[$index] = 0 if 0 <= $index && $index < @$calendar;
}
}
return $calendar;
};
}
# fetch biz calendar for given year, initializing it if necessary
sub _calendar {
my ($self, $year) = @_;
if (!defined($self->[F_YEAR]) || $year != $self->[F_YEAR]) {
$self->[F_YEAR] = $year;
$self->[F_CALENDAR] = $self->[F_MAKE_CAL]->($self, $year);
}
return $self->[F_CALENDAR];
}
# ----- public methods -----
sub get_empty_calendar {
my ($date, $year, $weekly_nonbiz) = @_;
my $firstday = $date->new->set_yd($year, 1);
my $days = $firstday->get_days_in_year($year);
my $first_wd = $firstday->get_weekday;
my @week = (1) x 7;
foreach my $day (@$weekly_nonbiz) {
$week[$day] = 0;
}
@week = @week[$first_wd .. 6, 0 .. $first_wd-1] if $first_wd;
my @calendar = ((@week) x ($days / 7), @week[0 .. ($days % 7)-1]);
return \@calendar;
}
sub define_configuration {
my ($class, $name, $configuration) = @_;
my $type = defined($configuration)? ref($configuration): '!';
if (!$type) {
return undef if !exists $samples{$configuration};
$configuration = $samples{$configuration};
}
lib/Date/Gregorian/Business.pm view on Meta::CPAN
# tweak super class to provide default alignment
sub Date::Gregorian::get_alignment {
return 0;
}
sub is_businessday {
my ($self) = @_;
my ($year, $day) = $self->get_yd;
return $self->_calendar($year)->[$day-1];
}
# count business days, proceeding into the future
# $days gives the interval measured in real days (positive)
# alignment tells where to start: 0 = at current day, 1 = the day after
# 0 <= result <= $days
sub _count_businessdays_up {
my ($self, $days) = @_;
my ($year, $day) = $self->get_yd;
my $calendar = $self->_calendar($year);
my $result = 0;
--$day if !$self->[F_ALIGNMENT];
while (0 < $days) {
while (@$calendar <= $day) {
$calendar = $self->_calendar(++$year);
$day = 0;
}
do {
no integer;
$result += $calendar->[$day];
};
++$day;
--$days;
}
return $result;
}
# count business days, proceeding into the past
# $days gives the interval measured in real days (positive)
# alignment tells where to start: 1 = at current day, 0 = the day before
# 0 <= result <= $days
sub _count_businessdays_down {
my ($self, $days) = @_;
my ($year, $day) = $self->get_yd;
my $calendar = $self->_calendar($year);
my $result = 0;
--$day if !$self->[F_ALIGNMENT];
while (0 < $days) {
--$day;
--$days;
while ($day < 0) {
$calendar = $self->_calendar(--$year);
$day = $#$calendar;
}
do {
no integer;
$result += $calendar->[$day];
};
}
return $result;
}
# Alignments and results Now:0 Now:1 Now:0 Now:1
# b--(H)--b---b---b--(H)--b---b Then:0 Then:1 Then:1 Then:0
# Then Now 3 3 3 3
# Then Now 3 2 2 3
# Then Now 3 4 3 4
lib/Date/Gregorian/Business.pm view on Meta::CPAN
}
if ($delta < 0) {
return $self->_count_businessdays_up(-$delta);
}
return 0;
}
sub set_next_businessday {
my ($self, $relation) = @_;
my ($year, $day) = $self->get_yd;
my $calendar = $self->_calendar($year);
--$day;
return $self if '<' ne $relation && '>' ne $relation && $calendar->[$day];
if ('<' eq $relation || '<=' eq $relation) {
do {
--$day;
while ($day < 0) {
$calendar = $self->_calendar(--$year);
$day = $#$calendar;
}
}
while (!$calendar->[$day]);
}
else {
do {
++$day;
while (@$calendar <= $day) {
$calendar = $self->_calendar(++$year);
$day = 0;
}
}
while (!$calendar->[$day]);
}
return $self->set_yd($year, $day+1);
}
sub iterate_businessdays_upto {
my ($self, $limit, $rel) = @_;
my $days = ($rel eq '<=') - $self->get_days_since($limit);
my ($year, $day, $calendar);
if (0 < $days) {
($year, $day) = $self->get_yd;
--$day;
$calendar = $self->_calendar($year);
}
return sub {
while (0 < $days) {
while (@$calendar <= $day) {
$calendar = $self->_calendar(++$year);
$day = 0;
}
--$days;
if ($calendar->[$day++]) {
return $self->set_yd($year, $day);
}
}
return undef;
};
}
sub iterate_businessdays_downto {
my ($self, $limit, $rel) = @_;
my $days = $self->get_days_since($limit) + ($rel ne '>');
my ($year, $day, $calendar);
if (0 < $days) {
($year, $day) = $self->get_yd;
--$day;
$calendar = $self->_calendar($year);
}
return sub {
while (0 < $days) {
while ($day < 0) {
$calendar = $self->_calendar(--$year);
$day = $#$calendar;
}
--$days;
if ($calendar->[$day--]) {
return $self->set_yd($year, $day+2);
}
}
return undef;
};
}
# -b----H----b----b----H----b-
# ^ ^ ^ ^
# 0 0 1 1 2 2
sub add_businessdays {
no integer;
my ($self, $days, $new_alignment) = @_;
my ($year, $day) = $self->get_yd;
-- $day;
my $calendar = $self->_calendar($year);
my $alignment = $self->[F_ALIGNMENT];
# handle alignment change
if (defined($new_alignment) && ($alignment xor $new_alignment)) {
if ($new_alignment) {
$alignment = $self->[F_ALIGNMENT] = 1;
$days -= $calendar->[$day];
}
else {
$alignment = $self->[F_ALIGNMENT] = 0;
$days += $calendar->[$day];
}
}
if (0 < $days || !$days && !$alignment) {
# move forward in time
$days -= $calendar->[$day] if !$alignment;
while (0 < $days || !$days && !$alignment) {
++$day;
while (@$calendar <= $day) {
$calendar = $self->_calendar(++$year);
$day = 0;
}
$days -= $calendar->[$day];
}
}
else {
# move backwards in time
$days += $calendar->[$day] if $alignment;
while ($days < 0 || !$days && $alignment) {
--$day;
while ($day < 0) {
$calendar = $self->_calendar(--$year);
$day = $#$calendar;
}
$days += $calendar->[$day];
}
}
return $self->set_yd($year, $day+1);
}
1;
__END__
lib/Date/Gregorian/Business.pm view on Meta::CPAN
@my_holidays = (
[6], # Sundays
[
[11, 22, [3, 2, 1, 0, 6, 5, 4]], # Thanksgiving
[12, 25], # December 25
[12, 26, undef, [2005, 2010]], # December 26 in 2005-2010
[12, 27, undef, sub { $_[1] & 1 }], # December 27 in odd years
]
);
sub my_make_calendar {
my ($date, $year) = @_;
my $calendar = $date->get_empty_calendar($year, [SATURDAY, SUNDAY]);
my $firstday = $date->new->set_yd($year, 1);
# ... calculate holidays of given year, for example ...
my $holiday = $date->new->set_ymd($year, 7, 4);
my $index = $holiday->get_days_since($firstday);
# Sunday -> next Monday, Saturday -> previous Friday
if (!$calendar->[$index] && !$calendar->[++$index]) {
$index -= 2;
}
$calendar->[$index] = 0;
# ... and so on for all holidays of year $year.
return $calendar;
}
Date::Gregorian::Business->define_configuration(
'Acme Ltd.' => \@my_holidays
);
Date::Gregorian::Business->define_configuration(
'Acme Ltd.' => \&my_make_calendar
);
# set default configuration and create object with defaults
Date::Gregorian::Business->configure_business('Acme Ltd.') or die;
$date = Date::Gregorian::Business->new;
# create object with explicitly specified configuration
$date = Date::Gregorian::Business->new('Acme Ltd.') or die;
# create object and change configuration later
$date = Date::Gregorian::Business->new;
$date->configure_business('Acme Ltd.') or die;
$date->configure_business(\@my_holidays) or die;
$date->configure_business(\&my_make_calendar) or die;
# some pre-defined configurations
$date->configure_business('us'); # US banking
$date->configure_business('de'); # German nation-wide
=head1 DESCRIPTION
I<Date::Gregorian::Business> is an extension of Date::Gregorian supporting
date calculations involving business days.
Objects of this class have a notion of whether or not a day is a
business day and provide methods to count business days between two
dates or find the other end of a date interval, given a start or
end date and a number of business days in between. Other methods
allow to define business calendars for use with this module.
By default, a date interval includes the earlier date and does not
include the later date of its two end points, no matter in what order
they are given. We call this "morning alignment". However, individual
date objects can be either "morning" or "evening" aligned, meaning they
represent the situation at the beginning or end of the day in question.
Where a date object is the result of a calculation, its alignment can
be chosen through an optional method argument.
=head2 User methods
=over 4
=item new
I<new>, called as a class method, creates and returns a new date
object. The optional parameter can be a configuration or (more
typically) the name of a configuration. If omitted, the current
default configuration is used. Business calendar configurations
are described in detail in an extra section below. In case of bad
configurations B<undef> is returned.
I<new>, called as an object method, returns a clone of the object.
A different configuration for the new object can be specified.
Again, in case of bad configurations B<undef> is returned.
=item is_businessday
I<is_businessday> returns a nonzero number (typically 1) if the
date currently represented by the object is a business day, or zero
if it falls on a weekend or holiday. Special business calendars
may have business days counting less than a whole day in calculations.
Objects configured that way may return 0.5 or even another numeric
value between 0 and 1 for some dates. In any case I<is_businessday>
can be used in boolean context.
=item align
I<align> sets the alignment of a date. An alignment of 0 means
morning alignment, 1 means evening alignment. With morning alignment,
the current day is counted in durations extending into the future,
lib/Date/Gregorian/Business.pm view on Meta::CPAN
=item add_businessdays
I<add_businessdays> moves an arbitrary date forward or backwards
in time up to a given number of business days. A positive number
of days means moving towards the future. The result is always a
business day. The alignment will not be changed if the second
parameter is omitted, or else set to the second parameter. The
result will be rounded to the beginning or end of a business day
if necessary, as determined by its alignment.
Rounding: If you work with simple calendars and integer numbers,
all results will be precise. However, with calendars containing
fractions of business days or with non-integer values of day
differences, a calculated date may end up somewhere in the middle
of a business day rather than at its beginning or end. The final
result will stay at that date but move up or down to the desired
alignment. In other words, fractional days will be rounded down
to morning alignment or up to evening alignment, whichever applies.
No ambiguities: Even if a calculated date lies next to a number of
non-business days in a way that more than one date would satisfy a
desired span of business days, results are always well-defined by
lib/Date/Gregorian/Business.pm view on Meta::CPAN
=back
=head2 Configuration
Version compatibility note: The configuration specifications described
here are expected to evolve with further development of this module.
In fact, they should ultimately be replaced by easier-to-use
configuration objects. We will try to stay downward compatible for
some time, however.
The business calendar to use can be customized both on an
object-by-object basis and by way of general defaults. Business
calendars can be stored under a name and later referenced by that
name.
A business calendar can be defined through a list of holiday
definitions or more generally through a code reference, as explained
below. A number of such definitions of common interest will be
accessible in later editions of this module or some related component.
=over 4
=item define_configuration
I<define_configuration> names and defines a configuration. It can
later be referenced by its name. By convention, user-defined names
lib/Date/Gregorian/Business.pm view on Meta::CPAN
=back
A more general way to specify a complete configuration is a code
reference. It must refer to a subroutine that takes a date object
and a year (which you can also view as a method with a year parameter)
and returns an array reference. The array must have exactly that
many elements as there are days in the given year. Each element
must be defined and have a numerical value greater or equal to zero.
These values will be returned by I<is_businessday> and added together
in calculations. The idea is that one call to the subroutine figures
out the calendar of a whole year in one go.
=item get_empty_calendar
I<get_empty_calendar> is a helper method mainly intended for use
in such a subroutine. It takes two mandatory parameters, a year
and a reference to an array like C<@weekend_days> above, and returns
a reference of an array of zeroes and ones representing the weekends
and weekly business days of that year suitable to be further modified
and finally returned by said subroutine.
=back
=head1 EXPORTS
t/05_business.t view on Meta::CPAN
$date2 &&
0 == $date2->get_days_since($date) &&
$a == $date->get_alignment;
}
sub fmt_date {
my ($date) = @_;
return sprintf "%04d-%02d-%02d", $date->get_ymd;
}
sub test_calendar {
my ($n, $date, $calendar, @first_ymd) = @_;
if (!$date) {
test $n, undef;
return;
}
my $date2 = $date->new->set_ymd(@first_ymd);
my $result = 1;
my ($biz, $exp);
foreach $exp (@$calendar) {
$biz = $date2->is_businessday;
if (($biz xor $exp) || $biz != $exp) {
$result = '';
$biz = defined($biz)? "'" . $biz . "'": 'undef';
$exp = defined($exp)? "'" . $exp . "'": 'undef';
warn
"[$n] ", fmt_date($date2),
" is_businessday=$biz expected=$exp\n";
}
$date2->add_days(1);
t/05_business.t view on Meta::CPAN
[ 5, 29],
[ 7, 4],
[ 9, 4],
[10, 9],
[11, 10],
[11, 23],
[12, 25],
],
);
my $my_make_calendar2_called = 0;
sub my_make_calendar {
my ($date, $year) = @_;
my $calendar = $date->get_empty_calendar($year, []);
my $i;
for ($i = 0; $i < @$calendar; $i += 10) {
$calendar->[$i] = 0;
}
return $calendar;
}
sub my_make_calendar2 {
my ($date, $year) = @_;
my $calendar = $date->get_empty_calendar($year, [SATURDAY, SUNDAY]);
++ $my_make_calendar2_called;
if (exists $some_holidays{$year}) {
my $first = $date->new->set_yd($year, 1);
my $this = $first->new;
foreach my $md (@{$some_holidays{$year}}) {
my $i = $this->set_ymd($year, @$md)->get_days_since($first);
if (0 <= $i && $i < @$calendar) {
$calendar->[$i] = 0;
};
}
}
return $calendar;
}
my $date = Date::Gregorian::Business->new;
my $date2;
my $result;
test(2, $date->isa('Date::Gregorian::Business'));
test(3, $date->isa('Date::Gregorian'));
$result = Date::Gregorian::Business->define_configuration(
'arr test' => \@my_holidays
);
test(4, $result);
$result = Date::Gregorian::Business->define_configuration(
'sub test' => \&my_make_calendar
);
test(5, $result);
$result = Date::Gregorian::Business->configure_business('undef test');
test(6, !defined($result));
$date = Date::Gregorian::Business->new('de_BW');
test(7, defined($date) && $date->isa('Date::Gregorian::Business'));
$date = Date::Gregorian::Business->new->set_ymd(1999, 12, 31);
t/05_business.t view on Meta::CPAN
test(8, $date->configure_business('arr test'));
test(9, $date2->configure_business(\@my_holidays));
test_equivalence(10, $date, $date2, 66, 2003, 11, 1);
test_equivalence(11, $date, $date2, 66, 2004, 11, 1);
test_equivalence(12, $date, $date2, 66, 2005, 11, 1);
test_equivalence(13, $date, $date2, 66, 2006, 11, 1);
test_equivalence(14, $date, $date2, 66, 2007, 11, 1);
test_equivalence(15, $date, $date2, 66, 2008, 11, 1);
test_equivalence(16, $date, $date2, 66, 2009, 11, 1);
test_calendar(17, $date, [
(0, 1, 1, 1, 0, 1, 1),
(0, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 0, 1, 0),
(0, 1, 1, 1, 1, 1, 1),
], 2003, 11, 23);
test_calendar(18, $date, [
(0, 1, 1, 1, 0, 1, 1),
(0, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 1, 1, 0),
(0, 1, 0, 1, 1, 1, 1),
], 2004, 11, 21);
test_calendar(19, $date, [
(0, 1, 1, 1, 0, 1, 1),
(0, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 1, 1, 1),
(0, 0, 0, 0, 1, 1, 1),
], 2005, 11, 20);
test_calendar(20, $date, [
(0, 1, 1, 1, 0, 1, 1),
(0, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 1, 1, 1),
(0, 0, 0, 1, 0, 1, 1),
], 2006, 11, 19);
test_calendar(21, $date, [
(0, 1, 1, 1, 0, 1, 1),
(0, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 1, 1, 1),
(0, 1, 0, 0, 0, 1, 0),
], 2007, 11, 18);
test_calendar(22, $date, [
(0, 1, 1, 1, 0, 1, 1),
(0, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 0, 0, 1),
(0, 0, 1, 1, 1, 1, 1),
], 2008, 11, 23);
test_calendar(23, $date, [
(0, 1, 1, 1, 0, 1, 1),
(0, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 1, 0, 1),
(0, 1, 0, 0, 1, 1, 1),
], 2009, 11, 22);
$date2->set_date($date->set_ymd(2005, 4, 23));
$result = $date->configure_business('sub test');
test(24, $result);
test_ymd(25, $date, 2005, 4, 23);
$result = $date2->configure_business(\&my_make_calendar);
test(26, $result);
test_ymd(27, $date2, 2005, 4, 23);
test_equivalence(28, $date, $date2, 100, 1999, 11, 1);
test_equivalence(29, $date, $date2, 100, 2000, 11, 1);
test_calendar(30, $date, [
(0, 1, 1, 1, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 1, 1),
(0, 1, 1, 1, 1, 1, 1, 1, 1, 1) x 3,
(0, 1, 1, 1, 1, 1),
], 2000, 11, 26);
$date2 = Date::Gregorian::Business->new('us');
test(31, $date2);
$result = $date2->set_ymd(2006, 1, 6)->align(1);
t/05_business.t view on Meta::CPAN
test(46, -7 == $date->get_businessdays_since($date2));
test(47, -7 == $date2->get_businessdays_until($date));
$date->align(1);
test(48, 7 == $date2->get_businessdays_since($date));
test(49, 7 == $date->get_businessdays_until($date2));
test(50, -7 == $date->get_businessdays_since($date2));
test(51, -7 == $date2->get_businessdays_until($date));
test_calendar(52, $date, [
(0, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0),
], 1999, 1, 1);
test_calendar(53, $date, [
(0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1),
], 2000, 1, 1);
test_calendar(54, $date, [
(0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1, 1, 1),
], 2001, 1, 1);
test_calendar(55, $date, [
(0, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1),
], 2002, 1, 1);
test_calendar(56, $date, [
(0, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1),
], 2003, 1, 1);
test_calendar(57, $date, [
(0, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
], 2004, 1, 1);
test_calendar(58, $date, [
(0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1),
], 2005, 1, 1);
test_calendar(59, $date, [
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 1, 1, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1, 1),
], 2006, 1, 1);
$date->align(0);
$date->set_ymd(1999, 12, 31)->set_next_businessday('>=');
t/05_business.t view on Meta::CPAN
test_equal 135, 254, $date->get_businessdays_until($date2);
$date->configure_business('de_BY2'); # nonexistent config
$date->set_ymd(2004, 12, 23)->align(0);
$date2->set_ymd(2004, 12, 26)->align(0);
test_equal 136, 2, $date->get_businessdays_until($date2);
$date->set_ymd(2004, 12, 24);
test_equal 137, 1, $date->is_businessday;
$date = Date::Gregorian::Business->new('us');
test_calendar(138, $date, [
0, 1, 1, 0, 0,
(1, 1, 1, 1, 1, 0, 0) x 2,
0, 1, 1, 1, 1, 0, 0,
(1, 1, 1, 1, 1, 0, 0) x 3,
0, 1, 1, 1, 1, 0, 0,
(1, 1, 1, 1, 1, 0, 0) x 13,
0, 1, 1, 1, 1, 0, 0,
(1, 1, 1, 1, 1, 0, 0) x 4,
1, 1, 1, 1, 0, 0, 0,
(1, 1, 1, 1, 1, 0, 0) x 8,
t/05_business.t view on Meta::CPAN
(1, 1, 1, 1, 1, 0, 0) x 3,
1, 0, 1, 1, 1, 0, 0,
1, 1, 1, 1, 1, 0, 0,
1, 1, 1, 0, 1, 0, 0,
(1, 1, 1, 1, 1, 0, 0) x 3,
1, 1, 1, 0, 1, 0, 0,
1, 1, 1,
], 2003, 1, 1);
test(139, !$date->set_ymd(1998, 7, 3)->is_businessday);
$my_make_calendar2_called = 0;
delete $some_holidays{1998};
$date2 = Date::Gregorian::Business->new(\&my_make_calendar2);
test_calendar(140, $date2, [1, 0, 0, 1], 1998, 7, 3);
test(141, 1 == $my_make_calendar2_called);
$date2->set_ymd(1998, 7, 3);
test_equivalence(142, $date, $date2, 1461, 2003, 1, 1);
$date->set_ymd(2003, 7, 1)->align(0)->add_businessdays(3);
test_ymda(143, $date, 2003, 7, 7, 0);
$date->set_ymd(2003, 7, 1)->align(0)->add_businessdays(3, 0);
test_ymda(144, $date, 2003, 7, 7, 0);
$date->set_ymd(2003, 7, 1)->align(0)->add_businessdays(3, 1);
test_ymda(145, $date, 2003, 7, 3, 1);
t/05_business.t view on Meta::CPAN
test(269, -3 == $date->get_businessdays_until($date2));
test(270, 3 == $date->get_businessdays_since($date2));
$date2->set_ymd(2003, 7, 6);
test(271, -3 == $date->get_businessdays_until($date2));
test(272, 3 == $date->get_businessdays_since($date2));
$date2->set_ymd(2003, 7, 7);
test(273, -3 == $date->get_businessdays_until($date2));
test(274, 3 == $date->get_businessdays_since($date2));
$date = Date::Gregorian::Business->new->configure(1752, 9, 14, 1753);
my $calendar = $date->get_empty_calendar(2000, [SUNDAY]);
test_array_equal(275, $calendar, [
1, 0,
(1, 1, 1, 1, 1, 1, 0) x 52,
]);
$calendar = $date->get_empty_calendar(1752, [SUNDAY]);
test_array_equal(276, $calendar, [
1, 1, 1, 1, 0,
(1, 1, 1, 1, 1, 1, 0) x 50,
]);
$result =
Date::Gregorian::Business->define_configuration("redefine test", "de");
test(277, $result);
$date = Date::Gregorian::Business->new("redefine test")->
set_ymd(2005, 1, 1)->align(0);
$result =
t/05_business.t view on Meta::CPAN
test 340, $date->set_ymd(3785, 2, 3)->is_businessday;
test 341, !$date->set_ymd(3785, 12, 16)->is_businessday;
$result = Date::Gregorian::Business->define_configuration('t1', 'unheard of');
test 342, !defined $result;
$result = Date::Gregorian::Business->define_configuration('t2', 't1');
test 343, !defined $result;
$result = Date::Gregorian::Business->define_configuration('t3', 'us');
test 344, $result;
$my_make_calendar2_called = 0;
$result = Date::Gregorian::Business->configure_business(\&my_make_calendar2);
test 345, $result;
$date2 = Date::Gregorian::Business->new();
test_calendar(346, $date2, [1, 0, 0, 1], 1998, 7, 3);
test 347, 1 == $my_make_calendar2_called;
$date = Date::Gregorian::Business->new('de')->set_ymd(1970, 6, 17);
test 348, !$date->is_businessday;
$result = Date::Gregorian::Business->define_configuration('missing param');
test 349, !$result;
$result = Date::Gregorian::Business->configure_business;
test 350, !$result;
( run in 0.494 second using v1.01-cache-2.11-cpan-c333fce770f )