File Coverage

blib/lib/Date/Calc/PP.pm

Criterion	Covered	Total	%
statement	1223	1504	81.3
branch	538	844	63.7
condition	360	600	60.0
subroutine	132	157	84.0
pod	1	152	0.6
total	2254	3257	69.2

###############################################################################
##                                                                           ##
##    Copyright (c) 1995 - 2015 by Steffen Beyer.                            ##
##    All rights reserved.                                                   ##
##                                                                           ##
##    This package is free software; you can redistribute it                 ##
##    and/or modify it under the same terms as Perl itself.                  ##
##                                                                           ##
###############################################################################

package Date::Calc::PP;

BEGIN { eval { require bytes; }; }
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

use Carp::Clan qw(^Date::);

use POSIX ();

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw();

@EXPORT_OK = qw(
    Days_in_Year
    Days_in_Month
    Weeks_in_Year
    leap_year
    check_date
    check_time
    check_business_date
    Day_of_Year
    Date_to_Days
    Day_of_Week
    Week_Number
    Week_of_Year
    Monday_of_Week
    Nth_Weekday_of_Month_Year
    Standard_to_Business
    Business_to_Standard
    Delta_Days
    Delta_DHMS
    Delta_YMD
    Delta_YMDHMS
    N_Delta_YMD
    N_Delta_YMDHMS
    Normalize_DHMS
    Add_Delta_Days
    Add_Delta_DHMS
    Add_Delta_YM
    Add_Delta_YMD
    Add_Delta_YMDHMS
    Add_N_Delta_YMD
    Add_N_Delta_YMDHMS
    System_Clock
    Today
    Now
    Today_and_Now
    This_Year
    Gmtime
    Localtime
    Mktime
    Timezone
    Date_to_Time
    Time_to_Date
    Easter_Sunday
    Decode_Month
    Decode_Day_of_Week
    Decode_Language
    Decode_Date_EU
    Decode_Date_US
    Fixed_Window
    Moving_Window
    Compress
    Uncompress
    check_compressed
    Compressed_to_Text
    Date_to_Text
    Date_to_Text_Long
    English_Ordinal
    Calendar
    Month_to_Text
    Day_of_Week_to_Text
    Day_of_Week_Abbreviation
    Language_to_Text
    Language
    Languages
    Decode_Date_EU2
    Decode_Date_US2
    Parse_Date
    ISO_LC
    ISO_UC
);

%EXPORT_TAGS = (all => [@EXPORT_OK]);

##################################################
##                                              ##
##  "Version()" is available but not exported   ##
##  in order to avoid possible name clashes.    ##
##  Call "Date::Calc::PP::Version()" instead!   ##
##                                              ##
##################################################

$VERSION = '6.4';

sub Version
{
    return $VERSION;
}

#################
##             ##
##  Resources  ##
##             ##
#################

my $DateCalc_YEAR_OF_EPOCH    =   70;   # year of reference (epoch)
my $DateCalc_CENTURY_OF_EPOCH = 1900;   # century of reference (epoch)
my $DateCalc_EPOCH = $DateCalc_CENTURY_OF_EPOCH + $DateCalc_YEAR_OF_EPOCH;

my $DateCalc_DAYS_TO_EPOCH;
my $DateCalc_DAYS_TO_OVFLW;
my $DateCalc_SECS_TO_OVFLW;

## MacOS (Classic):                                            ##
## <695056.0>     = Fri  1-Jan-1904 00:00:00 (time=0x00000000) ##
## <744766.23295> = Mon  6-Feb-2040 06:28:15 (time=0xFFFFFFFF) ##

## Unix:                                                       ##
## <719163.0>     = Thu  1-Jan-1970 00:00:00 (time=0x00000000) ##
## <744018.11647> = Tue 19-Jan-2038 03:14:07 (time=0x7FFFFFFF) ##

if ($^O eq 'MacOS')
{
    $DateCalc_DAYS_TO_EPOCH = 695056;
    $DateCalc_DAYS_TO_OVFLW = 744766;
    $DateCalc_SECS_TO_OVFLW =  23295;
}
else
{
    $DateCalc_DAYS_TO_EPOCH = 719163;
    $DateCalc_DAYS_TO_OVFLW = 744018;
    $DateCalc_SECS_TO_OVFLW =  11647;
}

my(@DateCalc_Days_in_Year_) =
(
    [ 0, 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 ],
    [ 0, 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 ]
);

my(@DateCalc_Days_in_Month_) =
(
    [ 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ],
    [ 0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ]
);

my $DateCalc_LANGUAGES = 14;

my $DateCalc_Language = 1; # Default = 1 (English)

my(@DateCalc_Month_to_Text_) =
(
    [
        "???", "???", "???", "???", "???", "???", "???",
        "???", "???", "???", "???", "???", "???"
    ],
    [
        "???", "January", "February", "March", "April", "May", "June",
        "July", "August", "September", "October", "November", "December"
    ],
    [
        "???", "janvier", "février", "mars", "avril", "mai", "juin",
        "juillet", "août", "septembre", "octobre", "novembre", "décembre"
    ],
    [
        "???", "Januar", "Februar", "März", "April", "Mai", "Juni",
        "Juli", "August", "September", "Oktober", "November", "Dezember"
    ],
    [
        "???", "enero", "febrero", "marzo", "abril", "mayo", "junio",
        "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre"
    ],
    [
        "???", "janeiro", "fevereiro", "março", "abril", "maio", "junho",
        "julho", "agosto", "setembro", "outubro", "novembro", "dezembro"
    ],
    [
        "???", "januari", "februari", "maart", "april", "mei", "juni",
        "juli", "augustus", "september", "oktober", "november", "december"
    ],
    [
        "???", "Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno",
        "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre"
    ],
    [
        "???", "januar", "februar", "mars", "april", "mai", "juni",
        "juli", "august", "september", "oktober", "november", "desember"
    ],
    [
        "???", "januari", "februari", "mars", "april", "maj", "juni",
        "juli", "augusti", "september", "oktober", "november", "december"
    ],
    [
        "???", "januar", "februar", "marts", "april", "maj", "juni",
        "juli", "august", "september", "oktober", "november", "december"
    ],
    [
        "???", "tammikuu", "helmikuu", "maaliskuu", "huhtikuu",
        "toukokuu", "kesäkuu", "heinäkuu", "elokuu",
        "syyskuu", "lokakuu", "marraskuu", "joulukuu"
    ],
    [
        "???", "Január", "Február", "Március", "Április", "Május", "Június",
        "Július", "Augusztus", "Szeptember", "Október", "November", "December"
    ],
    [
        "???", "Styczen", "Luty", "Marzec", "Kwiecien", "Maj", "Czerwiec",     # ISO-Latin-1 approximation
        "Lipiec", "Sierpien", "Wrzesien", "Pazdziernik", "Listopad", "Grudzien"
    ],
    [
        "???", "Ianuarie", "Februarie", "Martie", "Aprilie", "Mai", "Iunie",
        "Iulie", "August", "Septembrie", "Octombrie", "Noiembrie", "Decembrie"
    ]
);

my(@DateCalc_Day_of_Week_to_Text_) =
(
    [
        "???", "???", "???", "???",
        "???", "???", "???", "???"
    ],
    [
        "???", "Monday", "Tuesday", "Wednesday",
        "Thursday", "Friday", "Saturday", "Sunday"
    ],
    [
        "???", "Lundi", "Mardi", "Mercredi",
        "Jeudi", "Vendredi", "Samedi", "Dimanche"
    ],
    [
        "???", "Montag", "Dienstag", "Mittwoch",
        "Donnerstag", "Freitag", "Samstag", "Sonntag"
    ],
    [
        "???", "Lunes", "Martes", "Miércoles",
        "Jueves", "Viernes", "Sábado", "Domingo"
    ],
    [
        "???", "Segunda-feira", "Terça-feira", "Quarta-feira",
        "Quinta-feira", "Sexta-feira", "Sábado", "Domingo"
    ],
    [
        "???", "Maandag", "Dinsdag", "Woensdag",
        "Donderdag", "Vrijdag", "Zaterdag", "Zondag"
    ],
    [
        "???", "Lunedì", "Martedì", "Mercoledì",
        "Giovedì", "Venerdì", "Sabato", "Domenica"
    ],
    [
        "???", "mandag", "tirsdag", "onsdag",
        "torsdag", "fredag", "lørdag", "søndag"
    ],
    [
        "???", "måndag", "tisdag", "onsdag",
        "torsdag", "fredag", "lördag", "söndag"
    ],
    [
        "???", "mandag", "tirsdag", "onsdag",
        "torsdag", "fredag", "lørdag", "søndag"
    ],
    [
        "???", "maanantai", "tiistai", "keskiviikko",
        "torstai", "perjantai", "lauantai", "sunnuntai"
    ],
    [
        "???", "hétfõ", "kedd", "szerda",
        "csütörtök", "péntek", "szombat", "vasárnap"
    ],
    [
        "???", "poniedzialek", "wtorek", "sroda",     # ISO-Latin-1 approximation
        "czwartek", "piatek", "sobota", "niedziela"
    ],
    [
        "???", "Luni", "Marti", "Miercuri",
        "Joi", "Vineri", "Sambata", "Duminica"
    ]
);

my(@DateCalc_Day_of_Week_Abbreviation_) =
(
    #  Fill the fields below _only_ if special abbreviations are needed!
    #  Note that the first field serves as a flag and must be non-empty!
    [
        "", "", "", "", "", "", "", ""    #   0  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   1  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   2  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   3  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   4  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   5  #
#       "???", "2ª", "3ª", "4ª", "5ª", "6ª", "Sáb", "Dom"    #   5  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   6  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   7  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   8  #
    ],
    [
        "", "", "", "", "", "", "", ""    #   9  #
    ],
    [
        "", "", "", "", "", "", "", ""    #  10  #
    ],
    [
        "", "", "", "", "", "", "", ""    #  11  #
    ],
    [
        "", "", "", "", "", "", "", ""    #  12  #
    ],
    [
        "???", "Pn", "Wt", "Sr", "Cz", "Pt", "So", "Ni"    #  13  #    ISO-Latin-1 approximation
    ],
    [
        "", "", "", "", "", "", "", ""    #  14  #
    ]
);

my(@DateCalc_English_Ordinals_) =
(
    "th",
    "st",
    "nd",
    "rd"
);

my(@DateCalc_Date_Long_Format_) =
(
    "%s, %d %s %d",                     #   0  Default      #
    "%s, %s %s %d",                     #   1  English      #
    "%s %d %s %d",                      #   2  Français     #
    "%s, den %d. %s %d",                #   3  Deutsch      #
    "%s, %d de %s de %d",               #   4  Español      #
    "%s, dia %d de %s de %d",           #   5  Português    #
    "%s, %d %s %d",                     #   6  Nederlands   #
    "%s, %d %s %d",                     #   7  Italiano     #
    "%s, %d. %s %d",                    #   8  Norsk        #
    "%s, %d %s %d",                     #   9  Svenska      #
    "%s, %d. %s %d",                    #  10  Dansk        #
    "%s, %d. %sta %d",                  #  11  suomi        #
    "%d. %s %d., %s",                   #  12  Magyar       #
    "%s, %d %s %d",                     #  13  polski       #
    "%s %d %s %d"                       #  14  Romaneste    #
);

my(@DateCalc_Language_to_Text_) =
(
    "???", "English", "Français", "Deutsch", "Español",
    "Português", "Nederlands", "Italiano", "Norsk", "Svenska",
    "Dansk", "suomi", "Magyar", "polski", "Romaneste"
);

###############
##           ##
##  Calc.xs  ##
##           ##
###############

###############################################################################
##                                                                           ##
##    Copyright (c) 1995 - 2015 by Steffen Beyer.                            ##
##    All rights reserved.                                                   ##
##                                                                           ##
##    This package is free software; you can redistribute it                 ##
##    and/or modify it under the same terms as Perl itself.                  ##
##                                                                           ##
###############################################################################

sub DATECALC_USAGE
{
    croak('Usage: Date::Calc::' . $_[0]);
}
sub DATECALC_ERROR
{
    croak("Date::Calc::$_[0](): $_[1]");
}
sub DATECALC_DATE_ERROR
{
    croak("Date::Calc::$_[0](): not a valid date");
}
sub DATECALC_TIME_ERROR
{
    croak("Date::Calc::$_[0](): not a valid time");
}
sub DATECALC_YEAR_ERROR
{
    croak("Date::Calc::$_[0](): year out of range");
}
sub DATECALC_MONTH_ERROR
{
    croak("Date::Calc::$_[0](): month out of range");
}
sub DATECALC_WEEK_ERROR
{
    croak("Date::Calc::$_[0](): week out of range");
}
sub DATECALC_DAYOFWEEK_ERROR
{
    croak("Date::Calc::$_[0](): day of week out of range");
}
sub DATECALC_DATE_RANGE_ERROR
{
    croak("Date::Calc::$_[0](): date out of range");
}
sub DATECALC_TIME_RANGE_ERROR
{
    croak("Date::Calc::$_[0](): time out of range");
}
sub DATECALC_FACTOR_ERROR
{
    croak("Date::Calc::$_[0](): factor out of range");
}
sub DATECALC_LANGUAGE_ERROR
{
    croak("Date::Calc::$_[0](): language not available");
}
sub DATECALC_SYSTEM_ERROR
{
    croak("Date::Calc::$_[0](): not available on this system");
}
sub DATECALC_MEMORY_ERROR
{
    croak("Date::Calc::$_[0](): unable to allocate memory");
}
sub DATECALC_STRING_ERROR
{
    croak("Date::Calc::$_[0](): argument is not a string");
}
sub DATECALC_SCALAR_ERROR
{
    croak("Date::Calc::$_[0](): argument is not a scalar");
}

