← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Mon Aug 24 11:28:47 2009
Reported on Mon Aug 24 11:29:09 2009

File /usr/share/perl5/Date/Manip.pm
Statements Executed 105
Total Time 0.0514257 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
0000s0sDate::Manip::::BEGINDate::Manip::BEGIN
0000s0sDate::Manip::::DateCalcDate::Manip::DateCalc
0000s0sDate::Manip::::DateManipVersionDate::Manip::DateManipVersion
0000s0sDate::Manip::::Date_CmpDate::Manip::Date_Cmp
0000s0sDate::Manip::::Date_ConvTZDate::Manip::Date_ConvTZ
0000s0sDate::Manip::::Date_DayOfWeekDate::Manip::Date_DayOfWeek
0000s0sDate::Manip::::Date_DayOfYearDate::Manip::Date_DayOfYear
0000s0sDate::Manip::::Date_DaySuffixDate::Manip::Date_DaySuffix
0000s0sDate::Manip::::Date_DaysInMonthDate::Manip::Date_DaysInMonth
0000s0sDate::Manip::::Date_DaysInYearDate::Manip::Date_DaysInYear
0000s0sDate::Manip::::Date_DaysSince1BCDate::Manip::Date_DaysSince1BC
0000s0sDate::Manip::::Date_GetNextDate::Manip::Date_GetNext
0000s0sDate::Manip::::Date_GetPrevDate::Manip::Date_GetPrev
0000s0sDate::Manip::::Date_InitDate::Manip::Date_Init
0000s0sDate::Manip::::Date_IsHolidayDate::Manip::Date_IsHoliday
0000s0sDate::Manip::::Date_IsWorkDayDate::Manip::Date_IsWorkDay
0000s0sDate::Manip::::Date_LeapYearDate::Manip::Date_LeapYear
0000s0sDate::Manip::::Date_NearestWorkDayDate::Manip::Date_NearestWorkDay
0000s0sDate::Manip::::Date_NextWorkDayDate::Manip::Date_NextWorkDay
0000s0sDate::Manip::::Date_NthDayOfYearDate::Manip::Date_NthDayOfYear
0000s0sDate::Manip::::Date_PrevWorkDayDate::Manip::Date_PrevWorkDay
0000s0sDate::Manip::::Date_SecsSince1970Date::Manip::Date_SecsSince1970
0000s0sDate::Manip::::Date_SecsSince1970GMTDate::Manip::Date_SecsSince1970GMT
0000s0sDate::Manip::::Date_SetDateFieldDate::Manip::Date_SetDateField
0000s0sDate::Manip::::Date_SetTimeDate::Manip::Date_SetTime
0000s0sDate::Manip::::Date_TimeZoneDate::Manip::Date_TimeZone
0000s0sDate::Manip::::Date_WeekOfYearDate::Manip::Date_WeekOfYear
0000s0sDate::Manip::::Delta_FormatDate::Manip::Delta_Format
0000s0sDate::Manip::::EraseHolidaysDate::Manip::EraseHolidays
0000s0sDate::Manip::::Events_ListDate::Manip::Events_List
0000s0sDate::Manip::::ParseDateDate::Manip::ParseDate
0000s0sDate::Manip::::ParseDateDeltaDate::Manip::ParseDateDelta
0000s0sDate::Manip::::ParseDateStringDate::Manip::ParseDateString
0000s0sDate::Manip::::ParseRecurDate::Manip::ParseRecur
0000s0sDate::Manip::::UnixDateDate::Manip::UnixDate
0000s0sDate::Manip::::_Char_8BitDate::Manip::_Char_8Bit
0000s0sDate::Manip::::_CheckFilePathDate::Manip::_CheckFilePath
0000s0sDate::Manip::::_CheckTimeDate::Manip::_CheckTime
0000s0sDate::Manip::::_CleanFileDate::Manip::_CleanFile
0000s0sDate::Manip::::_DateCalc_DateDateDate::Manip::_DateCalc_DateDate
0000s0sDate::Manip::::_DateCalc_DateDeltaDate::Manip::_DateCalc_DateDelta
0000s0sDate::Manip::::_DateCalc_DeltaDeltaDate::Manip::_DateCalc_DeltaDelta
0000s0sDate::Manip::::_Date_DateCheckDate::Manip::_Date_DateCheck
0000s0sDate::Manip::::_Date_EasterDate::Manip::_Date_Easter
0000s0sDate::Manip::::_Date_FixYearDate::Manip::_Date_FixYear
0000s0sDate::Manip::::_Date_InitFileDate::Manip::_Date_InitFile
0000s0sDate::Manip::::_Date_InitHashDate::Manip::_Date_InitHash
0000s0sDate::Manip::::_Date_InitListsDate::Manip::_Date_InitLists
0000s0sDate::Manip::::_Date_InitStringsDate::Manip::_Date_InitStrings
0000s0sDate::Manip::::_Date_Init_CatalanDate::Manip::_Date_Init_Catalan
0000s0sDate::Manip::::_Date_Init_DanishDate::Manip::_Date_Init_Danish
0000s0sDate::Manip::::_Date_Init_DutchDate::Manip::_Date_Init_Dutch
0000s0sDate::Manip::::_Date_Init_EnglishDate::Manip::_Date_Init_English
0000s0sDate::Manip::::_Date_Init_FrenchDate::Manip::_Date_Init_French
0000s0sDate::Manip::::_Date_Init_GermanDate::Manip::_Date_Init_German
0000s0sDate::Manip::::_Date_Init_ItalianDate::Manip::_Date_Init_Italian
0000s0sDate::Manip::::_Date_Init_PolishDate::Manip::_Date_Init_Polish
0000s0sDate::Manip::::_Date_Init_PortugueseDate::Manip::_Date_Init_Portuguese
0000s0sDate::Manip::::_Date_Init_RomanianDate::Manip::_Date_Init_Romanian
0000s0sDate::Manip::::_Date_Init_RussianDate::Manip::_Date_Init_Russian
0000s0sDate::Manip::::_Date_Init_SpanishDate::Manip::_Date_Init_Spanish
0000s0sDate::Manip::::_Date_Init_SwedishDate::Manip::_Date_Init_Swedish
0000s0sDate::Manip::::_Date_Init_TurkishDate::Manip::_Date_Init_Turkish
0000s0sDate::Manip::::_Date_JoinDate::Manip::_Date_Join
0000s0sDate::Manip::::_Date_NthWeekOfYearDate::Manip::_Date_NthWeekOfYear
0000s0sDate::Manip::::_Date_ParseTimeDate::Manip::_Date_ParseTime
0000s0sDate::Manip::::_Date_RecurDate::Manip::_Date_Recur
0000s0sDate::Manip::::_Date_RecurSetTimeDate::Manip::_Date_RecurSetTime
0000s0sDate::Manip::::_Date_Recur_WoMDate::Manip::_Date_Recur_WoM
0000s0sDate::Manip::::_Date_RegexpDate::Manip::_Date_Regexp
0000s0sDate::Manip::::_Date_SetConfigVariableDate::Manip::_Date_SetConfigVariable
0000s0sDate::Manip::::_Date_SplitDate::Manip::_Date_Split
0000s0sDate::Manip::::_Date_TimeCheckDate::Manip::_Date_TimeCheck
0000s0sDate::Manip::::_Date_UpdateHolidaysDate::Manip::_Date_UpdateHolidays
0000s0sDate::Manip::::_Delta_NormalizeDate::Manip::_Delta_Normalize
0000s0sDate::Manip::::_Delta_SplitDate::Manip::_Delta_Split
0000s0sDate::Manip::::_Events_CalcDate::Manip::_Events_Calc
0000s0sDate::Manip::::_Events_ParseRawDate::Manip::_Events_ParseRaw
0000s0sDate::Manip::::_ExpandTildeDate::Manip::_ExpandTilde
0000s0sDate::Manip::::_FixPathDate::Manip::_FixPath
0000s0sDate::Manip::::_FullFilePathDate::Manip::_FullFilePath
0000s0sDate::Manip::::_IsIntDate::Manip::_IsInt
0000s0sDate::Manip::::_ModuloAdditionDate::Manip::_ModuloAddition
0000s0sDate::Manip::::_Recur_SplitDate::Manip::_Recur_Split
0000s0sDate::Manip::::_ReturnListDate::Manip::_ReturnList
0000s0sDate::Manip::::_SearchPathDate::Manip::_SearchPath
0000s0sDate::Manip::::_sortByLengthDate::Manip::_sortByLength
LineStmts.Exclusive
Time		Avg.Code
1package Date::Manip;
2# Copyright (c) 1995-2008 Sullivan Beck. All rights reserved.
3# This program is free software; you can redistribute it and/or modify it
4# under the same terms as Perl itself.
5
6###########################################################################
7###########################################################################
8
9336µs12µsuse warnings;
# spent 22µs making 1 call to warnings::import
10
113692µs231µsuse vars qw($OS %Lang %Holiday %Events %Curr %Cnf %Zone $VERSION @ISA @EXPORT);
# spent 110µs making 1 call to vars::import
12
13# Determine the type of OS...
1412µs2µs$OS="Unix";
1518µs8µs$OS="Windows" if ((defined $^O and
16 $^O =~ /MSWin32/i ||
17 $^O =~ /Windows_95/i ||
18 $^O =~ /Windows_NT/i) ||
19 (defined $ENV{OS} and
20 $ENV{OS} =~ /MSWin32/i ||
21 $ENV{OS} =~ /Windows_95/i ||
22 $ENV{OS} =~ /Windows_NT/i));
231700ns700ns$OS="Unix" if (defined $^O and
24 $^O =~ /cygwin/i);
251400ns400ns$OS="Netware" if (defined $^O and
26 $^O =~ /NetWare/i);
2714µs4µs$OS="Mac" if ((defined $^O and
28 $^O =~ /MacOS/i) ||
29 (defined $ENV{OS} and
30 $ENV{OS} =~ /MacOS/i));
311800ns800ns$OS="MPE" if (defined $^O and
32 $^O =~ /MPE/i);
331600ns600ns$OS="OS2" if (defined $^O and
34 $^O =~ /os2/i);
351500ns500ns$OS="VMS" if (defined $^O and
36 $^O =~ /VMS/i);
371600ns600ns$OS="AIX" if (defined $^O and
38 $^O =~ /aix/i);
39
40# Determine if we're doing taint checking
41437µs9µs$Date::Manip::NoTaint = eval { local $^W=0; eval("#" . substr($^X, 0, 0)); 1 };
42
43###########################################################################
44# CUSTOMIZATION
45###########################################################################
46#
47# See the section of the POD documentation section CUSTOMIZING DATE::MANIP
48# below for a complete description of each of these variables.
49
50
51# Location of a the global config file. Tilde (~) expansions are allowed.
52# This should be set in Date_Init arguments.
5312µs2µs$Cnf{"GlobalCnf"}="/etc/DateManip.cnf";
541900ns900ns$Cnf{"IgnoreGlobalCnf"}="";
55
56# Name of a personal config file and the path to search for it. Tilde (~)
57# expansions are allowed. This should be set in Date_Init arguments or in
58# the global config file.
59
6012µs2µs@Date::Manip::DatePath=();
6112µs2µsif ($OS eq "Windows") {
62 $Cnf{"PathSep"} = ";";
63 $Cnf{"PersonalCnf"} = "Manip.cnf";
64 $Cnf{"PersonalCnfPath"} = ".";
65
66} elsif ($OS eq "Netware") {
67 $Cnf{"PathSep"} = ";";
68 $Cnf{"PersonalCnf"} = "Manip.cnf";
69 $Cnf{"PersonalCnfPath"} = ".";
70
71} elsif ($OS eq "MPE") {
72 $Cnf{"PathSep"} = ":";
73 $Cnf{"PersonalCnf"} = "Manip.cnf";
74 $Cnf{"PersonalCnfPath"} = ".";
75
76} elsif ($OS eq "OS2") {
77 $Cnf{"PathSep"} = ":";
78 $Cnf{"PersonalCnf"} = "Manip.cnf";
79 $Cnf{"PersonalCnfPath"} = ".";
80
81} elsif ($OS eq "Mac") {
82 $Cnf{"PathSep"} = ":";
83 $Cnf{"PersonalCnf"} = "Manip.cnf";
84 $Cnf{"PersonalCnfPath"} = ".";
85
86} elsif ($OS eq "VMS") {
87 # VMS doesn't like files starting with "."
88 $Cnf{"PathSep"} = ",";
89 $Cnf{"PersonalCnf"} = "Manip.cnf";
90 $Cnf{"PersonalCnfPath"} = "/sys\$login";
91
92} else {
93 # Unix
941700ns700ns $Cnf{"PathSep"} = ":";
9511µs1µs $Cnf{"PersonalCnf"} = ".DateManip.cnf";
9611µs1µs $Cnf{"PersonalCnfPath"} = ".:~";
9712µs2µs @Date::Manip::DatePath=qw(/bin /usr/bin /usr/local/bin);
98}
99
100### Date::Manip variables set in the global or personal config file
101
102# Which language to use when parsing dates.
1031800ns800ns$Cnf{"Language"}="English";
104
105# 12/10 = Dec 10 (US) or Oct 12 (anything else)
1061900ns900ns$Cnf{"DateFormat"}="US";
107
108# Local timezone
1091500ns500ns$Cnf{"TZ"}="";
110
111# Timezone to work in (""=local, "IGNORE", or a timezone)
11212µs2µs$Cnf{"ConvTZ"}="";
113
114# Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
1151600ns600ns$Cnf{"Internal"}=0;
116
117# First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
1181900ns900ns$Cnf{"FirstDay"}=1;
119
120# First and last day of the work week (1=monday, 7=sunday)
1211700ns700ns$Cnf{"WorkWeekBeg"}=1;
1221600ns600ns$Cnf{"WorkWeekEnd"}=5;
123
124# If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
125# ignored)
1261600ns600ns$Cnf{"WorkDay24Hr"}=0;
127
128# Start and end time of the work day (any time format allowed, seconds
129# ignored)
13011µs1µs$Cnf{"WorkDayBeg"}="08:00";
1311600ns600ns$Cnf{"WorkDayEnd"}="17:00";
132
133# If "today" is a holiday, we look either to "tomorrow" or "yesterday" for
134# the nearest business day. By default, we'll always look "tomorrow"
135# first.
13612µs2µs$Cnf{"TomorrowFirst"}=1;
137
138# Erase the old holidays
1391800ns800ns$Cnf{"EraseHolidays"}="";
140
141# Set this to non-zero to be produce completely backwards compatible deltas
1421700ns700ns$Cnf{"DeltaSigns"}=0;
143
144# If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
145# make week 1 contain Jan 1.
1461600ns600ns$Cnf{"Jan1Week1"}=0;
147
148# 2 digit years fall into the 100 year period given by [ CURR-N,
149# CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful
150# numbers might be 0 (forced to be this year or later) and 99 (forced to be
151# this year or earlier). It can also be set to "c" (current century) or
152# "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the
153# form cNNNN to give the 100 year period NNNN to NNNN+99.
15411µs1µs$Cnf{"YYtoYYYY"}=89;
155
156# Set this to 1 if you want a long-running script to always update the
157# timezone. This will slow Date::Manip down. Read the POD documentation.
1581600ns600ns$Cnf{"UpdateCurrTZ"}=0;
159
160# Use an international character set.
1611500ns500ns$Cnf{"IntCharSet"}=0;
162
163# Use this to force the current date to be set to this:
1641700ns700ns$Cnf{"ForceDate"}="";
165
166# Use this to make "today" mean "today at midnight".
1671800ns800ns$Cnf{"TodayIsMidnight"}=0;
168
169###########################################################################
170
171134µs34µsrequire 5.000;
17211µs1µsrequire Exporter;
17319µs9µs@ISA = qw(Exporter);
17417µs7µs@EXPORT = qw(
175 DateManipVersion
176 Date_Init
177 ParseDateString
178 ParseDate
179 ParseRecur
180 Date_Cmp
181 DateCalc
182 ParseDateDelta
183 UnixDate
184 Delta_Format
185 Date_GetPrev
186 Date_GetNext
187 Date_SetTime
188 Date_SetDateField
189 Date_IsHoliday
190 Events_List
191
192 Date_DaysInMonth
193 Date_DayOfWeek
194 Date_SecsSince1970
195 Date_SecsSince1970GMT
196 Date_DaysSince1BC
197 Date_DayOfYear
198 Date_DaysInYear
199 Date_WeekOfYear
200 Date_LeapYear
201 Date_DaySuffix
202 Date_ConvTZ
203 Date_TimeZone
204 Date_IsWorkDay
205 Date_NextWorkDay
206 Date_PrevWorkDay
207 Date_NearestWorkDay
208 Date_NthDayOfYear
209);
210328µs9µsuse strict;
# spent 9µs making 1 call to strict::import
211334µs11µsuse integer;
# spent 12µs making 1 call to integer::import
212328µs9µsuse Carp;
# spent 55µs making 1 call to Exporter::import
213
2143118µs40µsuse IO::File;
# spent 147µs making 1 call to Exporter::import
215
2161500ns500ns$VERSION="5.54";
217
218########################################################################
219########################################################################
220
22111µs1µs$Curr{"InitLang"} = 1; # Whether a language is being init'ed
22212µs2µs$Curr{"InitDone"} = 0; # Whether Init_Date has been called
2231500ns500ns$Curr{"InitFilesRead"} = 0;
2241700ns700ns$Curr{"ResetWorkDay"} = 1;
22511µs1µs$Curr{"Debug"} = "";
22611µs1µs$Curr{"DebugVal"} = "";
227
22811µs1µs$Holiday{"year"} = 0;
22911µs1µs$Holiday{"dates"} = {};
2301800ns800ns$Holiday{"desc"} = {};
231
23211µs1µs$Events{"raw"} = [];
2331800ns800ns$Events{"parsed"} = 0;
2341600ns600ns$Events{"dates"} = [];
2351800ns800ns$Events{"recur"} = [];
236
237########################################################################
238########################################################################
239# THESE ARE THE MAIN ROUTINES
240########################################################################
241########################################################################
242
243# Get rid of a problem with old versions of perl
244359µs20µsno strict "vars";
# spent 22µs making 1 call to strict::unimport
245# This sorts from longest to shortest element
246sub _sortByLength {
247 return (length $b <=> length $a);
248}
249313.7ms4.58msuse strict "vars";
# spent 16µs making 1 call to strict::import
250
251sub DateManipVersion {
252 print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
253 return $VERSION;
254}
255
256sub Date_Init {
257 print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
258 $Curr{"Debug"}="";
259
260 my(@args)=@_;
261 $Curr{"InitDone"}=1;
262 local($_)=();
263 my($internal,$firstday)=();
264 my($var,$val,$file,@tmp)=();
265
266 # InitFilesRead = 0 : no conf files read yet
267 # 1 : global read, no personal read
268 # 2 : personal read
269
270 $Cnf{"EraseHolidays"}=0;
271 foreach (@args) {
272 s/\s*$//;
273 s/^\s*//;
274 /^(\S+) \s* = \s* (.*)$/x;
275 ($var,$val)=($1,$2);
276 if ($var =~ /^GlobalCnf$/i) {
277 $Cnf{"GlobalCnf"}=$val;
278 if ($val) {
279 $Curr{"InitFilesRead"}=0;
280 EraseHolidays();
281 }
282 } elsif ($var =~ /^PathSep$/i) {
283 $Cnf{"PathSep"}=$val;
284 } elsif ($var =~ /^PersonalCnf$/i) {
285 $Cnf{"PersonalCnf"}=$val;
286 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
287 } elsif ($var =~ /^PersonalCnfPath$/i) {
288 $Cnf{"PersonalCnfPath"}=$val;
289 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
290 } elsif ($var =~ /^IgnoreGlobalCnf$/i) {
291 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0);
292 $Cnf{"IgnoreGlobalCnf"}=1;
293 } elsif ($var =~ /^EraseHolidays$/i) {
294 EraseHolidays();
295 } else {
296 push(@tmp,$_);
297 }
298 }
299 @args=@tmp;
300
301 # Read global config file
302 if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
303 $Curr{"InitFilesRead"}=1;
304
305 if ($Cnf{"GlobalCnf"}) {
306 $file=_ExpandTilde($Cnf{"GlobalCnf"});
307 _Date_InitFile($file) if ($file);
308 }
309 }
310
311 # Read personal config file
312 if ($Curr{"InitFilesRead"}<2) {
313 $Curr{"InitFilesRead"}=2;
314
315 if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) {
316 $file=_SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r");
317 _Date_InitFile($file) if ($file);
318 }
319 }
320
321 foreach (@args) {
322 s/\s*$//;
323 s/^\s*//;
324 /^(\S+) \s* = \s* (.*)$/x;
325 ($var,$val)=($1,$2);
326 $val="" if (! defined $val);
327 _Date_SetConfigVariable($var,$val);
328 }
329
330 confess "ERROR: Unknown FirstDay in Date::Manip.\n"
331 if (! _IsInt($Cnf{"FirstDay"},1,7));
332 confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n"
333 if (! _IsInt($Cnf{"WorkWeekBeg"},1,7));
334 confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n"
335 if (! _IsInt($Cnf{"WorkWeekEnd"},1,7));
336 confess "ERROR: Invalid WorkWeek in Date::Manip.\n"
337 if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"});
338
339 my(%lang,
340 $tmp,%tmp,$tmp2,@tmp2,
341 $i,$j,@tmp3,
342 $zonesrfc,@zones)=();
343
344 my($L)=$Cnf{"Language"};
345
346 if ($Curr{"InitLang"}) {
347 $Curr{"InitLang"}=0;
348
349 if ($L eq "English") {
350 _Date_Init_English(\%lang);
351
352 } elsif ($L eq "French") {
353 _Date_Init_French(\%lang);
354
355 } elsif ($L eq "Swedish") {
356 _Date_Init_Swedish(\%lang);
357
358 } elsif ($L eq "German") {
359 _Date_Init_German(\%lang);
360
361 } elsif ($L eq "Polish") {
362 _Date_Init_Polish(\%lang);
363
364 } elsif ($L eq "Dutch" ||
365 $L eq "Nederlands") {
366 _Date_Init_Dutch(\%lang);
367
368 } elsif ($L eq "Spanish") {
369 _Date_Init_Spanish(\%lang);
370
371 } elsif ($L eq "Portuguese") {
372 _Date_Init_Portuguese(\%lang);
373
374 } elsif ($L eq "Romanian") {
375 _Date_Init_Romanian(\%lang);
376
377 } elsif ($L eq "Italian") {
378 _Date_Init_Italian(\%lang);
379
380 } elsif ($L eq "Russian") {
381 _Date_Init_Russian(\%lang);
382
383 } elsif ($L eq "Turkish") {
384 _Date_Init_Turkish(\%lang);
385
386 } elsif ($L eq "Danish") {
387 _Date_Init_Danish(\%lang);
388
389 } elsif ($L eq "Catalan") {
390 _Date_Init_Catalan(\%lang);
391
392 } else {
393 confess "ERROR: Unknown language in Date::Manip.\n";
394 }
395
396 # variables for months
397 # Month = "(jan|january|feb|february ... )"
398 # MonL = [ "Jan","Feb",... ]
399 # MonthL = [ "January","February", ... ]
400 # MonthH = { "january"=>1, "jan"=>1, ... }
401
402 $Lang{$L}{"MonthH"}={};
403 $Lang{$L}{"MonthL"}=[];
404 $Lang{$L}{"MonL"}=[];
405 _Date_InitLists([$lang{"month_name"},
406 $lang{"month_abb"}],
407 \$Lang{$L}{"Month"},"lc,sort,back",
408 [$Lang{$L}{"MonthL"},
409 $Lang{$L}{"MonL"}],
410 [$Lang{$L}{"MonthH"},1]);
411
412 # variables for day of week
413 # Week = "(mon|monday|tue|tuesday ... )"
414 # WL = [ "M","T",... ]
415 # WkL = [ "Mon","Tue",... ]
416 # WeekL = [ "Monday","Tudesday",... ]
417 # WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
418
419 $Lang{$L}{"WeekH"}={};
420 $Lang{$L}{"WeekL"}=[];
421 $Lang{$L}{"WkL"}=[];
422 $Lang{$L}{"WL"}=[];
423 _Date_InitLists([$lang{"day_name"},
424 $lang{"day_abb"}],
425 \$Lang{$L}{"Week"},"lc,sort,back",
426 [$Lang{$L}{"WeekL"},
427 $Lang{$L}{"WkL"}],
428 [$Lang{$L}{"WeekH"},1]);
429 _Date_InitLists([$lang{"day_char"}],
430 "","lc",
431 [$Lang{$L}{"WL"}],
432 [\%tmp,1]);
433 %{ $Lang{$L}{"WeekH"} } =
434 (%{ $Lang{$L}{"WeekH"} },%tmp);
435
436 # variables for last
437 # Last = "(last)"
438 # LastL = [ "last" ]
439 # Each = "(each)"
440 # EachL = [ "each" ]
441 # variables for day of month
442 # DoM = "(1st|first ... 31st)"
443 # DoML = [ "1st","2nd",... "31st" ]
444 # DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 }
445 # variables for week of month
446 # WoM = "(1st|first| ... 5th|last)"
447 # WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 }
448
449 $Lang{$L}{"LastL"}=$lang{"last"};
450 _Date_InitStrings($lang{"last"},
451 \$Lang{$L}{"Last"},"lc,sort");
452
453 $Lang{$L}{"EachL"}=$lang{"each"};
454 _Date_InitStrings($lang{"each"},
455 \$Lang{$L}{"Each"},"lc,sort");
456
457 $Lang{$L}{"DoMH"}={};
458 $Lang{$L}{"DoML"}=[];
459 _Date_InitLists([$lang{"num_suff"},
460 $lang{"num_word"}],
461 \$Lang{$L}{"DoM"},"lc,sort,back,escape",
462 [$Lang{$L}{"DoML"},
463 \@tmp],
464 [$Lang{$L}{"DoMH"},1]);
465
466 @tmp=();
467 foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
468 $tmp2=$Lang{$L}{"DoMH"}{$tmp};
469 if ($tmp2<6) {
470 $Lang{$L}{"WoMH"}{$tmp} = $tmp2;
471 push(@tmp,$tmp);
472 }
473 }
474 foreach $tmp (@{ $Lang{$L}{"LastL"} }) {
475 $Lang{$L}{"WoMH"}{$tmp} = -1;
476 push(@tmp,$tmp);
477 }
478 _Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"},
479 "lc,sort,back,escape");
480
481 # variables for AM or PM
482 # AM = "(am)"
483 # PM = "(pm)"
484 # AmPm = "(am|pm)"
485 # AMstr = "AM"
486 # PMstr = "PM"
487
488 _Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape");
489 _Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape");
490 _Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"},
491 "lc,back,sort,escape");
492 $Lang{$L}{"AMstr"}=$lang{"am"}[0];
493 $Lang{$L}{"PMstr"}=$lang{"pm"}[0];
494
495 # variables for expressions used in parsing deltas
496 # Yabb = "(?:y|yr|year|years)"
497 # Mabb = similar for months
498 # Wabb = similar for weeks
499 # Dabb = similar for days
500 # Habb = similar for hours
501 # MNabb = similar for minutes
502 # Sabb = similar for seconds
503 # Repl = { "abb"=>"replacement" }
504 # Whenever an abbreviation could potentially refer to two different
505 # strings (M standing for Minutes or Months), the abbreviation must
506 # be listed in Repl instead of in the appropriate Xabb values. This
507 # only applies to abbreviations which are substrings of other values
508 # (so there is no confusion between Mn and Month).
509
510 _Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort");
511 _Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort");
512 _Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort");
513 _Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort");
514 _Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort");
515 _Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort");
516 _Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort");
517 $Lang{$L}{"Repl"}={};
518 _Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
519
520 # variables for special dates that are offsets from now
521 # Now = "now"
522 # Today = "today"
523 # Offset = "(yesterday|tomorrow)"
524 # OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ]
525 # Times = "(noon|midnight)"
526 # TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" }
527 # SepHM = hour/minute separator
528 # SepMS = minute/second separator
529 # SepSS = second/fraction separator
530
531 $Lang{$L}{"TimesH"}={};
532 _Date_InitHash($lang{"times"},
533 \$Lang{$L}{"Times"},"lc,sort,back",
534 $Lang{$L}{"TimesH"});
535 _Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort");
536 _Date_InitStrings($lang{"today"},\$Lang{$L}{"Today"},"lc,sort");
537 $Lang{$L}{"OffsetH"}={};
538 _Date_InitHash($lang{"offset"},
539 \$Lang{$L}{"Offset"},"lc,sort,back",
540 $Lang{$L}{"OffsetH"});
541 $Lang{$L}{"SepHM"}=$lang{"sephm"};
542 $Lang{$L}{"SepMS"}=$lang{"sepms"};
543 $Lang{$L}{"SepSS"}=$lang{"sepss"};
544
545 # variables for time zones
546 # zones = regular expression with all zone names (EST)
547 # n2o = a hash of all parsable zone names with their offsets
548 # tzones = reguar expression with all tzdata timezones (US/Eastern)
549 # tz2z = hash of all tzdata timezones to full timezone (EST#EDT)
550
551 $zonesrfc=
552 "idlw -1200 ". # International Date Line West
553 "nt -1100 ". # Nome
554 "hst -1000 ". # Hawaii Standard
555 "cat -1000 ". # Central Alaska
556 "ahst -1000 ". # Alaska-Hawaii Standard
557 "akst -0900 ". # Alaska Standard
558 "yst -0900 ". # Yukon Standard
559 "hdt -0900 ". # Hawaii Daylight
560 "akdt -0800 ". # Alaska Daylight
561 "ydt -0800 ". # Yukon Daylight
562 "pst -0800 ". # Pacific Standard
563 "pdt -0700 ". # Pacific Daylight
564 "mst -0700 ". # Mountain Standard
565 "mdt -0600 ". # Mountain Daylight
566 "cst -0600 ". # Central Standard
567 "cdt -0500 ". # Central Daylight
568 "est -0500 ". # Eastern Standard
569 "act -0500 ". # Brazil, Acre
570 "pet -0500 ". # Peruvian time
571 "vet -0430 ". # Venezuela
572 "sat -0400 ". # Chile
573 "clt -0400 ". # Chile Standard
574 "clst -0400 ". # Chile Standard
575 "bot -0400 ". # Bolivia
576 "amt -0400 ". # Brazil, Amazon
577 "acst -0400 ". # Brazil, Acre Daylight
578 "edt -0400 ". # Eastern Daylight
579 "ast -0400 ". # Atlantic Standard
580 #"nst -0330 ". # Newfoundland Standard nst=North Sumatra +0630
581 "nft -0330 ". # Newfoundland
582 #"gst -0300 ". # Greenland Standard gst=Guam Standard +1000
583 "cldt -0300 ". # Chile Daylight
584 #"bst -0300 ". # Brazil Standard bst=British Summer +0100
585 "brt -0300 ". # Brazil Standard (official time)
586 #"brst -0300 ". # Brazil Standard
587 "adt -0300 ". # Atlantic Daylight
588 "art -0300 ". # Argentina
589 "arst -0200 ". # Argentina, Daylight
590 "amst -0300 ". # Brazil, Amazon Daylight
591 "uyt -0300 ". # Uruguay
592 "ndt -0230 ". # Newfoundland Daylight
593 "brst -0200 ". # Brazil Daylight (official time)
594 "fnt -0200 ". # Brazil, Fernando de Noronha
595 "at -0200 ". # Azores
596 "uyst -0200 ". # Uruguay
597 "wat -0100 ". # West Africa
598 "fnst -0100 ". # Brazil, Fernando de Noronha Daylight
599 "gmt +0000 ". # Greenwich Mean
600 "ut +0000 ". # Universal
601 "utc +0000 ". # Universal (Coordinated)
602 "wet +0000 ". # Western European
603 "cet +0100 ". # Central European
604 "fwt +0100 ". # French Winter
605 "met +0100 ". # Middle European
606 "mez +0100 ". # Middle European
607 "mewt +0100 ". # Middle European Winter
608 "swt +0100 ". # Swedish Winter
609 "bst +0100 ". # British Summer bst=Brazil standard -0300
610 "gb +0100 ". # GMT with daylight savings
611 "west +0100 ". # Western European Daylight
612 "eet +0200 ". # Eastern Europe, USSR Zone 1
613 "cest +0200 ". # Central European Summer
614 "fst +0200 ". # French Summer
615 "ist +0200 ". # Israel standard
616 "mest +0200 ". # Middle European Summer
617 "mesz +0200 ". # Middle European Summer
618 "metdst +0200 ". # An alias for mest used by HP-UX
619 "sast +0200 ". # South African Standard
620 "sst +0200 ". # Swedish Summer sst=South Sumatra +0700
621 "bt +0300 ". # Baghdad, USSR Zone 2
622 "eest +0300 ". # Eastern Europe Summer
623 "eetdst +0300 ". # An alias for eest used by HP-UX
624 "eetedt +0300 ". # Eastern Europe, USSR Zone 1
625 "idt +0300 ". # Israel Daylight
626 "msk +0300 ". # Moscow
627 "eat +0300 ". # East Africa
628 "it +0330 ". # Iran
629 "zp4 +0400 ". # USSR Zone 3
630 "msd +0400 ". # Moscow Daylight
631 "zp5 +0500 ". # USSR Zone 4
632 "yekt +0500 ". # Yeakaterinburg time zone, Russia
633 "yekst +0500 ". # Yeakaterinburg summer time zone, Russia
634 "ist +0530 ". # Indian Standard
635 "zp6 +0600 ". # USSR Zone 5
636 "novt +0600 ". # Novosibirsk winter time zone, Russia
637 "omst +0600 ". # Omsk time zone, Russia
638 "nst +0630 ". # North Sumatra nst=Newfoundland Std -0330
639 #"sst +0700 ". # South Sumatra, USSR Zone 6 sst=Swedish Summer +0200
640 "javt +0700 ". # Java
641 "ict +0700 ". # Indo China Time
642 "novst +0700 ". # Novosibirsk summer time zone, Russia
643 "krat +0700 ". # Krasnoyarsk, Russia
644 "myt +0800 ". # Malaysia
645 "hkt +0800 ". # Hong Kong
646 "sgt +0800 ". # Singapore
647 "cct +0800 ". # China Coast, USSR Zone 7
648 "krast +0800 ". # Krasnoyarsk, Russia Daylight
649 "awst +0800 ". # Australian Western Standard
650 "wst +0800 ". # West Australian Standard
651 "pht +0800 ". # Asia Manila
652 "kst +0900 ". # Republic of Korea
653 "jst +0900 ". # Japan Standard, USSR Zone 8
654 "rok +0900 ". # Republic of Korea
655 "acst +0930 ". # Australian Central Standard
656 "cast +0930 ". # Central Australian Standard
657 "aest +1000 ". # Australian Eastern Standard
658 "east +1000 ". # Eastern Australian Standard
659 "gst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
660 "chst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
661 "acdt +1030 ". # Australian Central Daylight
662 "cadt +1030 ". # Central Australian Daylight
663 "aedt +1100 ". # Australian Eastern Daylight
664 "eadt +1100 ". # Eastern Australian Daylight
665 "idle +1200 ". # International Date Line East
666 "nzst +1200 ". # New Zealand Standard
667 "nzt +1200 ". # New Zealand
668 "nzdt +1300 ". # New Zealand Daylight
669 "z +0000 ".
670 "a +0100 b +0200 c +0300 d +0400 e +0500 f +0600 g +0700 h +0800 ".
671 "i +0900 k +1000 l +1100 m +1200 ".
672 "n -0100 o -0200 p -0300 q -0400 r -0500 s -0600 t -0700 u -0800 ".
673 "v -0900 w -1000 x -1100 y -1200";
674
675 $Zone{"n2o"} = {};
676 ($Zone{"zones"},%{ $Zone{"n2o"} })=
677 _Date_Regexp($zonesrfc,"sort,lc,under,back",
678 "keys");
679
680 $tmp=
681 "US/Pacific PST8PDT ".
682 "US/Mountain MST7MDT ".
683 "US/Central CST6CDT ".
684 "US/Eastern EST5EDT ".
685 "Canada/Pacific PST8PDT ".
686 "Canada/Mountain MST7MDT ".
687 "Canada/Central CST6CDT ".
688 "Canada/Eastern EST5EDT";
689
690 $Zone{"tz2z"} = {};
691 ($Zone{"tzones"},%{ $Zone{"tz2z"} })=
692 _Date_Regexp($tmp,"lc,under,back","keys");
693 $Cnf{"TZ"}=Date_TimeZone();
694
695 # misc. variables
696 # At = "(?:at)"
697 # Of = "(?:in|of)"
698 # On = "(?:on)"
699 # Future = "(?:in)"
700 # Later = "(?:later)"
701 # Past = "(?:ago)"
702 # Next = "(?:next)"
703 # Prev = "(?:last|previous)"
704
705 _Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort");
706 _Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort");
707 _Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort");
708 _Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort");
709 _Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort");
710 _Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort");
711 _Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort");
712 _Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort");
713
714 # calc mode variables
715 # Approx = "(?:approximately)"
716 # Exact = "(?:exactly)"
717 # Business = "(?:business)"
718
719 _Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort");
720 _Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort");
721 _Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort");
722
723 ############### END OF LANGUAGE INITIALIZATION
724 }
725
726 if ($Curr{"ResetWorkDay"}) {
727 my($h1,$m1,$h2,$m2)=();
728 if ($Cnf{"WorkDay24Hr"}) {
729 ($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
730 ($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
731 $Curr{"WDlen"}=24*60;
732 $Cnf{"WorkDayBeg"}="00:00";
733 $Cnf{"WorkDayEnd"}="23:59";
734
735 } else {
736 confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n"
737 if (! (($h1,$m1)=_CheckTime($Cnf{"WorkDayBeg"})));
738 $Cnf{"WorkDayBeg"}="$h1:$m1";
739 confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n"
740 if (! (($h2,$m2)=_CheckTime($Cnf{"WorkDayEnd"})));
741 $Cnf{"WorkDayEnd"}="$h2:$m2";
742
743 ($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
744 ($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
745
746 # Work day length = h1:m1 or 0:len (len minutes)
747 $h1=$h2-$h1;
748 $m1=$m2-$m1;
749 if ($m1<0) {
750 $h1--;
751 $m1+=60;
752 }
753 $Curr{"WDlen"}=$h1*60+$m1;
754 }
755 $Curr{"ResetWorkDay"}=0;
756 }
757
758 # current time
759 my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
760 if ($Cnf{"ForceDate"}=~
761 /^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
762 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
763 } else {
764 ($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
765 $y+=1900;
766 $m++;
767 }
768 _Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
769 $Curr{"Y"}=$y;
770 $Curr{"M"}=$m;
771 $Curr{"D"}=$d;
772 $Curr{"H"}=$h;
773 $Curr{"Mn"}=$mn;
774 $Curr{"S"}=$s;
775 $Curr{"AmPm"}=$ampm;
776 $Curr{"Now"}=_Date_Join($y,$m,$d,$h,$mn,$s);
777 if ($Cnf{"TodayIsMidnight"}) {
778 $Curr{"Today"}=_Date_Join($y,$m,$d,0,0,0);
779 } else {
780 $Curr{"Today"}=$Curr{"Now"};
781 }
782
783 $Curr{"Debug"}=$Curr{"DebugVal"};
784
785 # If we're in array context, let's return a list of config variables
786 # that could be passed to Date_Init to get the same state as we're
787 # currently in.
788 if (wantarray) {
789 # Some special variables that have to be in a specific order
790 my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
791 my(%tmp)=map { $_,1 } @special;
792 my(@tmp,$key,$val);
793 foreach $key (@special) {
794 $val=$Cnf{$key};
795 push(@tmp,"$key=$val");
796 }
797 foreach $key (keys %Cnf) {
798 next if (exists $tmp{$key});
799 $val=$Cnf{$key};
800 push(@tmp,"$key=$val");
801 }
802 return @tmp;
803 }
804 return ();
805}
806
807sub ParseDateString {
808 print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
809 local($_)=@_;
810 return "" if (! $_);
811
812 my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
813 my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
814
815 # We only need to reinitialize if we have to determine what NOW is.
816 Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
817
818 my($L)=$Cnf{"Language"};
819 my($type)=$Cnf{"DateFormat"};
820
821 # Mode is set in DateCalc. ParseDate only overrides it if the string
822 # contains a mode.
823 if ($Lang{$L}{"Exact"} &&
824 s/$Lang{$L}{"Exact"}//) {
825 $Curr{"Mode"}=0;
826 } elsif ($Lang{$L}{"Approx"} &&
827 s/$Lang{$L}{"Approx"}//) {
828 $Curr{"Mode"}=1;
829 } elsif ($Lang{$L}{"Business"} &&
830 s/$Lang{$L}{"Business"}//) {
831 $Curr{"Mode"}=2;
832 } elsif (! exists $Curr{"Mode"}) {
833 $Curr{"Mode"}=0;
834 }
835
836 # Unfortunately, some deltas can be parsed as dates. An example is
837 # 1 second == 1 2nd == 1 2
838 # But, some dates can be parsed as deltas. The most important being:
839 # 1998010101:00:00
840 #
841 # We'll check to see if a "date" can be parsed as a delta. If so, we'll
842 # assume that it is a delta (since they are much simpler, it is much
843 # less likely that we'll mistake a delta for a date than vice versa)
844 # unless it is an ISO-8601 date.
845 #
846 # This is important because we are using DateCalc to test whether a
847 # string is a date or a delta. Dates are tested first, so we need to
848 # be able to pass a delta into this routine and have it correctly NOT
849 # interpreted as a date.
850 #
851 # We will insist that the string contain something other than digits and
852 # colons so that the following will get correctly interpreted as a date
853 # rather than a delta:
854 # 12:30
855 # 19980101
856
857 $delta="";
858 $delta=ParseDateDelta($_) if (/[^:0-9]/);
859
860 # Put parse in a simple loop for an easy exit.
861 PARSE: {
862 my(@tmp)=_Date_Split($_);
863 if (@tmp) {
864 ($y,$m,$d,$h,$mn,$s)=@tmp;
865 last PARSE;
866 }
867
868 # Fundamental regular expressions
869
870 my($month)=$Lang{$L}{"Month"}; # (jan|january|...)
871 my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
872 my($week)=$Lang{$L}{"Week"}; # (mon|monday|...)
873 my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
874 my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last)
875 my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
876 my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st)
877 my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
878 my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm)
879 my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight)
880 my($now)=$Lang{$L}{"Now"}; # now
881 my($today)=$Lang{$L}{"Today"}; # today
882 my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow)
883 my($zone)=$Zone{"zones"}; # (edt|est|...)
884 my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days)
885 my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months)
886 my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks)
887 my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next)
888 my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous)
889 my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago)
890 my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in)
891 my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later)
892 my($at)=$Lang{$L}{"At"}; # (?:at)
893 my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of)
894 my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)';
895 # \s*(?:on)\s* or \s+
896 my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last)
897 my($hm)=$Lang{$L}{"SepHM"}; # :
898 my($ms)=$Lang{$L}{"SepMS"}; # :
899 my($ss)=$Lang{$L}{"SepSS"}; # .
900
901 # Other regular expressions
902
903 my($D4)='(\d{4})'; # 4 digits (yr)
904 my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr)
905 my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
906 my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
907 my($FS)="(?:$ss\\d+)?"; # fractional secs
908 my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
909 # absolute time zone +0700 (GMT)
910 my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23
911 my($mzone)='(?:[0-5][0-9])'; # 00 - 59
912 my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))".
913 # +0700 +07:00 -07
914 '(?:\s*\([^)]+\))?)'; # (GMT)
915
916 # A regular expression for the time EXCEPT for the hour part
917 my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
918
919 # A special regular expression for /YYYY:HH:MN:SS used by Apache
920 my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
921
922 my($time)="";
923 $ampm="";
924 $date="";
925
926 # Substitute all special time expressions.
927 if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
928 $tmp=$2;
929 $tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
930 s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
931 }
932
933 # Remove some punctuation
934 s/[,]/ /g;
935
936 # When we have a digit followed immediately by a timezone (7EST), we
937 # will put a space between the digit, EXCEPT in the case of a single
938 # character military timezone. If the single character is followed
939 # by anything, no space is added.
940 $tmp = "";
941 while ( s/^(.*?\d)$zone(\s|$|[0-9])/$3/i ) {
942 my($bef,$z,$aft) = ($1,$2,$3);
943 if (length($z) != 1 || length($aft) == 0) {
944 $tmp .= "$bef $z";
945 } else {
946 $tmp .= "$bef$z";
947 }
948 }
949 $_ = "$tmp$_";
950 $zone = '\s+' . $zone . '(?:\s+|$)';
951
952 # Remove the time
953 $iso=1;
954 $midnight=0;
955 $from="24${hm}00(?:${ms}00)?";
956 $falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
957 $to="00${hm}00${ms}00";
958 $midnight=1 if (!/$falsefrom/ && s/$from/$to/);
959
960 $h=$mn=$s=0;
961 if (/$D$mnsec/i || /$ampmexp/i) {
962 $iso=0;
963 $tmp=0;
964 $tmp=1 if (/$mnsec$zone2?\s*$/i or /$mnsec$zone\s*$/i);
965 $tmp=0 if (/$ampmexp/i);
966 if (s/$apachetime$zone()/$1 /i ||
967 s/$apachetime$zone2?/$1 /i ||
968 s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i ||
969 s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i ||
970 s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i ||
971 s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i ||
972 (s/(t)$D$mnsec$zone()/$1 /i and (($iso=$tmp) || 1)) ||
973 (s/(t)$D$mnsec$zone2?/$1 /i and (($iso=$tmp) || 1)) ||
974 (s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) ||
975 (s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) ||
976 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i ||
977 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i ||
978 0
979 ) {
980 ($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
981 if (defined ($z)) {
982 if ($z =~ /^[+-]\d{2}:\d{2}$/) {
983 $z=~ s/://;
984 } elsif ($z =~ /^[+-]\d{2}$/) {
985 $z .= "00";
986 }
987 }
988 $time=1;
989 _Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
990 $y=$m=$d="";
991 # We're going to be calling TimeCheck again below (when we check the
992 # final date), so get rid of $ampm so that we don't have an error
993 # due to "15:30:00 PM". It'll get reset below.
994 $ampm="";
995 if (/^\s*$/) {
996 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
997 last PARSE;
998 }
999 }
1000 }
1001 $time=0 if ($time ne "1");
1002 s/\s+$//;
1003 s/^\s+//;
1004
1005 # if a zone was found, get rid of the regexps
1006 if ($z) {
1007 $zone="";
1008 $zone2="";
1009 }
1010
1011 # dateTtime ISO 8601 formats
1012 my($orig)=$_;
1013
1014 # Parse ISO 8601 dates now (which may still have a zone stuck to it).
1015 if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) ||
1016 ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) ||
1017 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) ||
1018 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) ||
1019 ($iso && /^([0-9-]+)T$zone?$/i) ||
1020 ($iso && /^([0-9-]+)T$zone2?$/i) ||
1021 0) {
1022
1023 # If we already got a timezone, don't get another one.
1024 my(@z);
1025 if ($z) {
1026 @z=($z,$z2);
1027 $z="";
1028 }
1029 ($_,$z,$z2) = ($1,$2,$3);
1030 ($z,$z2)=@z if (@z);
1031
1032 s,([0-9])\s*-,$1 ,g; # Change all ISO8601 seps to spaces
1033 s/^\s+//;
1034 s/\s+$//;
1035
1036 if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
1037 /^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
1038 0
1039 ) {
1040 # ISO 8601 Dates with times
1041 # YYYYMMDDtHHMNSSFFFF...
1042 # YYYYMMDDtHHMNSS
1043 # YYYYMMDDtHHMN
1044 # YYYYMMDDtHH
1045 # YY MMDDtHHMNSSFFFF...
1046 # YY MMDDtHHMNSS
1047 # YY MMDDtHHMN
1048 # YY MMDDtHH
1049 # The t is an optional letter "t".
1050 ($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
1051 if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) {
1052 $h=0;
1053 $midnight=1;
1054 }
1055 $z = "" if (! defined $h);
1056 return "" if ($time && defined $h);
1057 last PARSE;
1058
1059 } elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
1060 /^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
1061 # ISO 8601 Dates
1062 # YYYYMMDD
1063 # YYYYMM
1064 # YYYY
1065 # YY MMDD
1066 # YY MM
1067 # YY
1068 ($y,$m,$d)=($1,$2,$3);
1069 last PARSE;
1070
1071 } elsif (/^$YY\s+$D\s+$D/) {
1072 # YY-M-D
1073 ($y,$m,$d)=($1,$2,$3);
1074 last PARSE;
1075
1076 } elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
1077 # YY-W##-D
1078 ($y,$wofm,$dofw)=($1,$2,$3);
1079 ($y,$m,$d)=_Date_NthWeekOfYear($y,$wofm,$dofw);
1080 last PARSE;
1081
1082 } elsif (/^$D4\s*(\d{3})$/ ||
1083 /^$DD\s*(\d{3})$/) {
1084 # YYDOY
1085 ($y,$which)=($1,$2);
1086 ($y,$m,$d)=Date_NthDayOfYear($y,$which);
1087 last PARSE;
1088
1089 } elsif ($iso<0) {
1090 # We confused something like 1999/August12:00:00
1091 # with a dateTtime format
1092 $_=$orig;
1093
1094 } else {
1095 return "";
1096 }
1097 }
1098
1099 # All deltas that are not ISO-8601 dates are NOT dates.
1100 return "" if ($Curr{"InCalc"} && $delta);
1101 if ($delta) {
1102 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1103 return _DateCalc_DateDelta($Curr{"Now"},$delta);
1104 }
1105
1106 # Check for some special types of dates (next, prev)
1107 foreach $from (keys %{ $Lang{$L}{"Repl"} }) {
1108 $to=$Lang{$L}{"Repl"}{$from};
1109 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
1110 }
1111 if (/$wom/i || /$future/i || /$later/i || /$past/i ||
1112 /$next/i || /$prev/i || /^$week$/i || /$wkabb/i) {
1113 $tmp=0;
1114
1115 if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
1116 # last friday in October 95
1117 ($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
1118 # fix $m, $y
1119 return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1120 $dofw=$week{lc($dofw)};
1121 $wofm=$wom{lc($wofm)};
1122 # Get the first day of the month
1123 $date=_Date_Join($y,$m,1,$h,$mn,$s);
1124 if ($wofm==-1) {
1125 $date=_DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0);
1126 $date=Date_GetPrev($date,$dofw,0);
1127 } else {
1128 for ($i=0; $i<$wofm; $i++) {
1129 if ($i==0) {
1130 $date=Date_GetNext($date,$dofw,1);
1131 } else {
1132 $date=Date_GetNext($date,$dofw,0);
1133 }
1134 }
1135 }
1136 last PARSE;
1137
1138 } elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
1139 # last day in month
1140 ($m,$y)=($1,$2);
1141 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1142 $y=_Date_FixYear($y) if (! defined $y or length($y)<4);
1143 $m=$month{lc($m)};
1144 $d=Date_DaysInMonth($m,$y);
1145 last PARSE;
1146
1147 } elsif (/^$week$/i) {
1148 # friday
1149 ($dofw)=($1);
1150 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1151 $date=Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1);
1152 $date=Date_GetNext($date,$dofw,1,$h,$mn,$s);
1153 last PARSE;
1154
1155 } elsif (/^$next\s*$week$/i) {
1156 # next friday
1157 ($dofw)=($1);
1158 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1159 $date=Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s);
1160 last PARSE;
1161
1162 } elsif (/^$prev\s*$week$/i) {
1163 # last friday
1164 ($dofw)=($1);
1165 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1166 $date=Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s);
1167 last PARSE;
1168
1169 } elsif (/^$next$wkabb$/i) {
1170 # next week
1171 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1172 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0);
1173 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1174 last PARSE;
1175 } elsif (/^$prev$wkabb$/i) {
1176 # last week
1177 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1178 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0);
1179 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1180 last PARSE;
1181
1182 } elsif (/^$next$mabb$/i) {
1183 # next month
1184 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1185 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0);
1186 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1187 last PARSE;
1188 } elsif (/^$prev$mabb$/i) {
1189 # last month
1190 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1191 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0);
1192 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1193 last PARSE;
1194
1195 } elsif (/^$future\s*(\d+)$day$/i ||
1196 /^(\d+)$day$later$/i) {
1197 # in 2 days
1198 # 2 days later
1199 ($num)=($1);
1200 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1201 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0",
1202 \$err,0);
1203 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1204 last PARSE;
1205 } elsif (/^(\d+)$day$past$/i) {
1206 # 2 days ago
1207 ($num)=($1);
1208 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1209 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0",
1210 \$err,0);
1211 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1212 last PARSE;
1213
1214 } elsif (/^$future\s*(\d+)$wkabb$/i ||
1215 /^(\d+)$wkabb$later$/i) {
1216 # in 2 weeks
1217 # 2 weeks later
1218 ($num)=($1);
1219 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1220 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0",
1221 \$err,0);
1222 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1223 last PARSE;
1224 } elsif (/^(\d+)$wkabb$past$/i) {
1225 # 2 weeks ago
1226 ($num)=($1);
1227 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1228 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0",
1229 \$err,0);
1230 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1231 last PARSE;
1232
1233 } elsif (/^$future\s*(\d+)$mabb$/i ||
1234 /^(\d+)$mabb$later$/i) {
1235 # in 2 months
1236 # 2 months later
1237 ($num)=($1);
1238 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1239 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0",
1240 \$err,0);
1241 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1242 last PARSE;
1243 } elsif (/^(\d+)$mabb$past$/i) {
1244 # 2 months ago
1245 ($num)=($1);
1246 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1247 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0",
1248 \$err,0);
1249 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1250 last PARSE;
1251
1252 } elsif (/^$week$future\s*(\d+)$wkabb$/i ||
1253 /^$week\s*(\d+)$wkabb$later$/i) {
1254 # friday in 2 weeks
1255 # friday 2 weeks later
1256 ($dofw,$num)=($1,$2);
1257 $tmp="+";
1258 } elsif (/^$week\s*(\d+)$wkabb$past$/i) {
1259 # friday 2 weeks ago
1260 ($dofw,$num)=($1,$2);
1261 $tmp="-";
1262 } elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
1263 /^(\d+)$wkabb$later$on$week$/i) {
1264 # in 2 weeks on friday
1265 # 2 weeks later on friday
1266 ($num,$dofw)=($1,$2);
1267 $tmp="+"
1268 } elsif (/^(\d+)$wkabb$past$on$week$/i) {
1269 # 2 weeks ago on friday
1270 ($num,$dofw)=($1,$2);
1271 $tmp="-";
1272 } elsif (/^$week\s*$wkabb$/i) {
1273 # monday week (British date: in 1 week on monday)
1274 $dofw=$1;
1275 $num=1;
1276 $tmp="+";
1277 } elsif ( (/^$now\s*$wkabb$/i && ($tmp="Now")) ||
1278 (/^$today\s*$wkabb$/i && ($tmp="Today")) ) {
1279 # now week (British date: 1 week from now)
1280 # today week (British date: 1 week from today)
1281 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1282 $date=_DateCalc_DateDelta($Curr{$tmp},"+0:0:1:0:0:0:0",\$err,0);
1283 $date=Date_SetTime($date,$h,$mn,$s) if ($time);
1284 last PARSE;
1285 } elsif (/^$offset\s*$wkabb$/i) {
1286 # tomorrow week (British date: 1 week from tomorrow)
1287 ($offset)=($1);
1288 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1289 $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
1290 $date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1291 $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0);
1292 if ($time) {
1293 return ""
1294 if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1295 $date=Date_SetTime($date,$h,$mn,$s);
1296 }
1297 last PARSE;
1298 }
1299
1300 if ($tmp) {
1301 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1302 $date=_DateCalc_DateDelta($Curr{"Now"},
1303 $tmp . "0:0:$num:0:0:0:0",\$err,0);
1304 $date=Date_GetPrev($date,$Cnf{"FirstDay"},1);
1305 $date=Date_GetNext($date,$dofw,1,$h,$mn,$s);
1306 last PARSE;
1307 }
1308 }
1309
1310 # Change (2nd, second) to 2
1311 $tmp=0;
1312 if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
1313 if (/^\s*$dom\s*$/) {
1314 ($d)=($1);
1315 $d=$dom{lc($d)};
1316 $m=$Curr{"M"};
1317 last PARSE;
1318 }
1319 my $from = $2;
1320 my $to = $dom{ lc($from) };
1321 s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
1322 s/^\s+//;
1323 s/\s+$//;
1324 }
1325
1326 # Another set of special dates (Nth week)
1327 if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
1328 # 22nd sunday in 1996
1329 ($which,$dofw,$y)=($1,$2,$3);
1330 $y=$Curr{"Y"} if (! $y);
1331 $y--; # previous year
1332 $tmp=Date_GetNext("$y-12-31",$dofw,0);
1333 if ($which>1) {
1334 $tmp=_DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0);
1335 }
1336 ($y,$m,$d)=(_Date_Split($tmp, 1))[0..2];
1337 last PARSE;
1338 } elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
1339 /^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
1340 # sunday week 22 in 1996
1341 # sunday 22nd week in 1996
1342 ($dofw,$which,$y)=($1,$2,$3);
1343 ($y,$m,$d)=_Date_NthWeekOfYear($y,$which,$dofw);
1344 last PARSE;
1345 }
1346
1347 # Get rid of day of week
1348 if (/(^|[^a-z])$week($|[^a-z])/i) {
1349 $wk=$2;
1350 (s/(^|[^a-z])$week,/$1 /i) ||
1351 s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
1352 s/^\s+//;
1353 s/\s+$//;
1354 }
1355
1356 {
1357 # So that we can handle negative epoch times, let's convert
1358 # things like "epoch -" to "epochNEGATIVE " before we strip out
1359 # the $sep chars, which include '-'.
1360 s,epoch\s*-,epochNEGATIVE ,g;
1361
1362 # Non-ISO8601 dates
1363 s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces
1364 s,^\s*,,; # remove leading/trailing space
1365 s,\s*$,,;
1366
1367 if (/^$D\s+$D(?:\s+$YY)?$/) {
1368 # MM DD YY (DD MM YY non-US)
1369 ($m,$d,$y)=($1,$2,$3);
1370 ($m,$d)=($d,$m) if ($type ne "US");
1371 last PARSE;
1372
1373 } elsif (/^$D4\s*$D\s*$D$/) {
1374 # YYYY MM DD
1375 ($y,$m,$d)=($1,$2,$3);
1376 last PARSE;
1377
1378 } elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
1379 ($m)=($2);
1380
1381 if (/^\s*$D(?:\s+$YY)?\s*$/) {
1382 # mmm DD YY
1383 # DD mmm YY
1384 # DD YY mmm
1385 ($d,$y)=($1,$2);
1386 last PARSE;
1387
1388 } elsif (/^\s*$D$D4\s*$/) {
1389 # mmm DD YYYY
1390 # DD mmm YYYY
1391 # DD YYYY mmm
1392 ($d,$y)=($1,$2);
1393 last PARSE;
1394
1395 } elsif (/^\s*$D4\s*$D\s*$/) {
1396 # mmm YYYY DD
1397 # YYYY mmm DD
1398 # YYYY DD mmm
1399 ($y,$d)=($1,$2);
1400 last PARSE;
1401
1402 } elsif (/^\s*$D4\s*$/) {
1403 # mmm YYYY
1404 # YYYY mmm
1405 ($y,$d)=($1,1);
1406 last PARSE;
1407
1408 } else {
1409 return "";
1410 }
1411
1412 } elsif (/^epochNEGATIVE (\d+)$/) {
1413 $s=$1;
1414 $date=DateCalc("1970-01-01 00:00 GMT","-0:0:$s");
1415 } elsif (/^epoch\s*(\d+)$/i) {
1416 $s=$1;
1417 $date=DateCalc("1970-01-01 00:00 GMT","+0:0:$s");
1418
1419 } elsif ( (/^$now$/i && ($tmp="Now")) ||
1420 (/^$today$/i && ($tmp="Today")) ) {
1421 # now, today
1422 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1423 $date=$Curr{$tmp};
1424 if ($time) {
1425 return ""
1426 if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1427 $date=Date_SetTime($date,$h,$mn,$s);
1428 }
1429 last PARSE;
1430
1431 } elsif (/^$offset$/i) {
1432 # yesterday, tomorrow
1433 ($offset)=($1);
1434 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1435 $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
1436 $date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1437 if ($time) {
1438 return ""
1439 if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1440 $date=Date_SetTime($date,$h,$mn,$s);
1441 }
1442 last PARSE;
1443
1444 } else {
1445 return "";
1446 }
1447 }
1448 }
1449
1450 if (! $date) {
1451 return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1452 $date=_Date_Join($y,$m,$d,$h,$mn,$s);
1453 }
1454 $date=Date_ConvTZ($date,$z);
1455 if ($midnight) {
1456 $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0");
1457 }
1458 return $date;
1459}
1460
1461sub ParseDate {
1462 print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
1463 Date_Init() if (! $Curr{"InitDone"});
1464 my($args,@args,@a,$ref,$date)=();
1465 @a=@_;
1466
1467 # @a : is the list of args to ParseDate. Currently, only one argument
1468 # is allowed and it must be a scalar (or a reference to a scalar)
1469 # or a reference to an array.
1470
1471 if ($#a!=0) {
1472 print "ERROR: Invalid number of arguments to ParseDate.\n";
1473 return "";
1474 }
1475 $args=$a[0];
1476 $ref=ref $args;
1477 if (! $ref) {
1478 return $args if (_Date_Split($args));
1479 @args=($args);
1480 } elsif ($ref eq "ARRAY") {
1481 @args=@$args;
1482 } elsif ($ref eq "SCALAR") {
1483 return $$args if (_Date_Split($$args));
1484 @args=($$args);
1485 } else {
1486 print "ERROR: Invalid arguments to ParseDate.\n";
1487 return "";
1488 }
1489 @a=@args;
1490
1491 # @args : a list containing all the arguments (dereferenced if appropriate)
1492 # @a : a list containing all the arguments currently being examined
1493 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1494 # reference to a scalar, or a reference to an array was passed in
1495 # $args : the scalar or refererence passed in
1496
1497 PARSE: while($#a>=0) {
1498 $date=join(" ",@a);
1499 $date=ParseDateString($date);
1500 last if ($date);
1501 pop(@a);
1502 } # PARSE
1503
1504 splice(@args,0,$#a + 1);
1505 @$args= @args if (defined $ref and $ref eq "ARRAY");
1506 $date;
1507}
1508
1509sub Date_Cmp {
1510 my($D1,$D2)=@_;
1511 my($date1)=ParseDateString($D1);
1512 my($date2)=ParseDateString($D2);
1513 return $date1 cmp $date2;
1514}
1515
1516# **NOTE**
1517# The calc routines all call parse routines, so it is never necessary to
1518# call Date_Init in the calc routines.
1519sub DateCalc {
1520 print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
1521 my($D1,$D2,@arg)=@_;
1522 my($ref,$err,$errref,$mode)=();
1523
1524 ($errref,$mode) = (@arg);
1525 $ref=0;
1526
1527 if (defined $errref) {
1528 if (ref $errref) {
1529 $ref=1;
1530 } elsif (! defined $mode) {
1531 $mode=$errref;
1532 $errref="";
1533 }
1534 }
1535
1536 my(@date,@delta,$ret,$tmp,$oldincalc,$oldmode)=();
1537
1538 if (exists $Curr{"Mode"}) {
1539 $oldmode = $Curr{"Mode"};
1540 } else {
1541 $oldmode = 0;
1542 }
1543
1544 if (defined $mode and $mode>=0 and $mode<=3) {
1545 $Curr{"Mode"}=$mode;
1546 } else {
1547 $Curr{"Mode"}=0;
1548 }
1549
1550 if (exists $Curr{"InCalc"}) {
1551 $oldincalc = $Curr{"InCalc"};
1552 } else {
1553 $oldincalc = 0;
1554 }
1555 $Curr{"InCalc"}=1;
1556
1557 if ($tmp=ParseDateString($D1)) {
1558 # If we've already parsed the date, we don't want to do it a second
1559 # time (so we don't convert timezones twice).
1560 if (_Date_Split($D1)) {
1561 push(@date,$D1);
1562 } else {
1563 push(@date,$tmp);
1564 }
1565 } elsif ($tmp=ParseDateDelta($D1)) {
1566 push(@delta,$tmp);
1567 } else {
1568 $$errref=1 if ($ref);
1569 $Curr{"InCalc"} = $oldincalc;
1570 $Curr{"Mode"} = $oldmode;
1571 return;
1572 }
1573
1574 if ($tmp=ParseDateString($D2)) {
1575 if (_Date_Split($D2)) {
1576 push(@date,$D2);
1577 } else {
1578 push(@date,$tmp);
1579 }
1580 } elsif ($tmp=ParseDateDelta($D2)) {
1581 push(@delta,$tmp);
1582 $mode = $Curr{"Mode"};
1583 } else {
1584 $$errref=2 if ($ref);
1585 $Curr{"InCalc"} = $oldincalc;
1586 $Curr{"Mode"} = $oldmode;
1587 return;
1588 }
1589
1590 $Curr{"InCalc"} = $oldincalc;
1591 $Curr{"Mode"} = $oldmode;
1592
1593 if ($#date==1) {
1594 $ret=_DateCalc_DateDate(@date,$mode);
1595 } elsif ($#date==0) {
1596 $ret=_DateCalc_DateDelta(@date,@delta,\$err,$mode);
1597 $$errref=$err if ($ref);
1598 } else {
1599 $ret=_DateCalc_DeltaDelta(@delta,$mode);
1600 }
1601 $ret;
1602}
1603
1604sub ParseDateDelta {
1605 print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
1606 my($args,@args,@a,$ref)=();
1607 local($_)=();
1608 @a=@_;
1609
1610 # @a : is the list of args to ParseDateDelta. Currently, only one argument
1611 # is allowed and it must be a scalar (or a reference to a scalar)
1612 # or a reference to an array.
1613
1614 if ($#a!=0) {
1615 print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
1616 return "";
1617 }
1618 $args=$a[0];
1619 $ref=ref $args;
1620 if (! $ref) {
1621 @args=($args);
1622 } elsif ($ref eq "ARRAY") {
1623 @args=@$args;
1624 } elsif ($ref eq "SCALAR") {
1625 @args=($$args);
1626 } else {
1627 print "ERROR: Invalid arguments to ParseDateDelta.\n";
1628 return "";
1629 }
1630 @a=@args;
1631
1632 # @args : a list containing all the arguments (dereferenced if appropriate)
1633 # @a : a list containing all the arguments currently being examined
1634 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1635 # reference to a scalar, or a reference to an array was passed in
1636 # $args : the scalar or refererence passed in
1637
1638 my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=();
1639 my($len,$tmp,$tmp2,$tmpl)=();
1640 my($from,$to)=();
1641 my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1;
1642
1643 Date_Init() if (! $Curr{"InitDone"});
1644 # A sign can be a sequence of zero or more + and - signs, this
1645 # allows for deltas like '+ -2 days'.
1646 my($signexp)='((?:[+-]\s*)*)';
1647 my($numexp)='(\d+)';
1648 my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)";
1649 my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=();
1650 $yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()";
1651 $yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?";
1652 $mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?";
1653 $wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?";
1654 $dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?";
1655 $hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?";
1656 $mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?";
1657 $sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?";
1658 my($future)=$Lang{$Cnf{"Language"}}{"Future"};
1659 my($later)=$Lang{$Cnf{"Language"}}{"Later"};
1660 my($past)=$Lang{$Cnf{"Language"}}{"Past"};
1661
1662 $delta="";
1663 PARSE: while (@a) {
1664 $_ = join(" ", grep {defined;} @a);
1665 s/\s+$//;
1666 last if ($_ eq "");
1667
1668 # Mode is set in DateCalc. ParseDateDelta only overrides it if the
1669 # string contains a mode.
1670 if ($Lang{$Cnf{"Language"}}{"Exact"} &&
1671 s/$Lang{$Cnf{"Language"}}{"Exact"}//) {
1672 $Curr{"Mode"}=0;
1673 } elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
1674 s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
1675 $Curr{"Mode"}=1;
1676 } elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
1677 s/$Lang{$Cnf{"Language"}}{"Business"}//) {
1678 $Curr{"Mode"}=2;
1679 } elsif (! exists $Curr{"Mode"}) {
1680 $Curr{"Mode"}=0;
1681 }
1682 $workweek=7 if ($Curr{"Mode"} != 2);
1683
1684 foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) {
1685 $to=$Lang{$Cnf{"Language"}}{"Repl"}{$from};
1686 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
1687 }
1688
1689 # in or ago
1690 #
1691 # We need to make sure that $later, $future, and $past don't contain each
1692 # other... Romanian pointed this out where $past is "in urma" and $future
1693 # is "in". When they do, we have to take this into account.
1694 # $len length of best match (greatest wins)
1695 # $tmp string after best match
1696 # $dir direction (prior, after) of best match
1697 #
1698 # $tmp2 string before/after current match
1699 # $tmpl length of current match
1700
1701 $len=0;
1702 $tmp=$_;
1703 $dir=1;
1704
1705 $tmp2=$_;
1706 if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
1707 $tmpl=length($2);
1708 if ($tmpl>$len) {
1709 $tmp=$tmp2;
1710 $dir=1;
1711 $len=$tmpl;
1712 }
1713 }
1714
1715 $tmp2=$_;
1716 if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
1717 $tmpl=length($2);
1718 if ($tmpl>$len) {
1719 $tmp=$tmp2;
1720 $dir=1;
1721 $len=$tmpl;
1722 }
1723 }
1724
1725 $tmp2=$_;
1726 if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
1727 $tmpl=length($2);
1728 if ($tmpl>$len) {
1729 $tmp=$tmp2;
1730 $dir=-1;
1731 $len=$tmpl;
1732 }
1733 }
1734
1735 $_ = $tmp;
1736 s/\s*$//;
1737
1738 # the colon part of the delta
1739 $colon="";
1740 if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
1741 $colon=$1;
1742 s/\s+$//;
1743 }
1744 @colon=split(/:/,$colon);
1745
1746 # the non-colon part of the delta
1747 $sign="+";
1748 @delta=();
1749 $i=6;
1750 foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
1751 last if ($#colon>=$i--);
1752 $val=0;
1753 if (s/^$exp1//ix) {
1754 $val=$2 if ($2);
1755 $sign=$1 if ($1);
1756 }
1757
1758 # Collapse a sign like '+ -' into a single character like '-',
1759 # by counting the occurrences of '-'.
1760 #
1761 $sign =~ s/\s+//g;
1762 $sign =~ tr/+//d;
1763 my $count = ($sign =~ tr/-//d);
1764 die "bad characters in sign: $sign" if length $sign;
1765 $sign = $count % 2 ? '-' : '+';
1766
1767 push(@delta,"$sign$val");
1768 }
1769 if (! /^\s*$/) {
1770 pop(@a);
1771 next PARSE;
1772 }
1773
1774 # make sure that the colon part has a sign
1775 for ($i=0; $i<=$#colon; $i++) {
1776 $val=0;
1777 if ($colon[$i] =~ /^$signexp$numexp?/) {
1778 $val=$2 if ($2);
1779 $sign=$1 if ($1);
1780 }
1781 $colon[$i] = "$sign$val";
1782 }
1783
1784 # combine the two
1785 push(@delta,@colon);
1786 if ($dir<0) {
1787 for ($i=0; $i<=$#delta; $i++) {
1788 $delta[$i] =~ tr/-+/+-/;
1789 }
1790 }
1791
1792 # form the delta and shift off the valid part
1793 $delta=join(":",@delta);
1794 splice(@args,0,$#a+1);
1795 @$args=@args if (defined $ref and $ref eq "ARRAY");
1796 last PARSE;
1797 }
1798
1799 $delta=_Delta_Normalize($delta,$Curr{"Mode"});
1800 return $delta;
1801}
1802
1803sub UnixDate {
1804 print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
1805 my($date,@format)=@_;
1806 local($_)=();
1807 my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
1808 my($scalar)=();
1809 $date=ParseDateString($date);
1810 return if (! $date);
1811
1812 my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
1813 _Date_Split($date, 1);
1814 $f{"y"}=substr $f{"Y"},2;
1815 Date_Init() if (! $Curr{"InitDone"});
1816
1817 if (! wantarray) {
1818 $format=join(" ",@format);
1819 @format=($format);
1820 $scalar=1;
1821 }
1822
1823 # month, week
1824 $_=$m;
1825 s/^0//;
1826 $f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
1827 $f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
1828 $_=$m;
1829 s/^0/ /;
1830 $f{"f"}=$_;
1831 $f{"U"}=Date_WeekOfYear($m,$d,$y,7);
1832 $f{"W"}=Date_WeekOfYear($m,$d,$y,1);
1833
1834 # check week 52,53 and 0
1835 $f{"G"}=$f{"L"}=$y;
1836 if ($f{"W"}>=52 || $f{"U"}>=52) {
1837 my($dd,$mm,$yy)=($d,$m,$y);
1838 $dd+=7;
1839 if ($dd>31) {
1840 $dd-=31;
1841 $mm=1;
1842 $yy++;
1843 if (Date_WeekOfYear($mm,$dd,$yy,1)==2) {
1844 $f{"G"}=$yy;
1845 $f{"W"}=1;
1846 }
1847 if (Date_WeekOfYear($mm,$dd,$yy,7)==2) {
1848 $f{"L"}=$yy;
1849 $f{"U"}=1;
1850 }
1851 }
1852 }
1853 if ($f{"W"}==0) {
1854 my($dd,$mm,$yy)=($d,$m,$y);
1855 $dd-=7;
1856 $dd+=31 if ($dd<1);
1857 $yy = sprintf "%04d", $yy-1;
1858 $mm=12;
1859 $f{"G"}=$yy;
1860 $f{"W"}=Date_WeekOfYear($mm,$dd,$yy,1)+1;
1861 }
1862 if ($f{"U"}==0) {
1863 my($dd,$mm,$yy)=($d,$m,$y);
1864 $dd-=7;
1865 $dd+=31 if ($dd<1);
1866 $yy = sprintf "%04d", $yy-1;
1867 $mm=12;
1868 $f{"L"}=$yy;
1869 $f{"U"}=Date_WeekOfYear($mm,$dd,$yy,7)+1;
1870 }
1871
1872 $f{"U"}="0".$f{"U"} if (length $f{"U"} < 2);
1873 $f{"W"}="0".$f{"W"} if (length $f{"W"} < 2);
1874
1875 # day
1876 $f{"j"}=Date_DayOfYear($m,$d,$y);
1877 $f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
1878 $_=$d;
1879 s/^0/ /;
1880 $f{"e"}=$_;
1881 $f{"w"}=Date_DayOfWeek($m,$d,$y);
1882 $f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1];
1883 $f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2);
1884 $f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1];
1885 $f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1];
1886 $f{"E"}=Date_DaySuffix($f{"e"});
1887
1888 # hour
1889 $_=$h;
1890 s/^0/ /;
1891 $f{"k"}=$_;
1892 $f{"i"}=$f{"k"}+1;
1893 $f{"i"}=$f{"k"};
1894 $f{"i"}=12 if ($f{"k"}==0);
1895 $f{"i"}=$f{"k"}-12 if ($f{"k"}>12);
1896 $f{"i"}=$f{"i"}-12 if ($f{"i"}>12);
1897 $f{"i"}=" ".$f{"i"} if (length($f{"i"})<2);
1898 $f{"I"}=$f{"i"};
1899 $f{"I"}=~ s/^ /0/;
1900 $f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"};
1901 $f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11);
1902
1903 # minute, second, timezone
1904 $f{"o"}=Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
1905 $f{"s"}=Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s);
1906 $f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ?
1907 $Cnf{"TZ"} : $Cnf{"ConvTZ"};
1908 $f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || "");
1909
1910 # date, time
1911 $f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
1912 $f{"C"}=$f{"u"}=
1913 qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|;
1914 $f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|;
1915 $f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|;
1916 $f{"x"}=qq|$d/$m/$f{"y"}| if ($Cnf{"DateFormat"} ne "US");
1917 $f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|;
1918 $f{"R"}=qq|$h:$mn|;
1919 $f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
1920 $f{"V"}=qq|$m$d$h$mn$f{"y"}|;
1921 $f{"Q"}="$y$m$d";
1922 $f{"q"}=qq|$y$m$d$h$mn$s|;
1923 $f{"P"}=qq|$y$m$d$h:$mn:$s|;
1924 $f{"O"}=qq|$y-$m-${d}T$h:$mn:$s|;
1925 $f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|;
1926 if ($f{"W"}==0) {
1927 $y--;
1928 $tmp=Date_WeekOfYear(12,31,$y,1);
1929 $tmp="0$tmp" if (length($tmp) < 2);
1930 $f{"J"}=qq|$y-W$tmp-$f{"w"}|;
1931 } else {
1932 $f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|;
1933 }
1934 $f{"K"}=qq|$y-$f{"j"}|;
1935 # %l is a special case. Since it requires the use of the calculator
1936 # which requires this routine, an infinite recursion results. To get
1937 # around this, %l is NOT determined every time this is called so the
1938 # recursion breaks.
1939
1940 # other formats
1941 $f{"n"}="\n";
1942 $f{"t"}="\t";
1943 $f{"%"}="%";
1944 $f{"+"}="+";
1945
1946 foreach $format (@format) {
1947 $format=reverse($format);
1948 $out="";
1949 while ($format ne "") {
1950 $c=chop($format);
1951 if ($c eq "%") {
1952 $c=chop($format);
1953 if ($c eq "l") {
1954 Date_Init();
1955 $date1=_DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0");
1956 $date2=_DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0");
1957 if (Date_Cmp($date,$date1)>=0 && Date_Cmp($date,$date2)<=0) {
1958 $f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|;
1959 } else {
1960 $f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
1961 }
1962 $out .= $f{"$c"};
1963 } elsif (exists $f{"$c"}) {
1964 $out .= $f{"$c"};
1965 } else {
1966 $out .= $c;
1967 }
1968 } else {
1969 $out .= $c;
1970 }
1971 }
1972 push(@out,$out);
1973 }
1974 if ($scalar) {
1975 return $out[0];
1976 } else {
1977 return (@out);
1978 }
1979}
1980
1981# Can't be in "use integer" because we're doing decimal arithmatic
19823887µs296µsno integer;
# spent 23µs making 1 call to integer::unimport
1983sub Delta_Format {
1984 print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
1985 my($delta,@arg)=@_;
1986 my($mode);
1987 if (lc($arg[0]) eq "approx") {
1988 $mode = "approx";
1989 shift(@arg);
1990 } else {
1991 $mode = "exact";
1992 }
1993 my($dec,@format) = @arg;
1994
1995 $delta=ParseDateDelta($delta);
1996 return "" if (! $delta);
1997 my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
1998 local($_)=$delta;
1999 my($y,$M,$w,$d,$h,$m,$s)=_Delta_Split($delta);
2000 # Get rid of positive signs.
2001 ($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s);
2002
2003 if (defined $dec && $dec>0) {
2004 $dec="%." . ($dec*1) . "f";
2005 } else {
2006 $dec="%f";
2007 }
2008
2009 if (! wantarray) {
2010 $format=join(" ",@format);
2011 @format=($format);
2012 $scalar=1;
2013 }
2014
2015 # Length of each unit in seconds
2016 my($sl,$ml,$hl,$dl,$wl,$Ml,$yl)=();
2017 $sl = 1;
2018 $ml = $sl*60;
2019 $hl = $ml*60;
2020 $dl = $hl*24;
2021 $wl = $dl*7;
2022 $yl = $dl*365.25;
2023 $Ml = $yl/12;
2024
2025 # The decimal amount of each unit contained in all smaller units
2026 my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
2027 if ($mode eq "exact") {
2028 $yd = $M/12;
2029 $Md = 0;
2030 } else {
2031 $yd = ($M*$Ml + $w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
2032 $Md = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$Ml;
2033 }
2034
2035 $wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
2036 $dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
2037 $hd = ($m*$ml + $s*$sl)/$hl;
2038 $md = ($s*$sl)/$ml;
2039 $sd = 0;
2040
2041 # The amount of each unit contained in higher units.
2042 my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
2043 $yh = 0;
2044 $Mh = ($yh+$y)*12;
2045
2046 if ($mode eq "exact") {
2047 $wh = 0;
2048 $dh = ($wh+$w)*7;
2049 } else {
2050 $wh = ($yh+$y+$M/12)*365.25/7;
2051 $dh = ($wh+$w)*7;
2052 }
2053
2054 $hh = ($dh+$d)*24;
2055 $mh = ($hh+$h)*60;
2056 $sh = ($mh+$m)*60;
2057
2058 # Set up the formats
2059
2060 $f{"yv"} = $y;
2061 $f{"Mv"} = $M;
2062 $f{"wv"} = $w;
2063 $f{"dv"} = $d;
2064 $f{"hv"} = $h;
2065 $f{"mv"} = $m;
2066 $f{"sv"} = $s;
2067
2068 $f{"yh"} = $y+$yh;
2069 $f{"Mh"} = $M+$Mh;
2070 $f{"wh"} = $w+$wh;
2071 $f{"dh"} = $d+$dh;
2072 $f{"hh"} = $h+$hh;
2073 $f{"mh"} = $m+$mh;
2074 $f{"sh"} = $s+$sh;
2075
2076 $f{"yd"} = sprintf($dec,$y+$yd);
2077 $f{"Md"} = sprintf($dec,$M+$Md);
2078 $f{"wd"} = sprintf($dec,$w+$wd);
2079 $f{"dd"} = sprintf($dec,$d+$dd);
2080 $f{"hd"} = sprintf($dec,$h+$hd);
2081 $f{"md"} = sprintf($dec,$m+$md);
2082 $f{"sd"} = sprintf($dec,$s+$sd);
2083
2084 $f{"yt"} = sprintf($dec,$yh+$y+$yd);
2085 $f{"Mt"} = sprintf($dec,$Mh+$M+$Md);
2086 $f{"wt"} = sprintf($dec,$wh+$w+$wd);
2087 $f{"dt"} = sprintf($dec,$dh+$d+$dd);
2088 $f{"ht"} = sprintf($dec,$hh+$h+$hd);
2089 $f{"mt"} = sprintf($dec,$mh+$m+$md);
2090 $f{"st"} = sprintf($dec,$sh+$s+$sd);
2091
2092 $f{"%"} = "%";
2093
2094 foreach $format (@format) {
2095 $format=reverse($format);
2096 $out="";
2097 PARSE: while ($format) {
2098 $c1=chop($format);
2099 if ($c1 eq "%") {
2100 $c1=chop($format);
2101 if (exists($f{$c1})) {
2102 $out .= $f{$c1};
2103 next PARSE;
2104 }
2105 $c2=chop($format);
2106 if (exists($f{"$c1$c2"})) {
2107 $out .= $f{"$c1$c2"};
2108 next PARSE;
2109 }
2110 $out .= $c1;
2111 $format .= $c2;
2112 } else {
2113 $out .= $c1;
2114 }
2115 }
2116 push(@out,$out);
2117 }
2118 if ($scalar) {
2119 return $out[0];
2120 } else {
2121 return (@out);
2122 }
2123}
212438.32ms2.77msuse integer;
# spent 10µs making 1 call to integer::import
2125
2126sub ParseRecur {
2127 print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
2128 Date_Init() if (! $Curr{"InitDone"});
2129
2130 my($recur,$dateb,$date0,$date1,$flag)=@_;
2131 local($_)=$recur;
2132
2133 my($recur_0,$recur_1,@recur0,@recur1)=();
2134 my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=();
2135 my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=();
2136
2137 # $date0, $date1, $dateb, $flag : passed in (these are always the final say
2138 # in determining whether a date matches a
2139 # recurrence IF they are present.
2140 # $date_b, $date_0, $date_1 : if a value can be determined from the
2141 # $flag_t recurrence, they are stored here.
2142 #
2143 # If values can be determined from the recurrence AND are passed in, the
2144 # following are used:
2145 # max($date0,$date_0) i.e. the later of the two dates
2146 # min($date1,$date_1) i.e. the earlier of the two dates
2147 #
2148 # The base date that is used is the first one defined from
2149 # $dateb $date_b
2150 # The base date is only used if necessary (as determined by the recur).
2151 # For example, "every other friday" requires a base date, but "2nd
2152 # friday of every month" doesn't.
2153
2154 my($date_b,$date_0,$date_1,$flag_t);
2155
2156 #
2157 # Check the arguments passed in.
2158 #
2159
2160 $date0="" if (! defined $date0);
2161 $date1="" if (! defined $date1);
2162 $dateb="" if (! defined $dateb);
2163 $flag ="" if (! defined $flag);
2164
2165 if ($dateb) {
2166 $dateb=ParseDateString($dateb);
2167 return "" if (! $dateb);
2168 }
2169 if ($date0) {
2170 $date0=ParseDateString($date0);
2171 return "" if (! $date0);
2172 }
2173 if ($date1) {
2174 $date1=ParseDateString($date1);
2175 return "" if (! $date1);
2176 }
2177
2178 #
2179 # Parse the recur. $date_b, $date_0, and $date_e are values obtained
2180 # from the recur.
2181 #
2182
2183 @tmp=_Recur_Split($_);
2184
2185 if (@tmp) {
2186 ($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp;
2187 $recur_0 = "" if (! defined $recur_0);
2188 $recur_1 = "" if (! defined $recur_1);
2189 $flag_t = "" if (! defined $flag_t);
2190 $date_b = "" if (! defined $date_b);
2191 $date_0 = "" if (! defined $date_0);
2192 $date_1 = "" if (! defined $date_1);
2193
2194 @recur0 = split(/:/,$recur_0);
2195 @recur1 = split(/:/,$recur_1);
2196 return "" if ($#recur0 + $#recur1 + 2 != 7);
2197
2198 if ($date_b) {
2199 $date_b=ParseDateString($date_b);
2200 return "" if (! $date_b);
2201 }
2202 if ($date_0) {
2203 $date_0=ParseDateString($date_0);
2204 return "" if (! $date_0);
2205 }
2206 if ($date_1) {
2207 $date_1=ParseDateString($date_1);
2208 return "" if (! $date_1);
2209 }
2210
2211 } else {
2212
2213 my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...)
2214 my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... }
2215 my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...)
2216 my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... }
2217 my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days)
2218 my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months)
2219 my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks)
2220 my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st)
2221 my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} };
2222 # { 1st=>1,first=>1,...}
2223 my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of)
2224 my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last)
2225 my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every)
2226
2227 my($D)='\s*(\d+)';
2228 my($Y)='\s*(\d{4}|\d{2})';
2229
2230 # Change 1st to 1
2231 if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
2232 $tmp=lc($2);
2233 $tmp=$dayshash{"$tmp"};
2234 s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
2235 }
2236 s/\s*$//;
2237
2238 # Get rid of "each"
2239 if (/(^|[^a-z])$each($|[^a-z])/i) {
2240 s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
2241 $each=1;
2242 } else {
2243 $each=0;
2244 }
2245
2246 if ($each) {
2247
2248 if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
2249 /^$D?$day(?:$of$mmm())?$/i) {
2250 # every [2nd] day in [june] 1997
2251 # every [2nd] day [in june]
2252 ($num,$m,$y)=($1,$2,$3);
2253 $num=1 if (! defined $num);
2254 $m="" if (! defined $m);
2255 $y="" if (! defined $y);
2256
2257 $y=$Curr{"Y"} if (! $y);
2258 if ($m) {
2259 $m=$mmm{lc($m)};
2260 $date_0=_Date_Join($y,$m,1,0,0,0);
2261 $date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
2262 } else {
2263 $date_0=_Date_Join($y, 1,1,0,0,0);
2264 $date_1=_Date_Join($y+1,1,1,0,0,0);
2265 }
2266 $date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0);
2267 @recur0=(0,0,0,$num,0,0,0);
2268 @recur1=();
2269
2270 } elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
2271 # 2nd [day] of every month [in 1997]
2272 ($num,$y)=($1,$2);
2273 $y=$Curr{"Y"} if (! $y);
2274
2275 $date_0=_Date_Join($y, 1,1,0,0,0);
2276 $date_1=_Date_Join($y+1,1,1,0,0,0);
2277 $date_b=$date_0;
2278
2279 @recur0=(0,1,0);
2280 @recur1=($num,0,0,0);
2281
2282 } elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ ||
2283 /^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) {
2284 # 2nd tuesday of every month [in 1997]
2285 # last tuesday of every month [in 1997]
2286 ($num,$d,$y)=($1,$2,$3);
2287 $y=$Curr{"Y"} if (! $y);
2288 $d=$week{lc($d)};
2289 $num=-1 if ($num !~ /^$D$/);
2290
2291 $date_0=_Date_Join($y,1,1,0,0,0);
2292 $date_1=_Date_Join($y+1,1,1,0,0,0);
2293 $date_b=$date_0;
2294
2295 @recur0=(0,1);
2296 @recur1=($num,$d,0,0,0);
2297
2298 } elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i ||
2299 /^$D?$wkexp(?:$of$mmm())?$/i) {
2300 # every tuesday in june 1997
2301 # every 2nd tuesday in june 1997
2302 ($num,$d,$m,$y)=($1,$2,$3,$4);
2303 $y=$Curr{"Y"} if (! $y);
2304 $num=1 if (! defined $num);
2305 $m="" if (! defined $m);
2306 $d=$week{lc($d)};
2307
2308 if ($m) {
2309 $m=$mmm{lc($m)};
2310 $date_0=_Date_Join($y,$m,1,0,0,0);
2311 $date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
2312 } else {
2313 $date_0=_Date_Join($y,1,1,0,0,0);
2314 $date_1=_Date_Join($y+1,1,1,0,0,0);
2315 }
2316 $date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0);
2317
2318 @recur0=(0,0,$num);
2319 @recur1=($d,0,0,0);
2320
2321 } else {
2322 return "";
2323 }
2324
2325 $date_0="" if ($date0);
2326 $date_1="" if ($date1);
2327 } else {
2328 return "";
2329 }
2330 }
2331
2332 #
2333 # Override with any values passed in
2334 #
2335
2336 $date0 = $date_0 if (! $date0);
2337 $date1 = $date_1 if (! $date1);
2338 $dateb = $date_b if (! $dateb);
2339 if ($flag =~ s/^\+//) {
2340 $flag = "$flag_t,$flag" if ($flag_t);
2341 }
2342 $flag = $flag_t if (! $flag);
2343 $flag = "" if (! $flag);
2344
2345 if (! wantarray) {
2346 $tmp = join(":",@recur0);
2347 $tmp .= "*" . join(":",@recur1) if (@recur1);
2348 $tmp .= "*$flag*$dateb*$date0*$date1";
2349 return $tmp;
2350 }
2351 if (@recur0) {
2352 return () if (! $date0 || ! $date1); # dateb is NOT required in all case
2353 }
2354
2355 #
2356 # Some flags affect parsing.
2357 #
2358
2359 @flags = split(/,/,$flag);
2360 my($f);
2361 foreach $f (@flags) {
2362 if ($f =~ /^EASTER$/i) {
2363 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2364 # We want something that will return Jan 1 for the given years.
2365 if ($#recur0==-1) {
2366 @recur1=($y,1,0,1,$h,$mn,$s);
2367 } elsif ($#recur0<=3) {
2368 @recur0=($y,0,0,0);
2369 @recur1=($h,$mn,$s);
2370 } elsif ($#recur0==4) {
2371 @recur0=($y,0,0,0,0);
2372 @recur1=($mn,$s);
2373 } elsif ($#recur0==5) {
2374 @recur0=($y,0,0,0,0,0);
2375 @recur1=($s);
2376 } else {
2377 @recur0=($y,0,0,0,0,0,0);
2378 }
2379 }
2380 }
2381
2382 #
2383 # Determine the dates referenced by the recur. Also, fix the base date
2384 # as necessary for the recurrences which require it.
2385 #
2386
2387 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2388 @y=@m=@w=@d=();
2389 my(@time)=($h,$mn,$s);
2390
2391 RECUR: while (1) {
2392
2393 if ($#recur0==-1) {
2394 # * 0-M-W-D-H-MN-S => 0 * M-W-D-H-MN-S
2395
2396 if ($y eq "0") {
2397 push(@recur0,1);
2398 shift(@recur1);
2399 next RECUR;
2400 }
2401
2402 # Y-M-W-D-H-MN-S
2403
2404 @y=_ReturnList($y);
2405 foreach $y (@y) {
2406 $y=_Date_FixYear($y) if (length($y)==2);
2407 return () if (length($y)!=4 || ! _IsInt($y));
2408 }
2409
2410 $date0=ParseDate("0000-01-01") if (! $date0);
2411 $date1=ParseDate("9999-12-31 23:59:59") if (! $date1);
2412
2413 if ($m eq "0" and $w eq "0") {
2414
2415 # * Y-0-0-0-H-MN-S
2416 # * Y-0-0-DOY-H-MN-S
2417
2418 if ($d eq "0") {
2419 @d=(1);
2420 } else {
2421 @d=_ReturnList($d);
2422 return () if (! @d);
2423 foreach $d (@d) {
2424 return () if (! _IsInt($d,-366,366) || $d==0);
2425 }
2426 }
2427
2428 @date=();
2429 foreach $yy (@y) {
2430 my $diy = Date_DaysInYear($yy);
2431 foreach $d (@d) {
2432 my $tmpd = $d;
2433 $tmpd += ($diy+1) if ($tmpd < 0);
2434 next if (! _IsInt($tmpd,1,$diy));
2435 ($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd);
2436 push(@date, _Date_Join($y,$m,$dd,0,0,0));
2437 }
2438 }
2439 last RECUR;
2440
2441 } elsif ($w eq "0") {
2442
2443 # * Y-M-0-0-H-MN-S
2444 # * Y-M-0-DOM-H-MN-S
2445
2446 @m=_ReturnList($m);
2447 return () if (! @m);
2448 foreach $m (@m) {
2449 return () if (! _IsInt($m,1,12));
2450 }
2451
2452 if ($d eq "0") {
2453 @d=(1);
2454 } else {
2455 @d=_ReturnList($d);
2456 return () if (! @d);
2457 foreach $d (@d) {
2458 return () if (! _IsInt($d,-31,31) || $d==0);
2459 }
2460 }
2461
2462 @date=();
2463 foreach $y (@y) {
2464 foreach $m (@m) {
2465 my $dim = Date_DaysInMonth($m,$y);
2466 foreach $d (@d) {
2467 my $tmpd = $d;
2468 $tmpd += ($dim+1) if ($d<0);
2469 next if (! _IsInt($tmpd,1,$dim));
2470 $date=_Date_Join($y,$m,$tmpd,0,0,0);
2471 push(@date,$date);
2472 }
2473 }
2474 }
2475 last RECUR;
2476
2477 } elsif ($m eq "0") {
2478
2479 # * Y-0-WOY-DOW-H-MN-S
2480 # * Y-0-WOY-0-H-MN-S
2481
2482 @w=_ReturnList($w);
2483 return () if (! @w);
2484 foreach $w (@w) {
2485 return () if (! _IsInt($w,-53,53) || $w==0);
2486 }
2487
2488 if ($d eq "0") {
2489 @d=(1);
2490 } else {
2491 @d=_ReturnList($d);
2492 return () if (! @d);
2493 foreach $d (@d) {
2494 $d += 8 if ($d<0);
2495 return () if (! _IsInt($d,1,7));
2496 }
2497 }
2498
2499 @date=();
2500 foreach $y (@y) {
2501 foreach $w (@w) {
2502 foreach $d (@d) {
2503 my($tmpw,$del);
2504 if ($w<0) {
2505 $date="$y-12-31-00:00:00";
2506 $tmpw = (-$w)-1;
2507 $del="-0:0:$tmpw:0:0:0:0";
2508 $date=Date_GetPrev($date,$d,1);
2509 } else {
2510 $date="$y-01-01-00:00:00";
2511 $tmpw = ($w)-1;
2512 $del="0:0:$tmpw:0:0:0:0";
2513 $date=Date_GetNext($date,$d,1);
2514 }
2515 $date=_DateCalc_DateDelta($date,$del);
2516 push(@date,$date) if ( (_Date_Split($date))[0] == $y);
2517 }
2518 }
2519 }
2520 last RECUR;
2521
2522 } else {
2523
2524 # * Y-M-WOM-DOW-H-MN-S
2525 # * Y-M-WOM-0-H-MN-S
2526
2527 @m=_ReturnList($m);
2528 return () if (! @m);
2529 @w=_ReturnList($w);
2530 return () if (! @w);
2531 if ($d eq "0") {
2532 @d=(1);
2533 } else {
2534 @d=_ReturnList($d);
2535 }
2536
2537 @date=_Date_Recur_WoM(\@y,\@m,\@w,\@d);
2538 last RECUR;
2539 }
2540 }
2541
2542 if ($#recur0==0) {
2543
2544 # Y * M-W-D-H-MN-S
2545 $n=$y;
2546 $n=1 if ($n==0);
2547
2548 if ($m eq "0") {
2549
2550 # Y * 0-W-D-H-MN-S => Y-0 * W-D-H-MN-S
2551 push(@recur0,0);
2552 shift(@recur1);
2553
2554 } elsif ($w eq "0") {
2555
2556 # Y * M-0-DOM-H-MN-S
2557 return () if (! $dateb && $y != 1);
2558
2559 @m=_ReturnList($m);
2560 return () if (! @m);
2561 foreach $m (@m) {
2562 return () if (! _IsInt($m,1,12));
2563 }
2564
2565 if ($d eq "0") {
2566 @d = (1);
2567 } else {
2568 @d=_ReturnList($d);
2569 return () if (! @d);
2570 foreach $d (@d) {
2571 return () if (! _IsInt($d,-31,31) || $d==0);
2572 }
2573 }
2574
2575 # We need to find years that are a multiple of $n from $y(base)
2576 ($y0)=( _Date_Split($date0, 1) )[0];
2577 ($y1)=( _Date_Split($date1, 1) )[0];
2578 if ($dateb) {
2579 ($yb)=( _Date_Split($dateb, 1) )[0];
2580 } else {
2581 # If $y=1, there is no base year
2582 $yb=0;
2583 }
2584
2585 @date=();
2586 for ($yy=$y0; $yy<=$y1; $yy++) {
2587 if (($yy-$yb)%$n == 0) {
2588 foreach $m (@m) {
2589 foreach $d (@d) {
2590 my $dim = Date_DaysInMonth($m,$yy);
2591 my $tmpd = $d;
2592 if ($tmpd < 0) {
2593 $tmpd += ($dim+1);
2594 }
2595 next if (! _IsInt($tmpd,1,$dim));
2596 $date=_Date_Join($yy,$m,$tmpd,0,0,0);
2597 push(@date,$date);
2598 }
2599 }
2600 }
2601 }
2602 last RECUR;
2603
2604 } else {
2605
2606 # Y * M-WOM-DOW-H-MN-S
2607 # Y * M-WOM-0-H-MN-S
2608 return () if (! $dateb && $y != 1);
2609
2610 @m=_ReturnList($m);
2611 return () if (! @m);
2612 @w=_ReturnList($w);
2613 return () if (! @w);
2614
2615 if ($d eq "0") {
2616 @d=(1);
2617 } else {
2618 @d=_ReturnList($d);
2619 }
2620
2621 ($y0)=( _Date_Split($date0, 1) )[0];
2622 ($y1)=( _Date_Split($date1, 1) )[0];
2623 if ($dateb) {
2624 ($yb)=( _Date_Split($dateb, 1) )[0];
2625 } else {
2626 # If $y=1, there is no base year
2627 $yb=0;
2628 }
2629 @y=();
2630 for ($yy=$y0; $yy<=$y1; $yy++) {
2631 if (($yy-$yb)%$n == 0) {
2632 push(@y,$yy);
2633 }
2634 }
2635
2636 @date=_Date_Recur_WoM(\@y,\@m,\@w,\@d);
2637 last RECUR;
2638 }
2639 }
2640
2641 if ($#recur0==1) {
2642
2643 # Y-M * W-D-H-MN-S
2644
2645 if ($w eq "0") {
2646 # Y-M * 0-D-H-MN-S => Y-M-0 * D-H-MN-S
2647 push(@recur0,0);
2648 shift(@recur1);
2649
2650 } elsif ($m==0) {
2651
2652 # Y-0 * WOY-0-H-MN-S
2653 # Y-0 * WOY-DOW-H-MN-S
2654 return () if (! $dateb && $y != 1);
2655 $n=$y;
2656 $n=1 if ($n==0);
2657
2658 @w=_ReturnList($w);
2659 return () if (! @w);
2660 foreach $w (@w) {
2661 return () if ($w==0 || ! _IsInt($w,-53,53));
2662 }
2663
2664 if ($d eq "0") {
2665 @d=(1);
2666 } else {
2667 @d=_ReturnList($d);
2668 return () if (! @d);
2669 foreach $d (@d) {
2670 $d += 8 if ($d<0);
2671 return () if (! _IsInt($d,1,7));
2672 }
2673 }
2674
2675 # We need to find years that are a multiple of $n from $y(base)
2676 ($y0)=( _Date_Split($date0, 1) )[0];
2677 ($y1)=( _Date_Split($date1, 1) )[0];
2678 if ($dateb) {
2679 ($yb)=( _Date_Split($dateb, 1) )[0];
2680 } else {
2681 # If $y=1, there is no base year
2682 $yb=0;
2683 }
2684
2685 @date=();
2686 for ($yy=$y0; $yy<=$y1; $yy++) {
2687 if (($yy-$yb)%$n == 0) {
2688 foreach $w (@w) {
2689 foreach $d (@d) {
2690 my($tmpw,$del);
2691 if ($w<0) {
2692 $date="$yy-12-31-00:00:00";
2693 $tmpw = (-$w)-1;
2694 $del="-0:0:$tmpw:0:0:0:0";
2695 $date=Date_GetPrev($date,$d,1);
2696 } else {
2697 $date="$yy-01-01-00:00:00";
2698 $tmpw = ($w)-1;
2699 $del="0:0:$tmpw:0:0:0:0";
2700 $date=Date_GetNext($date,$d,1);
2701 }
2702 $date=DateCalc($date,$del);
2703 next if ((_Date_Split($date))[0] != $yy);
2704 push(@date,$date);
2705 }
2706 }
2707 }
2708 }
2709 last RECUR;
2710
2711 } else {
2712
2713 # Y-M * WOM-0-H-MN-S
2714 # Y-M * WOM-DOW-H-MN-S
2715 return () if (! $dateb && ($y != 0 || $m != 1));
2716 @tmp=(@recur0);
2717 push(@tmp,0) while ($#tmp<6);
2718 $delta=join(":",@tmp);
2719 $dateb=$date0 if (! $dateb);
2720 @tmp=_Date_Recur($date0,$date1,$dateb,$delta);
2721
2722 @w=_ReturnList($w);
2723 @m=();
2724 if ($d eq "0") {
2725 @d=(1);
2726 } else {
2727 @d=_ReturnList($d);
2728 }
2729
2730 @date=_Date_Recur_WoM(\@tmp,\@m,\@w,\@d);
2731 last RECUR;
2732 }
2733 }
2734
2735 if ($#recur0==2) {
2736 # Y-M-W * D-H-MN-S
2737
2738 if ($d eq "0") {
2739
2740 # Y-M-W * 0-H-MN-S
2741 return () if (! $dateb);
2742 $y=1 if ($y==0 && $m==0 && $w==0);
2743 $delta="$y:$m:$w:0:0:0:0";
2744 @date=_Date_Recur($date0,$date1,$dateb,$delta);
2745 last RECUR;
2746
2747 } elsif ($m==0 && $w==0) {
2748
2749 # Y-0-0 * DOY-H-MN-S
2750 $y=1 if ($y==0);
2751 $n=$y;
2752 return () if (! $dateb && $y!=1);
2753
2754 @d=_ReturnList($d);
2755 return () if (! @d);
2756 foreach $d (@d) {
2757 return () if (! _IsInt($d,-366,366) || $d==0);
2758 }
2759
2760 # We need to find years that are a multiple of $n from $y(base)
2761 ($y0)=( _Date_Split($date0, 1) )[0];
2762 ($y1)=( _Date_Split($date1, 1) )[0];
2763 if ($dateb) {
2764 ($yb)=( _Date_Split($dateb, 1) )[0];
2765 } else {
2766 # If $y=1, there is no base year
2767 $yb=0;
2768 }
2769 @date=();
2770 for ($yy=$y0; $yy<=$y1; $yy++) {
2771 my $diy = Date_DaysInYear($yy);
2772 if (($yy-$yb)%$n == 0) {
2773 foreach $d (@d) {
2774 my $tmpd = $d;
2775 $tmpd += ($diy+1) if ($tmpd<0);
2776 next if (! _IsInt($tmpd,1,$diy));
2777 ($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd);
2778 push(@date, _Date_Join($y,$m,$dd,0,0,0));
2779 }
2780 }
2781 }
2782 last RECUR;
2783
2784 } elsif ($w>0) {
2785
2786 # Y-M-W * DOW-H-MN-S
2787 return () if (! $dateb && ($y != 0 && $m != 0 && $w != 1));
2788 @tmp=(@recur0);
2789 push(@tmp,0) while ($#tmp<6);
2790 $delta=join(":",@tmp);
2791
2792 @d=_ReturnList($d);
2793 return () if (! @d);
2794 foreach $d (@d) {
2795 $d += 8 if ($d<0);
2796 return () if (! _IsInt($d,1,7));
2797 }
2798
2799 # Find out what DofW the basedate is.
2800 $dateb = $date0 if (! $dateb);
2801 @tmp2=_Date_Split($dateb, 1);
2802 $tmp=Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]);
2803
2804 @date=();
2805 foreach $d (@d) {
2806 $date_b=$dateb;
2807 # Move basedate to DOW in the same week
2808 if ($d != $tmp) {
2809 if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
2810 ($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
2811 ($tmp<$d && $d<$Cnf{"FirstDay"})) {
2812 $date_b=Date_GetNext($date_b,$d);
2813 } else {
2814 $date_b=Date_GetPrev($date_b,$d);
2815 }
2816 }
2817 push(@date,_Date_Recur($date0,$date1,$date_b,$delta));
2818 }
2819 last RECUR;
2820
2821 } elsif ($m>0) {
2822
2823 # Y-M-0 * DOM-H-MN-S
2824 return () if (! $dateb && ($y != 0 && $m != 1));
2825 @tmp=(@recur0);
2826 push(@tmp,0) while ($#tmp<6);
2827 $delta=join(":",@tmp);
2828
2829 @d=_ReturnList($d);
2830 return () if (! @d);
2831 foreach $d (@d) {
2832 return () if ($d==0 || ! _IsInt($d,-31,31));
2833 }
2834 $dateb = $date0 if (! $dateb);
2835
2836 @tmp2=_Date_Recur($date0,$date1,$dateb,$delta);
2837 @date=();
2838 foreach $date (@tmp2) {
2839 ($y,$m)=( _Date_Split($date, 1) )[0..1];
2840 my $dim=Date_DaysInMonth($m,$y);
2841 foreach $d (@d) {
2842 my $tmpd = $d;
2843 $tmpd += ($dim+1) if ($tmpd<0);
2844 next if (! _IsInt($tmpd,1,$dim));
2845 push(@date,_Date_Join($y,$m,$tmpd,0,0,0));
2846 }
2847 }
2848 last RECUR;
2849
2850 } else {
2851 return ();
2852 }
2853 }
2854
2855 if ($#recur0>2) {
2856
2857 # Y-M-W-D * H-MN-S
2858 # Y-M-W-D-H * MN-S
2859 # Y-M-W-D-H-MN * S
2860 # Y-M-W-D-H-S
2861 if (($#recur0 == 3 &&
2862 ($y == 0 && $m == 0 && $w == 0 && $d == 1)) ||
2863 ($#recur0 == 4 &&
2864 ($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 1)) ||
2865 ($#recur0 == 5 &&
2866 ($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 0 &&
2867 $mn == 1))) {
2868 $dateb = $date0;
2869 }
2870 return () if (! $dateb);
2871 @tmp=(@recur0);
2872 push(@tmp,0) while ($#tmp<6);
2873 $delta=join(":",@tmp);
2874 return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
2875 @date=_Date_Recur($date0,$date1,$dateb,$delta);
2876 if (@recur1) {
2877 unshift(@recur1,-1) while ($#recur1<2);
2878 @time=@recur1;
2879 } else {
2880 shift(@date);
2881 pop(@date);
2882 @time=();
2883 }
2884 }
2885
2886 last RECUR;
2887 }
2888 @date=_Date_RecurSetTime($date0,$date1,\@date,@time) if (@time);
2889
2890 #
2891 # We've got a list of dates. Operate on them with the flags.
2892 #
2893
2894 my($sign,$forw,$today,$df,$db,$work,$i);
2895 if (@flags) {
2896 FLAG: foreach $f (@flags) {
2897 $f = uc($f);
2898
2899 if ($f =~ /^(P|N)(D|T)([1-7])$/) {
2900 @tmp=($1,$2,$3);
2901 $forw =($tmp[0] eq "P" ? 0 : 1);
2902 $today=($tmp[1] eq "D" ? 0 : 1);
2903 $d=$tmp[2];
2904 @tmp=();
2905 foreach $date (@date) {
2906 if ($forw) {
2907 push(@tmp, Date_GetNext($date,$d,$today));
2908 } else {
2909 push(@tmp, Date_GetPrev($date,$d,$today));
2910 }
2911 }
2912 @date=@tmp;
2913 next FLAG;
2914 }
2915
2916 # We want to go forward exact amounts of time instead of
2917 # business mode calculations so that we don't change the time
2918 # (which may have been set in the recur).
2919 if ($f =~ /^(F|B)(D|W)(\d+)$/) {
2920 @tmp=($1,$2,$3);
2921 $sign="+";
2922 $sign="-" if ($tmp[0] eq "B");
2923 $work=0;
2924 $work=1 if ($tmp[1] eq "W");
2925 $n=$tmp[2];
2926 @tmp=();
2927 foreach $date (@date) {
2928 for ($i=1; $i<=$n; $i++) {
2929 while (1) {
2930 $date=DateCalc($date,"${sign}0:0:0:1:0:0:0");
2931 last if (! $work || Date_IsWorkDay($date,0));
2932 }
2933 }
2934 push(@tmp,$date);
2935 }
2936 @date=@tmp;
2937 next FLAG;
2938 }
2939
2940 if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
2941 $tmp=$1;
2942 my $noalt = $2 ? 1 : 0;
2943 if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
2944 $forw=1;
2945 } else {
2946 $forw=0;
2947 }
2948
2949 @tmp=();
2950 DATE: foreach $date (@date) {
2951 $df=$db=$date;
2952 if (Date_IsWorkDay($date)) {
2953 push(@tmp,$date);
2954 next DATE;
2955 }
2956 while (1) {
2957 if ($forw) {
2958 $d=$df=DateCalc($df,"+0:0:0:1:0:0:0");
2959 } else {
2960 $d=$db=DateCalc($db,"-0:0:0:1:0:0:0");
2961 }
2962 if (Date_IsWorkDay($d)) {
2963 push(@tmp,$d);
2964 next DATE;
2965 }
2966 $forw=1-$forw if (! $noalt);
2967 }
2968 }
2969 @date=@tmp;
2970 next FLAG;
2971 }
2972
2973 if ($f eq "EASTER") {
2974 @tmp=();
2975 foreach $date (@date) {
2976 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
2977 ($m,$d)=_Date_Easter($y);
2978 $date=_Date_Join($y,$m,$d,$h,$mn,$s);
2979 next if (Date_Cmp($date,$date0)<0 ||
2980 Date_Cmp($date,$date1)>0);
2981 push(@tmp,$date);
2982 }
2983 @date=@tmp;
2984 }
2985 }
2986 }
2987
2988 @date = sort { Date_Cmp($a,$b) } @date;
2989 return @date;
2990}
2991
2992sub Date_GetPrev {
2993 print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/);
2994 my($date,$dow,$today,$hr,$min,$sec)=@_;
2995 Date_Init() if (! $Curr{"InitDone"});
2996 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
2997 $adjust,$curr)=();
2998 $hr="00" if (defined $hr && $hr eq "0");
2999 $min="00" if (defined $min && $min eq "0");
3000 $sec="00" if (defined $sec && $sec eq "0");
3001
3002 if (! _Date_Split($date)) {
3003 $date=ParseDateString($date);
3004 return "" if (! $date);
3005 }
3006 $curr=$date;
3007 ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
3008
3009 if ($dow) {
3010 $curr_dow=Date_DayOfWeek($m,$d,$y);
3011 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
3012 if (_IsInt($dow)) {
3013 return "" if ($dow<1 || $dow>7);
3014 } else {
3015 return "" if (! exists $dow{lc($dow)});
3016 $dow=$dow{lc($dow)};
3017 }
3018 if ($dow == $curr_dow) {
3019 $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today);
3020 $adjust=1 if ($today==2);
3021 } else {
3022 $dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
3023 $num = $curr_dow - $dow;
3024 $date=_DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0);
3025 }
3026 $date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
3027 $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0)
3028 if ($adjust && Date_Cmp($date,$curr)>0);
3029
3030 } else {
3031 ($h,$mn,$s)=( _Date_Split($date, 1) )[3..5];
3032 ($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec);
3033 if ($hr) {
3034 ($hr,$min,$sec)=($th,$tm,$ts);
3035 $delta="-0:0:0:1:0:0:0";
3036 } elsif ($min) {
3037 ($hr,$min,$sec)=($h,$tm,$ts);
3038 $delta="-0:0:0:0:1:0:0";
3039 } elsif ($sec) {
3040 ($hr,$min,$sec)=($h,$mn,$ts);
3041 $delta="-0:0:0:0:0:1:0";
3042 } else {
3043 confess "ERROR: invalid arguments in Date_GetPrev.\n";
3044 }
3045
3046 $d=Date_SetTime($date,$hr,$min,$sec);
3047 if ($today) {
3048 $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>0);
3049 } else {
3050 $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>=0);
3051 }
3052 $date=$d;
3053 }
3054 return $date;
3055}
3056
3057sub Date_GetNext {
3058 print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/);
3059 my($date,$dow,$today,$hr,$min,$sec)=@_;
3060 Date_Init() if (! $Curr{"InitDone"});
3061 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
3062 $adjust,$curr)=();
3063 $hr="00" if (defined $hr && $hr eq "0");
3064 $min="00" if (defined $min && $min eq "0");
3065 $sec="00" if (defined $sec && $sec eq "0");
3066
3067 if (! _Date_Split($date)) {
3068 $date=ParseDateString($date);
3069 return "" if (! $date);
3070 }
3071 $curr=$date;
3072 ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
3073
3074 if ($dow) {
3075 $curr_dow=Date_DayOfWeek($m,$d,$y);
3076 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
3077 if (_IsInt($dow)) {
3078 return "" if ($dow<1 || $dow>7);
3079 } else {
3080 return "" if (! exists $dow{lc($dow)});
3081 $dow=$dow{lc($dow)};
3082 }
3083 if ($dow == $curr_dow) {
3084 $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today);
3085 $adjust=1 if ($today==2);
3086 } else {
3087 $curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
3088 $num = $dow - $curr_dow;
3089 $date=_DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0);
3090 }
3091 $date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
3092 $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0)
3093 if ($adjust && Date_Cmp($date,$curr)<0);
3094
3095 } else {
3096 ($h,$mn,$s)=( _Date_Split($date, 1) )[3..5];
3097 ($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec);
3098 if ($hr) {
3099 ($hr,$min,$sec)=($th,$tm,$ts);
3100 $delta="+0:0:0:1:0:0:0";
3101 } elsif ($min) {
3102 ($hr,$min,$sec)=($h,$tm,$ts);
3103 $delta="+0:0:0:0:1:0:0";
3104 } elsif ($sec) {
3105 ($hr,$min,$sec)=($h,$mn,$ts);
3106 $delta="+0:0:0:0:0:1:0";
3107 } else {
3108 confess "ERROR: invalid arguments in Date_GetNext.\n";
3109 }
3110
3111 $d=Date_SetTime($date,$hr,$min,$sec);
3112 if ($today) {
3113 $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<0);
3114 } else {
3115 $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<1);
3116 }
3117 $date=$d;
3118 }
3119
3120 return $date;
3121}
3122
3123sub Date_IsHoliday {
3124 print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
3125 my($date)=@_;
3126 Date_Init() if (! $Curr{"InitDone"});
3127 $date=ParseDateString($date);
3128 return undef if (! $date);
3129 $date=Date_SetTime($date,0,0,0);
3130 my($y)=(_Date_Split($date, 1))[0];
3131 _Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y});
3132 return undef if (! exists $Holiday{"dates"}{$y}{$date});
3133 my($name)=$Holiday{"dates"}{$y}{$date};
3134 return "" if (! $name);
3135 $name;
3136}
3137
3138sub Events_List {
3139 print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
3140 my(@args)=@_;
3141 Date_Init() if (! $Curr{"InitDone"});
3142 _Events_ParseRaw();
3143
3144 my($tmp,$date0,$date1,$flag);
3145 $date0=ParseDateString($args[0]);
3146 warn "Invalid date $args[0]", return undef if (! $date0);
3147
3148 if ($#args == 0) {
3149 return _Events_Calc($date0);
3150 }
3151
3152 if ($args[1]) {
3153 $date1=ParseDateString($args[1]);
3154 warn "Invalid date $args[1]\n", return undef if (! $date1);
3155 if (Date_Cmp($date0,$date1)>0) {
3156 $tmp=$date1;
3157 $date1=$date0;
3158 $date0=$tmp;
3159 }
3160 } else {
3161 $date0=Date_SetTime($date0,"00:00:00");
3162 $date1=_DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0");
3163 }
3164
3165 $tmp=_Events_Calc($date0,$date1);
3166
3167 $flag=$args[2];
3168 return $tmp if (! $flag);
3169
3170 my(@tmp,%ret,$delta)=();
3171 @tmp=@$tmp;
3172 push(@tmp,$date1);
3173
3174 if ($flag==1) {
3175 while ($#tmp>0) {
3176 ($date0,$tmp)=splice(@tmp,0,2);
3177 $date1=$tmp[0];
3178 $delta=_DateCalc_DateDate($date0,$date1);
3179 foreach $flag (@$tmp) {
3180 if (exists $ret{$flag}) {
3181 $ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta);
3182 } else {
3183 $ret{$flag}=$delta;
3184 }
3185 }
3186 }
3187 return \%ret;
3188
3189 } elsif ($flag==2) {
3190 while ($#tmp>0) {
3191 ($date0,$tmp)=splice(@tmp,0,2);
3192 $date1=$tmp[0];
3193 $delta=_DateCalc_DateDate($date0,$date1);
3194 $flag=join("+",sort { Date_Cmp($a,$b) } @$tmp);
3195 next if (! $flag);
3196 if (exists $ret{$flag}) {
3197 $ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta);
3198 } else {
3199 $ret{$flag}=$delta;
3200 }
3201 }
3202 return \%ret;
3203 }
3204
3205 warn "Invalid flag $flag\n";
3206 return undef;
3207}
3208
3209###
3210# NOTE: The following routines may be called in the routines below with very
3211# little time penalty.
3212###
3213sub Date_SetTime {
3214 print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
3215 my($date,$h,$mn,$s)=@_;
3216 Date_Init() if (! $Curr{"InitDone"});
3217 my($y,$m,$d)=();
3218
3219 if (! _Date_Split($date)) {
3220 $date=ParseDateString($date);
3221 return "" if (! $date);
3222 }
3223
3224 ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
3225 ($h,$mn,$s)=_Date_ParseTime($h,$mn,$s);
3226
3227 my($ampm,$wk);
3228 return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
3229 _Date_Join($y,$m,$d,$h,$mn,$s);
3230}
3231
3232sub Date_SetDateField {
3233 print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/);
3234 my($date,$field,$val,$nocheck)=@_;
3235 my($y,$m,$d,$h,$mn,$s)=();
3236 $nocheck=0 if (! defined $nocheck);
3237
3238 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date);
3239
3240 if (! $y) {
3241 $date=ParseDateString($date);
3242 return "" if (! $date);
3243 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
3244 }
3245
3246 if (lc($field) eq "y") {
3247 $y=$val;
3248 } elsif (lc($field) eq "m") {
3249 $m=$val;
3250 } elsif (lc($field) eq "d") {
3251 $d=$val;
3252 } elsif (lc($field) eq "h") {
3253 $h=$val;
3254 } elsif (lc($field) eq "mn") {
3255 $mn=$val;
3256 } elsif (lc($field) eq "s") {
3257 $s=$val;
3258 } else {
3259 confess "ERROR: Date_SetDateField: invalid field: $field\n";
3260 }
3261
3262 $date=_Date_Join($y,$m,$d,$h,$mn,$s);
3263 return $date if ($nocheck || _Date_Split($date));
3264 return "";
3265}
3266
3267########################################################################
3268# OTHER SUBROUTINES
3269########################################################################
3270# NOTE: These routines should not call any of the routines above as
3271# there will be a severe time penalty (and the possibility of
3272# infinite recursion). The last couple routines above are
3273# exceptions.
3274# NOTE: Date_Init is a special case. It should be called (conditionally)
3275# in every routine that uses any variable from the Date::Manip
3276# namespace.
3277########################################################################
3278
3279sub Date_DaysInMonth {
3280 print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
3281 my($m,$y)=@_;
3282 $y=_Date_FixYear($y) if (length($y)!=4);
3283 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
3284 $d_in_m[2]=29 if (Date_LeapYear($y));
3285 return $d_in_m[$m];
3286}
3287
3288sub Date_DayOfWeek {
3289 print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
3290 my($m,$d,$y)=@_;
3291 $y=_Date_FixYear($y) if (length($y)!=4);
3292 my($dayofweek,$dec31)=();
3293
3294 $dec31=5; # Dec 31, 1BC was Friday
3295 $dayofweek=(Date_DaysSince1BC($m,$d,$y)+$dec31) % 7;
3296 $dayofweek=7 if ($dayofweek==0);
3297 return $dayofweek;
3298}
3299
3300# Can't be in "use integer" because the numbers are too big.
33013374µs125µsno integer;
# spent 15µs making 1 call to integer::unimport
3302sub Date_SecsSince1970 {
3303 print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
3304 my($m,$d,$y,$h,$mn,$s)=@_;
3305 $y=_Date_FixYear($y) if (length($y)!=4);
3306 my($sec_now,$sec_70)=();
3307 $sec_now=(Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s;
3308# $sec_70 =(Date_DaysSince1BC(1,1,1970)-1)*24*3600;
3309 $sec_70 =62167219200;
3310 return ($sec_now-$sec_70);
3311}
3312
3313sub Date_SecsSince1970GMT {
3314 print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/);
3315 my($m,$d,$y,$h,$mn,$s)=@_;
3316 Date_Init() if (! $Curr{"InitDone"});
3317 $y=_Date_FixYear($y) if (length($y)!=4);
3318
3319 my($sec)=Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
3320 return $sec if ($Cnf{"ConvTZ"} eq "IGNORE");
3321
3322 my($tz)=$Cnf{"ConvTZ"};
3323 $tz=$Cnf{"TZ"} if (! $tz);
3324 $tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
3325
3326 my($tzs)=1;
3327 $tzs=-1 if ($tz<0);
3328 $tz=~/.(..)(..)/;
3329 my($tzh,$tzm)=($1,$2);
3330 $sec - $tzs*($tzh*3600+$tzm*60);
3331}
333233.18ms1.06msuse integer;
# spent 8µs making 1 call to integer::import
3333
3334sub Date_DaysSince1BC {
3335 print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
3336 my($m,$d,$y)=@_;
3337 $y=_Date_FixYear($y) if (length($y)!=4);
3338 my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
3339 my($cc,$yy)=();
3340
3341 $y=~ /(\d{2})(\d{2})/;
3342 ($cc,$yy)=($1,$2);
3343
3344 # Number of full years since Dec 31, 1BC (counting the year 0000).
3345 $Ny=$y;
3346
3347 # Number of full 4th years (incl. 0000) since Dec 31, 1BC
3348 $N4=($Ny-1)/4 + 1;
3349 $N4=0 if ($y==0);
3350
3351 # Number of full 100th years (incl. 0000)
3352 $N100=$cc + 1;
3353 $N100-- if ($yy==0);
3354 $N100=0 if ($y==0);
3355
3356 # Number of full 400th years (incl. 0000)
3357 $N400=($N100-1)/4 + 1;
3358 $N400=0 if ($y==0);
3359
3360 $dayofyear=Date_DayOfYear($m,$d,$y);
3361 $days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
3362
3363 return $days;
3364}
3365
3366sub Date_DayOfYear {
3367 print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3368 my($m,$d,$y)=@_;
3369 $y=_Date_FixYear($y) if (length($y)!=4);
3370 # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
3371 my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
3372 my($ly)=0;
3373 $ly=1 if ($m>2 && Date_LeapYear($y));
3374 return ($days[$m-1]+$d+$ly);
3375}
3376
3377sub Date_DaysInYear {
3378 print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
3379 my($y)=@_;
3380 $y=_Date_FixYear($y) if (length($y)!=4);
3381 return 366 if (Date_LeapYear($y));
3382 return 365;
3383}
3384
3385sub Date_WeekOfYear {
3386 print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3387 my($m,$d,$y,$f)=@_;
3388 Date_Init() if (! $Curr{"InitDone"});
3389 $y=_Date_FixYear($y) if (length($y)!=4);
3390
3391 my($day,$dow,$doy)=();
3392 $doy=Date_DayOfYear($m,$d,$y);
3393
3394 # The current DayOfYear and DayOfWeek
3395 if ($Cnf{"Jan1Week1"}) {
3396 $day=1;
3397 } else {
3398 $day=4;
3399 }
3400 $dow=Date_DayOfWeek(1,$day,$y);
3401
3402 # Move back to the first day of week 1.
3403 $f-=7 if ($f>$dow);
3404 $day-= ($dow-$f);
3405
3406 return 0 if ($day>$doy); # Day is in last week of previous year
3407 return (($doy-$day)/7 + 1);
3408}
3409
3410sub Date_LeapYear {
3411 print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
3412 my($y)=@_;
3413 $y=_Date_FixYear($y) if (length($y)!=4);
3414 return 0 unless $y % 4 == 0;
3415 return 1 unless $y % 100 == 0;
3416 return 0 unless $y % 400 == 0;
3417 return 1;
3418}
3419
3420sub Date_DaySuffix {
3421 print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
3422 my($d)=@_;
3423 Date_Init() if (! $Curr{"InitDone"});
3424 return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
3425}
3426
3427sub Date_ConvTZ {
3428 print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
3429 my($date,$from,$to,$level)=@_;
3430 if (not _Date_Split($date)) {
3431 my $err = "date passed in ('$date') is not a Date::Manip object";
3432 if (! $level) {
3433 croak $err;
3434 } elsif ($level==1) {
3435 carp $err;
3436 }
3437 return "";
3438 }
3439
3440 Date_Init() if (! $Curr{"InitDone"});
3441 my($gmt)=();
3442
3443 if (! $from) {
3444
3445 if (! $to) {
3446 # TZ -> ConvTZ
3447 return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
3448 $from=$Cnf{"TZ"};
3449 $to=$Cnf{"ConvTZ"};
3450
3451 } else {
3452 # ConvTZ,TZ -> $to
3453 $from=$Cnf{"ConvTZ"};
3454 $from=$Cnf{"TZ"} if (! $from);
3455 }
3456
3457 } else {
3458
3459 if (! $to) {
3460 # $from -> ConvTZ,TZ
3461 return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
3462 $to=$Cnf{"ConvTZ"};
3463 $to=$Cnf{"TZ"} if (! $to);
3464
3465 } else {
3466 # $from -> $to
3467 }
3468 }
3469
3470 $to=$Zone{"n2o"}{lc($to)}
3471 if (exists $Zone{"n2o"}{lc($to)});
3472 $from=$Zone{"n2o"}{lc($from)}
3473 if (exists $Zone{"n2o"}{lc($from)});
3474 $gmt=$Zone{"n2o"}{"gmt"};
3475
3476 return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/);
3477 return $date if ($from eq $to);
3478
3479 my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=();
3480 # We're going to try to do the calculation without calling DateCalc.
3481 ($yr,$mon,$d,$h,$m,$sec)=_Date_Split($date, 1);
3482
3483 # Convert $date from $from to GMT
3484 $from=~/([+-])(\d{2})(\d{2})/;
3485 ($s1,$h1,$m1)=($1,$2,$3);
3486 $s1= ($s1 eq "-" ? "+" : "-"); # switch sign
3487 $sign=$s1 . "1"; # + or - 1
3488
3489 # and from GMT to $to
3490 $to=~/([+-])(\d{2})(\d{2})/;
3491 ($s2,$h2,$m2)=($1,$2,$3);
3492
3493 if ($s1 eq $s2) {
3494 # Both the same sign
3495 $m+= $sign*($m1+$m2);
3496 $h+= $sign*($h1+$h2);
3497 } else {
3498 $sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
3499 $m+= $sign*($m1-$m2);
3500 $h+= $sign*($h1-$h2);
3501 }
3502
3503 if ($m>59) {
3504 $h+= $m/60;
3505 $m-= ($m/60)*60;
3506 } elsif ($m<0) {
3507 $h+= ($m/60 - 1);
3508 $m-= ($m/60 - 1)*60;
3509 }
3510
3511 if ($h>23) {
3512 $delta=$h/24;
3513 $h -= $delta*24;
3514 if (($d + $delta) > 28) {
3515 $date=_Date_Join($yr,$mon,$d,$h,$m,$sec);
3516 return _DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0);
3517 }
3518 $d+= $delta;
3519 } elsif ($h<0) {
3520 $delta=-$h/24 + 1;
3521 $h += $delta*24;
3522 if (($d - $delta) < 1) {
3523 $date=_Date_Join($yr,$mon,$d,$h,$m,$sec);
3524 return _DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0);
3525 }
3526 $d-= $delta;
3527 }
3528 return _Date_Join($yr,$mon,$d,$h,$m,$sec);
3529}
3530
3531sub Date_TimeZone {
3532 print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/);
3533 my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=();
3534 Date_Init() if (! $Curr{"InitDone"});
3535
3536 # Get timezones from all of the relevant places
3537
3538 push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var
3539 push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var
3540 push(@tz,$ENV{'SYS$TIMEZONE_RULE'})
3541 if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var
3542 push(@tz,$ENV{'SYS$TIMEZONE_NAME'})
3543 if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var
3544 push(@tz,$ENV{'UCX$TZ'})
3545 if defined $ENV{'UCX$TZ'}; # VMS TZ environ var
3546 push(@tz,$ENV{'TCPIP$TZ'})
3547 if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var
3548
3549 # The `date` command... if we're doing taint checking, we need to
3550 # always call it with a full path... otherwise, use the user's path.
3551 #
3552 # Microsoft operating systems don't have a date command built in. Try
3553 # to trap all the various ways of knowing we are on one of these systems.
3554 #
3555 # We'll try `date +%Z` first, and if that fails, we'll take just the
3556 # `date` program and assume the output is of the format:
3557 # Thu Aug 31 14:57:46 EDT 2000
3558
3559 unless (($^O ne 'cygwin' && $^X =~ /perl\.exe$/i) or
3560 ($OS eq "Windows") or
3561 ($OS eq "Netware") or
3562 ($OS eq "VMS")) {
3563 if ($Date::Manip::NoTaint) {
3564 if ($OS eq "VMS") {
3565 $tz=$ENV{'SYS$TIMEZONE_NAME'};
3566 if (! $tz) {
3567 $tz=$ENV{'MULTINET_TIMEZONE'};
3568 if (! $tz) {
3569 $tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
3570 }
3571 }
3572 } else {
3573 $tz=`date +%Z 2> /dev/null`;
3574 chomp($tz);
3575 if (! $tz) {
3576 $tz=`date 2> /dev/null`;
3577 chomp($tz);
3578 $tz=(split(/\s+/,$tz))[4];
3579 }
3580 }
3581 push(@tz,$tz) if (defined $tz);
3582 } else {
3583 # We need to satisfy taint checking, but also look in all the
3584 # directories in @DatePath.
3585 #
3586 local $ENV{PATH} = join(':', @Date::Manip::DatePath);
3587 local $ENV{BASH_ENV} = '';
3588 $tz=`date +%Z 2> /dev/null`;
3589 chomp($tz);
3590 if (! $tz) {
3591 $tz=`date 2> /dev/null`;
3592 chomp($tz);
3593 $tz=(split(/\s+/,$tz))[4];
3594 }
3595 push(@tz,$tz) if (defined $tz);
3596 }
3597 }
3598
3599 push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ
3600
3601 if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE
3602 $in=new IO::File;
3603 $in->open("/etc/TIMEZONE","r");
3604 while (! eof($in)) {
3605 $tmp=<$in>;
3606 if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
3607 push(@tz,$1);
3608 last;
3609 }
3610 }
3611 $in->close;
3612 }
3613
3614 if (-s "/etc/timezone") { # /etc/timezone
3615 $in=new IO::File;
3616 $in->open("/etc/timezone","r");
3617 while (! eof($in)) {
3618 $tmp=<$in>;
3619 next if ($tmp =~ /^\s*\043/);
3620 chomp($tmp);
3621 if ($tmp =~ /^\s*(.*?)\s*$/) {
3622 push(@tz,$1);
3623 last;
3624 }
3625 }
3626 $in->close;
3627 }
3628
3629 # Now parse each one to find the first valid one.
3630 foreach $tz (@tz) {
3631 $tz =~ s/\s*$//;
3632 $tz =~ s/^\s*//;
3633 $tz =~ s/^://;
3634 next if ($tz eq "");
3635
3636 return uc($tz)
3637 if (defined $Zone{"n2o"}{lc($tz)});
3638
3639 if ($tz =~ /^[+-]\d{4}$/) {
3640 return $tz;
3641 } elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
3642 my($h,$m)=($1,$2);
3643 $m="00" if (! $m);
3644 return "$h$m";
3645 }
3646
3647 # Handle US/Eastern format
3648 if ($tz =~ /^$Zone{"tzones"}$/i) {
3649 $tmp=lc $1;
3650 $tz=$Zone{"tz2z"}{$tmp};
3651 }
3652
3653 # Handle STD#DST# format (and STD-#DST-# formats)
3654 if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
3655 ($std,$dst)=($1,$2);
3656 next if (! defined $Zone{"n2o"}{lc($std)} or
3657 ! defined $Zone{"n2o"}{lc($dst)});
3658 $time = time();
3659 ($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
3660 localtime($time);
3661 return uc($dst) if ($isdst);
3662 return uc($std);
3663 }
3664 }
3665
3666 confess "ERROR: Date::Manip unable to determine Time Zone.\n";
3667}
3668
3669# Returns 1 if $date is a work day. If $time is non-zero, the time is
3670# also checked to see if it falls within work hours. Returns "" if
3671# an invalid date is passed in.
3672sub Date_IsWorkDay {
3673 print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3674 my($date,$time)=@_;
3675 Date_Init() if (! $Curr{"InitDone"});
3676 $date=ParseDateString($date);
3677 return "" if (! $date);
3678 my($d)=$date;
3679 $d=Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time);
3680
3681 my($y,$mon,$day,$h,$m,$s,$dow)=();
3682 ($y,$mon,$day,$h,$m,$s)=_Date_Split($d, 1);
3683 $dow=Date_DayOfWeek($mon,$day,$y);
3684
3685 return 0 if ($dow<$Cnf{"WorkWeekBeg"} or
3686 $dow>$Cnf{"WorkWeekEnd"} or
3687 "$h:$m" lt $Cnf{"WorkDayBeg"} or
3688 "$h:$m" ge $Cnf{"WorkDayEnd"});
3689
3690 if (! exists $Holiday{"dates"}{$y}) {
3691 # There will be recursion problems if we ever end up here twice.
3692 $Holiday{"dates"}{$y}={};
3693 _Date_UpdateHolidays($y)
3694 }
3695 $d=Date_SetTime($date,"00:00:00");
3696 return 0 if (exists $Holiday{"dates"}{$y}{$d});
3697 1;
3698}
3699
3700# Finds the day $off work days from now. If $time is passed in, we must
3701# also take into account the time of day.
3702#
3703# If $time is not passed in, day 0 is today (if today is a workday) or the
3704# next work day if it isn't. In any case, the time of day is unaffected.
3705#
3706# If $time is passed in, day 0 is now (if now is part of a workday) or the
3707# start of the very next work day.
3708sub Date_NextWorkDay {
3709 print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3710 my($date,$off,$time)=@_;
3711 Date_Init() if (! $Curr{"InitDone"});
3712 $date=ParseDateString($date);
3713 my($err)=();
3714
3715 if (! Date_IsWorkDay($date,$time)) {
3716 if ($time) {
3717 while (1) {
3718 $date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3719 last if (Date_IsWorkDay($date,$time));
3720 }
3721 } else {
3722 while (1) {
3723 $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3724 last if (Date_IsWorkDay($date,$time));
3725 }
3726 }
3727 }
3728
3729 while ($off>0) {
3730 while (1) {
3731 $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3732 last if (Date_IsWorkDay($date,$time));
3733 }
3734 $off--;
3735 }
3736
3737 return $date;
3738}
3739
3740# Finds the day $off work days before now. If $time is passed in, we must
3741# also take into account the time of day.
3742#
3743# If $time is not passed in, day 0 is today (if today is a workday) or the
3744# previous work day if it isn't. In any case, the time of day is unaffected.
3745#
3746# If $time is passed in, day 0 is now (if now is part of a workday) or the
3747# end of the previous work period. Note that since the end of a work day
3748# will automatically be turned into the start of the next one, this time
3749# may actually be treated as AFTER the current time.
3750sub Date_PrevWorkDay {
3751 print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3752 my($date,$off,$time)=@_;
3753 Date_Init() if (! $Curr{"InitDone"});
3754 $date=ParseDateString($date);
3755 my($err)=();
3756
3757 if (! Date_IsWorkDay($date,$time)) {
3758 if ($time) {
3759 while (1) {
3760 $date=Date_GetPrev($date,undef,0,$Cnf{"WorkDayEnd"});
3761 last if (Date_IsWorkDay($date,$time));
3762 }
3763 while (1) {
3764 $date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3765 last if (Date_IsWorkDay($date,$time));
3766 }
3767 } else {
3768 while (1) {
3769 $date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3770 last if (Date_IsWorkDay($date,$time));
3771 }
3772 }
3773 }
3774
3775 while ($off>0) {
3776 while (1) {
3777 $date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3778 last if (Date_IsWorkDay($date,$time));
3779 }
3780 $off--;
3781 }
3782
3783 return $date;
3784}
3785
3786# This finds the nearest workday to $date. If $date is a workday, it
3787# is returned.
3788sub Date_NearestWorkDay {
3789 print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3790 my($date,$tomorrow)=@_;
3791 Date_Init() if (! $Curr{"InitDone"});
3792 $date=ParseDateString($date);
3793 my($a,$b,$dela,$delb,$err)=();
3794 $tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow);
3795
3796 return $date if (Date_IsWorkDay($date));
3797
3798 # Find the nearest one.
3799 if ($tomorrow) {
3800 $dela="+0:0:0:1:0:0:0";
3801 $delb="-0:0:0:1:0:0:0";
3802 } else {
3803 $dela="-0:0:0:1:0:0:0";
3804 $delb="+0:0:0:1:0:0:0";
3805 }
3806 $a=$b=$date;
3807
3808 while (1) {
3809 $a=_DateCalc_DateDelta($a,$dela,\$err);
3810 return $a if (Date_IsWorkDay($a));
3811 $b=_DateCalc_DateDelta($b,$delb,\$err);
3812 return $b if (Date_IsWorkDay($b));
3813 }
3814}
3815
3816# Date_NthDayOfYear($y,$n);
3817# Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year.
3818sub Date_NthDayOfYear {
381932.16ms719µs no integer;
# spent 10µs making 1 call to integer::unimport
3820 print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3821 my($y,$n)=@_;
3822 $y=$Curr{"Y"} if (! $y);
3823 $n=1 if (! defined $n or $n eq "");
3824 $n+=0; # to turn 023 into 23
3825 $y=_Date_FixYear($y) if (length($y)<4);
3826 my $leap=Date_LeapYear($y);
3827 return () if ($n<1);
3828 return () if ($n >= ($leap ? 367 : 366));
3829
3830 my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31);
3831 $d_in_m[1]=29 if ($leap);
3832
3833 # Calculate the hours, minutes, and seconds into the day.
3834 my $remain=($n - int($n))*24;
3835 my $h=int($remain);
3836 $remain=($remain - $h)*60;
3837 my $mn=int($remain);
3838 $remain=($remain - $mn)*60;
3839 my $s=$remain;
3840
3841 # Calculate the month and the day.
3842 my($m,$d)=(0,0);
3843 $n=int($n);
3844 while ($n>0) {
3845 $m++;
3846 if ($n<=$d_in_m[0]) {
3847 $d=int($n);
3848 $n=0;
3849 } else {
3850 $n-= $d_in_m[0];
3851 shift(@d_in_m);
3852 }
3853 }
3854
3855 ($y,$m,$d,$h,$mn,$s);
3856}
3857
3858########################################################################
3859# NOT FOR EXPORT
3860########################################################################
3861
3862# This is used in Date_Init to fill in a hash based on international
3863# data. It takes a list of keys and values and returns both a hash
3864# with these values and a regular expression of keys.
3865#
3866# IN:
3867# $data = [ key1 val1 key2 val2 ... ]
3868# $opts = lc : lowercase the keys in the regexp
3869# sort : sort (by length) the keys in the regexp
3870# back : create a regexp with a back reference
3871# escape : escape all strings in the regexp
3872#
3873# OUT:
3874# $regexp = '(?:key1|key2|...)'
3875# $hash = { key1=>val1 key2=>val2 ... }
3876
3877sub _Date_InitHash {
3878 print "DEBUG: _Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
3879 my($data,$regexp,$opts,$hash)=@_;
3880 my(@data)=@$data;
3881 my($key,$val,@list)=();
3882
3883 # Parse the options
3884 my($lc,$sort,$back,$escape)=(0,0,0,0);
3885 $lc=1 if ($opts =~ /lc/i);
3886 $sort=1 if ($opts =~ /sort/i);
3887 $back=1 if ($opts =~ /back/i);
3888 $escape=1 if ($opts =~ /escape/i);
3889
3890 # Create the hash
3891 while (@data) {
3892 ($key,$val,@data)=@data;
3893 $key=lc($key) if ($lc);
3894 $$hash{$key}=$val;
3895 }
3896
3897 # Create the regular expression
3898 if ($regexp) {
3899 @list=keys(%$hash);
3900 @list=sort _sortByLength(@list) if ($sort);
3901 if ($escape) {
3902 foreach $val (@list) {
3903 $val="\Q$val\E";
3904 }
3905 }
3906 if ($back) {
3907 $$regexp="(" . join("|",@list) . ")";
3908 } else {
3909 $$regexp="(?:" . join("|",@list) . ")";
3910 }
3911 }
3912}
3913
3914# This is used in Date_Init to fill in regular expressions, lists, and
3915# hashes based on international data. It takes a list of lists which have
3916# to be stored as regular expressions (to find any element in the list),
3917# lists, and hashes (indicating the location in the lists).
3918#
3919# IN:
3920# $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ]
3921# [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ]
3922# ...
3923# [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ]
3924# $lists = [ \@listA \@listB ... \@listZ ]
3925# $opts = lc : lowercase the values in the regexp
3926# sort : sort (by length) the values in the regexp
3927# back : create a regexp with a back reference
3928# escape : escape all strings in the regexp
3929# $hash = [ \%hash, TYPE ]
3930# TYPE 0 : $hash{ valBn=>n-1 }
3931# TYPE 1 : $hash{ valBn=>n }
3932#
3933# OUT:
3934# $regexp = '(?:valA1|valA2|...|valB1|...)'
3935# $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
3936# [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
3937# $hash
3938
3939sub _Date_InitLists {
3940 print "DEBUG: _Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
3941 my($data,$regexp,$opts,$lists,$hash)=@_;
3942 my(@data)=@$data;
3943 my(@lists)=@$lists;
3944 my($i,@ele,$ele,@list,$j,$tmp)=();
3945
3946 # Parse the options
3947 my($lc,$sort,$back,$escape)=(0,0,0,0);
3948 $lc=1 if ($opts =~ /lc/i);
3949 $sort=1 if ($opts =~ /sort/i);
3950 $back=1 if ($opts =~ /back/i);
3951 $escape=1 if ($opts =~ /escape/i);
3952
3953 # Set each of the lists
3954 if (@lists) {
3955 confess "ERROR: _Date_InitLists: lists must be 1 per data\n"
3956 if ($#lists != $#data);
3957 for ($i=0; $i<=$#data; $i++) {
3958 @ele=@{ $data[$i] };
3959 if ($Cnf{"IntCharSet"} && $#ele>0) {
3960 @{ $lists[$i] } = @{ $ele[1] };
3961 } else {
3962 @{ $lists[$i] } = @{ $ele[0] };
3963 }
3964 }
3965 }
3966
3967 # Create the hash
3968 my($hashtype,$hashsave,%hash)=();
3969 if (@$hash) {
3970 ($hash,$hashtype)=@$hash;
3971 $hashsave=1;
3972 } else {
3973 $hashtype=0;
3974 $hashsave=0;
3975 }
3976 for ($i=0; $i<=$#data; $i++) {
3977 @ele=@{ $data[$i] };
3978 foreach $ele (@ele) {
3979 @list = @{ $ele };
3980 for ($j=0; $j<=$#list; $j++) {
3981 $tmp=$list[$j];
3982 next if (! $tmp);
3983 $tmp=lc($tmp) if ($lc);
3984 $hash{$tmp}= $j+$hashtype;
3985 }
3986 }
3987 }
3988 %$hash = %hash if ($hashsave);
3989
3990 # Create the regular expression
3991 if ($regexp) {
3992 @list=keys(%hash);
3993 @list=sort _sortByLength(@list) if ($sort);
3994 if ($escape) {
3995 foreach $ele (@list) {
3996 $ele="\Q$ele\E";
3997 }
3998 }
3999 if ($back) {
4000 $$regexp="(" . join("|",@list) . ")";
4001 } else {
4002 $$regexp="(?:" . join("|",@list) . ")";
4003 }
4004 }
4005}
4006
4007# This is used in Date_Init to fill in regular expressions and lists based
4008# on international data. This takes a list of strings and returns a regular
4009# expression (to find any one of them).
4010#
4011# IN:
4012# $data = [ string1 string2 ... ]
4013# $opts = lc : lowercase the values in the regexp
4014# sort : sort (by length) the values in the regexp
4015# back : create a regexp with a back reference
4016# escape : escape all strings in the regexp
4017#
4018# OUT:
4019# $regexp = '(string1|string2|...)'
4020
4021sub _Date_InitStrings {
4022 print "DEBUG: _Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
4023 my($data,$regexp,$opts)=@_;
4024 my(@list)=@{ $data };
4025
4026 # Parse the options
4027 my($lc,$sort,$back,$escape)=(0,0,0,0);
4028 $lc=1 if ($opts =~ /lc/i);
4029 $sort=1 if ($opts =~ /sort/i);
4030 $back=1 if ($opts =~ /back/i);
4031 $escape=1 if ($opts =~ /escape/i);
4032
4033 # Create the regular expression
4034 my($ele)=();
4035 @list=sort _sortByLength(@list) if ($sort);
4036 if ($escape) {
4037 foreach $ele (@list) {
4038 $ele="\Q$ele\E";
4039 }
4040 }
4041 if ($back) {
4042 $$regexp="(" . join("|",@list) . ")";
4043 } else {
4044 $$regexp="(?:" . join("|",@list) . ")";
4045 }
4046 $$regexp=lc($$regexp) if ($lc);
4047}
4048
4049# items is passed in (either as a space separated string, or a reference to
4050# a list) and a regular expression which matches any one of the items is
4051# prepared. The regular expression will be of one of the forms:
4052# "(a|b)" @list not empty, back option included
4053# "(?:a|b)" @list not empty
4054# "()" @list empty, back option included
4055# "" @list empty
4056# $options is a string which contains any of the following strings:
4057# back : the regular expression has a backreference
4058# opt : the regular expression is optional and a "?" is appended in
4059# the first two forms
4060# optws : the regular expression is optional and may be replaced by
4061# whitespace
4062# optWs : the regular expression is optional, but if not present, must
4063# be replaced by whitespace
4064# sort : the items in the list are sorted by length (longest first)
4065# lc : the string is lowercased
4066# under : any underscores are converted to spaces
4067# pre : it may be preceded by whitespace
4068# Pre : it must be preceded by whitespace
4069# PRE : it must be preceded by whitespace or the start
4070# post : it may be followed by whitespace
4071# Post : it must be followed by whitespace
4072# POST : it must be followed by whitespace or the end
4073# Spaces due to pre/post options will not be included in the back reference.
4074#
4075# If $array is included, then the elements will also be returned as a list.
4076# $array is a string which may contain any of the following:
4077# keys : treat the list as a hash and only the keys go into the regexp
4078# key0 : treat the list as the values of a hash with keys 0 .. N-1
4079# key1 : treat the list as the values of a hash with keys 1 .. N
4080# val0 : treat the list as the keys of a hash with values 0 .. N-1
4081# val1 : treat the list as the keys of a hash with values 1 .. N
4082
4083# _Date_InitLists([$lang{"month_name"},$lang{"month_abb"}],
4084# [\$Month,"lc,sort,back"],
4085# [\@Month,\@Mon],
4086# [\%Month,1]);
4087
4088# This is used in Date_Init to prepare regular expressions. A list of
4089# items is passed in (either as a space separated string, or a reference to
4090# a list) and a regular expression which matches any one of the items is
4091# prepared. The regular expression will be of one of the forms:
4092# "(a|b)" @list not empty, back option included
4093# "(?:a|b)" @list not empty
4094# "()" @list empty, back option included
4095# "" @list empty
4096# $options is a string which contains any of the following strings:
4097# back : the regular expression has a backreference
4098# opt : the regular expression is optional and a "?" is appended in
4099# the first two forms
4100# optws : the regular expression is optional and may be replaced by
4101# whitespace
4102# optWs : the regular expression is optional, but if not present, must
4103# be replaced by whitespace
4104# sort : the items in the list are sorted by length (longest first)
4105# lc : the string is lowercased
4106# under : any underscores are converted to spaces
4107# pre : it may be preceded by whitespace
4108# Pre : it must be preceded by whitespace
4109# PRE : it must be preceded by whitespace or the start
4110# post : it may be followed by whitespace
4111# Post : it must be followed by whitespace
4112# POST : it must be followed by whitespace or the end
4113# Spaces due to pre/post options will not be included in the back reference.
4114#
4115# If $array is included, then the elements will also be returned as a list.
4116# $array is a string which may contain any of the following:
4117# keys : treat the list as a hash and only the keys go into the regexp
4118# key0 : treat the list as the values of a hash with keys 0 .. N-1
4119# key1 : treat the list as the values of a hash with keys 1 .. N
4120# val0 : treat the list as the keys of a hash with values 0 .. N-1
4121# val1 : treat the list as the keys of a hash with values 1 .. N
4122sub _Date_Regexp {
4123 print "DEBUG: _Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
4124 my($list,$options,$array)=@_;
4125 my(@list,$ret,%hash,$i)=();
4126 local($_)=();
4127 $options="" if (! defined $options);
4128 $array="" if (! defined $array);
4129
4130 my($sort,$lc,$under)=(0,0,0);
4131 $sort =1 if ($options =~ /sort/i);
4132 $lc =1 if ($options =~ /lc/i);
4133 $under=1 if ($options =~ /under/i);
4134 my($back,$opt,$pre,$post,$ws)=("?:","","","","");
4135 $back ="" if ($options =~ /back/i);
4136 $opt ="?" if ($options =~ /opt/i);
4137 $pre ='\s*' if ($options =~ /pre/);
4138 $pre ='\s+' if ($options =~ /Pre/);
4139 $pre ='(?:\s+|^)' if ($options =~ /PRE/);
4140 $post ='\s*' if ($options =~ /post/);
4141 $post ='\s+' if ($options =~ /Post/);
4142 $post ='(?:$|\s+)' if ($options =~ /POST/);
4143 $ws ='\s*' if ($options =~ /optws/);
4144 $ws ='\s+' if ($options =~ /optws/);
4145
4146 my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0);
4147 $keys =1 if ($array =~ /keys/i);
4148 $key0 =1 if ($array =~ /key0/i);
4149 $key1 =1 if ($array =~ /key1/i);
4150 $val0 =1 if ($array =~ /val0/i);
4151 $val1 =1 if ($array =~ /val1/i);
4152 $hash =1 if ($keys or $key0 or $key1 or $val0 or $val1);
4153
4154 my($ref)=ref $list;
4155 if (! $ref) {
4156 $list =~ s/\s*$//;
4157 $list =~ s/^\s*//;
4158 $list =~ s/\s+/&&&/g;
4159 } elsif ($ref eq "ARRAY") {
4160 $list = join("&&&",@$list);
4161 } else {
4162 confess "ERROR: _Date_Regexp.\n";
4163 }
4164
4165 if (! $list) {
4166 if ($back eq "") {
4167 return "()";
4168 } else {
4169 return "";
4170 }
4171 }
4172
4173 $list=lc($list) if ($lc);
4174 $list=~ s/_/ /g if ($under);
4175 @list=split(/&&&/,$list);
4176 if ($keys) {
4177 %hash=@list;
4178 @list=keys %hash;
4179 } elsif ($key0 or $key1 or $val0 or $val1) {
4180 $i=0;
4181 $i=1 if ($key1 or $val1);
4182 if ($key0 or $key1) {
4183 %hash= map { $_,$i++ } @list;
4184 } else {
4185 %hash= map { $i++,$_ } @list;
4186 }
4187 }
4188 @list=sort _sortByLength(@list) if ($sort);
4189
4190 $ret="($back" . join("|",@list) . ")";
4191 $ret="(?:$pre$ret$post)" if ($pre or $post);
4192 $ret.=$opt;
4193 $ret="(?:$ret|$ws)" if ($ws);
4194
4195 if ($array and $hash) {
4196 return ($ret,%hash);
4197 } elsif ($array) {
4198 return ($ret,@list);
4199 } else {
4200 return $ret;
4201 }
4202}
4203
4204# This will produce a delta with the correct number of signs. At most two
4205# signs will be in it normally (one before the year, and one in front of
4206# the day), but if appropriate, signs will be in front of all elements.
4207# Also, as many of the signs will be equivalent as possible.
4208sub _Delta_Normalize {
4209 print "DEBUG: _Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
4210 my($delta,$mode)=@_;
4211 return "" if (! $delta);
4212 return "+0:+0:+0:+0:+0:+0:+0"
4213 if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"});
4214 return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/);
4215
4216 my($tmp,$sign1,$sign2,$len)=();
4217
4218 # Calculate the length of the day in minutes
4219 $len=24*60;
4220 $len=$Curr{"WDlen"} if ($mode==2 || $mode==3);
4221
4222 # We have to get the sign of every component explicitely so that a "-0"
4223 # or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must
4224 # be a negative delta).
4225
4226 my($y,$mon,$w,$d,$h,$m,$s)=_Delta_Split($delta);
4227
4228 # We need to make sure that the signs of all parts of a delta are the
4229 # same. The easiest way to do this is to convert all of the large
4230 # components to the smallest ones, then convert the smaller components
4231 # back to the larger ones.
4232
4233 # Do the year/month part
4234
4235 $mon += $y*12; # convert y to m
4236 $sign1="+";
4237 if ($mon<0) {
4238 $mon *= -1;
4239 $sign1="-";
4240 }
4241
4242 $y = $mon/12; # convert m to y
4243 $mon -= $y*12;
4244
4245 $y=0 if ($y eq "-0"); # get around silly -0 problem
4246 $mon=0 if ($mon eq "-0");
4247
4248 # Do the wk/day/hour/min/sec part
4249
4250 {
4251 # Unfortunately, $s is overflowing for dates more than ~70 years
4252 # apart.
4253319.8ms6.61ms no integer;
# spent 13µs making 1 call to integer::unimport
4254
4255 if ($mode==3 || $mode==2) {
4256 $s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
4257 } else {
4258 $s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
4259 }
4260 $sign2="+";
4261 if ($s<0) {
4262 $s*=-1;
4263 $sign2="-";
4264 }
4265
4266 $m = int($s/60); # convert s to m
4267 $s -= $m*60;
4268 $d = int($m/$len); # convert m to d
4269 $m -= $d*$len;
4270
4271 # The rest should be fine.
4272 }
4273 $h = $m/60; # convert m to h
4274 $m -= $h*60;
4275 if ($mode == 3 || $mode == 2) {
4276 $w = $w*1; # get around +0 problem
4277 } else {
4278 $w = $d/7; # convert d to w
4279 $d -= $w*7;
4280 }
4281
4282 $w=0 if ($w eq "-0"); # get around silly -0 problem
4283 $d=0 if ($d eq "-0");
4284 $h=0 if ($h eq "-0");
4285 $m=0 if ($m eq "-0");
4286 $s=0 if ($s eq "-0");
4287
4288 # Only include two signs if necessary
4289 $sign1=$sign2 if ($y==0 and $mon==0);
4290 $sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0);
4291 $sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"});
4292
4293 if ($Cnf{"DeltaSigns"}) {
4294 return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s";
4295 } else {
4296 return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s";
4297 }
4298}
4299
4300# This checks a delta to make sure it is valid. If it is, it splits
4301# it and returns the elements with a sign on each. The 2nd argument
4302# specifies the default sign. Blank elements are set to 0. If the
4303# third element is non-nil, exactly 7 elements must be included.
4304sub _Delta_Split {
4305 print "DEBUG: _Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
4306 my($delta,$sign,$exact)=@_;
4307 my(@delta)=split(/:/,$delta);
4308 return () if ($exact and $#delta != 6);
4309 my($i)=();
4310 $sign="+" if (! defined $sign);
4311 for ($i=0; $i<=$#delta; $i++) {
4312 $delta[$i]="0" if (! $delta[$i]);
4313 return () if ($delta[$i] !~ /^[+-]?\d+$/);
4314 $sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign);
4315 $delta[$i] = $sign.$delta[$i];
4316 }
4317 @delta;
4318}
4319
4320# Reads up to 3 arguments. $h may contain the time in any international
4321# format. Any empty elements are set to 0.
4322sub _Date_ParseTime {
4323 print "DEBUG: _Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
4324 my($h,$m,$s)=@_;
4325 my($t)=_CheckTime("one");
4326
4327 if (defined $h and $h =~ /$t/) {
4328 $h=$1;
4329 $m=$2;
4330 $s=$3 if (defined $3);
4331 }
4332 $h="00" if (! defined $h);
4333 $m="00" if (! defined $m);
4334 $s="00" if (! defined $s);
4335
4336 ($h,$m,$s);
4337}
4338
4339# Forms a date with the 6 elements passed in (all of which must be defined).
4340# No check as to validity is made.
4341sub _Date_Join {
4342 print "DEBUG: _Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
4343 foreach (0 .. $#_) {
4344 croak "undefined arg $_ to _Date_Join()" if not defined $_[$_];
4345 }
4346 my($y,$m,$d,$h,$mn,$s)=@_;
4347 my($ym,$md,$dh,$hmn,$mns)=();
4348
4349 if ($Cnf{"Internal"} == 0) {
4350 $ym=$md=$dh="";
4351 $hmn=$mns=":";
4352
4353 } elsif ($Cnf{"Internal"} == 1) {
4354 $ym=$md=$dh=$hmn=$mns="";
4355
4356 } elsif ($Cnf{"Internal"} == 2) {
4357 $ym=$md="-";
4358 $dh=" ";
4359 $hmn=$mns=":";
4360
4361 } else {
4362 confess "ERROR: Invalid internal format in _Date_Join.\n";
4363 }
4364 $m="0$m" if (length($m)==1);
4365 $d="0$d" if (length($d)==1);
4366 $h="0$h" if (length($h)==1);
4367 $mn="0$mn" if (length($mn)==1);
4368 $s="0$s" if (length($s)==1);
4369 "$y$ym$m$md$d$dh$h$hmn$mn$mns$s";
4370}
4371
4372# This checks a time. If it is valid, it splits it and returns 3 elements.
4373# If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is
4374# returned.
4375sub _CheckTime {
4376 print "DEBUG: _CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
4377 my($time)=@_;
4378 my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
4379 my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
4380 my($m)='[0-5][0-9]';
4381 my($s)=$m;
4382 my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)";
4383 my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)";
4384 my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"};
4385 my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4386 if ($time eq "one") {
4387 return $t;
4388 } elsif ($time eq "two") {
4389 $t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4390 return $t;
4391 }
4392
4393 if ($time =~ /$t/i) {
4394 ($h,$m,$s)=($1,$2,$3);
4395 $h="0$h" if (length($h)<2);
4396 $m="0$m" if (length($m)<2);
4397 $s="00" if (! defined $s);
4398 return ($h,$m,$s);
4399 } else {
4400 return ();
4401 }
4402}
4403
4404# This checks a recurrence. If it is valid, it splits it and returns the
4405# elements. Otherwise, it returns an empty list.
4406# ($recur0,$recur1,$flags,$dateb,$date0,$date1)=_Recur_Split($recur);
4407sub _Recur_Split {
4408 print "DEBUG: _Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
4409 my($recur)=@_;
4410 my(@ret,@tmp);
4411
4412 my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
4413 my($F) = '(?:\*([^*]*))';
4414 my($DB,$D0,$D1);
4415 $DB=$D0=$D1=$F;
4416
4417 if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
4418 @ret=($1,$2,$3,$4,$5);
4419 @tmp=split(/\*/,shift(@ret));
4420 return () if ($#tmp>1);
4421 return (@tmp,"",@ret) if ($#tmp==0);
4422 return (@tmp,@ret);
4423 }
4424 return ();
4425}
4426
4427# This checks a date. If it is valid, it splits it and returns the elements.
4428#
4429# The optional second argument says 'I really expect this to be a
4430# valid Date::Manip object, please throw an exception if it is not'.
4431# Otherwise, if the date passed in is undef or '', a regular
4432# expression for the date is returned; if the string is nonempty but
4433# still not valid, () is returned.
4434#
4435sub _Date_Split {
4436 print "DEBUG: _Date_Split\n" if ($Curr{"Debug"} =~ /trace/);
4437 my($date, $definitely_valid)=@_;
4438 $definitely_valid = 0 if not defined $definitely_valid;
4439 my($ym,$md,$dh,$hmn,$mns)=();
4440 my($y)='(\d{4})';
4441 my($m)='(0[1-9]|1[0-2])';
4442 my($d)='(0[1-9]|[1-2][0-9]|3[0-1])';
4443 my($h)='([0-1][0-9]|2[0-3])';
4444 my($mn)='([0-5][0-9])';
4445 my($s)=$mn;
4446
4447 if ($Cnf{"Internal"} == 0) {
4448 $ym=$md=$dh="";
4449 $hmn=$mns=":";
4450
4451 } elsif ($Cnf{"Internal"} == 1) {
4452 $ym=$md=$dh=$hmn=$mns="";
4453
4454 } elsif ($Cnf{"Internal"} == 2) {
4455 $ym=$md="-";
4456 $dh=" ";
4457 $hmn=$mns=":";
4458
4459 } else {
4460 confess "ERROR: Invalid internal format in _Date_Split.\n";
4461 }
4462
4463 my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$";
4464
4465 if (not defined $date or $date eq '') {
4466 if ($definitely_valid) {
4467 die "bad date '$date'";
4468 } else {
4469 return $t;
4470 }
4471 }
4472
4473 if ($date =~ /$t/) {
4474 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
4475 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4476 $d_in_m[2]=29 if (Date_LeapYear($y));
4477 if ($d>$d_in_m[$m]) {
4478 my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
4479 if ($definitely_valid) {
4480 die $msg;
4481 }
4482 else {
4483 warn $msg;
4484 return ();
4485 }
4486 }
4487 return ($y,$m,$d,$h,$mn,$s);
4488 }
4489
4490 if ($definitely_valid) {
4491 die "invalid date $date: doesn't match regexp $t";
4492 }
4493 return ();
4494}
4495
4496# This returns the date easter occurs on for a given year as ($month,$day).
4497# This is from the Calendar FAQ.
4498sub _Date_Easter {
4499 my($y)=@_;
4500 $y=_Date_FixYear($y) if (length($y)==2);
4501
4502 my($c) = $y/100;
4503 my($g) = $y % 19;
4504 my($k) = ($c-17)/25;
4505 my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30;
4506 $i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11));
4507 my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7;
4508 my($l) = $i-$j;
4509 my($m) = 3 + ($l+40)/44;
4510 my($d) = $l + 28 - 31*($m/4);
4511 return ($m,$d);
4512}
4513
4514# This takes a list of years, months, WeekOfMonth's, and DayOfWeek's, and
4515# returns a list of dates. Optionally, a list of dates can be passed in as
4516# the 1st argument (with the 2nd argument the null list) and the year/month
4517# of these will be used.
4518sub _Date_Recur_WoM {
4519 my($y,$m,$w,$d)=@_;
4520 my(@y)=@$y;
4521 my(@m)=@$m;
4522 my(@w)=@$w;
4523 my(@d)=@$d;
4524 my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
4525
4526 if (@m) {
4527 foreach $m (@m) {
4528 return () if (! _IsInt($m,1,12));
4529 }
4530
4531 @tmp=@tmp2=();
4532 foreach $y (@y) {
4533 foreach $m (@m) {
4534 push(@tmp,$y);
4535 push(@tmp2,$m);
4536 }
4537 }
4538
4539 @y=@tmp;
4540 @m=@tmp2;
4541
4542 } else {
4543 foreach $d0 (@y) {
4544 @tmp=_Date_Split($d0);
4545 return () if (! @tmp);
4546 push(@tmp2,$tmp[0]);
4547 push(@m,$tmp[1]);
4548 }
4549 @y=@tmp2;
4550 }
4551
4552 return () if (! @w);
4553 foreach $w (@w) {
4554 return () if ($w==0 || ! _IsInt($w,-5,5));
4555 }
4556
4557 if (@d) {
4558 foreach $d (@d) {
4559 return () if ($d==0 || ! _IsInt($d,-7,7));
4560 $d += 8 if ($d < 0);
4561 }
4562 }
4563
4564 @date=();
4565 foreach $y (@y) {
4566 $m=shift(@m);
4567
4568 # Find 1st day of this month and next month
4569 $date0=_Date_Join($y,$m,1,0,0,0);
4570 $date1=_DateCalc_DateDelta($date0,"+0:1:0:0:0:0:0");
4571
4572 foreach $d (@d) {
4573 # Find 1st occurence of DOW (in both months)
4574 $d0=Date_GetNext($date0,$d,1);
4575 $d1=Date_GetNext($date1,$d,1);
4576
4577 @tmp=();
4578 while (Date_Cmp($d0,$d1)<0) {
4579 push(@tmp,$d0);
4580 $d0=_DateCalc_DateDelta($d0,"+0:0:1:0:0:0:0");
4581 }
4582
4583 @tmp2=();
4584 foreach $w (@w) {
4585 if ($w>0) {
4586 next if ($w > $#tmp+1);
4587 push(@tmp2,$tmp[$w-1]);
4588 } else {
4589 next if (-$w > $#tmp+1);
4590 push(@tmp2,$tmp[$#tmp+1+$w]);
4591 }
4592 }
4593 @tmp2=sort { Date_Cmp($a,$b) } @tmp2;
4594 push(@date,@tmp2);
4595 }
4596 }
4597
4598 @date;
4599}
4600
4601# This returns a sorted list of dates formed by adding/subtracting
4602# $delta to $dateb in the range $date0<=$d<$dateb. The first date in
4603# the list is actually the first date<$date0 and the last date in the
4604# list is the first date>=$date1 (because sometimes the set part will
4605# move the date back into the range).
4606sub _Date_Recur {
4607 my($date0,$date1,$dateb,$delta)=@_;
4608 my(@ret,$d)=();
4609
4610 while (Date_Cmp($dateb,$date0)<0) {
4611 $dateb=_DateCalc_DateDelta($dateb,$delta);
4612 }
4613 while (Date_Cmp($dateb,$date1)>=0) {
4614 $dateb=_DateCalc_DateDelta($dateb,"-$delta");
4615 }
4616
4617 # Add the dates $date0..$dateb
4618 $d=$dateb;
4619 while (Date_Cmp($d,$date0)>=0) {
4620 unshift(@ret,$d);
4621 $d=_DateCalc_DateDelta($d,"-$delta");
4622 }
4623 # Add the first date earler than the range
4624 unshift(@ret,$d);
4625
4626 # Add the dates $dateb..$date1
4627 $d=_DateCalc_DateDelta($dateb,$delta);
4628 while (Date_Cmp($d,$date1)<0) {
4629 push(@ret,$d);
4630 $d=_DateCalc_DateDelta($d,$delta);
4631 }
4632 # Add the first date later than the range
4633 push(@ret,$d);
4634
4635 @ret;
4636}
4637
4638# This sets the values in each date of a recurrence.
4639#
4640# $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1",
4641# they are not set (and none of the larger elements are set).
4642sub _Date_RecurSetTime {
4643 my($date0,$date1,$dates,$h,$m,$s)=@_;
4644 my(@dates)=@$dates;
4645 my(@h,@m,@s,$date,@tmp)=();
4646
4647 $m="-1" if ($s eq "-1");
4648 $h="-1" if ($m eq "-1");
4649
4650 if ($h ne "-1") {
4651 @h=_ReturnList($h);
4652 return () if ! (@h);
4653 @h=sort { $a<=>$b } (@h);
4654
4655 @tmp=();
4656 foreach $date (@dates) {
4657 foreach $h (@h) {
4658 push(@tmp,Date_SetDateField($date,"h",$h,1));
4659 }
4660 }
4661 @dates=@tmp;
4662 }
4663
4664 if ($m ne "-1") {
4665 @m=_ReturnList($m);
4666 return () if ! (@m);
4667 @m=sort { $a<=>$b } (@m);
4668
4669 @tmp=();
4670 foreach $date (@dates) {
4671 foreach $m (@m) {
4672 push(@tmp,Date_SetDateField($date,"mn",$m,1));
4673 }
4674 }
4675 @dates=@tmp;
4676 }
4677
4678 if ($s ne "-1") {
4679 @s=_ReturnList($s);
4680 return () if ! (@s);
4681 @s=sort { $a<=>$b } (@s);
4682
4683 @tmp=();
4684 foreach $date (@dates) {
4685 foreach $s (@s) {
4686 push(@tmp,Date_SetDateField($date,"s",$s,1));
4687 }
4688 }
4689 @dates=@tmp;
4690 }
4691
4692 @tmp=();
4693 foreach $date (@dates) {
4694 push(@tmp,$date) if (Date_Cmp($date,$date0)>=0 &&
4695 Date_Cmp($date,$date1)<0 &&
4696 _Date_Split($date));
4697 }
4698
4699 @tmp;
4700}
4701
4702sub _DateCalc_DateDate {
4703 print "DEBUG: _DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
4704 my($D1,$D2,$mode)=@_;
4705 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4706 $mode=0 if (! defined $mode);
4707
4708 # Exact mode
4709 if ($mode==0) {
4710 my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($D1, 1);
4711 my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($D2, 1);
4712 my($i,@delta,$d,$delta,$y)=();
4713
4714 # form the delta for hour/min/sec
4715 $delta[4]=$h2-$h1;
4716 $delta[5]=$mn2-$mn1;
4717 $delta[6]=$s2-$s1;
4718
4719 # form the delta for yr/mon/day
4720 $delta[0]=$delta[1]=0;
4721 $d=0;
4722 if ($y2>$y1) {
4723 $d=Date_DaysInYear($y1) - Date_DayOfYear($m1,$d1,$y1);
4724 $d+=Date_DayOfYear($m2,$d2,$y2);
4725 for ($y=$y1+1; $y<$y2; $y++) {
4726 $d+= Date_DaysInYear($y);
4727 }
4728 } elsif ($y2<$y1) {
4729 $d=Date_DaysInYear($y2) - Date_DayOfYear($m2,$d2,$y2);
4730 $d+=Date_DayOfYear($m1,$d1,$y1);
4731 for ($y=$y2+1; $y<$y1; $y++) {
4732 $d+= Date_DaysInYear($y);
4733 }
4734 $d *= -1;
4735 } else {
4736 $d=Date_DayOfYear($m2,$d2,$y2) - Date_DayOfYear($m1,$d1,$y1);
4737 }
4738 $delta[2]=0;
4739 $delta[3]=$d;
4740
4741 for ($i=0; $i<7; $i++) {
4742 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4743 }
4744
4745 $delta=join(":",@delta);
4746 $delta=_Delta_Normalize($delta,0);
4747 return $delta;
4748 }
4749
4750 my($date1,$date2)=($D1,$D2);
4751 my($tmp,$sign,$err,@tmp)=();
4752
4753 # make sure both are work days
4754 if ($mode==2 || $mode==3) {
4755 $date1=Date_NextWorkDay($date1,0,1);
4756 $date2=Date_NextWorkDay($date2,0,1);
4757 }
4758
4759 # make sure date1 comes before date2
4760 if (Date_Cmp($date1,$date2)>0) {
4761 $sign="-";
4762 $tmp=$date1;
4763 $date1=$date2;
4764 $date2=$tmp;
4765 } else {
4766 $sign="+";
4767 }
4768 if (Date_Cmp($date1,$date2)==0) {
4769 return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
4770 return "+0:0:0:0:0:0:0";
4771 }
4772
4773 my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($date1, 1);
4774 my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($date2, 1);
4775 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0);
4776
4777 if ($mode != 3) {
4778
4779 # Do years
4780 $dy=$y2-$y1;
4781 $dm=0;
4782 if ($dy>0) {
4783 $tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0);
4784 if (Date_Cmp($tmp,$date2)>0) {
4785 $dy--;
4786 $tmp=$date1;
4787 $tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0)
4788 if ($dy>0);
4789 $dm=12;
4790 }
4791 $date1=$tmp;
4792 }
4793
4794 # Do months
4795 $dm+=$m2-$m1;
4796 if ($dm>0) {
4797 $tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0);
4798 if (Date_Cmp($tmp,$date2)>0) {
4799 $dm--;
4800 $tmp=$date1;
4801 $tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0)
4802 if ($dm>0);
4803 }
4804 $date1=$tmp;
4805 }
4806
4807 # At this point, check to see that we're on a business day again so that
4808 # Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month
4809 if ($mode==2) {
4810 if (! Date_IsWorkDay($date1,0)) {
4811 $date1=Date_NextWorkDay($date1,0,1);
4812 }
4813 }
4814 }
4815
4816 # Do days
4817 if ($mode==2 || $mode==3) {
4818 $dd=0;
4819 while (1) {
4820 $tmp=Date_NextWorkDay($date1,1,1);
4821 if (Date_Cmp($tmp,$date2)<=0) {
4822 $dd++;
4823 $date1=$tmp;
4824 } else {
4825 last;
4826 }
4827 }
4828
4829 } else {
4830 ($y1,$m1,$d1)=( _Date_Split($date1, 1) )[0..2];
4831 $dd=0;
4832 # If we're jumping across months, set $d1 to the first of the next month
4833 # (or possibly the 0th of next month which is equivalent to the last day
4834 # of this month)
4835 if ($m1!=$m2) {
4836 $d_in_m[2]=29 if (Date_LeapYear($y1));
4837 $dd=$d_in_m[$m1]-$d1+1;
4838 $d1=1;
4839 $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4840 if (Date_Cmp($tmp,$date2)>0) {
4841 $dd--;
4842 $d1--;
4843 $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4844 }
4845 $date1=$tmp;
4846 }
4847
4848 $ddd=0;
4849 if ($d1<$d2) {
4850 $ddd=$d2-$d1;
4851 $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4852 if (Date_Cmp($tmp,$date2)>0) {
4853 $ddd--;
4854 $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4855 }
4856 $date1=$tmp;
4857 }
4858 $dd+=$ddd;
4859 }
4860
4861 # in business mode, make sure h1 comes before h2 (if not find delta between
4862 # now and end of day and move to start of next business day)
4863 $d1=( _Date_Split($date1, 1) )[2];
4864 $dh=$dmn=$ds=0;
4865 if ($mode==2 || $mode==3 and $d1 != $d2) {
4866 $tmp=Date_SetTime($date1,$Cnf{"WorkDayEnd"});
4867 $tmp=_DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0")
4868 if ($Cnf{"WorkDay24Hr"});
4869 $tmp=_DateCalc_DateDate($date1,$tmp,0);
4870 ($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=_Delta_Split($tmp);
4871 $date1=Date_NextWorkDay($date1,1,0);
4872 $date1=Date_SetTime($date1,$Cnf{"WorkDayBeg"});
4873 $d1=( _Date_Split($date1, 1) )[2];
4874 confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2);
4875 }
4876
4877 # Hours, minutes, seconds
4878 $tmp=_DateCalc_DateDate($date1,$date2,0);
4879 @tmp=_Delta_Split($tmp);
4880 $dh += $tmp[4];
4881 $dmn += $tmp[5];
4882 $ds += $tmp[6];
4883
4884 $tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds";
4885 _Delta_Normalize($tmp,$mode);
4886}
4887
4888sub _DateCalc_DeltaDelta {
4889 print "DEBUG: _DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/);
4890 my($D1,$D2,$mode)=@_;
4891 my(@delta1,@delta2,$i,$delta,@delta)=();
4892 $mode=0 if (! defined $mode);
4893
4894 @delta1=_Delta_Split($D1);
4895 @delta2=_Delta_Split($D2);
4896 for ($i=0; $i<7; $i++) {
4897 $delta[$i]=$delta1[$i]+$delta2[$i];
4898 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4899 }
4900
4901 $delta=join(":",@delta);
4902 $delta=_Delta_Normalize($delta,$mode);
4903 return $delta;
4904}
4905
4906sub _DateCalc_DateDelta {
4907 print "DEBUG: _DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
4908 my($D1,$D2,$errref,$mode)=@_;
4909 my($date)=();
4910 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4911 my($h1,$m1,$h2,$m2,$len,$hh,$mm)=();
4912 $mode=0 if (! defined $mode);
4913
4914 if ($mode==2 || $mode==3) {
4915 $h1=$Curr{"WDBh"};
4916 $m1=$Curr{"WDBm"};
4917 $h2=$Curr{"WDEh"};
4918 $m2=$Curr{"WDEm"};
4919 $hh=$h2-$h1;
4920 $mm=$m2-$m1;
4921 if ($mm<0) {
4922 $hh--;
4923 $mm+=60;
4924 }
4925 }
4926
4927 # Date, delta
4928 my($y,$m,$d,$h,$mn,$s)=_Date_Split($D1, 1);
4929 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=_Delta_Split($D2);
4930
4931 # do the month/year part
4932 $y+=$dy;
4933 while (length($y)<4) {
4934 $y = "0$y";
4935 }
4936 _ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11
4937 $d_in_m[2]=29 if (Date_LeapYear($y));
4938
4939 # if we have gone past the last day of a month, move the date back to
4940 # the last day of the month
4941 if ($d>$d_in_m[$m]) {
4942 $d=$d_in_m[$m];
4943 }
4944
4945 # do the week part
4946 if ($mode==0 || $mode==1) {
4947 $dd += $dw*7;
4948 } else {
4949 $date=_DateCalc_DateDelta(_Date_Join($y,$m,$d,$h,$mn,$s),
4950 "+0:0:$dw:0:0:0:0",0);
4951 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
4952 }
4953
4954 # in business mode, set the day to a work day at this point so the h/mn/s
4955 # stuff will work out
4956 if ($mode==2 || $mode==3) {
4957 $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
4958 $date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),0,1);
4959 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
4960 }
4961
4962 # seconds, minutes, hours
4963 _ModuloAddition(60,$ds,\$s,\$mn);
4964 if ($mode==2 || $mode==3) {
4965 while (1) {
4966 _ModuloAddition(60,$dmn,\$mn,\$h);
4967 $h+= $dh;
4968
4969 if ($h>$h2 or $h==$h2 && $mn>$m2) {
4970 $dh=$h-$h2;
4971 $dmn=$mn-$m2;
4972 $h=$h1;
4973 $mn=$m1;
4974 $dd++;
4975
4976 } elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
4977 $dh=$h-$h1;
4978 $dmn=$m1-$mn;
4979 $h=$h2;
4980 $mn=$m2;
4981 $dd--;
4982
4983 } elsif ($h==$h2 && $mn==$m2) {
4984 $dd++;
4985 $dh=-$hh;
4986 $dmn=-$mm;
4987
4988 } else {
4989 last;
4990 }
4991 }
4992
4993 } else {
4994 _ModuloAddition(60,$dmn,\$mn,\$h);
4995 _ModuloAddition(24,$dh,\$h,\$d);
4996 }
4997
4998 # If we have just gone past the last day of the month, we need to make
4999 # up for this:
5000 if ($d>$d_in_m[$m]) {
5001 $dd+= $d-$d_in_m[$m];
5002 $d=$d_in_m[$m];
5003 }
5004
5005 # days
5006 if ($mode==2 || $mode==3) {
5007 if ($dd>=0) {
5008 $date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),$dd,1);
5009 } else {
5010 $date=Date_PrevWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1);
5011 }
5012 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
5013
5014 } else {
5015 $d_in_m[2]=29 if (Date_LeapYear($y));
5016 $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
5017 $d += $dd;
5018 while ($d<1) {
5019 $m--;
5020 if ($m==0) {
5021 $m=12;
5022 $y--;
5023 if (Date_LeapYear($y)) {
5024 $d_in_m[2]=29;
5025 } else {
5026 $d_in_m[2]=28;
5027 }
5028 }
5029 $d += $d_in_m[$m];
5030 }
5031 while ($d>$d_in_m[$m]) {
5032 $d -= $d_in_m[$m];
5033 $m++;
5034 if ($m==13) {
5035 $m=1;
5036 $y++;
5037 if (Date_LeapYear($y)) {
5038 $d_in_m[2]=29;
5039 } else {
5040 $d_in_m[2]=28;
5041 }
5042 }
5043 }
5044 }
5045
5046 if ($y<0 or $y>9999) {
5047 $$errref=3;
5048 return;
5049 }
5050 _Date_Join($y,$m,$d,$h,$mn,$s);
5051}
5052
5053sub _Date_UpdateHolidays {
5054 print "DEBUG: _Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
5055 my($year)=@_;
5056 $Holiday{"year"}=$year;
5057 $Holiday{"dates"}{$year}={};
5058
5059 my($date,$delta,$err)=();
5060 my($key,@tmp,$tmp);
5061
5062 foreach $key (keys %{ $Holiday{"desc"} }) {
5063 @tmp=_Recur_Split($key);
5064 if (@tmp) {
5065 $tmp=ParseDateString("${year}010100:00:00");
5066 ($date)=ParseRecur($key,$tmp,$tmp,($year+1)."-01-01");
5067 next if (! $date);
5068
5069 } elsif ($key =~ /^(.*)([+-].*)$/) {
5070 # Date +/- Delta
5071 ($date,$delta)=($1,$2);
5072 $tmp=ParseDateString("$date $year");
5073 if ($tmp) {
5074 $date=$tmp;
5075 } else {
5076 $date=ParseDateString($date);
5077 next if ($date !~ /^$year/);
5078 }
5079 $date=DateCalc($date,$delta,\$err,0);
5080
5081 } else {
5082 # Date
5083 $date=$key;
5084 $tmp=ParseDateString("$date $year");
5085 if ($tmp) {
5086 $date=$tmp;
5087 } else {
5088 $date=ParseDateString($date);
5089 next if ($date !~ /^$year/);
5090 }
5091 }
5092 $Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key};
5093 }
5094}
5095
5096# This sets a Date::Manip config variable.
5097sub _Date_SetConfigVariable {
5098 print "DEBUG: _Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/);
5099 my($var,$val)=@_;
5100
5101 # These are most appropriate for command line options instead of in files.
5102 $Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i);
5103 $Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i);
5104 $Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i);
5105 EraseHolidays(), return if ($var =~ /^EraseHolidays$/i);
5106 $Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i);
5107 $Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i);
5108
5109 $Curr{"InitLang"}=1,
5110 $Cnf{"Language"}=$val, return if ($var =~ /^Language$/i);
5111 $Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i);
5112 $Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i);
5113 $Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i);
5114 $Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i);
5115 $Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i);
5116 $Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i);
5117 $Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i);
5118 $Cnf{"WorkDayBeg"}=$val,
5119 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
5120 $Cnf{"WorkDayEnd"}=$val,
5121 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i);
5122 $Cnf{"WorkDay24Hr"}=$val,
5123 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i);
5124 $Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i);
5125 $Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i);
5126 $Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i);
5127 $Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i);
5128 $Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i);
5129 $Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i);
5130 $Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i);
5131 $Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i);
5132 $Cnf{"TodayIsMidnight"}=$val, return if ($var =~ /^TodayIsMidnight$/i);
5133
5134 confess "ERROR: Unknown configuration variable $var in Date::Manip.\n";
5135}
5136
5137sub EraseHolidays {
5138 print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
5139
5140 $Cnf{"EraseHolidays"}=0;
5141 delete $Holiday{"list"};
5142 $Holiday{"list"}={};
5143 delete $Holiday{"desc"};
5144 $Holiday{"desc"}={};
5145 $Holiday{"dates"}={};
5146}
5147
5148# This returns a pointer to a list of times and events in the format
5149# [ date [ events ], date, [ events ], ... ]
5150# where each list of events are events that are in effect at the date
5151# immediately preceding the list.
5152#
5153# This takes either one date or two dates as arguments.
5154sub _Events_Calc {
5155 print "DEBUG: _Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
5156
5157 my($date0,$date1)=@_;
5158
5159 my($tmp);
5160 $date0=ParseDateString($date0);
5161 return undef if (! $date0);
5162 if ($date1) {
5163 $date1=ParseDateString($date1);
5164 if (Date_Cmp($date0,$date1)>0) {
5165 $tmp=$date1;
5166 $date1=$date0;
5167 $date0=$tmp;
5168 }
5169 } else {
5170 $date1=_DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1");
5171 }
5172
5173 #
5174 # [ d0,d1,del,name ] => [ d0, d1+del )
5175 # [ d0,0,del,name ] => [ d0, d0+del )
5176 #
5177 my(%ret,$d0,$d1,$del,$name,$c0,$c1);
5178 my(@tmp)=@{ $Events{"dates"} };
5179 DATE: while (@tmp) {
5180 ($d0,$d1,$del,$name)=splice(@tmp,0,4);
5181 $d0=ParseDateString($d0);
5182 $d1=ParseDateString($d1) if ($d1);
5183 $del=ParseDateDelta($del) if ($del);
5184 if ($d1) {
5185 if ($del) {
5186 $d1=_DateCalc_DateDelta($d1,$del);
5187 }
5188 } else {
5189 $d1=_DateCalc_DateDelta($d0,$del);
5190 }
5191 if (Date_Cmp($d0,$d1)>0) {
5192 $tmp=$d1;
5193 $d1=$d0;
5194 $d0=$tmp;
5195 }
5196 # [ date0,date1 )
5197 # [ d0,d1 ) OR [ d0,d1 )
5198 next DATE if (Date_Cmp($d1,$date0)<=0 ||
5199 Date_Cmp($d0,$date1)>=0);
5200 # [ date0,date1 )
5201 # [ d0,d1 )
5202 # [ d0, d1 )
5203 if (Date_Cmp($d0,$date0)<=0) {
5204 push @{ $ret{$date0} },$name;
5205 push @{ $ret{$d1} },"!$name" if (Date_Cmp($d1,$date1)<0);
5206 next DATE;
5207 }
5208 # [ date0,date1 )
5209 # [ d0,d1 )
5210 if (Date_Cmp($d1,$date1)>=0) {
5211 push @{ $ret{$d0} },$name;
5212 next DATE;
5213 }
5214 # [ date0,date1 )
5215 # [ d0,d1 )
5216 push @{ $ret{$d0} },$name;
5217 push @{ $ret{$d1} },"!$name";
5218 }
5219
5220 #
5221 # [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
5222 #
5223 my($rec,$del0,$del1,@d);
5224 @tmp=@{ $Events{"recur"} };
5225 RECUR: while (@tmp) {
5226 ($rec,$del0,$del1,$name)=splice(@tmp,0,4);
5227 @d=();
5228
5229 }
5230
5231 # Sort them AND take into account the "!$name" entries.
5232 my(%tmp,$date,@tmp2,@ret);
5233 @d=sort { Date_Cmp($a,$b) } keys %ret;
5234 foreach $date (@d) {
5235 @tmp=@{ $ret{$date} };
5236 @tmp2=();
5237 foreach $tmp (@tmp) {
5238 push(@tmp2,$tmp), next if ($tmp =~ /^!/);
5239 $tmp{$tmp}=1;
5240 }
5241 foreach $tmp (@tmp2) {
5242 $tmp =~ s/^!//;
5243 delete $tmp{$tmp};
5244 }
5245 push(@ret,$date,[ keys %tmp ]);
5246 }
5247
5248 %tmp = @ret;
5249 @ret = ();
5250 foreach my $d (sort { Date_Cmp($a,$b) } keys %tmp) {
5251 my $e = $tmp{$d};
5252 push @ret,($d,[ sort @$e ]);
5253 }
5254 return \@ret;
5255}
5256
5257# This parses the raw events list
5258sub _Events_ParseRaw {
5259 print "DEBUG: _Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
5260
5261 # Only need to be parsed once
5262 my($force)=@_;
5263 $Events{"parsed"}=0 if ($force);
5264 return if ($Events{"parsed"});
5265 $Events{"parsed"}=1;
5266
5267 my(@events)=@{ $Events{"raw"} };
5268 my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
5269 $recur);
5270 EVENT: while (@events) {
5271 ($event,$name)=splice(@events,0,2);
5272 @event=split(/\s*;\s*/,$event);
5273
5274 if ($#event == 0) {
5275
5276 if ($date0=ParseDateString($event[0])) {
5277 #
5278 # date = event
5279 #
5280 $tmp=ParseDateString("$event[0] 00:00:00");
5281 if ($tmp && $tmp eq $date0) {
5282 $delta="+0:0:0:1:0:0:0";
5283 } else {
5284 $delta="+0:0:0:0:1:0:0";
5285 }
5286 push @{ $Events{"dates"} },($date0,0,$delta,$name);
5287
5288 } elsif ($recur=ParseRecur($event[0])) {
5289 #
5290 # recur = event
5291 #
5292 ($recur0,$recur1)=_Recur_Split($recur);
5293 if ($recur0) {
5294 if ($recur1) {
5295 $r="$recur0:$recur1";
5296 } else {
5297 $r=$recur0;
5298 }
5299 } else {
5300 $r=$recur1;
5301 }
5302 (@recur)=split(/:/,$r);
5303 if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
5304 $delta="+0:0:0:1:0:0:0";
5305 } else {
5306 $delta="+0:0:0:0:1:0:0";
5307 }
5308 push @{ $Events{"recur"} },($recur,0,$delta,$name);
5309
5310 } else {
5311 # ??? = event
5312 warn "WARNING: illegal event ignored [ @event ]\n";
5313 next EVENT;
5314 }
5315
5316 } elsif ($#event == 1) {
5317
5318 if ($date0=ParseDateString($event[0])) {
5319
5320 if ($date1=ParseDateString($event[1])) {
5321 #
5322 # date ; date = event
5323 #
5324 $tmp=ParseDateString("$event[1] 00:00:00");
5325 if ($tmp && $tmp eq $date1) {
5326 $date1=_DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0");
5327 }
5328 push @{ $Events{"dates"} },($date0,$date1,0,$name);
5329
5330 } elsif ($delta=ParseDateDelta($event[1])) {
5331 #
5332 # date ; delta = event
5333 #
5334 push @{ $Events{"dates"} },($date0,0,$delta,$name);
5335
5336 } else {
5337 # date ; ??? = event
5338 warn "WARNING: illegal event ignored [ @event ]\n";
5339 next EVENT;
5340 }
5341
5342 } elsif ($recur=ParseRecur($event[0])) {
5343
5344 if ($delta=ParseDateDelta($event[1])) {
5345 #
5346 # recur ; delta = event
5347 #
5348 push @{ $Events{"recur"} },($recur,0,$delta,$name);
5349
5350 } else {
5351 # recur ; ??? = event
5352 warn "WARNING: illegal event ignored [ @event ]\n";
5353 next EVENT;
5354 }
5355
5356 } else {
5357 # ??? ; ??? = event
5358 warn "WARNING: illegal event ignored [ @event ]\n";
5359 next EVENT;
5360 }
5361
5362 } else {
5363 # date ; delta0 ; delta1 = event
5364 # recur ; delta0 ; delta1 = event
5365 # ??? ; ??? ; ??? ... = event
5366 warn "WARNING: illegal event ignored [ @event ]\n";
5367 next EVENT;
5368 }
5369 }
5370}
5371
5372# This reads an init file.
5373sub _Date_InitFile {
5374 print "DEBUG: _Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
5375 my($file)=@_;
5376 my($in)=new IO::File;
5377 local($_)=();
5378 my($section)="vars";
5379 my($var,$val,$recur,$name)=();
5380
5381 $in->open($file) || return;
5382 while(defined ($_=<$in>)) {
5383 chomp;
5384 s/^\s+//;
5385 s/\s+$//;
5386 next if (! $_ or /^\#/);
5387
5388 if (/^\*holiday/i) {
5389 $section="holiday";
5390 EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
5391 next;
5392 } elsif (/^\*events/i) {
5393 $section="events";
5394 next;
5395 }
5396
5397 if ($section =~ /var/i) {
5398 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5399 if (! /(.*\S)\s*=\s*(.*)$/);
5400 ($var,$val)=($1,$2);
5401 _Date_SetConfigVariable($var,$val);
5402
5403 } elsif ($section =~ /holiday/i) {
5404 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5405 if (! /(.*\S)\s*=\s*(.*)$/);
5406 ($recur,$name)=($1,$2);
5407 $name="" if (! defined $name);
5408 $Holiday{"desc"}{$recur}=$name;
5409
5410 } elsif ($section =~ /events/i) {
5411 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5412 if (! /(.*\S)\s*=\s*(.*)$/);
5413 ($val,$var)=($1,$2);
5414 push @{ $Events{"raw"} },($val,$var);
5415
5416 } else {
5417 # A section not currently used by Date::Manip (but may be
5418 # used by some extension to it).
5419 next;
5420 }
5421 }
5422 close($in);
5423}
5424
5425# $flag=_Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
5426# Returns 1 if any of the fields are bad. All fields are optional, and
5427# all possible checks are done on the data. If a field is not passed in,
5428# it is set to default values. If data is missing, appropriate defaults
5429# are supplied.
5430sub _Date_TimeCheck {
5431 print "DEBUG: _Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
5432 my($h,$mn,$s,$ampm)=@_;
5433 my($tmp1,$tmp2,$tmp3)=();
5434
5435 $$h="" if (! defined $$h);
5436 $$mn="" if (! defined $$mn);
5437 $$s="" if (! defined $$s);
5438 $$ampm="" if (! defined $$ampm);
5439 $$ampm=uc($$ampm) if ($$ampm);
5440
5441 # Check hour
5442 $tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
5443 $tmp2="";
5444 if ($$ampm =~ /^$tmp1$/i) {
5445 $tmp3=$Lang{$Cnf{"Language"}}{"AM"};
5446 $tmp2="AM" if ($$ampm =~ /^$tmp3$/i);
5447 $tmp3=$Lang{$Cnf{"Language"}}{"PM"};
5448 $tmp2="PM" if ($$ampm =~ /^$tmp3$/i);
5449 } elsif ($$ampm) {
5450 return 1;
5451 }
5452 if ($tmp2 eq "AM" || $tmp2 eq "PM") {
5453 $$h="0$$h" if (length($$h)==1);
5454 return 1 if ($$h<1 || $$h>12);
5455 $$h="00" if ($tmp2 eq "AM" and $$h==12);
5456 $$h += 12 if ($tmp2 eq "PM" and $$h!=12);
5457 } else {
5458 $$h="00" if ($$h eq "");
5459 $$h="0$$h" if (length($$h)==1);
5460 return 1 if (! _IsInt($$h,0,23));
5461 $tmp2="AM" if ($$h<12);
5462 $tmp2="PM" if ($$h>=12);
5463 }
5464 $$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
5465 $$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
5466
5467 # Check minutes
5468 $$mn="00" if ($$mn eq "");
5469 $$mn="0$$mn" if (length($$mn)==1);
5470 return 1 if (! _IsInt($$mn,0,59));
5471
5472 # Check seconds
5473 $$s="00" if ($$s eq "");
5474 $$s="0$$s" if (length($$s)==1);
5475 return 1 if (! _IsInt($$s,0,59));
5476
5477 return 0;
5478}
5479
5480# $flag=_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
5481# Returns 1 if any of the fields are bad. All fields are optional, and
5482# all possible checks are done on the data. If a field is not passed in,
5483# it is set to default values. If data is missing, appropriate defaults
5484# are supplied.
5485#
5486# If the flag UpdateHolidays is set, the year is set to
5487# CurrHolidayYear.
5488sub _Date_DateCheck {
5489 print "DEBUG: _Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/);
5490 my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_;
5491 my($tmp1,$tmp2,$tmp3)=();
5492
5493 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
5494 my($curr_y)=$Curr{"Y"};
5495 my($curr_m)=$Curr{"M"};
5496 my($curr_d)=$Curr{"D"};
5497 $$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d);
5498 $$y="" if (! defined $$y);
5499 $$m="" if (! defined $$m);
5500 $$d="" if (! defined $$d);
5501 $$wk="" if (! defined $$wk);
5502 $$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq "");
5503
5504 # Check year.
5505 $$y=$curr_y if ($$y eq "");
5506 $$y=_Date_FixYear($$y) if (length($$y)<4);
5507 return 1 if (! _IsInt($$y,0,9999));
5508 $d_in_m[2]=29 if (Date_LeapYear($$y));
5509
5510 # Check month
5511 $$m=$curr_m if ($$m eq "");
5512 $$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}
5513 if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)});
5514 $$m="0$$m" if (length($$m)==1);
5515 return 1 if (! _IsInt($$m,1,12));
5516
5517 # Check day
5518 $$d="01" if ($$d eq "");
5519 $$d="0$$d" if (length($$d)==1);
5520 return 1 if (! _IsInt($$d,1,$d_in_m[$$m]));
5521 if ($$wk) {
5522 $tmp1=Date_DayOfWeek($$m,$$d,$$y);
5523 $tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}
5524 if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)});
5525 return 1 if ($tmp1 != $tmp2);
5526 }
5527
5528 return _Date_TimeCheck($h,$mn,$s,$ampm);
5529}
5530
5531# Takes a year in 2 digit form and returns it in 4 digit form
5532sub _Date_FixYear {
5533 print "DEBUG: _Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
5534 my($y)=@_;
5535 my($curr_y)=$Curr{"Y"};
5536 $y=$curr_y if (! defined $y or ! $y);
5537 return $y if (length($y)==4);
5538 confess "ERROR: Invalid year ($y)\n" if (length($y)!=2);
5539 my($y1,$y2)=();
5540
5541 if (lc($Cnf{"YYtoYYYY"}) eq "c") {
5542 $y1=substr($y,0,2);
5543 $y="$y1$y";
5544
5545 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
5546 $y1=$1;
5547 $y="$y1$y";
5548
5549 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
5550 $y1="$1$2";
5551 $y ="$1$y";
5552 $y += 100 if ($y<$y1);
5553
5554 } else {
5555 $y1=$curr_y-$Cnf{"YYtoYYYY"};
5556 $y2=$y1+99;
5557 $y="19$y";
5558 while ($y<$y1) {
5559 $y+=100;
5560 }
5561 while ($y>$y2) {
5562 $y-=100;
5563 }
5564 }
5565 $y;
5566}
5567
5568# _Date_NthWeekOfYear($y,$n);
5569# Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
5570# year.
5571# _Date_NthWeekOfYear($y,$n,$dow,$flag);
5572# Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag
5573# is nil, the first DoW of the year may actually be in the previous
5574# year (since the 1st week may include days from the previous year).
5575# If flag is non-nil, the 1st DoW of the year refers to the 1st one
5576# actually in the year
5577sub _Date_NthWeekOfYear {
5578 print "DEBUG: _Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
5579 my($y,$n,$dow,$flag)=@_;
5580 my($m,$d,$err,$tmp,$date,%dow)=();
5581 $y=$Curr{"Y"} if (! defined $y or ! $y);
5582 $n=1 if (! defined $n or $n eq "");
5583 return () if ($n<0 || $n>53);
5584 if (defined $dow) {
5585 $dow=lc($dow);
5586 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
5587 $dow=$dow{$dow} if (exists $dow{$dow});
5588 return () if ($dow<1 || $dow>7);
5589 $flag="" if (! defined $flag);
5590 } else {
5591 $dow="";
5592 $flag="";
5593 }
5594
5595 $y=_Date_FixYear($y) if (length($y)<4);
5596 if ($Cnf{"Jan1Week1"}) {
5597 $date=_Date_Join($y,1,1,0,0,0);
5598 } else {
5599 $date=_Date_Join($y,1,4,0,0,0);
5600 }
5601 $date=Date_GetPrev($date,$Cnf{"FirstDay"},1);
5602 $date=Date_GetNext($date,$dow,1) if ($dow ne "");
5603
5604 if ($flag) {
5605 ($tmp)=_Date_Split($date, 1);
5606 $n++ if ($tmp != $y);
5607 }
5608
5609 if ($n>1) {
5610 $date=_DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0);
5611 } elsif ($n==0) {
5612 $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0);
5613 }
5614 ($y,$m,$d)=_Date_Split($date, 1);
5615 ($y,$m,$d);
5616}
5617
5618########################################################################
5619# LANGUAGE INITIALIZATION
5620########################################################################
5621
5622# 8-bit international characters can be gotten by "\xXX". I don't know
5623# how to get 16-bit characters. I've got to read up on perllocale.
5624sub _Char_8Bit {
5625 my($hash)=@_;
5626
5627 # grave `
5628 # A` 00c0 a` 00e0
5629 # E` 00c8 e` 00e8
5630 # I` 00cc i` 00ec
5631 # O` 00d2 o` 00f2
5632 # U` 00d9 u` 00f9
5633 # W` 1e80 w` 1e81
5634 # Y` 1ef2 y` 1ef3
5635
5636 $$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE
5637 $$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE
5638 $$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE
5639 $$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE
5640 $$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE
5641 $$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE
5642 $$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE
5643 $$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE
5644 $$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE
5645 $$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE
5646
5647 # acute '
5648 # A' 00c1 a' 00e1
5649 # C' 0106 c' 0107
5650 # E' 00c9 e' 00e9
5651 # I' 00cd i' 00ed
5652 # L' 0139 l' 013a
5653 # N' 0143 n' 0144
5654 # O' 00d3 o' 00f3
5655 # R' 0154 r' 0155
5656 # S' 015a s' 015b
5657 # U' 00da u' 00fa
5658 # W' 1e82 w' 1e83
5659 # Y' 00dd y' 00fd
5660 # Z' 0179 z' 017a
5661
5662 $$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE
5663 $$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE
5664 $$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE
5665 $$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE
5666 $$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE
5667 $$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE
5668 $$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE
5669 $$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE
5670 $$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE
5671 $$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE
5672 $$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE
5673 $$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE
5674
5675 # double acute " "
5676 # O" 0150 o" 0151
5677 # U" 0170 u" 0171
5678
5679 # circumflex ^
5680 # A^ 00c2 a^ 00e2
5681 # C^ 0108 c^ 0109
5682 # E^ 00ca e^ 00ea
5683 # G^ 011c g^ 011d
5684 # H^ 0124 h^ 0125
5685 # I^ 00ce i^ 00ee
5686 # J^ 0134 j^ 0135
5687 # O^ 00d4 o^ 00f4
5688 # S^ 015c s^ 015d
5689 # U^ 00db u^ 00fb
5690 # W^ 0174 w^ 0175
5691 # Y^ 0176 y^ 0177
5692
5693 $$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
5694 $$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
5695 $$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
5696 $$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
5697 $$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
5698 $$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX
5699 $$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX
5700 $$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX
5701 $$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX
5702 $$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX
5703
5704 # tilde ~
5705 # A~ 00c3 a~ 00e3
5706 # I~ 0128 i~ 0129
5707 # N~ 00d1 n~ 00f1
5708 # O~ 00d5 o~ 00f5
5709 # U~ 0168 u~ 0169
5710
5711 $$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE
5712 $$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE
5713 $$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE
5714 $$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE
5715 $$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE
5716 $$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE
5717
5718 # macron -
5719 # A- 0100 a- 0101
5720 # E- 0112 e- 0113
5721 # I- 012a i- 012b
5722 # O- 014c o- 014d
5723 # U- 016a u- 016b
5724
5725 # breve ( [half circle up]
5726 # A( 0102 a( 0103
5727 # G( 011e g( 011f
5728 # U( 016c u( 016d
5729
5730 # dot .
5731 # C. 010a c. 010b
5732 # E. 0116 e. 0117
5733 # G. 0120 g. 0121
5734 # I. 0130
5735 # Z. 017b z. 017c
5736
5737 # diaeresis : [side by side dots]
5738 # A: 00c4 a: 00e4
5739 # E: 00cb e: 00eb
5740 # I: 00cf i: 00ef
5741 # O: 00d6 o: 00f6
5742 # U: 00dc u: 00fc
5743 # W: 1e84 w: 1e85
5744 # Y: 0178 y: 00ff
5745
5746 $$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS
5747 $$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS
5748 $$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS
5749 $$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS
5750 $$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS
5751 $$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS
5752 $$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS
5753 $$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS
5754 $$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS
5755 $$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS
5756 $$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS
5757
5758 # ring o
5759 # U0 016e u0 016f
5760
5761 # cedilla , [squiggle down and left below the letter]
5762 # ,C 00c7 ,c 00e7
5763 # ,G 0122 ,g 0123
5764 # ,K 0136 ,k 0137
5765 # ,L 013b ,l 013c
5766 # ,N 0145 ,n 0146
5767 # ,R 0156 ,r 0157
5768 # ,S 015e ,s 015f
5769 # ,T 0162 ,t 0163
5770
5771 $$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA
5772 $$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA
5773
5774 # ogonek ; [squiggle down and right below the letter]
5775 # A; 0104 a; 0105
5776 # E; 0118 e; 0119
5777 # I; 012e i; 012f
5778 # U; 0172 u; 0173
5779
5780 # caron < [little v on top]
5781 # A< 01cd a< 01ce
5782 # C< 010c c< 010d
5783 # D< 010e d< 010f
5784 # E< 011a e< 011b
5785 # L< 013d l< 013e
5786 # N< 0147 n< 0148
5787 # R< 0158 r< 0159
5788 # S< 0160 s< 0161
5789 # T< 0164 t< 0165
5790 # Z< 017d z< 017e
5791
5792
5793 # Other characters
5794
5795 # First character is below, 2nd character is above
5796 $$hash{"||"} = "\xa6"; # BROKEN BAR
5797 $$hash{" :"} = "\xa8"; # DIAERESIS
5798 $$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR
5799 #$$hash{" -"}= "\xaf"; # MACRON (narrow bar)
5800 $$hash{" -"} = "\xad"; # HYPHEN (wide bar)
5801 $$hash{" o"} = "\xb0"; # DEGREE SIGN
5802 $$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN
5803 $$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE
5804 $$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO
5805 $$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE
5806 $$hash{" '"} = "\xb4"; # ACUTE ACCENT
5807 $$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR
5808 $$hash{" ."} = "\xb7"; # MIDDLE DOT
5809 $$hash{", "} = "\xb8"; # CEDILLA
5810 $$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE
5811 $$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE
5812 $$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH
5813
5814 # upside down characters
5815
5816 $$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
5817 $$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
5818
5819 # overlay characters
5820
5821 $$hash{"X o"} = "\xa4"; # CURRENCY SIGN
5822 $$hash{"Y ="} = "\xa5"; # YEN SIGN
5823 $$hash{"S o"} = "\xa7"; # SECTION SIGN
5824 $$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright
5825 $$hash{"O R"} = "\xae"; # REGISTERED SIGN
5826 $$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH
5827 $$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE
5828 $$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE
5829
5830 # special names
5831
5832 $$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER
5833 $$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF
5834 $$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS
5835 $$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK
5836 $$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK
5837 $$hash{"cent"}= "\xa2"; # CENT SIGN
5838 $$hash{"lb"} = "\xa3"; # POUND SIGN
5839 $$hash{"mu"} = "\xb5"; # MICRO SIGN
5840 $$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S
5841 $$hash{"para"}= "\xb6"; # PILCROW SIGN
5842 $$hash{"-|"} = "\xac"; # NOT SIGN
5843 $$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE
5844 $$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE
5845 $$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN
5846 $$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN
5847 $$hash{"/"} = "\xf7"; # DIVISION SIGN
5848 $$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN
5849}
5850
5851# $hashref = _Date_Init_LANGUAGE;
5852# This returns a hash containing all of the initialization for a
5853# specific language. The hash elements are:
5854#
5855# @ month_name full month names January February ...
5856# @ month_abb month abbreviations Jan Feb ...
5857# @ day_name day names Monday Tuesday ...
5858# @ day_abb day abbreviations Mon Tue ...
5859# @ day_char day character abbrevs M T ...
5860# @ am AM notations
5861# @ pm PM notations
5862#
5863# @ num_suff number with suffix 1st 2nd ...
5864# @ num_word numbers spelled out first second ...
5865#
5866# $ now words which mean now now ...
5867# $ today words which mean today today ...
5868# $ last words which mean last last final ...
5869# $ each words which mean each each every ...
5870# $ of of (as in a member of) in of ...
5871# ex. 4th day OF June
5872# $ at at 4:00 at
5873# $ on on Sunday on
5874# $ future in the future in
5875# $ past in the past ago
5876# $ next next item next
5877# $ prev previous item last previous
5878# $ later 2 hours later
5879#
5880# % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 }
5881# % times a hash of times { noon->12:00:00 ... }
5882#
5883# $ years words for year y yr year ...
5884# $ months words for month
5885# $ weeks words for week
5886# $ days words for day
5887# $ hours words for hour
5888# $ minutes words for minute
5889# $ seconds words for second
5890# % replace
5891# The replace element is quite important, but a bit tricky. In
5892# English (and probably other languages), one of the abbreviations
5893# for the word month that would be nice is "m". The problem is that
5894# "m" matches the "m" in "minute" which causes the string to be
5895# improperly matched in some cases. Hence, the list of abbreviations
5896# for month is given as:
5897# "mon month months"
5898# In order to allow you to enter "m", replacements can be done.
5899# $replace is a list of pairs of words which are matched and replaced
5900# AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that
5901# the entire word "m" will be replaced with "month". This allows the
5902# desired abbreviation to be used. Make sure that replace contains
5903# an even number of words (i.e. all must be pairs). Any time a
5904# desired abbreviation matches the start of any other, it has to go
5905# here.
5906#
5907# $ exact exact mode exactly
5908# $ approx approximate mode approximately
5909# $ business business mode business
5910#
5911# r sephm hour/minute separator (?::)
5912# r sepms minute/second separator (?::)
5913# r sepss second/fraction separator (?:[.:])
5914#
5915# Elements marked with an asterix (@) are returned as a set of lists.
5916# Each list contains the strings for each element. The first set is used
5917# when the 7-bit ASCII (US) character set is wanted. The 2nd set is used
5918# when an international character set is available. Both of the 1st two
5919# sets should be complete (but the 2nd list can be left empty to force the
5920# first set to be used always). The 3rd set and later can be partial sets
5921# if desired.
5922#
5923# Elements marked with a dollar ($) are returned as a simple list of words.
5924#
5925# Elements marked with a percent (%) are returned as a hash list.
5926#
5927# Elements marked with (r) are regular expression elements which must not
5928# create a back reference.
5929#
5930# ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in
5931# every language.
5932
5933sub _Date_Init_English {
5934 print "DEBUG: _Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
5935 my($d)=@_;
5936
5937 $$d{"month_name"}=
5938 [["January","February","March","April","May","June",
5939 "July","August","September","October","November","December"]];
5940
5941 $$d{"month_abb"}=
5942 [["Jan","Feb","Mar","Apr","May","Jun",
5943 "Jul","Aug","Sep","Oct","Nov","Dec"],
5944 [],
5945 ["","","","","","","","","Sept"]];
5946
5947 $$d{"day_name"}=
5948 [["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
5949 $$d{"day_abb"}=
5950 [["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
5951 ["", "Tues","", "Thur","", "", ""]];
5952 $$d{"day_char"}=
5953 [["M","T","W","Th","F","Sa","S"]];
5954
5955 $$d{"num_suff"}=
5956 [["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th",
5957 "11th","12th","13th","14th","15th","16th","17th","18th","19th","20th",
5958 "21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th",
5959 "31st"]];
5960 $$d{"num_word"}=
5961 [["first","second","third","fourth","fifth","sixth","seventh","eighth",
5962 "ninth","tenth","eleventh","twelfth","thirteenth","fourteenth",
5963 "fifteenth","sixteenth","seventeenth","eighteenth","nineteenth",
5964 "twentieth","twenty-first","twenty-second","twenty-third",
5965 "twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh",
5966 "twenty-eighth","twenty-ninth","thirtieth","thirty-first"]];
5967
5968 $$d{"now"} =["now"];
5969 $$d{"today"} =["today"];
5970 $$d{"last"} =["last","final"];
5971 $$d{"each"} =["each","every"];
5972 $$d{"of"} =["in","of"];
5973 $$d{"at"} =["at"];
5974 $$d{"on"} =["on"];
5975 $$d{"future"} =["in"];
5976 $$d{"past"} =["ago"];
5977 $$d{"next"} =["next"];
5978 $$d{"prev"} =["previous","last"];
5979 $$d{"later"} =["later"];
5980
5981 $$d{"exact"} =["exactly"];
5982 $$d{"approx"} =["approximately"];
5983 $$d{"business"}=["business"];
5984
5985 $$d{"offset"} =["yesterday","-0:0:0:1:0:0:0","tomorrow","+0:0:0:1:0:0:0","overmorrow","+0:0:0:2:0:0:0","ereyesterday","-0:0:0:2:0:0:0"];
5986 $$d{"times"} =["noon","12:00:00","midnight","00:00:00"];
5987
5988 $$d{"years"} =["y","yr","year","yrs","years"];
5989 $$d{"months"} =["mon","month","months"];
5990 $$d{"weeks"} =["w","wk","wks","week","weeks"];
5991 $$d{"days"} =["d","day","days"];
5992 $$d{"hours"} =["h","hr","hrs","hour","hours"];
5993 $$d{"minutes"} =["mn","min","minute","minutes"];
5994 $$d{"seconds"} =["s","sec","second","seconds"];
5995 $$d{"replace"} =["m","month"];
5996
5997 $$d{"sephm"} =':';
5998 $$d{"sepms"} =':';
5999 $$d{"sepss"} ='[.:]';
6000
6001 $$d{"am"} = ["AM","A.M."];
6002 $$d{"pm"} = ["PM","P.M."];
6003}
6004
6005sub _Date_Init_Italian {
6006 print "DEBUG: _Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
6007 my($d)=@_;
6008 my(%h)=();
6009 _Char_8Bit(\%h);
6010 my($i)=$h{"i`"};
6011
6012 $$d{"month_name"}=
6013 [[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
6014 Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
6015
6016 $$d{"month_abb"}=
6017 [[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
6018
6019 $$d{"day_name"}=
6020 [[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
6021 [qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
6022 $$d{"day_abb"}=
6023 [[qw(Lun Mar Mer Gio Ven Sab Dom)]];
6024 $$d{"day_char"}=
6025 [[qw(L Ma Me G V S D)]];
6026
6027 $$d{"num_suff"}=
6028 [[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo
6029 16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo
6030 29mo 3mo 31mo)]];
6031 $$d{"num_word"}=
6032 [[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo
6033 undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo
6034 sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo
6035 ventunesimo ventiduesimo ventitreesimo ventiquattresimo
6036 venticinquesimo ventiseiesimo ventisettesimo ventottesimo
6037 ventinovesimo trentesimo trentunesimo)]];
6038
6039 $$d{"now"} =[qw(adesso)];
6040 $$d{"today"} =[qw(oggi)];
6041 $$d{"last"} =[qw(ultimo)];
6042 $$d{"each"} =[qw(ogni)];
6043 $$d{"of"} =[qw(della del)];
6044 $$d{"at"} =[qw(alle)];
6045 $$d{"on"} =[qw(di)];
6046 $$d{"future"} =[qw(fra)];
6047 $$d{"past"} =[qw(fa)];
6048 $$d{"next"} =[qw(prossimo)];
6049 $$d{"prev"} =[qw(ultimo)];
6050 $$d{"later"} =[qw(dopo)];
6051
6052 $$d{"exact"} =[qw(esattamente)];
6053 $$d{"approx"} =[qw(circa)];
6054 $$d{"business"}=[qw(lavorativi lavorativo)];
6055
6056 $$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)];
6057 $$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)];
6058
6059 $$d{"years"} =[qw(anni anno a)];
6060 $$d{"months"} =[qw(mesi mese mes)];
6061 $$d{"weeks"} =[qw(settimane settimana sett)];
6062 $$d{"days"} =[qw(giorni giorno g)];
6063 $$d{"hours"} =[qw(ore ora h)];
6064 $$d{"minutes"} =[qw(minuti minuto min)];
6065 $$d{"seconds"} =[qw(secondi secondo sec)];
6066 $$d{"replace"} =[qw(s sec m mes)];
6067
6068 $$d{"sephm"} =':';
6069 $$d{"sepms"} =':';
6070 $$d{"sepss"} ='[.:]';
6071
6072 $$d{"am"} = [qw(AM)];
6073 $$d{"pm"} = [qw(PM)];
6074}
6075
6076sub _Date_Init_French {
6077 print "DEBUG: _Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
6078 my($d)=@_;
6079 my(%h)=();
6080 _Char_8Bit(\%h);
6081 my($e)=$h{"e'"};
6082 my($u)=$h{"u^"};
6083 my($a)=$h{"a'"};
6084
6085 $$d{"month_name"}=
6086 [["janvier","fevrier","mars","avril","mai","juin",
6087 "juillet","aout","septembre","octobre","novembre","decembre"],
6088 ["janvier","f${e}vrier","mars","avril","mai","juin",
6089 "juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]];
6090 $$d{"month_abb"}=
6091 [["jan","fev","mar","avr","mai","juin",
6092 "juil","aout","sept","oct","nov","dec"],
6093 ["jan","f${e}v","mar","avr","mai","juin",
6094 "juil","ao${u}t","sept","oct","nov","d${e}c"]];
6095
6096 $$d{"day_name"}=
6097 [["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
6098 $$d{"day_abb"}=
6099 [["lun","mar","mer","jeu","ven","sam","dim"]];
6100 $$d{"day_char"}=
6101 [["l","ma","me","j","v","s","d"]];
6102
6103 $$d{"num_suff"}=
6104 [["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e",
6105 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
6106 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
6107 "31e"]];
6108 $$d{"num_word"}=
6109 [["premier","deux","trois","quatre","cinq","six","sept","huit","neuf",
6110 "dix","onze","douze","treize","quatorze","quinze","seize","dix-sept",
6111 "dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois",
6112 "vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit",
6113 "vingt-neuf","trente","trente et un"],
6114 ["1re"]];
6115
6116 $$d{"now"} =["maintenant"];
6117 $$d{"today"} =["aujourd'hui"];
6118 $$d{"last"} =["dernier"];
6119 $$d{"each"} =["chaque","tous les","toutes les"];
6120 $$d{"of"} =["en","de"];
6121 $$d{"at"} =["a","${a}0"];
6122 $$d{"on"} =["sur"];
6123 $$d{"future"} =["en"];
6124 $$d{"past"} =["il y a"];
6125 $$d{"next"} =["suivant"];
6126 $$d{"prev"} =["precedent","pr${e}c${e}dent"];
6127 $$d{"later"} =["plus tard"];
6128
6129 $$d{"exact"} =["exactement"];
6130 $$d{"approx"} =["approximativement"];
6131 $$d{"business"}=["professionel"];
6132
6133 $$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"];
6134 $$d{"times"} =["midi","12:00:00","minuit","00:00:00"];
6135
6136 $$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"];
6137 $$d{"months"} =["mois"];
6138 $$d{"weeks"} =["sem","semaine"];
6139 $$d{"days"} =["j","jour","jours"];
6140 $$d{"hours"} =["h","heure","heures"];
6141 $$d{"minutes"} =["mn","min","minute","minutes"];
6142 $$d{"seconds"} =["s","sec","seconde","secondes"];
6143 $$d{"replace"} =["m","mois"];
6144
6145 $$d{"sephm"} ='[h:]';
6146 $$d{"sepms"} =':';
6147 $$d{"sepss"} ='[.:,]';
6148
6149 $$d{"am"} = ["du matin"];
6150 $$d{"pm"} = ["du soir"];
6151}
6152
6153sub _Date_Init_Romanian {
6154 print "DEBUG: _Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
6155 my($d)=@_;
6156 my(%h)=();
6157 _Char_8Bit(\%h);
6158 my($p)=$h{"p"};
6159 my($i)=$h{"i^"};
6160 my($a)=$h{"a~"};
6161 my($o)=$h{"-o"};
6162
6163 $$d{"month_name"}=
6164 [["ianuarie","februarie","martie","aprilie","mai","iunie",
6165 "iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
6166 $$d{"month_abb"}=
6167 [["ian","febr","mart","apr","mai","iun",
6168 "iul","aug","sept","oct","nov","dec"],
6169 ["","feb"]];
6170
6171 $$d{"day_name"}=
6172 [["luni","marti","miercuri","joi","vineri","simbata","duminica"],
6173 ["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
6174 "duminic${a}"]];
6175 $$d{"day_abb"}=
6176 [["lun","mar","mie","joi","vin","sim","dum"],
6177 ["lun","mar","mie","joi","vin","s${i}m","dum"]];
6178 $$d{"day_char"}=
6179 [["L","Ma","Mi","J","V","S","D"]];
6180
6181 $$d{"num_suff"}=
6182 [["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a",
6183 "a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a",
6184 "a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a",
6185 "a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a",
6186 "a 30-a","a 31-a"]];
6187
6188 $$d{"num_word"}=
6189 [["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea",
6190 "a opta","a noua","a zecea","a unsprezecea","a doisprezecea",
6191 "a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea",
6192 "a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea",
6193 "a douazecisiuna","a douazecisidoua","a douazecisitreia",
6194 "a douazecisipatra","a douazecisicincea","a douazecisisasea",
6195 "a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea",
6196 "a treizecisiuna"],
6197 ["prima","a doua","a treia","a patra","a cincea","a ${o}asea",
6198 "a ${o}aptea","a opta","a noua","a zecea","a unsprezecea",
6199 "a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea",
6200 "a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea",
6201 "a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna",
6202 "a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia",
6203 "a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea",
6204 "a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea",
6205 "a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea",
6206 "a treizeci${o}iuna"],
6207 ["intii", "doi", "trei", "patru", "cinci", "sase", "sapte",
6208 "opt","noua","zece","unsprezece","doisprezece",
6209 "treisprezece","patrusprezece","cincisprezece","saiprezece",
6210 "saptesprezece","optsprezece","nouasprezece","douazeci",
6211 "douazecisiunu","douazecisidoi","douazecisitrei",
6212 "douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte",
6213 "douazecisiopt","douazecisinoua","treizeci","treizecisiunu"],
6214 ["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte",
6215 "opt","nou${a}","zece","unsprezece","doisprezece",
6216 "treisprezece","patrusprezece","cincisprezece","${o}aiprezece",
6217 "${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci",
6218 "dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei",
6219 "dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase",
6220 "dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt",
6221 "dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]];
6222
6223 $$d{"now"} =["acum"];
6224 $$d{"today"} =["azi","astazi","ast${a}zi"];
6225 $$d{"last"} =["ultima"];
6226 $$d{"each"} =["fiecare"];
6227 $$d{"of"} =["din","in","n"];
6228 $$d{"at"} =["la"];
6229 $$d{"on"} =["on"];
6230 $$d{"future"} =["in","${i}n"];
6231 $$d{"past"} =["in urma", "${i}n urm${a}"];
6232 $$d{"next"} =["urmatoarea","urm${a}toarea"];
6233 $$d{"prev"} =["precedenta","ultima"];
6234 $$d{"later"} =["mai tirziu", "mai t${i}rziu"];
6235
6236 $$d{"exact"} =["exact"];
6237 $$d{"approx"} =["aproximativ"];
6238 $$d{"business"}=["de lucru","lucratoare","lucr${a}toare"];
6239
6240 $$d{"offset"} =["ieri","-0:0:0:1:0:0:0",
6241 "alaltaieri", "-0:0:0:2:0:0:0",
6242 "alalt${a}ieri","-0:0:0:2:0:0:0",
6243 "miine","+0:0:0:1:0:0:0",
6244 "m${i}ine","+0:0:0:1:0:0:0",
6245 "poimiine","+0:0:0:2:0:0:0",
6246 "poim${i}ine","+0:0:0:2:0:0:0"];
6247 $$d{"times"} =["amiaza","12:00:00",
6248 "amiaz${a}","12:00:00",
6249 "miezul noptii","00:00:00",
6250 "miezul nop${p}ii","00:00:00"];
6251
6252 $$d{"years"} =["ani","an","a"];
6253 $$d{"months"} =["luni","luna","lun${a}","l"];
6254 $$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina",
6255 "s${a}pt${a}m${i}na","sapt","s${a}pt"];
6256 $$d{"days"} =["zile","zi","z"];
6257 $$d{"hours"} =["ore", "ora", "or${a}", "h"];
6258 $$d{"minutes"} =["minute","min","m"];
6259 $$d{"seconds"} =["secunde","sec",];
6260 $$d{"replace"} =["s","secunde"];
6261
6262 $$d{"sephm"} =':';
6263 $$d{"sepms"} =':';
6264 $$d{"sepss"} ='[.:,]';
6265
6266 $$d{"am"} = ["AM","A.M."];
6267 $$d{"pm"} = ["PM","P.M."];
6268}
6269
6270sub _Date_Init_Swedish {
6271 print "DEBUG: _Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
6272 my($d)=@_;
6273 my(%h)=();
6274 _Char_8Bit(\%h);
6275 my($ao)=$h{"ao"};
6276 my($o) =$h{"o:"};
6277 my($a) =$h{"a:"};
6278
6279 $$d{"month_name"}=
6280 [["Januari","Februari","Mars","April","Maj","Juni",
6281 "Juli","Augusti","September","Oktober","November","December"]];
6282 $$d{"month_abb"}=
6283 [["Jan","Feb","Mar","Apr","Maj","Jun",
6284 "Jul","Aug","Sep","Okt","Nov","Dec"]];
6285
6286 $$d{"day_name"}=
6287 [["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
6288 ["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
6289 "S${o}ndag"]];
6290 $$d{"day_abb"}=
6291 [["Man","Tis","Ons","Tor","Fre","Lor","Son"],
6292 ["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
6293 $$d{"day_char"}=
6294 [["M","Ti","O","To","F","L","S"]];
6295
6296 $$d{"num_suff"}=
6297 [["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
6298 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
6299 "21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
6300 "31:a"]];
6301 $$d{"num_word"}=
6302 [["forsta","andra","tredje","fjarde","femte","sjatte","sjunde",
6303 "attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6304 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6305 "tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte",
6306 "tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde",
6307 "trettionde","trettioforsta"],
6308 ["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde",
6309 "${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6310 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6311 "tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte",
6312 "tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde",
6313 "trettionde","trettiof${o}rsta"]];
6314
6315 $$d{"now"} =["nu"];
6316 $$d{"today"} =["idag"];
6317 $$d{"last"} =["forra","f${o}rra","senaste"];
6318 $$d{"each"} =["varje"];
6319 $$d{"of"} =["om"];
6320 $$d{"at"} =["kl","kl.","klockan"];
6321 $$d{"on"} =["pa","p${ao}"];
6322 $$d{"future"} =["om"];
6323 $$d{"past"} =["sedan"];
6324 $$d{"next"} =["nasta","n${a}sta"];
6325 $$d{"prev"} =["forra","f${o}rra"];
6326 $$d{"later"} =["senare"];
6327
6328 $$d{"exact"} =["exakt"];
6329 $$d{"approx"} =["ungefar","ungef${a}r"];
6330 $$d{"business"}=["arbetsdag","arbetsdagar"];
6331
6332 $$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
6333 "imorgon","+0:0:0:1:0:0:0"];
6334 $$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00",
6335 "midnatt","00:00:00"];
6336
6337 $$d{"years"} =["ar","${ao}r"];
6338 $$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"];
6339 $$d{"weeks"} =["v","vecka","veckor"];
6340 $$d{"days"} =["d","dag","dagar"];
6341 $$d{"hours"} =["t","tim","timme","timmar"];
6342 $$d{"minutes"} =["min","minut","minuter"];
6343 $$d{"seconds"} =["s","sek","sekund","sekunder"];
6344 $$d{"replace"} =["m","minut"];
6345
6346 $$d{"sephm"} ='[.:]';
6347 $$d{"sepms"} =':';
6348 $$d{"sepss"} ='[.:]';
6349
6350 $$d{"am"} = ["FM"];
6351 $$d{"pm"} = ["EM"];
6352}
6353
6354sub _Date_Init_German {
6355 print "DEBUG: _Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
6356 my($d)=@_;
6357 my(%h)=();
6358 _Char_8Bit(\%h);
6359 my($a)=$h{"a:"};
6360 my($u)=$h{"u:"};
6361 my($o)=$h{"o:"};
6362 my($b)=$h{"beta"};
6363
6364 $$d{"month_name"}=
6365 [["Januar","Februar","Maerz","April","Mai","Juni",
6366 "Juli","August","September","Oktober","November","Dezember"],
6367 ["J${a}nner","Februar","M${a}rz","April","Mai","Juni",
6368 "Juli","August","September","Oktober","November","Dezember"]];
6369 $$d{"month_abb"}=
6370 [["Jan","Feb","Mar","Apr","Mai","Jun",
6371 "Jul","Aug","Sep","Okt","Nov","Dez"],
6372 ["J${a}n","Feb","M${a}r","Apr","Mai","Jun",
6373 "Jul","Aug","Sep","Okt","Nov","Dez"]];
6374
6375 $$d{"day_name"}=
6376 [["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
6377 "Sonntag"]];
6378 $$d{"day_abb"}=
6379 [["Mo","Di","Mi","Do","Fr","Sa","So"]];
6380 $$d{"day_char"}=
6381 [["M","Di","Mi","Do","F","Sa","So"]];
6382
6383 $$d{"num_suff"}=
6384 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6385 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6386 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6387 "31."]];
6388 $$d{"num_word"}=
6389 [
6390 ["erste","zweite","dritte","vierte","funfte","sechste","siebente",
6391 "achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte",
6392 "funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte",
6393 "zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste",
6394 "vierundzwanzigste","funfundzwanzigste","sechundzwanzigste",
6395 "siebundzwanzigste","achtundzwanzigste","neunundzwanzigste",
6396 "dreibigste","einunddreibigste"],
6397 ["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente",
6398 "achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte",
6399 "vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte",
6400 "neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste",
6401 "dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste",
6402 "sechundzwanzigste","siebundzwanzigste","achtundzwanzigste",
6403 "neunundzwanzigste","drei${b}igste","einunddrei${b}igste"],
6404 ["erster"]];
6405
6406 $$d{"now"} =["jetzt"];
6407 $$d{"today"} =["heute"];
6408 $$d{"last"} =["letzte","letzten"];
6409 $$d{"each"} =["jeden"];
6410 $$d{"of"} =["der","im","des"];
6411 $$d{"at"} =["um"];
6412 $$d{"on"} =["am"];
6413 $$d{"future"} =["in"];
6414 $$d{"past"} =["vor"];
6415 $$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
6416 $$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
6417 $$d{"later"} =["spater","sp${a}ter"];
6418
6419 $$d{"exact"} =["genau"];
6420 $$d{"approx"} =["ungefahr","ungef${a}hr"];
6421 $$d{"business"}=["Arbeitstag"];
6422
6423 $$d{"offset"} =["gestern","-0:0:0:1:0:0:0","morgen","+0:0:0:1:0:0:0","${u}bermorgen","+0:0:0:2:0:0:0"];
6424 $$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"];
6425
6426 $$d{"years"} =["j","Jahr","Jahre","Jahren"];
6427 $$d{"months"} =["Monat","Monate","Monaten"];
6428 $$d{"weeks"} =["w","Woche","Wochen"];
6429 $$d{"days"} =["t","Tag","Tage","Tagen"];
6430 $$d{"hours"} =["h","std","Stunde","Stunden"];
6431 $$d{"minutes"} =["min","Minute","Minuten"];
6432 $$d{"seconds"} =["s","sek","Sekunde","Sekunden"];
6433 $$d{"replace"} =["m","Monat"];
6434
6435 $$d{"sephm"} =':';
6436 $$d{"sepms"} ='[: ]';
6437 $$d{"sepss"} ='[.:]';
6438
6439 $$d{"am"} = ["FM"];
6440 $$d{"pm"} = ["EM"];
6441}
6442
6443sub _Date_Init_Dutch {
6444 print "DEBUG: _Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
6445 my($d)=@_;
6446 my(%h)=();
6447 _Char_8Bit(\%h);
6448
6449 $$d{"month_name"}=
6450 [["januari","februari","maart","april","mei","juni","juli","augustus",
6451 "september","october","november","december"],
6452 ["","","","","","","","","","oktober"]];
6453
6454 $$d{"month_abb"}=
6455 [["jan","feb","maa","apr","mei","jun","jul",
6456 "aug","sep","oct","nov","dec"],
6457 ["","","mrt","","","","","","","okt"]];
6458 $$d{"day_name"}=
6459 [["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
6460 "zondag"]];
6461 $$d{"day_abb"}=
6462 [["ma","di","wo","do","vr","zat","zon"],
6463 ["","","","","","za","zo"]];
6464 $$d{"day_char"}=
6465 [["M","D","W","D","V","Za","Zo"]];
6466
6467 $$d{"num_suff"}=
6468 [["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de",
6469 "11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste",
6470 "21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste",
6471 "30ste","31ste"]];
6472 $$d{"num_word"}=
6473 [["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
6474 "negende","tiende","elfde","twaalfde",
6475 map {"${_}tiende";} qw (der veer vijf zes zeven acht negen),
6476 "twintigste",
6477 map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht
6478 negen),
6479 "dertigste","eenendertigste"],
6480 ["","","","","","","","","","","","","","","","","","","","",
6481 map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht
6482 negen),
6483 "dertigste","een-en-dertigste"],
6484 ["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
6485 "elf","twaalf",
6486 map {"${_}tien"} qw (der veer vijf zes zeven acht negen),
6487 "twintig",
6488 map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen),
6489 "dertig","eenendertig"],
6490 ["","","","","","","","","","","","","","","","","","","","",
6491 map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht
6492 negen),
6493 "dertig","een-en-dertig"]];
6494
6495 $$d{"now"} =["nu","nou"];
6496 $$d{"today"} =["vandaag"];
6497 $$d{"last"} =["laatste"];
6498 $$d{"each"} =["elke","elk"];
6499 $$d{"of"} =["in","van"];
6500 $$d{"at"} =["om"];
6501 $$d{"on"} =["op"];
6502 $$d{"future"} =["over"];
6503 $$d{"past"} =["geleden","vroeger","eerder"];
6504 $$d{"next"} =["volgende","volgend"];
6505 $$d{"prev"} =["voorgaande","voorgaand"];
6506 $$d{"later"} =["later"];
6507
6508 $$d{"exact"} =["exact","precies","nauwkeurig"];
6509 $$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.'];
6510 $$d{"business"}=["werk","zakelijke","zakelijk"];
6511
6512 $$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0",
6513 "gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"];
6514 $$d{"times"} =["noen","12:00:00","middernacht","00:00:00"];
6515
6516 $$d{"years"} =["jaar","jaren","ja","j"];
6517 $$d{"months"} =["maand","maanden","mnd"];
6518 $$d{"weeks"} =["week","weken","w"];
6519 $$d{"days"} =["dag","dagen","d"];
6520 $$d{"hours"} =["uur","uren","u","h"];
6521 $$d{"minutes"} =["minuut","minuten","min"];
6522 $$d{"seconds"} =["seconde","seconden","sec","s"];
6523 $$d{"replace"} =["m","minuten"];
6524
6525 $$d{"sephm"} ='[:.uh]';
6526 $$d{"sepms"} ='[:.m]';
6527 $$d{"sepss"} ='[.:]';
6528
6529 $$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends",
6530 "ochtend","'s_nachts","nacht"];
6531 $$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag",
6532 "'s_avonds","avond"];
6533}
6534
6535sub _Date_Init_Polish {
6536 print "DEBUG: _Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
6537 my($d)=@_;
6538
6539 $$d{"month_name"}=
6540 [["stycznia","luty","marca","kwietnia","maja","czerwca",
6541 "lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"],
6542 ["stycznia","luty","marca","kwietnia","maja","czerwca","lipca",
6543 "sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]];
6544 $$d{"month_abb"}=
6545 [["sty.","lut.","mar.","kwi.","maj","cze.",
6546 "lip.","sie.","wrz.","paz.","lis.","gru."],
6547 ["sty.","lut.","mar.","kwi.","maj","cze.",
6548 "lip.","sie.","wrz.","pa\x9f.","lis.","gru."]];
6549
6550 $$d{"day_name"}=
6551 [["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
6552 "niedziela"],
6553 ["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
6554 "sobota","niedziela"]];
6555 $$d{"day_abb"}=
6556 [["po.","wt.","sr.","cz.","pi.","so.","ni."],
6557 ["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
6558 $$d{"day_char"}=
6559 [["p","w","e","c","p","s","n"],
6560 ["p","w","\x9c.","c","p","s","n"]];
6561
6562 $$d{"num_suff"}=
6563 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6564 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6565 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6566 "31."]];
6567 $$d{"num_word"}=
6568 [["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
6569 "siodmego","osmego","dziewiatego","dziesiatego",
6570 "jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
6571 "szestnastego","siedemnastego","osiemnastego","dziewietnastego",
6572 "dwudziestego",
6573 "dwudziestego pierwszego","dwudziestego drugiego",
6574 "dwudziestego trzeczego","dwudziestego czwartego",
6575 "dwudziestego piatego","dwudziestego szostego",
6576 "dwudziestego siodmego","dwudziestego osmego",
6577 "dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"],
6578 ["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego",
6579 "sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego",
6580 "dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego",
6581 "czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego",
6582 "osiemnastego","dziewietnastego","dwudziestego",
6583 "dwudziestego pierwszego","dwudziestego drugiego",
6584 "dwudziestego trzeczego","dwudziestego czwartego",
6585 "dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego",
6586 "dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego",
6587 "dwudziestego dziewi\x81\xb9tego","trzydziestego",
6588 "trzydziestego pierwszego"]];
6589
6590 $$d{"now"} =["teraz"];
6591 $$d{"today"} =["dzisaj"];
6592 $$d{"last"} =["ostatni","ostatna"];
6593 $$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"];
6594 $$d{"of"} =["w","z"];
6595 $$d{"at"} =["o","u"];
6596 $$d{"on"} =["na"];
6597 $$d{"future"} =["za"];
6598 $$d{"past"} =["temu"];
6599 $$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
6600 "przyszly","przysz\x81\xb3y","przyszlym",
6601 "przysz\x81\xb3ym"];
6602 $$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
6603 $$d{"later"} =["later"];
6604
6605 $$d{"exact"} =["doklandnie","dok\x81\xb3andnie"];
6606 $$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej",
6607 "mniej wi\x81\xeacej","okolo","oko\x81\xb3o"];
6608 $$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym",
6609 "s\x81\xb3u\x81\xbfbowym"];
6610
6611 $$d{"times"} =["po\x81\xb3udnie","12:00:00",
6612 "p\x81\xf3\x81\xb3noc","00:00:00",
6613 "poludnie","12:00:00","polnoc","00:00:00"];
6614 $$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"];
6615
6616 $$d{"years"} =["rok","lat","lata","latach"];
6617 $$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy",
6618 "miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"];
6619 $$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"];
6620 $$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"];
6621 $$d{"hours"} =["g.","godzina","godziny","godzinie"];
6622 $$d{"minutes"} =["mn.","min.","minut","minuty"];
6623 $$d{"seconds"} =["s.","sekund","sekundy"];
6624 $$d{"replace"} =["m.","miesiac"];
6625
6626 $$d{"sephm"} =':';
6627 $$d{"sepms"} =':';
6628 $$d{"sepss"} ='[.:]';
6629
6630 $$d{"am"} = ["AM","A.M."];
6631 $$d{"pm"} = ["PM","P.M."];
6632}
6633
6634sub _Date_Init_Spanish {
6635 print "DEBUG: _Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
6636 my($d)=@_;
6637 my(%h)=();
6638 _Char_8Bit(\%h);
6639
6640 $$d{"month_name"}=
6641 [["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
6642 "Septiembre","Octubre","Noviembre","Diciembre"]];
6643
6644 $$d{"month_abb"}=
6645 [["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
6646 "Nov","Dic"]];
6647
6648 $$d{"day_name"}=
6649 [["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
6650 $$d{"day_abb"}=
6651 [["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
6652 $$d{"day_char"}=
6653 [["L","Ma","Mi","J","V","S","D"]];
6654
6655 $$d{"num_suff"}=
6656 [["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o",
6657 "11o","12o","13o","14o","15o","16o","17o","18o","19o","20o",
6658 "21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"],
6659 ["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a",
6660 "11a","12a","13a","14a","15a","16a","17a","18a","19a","20a",
6661 "21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]];
6662 $$d{"num_word"}=
6663 [["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo",
6664 "Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo",
6665 "Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto",
6666 "Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo",
6667 "Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero",
6668 "Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto",
6669 "Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo",
6670 "Trigesimo Primero"],
6671 ["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima",
6672 "Octava","Novena","Decima","Decimo Primera","Decimo Segunda",
6673 "Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta",
6674 "Decimo Septima","Decimo Octava","Decimo Novena","Vigesima",
6675 "Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera",
6676 "Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta",
6677 "Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima",
6678 "Trigesimo Primera"]];
6679
6680 $$d{"now"} =["Ahora"];
6681 $$d{"today"} =["Hoy"];
6682 $$d{"last"} =["ultimo"];
6683 $$d{"each"} =["cada"];
6684 $$d{"of"} =["en","de"];
6685 $$d{"at"} =["a"];
6686 $$d{"on"} =["el"];
6687 $$d{"future"} =["en"];
6688 $$d{"past"} =["hace"];
6689 $$d{"next"} =["siguiente"];
6690 $$d{"prev"} =["anterior"];
6691 $$d{"later"} =["later"];
6692
6693 $$d{"exact"} =["exactamente"];
6694 $$d{"approx"} =["aproximadamente"];
6695 $$d{"business"}=["laborales"];
6696
6697 $$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"];
6698 $$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"];
6699
6700 $$d{"years"} =["a","ano","ano","anos","anos"];
6701 $$d{"months"} =["m","mes","mes","meses"];
6702 $$d{"weeks"} =["sem","semana","semana","semanas"];
6703 $$d{"days"} =["d","dia","dias"];
6704 $$d{"hours"} =["hr","hrs","hora","horas"];
6705 $$d{"minutes"} =["min","min","minuto","minutos"];
6706 $$d{"seconds"} =["s","seg","segundo","segundos"];
6707 $$d{"replace"} =["m","mes"];
6708
6709 $$d{"sephm"} =':';
6710 $$d{"sepms"} =':';
6711 $$d{"sepss"} ='[.:]';
6712
6713 $$d{"am"} = ["AM","A.M."];
6714 $$d{"pm"} = ["PM","P.M."];
6715}
6716
6717sub _Date_Init_Portuguese {
6718 print "DEBUG: _Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
6719 my($d)=@_;
6720 my(%h)=();
6721 _Char_8Bit(\%h);
6722 my($o) = $h{"-o"};
6723 my($c) = $h{",c"};
6724 my($a) = $h{"a'"};
6725 my($e) = $h{"e'"};
6726 my($u) = $h{"u'"};
6727 my($o2)= $h{"o'"};
6728 my($a2)= $h{"a`"};
6729 my($a3)= $h{"a~"};
6730 my($e2)= $h{"e^"};
6731
6732 $$d{"month_name"}=
6733 [["Janeiro","Fevereiro","Marco","Abril","Maio","Junho",
6734 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"],
6735 ["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho",
6736 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]];
6737
6738 $$d{"month_abb"}=
6739 [["Jan","Fev","Mar","Abr","Mai","Jun",
6740 "Jul","Ago","Set","Out","Nov","Dez"]];
6741
6742 $$d{"day_name"}=
6743 [["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
6744 ["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
6745 $$d{"day_abb"}=
6746 [["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
6747 ["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
6748 $$d{"day_char"}=
6749 [["Sg","T","Qa","Qi","Sx","Sb","D"]];
6750
6751 $$d{"num_suff"}=
6752 [["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}",
6753 "9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}",
6754 "16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}",
6755 "23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}",
6756 "30${o}","31${o}"]];
6757 $$d{"num_word"}=
6758 [["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo",
6759 "oitavo","nono","decimo","decimo primeiro","decimo segundo",
6760 "decimo terceiro","decimo quarto","decimo quinto","decimo sexto",
6761 "decimo setimo","decimo oitavo","decimo nono","vigesimo",
6762 "vigesimo primeiro","vigesimo segundo","vigesimo terceiro",
6763 "vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo",
6764 "vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"],
6765 ["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo",
6766 "oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo",
6767 "d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto",
6768 "d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo",
6769 "d${e}cimo nono","vig${e}simo","vig${e}simo primeiro",
6770 "vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto",
6771 "vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo",
6772 "vig${e}simo oitavo","vig${e}simo nono","trig${e}simo",
6773 "trig${e}simo primeiro"]];
6774
6775 $$d{"now"} =["agora"];
6776 $$d{"today"} =["hoje"];
6777 $$d{"last"} =["${u}ltimo","ultimo"];
6778 $$d{"each"} =["cada"];
6779 $$d{"of"} =["da","do"];
6780 $$d{"at"} =["as","${a2}s"];
6781 $$d{"on"} =["na","no"];
6782 $$d{"future"} =["em"];
6783 $$d{"past"} =["a","${a2}"];
6784 $$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"];
6785 $$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"];
6786 $$d{"later"} =["passadas","passados"];
6787
6788 $$d{"exact"} =["exactamente"];
6789 $$d{"approx"} =["aproximadamente"];
6790 $$d{"business"}=["util","uteis"];
6791
6792 $$d{"offset"} =["ontem","-0:0:0:1:0:0:0",
6793 "amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"];
6794 $$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"];
6795
6796 $$d{"years"} =["anos","ano","ans","an","a"];
6797 $$d{"months"} =["meses","m${e2}s","mes","m"];
6798 $$d{"weeks"} =["semanas","semana","sem","sems","s"];
6799 $$d{"days"} =["dias","dia","d"];
6800 $$d{"hours"} =["horas","hora","hr","hrs"];
6801 $$d{"minutes"} =["minutos","minuto","min","mn"];
6802 $$d{"seconds"} =["segundos","segundo","seg","sg"];
6803 $$d{"replace"} =["m","mes","s","sems"];
6804
6805 $$d{"sephm"} =':';
6806 $$d{"sepms"} =':';
6807 $$d{"sepss"} ='[,]';
6808
6809 $$d{"am"} = ["AM","A.M."];
6810 $$d{"pm"} = ["PM","P.M."];
6811}
6812
6813sub _Date_Init_Russian {
6814 print "DEBUG: _Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
6815 my($d)=@_;
6816 my(%h)=();
6817 _Char_8Bit(\%h);
6818 my($a) =$h{"a:"};
6819
6820 $$d{"month_name"}=
6821 [
6822 ["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1",
6823 "\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1",
6824 "\xc9\xc0\xce\xd1",
6825 "\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1",
6826 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1",
6827 "\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"],
6828 ["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8",
6829 "\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca",
6830 "\xc9\xc0\xce\xd8",
6831 "\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4",
6832 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8",
6833 "\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"]
6834 ];
6835
6836 $$d{"month_abb"}=
6837 [["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2",
6838 "\xcd\xc1\xca","\xc9\xc0\xce",
6839 "\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4",
6840 "\xce\xcf\xd1\xc2","\xc4\xc5\xcb"],
6841 ["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","",
6842 "","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]];
6843
6844 $$d{"day_name"}=
6845 [["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb",
6846 "\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1",
6847 "\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1",
6848 "\xd3\xd5\xc2\xc2\xcf\xd4\xc1",
6849 "\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]];
6850 $$d{"day_abb"}=
6851 [["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7",
6852 "\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"],
6853 ["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4",
6854 "\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]];
6855 $$d{"day_char"}=
6856 [["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
6857 "\xd7\xd3"]];
6858
6859 $$d{"num_suff"}=
6860 [["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ",
6861 "11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ",
6862 "21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ",
6863 "31 "]];
6864 $$d{"num_word"}=
6865 [["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca",
6866 "\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6867 "\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca",
6868 "\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca",
6869 "\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca",
6870 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6871 "\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca",
6872 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6873 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6874 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6875 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6876 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6877 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6878 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6879 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6880 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca",
6881 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca",
6882 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca",
6883 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6884 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca",
6885 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca",
6886 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca",
6887 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca",
6888 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca",
6889 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca",
6890 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"],
6891
6892 ["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5",
6893 "\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6894 "\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5",
6895 "\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6896 "\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5",
6897 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6898 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6899 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6900 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6901 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6902 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6903 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6904 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6905 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6906 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6907 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5",
6908 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6909 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5",
6910 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6911 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5",
6912 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5",
6913 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5",
6914 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6915 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5",
6916 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5",
6917 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"],
6918
6919 ["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf",
6920 "\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6921 "\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf",
6922 "\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6923 "\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6924 "\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf",
6925 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6926 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6927 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6928 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6929 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6930 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6931 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6932 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6933 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6934 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6935 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf",
6936 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6937 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6938 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf",
6939 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf",
6940 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf",
6941 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6942 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6943 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf",
6944 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6945 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]];
6946
6947 $$d{"now"} =["\xd3\xc5\xca\xde\xc1\xd3"];
6948 $$d{"today"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1"];
6949 $$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"];
6950 $$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"];
6951 $$d{"of"} =[" "];
6952 $$d{"at"} =["\xd7"];
6953 $$d{"on"} =["\xd7"];
6954 $$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"];
6955 $$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "];
6956 $$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"];
6957 $$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"];
6958 $$d{"later"} =["\xd0\xcf\xda\xd6\xc5"];
6959
6960 $$d{"exact"} =["\xd4\xcf\xde\xce\xcf"];
6961 $$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"];
6962 $$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"];
6963
6964 $$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0",
6965 "\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0",
6966 "\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0",
6967 "\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1",
6968 "+0:0:0:2:0:0:0"];
6969 $$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00",
6970 "\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"];
6971
6972 $$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4",
6973 "\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"];
6974 $$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3",
6975 "\xcd\xc5\xd3\xd1\xc3\xc5\xd7"];
6976 $$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8",
6977 "\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"];
6978 $$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca",
6979 "\xc4\xce\xd1"];
6980 $$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3",
6981 "\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"];
6982 $$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1",
6983 "\xcd\xc9\xce\xd5\xd4"];
6984 $$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
6985 "\xd3\xc5\xcb\xd5\xce\xc4"];
6986 $$d{"replace"} =[];
6987
6988 $$d{"sephm"} ="[:\xde]";
6989 $$d{"sepms"} ="[:\xcd]";
6990 $$d{"sepss"} ="[:.\xd3]";
6991
6992 $$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
6993 "\xd5\xd4\xd2\xc1",
6994 "\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"];
6995 $$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1",
6996 "\xd7\xc5\xde\xc5\xd2\xc1",
6997 "\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1",
6998 "\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"];
6999}
7000
7001sub _Date_Init_Turkish {
7002 print "DEBUG: _Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
7003 my($d)=@_;
7004
7005 $$d{"month_name"}=
7006 [
7007 ["ocak","subat","mart","nisan","mayis","haziran",
7008 "temmuz","agustos","eylul","ekim","kasim","aralik"],
7009 ["ocak","\xfeubat","mart","nisan","may\xfds","haziran",
7010 "temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"]
7011 ];
7012
7013 $$d{"month_abb"}=
7014 [
7015 ["oca","sub","mar","nis","may","haz",
7016 "tem","agu","eyl","eki","kas","ara"],
7017 ["oca","\xfeub","mar","nis","may","haz",
7018 "tem","a\xf0u","eyl","eki","kas","ara"]
7019 ];
7020
7021 $$d{"day_name"}=
7022 [
7023 ["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
7024 ["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
7025 "cumartesi","pazar"],
7026 ];
7027
7028 $$d{"day_abb"}=
7029 [
7030 ["pzt","sal","car","per","cum","cts","paz"],
7031 ["pzt","sal","\xe7ar","per","cum","cts","paz"],
7032 ];
7033
7034 $$d{"day_char"}=
7035 [["Pt","S","Cr","Pr","C","Ct","P"],
7036 ["Pt","S","\xc7","Pr","C","Ct","P"]];
7037
7038 $$d{"num_suff"}=
7039 [[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.",
7040 "11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.",
7041 "21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.",
7042 "31."]];
7043
7044 $$d{"num_word"}=
7045 [
7046 ["birinci","ikinci","ucuncu","dorduncu",
7047 "besinci","altinci","yedinci","sekizinci",
7048 "dokuzuncu","onuncu","onbirinci","onikinci",
7049 "onucuncu","ondordoncu",
7050 "onbesinci","onaltinci","onyedinci","onsekizinci",
7051 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
7052 "yirmiucuncu","yirmidorduncu",
7053 "yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci",
7054 "yirmidokuzuncu","otuzuncu","otuzbirinci"],
7055 ["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc",
7056 "be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci",
7057 "dokuzuncu","onuncu","onbirinci","onikinci",
7058 "on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc",
7059 "onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci",
7060 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
7061 "yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc",
7062 "yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci",
7063 "yirmidokuzuncu","otuzuncu","otuzbirinci"]
7064 ];
7065
7066 $$d{"now"} =["\xfeimdi", "simdi"];
7067 $$d{"today"} =["bugun", "bug\xfcn"];
7068 $$d{"last"} =["son", "sonuncu"];
7069 $$d{"each"} =["her"];
7070 $$d{"of"} =["of"];
7071 $$d{"at"} =["saat"];
7072 $$d{"on"} =["on"];
7073 $$d{"future"} =["gelecek"];
7074 $$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
7075 $$d{"next"} =["gelecek","sonraki"];
7076 $$d{"prev"} =["onceki","\xf6nceki"];
7077 $$d{"later"} =["sonra"];
7078
7079 $$d{"exact"} =["tam"];
7080 $$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"];
7081 $$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"];
7082
7083 $$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0",
7084 "dun", "-0:0:0:1:0:0:0",
7085 "yar\xfdn","+0:0:0:1:0:0:0",
7086 "yarin","+0:0:0:1:0:0:0"];
7087
7088 $$d{"times"} =["\xf6\xf0len","12:00:00",
7089 "oglen","12:00:00",
7090 "yarim","12:300:00",
7091 "yar\xfdm","12:30:00",
7092 "gece yar\xfds\xfd","00:00:00",
7093 "gece yarisi","00:00:00"];
7094
7095 $$d{"years"} =["yil","y"];
7096 $$d{"months"} =["ay","a"];
7097 $$d{"weeks"} =["hafta", "h"];
7098 $$d{"days"} =["gun","g"];
7099 $$d{"hours"} =["saat"];
7100 $$d{"minutes"} =["dakika","dak","d"];
7101 $$d{"seconds"} =["saniye","sn",];
7102 $$d{"replace"} =["s","saat"];
7103
7104 $$d{"sephm"} =':';
7105 $$d{"sepms"} =':';
7106 $$d{"sepss"} ='[.:,]';
7107
7108 $$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
7109 $$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
7110}
7111
7112sub _Date_Init_Danish {
7113 print "DEBUG: _Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
7114 my($d)=@_;
7115
7116 $$d{"month_name"}=
7117 [["Januar","Februar","Marts","April","Maj","Juni",
7118 "Juli","August","September","Oktober","November","December"]];
7119 $$d{"month_abb"}=
7120 [["Jan","Feb","Mar","Apr","Maj","Jun",
7121 "Jul","Aug","Sep","Okt","Nov","Dec"]];
7122
7123 $$d{"day_name"}=
7124 [["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
7125 ["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
7126
7127 $$d{"day_abb"}=
7128 [["Man","Tir","Ons","Tor","Fre","Lor","Son"],
7129 ["Man","Tir","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
7130 $$d{"day_char"}=
7131 [["M","Ti","O","To","F","L","S"]];
7132
7133 $$d{"num_suff"}=
7134 [["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
7135 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
7136 "21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
7137 "31:e"]];
7138 $$d{"num_word"}=
7139 [["forste","anden","tredie","fjerde","femte","sjette","syvende",
7140 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7141 "femtende","sekstende","syttende","attende","nittende","tyvende",
7142 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7143 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7144 "tredivte","enogtredivte"],
7145 ["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende",
7146 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7147 "femtende","sekstende","syttende","attende","nittende","tyvende",
7148 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7149 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7150 "tredivte","enogtredivte"]];
7151
7152 $$d{"now"} =["nu"];
7153 $$d{"today"} =["idag"];
7154 $$d{"last"} =["forrige","sidste","nyeste"];
7155 $$d{"each"} =["hver"];
7156 $$d{"of"} =["om"];
7157 $$d{"at"} =["kl","kl.","klokken"];
7158 $$d{"on"} =["pa","p\xe5"];
7159 $$d{"future"} =["om"];
7160 $$d{"past"} =["siden"];
7161 $$d{"next"} =["nasta","n\xe6ste"];
7162 $$d{"prev"} =["forrige"];
7163 $$d{"later"} =["senere"];
7164
7165 $$d{"exact"} =["pracist","pr\xe6cist"];
7166 $$d{"approx"} =["circa"];
7167 $$d{"business"}=["arbejdsdag","arbejdsdage"];
7168
7169 $$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
7170 "imorgen","+0:0:0:1:0:0:0"];
7171 $$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00",
7172 "midnat","00:00:00"];
7173
7174 $$d{"years"} =["ar","\xe5r"];
7175 $$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"];
7176 $$d{"weeks"} =["u","uge","uger"];
7177 $$d{"days"} =["d","dag","dage"];
7178 $$d{"hours"} =["t","tim","time","timer"];
7179 $$d{"minutes"} =["min","minut","minutter"];
7180 $$d{"seconds"} =["s","sek","sekund","sekunder"];
7181 $$d{"replace"} =["m","minut"];
7182
7183 $$d{"sephm"} ='[.:]';
7184 $$d{"sepms"} =':';
7185 $$d{"sepss"} ='[.:]';
7186
7187 $$d{"am"} = ["FM"];
7188 $$d{"pm"} = ["EM"];
7189}
7190
7191sub _Date_Init_Catalan {
7192 print "DEBUG: _Date_Init_Catalan\n" if ($Curr{"Debug"} =~ /trace/);
7193 my($d)=@_;
7194
7195 $$d{"month_name"}=
7196 [["Gener","Febrer","Marc","Abril","Maig","Juny",
7197 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7198 ["Gener","Febrer","Març","Abril","Maig","Juny",
7199 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7200 ["Gener","Febrer","Marc,","Abril","Maig","Juny",
7201 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"]];
7202
7203 $$d{"month_abb"}=
7204 [["Gen","Feb","Mar","Abr","Mai","Jun",
7205 "Jul","Ago","Set","Oct","Nov","Des"],
7206 [],
7207 ["","","","","","",
7208 "","","","","","Dec"] #common mistake
7209 ];
7210
7211 $$d{"day_name"}=
7212 [["Dilluns","Dimarts","Dimecres","Dijous","Divendres","Dissabte","Diumenge"]];
7213 $$d{"day_abb"}=
7214 [["Dll","Dmt","Dmc","Dij","Div","Dis","Diu"],
7215 ["","Dim","","","","",""],
7216 ["","","Dic","","","",""]
7217 ];
7218 $$d{"day_char"}=
7219 [["Dl","Dm","Dc","Dj","Dv","Ds","Du"] ,
7220 ["L","M","X","J","V","S","U"]];
7221
7222 $$d{"num_suff"}=
7223 [["1er","2n","3r","4t","5e","6e","7e","8e","9e","10e",
7224 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
7225 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
7226 "31e"],
7227 ["1er","2n","3r","4t","5è","6è","7è","8è","9è","10è",
7228 "11è","12è","13è","14è","15è","16è","17è","18è","19è","20è",
7229 "21è","22è","23è","24è","25è","26è","27è","28è","29è","30è",
7230 "31è"]];
7231 $$d{"num_word"}=
7232 [["primer","segon","tercer","quart","cinque","sise","sete","vuite",
7233 "nove","dese","onze","dotze","tretze","catorze",
7234 "quinze","setze","dissete","divuite","dinove",
7235 "vinte","vint-i-une","vint-i-dose","vint-i-trese",
7236 "vint-i-quatre","vint-i-cinque","vint-i-sise","vint-i-sete",
7237 "vint-i-vuite","vint-i-nove","trente","trenta-une"],
7238 ["primer","segon","tercer","quart","cinquè","sisè","setè","vuitè",
7239 "novè","desè","onzè","dotzè","tretzè","catorzè",
7240 "quinzè","setzè","dissetè","divuitè","dinovè",
7241 "vintè","vint-i-unè","vint-i-dosè","vint-i-tresè",
7242 "vint-i-quatrè","vint-i-cinquè","vint-i-sisè","vint-i-setè",
7243 "vint-i-vuitè","vint-i-novè","trentè","trenta-unè"]];
7244
7245 $$d{"now"} =["avui","ara"];
7246 $$d{"last"} =["darrer","últim","darrera","última"];
7247 $$d{"each"} =["cada","cadascun","cadascuna"];
7248 $$d{"of"} =["de","d'"];
7249 $$d{"at"} =["a les","a","al"];
7250 $$d{"on"} =["el"];
7251 $$d{"future"} =["d'aquí a"];
7252 $$d{"past"} =["fa"];
7253 $$d{"next"} =["proper"];
7254 $$d{"prev"} =["passat","proppassat","anterior"];
7255 $$d{"later"} =["més tard"];
7256
7257 $$d{"exact"} =["exactament"];
7258 $$d{"approx"} =["approximadament"];
7259 $$d{"business"}=["empresa"];
7260
7261 $$d{"offset"} =["ahir","-0:0:0:1:0:0:0","demà","+0:0:0:1:0:0:0","abans d'ahir","-0:0:0:2:0:0:0","demà passat","+0:0:0:2:0:0:0",];
7262 $$d{"times"} =["migdia","12:00:00","mitjanit","00:00:00"];
7263
7264 $$d{"years"} =["a","an","any","anys"];
7265 $$d{"months"} =["mes","me","ms"];
7266 $$d{"weeks"} =["se","set","setm","setmana","setmanes"];
7267 $$d{"days"} =["d","dia","dies"];
7268 $$d{"hours"} =["h","ho","hores","hora"];
7269 $$d{"minutes"} =["mn","min","minut","minuts"];
7270 $$d{"seconds"} =["s","seg","segon","segons"];
7271 $$d{"replace"} =["m","mes","s","setmana"];
7272
7273 $$d{"sephm"} =':';
7274 $$d{"sepms"} =':';
7275 $$d{"sepss"} ='[.:]';
7276
7277 $$d{"am"} = ["AM","A.M."];
7278 $$d{"pm"} = ["PM","P.M."];
7279}
7280
7281########################################################################
7282# FROM MY PERSONAL LIBRARIES
7283########################################################################
7284
728531.71ms572µsno integer;
# spent 23µs making 1 call to integer::unimport
7286
7287# _ModuloAddition($N,$add,\$val,\$rem);
7288# This calculates $val=$val+$add and forces $val to be in a certain range.
7289# This is useful for adding numbers for which only a certain range is
7290# allowed (for example, minutes can be between 0 and 59 or months can be
7291# between 1 and 12). The absolute value of $N determines the range and
7292# the sign of $N determines whether the range is 0 to N-1 (if N>0) or
7293# 1 to N (N<0). The remainder (as modulo N) is added to $rem.
7294# Example:
7295# To add 2 hours together (with the excess returned in days) use:
7296# _ModuloAddition(60,$s1,\$s,\$day);
7297sub _ModuloAddition {
7298 my($N,$add,$val,$rem)=@_;
7299 return if ($N==0);
7300 $$val+=$add;
7301 if ($N<0) {
7302 # 1 to N
7303 $N = -$N;
7304 if ($$val>$N) {
7305 $$rem+= int(($$val-1)/$N);
7306 $$val = ($$val-1)%$N +1;
7307 } elsif ($$val<1) {
7308 $$rem-= int(-$$val/$N)+1;
7309 $$val = $N-(-$$val % $N);
7310 }
7311
7312 } else {
7313 # 0 to N-1
7314 if ($$val>($N-1)) {
7315 $$rem+= int($$val/$N);
7316 $$val = $$val%$N;
7317 } elsif ($$val<0) {
7318 $$rem-= int(-($$val+1)/$N)+1;
7319 $$val = ($N-1)-(-($$val+1)%$N);
7320 }
7321 }
7322}
7323
7324# $Flag=_IsInt($String [,$low, $high]);
7325# Returns 1 if $String is a valid integer, 0 otherwise. If $low is
7326# entered, $String must be >= $low. If $high is entered, $String must
7327# be <= $high. It is valid to check only one of the bounds.
7328sub _IsInt {
7329 my($N,$low,$high)=@_;
7330 return 0 if (! defined $N or
7331 $N !~ /^\s*[-+]?\d+\s*$/ or
7332 defined $low && $N<$low or
7333 defined $high && $N>$high);
7334 return 1;
7335}
7336
7337# $File=_CleanFile($file);
7338# This cleans up a path to remove the following things:
7339# double slash /a//b -> /a/b
7340# trailing dot /a/. -> /a
7341# leading dot ./a -> a
7342# trailing slash a/ -> a
7343sub _CleanFile {
7344 my($file)=@_;
7345 $file =~ s/\s*$//;
7346 $file =~ s/^\s*//;
7347 $file =~ s|//+|/|g; # multiple slash
7348 $file =~ s|/\.$|/|; # trailing /. (leaves trailing slash)
7349 $file =~ s|^\./|| # leading ./
7350 if ($file ne "./");
7351 $file =~ s|/$|| # trailing slash
7352 if ($file ne "/");
7353 return $file;
7354}
7355
7356# $File=_ExpandTilde($file);
7357# This checks to see if a "~" appears as the first character in a path.
7358# If it does, the "~" expansion is interpreted (if possible) and the full
7359# path is returned. If a "~" expansion is used but cannot be
7360# interpreted, an empty string is returned.
7361#
7362# This is Windows/Mac friendly.
7363# This is efficient.
7364sub _ExpandTilde {
7365 my($file)=shift;
7366 my($user,$home)=();
7367 # ~aaa/bbb= ~ aaa /bbb
7368 if ($file =~ s|^~([^/]*)||) {
7369 $user=$1;
7370 # Single user operating systems (Mac, MSWindows) don't have the getpwnam
7371 # and getpwuid routines defined. Try to catch various different ways
7372 # of knowing we are on one of these systems:
7373 return "" if ($OS eq "Windows" or
7374 $OS eq "Mac" or
7375 $OS eq "Netware" or
7376 $OS eq "MPE");
7377 $user="" if (! defined $user);
7378
7379 if ($user) {
7380 $home= (getpwnam($user))[7];
7381 } else {
7382 $home= (getpwuid($<))[7];
7383 }
7384 $home = VMS::Filespec::unixpath($home) if ($OS eq "VMS");
7385 return "" if (! $home);
7386 $file="$home/$file";
7387 }
7388 $file;
7389}
7390
7391# $File=_FullFilePath($file);
7392# Returns the full or relative path to $file (expanding "~" if necessary).
7393# Returns an empty string if a "~" expansion cannot be interpreted. The
7394# path does not need to exist. _CleanFile is called.
7395sub _FullFilePath {
7396 my($file)=shift;
7397 my($rootpat) = '^/'; #default pattern to match absolute path
7398 $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
7399 $file=_ExpandTilde($file);
7400 return "" if (! $file);
7401 return _CleanFile($file);
7402}
7403
7404# $Flag=_CheckFilePath($file [,$mode]);
7405# Checks to see if $file exists, to see what type it is, and whether
7406# the script can access it. If it exists and has the correct mode, 1
7407# is returned.
7408#
7409# $mode is a string which may contain any of the valid file test operator
7410# characters except t, M, A, C. The appropriate test is run for each
7411# character. For example, if $mode is "re" the -r and -e tests are both
7412# run.
7413#
7414# An empty string is returned if the file doesn't exist. A 0 is returned
7415# if the file exists but any test fails.
7416#
7417# All characters in $mode which do not correspond to valid tests are
7418# ignored.
7419sub _CheckFilePath {
7420 my($file,$mode)=@_;
7421 my($test)=();
7422 $file=_FullFilePath($file);
7423 $mode = "" if (! defined $mode);
7424
7425 # Run tests
7426 return 0 if (! defined $file or ! $file);
7427 return 0 if (( ! -e $file) or
7428 ($mode =~ /r/ && ! -r $file) or
7429 ($mode =~ /w/ && ! -w $file) or
7430 ($mode =~ /x/ && ! -x $file) or
7431 ($mode =~ /R/ && ! -R $file) or
7432 ($mode =~ /W/ && ! -W $file) or
7433 ($mode =~ /X/ && ! -X $file) or
7434 ($mode =~ /o/ && ! -o $file) or
7435 ($mode =~ /O/ && ! -O $file) or
7436 ($mode =~ /z/ && ! -z $file) or
7437 ($mode =~ /s/ && ! -s $file) or
7438 ($mode =~ /f/ && ! -f $file) or
7439 ($mode =~ /d/ && ! -d $file) or
7440 ($mode =~ /l/ && ! -l $file) or
7441 ($mode =~ /s/ && ! -s $file) or
7442 ($mode =~ /p/ && ! -p $file) or
7443 ($mode =~ /b/ && ! -b $file) or
7444 ($mode =~ /c/ && ! -c $file) or
7445 ($mode =~ /u/ && ! -u $file) or
7446 ($mode =~ /g/ && ! -g $file) or
7447 ($mode =~ /k/ && ! -k $file) or
7448 ($mode =~ /T/ && ! -T $file) or
7449 ($mode =~ /B/ && ! -B $file));
7450 return 1;
7451}
7452#&&
7453
7454# $Path=_FixPath($path [,$full] [,$mode] [,$error]);
7455# Makes sure that every directory in $path (a colon separated list of
7456# directories) appears as a full path or relative path. All "~"
7457# expansions are removed. All trailing slashes are removed also. If
7458# $full is non-nil, relative paths are expanded to full paths as well.
7459#
7460# If $mode is given, it may be either "e", "r", or "w". In this case,
7461# additional checking is done to each directory. If $mode is "e", it
7462# need ony exist to pass the check. If $mode is "r", it must have have
7463# read and execute permission. If $mode is "w", it must have read,
7464# write, and execute permission.
7465#
7466# The value of $error determines what happens if the directory does not
7467# pass the test. If it is non-nil, if any directory does not pass the
7468# test, the subroutine returns the empty string. Otherwise, it is simply
7469# removed from $path.
7470#
7471# The corrected path is returned.
7472sub _FixPath {
7473 my($path,$full,$mode,$err)=@_;
7474 local($_)="";
7475 my(@dir)=split(/$Cnf{"PathSep"}/,$path);
7476 $full=0 if (! defined $full);
7477 $mode="" if (! defined $mode);
7478 $err=0 if (! defined $err);
7479 $path="";
7480 if ($mode eq "e") {
7481 $mode="de";
7482 } elsif ($mode eq "r") {
7483 $mode="derx";
7484 } elsif ($mode eq "w") {
7485 $mode="derwx";
7486 }
7487
7488 foreach (@dir) {
7489
7490 # Expand path
7491 if ($full) {
7492 $_=_FullFilePath($_);
7493 } else {
7494 $_=_ExpandTilde($_);
7495 }
7496 if (! $_) {
7497 return "" if ($err);
7498 next;
7499 }
7500
7501 # Check mode
7502 if (! $mode or _CheckFilePath($_,$mode)) {
7503 $path .= $Cnf{"PathSep"} . $_;
7504 } else {
7505 return "" if ($err);
7506 }
7507 }
7508 $path =~ s/^$Cnf{"PathSep"}//;
7509 return $path;
7510}
7511#&&
7512
7513# $File=_SearchPath($file,$path [,$mode] [,@suffixes]);
7514# Searches through directories in $path for a file named $file. The
7515# full path is returned if one is found, or an empty string otherwise.
7516# The file may exist with one of the @suffixes. The mode is checked
7517# similar to _CheckFilePath.
7518#
7519# The first full path that matches the name and mode is returned. If none
7520# is found, an empty string is returned.
7521sub _SearchPath {
7522 my($file,$path,$mode,@suff)=@_;
7523 my($f,$s,$d,@dir,$fs)=();
7524 $path=_FixPath($path,1,"r");
7525 @dir=split(/$Cnf{"PathSep"}/,$path);
7526 foreach $d (@dir) {
7527 $f="$d/$file";
7528 $f=~ s|//|/|g;
7529 return $f if (_CheckFilePath($f,$mode));
7530 foreach $s (@suff) {
7531 $fs="$f.$s";
7532 return $fs if (_CheckFilePath($fs,$mode));
7533 }
7534 }
7535 return "";
7536}
7537
7538# @list=_ReturnList($str);
7539# This takes a string which should be a comma separated list of integers
7540# or ranges (5-7). It returns a sorted list of all integers referred to
7541# by the string, or () if there is an invalid element.
7542#
7543# Negative integers are also handled. "-2--1" is equivalent to "-2,-1".
7544sub _ReturnList {
7545 my($str)=@_;
7546 my(@ret,@str,$from,$to,$tmp)=();
7547 @str=split(/,/,$str);
7548 foreach $str (@str) {
7549 if ($str =~ /^[-+]?\d+$/) {
7550 push(@ret,$str);
7551 } elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {
7552 ($from,$to)=($1,$2);
7553 if ($from>$to) {
7554 $tmp=$from;
7555 $from=$to;
7556 $to=$tmp;
7557 }
7558 push(@ret,$from..$to);
7559 } else {
7560 return ();
7561 }
7562 }
7563 @ret;
7564}
7565
7566171µs71µs1;
7567# Local Variables:
7568# mode: cperl
7569# indent-tabs-mode: nil
7570# cperl-indent-level: 3
7571# cperl-continued-statement-offset: 2
7572# cperl-continued-brace-offset: 0
7573# cperl-brace-offset: 0
7574# cperl-brace-imaginary-offset: 0
7575# cperl-label-offset: -2
7576# End:
Report produced by the NYTProf 2.10 Perl profiler, developed by Tim Bunce and Adam Kaplan.