BEGIN {
eval
{
require
bytes; }; }
use
vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION)
;
@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
=
'6.4'
;
sub
Version
{
return
$VERSION
;
}
my
$DateCalc_YEAR_OF_EPOCH
= 70;
my
$DateCalc_CENTURY_OF_EPOCH
= 1900;
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
;
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;
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"
,
"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"
,
"czwartek"
,
"piatek"
,
"sobota"
,
"niedziela"
],
[
"???"
,
"Luni"
,
"Marti"
,
"Miercuri"
,
"Joi"
,
"Vineri"
,
"Sambata"
,
"Duminica"
]
);
my
(
@DateCalc_Day_of_Week_Abbreviation_
) =
(
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
],
[
"???"
,
"Pn"
,
"Wt"
,
"Sr"
,
"Cz"
,
"Pt"
,
"So"
,
"Ni"
],
[
""
,
""
,
""
,
""
,
""
,
""
,
""
,
""
]
);
my
(
@DateCalc_English_Ordinals_
) =
(
"th"
,
"st"
,
"nd"
,
"rd"
);
my
(
@DateCalc_Date_Long_Format_
) =
(
"%s, %d %s %d"
,
"%s, %s %s %d"
,
"%s %d %s %d"
,
"%s, den %d. %s %d"
,
"%s, %d de %s de %d"
,
"%s, dia %d de %s de %d"
,
"%s, %d %s %d"
,
"%s, %d %s %d"
,
"%s, %d. %s %d"
,
"%s, %d %s %d"
,
"%s, %d. %s %d"
,
"%s, %d. %sta %d"
,
"%d. %s %d., %s"
,
"%s, %d %s %d"
,
"%s %d %s %d"
);
my
(
@DateCalc_Language_to_Text_
) =
(
"???"
,
"English"
,
"Français"
,
"Deutsch"
,
"Español"
,
"Português"
,
"Nederlands"
,
"Italiano"
,
"Norsk"
,
"Svenska"
,
"Dansk"
,
"suomi"
,
"Magyar"
,
"polski"
,
"Romaneste"
);
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
;
}
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
{
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
{
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
;
}
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
);
}
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
);
}
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;
}
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;
}
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;
}
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
{
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;
${
$_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;
}
sub
DateCalc_Decode_Month
{
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
{
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
{
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
)
{
$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
)
{
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
{
$$_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
)
{
$buffer
+=
$i
;
$length
=
$j
-
$i
+1;
$i
= 1;
while
(DateCalc_scanx(
$string
,
$buffer
,
$length
,
$i
,0)) {
$i
++; }
if
(
$i
>=
$length
)
{
$i
= 0;
while
(DateCalc_scan9(
$string
,
$buffer
,
$length
,
$i
,0)) {
$i
++; }
if
(
$i
>=
$length
)
{
$$_month
=
substr
(
$string
,
$buffer
,
$length
);
}
else
{
$$_month
= DateCalc_Decode_Month(
substr
(
$string
,
$buffer
,
$length
),
$lang
);
}
}
else
{
return
0; }
}
else
{
return
0; }
}
}
else
{
return
0; }
$$_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
)
{
$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
)
{
if
(
$j
< 0)
{
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
{
$$_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; }
}
}
else
{
$k
= 0;
while
(DateCalc_scan9(
$string
,
$buffer
,
$length
,
$k
,0)) {
$k
++; }
if
(
$k
>=
$i
)
{
$$_month
=
substr
(
$string
,
$buffer
,
$i
);
}
else
{
$$_month
= DateCalc_Decode_Month(
substr
(
$string
,
$buffer
,
$i
),
$lang
);
if
(
$$_month
== 0) {
return
0; }
}
$buffer
+=
$i
;
$length
-=
$i
;
$j
-=
$i
;
$k
=
$j
+1;
$i
= 1;
while
(DateCalc_scanx(
$string
,
$buffer
,
$length
,
$i
,1)) {
$i
++; }
$j
--;
while
(DateCalc_scan9(
$string
,
$buffer
,
$length
,
$j
,1)) {
$j
--; }
if
(
$j
<
$i
)
{
$buffer
+=
$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
{
$$_year
=
substr
(
$string
,
$buffer
+
$k
,
$length
-
$k
);
$k
=
$i
;
while
(DateCalc_scan9(
$string
,
$buffer
,
$length
,
$k
,0)) {
$k
++; }
if
(
$k
>
$j
)
{
$$_day
=
substr
(
$string
,
$buffer
+
$i
,
$j
-
$i
+1);
}
else
{
return
0; }
}
}
}
else
{
return
0; }
}
$$_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
{
$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
{
$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
;
}
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
();
}
}
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
(); }
}
elsif
(
$buffer
=~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x)
{
(
$day
,
$month
,
$year
) = ($1,$2,$3);
}
else
{
return
(); }
$year
= Moving_Window(
$year
);
if
(check_date(
$year
,
$month
,
$day
))
{
return
(
$year
,
$month
,
$day
);
}
else
{
return
(); }
}
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
();
}
$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
(); }
}
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
();
}
}
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
(); }
}
elsif
(
$buffer
=~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x)
{
(
$month
,
$day
,
$year
) = ($1,$2,$3);
}
else
{
return
(); }
$year
= Moving_Window(
$year
);
if
(check_date(
$year
,
$month
,
$day
))
{
return
(
$year
,
$month
,
$day
);
}
else
{
return
(); }
}
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;