sub Days_in_Year
{
    DATECALC_USAGE('Days_in_Year($year,$month)') unless (@_ == 2);
    my($year,$month) = @_;
    if ($year > 0)
    {
        if (($month >= 1) and ($month <= 12))
        {
            return $DateCalc_Days_in_Year_[DateCalc_leap_year($year)][$month+1];
        }
        else { DATECALC_MONTH_ERROR('Days_in_Year'); }
    }
    else { DATECALC_YEAR_ERROR('Days_in_Year'); }
}

sub Days_in_Month
{
    DATECALC_USAGE('Days_in_Month($year,$month)') unless (@_ == 2);
    my($year,$month) = @_;
    if ($year > 0)
    {
        if (($month >= 1) and ($month <= 12))
        {
            return $DateCalc_Days_in_Month_[DateCalc_leap_year($year)][$month];
        }
        else { DATECALC_MONTH_ERROR('Days_in_Month'); }
    }
    else { DATECALC_YEAR_ERROR('Days_in_Month'); }
}

sub Weeks_in_Year
{
    DATECALC_USAGE('Weeks_in_Year($year)') unless (@_ == 1);
    my($year) = shift;
    if ($year > 0)
    {
        return DateCalc_Weeks_in_Year($year);
    }
    else { DATECALC_YEAR_ERROR('Weeks_in_Year'); }
}

sub leap_year
{
    DATECALC_USAGE('leap_year($year)') unless (@_ == 1);
    my($year) = shift;
    if ($year > 0)
    {
        return DateCalc_leap_year($year);
    }
    else { DATECALC_YEAR_ERROR('leap_year'); }
}

sub check_date
{
    DATECALC_USAGE('check_date($year,$month,$day)') unless (@_ == 3);
    my($year,$month,$day) = @_;
    return DateCalc_check_date($year,$month,$day);
}

sub check_time
{
    DATECALC_USAGE('check_time($hour,$min,$sec)') unless (@_ == 3);
    my($hour,$min,$sec) = @_;
    return DateCalc_check_time($hour,$min,$sec);
}

sub check_business_date
{
    DATECALC_USAGE('check_business_date($year,$week,$dow)') unless (@_ == 3);
    my($year,$week,$dow) = @_;
    return DateCalc_check_business_date($year,$week,$dow);
}

sub Day_of_Year
{
    DATECALC_USAGE('Day_of_Year($year,$month,$day)') unless (@_ == 3);
    my($year,$month,$day) = @_;
    my $retval = DateCalc_Day_of_Year($year,$month,$day);
    if ($retval == 0) { DATECALC_DATE_ERROR('Day_of_Year'); }
    return $retval;
}

sub Date_to_Days
{
    DATECALC_USAGE('Date_to_Days($year,$month,$day)') unless (@_ == 3);
    my($year,$month,$day) = @_;
    my $retval = DateCalc_Date_to_Days($year,$month,$day);
    if ($retval == 0) { DATECALC_DATE_ERROR('Date_to_Days'); }
    return $retval;
}

sub Day_of_Week
{
    DATECALC_USAGE('Day_of_Week($year,$month,$day)') unless (@_ == 3);
    my($year,$month,$day) = @_;
    my $retval = DateCalc_Day_of_Week($year,$month,$day);
    if ($retval == 0) { DATECALC_DATE_ERROR('Day_of_Week'); }
    return $retval;
}

sub Week_Number
{
    DATECALC_USAGE('Week_Number($year,$month,$day)') unless (@_ == 3);
    my($year,$month,$day) = @_;
    my($retval);
    if (DateCalc_check_date($year,$month,$day))
    {
        $retval = DateCalc_Week_Number($year,$month,$day);
    }
    else { DATECALC_DATE_ERROR('Week_Number'); }
    return $retval;
}

sub Week_of_Year
{
    DATECALC_USAGE('Week_of_Year($year,$month,$day)') unless (@_ == 3);
    my($year,$month,$day) = @_;
    my($week);
    if (DateCalc_week_of_year(\$week,\$year,$month,$day))
    {
        if (wantarray) { return($week,$year); }
        else           { return $week;        }
    }
    else { DATECALC_DATE_ERROR('Week_of_Year'); }
}

sub Monday_of_Week
{
    DATECALC_USAGE('Monday_of_Week($week,$year)') unless (@_ == 2);
    my($week,$year) = @_;
    my($month,$day);
    if ($year > 0)
    {
        if (($week > 0) and ($week <= DateCalc_Weeks_in_Year($year)))
        {
            if (DateCalc_monday_of_week($week,\$year,\$month,\$day))
            {
                return($year,$month,$day);
            }
            else { DATECALC_DATE_ERROR('Monday_of_Week'); }
        }
        else { DATECALC_WEEK_ERROR('Monday_of_Week'); }
    }
    else { DATECALC_YEAR_ERROR('Monday_of_Week'); }
}

sub Nth_Weekday_of_Month_Year
{
    DATECALC_USAGE('Nth_Weekday_of_Month_Year($year,$month,$dow,$n)') unless (@_ == 4);
    my($year,$month,$dow,$n) = @_;
    my($day);
    if ($year > 0)
    {
        if (($month >= 1) and ($month <= 12))
        {
            if (($dow >= 1) and ($dow <= 7))
            {
                if (($n >= 1) and ($n <= 5))
                {
                    if (DateCalc_nth_weekday_of_month_year(\$year,\$month,\$day,$dow,$n))
                    {
                        return($year,$month,$day);
                    }
                    else { return(); }
                }
                else { DATECALC_FACTOR_ERROR('Nth_Weekday_of_Month_Year'); }
            }
            else { DATECALC_DAYOFWEEK_ERROR('Nth_Weekday_of_Month_Year'); }
        }
        else { DATECALC_MONTH_ERROR('Nth_Weekday_of_Month_Year'); }
    }
    else { DATECALC_YEAR_ERROR('Nth_Weekday_of_Month_Year'); }
}

sub Standard_to_Business
{
    DATECALC_USAGE('Standard_to_Business($year,$month,$day)') unless (@_ == 3);
    my($year,$month,$day) = @_;
    my($week,$dow);
    if (DateCalc_standard_to_business(\$year,\$week,\$dow,$month,$day))
    {
        return($year,$week,$dow);
    }
    else { DATECALC_DATE_ERROR('Standard_to_Business'); }
}

sub Business_to_Standard
{
    DATECALC_USAGE('Business_to_Standard($year,$week,$dow)') unless (@_ == 3);
    my($year,$week,$dow) = @_;
    my($month,$day);
    if (DateCalc_business_to_standard(\$year,\$month,\$day,$week,$dow))
    {
        return($year,$month,$day);
    }
    else { DATECALC_DATE_ERROR('Business_to_Standard'); }
}

sub Delta_Days
{
    DATECALC_USAGE('Delta_Days($year1,$month1,$day1,$year2,$month2,$day2)') unless (@_ == 6);
    my($year1,$month1,$day1,$year2,$month2,$day2) = @_;
    my($retval);
    if (DateCalc_check_date($year1,$month1,$day1) and
        DateCalc_check_date($year2,$month2,$day2))
    {
        $retval = DateCalc_Delta_Days($year1,$month1,$day1, $year2,$month2,$day2);
    }
    else { DATECALC_DATE_ERROR('Delta_Days'); }
    return $retval;
}

sub Delta_DHMS
{
    DATECALC_USAGE('Delta_DHMS($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2)') unless (@_ == 12);
    my($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_;
    my($Dd,$Dh,$Dm,$Ds);
    if (DateCalc_check_date($year1,$month1,$day1) and
        DateCalc_check_date($year2,$month2,$day2))
    {
        if (DateCalc_check_time($hour1,$min1,$sec1) and
            DateCalc_check_time($hour2,$min2,$sec2))
        {
            if (DateCalc_delta_dhms(\$Dd,\$Dh,\$Dm,\$Ds,
                                    $year1,$month1,$day1, $hour1,$min1,$sec1,
                                    $year2,$month2,$day2, $hour2,$min2,$sec2))
            {
                return($Dd,$Dh,$Dm,$Ds);
            }
            else { DATECALC_DATE_ERROR('Delta_DHMS'); }
        }
        else { DATECALC_TIME_ERROR('Delta_DHMS'); }
    }
    else { DATECALC_DATE_ERROR('Delta_DHMS'); }
}

sub Delta_YMD
{
    DATECALC_USAGE('Delta_YMD($year1,$month1,$day1,$year2,$month2,$day2)') unless (@_ == 6);
    my($year1,$month1,$day1,$year2,$month2,$day2) = @_;
    if (DateCalc_delta_ymd(\$year1,\$month1,\$day1, $year2,$month2,$day2))
    {
        return($year1,$month1,$day1);
    }
    else { DATECALC_DATE_ERROR('Delta_YMD'); }
}

sub Delta_YMDHMS
{
    DATECALC_USAGE('Delta_YMDHMS($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2)') unless (@_ == 12);
    my($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_;
    my($D_y,$D_m,$D_d,$Dh,$Dm,$Ds);
    if (DateCalc_check_date($year1,$month1,$day1) and
        DateCalc_check_date($year2,$month2,$day2))
    {
        if (DateCalc_check_time($hour1,$min1,$sec1) and
            DateCalc_check_time($hour2,$min2,$sec2))
        {
            if (DateCalc_delta_ymdhms(\$D_y,\$D_m,\$D_d,    \$Dh,\$Dm,\$Ds,
                                      $year1,$month1,$day1, $hour1,$min1,$sec1,
                                      $year2,$month2,$day2, $hour2,$min2,$sec2))
            {
                return($D_y,$D_m,$D_d,$Dh,$Dm,$Ds);
            }
            else { DATECALC_DATE_ERROR('Delta_YMDHMS'); }
        }
        else { DATECALC_TIME_ERROR('Delta_YMDHMS'); }
    }
    else { DATECALC_DATE_ERROR('Delta_YMDHMS'); }
}

sub N_Delta_YMD
{
    DATECALC_USAGE('N_Delta_YMD($year1,$month1,$day1,$year2,$month2,$day2)') unless (@_ == 6);
    my($year1,$month1,$day1,$year2,$month2,$day2) = @_;
    if (DateCalc_norm_delta_ymd(\$year1,\$month1,\$day1, $year2,$month2,$day2))
    {
        return($year1,$month1,$day1);
    }
    else { DATECALC_DATE_ERROR('N_Delta_YMD'); }
}

sub N_Delta_YMDHMS
{
    DATECALC_USAGE('N_Delta_YMDHMS($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2)') unless (@_ == 12);
    my($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_;
    my($D_y,$D_m,$D_d,$Dhh,$Dmm,$Dss);
    if (DateCalc_check_date($year1,$month1,$day1) and
        DateCalc_check_date($year2,$month2,$day2))
    {
        if (DateCalc_check_time($hour1,$min1,$sec1) and
            DateCalc_check_time($hour2,$min2,$sec2))
        {
            if (DateCalc_norm_delta_ymdhms(\$D_y,\$D_m,\$D_d,    \$Dhh,\$Dmm,\$Dss,
                                           $year1,$month1,$day1, $hour1,$min1,$sec1,
                                           $year2,$month2,$day2, $hour2,$min2,$sec2))
            {
                return($D_y,$D_m,$D_d,$Dhh,$Dmm,$Dss);
            }
            else { DATECALC_DATE_ERROR('N_Delta_YMDHMS'); }
        }
        else { DATECALC_TIME_ERROR('N_Delta_YMDHMS'); }
    }
    else { DATECALC_DATE_ERROR('N_Delta_YMDHMS'); }
}

sub Normalize_DHMS
{
    DATECALC_USAGE('Normalize_DHMS($Dd,$Dh,$Dm,$Ds)') unless (@_ == 4);
    my($Dd,$Dh,$Dm,$Ds) = @_;
    DateCalc_Normalize_DHMS(\$Dd,\$Dh,\$Dm,\$Ds);
    return($Dd,$Dh,$Dm,$Ds);
}

sub Add_Delta_Days
{
    DATECALC_USAGE('Add_Delta_Days($year,$month,$day,$Dd)') unless (@_ == 4);
    my($year,$month,$day,$Dd) = @_;
    if (DateCalc_add_delta_days(\$year,\$month,\$day, $Dd))
    {
        return($year,$month,$day);
    }
    else { DATECALC_DATE_ERROR('Add_Delta_Days'); }
}

sub Add_Delta_DHMS
{
    DATECALC_USAGE('Add_Delta_DHMS($year,$month,$day,$hour,$min,$sec,$Dd,$Dh,$Dm,$Ds)') unless (@_ == 10);
    my($year,$month,$day,$hour,$min,$sec,$Dd,$Dh,$Dm,$Ds) = @_;
    if (DateCalc_check_date($year,$month,$day))
    {
        if (DateCalc_check_time($hour,$min,$sec))
        {
            if (DateCalc_add_delta_dhms(\$year,\$month,\$day,
                                        \$hour,\$min,\$sec,
                                        $Dd,$Dh,$Dm,$Ds))
            {
                return($year,$month,$day,$hour,$min,$sec);
            }
            else { DATECALC_DATE_ERROR('Add_Delta_DHMS'); }
        }
        else { DATECALC_TIME_ERROR('Add_Delta_DHMS'); }
    }
    else { DATECALC_DATE_ERROR('Add_Delta_DHMS'); }
}

sub Add_Delta_YM
{
    DATECALC_USAGE('Add_Delta_YM($year,$month,$day,$Dy,$Dm)') unless (@_ == 5);
    my($year,$month,$day,$Dy,$Dm) = @_;
    if (DateCalc_add_delta_ym(\$year,\$month,\$day, $Dy,$Dm))
    {
        return($year,$month,$day);
    }
    else { DATECALC_DATE_ERROR('Add_Delta_YM'); }
}

sub Add_Delta_YMD
{
    DATECALC_USAGE('Add_Delta_YMD($year,$month,$day,$Dy,$Dm,$Dd)') unless (@_ == 6);
    my($year,$month,$day,$Dy,$Dm,$Dd) = @_;
    if (DateCalc_add_delta_ymd(\$year,\$month,\$day, $Dy,$Dm,$Dd))
    {
        return($year,$month,$day);
    }
    else { DATECALC_DATE_ERROR('Add_Delta_YMD'); }
}

sub Add_Delta_YMDHMS
{
    DATECALC_USAGE('Add_Delta_YMDHMS($year,$month,$day,$hour,$min,$sec,$D_y,$D_m,$D_d,$Dh,$Dm,$Ds)') unless (@_ == 12);
    my($year,$month,$day,$hour,$min,$sec,$D_y,$D_m,$D_d,$Dh,$Dm,$Ds) = @_;
    if (DateCalc_check_date($year,$month,$day))
    {
        if (DateCalc_check_time($hour,$min,$sec))
        {
            if (DateCalc_add_delta_ymdhms(\$year,\$month,\$day,
                                          \$hour,\$min,\$sec,
                                          $D_y,$D_m,$D_d,
                                          $Dh,$Dm,$Ds))
            {
                return($year,$month,$day,$hour,$min,$sec);
            }
            else { DATECALC_DATE_ERROR('Add_Delta_YMDHMS'); }
        }
        else { DATECALC_TIME_ERROR('Add_Delta_YMDHMS'); }
    }
    else { DATECALC_DATE_ERROR('Add_Delta_YMDnMS'); }
}

sub Add_N_Delta_YMD
{
    DATECALC_USAGE('Add_N_Delta_YMD($year,$month,$day,$Dy,$Dm,$Dd)') unless (@_ == 6);
    my($year,$month,$day,$Dy,$Dm,$Dd) = @_;
    if (DateCalc_add_norm_delta_ymd(\$year,\$month,\$day, $Dy,$Dm,$Dd))
    {
        return($year,$month,$day);
    }
    else { DATECALC_DATE_ERROR('Add_N_Delta_YMD'); }
}

sub Add_N_Delta_YMDHMS
{
    DATECALC_USAGE('Add_N_Delta_YMDHMS($year,$month,$day,$hour,$min,$sec,$D_y,$D_m,$D_d,$Dhh,$Dmm,$Dss)') unless (@_ == 12);
    my($year,$month,$day,$hour,$min,$sec,$D_y,$D_m,$D_d,$Dhh,$Dmm,$Dss) = @_;
    if (DateCalc_check_date($year,$month,$day))
    {
        if (DateCalc_check_time($hour,$min,$sec))
        {
            if (DateCalc_add_norm_delta_ymdhms(\$year,\$month,\$day,
                                               \$hour,\$min,\$sec,
                                               $D_y,$D_m,$D_d,
                                               $Dhh,$Dmm,$Dss))
            {
                return($year,$month,$day,$hour,$min,$sec);
            }
            else { DATECALC_DATE_ERROR('Add_N_Delta_YMDHMS'); }
        }
        else { DATECALC_TIME_ERROR('Add_N_Delta_YMDHMS'); }
    }
    else { DATECALC_DATE_ERROR('Add_N_Delta_YMDHMS'); }
}

sub System_Clock
{
    DATECALC_USAGE('System_Clock([$gmt])') unless ((@_ == 0) or (@_ == 1));
    my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt);
    if (@_ == 1) { $gmt = shift; }
    else         { $gmt =     0; }
    if (DateCalc_system_clock(\$year,\$month,\$day,
                              \$hour,\$min,\$sec,
                              \$doy,\$dow,\$dst,
                              $gmt))
    {
        return($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst);
    }
    else { DATECALC_SYSTEM_ERROR('System_Clock'); }
}

sub Today
{
    DATECALC_USAGE('Today([$gmt])') unless ((@_ == 0) or (@_ == 1));
    my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt);
    if (@_ == 1) { $gmt = shift; }
    else         { $gmt =     0; }
    if (DateCalc_system_clock(\$year,\$month,\$day,
                              \$hour,\$min,\$sec,
                              \$doy,\$dow,\$dst,
                              $gmt))
    {
        return($year,$month,$day);
    }
    else { DATECALC_SYSTEM_ERROR('Today'); }
}

sub Now
{
    DATECALC_USAGE('Now([$gmt])') unless ((@_ == 0) or (@_ == 1));
    my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt);
    if (@_ == 1) { $gmt = shift; }
    else         { $gmt =     0; }
    if (DateCalc_system_clock(\$year,\$month,\$day,
                              \$hour,\$min,\$sec,
                              \$doy,\$dow,\$dst,
                              $gmt))
    {
        return($hour,$min,$sec);
    }
    else { DATECALC_SYSTEM_ERROR('Now'); }
}

sub Today_and_Now
{
    DATECALC_USAGE('Today_and_Now([$gmt])') unless ((@_ == 0) or (@_ == 1));
    my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt);
    if (@_ == 1) { $gmt = shift; }
    else         { $gmt =     0; }
    if (DateCalc_system_clock(\$year,\$month,\$day,
                              \$hour,\$min,\$sec,
                              \$doy,\$dow,\$dst,
                              $gmt))
    {
        return($year,$month,$day,$hour,$min,$sec);
    }
    else { DATECALC_SYSTEM_ERROR('Today_and_Now'); }
}

sub This_Year
{
    DATECALC_USAGE('This_Year([$gmt])') unless ((@_ == 0) or (@_ == 1));
    my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt);
    if (@_ == 1) { $gmt = shift; }
    else         { $gmt =     0; }
    if (DateCalc_system_clock(\$year,\$month,\$day,
                              \$hour,\$min,\$sec,
                              \$doy,\$dow,\$dst,
                              $gmt))
    {
        return($year);
    }
    else { DATECALC_SYSTEM_ERROR('This_Year'); }
}

sub Gmtime
{
    DATECALC_USAGE('Gmtime([time])') unless ((@_ == 0) or (@_ == 1));
    my($seconds,$year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst);
    if (@_ == 1) { $seconds = shift; }
    else         { $seconds =  time; }
    if (($seconds < 0) or ($seconds > 0xFFFFFFFF)) { DATECALC_TIME_RANGE_ERROR('Gmtime'); }
    if (DateCalc_gmtime(\$year,\$month,\$day,
                        \$hour,\$min,\$sec,
                        \$doy,\$dow,\$dst,
                        $seconds))
    {
        return($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst);
    }
    else { DATECALC_TIME_RANGE_ERROR('Gmtime'); }
}

sub Localtime
{
    DATECALC_USAGE('Localtime([time])') unless ((@_ == 0) or (@_ == 1));
    my($seconds,$year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst);
    if (@_ == 1) { $seconds = shift; }
    else         { $seconds =  time; }
    if (($seconds < 0) or ($seconds > 0xFFFFFFFF)) { DATECALC_TIME_RANGE_ERROR('Localtime'); }
    if (DateCalc_localtime(\$year,\$month,\$day,
                           \$hour,\$min,\$sec,
                           \$doy,\$dow,\$dst,
                           $seconds))
    {
        return($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst);
    }
    else { DATECALC_TIME_RANGE_ERROR('Localtime'); }
}

sub Mktime
{
    DATECALC_USAGE('Mktime($year,$month,$day,$hour,$min,$sec)') unless (@_ == 6);
    my($year,$month,$day,$hour,$min,$sec) = @_;
    my($seconds);
    if (DateCalc_mktime(\$seconds, $year,$month,$day, $hour,$min,$sec, -1,-1,-1))
    {
        return $seconds;
    }
    else { DATECALC_DATE_RANGE_ERROR('Mktime'); }
}

sub Timezone
{
    DATECALC_USAGE('Timezone([time])') unless ((@_ == 0) or (@_ == 1));
    my($when,$year,$month,$day,$hour,$min,$sec,$dst);
    if (@_ == 1) { $when = shift; }
    else         { $when =  time; }
    if (($when < 0) or ($when > 0xFFFFFFFF)) { DATECALC_TIME_RANGE_ERROR('Timezone'); }
    if (DateCalc_timezone(\$year,\$month,\$day,
                          \$hour,\$min,\$sec,
                          \$dst,$when))
    {
        return($year,$month,$day,$hour,$min,$sec,$dst);
    }
    else { DATECALC_TIME_RANGE_ERROR('Timezone'); }
}

sub Date_to_Time
{
    DATECALC_USAGE('Date_to_Time($year,$month,$day,$hour,$min,$sec)') unless (@_ == 6);
    my($year,$month,$day,$hour,$min,$sec) = @_;
    my($seconds);
    if (DateCalc_date2time(\$seconds, $year,$month,$day, $hour,$min,$sec))
    {
        return $seconds;
    }
    else { DATECALC_DATE_RANGE_ERROR('Date_to_Time'); }
}

sub Time_to_Date
{
    DATECALC_USAGE('Time_to_Date([time])') unless ((@_ == 0) or (@_ == 1));
    my($seconds,$year,$month,$day,$hour,$min,$sec);
    if (@_ == 1) { $seconds = shift; }
    else         { $seconds =  time; }
    if (($seconds < 0) or ($seconds > 0xFFFFFFFF)) { DATECALC_TIME_RANGE_ERROR('Time_to_Date'); }
    if (DateCalc_time2date(\$year,\$month,\$day, \$hour,\$min,\$sec, $seconds))
    {
        return($year,$month,$day,$hour,$min,$sec);
    }
    else { DATECALC_TIME_RANGE_ERROR('Time_to_Date'); }
}

sub Easter_Sunday
{
    DATECALC_USAGE('Easter_Sunday($year)') unless (@_ == 1);
    my($year) = shift;
    my($month,$day);
    if (($year > 0) and DateCalc_easter_sunday(\$year,\$month,\$day))
    {
        return($year,$month,$day);
    }
    else { DATECALC_YEAR_ERROR('Easter_Sunday'); }
}

sub Decode_Month
{
    DATECALC_USAGE('Decode_Month($string[,$lang])') unless ((@_ == 1) or (@_ == 2));
    my($string) = shift;
    my($lang)   = shift || 0;
    return DateCalc_Decode_Month($string,$lang);
}

sub Decode_Day_of_Week
{
    DATECALC_USAGE('Decode_Day_of_Week($string[,$lang])') unless ((@_ == 1) or (@_ == 2));
    my($string) = shift;
    my($lang)   = shift || 0;
    return DateCalc_Decode_Day_of_Week($string,$lang);
}

sub Decode_Language
{
    DATECALC_USAGE('Decode_Language($string)') unless (@_ == 1);
    my($string) = shift;
    return DateCalc_Decode_Language($string);
}

sub Decode_Date_EU
{
    DATECALC_USAGE('Decode_Date_EU($string[,$lang])') unless ((@_ == 1) or (@_ == 2));
    my($string) = shift;
    my($lang)   = shift || 0;
    my($year,$month,$day);
    if (DateCalc_decode_date_eu($string,\$year,\$month,\$day,$lang))
    {
        return($year,$month,$day);
    }
    else { return(); }
}

sub Decode_Date_US
{
    DATECALC_USAGE('Decode_Date_US($string[,$lang])') unless ((@_ == 1) or (@_ == 2));
    my($string) = shift;
    my($lang)   = shift || 0;
    my($year,$month,$day);
    if (DateCalc_decode_date_us($string,\$year,\$month,\$day,$lang))
    {
        return($year,$month,$day);
    }
    else { return(); }
}

sub Fixed_Window
{
    DATECALC_USAGE('Fixed_Window($year)') unless (@_ == 1);
    my($year) = shift;
    return DateCalc_Fixed_Window($year);
}

sub Moving_Window
{
    DATECALC_USAGE('Moving_Window($year)') unless (@_ == 1);
    my($year) = shift;
    return DateCalc_Moving_Window($year);
}

sub Compress
{
    DATECALC_USAGE('Compress($year,$month,$day)') unless (@_ == 3);
    my($year,$month,$day) = @_;
    return DateCalc_Compress($year,$month,$day);
}

sub Uncompress
{
    DATECALC_USAGE('Uncompress($date)') unless (@_ == 1);
    my($date) = shift;
    my($century,$year,$month,$day);
    if (DateCalc_uncompress($date,\$century,\$year,\$month,\$day))
    {
        return($century,$year,$month,$day);
    }
    else { return(); }
}

sub check_compressed
{
    DATECALC_USAGE('check_compressed($date)') unless (@_ == 1);
    my($date) = shift;
    return DateCalc_check_compressed($date);
}

sub Compressed_to_Text
{
    DATECALC_USAGE('Compressed_to_Text($date[,$lang])') unless ((@_ == 1) or (@_ == 2));
    my($date) = shift;
    my($lang) = shift || 0;
    return DateCalc_Compressed_to_Text($date,$lang);
}

sub Date_to_Text
{
    DATECALC_USAGE('Date_to_Text($year,$month,$day[,$lang])') unless ((@_ == 3) or (@_ == 4));
    my($year)  = shift;
    my($month) = shift;
    my($day)   = shift;
    my($lang)  = shift || 0;
    if (DateCalc_check_date($year,$month,$day))
    {
        return DateCalc_Date_to_Text($year,$month,$day,$lang);
    }
    else { DATECALC_DATE_ERROR('Date_to_Text'); }
}

sub Date_to_Text_Long
{
    DATECALC_USAGE('Date_to_Text_Long($year,$month,$day[,$lang])') unless ((@_ == 3) or (@_ == 4));
    my($year)  = shift;
    my($month) = shift;
    my($day)   = shift;
    my($lang)  = shift || 0;
    if (DateCalc_check_date($year,$month,$day))
    {
        return DateCalc_Date_to_Text_Long($year,$month,$day,$lang);
    }
    else { DATECALC_DATE_ERROR('Date_to_Text_Long'); }
}

sub English_Ordinal
{
    DATECALC_USAGE('English_Ordinal($number)') unless (@_ == 1);
    my($number) = shift;
    return DateCalc_English_Ordinal($number);
}

sub Calendar
{
    DATECALC_USAGE('Calendar($year,$month[,$orthodox[,$lang]])') if ((@_ < 2) or (@_ > 4));
    my($year)  = shift;
    my($month) = shift;
    my($orthodox,$lang);
    if    (@_ == 2) { $orthodox = shift; $lang = shift; }
    elsif (@_ == 1) { $orthodox = shift; $lang =     0; }
    else            { $orthodox =     0; $lang =     0; }
    if ($year > 0)
    {
        if (($month >= 1) and ($month <= 12))
        {
            return DateCalc_Calendar($year,$month,$orthodox,$lang);
        }
        else { DATECALC_MONTH_ERROR('Calendar'); }
    }
    else { DATECALC_YEAR_ERROR('Calendar'); }
}

sub Month_to_Text
{
    DATECALC_USAGE('Month_to_Text($month[,$lang])') unless ((@_ == 1) or (@_ == 2));
    my($month) = shift;
    my($lang)  = shift || 0;
    if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)) { $lang = $DateCalc_Language; }
    if (($month >= 1) and ($month <= 12))
    {
        return $DateCalc_Month_to_Text_[$lang][$month];
    }
    else { DATECALC_MONTH_ERROR('Month_to_Text'); }
}

sub Day_of_Week_to_Text
{
    DATECALC_USAGE('Day_of_Week_to_Text($dow[,$lang])') unless ((@_ == 1) or (@_ == 2));
    my($dow)  = shift;
    my($lang) = shift || 0;
    if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)) { $lang = $DateCalc_Language; }
    if (($dow >= 1) and ($dow <= 7))
    {
        return $DateCalc_Day_of_Week_to_Text_[$lang][$dow];
    }
    else { DATECALC_DAYOFWEEK_ERROR('Day_of_Week_to_Text'); }
}

sub Day_of_Week_Abbreviation
{
    DATECALC_USAGE('Day_of_Week_Abbreviation($dow[,$lang])') unless ((@_ == 1) or (@_ == 2));
    my($dow)  = shift;
    my($lang) = shift || 0;
    if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)) { $lang = $DateCalc_Language; }
    if (($dow >= 1) and ($dow <= 7))
    {
        if ($DateCalc_Day_of_Week_Abbreviation_[$lang][0] ne '')
        {
            return $DateCalc_Day_of_Week_Abbreviation_[$lang][$dow];
        }
        else
        {
            return substr($DateCalc_Day_of_Week_to_Text_[$lang][$dow],0,3);
        }
    }
    else { DATECALC_DAYOFWEEK_ERROR('Day_of_Week_Abbreviation'); }
}

sub Language_to_Text
{
    DATECALC_USAGE('Language_to_Text($lang)') unless (@_ == 1);
    my($lang) = shift;
    if (($lang >= 1) and ($lang <= $DateCalc_LANGUAGES))
    {
        return $DateCalc_Language_to_Text_[$lang];
    }
    else { DATECALC_LANGUAGE_ERROR('Language_to_Text'); }
}

sub Language
{
    DATECALC_USAGE('Language([$lang])') unless ((@_ == 0) or (@_ == 1));
    my($retval) = $DateCalc_Language;
    my($lang);
    if (@_ == 1)
    {
        $lang = shift || 0;
        if (($lang >= 1) and ($lang <= $DateCalc_LANGUAGES))
        {
            $DateCalc_Language = $lang;
        }
        else { DATECALC_LANGUAGE_ERROR('Language'); }
    }
    return $retval;
}

sub Languages
{
    DATECALC_USAGE('Languages()') unless (@_ == 0);
    return $DateCalc_LANGUAGES;
}

sub ISO_LC
{
    DATECALC_USAGE('ISO_LC($string)') unless (@_ == 1);
    my($string) = shift;
    $string =~ s!([\x41-\x5A\xC0-\xD6\xD8-\xDE])!chr(ord($1)+0x20)!ge;
    return $string;
}

sub ISO_UC
{
    DATECALC_USAGE('ISO_UC($string)') unless (@_ == 1);
    my($string) = shift;
    $string =~ s!([\x61-\x7A\xE0-\xF6\xF8-\xFE])!chr(ord($1)-0x20)!ge;
    return $string;
}

##################
##              ##
##  DateCalc.c  ##
##              ##
##################

########################
## Private functions: ##
########################

sub DateCalc_is_digit
{
    return 1 if ($_[0] =~ /^[0-9]+$/);
    return 0;
}

sub DateCalc_is_alnum
{
    return 1 if ($_[0] =~ /^[\x30-\x39\x41-\x5A\x61-\x7A\xC0-\xD6\xD8-\xF6\xF8-\xFF]+$/);
    return 0;
}

sub DateCalc_ISO_LC
{
    my($char) = $_[0];
    $char =~ s!([\x41-\x5A\xC0-\xD6\xD8-\xDE])!chr(ord($1)+0x20)!ge;
    return $char;
}

sub DateCalc_ISO_UC
{
    my($char) = $_[0];
    $char =~ s!([\x61-\x7A\xE0-\xF6\xF8-\xFE])!chr(ord($1)-0x20)!ge;
    return $char;
}

sub DateCalc_ISO_UC_First
{
    my($string) = $_[0];
    $string =~ s!([\x41-\x5A\xC0-\xD6\xD8-\xDE])!chr(ord($1)+0x20)!ge;
    $string =~ s!^([\x61-\x7A\xE0-\xF6\xF8-\xFE])!chr(ord($1)-0x20)!e;
    return $string;
}

sub DateCalc_Year_to_Days
{
    my($year) = $_[0];
    my($days) = $year * 365;
    $year >>= 2;
    $days += $year;
    $year = int($year / 25);
    $days -= $year;
    $days += ($year >>  2);
    return $days;
}

sub DateCalc_scan9
{   ## Mnemonic: COBOL "PIC 9" ##
    my($str,$buf,$len,$idx,$neg) = @_;
    $idx += $buf;
    $len += $buf;
    if (($idx >= 0) and ($idx < $len)) { return DateCalc_is_digit(substr($str,$idx,1)) ^ $neg; }
    return 0;
}

sub DateCalc_scanx
{   ## Mnemonic: COBOL "PIC X" ##
    my($str,$buf,$len,$idx,$neg) = @_;
    $idx += $buf;
    $len += $buf;
    if (($idx >= 0) and ($idx < $len)) { return DateCalc_is_alnum(substr($str,$idx,1)) ^ $neg; }
    return 0;
}

sub DateCalc_Center
{
    my($_target,$source,$width) = @_;
    my($length,$blank);
    $length = length($source);
    $length = $width if ($length > $width);
    $blank = $width - $length;
    $blank >>= 1;
    $$_target .= ' ' x $blank;
    $$_target .= substr($source,0,$length);
    $$_target .= "\n";
}

sub DateCalc_Blank
{
    my($_target,$count) = @_;
    $$_target .= ' ' x $count;
}

sub DateCalc_Newline
{
    my($_target,$count) = @_;
    $$_target .= "\n" x $count;
}

sub DateCalc_Normalize_Time
{
    my($_Dd,$_Dh,$_Dm,$_Ds) = @_;
    my($quot);
    $quot = int($$_Ds / 60);
    $$_Ds -= $quot * 60;
    $$_Dm += $quot;
    $quot = int($$_Dm / 60);
    $$_Dm -= $quot * 60;
    $$_Dh += $quot;
    $quot = int($$_Dh / 24);
    $$_Dh -= $quot * 24;
    $$_Dd += $quot;
}

## Prevent overflow errors on systems ##
## with short "long"s (e.g. 32 bits): ##

sub DateCalc_Normalize_Ranges
{
    my($_Dd,$_Dh,$_Dm,$_Ds) = @_;
    my($quot);
    $quot = int($$_Dh / 24);
    $$_Dh -= $quot * 24;
    $$_Dd += $quot;
    $quot = int($$_Dm / 60);
    $$_Dm -= $quot * 60;
    $$_Dh += $quot;
    DateCalc_Normalize_Time($_Dd,$_Dh,$_Dm,$_Ds);
}

# $_Dh and $_Dm are assumed to be empty;
# the whole time part must be in $_Ds:

sub DateCalc_Normalize_Signs
{
    my($_Dd,$_Dh,$_Dm,$_Ds) = @_;
    my($quot);
    $quot = int($$_Ds / 86400);
    $$_Ds -= $quot * 86400;
    $$_Dd += $quot;
    if ($$_Dd != 0)
    {
        if ($$_Dd > 0)
        {
            if ($$_Ds < 0)
            {
                $$_Ds += 86400;
                ${$_Dd}--;
            }
        }
        else
        {
            if ($$_Ds > 0)
            {
                $$_Ds -= 86400;
                ${$_Dd}++;
            }
        }
    }
    $$_Dh = 0;
    $$_Dm = 0;
    if ($$_Ds != 0) { DateCalc_Normalize_Time($_Dd,$_Dh,$_Dm,$_Ds); }
}

sub DateCalc_Normalize_DHMS
{
    my($_Dd,$_Dh,$_Dm,$_Ds) = @_;
    DateCalc_Normalize_Ranges($_Dd,$_Dh,$_Dm,$_Ds);
    $$_Ds += (($$_Dh * 60) + $$_Dm) * 60;
    DateCalc_Normalize_Signs($_Dd,$_Dh,$_Dm,$_Ds);
}

#######################
## Public functions: ##
#######################

sub DateCalc_leap_year
{
    my($year) = $_[0];
    my($yy);
    return( (($year & 0x03) == 0) and
            ( ((($yy = int($year / 100)) * 100) != $year) or
                (($yy & 0x03) == 0) ) );
}

sub DateCalc_check_date
{
    my($year,$month,$day) = @_;
    return 1 if
        (($year  >= 1) and
         ($month >= 1) and ($month <= 12) and
         ($day   >= 1) and
         ($day   <= $DateCalc_Days_in_Month_[DateCalc_leap_year($year)][$month]));
    return 0;
}

sub DateCalc_check_time
{
    my($hour,$min,$sec) = @_;
    return 1 if
        (($hour >= 0) and ($min >= 0) and ($sec >= 0) and
         ($hour < 24) and ($min < 60) and ($sec < 60));
    return 0;
}

sub DateCalc_check_business_date
{
    my($year,$week,$dow) = @_;
    return 1 if
        (($year >= 1) and
         ($week >= 1) and ($week <= DateCalc_Weeks_in_Year($year)) and
         ($dow  >= 1) and ($dow <= 7));
    return 0;
}

sub DateCalc_Day_of_Year
{
    my($year,$month,$day) = @_;
    my($leap);
    if (($year  >= 1) and
        ($month >= 1) and ($month <= 12) and
        ($day   >= 1) and
        ($day   <= $DateCalc_Days_in_Month_[($leap=DateCalc_leap_year($year))][$month]))
    {
        return $DateCalc_Days_in_Year_[$leap][$month] + $day;
    }
    return 0;
}

sub DateCalc_Date_to_Days
{
    my($year,$month,$day) = @_;
    my($leap);
    if (($year  >= 1) and
        ($month >= 1) and ($month <= 12) and
        ($day   >= 1) and
        ($day   <= $DateCalc_Days_in_Month_[($leap=DateCalc_leap_year($year))][$month]))
    {
        return DateCalc_Year_to_Days(--$year)
             + $DateCalc_Days_in_Year_[$leap][$month]
             + $day;
    }
    return 0;
}

sub DateCalc_Day_of_Week
{
    my($year,$month,$day) = @_;
    my($days);
    $days = DateCalc_Date_to_Days($year,$month,$day);
    if ($days > 0)
    {
        $days--;
        $days %= 7;
        $days++;
    }
    return $days;
}

sub DateCalc_Weeks_in_Year
{
    my($year) = $_[0];
    if ((DateCalc_Day_of_Week($year,1,1)   == 4) or
        (DateCalc_Day_of_Week($year,12,31) == 4))
        { return 53; }
    else
        { return 52; }
}

sub DateCalc_Week_Number
{
    my($year,$month,$day) = @_;
    my($first,$week);
    $first = DateCalc_Day_of_Week($year,1,1) - 1;
    $week = int((DateCalc_Delta_Days($year,1,1, $year,$month,$day) + $first) / 7);
    if ($first < 4) { return ++$week; }
    else            { return   $week; }
}

sub DateCalc_week_of_year
{
    my($_week,$_year,$month,$day) = @_;
    if (DateCalc_check_date($$_year,$month,$day))
    {
        $$_week = DateCalc_Week_Number($$_year,$month,$day);
        if ($$_week == 0) { $$_week = DateCalc_Weeks_in_Year(--${$_year}); }
        elsif ($$_week > DateCalc_Weeks_in_Year($$_year))
        {
            $$_week = 1;
            ${$_year}++;
        }
        return 1;
    }
    return 0;
}

sub DateCalc_monday_of_week
{
    my($week,$_year,$_month,$_day) = @_;
    my($first);
    $$_month = $$_day = 1;
    $first = DateCalc_Day_of_Week($$_year,1,1) - 1;
    $week-- if ($first < 4);
    return DateCalc_add_delta_days($_year,$_month,$_day, ($week * 7 - $first));
}

sub DateCalc_nth_weekday_of_month_year
{
    my($_year,$_month,$_day,$dow,$n) = @_;
    my($mm) = $$_month;
    my($first,$delta);
    $$_day = 1;
    return 0 if
        (($$_year < 1) or
         ($mm     < 1) or ($mm  > 12) or
         ($dow    < 1) or ($dow >  7) or
         ($n      < 1) or ($n   >  5));
    $first = DateCalc_Day_of_Week($$_year,$mm,1);
    $dow += 7 if ($dow < $first);
    $delta = $dow - $first;
    $delta += --$n * 7;
    return 1 if (DateCalc_add_delta_days($_year,$_month,$_day,$delta) and ($$_month == $mm));
    return 0;
}

sub DateCalc_standard_to_business
{
    my($_year,$_week,$_dow,$month,$day) = @_;
    my($yy) = $$_year;

    if (DateCalc_week_of_year($_week,$_year,$month,$day))
    {
        $$_dow = DateCalc_Day_of_Week($yy,$month,$day);
        return 1;
    }
    return 0;
}

sub DateCalc_business_to_standard
{
    my($_year,$_month,$_day,$week,$dow) = @_;
    my($first,$delta);
    if (DateCalc_check_business_date($$_year,$week,$dow))
    {
        $$_month = $$_day = 1;
        $first = DateCalc_Day_of_Week($$_year,1,1);
        $week++ if ($first > 4);
        $delta = --$week * 7 + $dow - $first;
        return DateCalc_add_delta_days($_year,$_month,$_day,$delta);
    }
    return 0;
}

sub DateCalc_Delta_Days
{
    return DateCalc_Date_to_Days(@_[3..5]) -
           DateCalc_Date_to_Days(@_[0..2]);
}

sub DateCalc_delta_hms
{
    my($_Dd,$_Dh,$_Dm,$_Ds,$hour1,$min1,$sec1,$hour2,$min2,$sec2) = @_;
    if (DateCalc_check_time($hour1,$min1,$sec1) and
        DateCalc_check_time($hour2,$min2,$sec2))
    {
        $$_Ds = (((($hour2 * 60) + $min2) * 60) + $sec2) -
                (((($hour1 * 60) + $min1) * 60) + $sec1);
        DateCalc_Normalize_Signs($_Dd,$_Dh,$_Dm,$_Ds);
        return 1;
    }
    return 0;
}

sub DateCalc_delta_dhms
{
    my($_Dd,$_Dh,$_Dm,$_Ds,$year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_;
    $$_Dd = $$_Dh = $$_Dm = $$_Ds = 0;
    if (DateCalc_check_date($year1,$month1,$day1) and
        DateCalc_check_date($year2,$month2,$day2))
    {
        $$_Dd = DateCalc_Delta_Days($year1,$month1,$day1, $year2,$month2,$day2);
        return DateCalc_delta_hms($_Dd,$_Dh,$_Dm,$_Ds, $hour1,$min1,$sec1, $hour2,$min2,$sec2);
    }
    return 0;
}

sub DateCalc_delta_ymd
{
    my($_year1,$_month1,$_day1,$year2,$month2,$day2) = @_;
    if (DateCalc_check_date($$_year1,$$_month1,$$_day1) and
        DateCalc_check_date(  $year2,  $month2,  $day2))
    {
        $$_day1   = $day2   - $$_day1;
        $$_month1 = $month2 - $$_month1;
        $$_year1  = $year2  - $$_year1;
        return 1;
    }
    return 0;
}

sub DateCalc_delta_ymdhms
{
    my($_D_y,$_D_m,$_D_d,$_Dh,$_Dm,$_Ds,$year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_;
    return 0 unless (DateCalc_delta_ymd(\$year1,\$month1,\$day1, $year2,$month2,$day2));
    $$_D_d = $day1;
    return 0 unless (DateCalc_delta_hms($_D_d,$_Dh,$_Dm,$_Ds, $hour1,$min1,$sec1, $hour2,$min2,$sec2));
    $$_D_y = $year1;
    $$_D_m = $month1;
    return 1;
}

sub DateCalc_norm_delta_ymd
{
    my($_year1,$_month1,$_day1,$year2,$month2,$day2) = @_;
    my($Dy) = 0;
    my($Dm) = 0;
    my($Dd) = 0;
    my($d2,$ty,$tm,$td);

    if (DateCalc_check_date($$_year1,$$_month1,$$_day1) and
        DateCalc_check_date(  $year2,  $month2,  $day2))
    {
        $d2 =     DateCalc_Date_to_Days(  $year2,  $month2,  $day2);
        $Dd = $d2-DateCalc_Date_to_Days($$_year1,$$_month1,$$_day1);
        if (($Dd < -30) or ($Dd > 30))
        {
            $Dy = ($year2  - $$_year1);
            $Dm = ($month2 - $$_month1);
            $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td);
            unless ((($Dy >= 0) and ($Dm >= 0) and ($Dd >= 0)) or
                    (($Dy <= 0) and ($Dm <= 0) and ($Dd <= 0)))
            {
                if    (($Dy < 0) and ($Dm > 0)) { $Dy++; $Dm -= 12; }
                elsif (($Dy > 0) and ($Dm < 0)) { $Dy--; $Dm += 12; }
                if    (($Dm < 0) and ($Dd > 0)) { $Dm++; $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                elsif (($Dm > 0) and ($Dd < 0)) { $Dm--; $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                if    (($Dy < 0) and ($Dd > 0)) { $Dy++; $Dm -= 12; }
                elsif (($Dy > 0) and ($Dd < 0)) { $Dy--; $Dm += 12; }
                if    (($Dm < 0) and ($Dd > 0)) { $Dm++; $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                elsif (($Dm > 0) and ($Dd < 0)) { $Dm--; $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
            }
        }
        $$_year1  = $Dy;
        $$_month1 = $Dm;
        $$_day1   = $Dd;
        return 1;
    }
    return 0;
}

sub DateCalc_norm_delta_ymdhms
{
    my($_D_y,$_D_m,$_D_d,$_Dhh,$_Dmm,$_Dss,$year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_;
    my($Dy) = 0;
    my($Dm) = 0;
    my($Dd) = 0;
    my($d2,$ty,$tm,$td,$hh,$mm,$ss);
    if (DateCalc_check_date($year1,$month1,$day1) and
        DateCalc_check_time($hour1,$min1,  $sec1) and
        DateCalc_check_date($year2,$month2,$day2) and
        DateCalc_check_time($hour1,$min2,  $sec2))
    {
        $ss = ( ($hour2-$hour1) * 60 + ($min2-$min1) ) * 60 + ($sec2-$sec1);
        $d2 =     DateCalc_Date_to_Days($year2,$month2,$day2);
        $Dd = $d2-DateCalc_Date_to_Days($year1,$month1,$day1);
        if (($Dd < -30) or ($Dd > 30))
        {
            $Dy = $year2  - $year1;
            $Dm = $month2 - $month1;
            $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td);
            unless ((($Dy >= 0) and ($Dm >= 0) and ($Dd >= 0) and ($ss >= 0)) or
                    (($Dy <= 0) and ($Dm <= 0) and ($Dd <= 0) and ($ss <= 0)))
            {
                if    (($Dy < 0) and ($Dm > 0)) { $Dy++; $Dm -= 12; }
                elsif (($Dy > 0) and ($Dm < 0)) { $Dy--; $Dm += 12; }
                if    (($Dm < 0) and ($Dd > 0)) { $Dm++; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                elsif (($Dm > 0) and ($Dd < 0)) { $Dm--; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                if    (($Dy < 0) and ($Dd > 0)) { $Dy++; $Dm -= 12; }
                elsif (($Dy > 0) and ($Dd < 0)) { $Dy--; $Dm += 12; }
                if    (($Dm < 0) and ($Dd > 0)) { $Dm++; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                elsif (($Dm > 0) and ($Dd < 0)) { $Dm--; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                if    (($Dd < 0) and ($ss > 0)) { $Dd++; $ss -= 86400; }
                elsif (($Dd > 0) and ($ss < 0)) { $Dd--; $ss += 86400; }
                if    (($Dm < 0) and ($ss > 0)) { $Dm++; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                elsif (($Dm > 0) and ($ss < 0)) { $Dm--; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                if    (($Dy < 0) and ($ss > 0)) { $Dy++; $Dm -= 12; }
                elsif (($Dy > 0) and ($ss < 0)) { $Dy--; $Dm += 12; }
                if    (($Dm < 0) and ($ss > 0)) { $Dm++; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                elsif (($Dm > 0) and ($ss < 0)) { $Dm--; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); }
                if    (($Dd < 0) and ($ss > 0)) { $Dd++; $ss -= 86400; }
                elsif (($Dd > 0) and ($ss < 0)) { $Dd--; $ss += 86400; }
            }
        }
        else
        {
            if    (($Dd < 0) and ($ss > 0)) { $Dd++; $ss -= 86400; }
            elsif (($Dd > 0) and ($ss < 0)) { $Dd--; $ss += 86400; }
        }
        $mm = int( $ss / 60 );
        $ss -= $mm * 60;
        $hh = int( $mm / 60 );
        $mm -= $hh * 60;
        $$_D_y = $Dy;
        $$_D_m = $Dm;
        $$_D_d = $Dd;
        $$_Dhh = $hh;
        $$_Dmm = $mm;
        $$_Dss = $ss;
        return 1;
    }
    return 0;
}

sub DateCalc_add_delta_days
{
    my($_year,$_month,$_day,$Dd) = @_;
    my($days,$leap);
    if ((($days = DateCalc_Date_to_Days($$_year,$$_month,$$_day)) > 0) and
        (($days += $Dd) > 0))
    {
        if ($Dd != 0)
        {
            $$_year = int( $days / 365.2425 );
            $$_day  = $days - DateCalc_Year_to_Days($$_year);
            if ($$_day < 1)
            {
                $$_day = $days - DateCalc_Year_to_Days($$_year-1);
            }
            else { ${$_year}++; }
            $leap = DateCalc_leap_year($$_year);
            if ($$_day > $DateCalc_Days_in_Year_[$leap][13])
            {
                $$_day -= $DateCalc_Days_in_Year_[$leap][13];
                $leap  = DateCalc_leap_year(++${$_year});
            }
            for ( $$_month = 12; $$_month >= 1; ${$_month}-- )
            {
                if ($$_day > $DateCalc_Days_in_Year_[$leap][$$_month])
                {
                    $$_day -= $DateCalc_Days_in_Year_[$leap][$$_month];
                    last;
                }
            }
        }
        return 1;
    }
    return 0;
}

sub DateCalc_add_delta_dhms
{
    my($_year,$_month,$_day,$_hour,$_min,$_sec,$Dd,$Dh,$Dm,$Ds) = @_;
    if (DateCalc_check_date($$_year,$$_month,$$_day) and
        DateCalc_check_time($$_hour,$$_min,  $$_sec))
    {
        DateCalc_Normalize_Ranges(\$Dd,\$Dh,\$Dm,\$Ds);
        $Ds += (((($$_hour * 60) + $$_min) * 60) + $$_sec) +
                (((  $Dh   * 60) +   $Dm)  * 60);
        while ($Ds < 0)
        {
            $Ds += 86400;
            $Dd--;
        }
        if ($Ds > 0)
        {
            $Dh = 0;
            $Dm = 0;
            DateCalc_Normalize_Time(\$Dd,\$Dh,\$Dm,\$Ds);
            $$_hour = $Dh;
            $$_min  = $Dm;
            $$_sec  = $Ds;
        }
        else { $$_hour = $$_min = $$_sec = 0; }
        return DateCalc_add_delta_days($_year,$_month,$_day,$Dd);
    }
    return 0;
}

sub DateCalc_add_year_month
{
    my($_year,$_month,$Dy,$Dm) = @_;
    my($quot);
    return 0 if (($$_year < 1) or ($$_month < 1) or ($$_month > 12));
    if ($Dm != 0)
    {
        $Dm  += $$_month - 1;
        $quot = int($Dm / 12);
        $Dm  -= $quot * 12;
        if ($Dm < 0)
        {
            $Dm += 12;
            $quot--;
        }
        $$_month = $Dm + 1;
        $Dy += $quot;
    }
    if ($Dy != 0)
    {
        $$_year += $Dy;
    }
    return 0 if ($$_year < 1);
    return 1;
}

sub DateCalc_add_delta_ym
{
    my($_year,$_month,$_day,$Dy,$Dm) = @_;
    my($Dd);
    return 0 unless (DateCalc_check_date($$_year,$$_month,$$_day));
    return 0 unless (DateCalc_add_year_month($_year,$_month,$Dy,$Dm));
    if ($$_day > ($Dd = $DateCalc_Days_in_Month_[DateCalc_leap_year($$_year)][$$_month]))
    {
        $$_day = $Dd;
    }
    return 1;
}

sub DateCalc_add_delta_ymd
{
    my($_year,$_month,$_day,$Dy,$Dm,$Dd) = @_;
    return 0 unless (DateCalc_check_date($$_year,$$_month,$$_day));
    return 0 unless (DateCalc_add_year_month($_year,$_month,$Dy,$Dm));
    $Dd += $$_day - 1;
    $$_day = 1;
    return DateCalc_add_delta_days($_year,$_month,$_day,$Dd);
}

sub DateCalc_add_delta_ymdhms
{
    my($_year,$_month,$_day,$_hour,$_min,$_sec,$D_y,$D_m,$D_d,$Dh,$Dm,$Ds) = @_;
    return 0 unless (DateCalc_check_date($$_year,$$_month,$$_day) and DateCalc_check_time($$_hour,$$_min,$$_sec));
    return 0 unless (DateCalc_add_year_month($_year,$_month,$D_y,$D_m));
    $D_d += $$_day - 1;
    $$_day = 1;
    return DateCalc_add_delta_dhms($_year,$_month,$_day,$_hour,$_min,$_sec,$D_d,$Dh,$Dm,$Ds);
}

sub DateCalc_add_norm_delta_ymd
{
    my($_year,$_month,$_day,$Dy,$Dm,$Dd) = @_;
    return 0 unless (DateCalc_add_delta_ym($_year,$_month,$_day,$Dy,$Dm));
    return DateCalc_add_delta_days($_year,$_month,$_day,$Dd);
}

sub DateCalc_add_norm_delta_ymdhms
{
    my($_year,$_month,$_day,$_hour,$_min,$_sec,$D_y,$D_m,$D_d,$Dh,$Dm,$Ds) = @_;
    return 0 unless (DateCalc_add_delta_ym($_year,$_month,$_day,$D_y,$D_m));
    return DateCalc_add_delta_dhms($_year,$_month,$_day,$_hour,$_min,$_sec,$D_d,$Dh,$Dm,$Ds);
}

sub DateCalc_system_clock
{
    my($_year,$_month,$_day,$_hour,$_min,$_sec,$_doy,$_dow,$_dst,$gmt) = @_;
    my($seconds) = time();
    if ($seconds >= 0)
    {
        $$_dst = 0;
        if ($gmt) { ($$_sec,$$_min,$$_hour,$$_day,$$_month,$$_year,$$_dow,$$_doy)        =    gmtime($seconds); }
        else      { ($$_sec,$$_min,$$_hour,$$_day,$$_month,$$_year,$$_dow,$$_doy,$$_dst) = localtime($seconds); }
        ${$_year} += 1900;
        ${$_month}++;
        ${$_dow} = 7 if (${$_dow} == 0);
        ${$_doy}++;
        if ($$_dst != 0)
        {
            if ($$_dst < 0) { $$_dst = -1; }
            else            { $$_dst =  1; }
        }
        return 1;
    }
    return 0;
}

sub DateCalc_gmtime
{
    my($_year,$_month,$_day,$_hour,$_min,$_sec,$_doy,$_dow,$_dst,$seconds) = @_;
    if ($seconds >= 0)
    {
        $$_dst = 0;
        ($$_sec,$$_min,$$_hour,$$_day,$$_month,$$_year,$$_dow,$$_doy) = gmtime($seconds);
        ${$_year} += 1900;
        ${$_month}++;
        ${$_dow} = 7 if (${$_dow} == 0);
        ${$_doy}++;
        return 1;
    }
    return 0;
}

sub DateCalc_localtime
{
    my($_year,$_month,$_day,$_hour,$_min,$_sec,$_doy,$_dow,$_dst,$seconds) = @_;
    if ($seconds >= 0)
    {
        ($$_sec,$$_min,$$_hour,$$_day,$$_month,$$_year,$$_dow,$$_doy,$$_dst) = localtime($seconds);
        ${$_year} += 1900;
        ${$_month}++;
        ${$_dow} = 7 if (${$_dow} == 0);
        ${$_doy}++;
        if ($$_dst != 0)
        {
            if ($$_dst < 0) { $$_dst = -1; }
            else            { $$_dst =  1; }
        }
        return 1;
    }
    return 0;
}

## MacOS (Classic):                                            ##
## <695056.0>     = Fri  1-Jan-1904 00:00:00 (time=0x00000000) ##
## <744766.23295> = Mon  6-Feb-2040 06:28:15 (time=0xFFFFFFFF) ##

## Unix:                                                       ##
## <719163.0>     = Thu  1-Jan-1970 00:00:00 (time=0x00000000) ##
## <744018.11647> = Tue 19-Jan-2038 03:14:07 (time=0x7FFFFFFF) ##

sub DateCalc_mktime
{
    my($_seconds,$year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst) = @_;
    $$_seconds = 0;
    if ($^O eq 'MacOS')
    {
        return 0 if
        (
            ($year  < 1904) or ($year  > 2040) or
            ($month <    1) or ($month >   12) or
            ($day   <    1) or ($day   >   31) or
            ($hour  <    0) or ($hour  >   23) or
            ($min   <    0) or ($min   >   59) or
            ($sec   <    0) or ($sec   >   59)
        );
        return 0 if
        (
            ($year == 2040) and ( ($month >  2) or
                                ( ($month == 2) and ( ($day >  6) or
                                                    ( ($day == 6) and ( ($hour >  6) or
                                                                      ( ($hour == 6) and ( ($min >  28) or
                                                                                         ( ($min == 28) and ($sec > 15) ) )))))))
        );
    }
    else
    {
        return 0 if
        (
            ($year  < 1970) or ($year  > 2038) or
            ($month <    1) or ($month >   12) or
            ($day   <    1) or ($day   >   31) or
            ($hour  <    0) or ($hour  >   23) or
            ($min   <    0) or ($min   >   59) or
            ($sec   <    0) or ($sec   >   59)
        );
        return 0 if
        (
            ($year == 2038) and ( ($month >  1) or
                                ( ($month == 1) and ( ($day >  19) or
                                                    ( ($day == 19) and ( ($hour >  3) or
                                                                       ( ($hour == 3) and ( ($min >  14) or
                                                                                          ( ($min == 14) and ($sec > 7) ) )))))))
        );
    }
    $year -= 1900;
    $month--;
    if ($doy <= 0) { $doy = -1; }
    else           { $doy--;    }
    if    ($dow <= 0) { $dow = -1; }
    elsif ($dow == 7) { $dow =  0; }
    if ($dst != 0)
    {
        if ($dst < 0) { $dst = -1; }
        else          { $dst =  1; }
    }
    $$_seconds = POSIX::mktime($sec,$min,$hour,$day,$month,$year,$doy,$dow,$dst) || 0;
    return 1 if ($$_seconds >= 0);
    return 0;
}

sub DateCalc_timezone
{
    my($_year,$_month,$_day,$_hour,$_min,$_sec,$_dst,$when) = @_;
    my($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2);
    if ($when >= 0)
    {
        ($year1,$month1,$day1,$hour1,$min1,$sec1)        =    (gmtime($when))[5,4,3,2,1,0];
        $year1 += 1900;
        $month1++;
        ($year2,$month2,$day2,$hour2,$min2,$sec2,$$_dst) = (localtime($when))[5,4,3,2,1,0,8];
        $year2 += 1900;
        $month2++;
        if (DateCalc_delta_ymdhms($_year,$_month,$_day, $_hour,$_min,$_sec,
                                  $year1,$month1,$day1, $hour1,$min1,$sec1,
                                  $year2,$month2,$day2, $hour2,$min2,$sec2))
        {
            if ($$_dst != 0)
            {
                if ($$_dst < 0) { $$_dst = -1; }
                else            { $$_dst =  1; }
            }
            return 1;
        }
    }
    return 0;
}

## MacOS (Classic):                                            ##
## <695056.0>     = Fri  1-Jan-1904 00:00:00 (time=0x00000000) ##
## <744766.23295> = Mon  6-Feb-2040 06:28:15 (time=0xFFFFFFFF) ##

## Unix:                                                       ##
## <719163.0>     = Thu  1-Jan-1970 00:00:00 (time=0x00000000) ##
## <744018.11647> = Tue 19-Jan-2038 03:14:07 (time=0x7FFFFFFF) ##

#ifdef MACOS_TRADITIONAL
    #define DateCalc_DAYS_TO_EPOCH  695056
    #define DateCalc_DAYS_TO_OVFLW  744766
    #define DateCalc_SECS_TO_OVFLW   23295
#else
    #define DateCalc_DAYS_TO_EPOCH  719163
    #define DateCalc_DAYS_TO_OVFLW  744018
    #define DateCalc_SECS_TO_OVFLW   11647
#endif

## Substitute for BSD's timegm(3) function: ##

sub DateCalc_date2time
{
    my($_seconds,$year,$month,$day,$hour,$min,$sec) = @_;
    my($days,$secs);
    $$_seconds = 0;
    $days = DateCalc_Date_to_Days($year,$month,$day);
    $secs = ((($hour * 60) + $min) * 60) + $sec;
    return 0 if
    (
        ($days <  $DateCalc_DAYS_TO_EPOCH) or
        ($secs <  0)                       or
        ($days >  $DateCalc_DAYS_TO_OVFLW) or
        (
            ($days == $DateCalc_DAYS_TO_OVFLW) and
            ($secs >  $DateCalc_SECS_TO_OVFLW)
        )
    );
    $$_seconds = (($days - $DateCalc_DAYS_TO_EPOCH) * 86400) + $secs;
    return 1;
}

## Substitute for POSIX's gmtime(3) function: ##

sub DateCalc_time2date
{
    my($_year,$_month,$_day,$_hour,$_min,$_sec,$ss) = @_;
    my($mm,$hh,$dd);
    return 0 if ($ss < 0);
    $dd = int($ss / 86400);
    $ss -= $dd * 86400;
    $mm = int($ss / 60);
    $ss -= $mm * 60;
    $hh = int($mm / 60);
    $mm -= $hh * 60;
    $dd += $DateCalc_DAYS_TO_EPOCH-1;
    $$_sec   = $ss;
    $$_min   = $mm;
    $$_hour  = $hh;
    $$_day   = 1;
    $$_month = 1;
    $$_year  = 1;
    return DateCalc_add_delta_days($_year,$_month,$_day,$dd);
}

sub DateCalc_easter_sunday
{
    ##**************************************************************##
    ##                                                              ##
    ##  Gauss'sche Regel (Gaussian Rule)                            ##
    ##  ================================                            ##
    ##                                                              ##
    ##  Quelle / Source:                                            ##
    ##                                                              ##
    ##  H. H. Voigt, "Abriss der Astronomie", Wissenschaftsverlag,  ##
    ##  Bibliographisches Institut, Seite 9.                        ##
    ##                                                              ##
    ##**************************************************************##

    my($_year,$_month,$_day) = @_;
    my($a,$b,$c,$d,$e,$m,$n);

    return 0 if (($$_year < 1583) or ($$_year > 2299));

    if    ($$_year < 1700) { $m = 22; $n = 2; }
    elsif ($$_year < 1800) { $m = 23; $n = 3; }
    elsif ($$_year < 1900) { $m = 23; $n = 4; }
    elsif ($$_year < 2100) { $m = 24; $n = 5; }
    elsif ($$_year < 2200) { $m = 24; $n = 6; }
    else                   { $m = 25; $n = 0; }

    $a = $$_year % 19;
    $b = $$_year % 4;
    $c = $$_year % 7;
    $d = (19 * $a + $m) % 30;
    $e = (2 * $b + 4 * $c + 6 * $d + $n) % 7;
    $$_day = 22 + $d + $e;
    $$_month = 3;
    if ($$_day > 31)
    {
        $$_day -= 31; ## same as $$_day = $d + $e - 9; ##
        ${$_month}++;
    }
    $$_day = 19 if (($$_day == 26) and ($$_month == 4));
    $$_day = 18 if (($$_day == 25) and ($$_month == 4) and ($d == 28) and ($e == 6) and ($a > 10));
    return 1;
}

##  Carnival Monday / Rosenmontag / Veille du Mardi Gras   =  easter sunday - 48  ##
##  Mardi Gras / Karnevalsdienstag / Mardi Gras            =  easter sunday - 47  ##
##  Ash Wednesday / Aschermittwoch / Mercredi des Cendres  =  easter sunday - 46  ##
##  Palm Sunday / Palmsonntag / Dimanche des Rameaux       =  easter sunday - 7   ##
##  Easter Friday / Karfreitag / Vendredi Saint            =  easter sunday - 2   ##
##  Easter Saturday / Ostersamstag / Samedi de Paques      =  easter sunday - 1   ##
##  Easter Monday / Ostermontag / Lundi de Paques          =  easter sunday + 1   ##
##  Ascension of Christ / Christi Himmelfahrt / Ascension  =  easter sunday + 39  ##
##  Whitsunday / Pfingstsonntag / Dimanche de Pentecote    =  easter sunday + 49  ##
##  Whitmonday / Pfingstmontag / Lundi de Pentecote        =  easter sunday + 50  ##
##  Feast of Corpus Christi / Fronleichnam / Fete-Dieu     =  easter sunday + 60  ##

sub DateCalc_Decode_Month ## 0 = error ##
{
    my($string,$lang) = @_;
    my($length,$buffer,$month,$ok,$m);
    $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES));
    $length = length($string);
    $buffer = DateCalc_ISO_UC($string);
    $month = 0;
    $ok = 0;
    MONTH:
    for ( $m = 1; $m <= 12; $m++ )
    {
        next MONTH if ($length > length($DateCalc_Month_to_Text_[$lang][$m]));
        next MONTH if (DateCalc_ISO_UC(substr($DateCalc_Month_to_Text_[$lang][$m],0,$length)) ne $buffer);
        if ($month > 0) { $ok = 0; last MONTH; }
        else            { $ok = 1; $month = $m; }
    }
    return $month if ($ok);
    return 0;
}

sub DateCalc_Decode_Day_of_Week ## 0 = error ##
{
    my($string,$lang) = @_;
    my($length,$buffer,$dow,$ok,$d);
    $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES));
    $length = length($string);
    $buffer = DateCalc_ISO_UC($string);
    $dow = 0;
    $ok = 0;
    DAYOFWEEK:
    for ( $d = 1; $d <= 7; $d++ )
    {
        next DAYOFWEEK if ($length > length($DateCalc_Day_of_Week_to_Text_[$lang][$d]));
        next DAYOFWEEK if (DateCalc_ISO_UC(substr($DateCalc_Day_of_Week_to_Text_[$lang][$d],0,$length)) ne $buffer);
        if ($dow > 0) { $ok = 0; last DAYOFWEEK; }
        else          { $ok = 1; $dow = $d; }
    }
    return $dow if ($ok);
    return 0;
}

sub DateCalc_Decode_Language ## 0 = error ##
{
    my($string) = $_[0];
    my($length,$buffer,$lang,$ok,$l);
    $length = length($string);
    $buffer = DateCalc_ISO_UC($string);
    $lang = 0;
    $ok = 0;
    LANGUAGE:
    for ( $l = 1; $l <= $DateCalc_LANGUAGES; $l++ )
    {
        next LANGUAGE if ($length > length($DateCalc_Language_to_Text_[$l]));
        next LANGUAGE if (DateCalc_ISO_UC(substr($DateCalc_Language_to_Text_[$l],0,$length)) ne $buffer);
        if ($lang > 0) { $ok = 0; last LANGUAGE; }
        else           { $ok = 1; $lang = $l; }
    }
    return $lang if ($ok);
    return 0;
}

sub DateCalc_decode_date_eu
{
    my($string,$_year,$_month,$_day,$lang) = @_;
    my($length,$buffer,$i,$j);
    $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES));
    $$_year = $$_month = $$_day = 0;
    return 0 unless ($length = length($string));
    $buffer = 0;
    $i = 0;
    while (DateCalc_scan9($string,$buffer,$length,$i,1)) { $i++; }
    $j = $length-1;
    while (DateCalc_scan9($string,$buffer,$length,$j,1)) { $j--; }
    if ($i+1 < $j)      ## at least 3 chars, else error! ##
    {
        $buffer += $i;
        $length = $j-$i+1;
        $i = 1;
        while (DateCalc_scan9($string,$buffer,$length,$i,0)) { $i++; }
        $j = $length-2;
        while (DateCalc_scan9($string,$buffer,$length,$j,0)) { $j--; }
        if ($j < $i)  ## only numerical chars without delimiters ##
        {
            if    ($length == 3)
            {
                $$_day   = substr($string,$buffer,  1);
                $$_month = substr($string,$buffer+1,1);
                $$_year  = substr($string,$buffer+2,1);
            }
            elsif ($length == 4)
            {
                $$_day   = substr($string,$buffer,  1);
                $$_month = substr($string,$buffer+1,1);
                $$_year  = substr($string,$buffer+2,2);
            }
            elsif ($length == 5)
            {
                $$_day   = substr($string,$buffer,  1);
                $$_month = substr($string,$buffer+1,2);
                $$_year  = substr($string,$buffer+3,2);
            }
            elsif ($length == 6)
            {
                $$_day   = substr($string,$buffer,  2);
                $$_month = substr($string,$buffer+2,2);
                $$_year  = substr($string,$buffer+4,2);
            }
            elsif ($length == 7)
            {
                $$_day   = substr($string,$buffer,  1);
                $$_month = substr($string,$buffer+1,2);
                $$_year  = substr($string,$buffer+3,4);
            }
            elsif ($length == 8)
            {
                $$_day   = substr($string,$buffer,  2);
                $$_month = substr($string,$buffer+2,2);
                $$_year  = substr($string,$buffer+4,4);
            }
            else { return 0; }
        }
        else        ## at least one non-numerical char (i <= j) ##
        {
            $$_day  = substr($string,$buffer,$i);
            $$_year = substr($string,$buffer+($j+1),$length-($j+1));
            while (DateCalc_scanx($string,$buffer,$length,$i,1)) { $i++; }
            while (DateCalc_scanx($string,$buffer,$length,$j,1)) { $j--; }
            if ($i <= $j)       ## at least one char left for month ##
            {
                $buffer += $i;
                $length = $j-$i+1;
                $i = 1;
                while (DateCalc_scanx($string,$buffer,$length,$i,0)) { $i++; }
                if ($i >= $length)  ## ok, no more delimiters ##
                {
                    $i = 0;
                    while (DateCalc_scan9($string,$buffer,$length,$i,0)) { $i++; }
                    if ($i >= $length) ## only digits for month ##
                    {
                        $$_month = substr($string,$buffer,$length);
                    }
                    else             ## match with month names ##
                    {
                        $$_month = DateCalc_Decode_Month(substr($string,$buffer,$length),$lang);
                    }
                }
                else { return 0; } ## delimiters inside month string ##
            }
            else { return 0; } ## no chars left for month ##
        }           ## at least one non-numerical char (i <= j) ##
    }
    else { return 0; } ## less than 3 chars in buffer ##
    $$_year = DateCalc_Moving_Window($$_year);
    return DateCalc_check_date($$_year,$$_month,$$_day);
}

sub DateCalc_decode_date_us
{
    my($string,$_year,$_month,$_day,$lang) = @_;
    my($length,$buffer,$i,$j,$k);
    $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES));

    $$_year = $$_month = $$_day = 0;
    return 0 unless ($length = length($string));
    {
        $buffer = 0;
        $i = 0;
        while (DateCalc_scanx($string,$buffer,$length,$i,1)) { $i++; }
        $j = $length-1;
        while (DateCalc_scan9($string,$buffer,$length,$j,1)) { $j--; }
        if ($i+1 < $j)      ## at least 3 chars, else error! ##
        {
            $buffer += $i;
            $length = $j-$i+1;
            $i = 1;
            while (DateCalc_scanx($string,$buffer,$length,$i,0)) { $i++; }
            $j = $length-2;
            while (DateCalc_scan9($string,$buffer,$length,$j,0)) { $j--; }
            if ($i >= $length)  ## only alphanumeric chars left ##
            {
                if ($j < 0) ## case 0 : xxxx999999xxxx ##
                {           ##             j0     i    ##
                    if    ($length == 3)
                    {
                        $$_month = substr($string,$buffer,  1);
                        $$_day   = substr($string,$buffer+1,1);
                        $$_year  = substr($string,$buffer+2,1);
                    }
                    elsif ($length == 4)
                    {
                        $$_month = substr($string,$buffer,  1);
                        $$_day   = substr($string,$buffer+1,1);
                        $$_year  = substr($string,$buffer+2,2);
                    }
                    elsif ($length == 5)
                    {
                        $$_month = substr($string,$buffer,  1);
                        $$_day   = substr($string,$buffer+1,2);
                        $$_year  = substr($string,$buffer+3,2);
                    }
                    elsif ($length == 6)
                    {
                        $$_month = substr($string,$buffer,  2);
                        $$_day   = substr($string,$buffer+2,2);
                        $$_year  = substr($string,$buffer+4,2);
                    }
                    elsif ($length == 7)
                    {
                        $$_month = substr($string,$buffer,  1);
                        $$_day   = substr($string,$buffer+1,2);
                        $$_year  = substr($string,$buffer+3,4);
                    }
                    elsif ($length == 8)
                    {
                        $$_month = substr($string,$buffer,  2);
                        $$_day   = substr($string,$buffer+2,2);
                        $$_year  = substr($string,$buffer+4,4);
                    }
                    else { return 0; }
                }
                else        ## case 1 : xxxxAAA999999xxxx ##
                {           ##              0 j      i    ##
                    $$_month = DateCalc_Decode_Month(substr($string,$buffer,$j+1),$lang);
                    $buffer += $j+1;
                    $length -= $j+1;
                    if    ($length == 2)
                    {
                        $$_day  = substr($string,$buffer,  1);
                        $$_year = substr($string,$buffer+1,1);
                    }
                    elsif ($length == 3)
                    {
                        $$_day  = substr($string,$buffer,  1);
                        $$_year = substr($string,$buffer+1,2);
                    }
                    elsif ($length == 4)
                    {
                        $$_day  = substr($string,$buffer,  2);
                        $$_year = substr($string,$buffer+2,2);
                    }
                    elsif ($length == 5)
                    {
                        $$_day  = substr($string,$buffer,  1);
                        $$_year = substr($string,$buffer+1,4);
                    }
                    elsif ($length == 6)
                    {
                        $$_day  = substr($string,$buffer,  2);
                        $$_year = substr($string,$buffer+2,4);
                    }
                    else { return 0; }
                }
            }              ##              0  i  j    l         ##
            else           ## case 2 : xxxxAAAxxxx9999xxxx _OR_ ##
            {              ## case 3 : xxxxAAAxx99xx9999xx      ##
                $k = 0;    ##              0  i    j    l       ##
                while (DateCalc_scan9($string,$buffer,$length,$k,0)) { $k++; }
                if ($k >= $i) ## ok, only digits ##
                {
                    $$_month = substr($string,$buffer,$i);
                }
                else          ## no, some non-digits ##
                {
                    $$_month = DateCalc_Decode_Month(substr($string,$buffer,$i),$lang);
                    if ($$_month == 0) { return 0; }
                }
                $buffer += $i;
                $length -= $i;
                $j -= $i;
                $k = $j+1; ## remember start position of day+year(2)/year(3) ##
                $i = 1;
                while (DateCalc_scanx($string,$buffer,$length,$i,1)) { $i++; }
                $j--;
                while (DateCalc_scan9($string,$buffer,$length,$j,1)) { $j--; }
                if ($j < $i) ## case 2 : xxxxAAAxxxx9999xxxx ##
                {            ##                j0   i   l    ##
                    $buffer += $k;    ##            k        ##
                    $length -= $k;
                    if    ($length == 2)
                    {
                        $$_day  = substr($string,$buffer,  1);
                        $$_year = substr($string,$buffer+1,1);
                    }
                    elsif ($length == 3)
                    {
                        $$_day  = substr($string,$buffer,  1);
                        $$_year = substr($string,$buffer+1,2);
                    }
                    elsif ($length == 4)
                    {
                        $$_day  = substr($string,$buffer,  2);
                        $$_year = substr($string,$buffer+2,2);
                    }
                    elsif ($length == 5)
                    {
                        $$_day  = substr($string,$buffer,  1);
                        $$_year = substr($string,$buffer+1,4);
                    }
                    elsif ($length == 6)
                    {
                        $$_day  = substr($string,$buffer,  2);
                        $$_year = substr($string,$buffer+2,4);
                    }
                    else { return 0; }
                }
                else       ## case 3 : xxxxAAAxx99xx9999xx ##
                {          ##                 0 ij  k   l  ##
                    $$_year = substr($string,$buffer+$k,$length-$k);
                    $k = $i;
                    while (DateCalc_scan9($string,$buffer,$length,$k,0)) { $k++; }
                    if ($k > $j)       ## ok, only digits ##
                    {
                        $$_day = substr($string,$buffer+$i,$j-$i+1);
                    }
                    else { return 0; } ## non-digits inside day ##
                }
            }                 ## i < length ##
        }
        else { return 0; } ## less than 3 chars in buffer ##
    }
    $$_year = DateCalc_Moving_Window($$_year);
    return DateCalc_check_date($$_year,$$_month,$$_day);
}

sub DateCalc_Fixed_Window
{
    my($year) = $_[0];
    return 0 if ($year < 0);
    if ($year < 100)
    {
        $year += 100 if ($year < $DateCalc_YEAR_OF_EPOCH);
        $year += $DateCalc_CENTURY_OF_EPOCH;
    }
    return $year;
}

sub DateCalc_Moving_Window
{
    my($year) = $_[0];
    my($seconds,$current,$century);
    return 0 if ($year < 0);
    if ($year < 100)
    {
        if (($seconds = time()) >= 0)
        {
            $current = (gmtime($seconds))[5] + 1900;
            $century = int($current / 100);
            $year += $century * 100;
            if    ($year <  $current - 50) { $year += 100; }
            elsif ($year >= $current + 50) { $year -= 100; }
        }
        else { $year = DateCalc_Fixed_Window($year); }
    }
    return $year;
}

sub DateCalc_Compress
{
    my($year,$month,$day) = @_;
    my($yy);
    if (($year >= $DateCalc_EPOCH) and ($year < ($DateCalc_EPOCH + 100)))
    {
        $yy = $year;
        $year -= $DateCalc_EPOCH;
    }
    else
    {
        return 0 if (($year < 0) or ($year > 99));
        if ($year < $DateCalc_YEAR_OF_EPOCH)
        {
            $yy = $DateCalc_CENTURY_OF_EPOCH + 100 + $year;
            $year += 100 - $DateCalc_YEAR_OF_EPOCH;
        }
        else
        {
            $yy = $DateCalc_CENTURY_OF_EPOCH + $year;
            $year -= $DateCalc_YEAR_OF_EPOCH;
        }
    }
    return 0 if (($month < 1) or ($month > 12));
    return 0 if
        (($day < 1) or
         ($day > $DateCalc_Days_in_Month_[DateCalc_leap_year($yy)][$month]));
    return ($year << 9) | ($month << 5) | $day;
}

sub DateCalc_uncompress
{
    my($date,$_century,$_year,$_month,$_day) = @_;
    if ($date > 0)
    {
        $$_year  =  $date >> 9;
        $$_month = ($date & 0x01FF) >> 5;
        $$_day   =  $date & 0x001F;
        if ($$_year < 100)
        {
            if ($$_year < 100-$DateCalc_YEAR_OF_EPOCH)
            {
                $$_century = $DateCalc_CENTURY_OF_EPOCH;
                $$_year += $DateCalc_YEAR_OF_EPOCH;
            }
            else
            {
                $$_century = $DateCalc_CENTURY_OF_EPOCH+100;
                $$_year -= 100-$DateCalc_YEAR_OF_EPOCH;
            }
            return DateCalc_check_date($$_century+$$_year,$$_month,$$_day);
        }
    }
    return 0;
}

sub DateCalc_check_compressed
{
    my($century,$year,$month,$day);
    return DateCalc_uncompress($_[0],\$century,\$year,\$month,\$day);
}

sub DateCalc_Compressed_to_Text
{
    my($date,$lang) = @_;
    my($century,$year,$month,$day,$string);
    $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES));
    if (DateCalc_uncompress($date,\$century,\$year,\$month,\$day))
    {
        $string = sprintf("%02d-%.3s-%02d",$day,$DateCalc_Month_to_Text_[$lang][$month],$year);
    }
    else { $string = '??-???-??'; }
    return $string;
}

sub DateCalc_Date_to_Text
{
    my($year,$month,$day,$lang) = @_;
    $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES));
    if (DateCalc_check_date($year,$month,$day))
    {
        if ($DateCalc_Day_of_Week_Abbreviation_[$lang][0] ne '')
        {
            return sprintf("%.3s %d-%.3s-%d",
                $DateCalc_Day_of_Week_Abbreviation_[$lang][DateCalc_Day_of_Week($year,$month,$day)],
                $day,$DateCalc_Month_to_Text_[$lang][$month],$year);
        }
        else
        {
            return sprintf("%.3s %d-%.3s-%d",
                $DateCalc_Day_of_Week_to_Text_[$lang][DateCalc_Day_of_Week($year,$month,$day)],
                $day,$DateCalc_Month_to_Text_[$lang][$month],$year);
        }
    }
    return undef;
}

sub DateCalc_English_Ordinal
{
    my($result) = "$_[0]";
    my($length,$digit);
    if (($length = length($result)) > 0)
    {
        $digit = 0 unless
        (
            ( (($length > 1) and (substr($result,$length-2,1) ne '1')) or ($length == 1) )
            and
            ( ($digit = substr($result,$length-1,1)) <= 3 )
        );
        $result .= $DateCalc_English_Ordinals_[$digit];
    }
    return $result;
}

sub DateCalc_Date_to_Text_Long
{
    my($year,$month,$day,$lang) = @_;
    my($string,$buffer);
    $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES));
    if (DateCalc_check_date($year,$month,$day))
    {
        if    ($lang == 1)
        {
            return sprintf
            (
                $DateCalc_Date_Long_Format_[$lang],
                $DateCalc_Day_of_Week_to_Text_[$lang]
                    [DateCalc_Day_of_Week($year,$month,$day)],
                $DateCalc_Month_to_Text_[$lang][$month],
                DateCalc_English_Ordinal($day),
                $year
            );
        }
        elsif ($lang == 12)
        {
            return sprintf
            (
                $DateCalc_Date_Long_Format_[$lang],
                $year,
                $DateCalc_Month_to_Text_[$lang][$month],
                $day,
                $DateCalc_Day_of_Week_to_Text_[$lang]
                    [DateCalc_Day_of_Week($year,$month,$day)]
            );
        }
        else
        {
            return sprintf
            (
                $DateCalc_Date_Long_Format_[$lang],
                $DateCalc_Day_of_Week_to_Text_[$lang]
                    [DateCalc_Day_of_Week($year,$month,$day)],
                $day,
                $DateCalc_Month_to_Text_[$lang][$month],
                $year
            );
        }
    }
    return undef;
}

sub DateCalc_Calendar
{
    my($year,$month,$orthodox,$lang) = @_;
    my($string,$cursor,$buffer,$first,$last,$day);
    if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)) { $lang = $DateCalc_Language; }
    $string = '';
    $cursor = \$string;
    DateCalc_Newline($cursor,1);
    $buffer = sprintf("%s %d", DateCalc_ISO_UC_First($DateCalc_Month_to_Text_[$lang][$month]), $year);
    DateCalc_Center($cursor,$buffer,27);
    if ($DateCalc_Day_of_Week_Abbreviation_[$lang][0] ne '')
    {
        if ($orthodox)
        {
            $string .= sprintf("%3.3s %3.3s %3.3s %3.3s %3.3s %3.3s %3.3s\n",
                $DateCalc_Day_of_Week_Abbreviation_[$lang][7],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][1],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][2],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][3],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][4],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][5],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][6]);
        }
        else ## conform to ISO standard ##
        {
            $string .= sprintf("%3.3s %3.3s %3.3s %3.3s %3.3s %3.3s %3.3s\n",
                $DateCalc_Day_of_Week_Abbreviation_[$lang][1],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][2],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][3],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][4],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][5],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][6],
                $DateCalc_Day_of_Week_Abbreviation_[$lang][7]);
        }
    }
    else
    {
        if ($orthodox)
        {
            $string .= sprintf("%3.3s %3.3s %3.3s %3.3s %3.3s %3.3s %3.3s\n",
                $DateCalc_Day_of_Week_to_Text_[$lang][7],
                $DateCalc_Day_of_Week_to_Text_[$lang][1],
                $DateCalc_Day_of_Week_to_Text_[$lang][2],
                $DateCalc_Day_of_Week_to_Text_[$lang][3],
                $DateCalc_Day_of_Week_to_Text_[$lang][4],
                $DateCalc_Day_of_Week_to_Text_[$lang][5],
                $DateCalc_Day_of_Week_to_Text_[$lang][6]);
        }
        else ## conform to ISO standard ##
        {
            $string .= sprintf("%3.3s %3.3s %3.3s %3.3s %3.3s %3.3s %3.3s\n",
                $DateCalc_Day_of_Week_to_Text_[$lang][1],
                $DateCalc_Day_of_Week_to_Text_[$lang][2],
                $DateCalc_Day_of_Week_to_Text_[$lang][3],
                $DateCalc_Day_of_Week_to_Text_[$lang][4],
                $DateCalc_Day_of_Week_to_Text_[$lang][5],
                $DateCalc_Day_of_Week_to_Text_[$lang][6],
                $DateCalc_Day_of_Week_to_Text_[$lang][7]);
        }
    }
    $first = DateCalc_Day_of_Week($year,$month,1);
    $last = $DateCalc_Days_in_Month_[DateCalc_leap_year($year)][$month];
    if ($orthodox) { $first = 0 if ($first == 7); }
    else           { $first--; }
    if ($first) { DateCalc_Blank($cursor,($first<<2)-1); }
    for ( $day = 1; $day <= $last; $day++, $first++ )
    {
        if ($first > 0)
        {
            if ($first > 6)
            {
                $first = 0;
                DateCalc_Newline($cursor,1);
            }
            else { DateCalc_Blank($cursor,1); }
        }
        $string .= sprintf(" %2d",$day);
    }
    DateCalc_Newline($cursor,2);
    return $string;
}

###############
##           ##
##  Calc.pm  ##
##           ##
###############

sub Decode_Date_EU2
{
    croak "Usage: (\$year,\$month,\$day) = Decode_Date_EU2(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));

    my($buffer) = shift;
    my($lang)   = shift || 0;
    my($year,$month,$day,$length);

    $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
    if ($buffer =~ /^\D*  (\d+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  (\d+)  \D*$/x)
    {
        ($day,$month,$year) = ($1,$2,$3);
        $month = Decode_Month($month,$lang);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
    }
    elsif ($buffer =~ /^\D*  0*(\d+)  \D*$/x)
    {
        $buffer = $1;
        $length = length($buffer);
        if    ($length == 3)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,1);
            $year  = substr($buffer,2,1);
        }
        elsif ($length == 4)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,1);
            $year  = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,2);
            $year  = substr($buffer,3,2);
        }
        elsif ($length == 6)
        {
            $day   = substr($buffer,0,2);
            $month = substr($buffer,2,2);
            $year  = substr($buffer,4,2);
        }
        elsif ($length == 7)
        {
            $day   = substr($buffer,0,1);
            $month = substr($buffer,1,2);
            $year  = substr($buffer,3,4);
        }
        elsif ($length == 8)
        {
            $day   = substr($buffer,0,2);
            $month = substr($buffer,2,2);
            $year  = substr($buffer,4,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^\D*  (\d+)  \D+  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($day,$month,$year) = ($1,$2,$3);
    }
    else { return(); } # no match at all!
    $year = Moving_Window($year);
    if (check_date($year,$month,$day))
    {
        return($year,$month,$day);
    }
    else { return(); } # not a valid date!
}

sub Decode_Date_US2
{
    croak "Usage: (\$year,\$month,\$day) = Decode_Date_US2(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));

    my($buffer) = shift;
    my($lang)   = shift || 0;
    my($year,$month,$day,$length);

    $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
    if ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  0*(\d+)  \D*$/x)
    {
        ($month,$buffer) = ($1,$2);
        $month = Decode_Month($month,$lang);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
        $length = length($buffer);
        if    ($length == 2)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,1);
        }
        elsif ($length == 3)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,2);
        }
        elsif ($length == 4)
        {
            $day  = substr($buffer,0,2);
            $year = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $day  = substr($buffer,0,1);
            $year = substr($buffer,1,4);
        }
        elsif ($length == 6)
        {
            $day  = substr($buffer,0,2);
            $year = substr($buffer,2,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+)  [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]*  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($month,$day,$year) = ($1,$2,$3);
        $month = Decode_Month($month,$lang);
        unless ($month > 0)
        {
            return(); # can't decode month!
        }
    }
    elsif ($buffer =~ /^\D*  0*(\d+)  \D*$/x)
    {
        $buffer = $1;
        $length = length($buffer);
        if    ($length == 3)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,1);
            $year  = substr($buffer,2,1);
        }
        elsif ($length == 4)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,1);
            $year  = substr($buffer,2,2);
        }
        elsif ($length == 5)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,2);
            $year  = substr($buffer,3,2);
        }
        elsif ($length == 6)
        {
            $month = substr($buffer,0,2);
            $day   = substr($buffer,2,2);
            $year  = substr($buffer,4,2);
        }
        elsif ($length == 7)
        {
            $month = substr($buffer,0,1);
            $day   = substr($buffer,1,2);
            $year  = substr($buffer,3,4);
        }
        elsif ($length == 8)
        {
            $month = substr($buffer,0,2);
            $day   = substr($buffer,2,2);
            $year  = substr($buffer,4,4);
        }
        else { return(); } # wrong number of digits!
    }
    elsif ($buffer =~ /^\D*  (\d+)  \D+  (\d+)  \D+  (\d+)  \D*$/x)
    {
        ($month,$day,$year) = ($1,$2,$3);
    }
    else { return(); } # no match at all!
    $year = Moving_Window($year);
    if (check_date($year,$month,$day))
    {
        return($year,$month,$day);
    }
    else { return(); } # not a valid date!
}

sub Parse_Date
{
    croak "Usage: (\$year,\$month,\$day) = Parse_Date(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));

    my($date) = shift;
    my($lang) = shift || 0;
    my($year,$month,$day);

    $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
    unless ($date =~ /\b([\x41-\x5A\x61-\x7A\xC0-\xD6\xD8-\xF6\xF8-\xFF]{3})\s+([0123]??\d)\b/)
    {
        return();
    }
    $month = $1;
    $day   = $2;
    unless ($date =~ /\b(19\d\d|20\d\d)\b/)
    {
        return();
    }
    $year  = $1;
    $month = Decode_Month($month,$lang);
    unless ($month > 0)
    {
        return();
    }
    unless (check_date($year,$month,$day))
    {
        return();
    }
    return($year,$month,$day);
}

1;

__END__