1 | package Date::Manip;
|
---|
2 | # Copyright (c) 1995-2010 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 |
|
---|
9 | use warnings;
|
---|
10 |
|
---|
11 | use vars qw($OS %Lang %Holiday %Events %Curr %Cnf %Zone $VERSION @ISA @EXPORT);
|
---|
12 |
|
---|
13 | # Determine the type of OS...
|
---|
14 | $OS="Unix";
|
---|
15 | $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));
|
---|
23 | $OS="Unix" if (defined $^O and
|
---|
24 | $^O =~ /cygwin/i);
|
---|
25 | $OS="Netware" if (defined $^O and
|
---|
26 | $^O =~ /NetWare/i);
|
---|
27 | $OS="Mac" if ((defined $^O and
|
---|
28 | $^O =~ /MacOS/i) ||
|
---|
29 | (defined $ENV{OS} and
|
---|
30 | $ENV{OS} =~ /MacOS/i));
|
---|
31 | $OS="MPE" if (defined $^O and
|
---|
32 | $^O =~ /MPE/i);
|
---|
33 | $OS="OS2" if (defined $^O and
|
---|
34 | $^O =~ /os2/i);
|
---|
35 | $OS="VMS" if (defined $^O and
|
---|
36 | $^O =~ /VMS/i);
|
---|
37 | $OS="AIX" if (defined $^O and
|
---|
38 | $^O =~ /aix/i);
|
---|
39 |
|
---|
40 | # Determine if we're doing taint checking
|
---|
41 | #if ($] < 5.0080) {
|
---|
42 | $Date::Manip::NoTaint = eval { local $^W=0; eval("#" . substr($^X, 0, 0)); 1 };
|
---|
43 | #} else {
|
---|
44 | # $Date::Manip::NoTaint = (${^TAINT} == 0 ? 1 : 0);
|
---|
45 | #}
|
---|
46 |
|
---|
47 | ###########################################################################
|
---|
48 | # CUSTOMIZATION
|
---|
49 | ###########################################################################
|
---|
50 | #
|
---|
51 | # See the section of the POD documentation section CUSTOMIZING DATE::MANIP
|
---|
52 | # below for a complete description of each of these variables.
|
---|
53 |
|
---|
54 |
|
---|
55 | # Location of a the global config file. Tilde (~) expansions are allowed.
|
---|
56 | # This should be set in Date_Init arguments.
|
---|
57 | $Cnf{"GlobalCnf"}="";
|
---|
58 | $Cnf{"IgnoreGlobalCnf"}="";
|
---|
59 |
|
---|
60 | # Name of a personal config file and the path to search for it. Tilde (~)
|
---|
61 | # expansions are allowed. This should be set in Date_Init arguments or in
|
---|
62 | # the global config file.
|
---|
63 |
|
---|
64 | @Date::Manip::DatePath=();
|
---|
65 | if ($OS eq "Windows") {
|
---|
66 | $Cnf{"PathSep"} = ";";
|
---|
67 | $Cnf{"PersonalCnf"} = "Manip.cnf";
|
---|
68 | $Cnf{"PersonalCnfPath"} = ".";
|
---|
69 |
|
---|
70 | } elsif ($OS eq "Netware") {
|
---|
71 | $Cnf{"PathSep"} = ";";
|
---|
72 | $Cnf{"PersonalCnf"} = "Manip.cnf";
|
---|
73 | $Cnf{"PersonalCnfPath"} = ".";
|
---|
74 |
|
---|
75 | } elsif ($OS eq "MPE") {
|
---|
76 | $Cnf{"PathSep"} = ":";
|
---|
77 | $Cnf{"PersonalCnf"} = "Manip.cnf";
|
---|
78 | $Cnf{"PersonalCnfPath"} = ".";
|
---|
79 |
|
---|
80 | } elsif ($OS eq "OS2") {
|
---|
81 | $Cnf{"PathSep"} = ":";
|
---|
82 | $Cnf{"PersonalCnf"} = "Manip.cnf";
|
---|
83 | $Cnf{"PersonalCnfPath"} = ".";
|
---|
84 |
|
---|
85 | } elsif ($OS eq "Mac") {
|
---|
86 | $Cnf{"PathSep"} = ":";
|
---|
87 | $Cnf{"PersonalCnf"} = "Manip.cnf";
|
---|
88 | $Cnf{"PersonalCnfPath"} = ".";
|
---|
89 |
|
---|
90 | } elsif ($OS eq "VMS") {
|
---|
91 | # VMS doesn't like files starting with "."
|
---|
92 | $Cnf{"PathSep"} = ",";
|
---|
93 | $Cnf{"PersonalCnf"} = "Manip.cnf";
|
---|
94 | $Cnf{"PersonalCnfPath"} = "/sys\$login";
|
---|
95 |
|
---|
96 | } else {
|
---|
97 | # Unix
|
---|
98 | $Cnf{"PathSep"} = ":";
|
---|
99 | $Cnf{"PersonalCnf"} = ".DateManip.cnf";
|
---|
100 | $Cnf{"PersonalCnfPath"} = ".:~";
|
---|
101 | @Date::Manip::DatePath=qw(/bin /usr/bin /usr/local/bin);
|
---|
102 | }
|
---|
103 |
|
---|
104 | ### Date::Manip variables set in the global or personal config file
|
---|
105 |
|
---|
106 | # Which language to use when parsing dates.
|
---|
107 | $Cnf{"Language"}="English";
|
---|
108 |
|
---|
109 | # 12/10 = Dec 10 (US) or Oct 12 (anything else)
|
---|
110 | $Cnf{"DateFormat"}="US";
|
---|
111 |
|
---|
112 | # Local timezone
|
---|
113 | $Cnf{"TZ"}="";
|
---|
114 |
|
---|
115 | # Timezone to work in (""=local, "IGNORE", or a timezone)
|
---|
116 | $Cnf{"ConvTZ"}="";
|
---|
117 |
|
---|
118 | # Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
|
---|
119 | $Cnf{"Internal"}=0;
|
---|
120 |
|
---|
121 | # First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
|
---|
122 | $Cnf{"FirstDay"}=1;
|
---|
123 |
|
---|
124 | # First and last day of the work week (1=monday, 7=sunday)
|
---|
125 | $Cnf{"WorkWeekBeg"}=1;
|
---|
126 | $Cnf{"WorkWeekEnd"}=5;
|
---|
127 |
|
---|
128 | # If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
|
---|
129 | # ignored)
|
---|
130 | $Cnf{"WorkDay24Hr"}=0;
|
---|
131 |
|
---|
132 | # Start and end time of the work day (any time format allowed, seconds
|
---|
133 | # ignored)
|
---|
134 | $Cnf{"WorkDayBeg"}="08:00";
|
---|
135 | $Cnf{"WorkDayEnd"}="17:00";
|
---|
136 |
|
---|
137 | # If "today" is a holiday, we look either to "tomorrow" or "yesterday" for
|
---|
138 | # the nearest business day. By default, we'll always look "tomorrow"
|
---|
139 | # first.
|
---|
140 | $Cnf{"TomorrowFirst"}=1;
|
---|
141 |
|
---|
142 | # Erase the old holidays
|
---|
143 | $Cnf{"EraseHolidays"}="";
|
---|
144 |
|
---|
145 | # Set this to non-zero to be produce completely backwards compatible deltas
|
---|
146 | $Cnf{"DeltaSigns"}=0;
|
---|
147 |
|
---|
148 | # If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
|
---|
149 | # make week 1 contain Jan 1.
|
---|
150 | $Cnf{"Jan1Week1"}=0;
|
---|
151 |
|
---|
152 | # 2 digit years fall into the 100 year period given by [ CURR-N,
|
---|
153 | # CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful
|
---|
154 | # numbers might be 0 (forced to be this year or later) and 99 (forced to be
|
---|
155 | # this year or earlier). It can also be set to "c" (current century) or
|
---|
156 | # "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the
|
---|
157 | # form cNNNN to give the 100 year period NNNN to NNNN+99.
|
---|
158 | $Cnf{"YYtoYYYY"}=89;
|
---|
159 |
|
---|
160 | # Set this to 1 if you want a long-running script to always update the
|
---|
161 | # timezone. This will slow Date::Manip down. Read the POD documentation.
|
---|
162 | $Cnf{"UpdateCurrTZ"}=0;
|
---|
163 |
|
---|
164 | # Use an international character set.
|
---|
165 | $Cnf{"IntCharSet"}=0;
|
---|
166 |
|
---|
167 | # Use this to force the current date to be set to this:
|
---|
168 | $Cnf{"ForceDate"}="";
|
---|
169 |
|
---|
170 | # Use this to make "today" mean "today at midnight".
|
---|
171 | $Cnf{"TodayIsMidnight"}=0;
|
---|
172 |
|
---|
173 | ###########################################################################
|
---|
174 |
|
---|
175 | require 5.000;
|
---|
176 | require Exporter;
|
---|
177 | @ISA = qw(Exporter);
|
---|
178 | @EXPORT = qw(
|
---|
179 | DateManipVersion
|
---|
180 | Date_Init
|
---|
181 | ParseDateString
|
---|
182 | ParseDate
|
---|
183 | ParseRecur
|
---|
184 | Date_Cmp
|
---|
185 | DateCalc
|
---|
186 | ParseDateDelta
|
---|
187 | UnixDate
|
---|
188 | Delta_Format
|
---|
189 | Date_GetPrev
|
---|
190 | Date_GetNext
|
---|
191 | Date_SetTime
|
---|
192 | Date_SetDateField
|
---|
193 | Date_IsHoliday
|
---|
194 | Events_List
|
---|
195 |
|
---|
196 | Date_DaysInMonth
|
---|
197 | Date_DayOfWeek
|
---|
198 | Date_SecsSince1970
|
---|
199 | Date_SecsSince1970GMT
|
---|
200 | Date_DaysSince1BC
|
---|
201 | Date_DayOfYear
|
---|
202 | Date_DaysInYear
|
---|
203 | Date_WeekOfYear
|
---|
204 | Date_LeapYear
|
---|
205 | Date_DaySuffix
|
---|
206 | Date_ConvTZ
|
---|
207 | Date_TimeZone
|
---|
208 | Date_IsWorkDay
|
---|
209 | Date_NextWorkDay
|
---|
210 | Date_PrevWorkDay
|
---|
211 | Date_NearestWorkDay
|
---|
212 | Date_NthDayOfYear
|
---|
213 | );
|
---|
214 | use strict;
|
---|
215 | use integer;
|
---|
216 | use Carp;
|
---|
217 |
|
---|
218 | use IO::File;
|
---|
219 |
|
---|
220 | use vars qw($Abbrevs);
|
---|
221 | use Date::Manip::DM5abbrevs;
|
---|
222 |
|
---|
223 | $VERSION="5.55";
|
---|
224 |
|
---|
225 | ########################################################################
|
---|
226 | ########################################################################
|
---|
227 |
|
---|
228 | $Curr{"InitLang"} = 1; # Whether a language is being init'ed
|
---|
229 | $Curr{"InitDone"} = 0; # Whether Init_Date has been called
|
---|
230 | $Curr{"InitFilesRead"} = 0;
|
---|
231 | $Curr{"ResetWorkDay"} = 1;
|
---|
232 | $Curr{"Debug"} = "";
|
---|
233 | $Curr{"DebugVal"} = "";
|
---|
234 |
|
---|
235 | $Holiday{"year"} = 0;
|
---|
236 | $Holiday{"dates"} = {};
|
---|
237 | $Holiday{"desc"} = {};
|
---|
238 |
|
---|
239 | $Events{"raw"} = [];
|
---|
240 | $Events{"parsed"} = 0;
|
---|
241 | $Events{"dates"} = [];
|
---|
242 | $Events{"recur"} = [];
|
---|
243 |
|
---|
244 | ########################################################################
|
---|
245 | ########################################################################
|
---|
246 | # THESE ARE THE MAIN ROUTINES
|
---|
247 | ########################################################################
|
---|
248 | ########################################################################
|
---|
249 |
|
---|
250 | # Get rid of a problem with old versions of perl
|
---|
251 | no strict "vars";
|
---|
252 | # This sorts from longest to shortest element
|
---|
253 | sub _sortByLength {
|
---|
254 | return (length $b <=> length $a);
|
---|
255 | }
|
---|
256 | use strict "vars";
|
---|
257 |
|
---|
258 | sub DateManipVersion {
|
---|
259 | print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
260 | return $VERSION;
|
---|
261 | }
|
---|
262 |
|
---|
263 | sub Date_Init {
|
---|
264 | print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
265 | $Curr{"Debug"}="";
|
---|
266 |
|
---|
267 | my(@args)=@_;
|
---|
268 | $Curr{"InitDone"}=1;
|
---|
269 | local($_)=();
|
---|
270 | my($internal,$firstday)=();
|
---|
271 | my($var,$val,$file,@tmp)=();
|
---|
272 |
|
---|
273 | # InitFilesRead = 0 : no conf files read yet
|
---|
274 | # 1 : global read, no personal read
|
---|
275 | # 2 : personal read
|
---|
276 |
|
---|
277 | $Cnf{"EraseHolidays"}=0;
|
---|
278 | foreach (@args) {
|
---|
279 | s/\s*$//;
|
---|
280 | s/^\s*//;
|
---|
281 | /^(\S+) \s* = \s* (.*)$/x;
|
---|
282 | ($var,$val)=($1,$2);
|
---|
283 | if ($var =~ /^GlobalCnf$/i) {
|
---|
284 | $Cnf{"GlobalCnf"}=$val;
|
---|
285 | if ($val) {
|
---|
286 | $Curr{"InitFilesRead"}=0;
|
---|
287 | EraseHolidays();
|
---|
288 | }
|
---|
289 | } elsif ($var =~ /^PathSep$/i) {
|
---|
290 | $Cnf{"PathSep"}=$val;
|
---|
291 | } elsif ($var =~ /^PersonalCnf$/i) {
|
---|
292 | $Cnf{"PersonalCnf"}=$val;
|
---|
293 | $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
|
---|
294 | } elsif ($var =~ /^PersonalCnfPath$/i) {
|
---|
295 | $Cnf{"PersonalCnfPath"}=$val;
|
---|
296 | $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
|
---|
297 | } elsif ($var =~ /^IgnoreGlobalCnf$/i) {
|
---|
298 | $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0);
|
---|
299 | $Cnf{"IgnoreGlobalCnf"}=1;
|
---|
300 | } elsif ($var =~ /^EraseHolidays$/i) {
|
---|
301 | EraseHolidays();
|
---|
302 | } else {
|
---|
303 | push(@tmp,$_);
|
---|
304 | }
|
---|
305 | }
|
---|
306 | @args=@tmp;
|
---|
307 |
|
---|
308 | # Read global config file
|
---|
309 | if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
|
---|
310 | $Curr{"InitFilesRead"}=1;
|
---|
311 |
|
---|
312 | if ($Cnf{"GlobalCnf"}) {
|
---|
313 | $file=_ExpandTilde($Cnf{"GlobalCnf"});
|
---|
314 | _Date_InitFile($file) if ($file);
|
---|
315 | }
|
---|
316 | }
|
---|
317 |
|
---|
318 | # Read personal config file
|
---|
319 | if ($Curr{"InitFilesRead"}<2) {
|
---|
320 | $Curr{"InitFilesRead"}=2;
|
---|
321 |
|
---|
322 | if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) {
|
---|
323 | $file=_SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r");
|
---|
324 | _Date_InitFile($file) if ($file);
|
---|
325 | }
|
---|
326 | }
|
---|
327 |
|
---|
328 | foreach (@args) {
|
---|
329 | s/\s*$//;
|
---|
330 | s/^\s*//;
|
---|
331 | /^(\S+) \s* = \s* (.*)$/x;
|
---|
332 | ($var,$val)=($1,$2);
|
---|
333 | $val="" if (! defined $val);
|
---|
334 | _Date_SetConfigVariable($var,$val);
|
---|
335 | }
|
---|
336 |
|
---|
337 | confess "ERROR: Unknown FirstDay in Date::Manip.\n"
|
---|
338 | if (! _IsInt($Cnf{"FirstDay"},1,7));
|
---|
339 | confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n"
|
---|
340 | if (! _IsInt($Cnf{"WorkWeekBeg"},1,7));
|
---|
341 | confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n"
|
---|
342 | if (! _IsInt($Cnf{"WorkWeekEnd"},1,7));
|
---|
343 | confess "ERROR: Invalid WorkWeek in Date::Manip.\n"
|
---|
344 | if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"});
|
---|
345 |
|
---|
346 | my(%lang,
|
---|
347 | $tmp,%tmp,$tmp2,@tmp2,
|
---|
348 | $i,$j,@tmp3,
|
---|
349 | @zones)=();
|
---|
350 |
|
---|
351 | my($L)=$Cnf{"Language"};
|
---|
352 |
|
---|
353 | if ($Curr{"InitLang"}) {
|
---|
354 | $Curr{"InitLang"}=0;
|
---|
355 |
|
---|
356 | if ($L eq "English") {
|
---|
357 | _Date_Init_English(\%lang);
|
---|
358 |
|
---|
359 | } elsif ($L eq "French") {
|
---|
360 | _Date_Init_French(\%lang);
|
---|
361 |
|
---|
362 | } elsif ($L eq "Swedish") {
|
---|
363 | _Date_Init_Swedish(\%lang);
|
---|
364 |
|
---|
365 | } elsif ($L eq "German") {
|
---|
366 | _Date_Init_German(\%lang);
|
---|
367 |
|
---|
368 | } elsif ($L eq "Polish") {
|
---|
369 | _Date_Init_Polish(\%lang);
|
---|
370 |
|
---|
371 | } elsif ($L eq "Dutch" ||
|
---|
372 | $L eq "Nederlands") {
|
---|
373 | _Date_Init_Dutch(\%lang);
|
---|
374 |
|
---|
375 | } elsif ($L eq "Spanish") {
|
---|
376 | _Date_Init_Spanish(\%lang);
|
---|
377 |
|
---|
378 | } elsif ($L eq "Portuguese") {
|
---|
379 | _Date_Init_Portuguese(\%lang);
|
---|
380 |
|
---|
381 | } elsif ($L eq "Romanian") {
|
---|
382 | _Date_Init_Romanian(\%lang);
|
---|
383 |
|
---|
384 | } elsif ($L eq "Italian") {
|
---|
385 | _Date_Init_Italian(\%lang);
|
---|
386 |
|
---|
387 | } elsif ($L eq "Russian") {
|
---|
388 | _Date_Init_Russian(\%lang);
|
---|
389 |
|
---|
390 | } elsif ($L eq "Turkish") {
|
---|
391 | _Date_Init_Turkish(\%lang);
|
---|
392 |
|
---|
393 | } elsif ($L eq "Danish") {
|
---|
394 | _Date_Init_Danish(\%lang);
|
---|
395 |
|
---|
396 | } elsif ($L eq "Catalan") {
|
---|
397 | _Date_Init_Catalan(\%lang);
|
---|
398 |
|
---|
399 | } else {
|
---|
400 | confess "ERROR: Unknown language in Date::Manip.\n";
|
---|
401 | }
|
---|
402 |
|
---|
403 | # variables for months
|
---|
404 | # Month = "(jan|january|feb|february ... )"
|
---|
405 | # MonL = [ "Jan","Feb",... ]
|
---|
406 | # MonthL = [ "January","February", ... ]
|
---|
407 | # MonthH = { "january"=>1, "jan"=>1, ... }
|
---|
408 |
|
---|
409 | $Lang{$L}{"MonthH"}={};
|
---|
410 | $Lang{$L}{"MonthL"}=[];
|
---|
411 | $Lang{$L}{"MonL"}=[];
|
---|
412 | _Date_InitLists([$lang{"month_name"},
|
---|
413 | $lang{"month_abb"}],
|
---|
414 | \$Lang{$L}{"Month"},"lc,sort,back",
|
---|
415 | [$Lang{$L}{"MonthL"},
|
---|
416 | $Lang{$L}{"MonL"}],
|
---|
417 | [$Lang{$L}{"MonthH"},1]);
|
---|
418 |
|
---|
419 | # variables for day of week
|
---|
420 | # Week = "(mon|monday|tue|tuesday ... )"
|
---|
421 | # WL = [ "M","T",... ]
|
---|
422 | # WkL = [ "Mon","Tue",... ]
|
---|
423 | # WeekL = [ "Monday","Tudesday",... ]
|
---|
424 | # WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
|
---|
425 |
|
---|
426 | $Lang{$L}{"WeekH"}={};
|
---|
427 | $Lang{$L}{"WeekL"}=[];
|
---|
428 | $Lang{$L}{"WkL"}=[];
|
---|
429 | $Lang{$L}{"WL"}=[];
|
---|
430 | _Date_InitLists([$lang{"day_name"},
|
---|
431 | $lang{"day_abb"}],
|
---|
432 | \$Lang{$L}{"Week"},"lc,sort,back",
|
---|
433 | [$Lang{$L}{"WeekL"},
|
---|
434 | $Lang{$L}{"WkL"}],
|
---|
435 | [$Lang{$L}{"WeekH"},1]);
|
---|
436 | _Date_InitLists([$lang{"day_char"}],
|
---|
437 | "","lc",
|
---|
438 | [$Lang{$L}{"WL"}],
|
---|
439 | [\%tmp,1]);
|
---|
440 | %{ $Lang{$L}{"WeekH"} } =
|
---|
441 | (%{ $Lang{$L}{"WeekH"} },%tmp);
|
---|
442 |
|
---|
443 | # variables for last
|
---|
444 | # Last = "(last)"
|
---|
445 | # LastL = [ "last" ]
|
---|
446 | # Each = "(each)"
|
---|
447 | # EachL = [ "each" ]
|
---|
448 | # variables for day of month
|
---|
449 | # DoM = "(1st|first ... 31st)"
|
---|
450 | # DoML = [ "1st","2nd",... "31st" ]
|
---|
451 | # DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 }
|
---|
452 | # variables for week of month
|
---|
453 | # WoM = "(1st|first| ... 5th|last)"
|
---|
454 | # WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 }
|
---|
455 |
|
---|
456 | $Lang{$L}{"LastL"}=$lang{"last"};
|
---|
457 | _Date_InitStrings($lang{"last"},
|
---|
458 | \$Lang{$L}{"Last"},"lc,sort");
|
---|
459 |
|
---|
460 | $Lang{$L}{"EachL"}=$lang{"each"};
|
---|
461 | _Date_InitStrings($lang{"each"},
|
---|
462 | \$Lang{$L}{"Each"},"lc,sort");
|
---|
463 |
|
---|
464 | $Lang{$L}{"DoMH"}={};
|
---|
465 | $Lang{$L}{"DoML"}=[];
|
---|
466 | _Date_InitLists([$lang{"num_suff"},
|
---|
467 | $lang{"num_word"}],
|
---|
468 | \$Lang{$L}{"DoM"},"lc,sort,back,escape",
|
---|
469 | [$Lang{$L}{"DoML"},
|
---|
470 | \@tmp],
|
---|
471 | [$Lang{$L}{"DoMH"},1]);
|
---|
472 |
|
---|
473 | @tmp=();
|
---|
474 | foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
|
---|
475 | $tmp2=$Lang{$L}{"DoMH"}{$tmp};
|
---|
476 | if ($tmp2<6) {
|
---|
477 | $Lang{$L}{"WoMH"}{$tmp} = $tmp2;
|
---|
478 | push(@tmp,$tmp);
|
---|
479 | }
|
---|
480 | }
|
---|
481 | foreach $tmp (@{ $Lang{$L}{"LastL"} }) {
|
---|
482 | $Lang{$L}{"WoMH"}{$tmp} = -1;
|
---|
483 | push(@tmp,$tmp);
|
---|
484 | }
|
---|
485 | _Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"},
|
---|
486 | "lc,sort,back,escape");
|
---|
487 |
|
---|
488 | # variables for AM or PM
|
---|
489 | # AM = "(am)"
|
---|
490 | # PM = "(pm)"
|
---|
491 | # AmPm = "(am|pm)"
|
---|
492 | # AMstr = "AM"
|
---|
493 | # PMstr = "PM"
|
---|
494 |
|
---|
495 | _Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape");
|
---|
496 | _Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape");
|
---|
497 | _Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"},
|
---|
498 | "lc,back,sort,escape");
|
---|
499 | $Lang{$L}{"AMstr"}=$lang{"am"}[0];
|
---|
500 | $Lang{$L}{"PMstr"}=$lang{"pm"}[0];
|
---|
501 |
|
---|
502 | # variables for expressions used in parsing deltas
|
---|
503 | # Yabb = "(?:y|yr|year|years)"
|
---|
504 | # Mabb = similar for months
|
---|
505 | # Wabb = similar for weeks
|
---|
506 | # Dabb = similar for days
|
---|
507 | # Habb = similar for hours
|
---|
508 | # MNabb = similar for minutes
|
---|
509 | # Sabb = similar for seconds
|
---|
510 | # Repl = { "abb"=>"replacement" }
|
---|
511 | # Whenever an abbreviation could potentially refer to two different
|
---|
512 | # strings (M standing for Minutes or Months), the abbreviation must
|
---|
513 | # be listed in Repl instead of in the appropriate Xabb values. This
|
---|
514 | # only applies to abbreviations which are substrings of other values
|
---|
515 | # (so there is no confusion between Mn and Month).
|
---|
516 |
|
---|
517 | _Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort");
|
---|
518 | _Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort");
|
---|
519 | _Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort");
|
---|
520 | _Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort");
|
---|
521 | _Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort");
|
---|
522 | _Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort");
|
---|
523 | _Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort");
|
---|
524 | $Lang{$L}{"Repl"}={};
|
---|
525 | _Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
|
---|
526 |
|
---|
527 | # variables for special dates that are offsets from now
|
---|
528 | # Now = "now"
|
---|
529 | # Today = "today"
|
---|
530 | # Offset = "(yesterday|tomorrow)"
|
---|
531 | # OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ]
|
---|
532 | # Times = "(noon|midnight)"
|
---|
533 | # TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" }
|
---|
534 | # SepHM = hour/minute separator
|
---|
535 | # SepMS = minute/second separator
|
---|
536 | # SepSS = second/fraction separator
|
---|
537 |
|
---|
538 | $Lang{$L}{"TimesH"}={};
|
---|
539 | _Date_InitHash($lang{"times"},
|
---|
540 | \$Lang{$L}{"Times"},"lc,sort,back",
|
---|
541 | $Lang{$L}{"TimesH"});
|
---|
542 | _Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort");
|
---|
543 | _Date_InitStrings($lang{"today"},\$Lang{$L}{"Today"},"lc,sort");
|
---|
544 | $Lang{$L}{"OffsetH"}={};
|
---|
545 | _Date_InitHash($lang{"offset"},
|
---|
546 | \$Lang{$L}{"Offset"},"lc,sort,back",
|
---|
547 | $Lang{$L}{"OffsetH"});
|
---|
548 | $Lang{$L}{"SepHM"}=$lang{"sephm"};
|
---|
549 | $Lang{$L}{"SepMS"}=$lang{"sepms"};
|
---|
550 | $Lang{$L}{"SepSS"}=$lang{"sepss"};
|
---|
551 |
|
---|
552 | # variables for time zones
|
---|
553 | # zones = regular expression with all zone names (EST)
|
---|
554 | # n2o = a hash of all parsable zone names with their offsets
|
---|
555 | # tzones = reguar expression with all tzdata timezones (US/Eastern)
|
---|
556 | # tz2z = hash of all tzdata timezones to full timezone (EST#EDT)
|
---|
557 |
|
---|
558 | $Zone{"n2o"} = {};
|
---|
559 | ($Zone{"zones"},%{ $Zone{"n2o"} })=
|
---|
560 | _Date_Regexp($Abbrevs,"sort,lc,under,back",
|
---|
561 | "keys");
|
---|
562 |
|
---|
563 | $tmp=
|
---|
564 | "US/Pacific PST8PDT ".
|
---|
565 | "US/Mountain MST7MDT ".
|
---|
566 | "US/Central CST6CDT ".
|
---|
567 | "US/Eastern EST5EDT ".
|
---|
568 | "Canada/Pacific PST8PDT ".
|
---|
569 | "Canada/Mountain MST7MDT ".
|
---|
570 | "Canada/Central CST6CDT ".
|
---|
571 | "Canada/Eastern EST5EDT";
|
---|
572 |
|
---|
573 | $Zone{"tz2z"} = {};
|
---|
574 | ($Zone{"tzones"},%{ $Zone{"tz2z"} })=
|
---|
575 | _Date_Regexp($tmp,"lc,under,back","keys");
|
---|
576 | $Cnf{"TZ"}=Date_TimeZone();
|
---|
577 |
|
---|
578 | # misc. variables
|
---|
579 | # At = "(?:at)"
|
---|
580 | # Of = "(?:in|of)"
|
---|
581 | # On = "(?:on)"
|
---|
582 | # Future = "(?:in)"
|
---|
583 | # Later = "(?:later)"
|
---|
584 | # Past = "(?:ago)"
|
---|
585 | # Next = "(?:next)"
|
---|
586 | # Prev = "(?:last|previous)"
|
---|
587 |
|
---|
588 | _Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort");
|
---|
589 | _Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort");
|
---|
590 | _Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort");
|
---|
591 | _Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort");
|
---|
592 | _Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort");
|
---|
593 | _Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort");
|
---|
594 | _Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort");
|
---|
595 | _Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort");
|
---|
596 |
|
---|
597 | # calc mode variables
|
---|
598 | # Approx = "(?:approximately)"
|
---|
599 | # Exact = "(?:exactly)"
|
---|
600 | # Business = "(?:business)"
|
---|
601 |
|
---|
602 | _Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort");
|
---|
603 | _Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort");
|
---|
604 | _Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort");
|
---|
605 |
|
---|
606 | ############### END OF LANGUAGE INITIALIZATION
|
---|
607 | }
|
---|
608 |
|
---|
609 | if ($Curr{"ResetWorkDay"}) {
|
---|
610 | my($h1,$m1,$h2,$m2)=();
|
---|
611 | if ($Cnf{"WorkDay24Hr"}) {
|
---|
612 | ($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
|
---|
613 | ($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
|
---|
614 | $Curr{"WDlen"}=24*60;
|
---|
615 | $Cnf{"WorkDayBeg"}="00:00";
|
---|
616 | $Cnf{"WorkDayEnd"}="23:59";
|
---|
617 |
|
---|
618 | } else {
|
---|
619 | confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n"
|
---|
620 | if (! (($h1,$m1)=_CheckTime($Cnf{"WorkDayBeg"})));
|
---|
621 | $Cnf{"WorkDayBeg"}="$h1:$m1";
|
---|
622 | confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n"
|
---|
623 | if (! (($h2,$m2)=_CheckTime($Cnf{"WorkDayEnd"})));
|
---|
624 | $Cnf{"WorkDayEnd"}="$h2:$m2";
|
---|
625 |
|
---|
626 | ($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
|
---|
627 | ($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
|
---|
628 |
|
---|
629 | # Work day length = h1:m1 or 0:len (len minutes)
|
---|
630 | $h1=$h2-$h1;
|
---|
631 | $m1=$m2-$m1;
|
---|
632 | if ($m1<0) {
|
---|
633 | $h1--;
|
---|
634 | $m1+=60;
|
---|
635 | }
|
---|
636 | $Curr{"WDlen"}=$h1*60+$m1;
|
---|
637 | }
|
---|
638 | $Curr{"ResetWorkDay"}=0;
|
---|
639 | }
|
---|
640 |
|
---|
641 | # current time
|
---|
642 | my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
|
---|
643 | if ($Cnf{"ForceDate"}=~
|
---|
644 | /^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
|
---|
645 | ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
|
---|
646 | } else {
|
---|
647 | ($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
|
---|
648 | $y+=1900;
|
---|
649 | $m++;
|
---|
650 | }
|
---|
651 | _Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
|
---|
652 | $Curr{"Y"}=$y;
|
---|
653 | $Curr{"M"}=$m;
|
---|
654 | $Curr{"D"}=$d;
|
---|
655 | $Curr{"H"}=$h;
|
---|
656 | $Curr{"Mn"}=$mn;
|
---|
657 | $Curr{"S"}=$s;
|
---|
658 | $Curr{"AmPm"}=$ampm;
|
---|
659 | $Curr{"Now"}=_Date_Join($y,$m,$d,$h,$mn,$s);
|
---|
660 | if ($Cnf{"TodayIsMidnight"}) {
|
---|
661 | $Curr{"Today"}=_Date_Join($y,$m,$d,0,0,0);
|
---|
662 | } else {
|
---|
663 | $Curr{"Today"}=$Curr{"Now"};
|
---|
664 | }
|
---|
665 |
|
---|
666 | $Curr{"Debug"}=$Curr{"DebugVal"};
|
---|
667 |
|
---|
668 | # If we're in array context, let's return a list of config variables
|
---|
669 | # that could be passed to Date_Init to get the same state as we're
|
---|
670 | # currently in.
|
---|
671 | if (wantarray) {
|
---|
672 | # Some special variables that have to be in a specific order
|
---|
673 | my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
|
---|
674 | my(%tmp)=map { $_,1 } @special;
|
---|
675 | my(@tmp,$key,$val);
|
---|
676 | foreach $key (@special) {
|
---|
677 | $val=$Cnf{$key};
|
---|
678 | push(@tmp,"$key=$val");
|
---|
679 | }
|
---|
680 | foreach $key (keys %Cnf) {
|
---|
681 | next if (exists $tmp{$key});
|
---|
682 | $val=$Cnf{$key};
|
---|
683 | push(@tmp,"$key=$val");
|
---|
684 | }
|
---|
685 | return @tmp;
|
---|
686 | }
|
---|
687 | return ();
|
---|
688 | }
|
---|
689 |
|
---|
690 | sub ParseDateString {
|
---|
691 | print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
692 | local($_)=@_;
|
---|
693 | return "" if (! $_);
|
---|
694 |
|
---|
695 | my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
|
---|
696 | my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
|
---|
697 |
|
---|
698 | # We only need to reinitialize if we have to determine what NOW is.
|
---|
699 | Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
|
---|
700 |
|
---|
701 | my($L)=$Cnf{"Language"};
|
---|
702 | my($type)=$Cnf{"DateFormat"};
|
---|
703 |
|
---|
704 | # Mode is set in DateCalc. ParseDate only overrides it if the string
|
---|
705 | # contains a mode.
|
---|
706 | if ($Lang{$L}{"Exact"} &&
|
---|
707 | s/$Lang{$L}{"Exact"}//) {
|
---|
708 | $Curr{"Mode"}=0;
|
---|
709 | } elsif ($Lang{$L}{"Approx"} &&
|
---|
710 | s/$Lang{$L}{"Approx"}//) {
|
---|
711 | $Curr{"Mode"}=1;
|
---|
712 | } elsif ($Lang{$L}{"Business"} &&
|
---|
713 | s/$Lang{$L}{"Business"}//) {
|
---|
714 | $Curr{"Mode"}=2;
|
---|
715 | } elsif (! exists $Curr{"Mode"}) {
|
---|
716 | $Curr{"Mode"}=0;
|
---|
717 | }
|
---|
718 |
|
---|
719 | # Unfortunately, some deltas can be parsed as dates. An example is
|
---|
720 | # 1 second == 1 2nd == 1 2
|
---|
721 | # But, some dates can be parsed as deltas. The most important being:
|
---|
722 | # 1998010101:00:00
|
---|
723 | #
|
---|
724 | # We'll check to see if a "date" can be parsed as a delta. If so, we'll
|
---|
725 | # assume that it is a delta (since they are much simpler, it is much
|
---|
726 | # less likely that we'll mistake a delta for a date than vice versa)
|
---|
727 | # unless it is an ISO-8601 date.
|
---|
728 | #
|
---|
729 | # This is important because we are using DateCalc to test whether a
|
---|
730 | # string is a date or a delta. Dates are tested first, so we need to
|
---|
731 | # be able to pass a delta into this routine and have it correctly NOT
|
---|
732 | # interpreted as a date.
|
---|
733 | #
|
---|
734 | # We will insist that the string contain something other than digits and
|
---|
735 | # colons so that the following will get correctly interpreted as a date
|
---|
736 | # rather than a delta:
|
---|
737 | # 12:30
|
---|
738 | # 19980101
|
---|
739 |
|
---|
740 | $delta="";
|
---|
741 | $delta=ParseDateDelta($_) if (/[^:0-9]/);
|
---|
742 |
|
---|
743 | # Put parse in a simple loop for an easy exit.
|
---|
744 | PARSE: {
|
---|
745 | my(@tmp)=_Date_Split($_);
|
---|
746 | if (@tmp) {
|
---|
747 | ($y,$m,$d,$h,$mn,$s)=@tmp;
|
---|
748 | last PARSE;
|
---|
749 | }
|
---|
750 |
|
---|
751 | # Fundamental regular expressions
|
---|
752 |
|
---|
753 | my($month)=$Lang{$L}{"Month"}; # (jan|january|...)
|
---|
754 | my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
|
---|
755 | my($week)=$Lang{$L}{"Week"}; # (mon|monday|...)
|
---|
756 | my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
|
---|
757 | my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last)
|
---|
758 | my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
|
---|
759 | my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st)
|
---|
760 | my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
|
---|
761 | my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm)
|
---|
762 | my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight)
|
---|
763 | my($now)=$Lang{$L}{"Now"}; # now
|
---|
764 | my($today)=$Lang{$L}{"Today"}; # today
|
---|
765 | my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow)
|
---|
766 | my($zone)=$Zone{"zones"}; # (edt|est|...)
|
---|
767 | my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days)
|
---|
768 | my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months)
|
---|
769 | my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks)
|
---|
770 | my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next)
|
---|
771 | my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous)
|
---|
772 | my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago)
|
---|
773 | my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in)
|
---|
774 | my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later)
|
---|
775 | my($at)=$Lang{$L}{"At"}; # (?:at)
|
---|
776 | my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of)
|
---|
777 | my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)';
|
---|
778 | # \s*(?:on)\s* or \s+
|
---|
779 | my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last)
|
---|
780 | my($hm)=$Lang{$L}{"SepHM"}; # :
|
---|
781 | my($ms)=$Lang{$L}{"SepMS"}; # :
|
---|
782 | my($ss)=$Lang{$L}{"SepSS"}; # .
|
---|
783 |
|
---|
784 | # Other regular expressions
|
---|
785 |
|
---|
786 | my($D4)='(\d{4})'; # 4 digits (yr)
|
---|
787 | my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr)
|
---|
788 | my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
|
---|
789 | my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
|
---|
790 | my($FS)="(?:$ss\\d+)?"; # fractional secs
|
---|
791 | my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
|
---|
792 | # absolute time zone +0700 (GMT)
|
---|
793 | my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23
|
---|
794 | my($mzone)='(?:[0-5][0-9])'; # 00 - 59
|
---|
795 | my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))".
|
---|
796 | # +0700 +07:00 -07
|
---|
797 | '(?:\s*\([^)]+\))?)'; # (GMT)
|
---|
798 |
|
---|
799 | # A regular expression for the time EXCEPT for the hour part
|
---|
800 | my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
|
---|
801 |
|
---|
802 | # A special regular expression for /YYYY:HH:MN:SS used by Apache
|
---|
803 | my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
|
---|
804 |
|
---|
805 | my($time)="";
|
---|
806 | $ampm="";
|
---|
807 | $date="";
|
---|
808 |
|
---|
809 | # Substitute all special time expressions.
|
---|
810 | if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
|
---|
811 | $tmp=$2;
|
---|
812 | $tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
|
---|
813 | s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
|
---|
814 | }
|
---|
815 |
|
---|
816 | # Remove some punctuation
|
---|
817 | s/[,]/ /g;
|
---|
818 |
|
---|
819 | # When we have a digit followed immediately by a timezone (7EST), we
|
---|
820 | # will put a space between the digit, EXCEPT in the case of a single
|
---|
821 | # character military timezone. If the single character is followed
|
---|
822 | # by anything, no space is added.
|
---|
823 | $tmp = "";
|
---|
824 | while ( s/^(.*?\d)$zone(\s|$|[0-9])/$3/i ) {
|
---|
825 | my($bef,$z,$aft) = ($1,$2,$3);
|
---|
826 | if (length($z) != 1 || length($aft) == 0) {
|
---|
827 | $tmp .= "$bef $z";
|
---|
828 | } else {
|
---|
829 | $tmp .= "$bef$z";
|
---|
830 | }
|
---|
831 | }
|
---|
832 | $_ = "$tmp$_";
|
---|
833 | $zone = '\s+' . $zone . '(?:\s+|$)';
|
---|
834 |
|
---|
835 | # Remove the time
|
---|
836 | $iso=1;
|
---|
837 | $midnight=0;
|
---|
838 | $from="24${hm}00(?:${ms}00)?";
|
---|
839 | $falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
|
---|
840 | $to="00${hm}00${ms}00";
|
---|
841 | $midnight=1 if (!/$falsefrom/ && s/$from/$to/);
|
---|
842 |
|
---|
843 | $h=$mn=$s=0;
|
---|
844 | if (/$D$mnsec/i || /$ampmexp/i) {
|
---|
845 | $iso=0;
|
---|
846 | $tmp=0;
|
---|
847 | $tmp=1 if (/$mnsec$zone2?\s*$/i or /$mnsec$zone\s*$/i);
|
---|
848 | $tmp=0 if (/$ampmexp/i);
|
---|
849 | if (s/$apachetime$zone()/$1 /i ||
|
---|
850 | s/$apachetime$zone2?/$1 /i ||
|
---|
851 | s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i ||
|
---|
852 | s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i ||
|
---|
853 | s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i ||
|
---|
854 | s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i ||
|
---|
855 | (s/(t)$D$mnsec$zone()/$1 /i and (($iso=$tmp) || 1)) ||
|
---|
856 | (s/(t)$D$mnsec$zone2?/$1 /i and (($iso=$tmp) || 1)) ||
|
---|
857 | (s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) ||
|
---|
858 | (s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) ||
|
---|
859 | s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i ||
|
---|
860 | s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i ||
|
---|
861 | 0
|
---|
862 | ) {
|
---|
863 | ($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
|
---|
864 | if (defined ($z)) {
|
---|
865 | if ($z =~ /^[+-]\d{2}:\d{2}$/) {
|
---|
866 | $z=~ s/://;
|
---|
867 | } elsif ($z =~ /^[+-]\d{2}$/) {
|
---|
868 | $z .= "00";
|
---|
869 | }
|
---|
870 | }
|
---|
871 | $time=1;
|
---|
872 | _Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
|
---|
873 | $y=$m=$d="";
|
---|
874 | # We're going to be calling TimeCheck again below (when we check the
|
---|
875 | # final date), so get rid of $ampm so that we don't have an error
|
---|
876 | # due to "15:30:00 PM". It'll get reset below.
|
---|
877 | $ampm="";
|
---|
878 | if (/^\s*$/) {
|
---|
879 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
880 | last PARSE;
|
---|
881 | }
|
---|
882 | }
|
---|
883 | }
|
---|
884 | $time=0 if ($time ne "1");
|
---|
885 | s/\s+$//;
|
---|
886 | s/^\s+//;
|
---|
887 |
|
---|
888 | # if a zone was found, get rid of the regexps
|
---|
889 | if ($z) {
|
---|
890 | $zone="";
|
---|
891 | $zone2="";
|
---|
892 | }
|
---|
893 |
|
---|
894 | # dateTtime ISO 8601 formats
|
---|
895 | my($orig)=$_;
|
---|
896 |
|
---|
897 | # Parse ISO 8601 dates now (which may still have a zone stuck to it).
|
---|
898 | if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) ||
|
---|
899 | ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) ||
|
---|
900 | ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) ||
|
---|
901 | ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) ||
|
---|
902 | ($iso && /^([0-9-]+)T$zone?$/i) ||
|
---|
903 | ($iso && /^([0-9-]+)T$zone2?$/i) ||
|
---|
904 | 0) {
|
---|
905 |
|
---|
906 | # If we already got a timezone, don't get another one.
|
---|
907 | my(@z);
|
---|
908 | if ($z) {
|
---|
909 | @z=($z,$z2);
|
---|
910 | $z="";
|
---|
911 | }
|
---|
912 | ($_,$z,$z2) = ($1,$2,$3);
|
---|
913 | ($z,$z2)=@z if (@z);
|
---|
914 |
|
---|
915 | s,([0-9])\s*-,$1 ,g; # Change all ISO8601 seps to spaces
|
---|
916 | s/^\s+//;
|
---|
917 | s/\s+$//;
|
---|
918 |
|
---|
919 | if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
|
---|
920 | /^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
|
---|
921 | 0
|
---|
922 | ) {
|
---|
923 | # ISO 8601 Dates with times
|
---|
924 | # YYYYMMDDtHHMNSSFFFF...
|
---|
925 | # YYYYMMDDtHHMNSS
|
---|
926 | # YYYYMMDDtHHMN
|
---|
927 | # YYYYMMDDtHH
|
---|
928 | # YY MMDDtHHMNSSFFFF...
|
---|
929 | # YY MMDDtHHMNSS
|
---|
930 | # YY MMDDtHHMN
|
---|
931 | # YY MMDDtHH
|
---|
932 | # The t is an optional letter "t".
|
---|
933 | ($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
|
---|
934 | if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) {
|
---|
935 | $h=0;
|
---|
936 | $midnight=1;
|
---|
937 | }
|
---|
938 | $z = "" if (! defined $h);
|
---|
939 | return "" if ($time && defined $h);
|
---|
940 | last PARSE;
|
---|
941 |
|
---|
942 | } elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
|
---|
943 | /^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
|
---|
944 | # ISO 8601 Dates
|
---|
945 | # YYYYMMDD
|
---|
946 | # YYYYMM
|
---|
947 | # YYYY
|
---|
948 | # YY MMDD
|
---|
949 | # YY MM
|
---|
950 | # YY
|
---|
951 | ($y,$m,$d)=($1,$2,$3);
|
---|
952 | last PARSE;
|
---|
953 |
|
---|
954 | } elsif (/^$YY\s+$D\s+$D/) {
|
---|
955 | # YY-M-D
|
---|
956 | ($y,$m,$d)=($1,$2,$3);
|
---|
957 | last PARSE;
|
---|
958 |
|
---|
959 | } elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
|
---|
960 | # YY-W##-D
|
---|
961 | ($y,$wofm,$dofw)=($1,$2,$3);
|
---|
962 | ($y,$m,$d)=_Date_NthWeekOfYear($y,$wofm,$dofw);
|
---|
963 | last PARSE;
|
---|
964 |
|
---|
965 | } elsif (/^$D4\s*(\d{3})$/ ||
|
---|
966 | /^$DD\s*(\d{3})$/) {
|
---|
967 | # YYDOY
|
---|
968 | ($y,$which)=($1,$2);
|
---|
969 | ($y,$m,$d)=Date_NthDayOfYear($y,$which);
|
---|
970 | last PARSE;
|
---|
971 |
|
---|
972 | } elsif ($iso<0) {
|
---|
973 | # We confused something like 1999/August12:00:00
|
---|
974 | # with a dateTtime format
|
---|
975 | $_=$orig;
|
---|
976 |
|
---|
977 | } else {
|
---|
978 | return "";
|
---|
979 | }
|
---|
980 | }
|
---|
981 |
|
---|
982 | # All deltas that are not ISO-8601 dates are NOT dates.
|
---|
983 | return "" if ($Curr{"InCalc"} && $delta);
|
---|
984 | if ($delta) {
|
---|
985 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
986 | return _DateCalc_DateDelta($Curr{"Now"},$delta);
|
---|
987 | }
|
---|
988 |
|
---|
989 | # Check for some special types of dates (next, prev)
|
---|
990 | foreach $from (keys %{ $Lang{$L}{"Repl"} }) {
|
---|
991 | $to=$Lang{$L}{"Repl"}{$from};
|
---|
992 | s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
|
---|
993 | }
|
---|
994 | if (/$wom/i || /$future/i || /$later/i || /$past/i ||
|
---|
995 | /$next/i || /$prev/i || /^$week$/i || /$wkabb/i) {
|
---|
996 | $tmp=0;
|
---|
997 |
|
---|
998 | if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
|
---|
999 | # last friday in October 95
|
---|
1000 | ($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
|
---|
1001 | # fix $m, $y
|
---|
1002 | return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
---|
1003 | $dofw=$week{lc($dofw)};
|
---|
1004 | $wofm=$wom{lc($wofm)};
|
---|
1005 | # Get the first day of the month
|
---|
1006 | $date=_Date_Join($y,$m,1,$h,$mn,$s);
|
---|
1007 | if ($wofm==-1) {
|
---|
1008 | $date=_DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0);
|
---|
1009 | $date=Date_GetPrev($date,$dofw,0);
|
---|
1010 | } else {
|
---|
1011 | for ($i=0; $i<$wofm; $i++) {
|
---|
1012 | if ($i==0) {
|
---|
1013 | $date=Date_GetNext($date,$dofw,1);
|
---|
1014 | } else {
|
---|
1015 | $date=Date_GetNext($date,$dofw,0);
|
---|
1016 | }
|
---|
1017 | }
|
---|
1018 | }
|
---|
1019 | last PARSE;
|
---|
1020 |
|
---|
1021 | } elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
|
---|
1022 | # last day in month
|
---|
1023 | ($m,$y)=($1,$2);
|
---|
1024 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1025 | $y=_Date_FixYear($y) if (! defined $y or length($y)<4);
|
---|
1026 | $m=$month{lc($m)};
|
---|
1027 | $d=Date_DaysInMonth($m,$y);
|
---|
1028 | last PARSE;
|
---|
1029 |
|
---|
1030 | } elsif (/^$week$/i) {
|
---|
1031 | # friday
|
---|
1032 | ($dofw)=($1);
|
---|
1033 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1034 | $date=Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1);
|
---|
1035 | $date=Date_GetNext($date,$dofw,1,$h,$mn,$s);
|
---|
1036 | last PARSE;
|
---|
1037 |
|
---|
1038 | } elsif (/^$next\s*$week$/i) {
|
---|
1039 | # next friday
|
---|
1040 | ($dofw)=($1);
|
---|
1041 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1042 | $date=Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s);
|
---|
1043 | last PARSE;
|
---|
1044 |
|
---|
1045 | } elsif (/^$prev\s*$week$/i) {
|
---|
1046 | # last friday
|
---|
1047 | ($dofw)=($1);
|
---|
1048 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1049 | $date=Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s);
|
---|
1050 | last PARSE;
|
---|
1051 |
|
---|
1052 | } elsif (/^$next$wkabb$/i) {
|
---|
1053 | # next week
|
---|
1054 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1055 | $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0);
|
---|
1056 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1057 | last PARSE;
|
---|
1058 | } elsif (/^$prev$wkabb$/i) {
|
---|
1059 | # last week
|
---|
1060 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1061 | $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0);
|
---|
1062 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1063 | last PARSE;
|
---|
1064 |
|
---|
1065 | } elsif (/^$next$mabb$/i) {
|
---|
1066 | # next month
|
---|
1067 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1068 | $date=_DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0);
|
---|
1069 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1070 | last PARSE;
|
---|
1071 | } elsif (/^$prev$mabb$/i) {
|
---|
1072 | # last month
|
---|
1073 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1074 | $date=_DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0);
|
---|
1075 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1076 | last PARSE;
|
---|
1077 |
|
---|
1078 | } elsif (/^$future\s*(\d+)$day$/i ||
|
---|
1079 | /^(\d+)$day$later$/i) {
|
---|
1080 | # in 2 days
|
---|
1081 | # 2 days later
|
---|
1082 | ($num)=($1);
|
---|
1083 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1084 | $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0",
|
---|
1085 | \$err,0);
|
---|
1086 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1087 | last PARSE;
|
---|
1088 | } elsif (/^(\d+)$day$past$/i) {
|
---|
1089 | # 2 days ago
|
---|
1090 | ($num)=($1);
|
---|
1091 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1092 | $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0",
|
---|
1093 | \$err,0);
|
---|
1094 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1095 | last PARSE;
|
---|
1096 |
|
---|
1097 | } elsif (/^$future\s*(\d+)$wkabb$/i ||
|
---|
1098 | /^(\d+)$wkabb$later$/i) {
|
---|
1099 | # in 2 weeks
|
---|
1100 | # 2 weeks later
|
---|
1101 | ($num)=($1);
|
---|
1102 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1103 | $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0",
|
---|
1104 | \$err,0);
|
---|
1105 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1106 | last PARSE;
|
---|
1107 | } elsif (/^(\d+)$wkabb$past$/i) {
|
---|
1108 | # 2 weeks ago
|
---|
1109 | ($num)=($1);
|
---|
1110 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1111 | $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0",
|
---|
1112 | \$err,0);
|
---|
1113 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1114 | last PARSE;
|
---|
1115 |
|
---|
1116 | } elsif (/^$future\s*(\d+)$mabb$/i ||
|
---|
1117 | /^(\d+)$mabb$later$/i) {
|
---|
1118 | # in 2 months
|
---|
1119 | # 2 months later
|
---|
1120 | ($num)=($1);
|
---|
1121 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1122 | $date=_DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0",
|
---|
1123 | \$err,0);
|
---|
1124 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1125 | last PARSE;
|
---|
1126 | } elsif (/^(\d+)$mabb$past$/i) {
|
---|
1127 | # 2 months ago
|
---|
1128 | ($num)=($1);
|
---|
1129 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1130 | $date=_DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0",
|
---|
1131 | \$err,0);
|
---|
1132 | $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
---|
1133 | last PARSE;
|
---|
1134 |
|
---|
1135 | } elsif (/^$week$future\s*(\d+)$wkabb$/i ||
|
---|
1136 | /^$week\s*(\d+)$wkabb$later$/i) {
|
---|
1137 | # friday in 2 weeks
|
---|
1138 | # friday 2 weeks later
|
---|
1139 | ($dofw,$num)=($1,$2);
|
---|
1140 | $tmp="+";
|
---|
1141 | } elsif (/^$week\s*(\d+)$wkabb$past$/i) {
|
---|
1142 | # friday 2 weeks ago
|
---|
1143 | ($dofw,$num)=($1,$2);
|
---|
1144 | $tmp="-";
|
---|
1145 | } elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
|
---|
1146 | /^(\d+)$wkabb$later$on$week$/i) {
|
---|
1147 | # in 2 weeks on friday
|
---|
1148 | # 2 weeks later on friday
|
---|
1149 | ($num,$dofw)=($1,$2);
|
---|
1150 | $tmp="+"
|
---|
1151 | } elsif (/^(\d+)$wkabb$past$on$week$/i) {
|
---|
1152 | # 2 weeks ago on friday
|
---|
1153 | ($num,$dofw)=($1,$2);
|
---|
1154 | $tmp="-";
|
---|
1155 | } elsif (/^$week\s*$wkabb$/i) {
|
---|
1156 | # monday week (British date: in 1 week on monday)
|
---|
1157 | $dofw=$1;
|
---|
1158 | $num=1;
|
---|
1159 | $tmp="+";
|
---|
1160 | } elsif ( (/^$now\s*$wkabb$/i && ($tmp="Now")) ||
|
---|
1161 | (/^$today\s*$wkabb$/i && ($tmp="Today")) ) {
|
---|
1162 | # now week (British date: 1 week from now)
|
---|
1163 | # today week (British date: 1 week from today)
|
---|
1164 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1165 | $date=_DateCalc_DateDelta($Curr{$tmp},"+0:0:1:0:0:0:0",\$err,0);
|
---|
1166 | $date=Date_SetTime($date,$h,$mn,$s) if ($time);
|
---|
1167 | last PARSE;
|
---|
1168 | } elsif (/^$offset\s*$wkabb$/i) {
|
---|
1169 | # tomorrow week (British date: 1 week from tomorrow)
|
---|
1170 | ($offset)=($1);
|
---|
1171 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1172 | $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
|
---|
1173 | $date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
|
---|
1174 | $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0);
|
---|
1175 | if ($time) {
|
---|
1176 | return ""
|
---|
1177 | if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
---|
1178 | $date=Date_SetTime($date,$h,$mn,$s);
|
---|
1179 | }
|
---|
1180 | last PARSE;
|
---|
1181 | }
|
---|
1182 |
|
---|
1183 | if ($tmp) {
|
---|
1184 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1185 | $date=_DateCalc_DateDelta($Curr{"Now"},
|
---|
1186 | $tmp . "0:0:$num:0:0:0:0",\$err,0);
|
---|
1187 | $date=Date_GetPrev($date,$Cnf{"FirstDay"},1);
|
---|
1188 | $date=Date_GetNext($date,$dofw,1,$h,$mn,$s);
|
---|
1189 | last PARSE;
|
---|
1190 | }
|
---|
1191 | }
|
---|
1192 |
|
---|
1193 | # Change (2nd, second) to 2
|
---|
1194 | $tmp=0;
|
---|
1195 | if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
|
---|
1196 | if (/^\s*$dom\s*$/) {
|
---|
1197 | ($d)=($1);
|
---|
1198 | $d=$dom{lc($d)};
|
---|
1199 | $m=$Curr{"M"};
|
---|
1200 | last PARSE;
|
---|
1201 | }
|
---|
1202 | my $from = $2;
|
---|
1203 | my $to = $dom{ lc($from) };
|
---|
1204 | s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
|
---|
1205 | s/^\s+//;
|
---|
1206 | s/\s+$//;
|
---|
1207 | }
|
---|
1208 |
|
---|
1209 | # Another set of special dates (Nth week)
|
---|
1210 | if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
|
---|
1211 | # 22nd sunday in 1996
|
---|
1212 | ($which,$dofw,$y)=($1,$2,$3);
|
---|
1213 | $y=$Curr{"Y"} if (! $y);
|
---|
1214 | $y--; # previous year
|
---|
1215 | $tmp=Date_GetNext("$y-12-31",$dofw,0);
|
---|
1216 | if ($which>1) {
|
---|
1217 | $tmp=_DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0);
|
---|
1218 | }
|
---|
1219 | ($y,$m,$d)=(_Date_Split($tmp, 1))[0..2];
|
---|
1220 | last PARSE;
|
---|
1221 | } elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
|
---|
1222 | /^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
|
---|
1223 | # sunday week 22 in 1996
|
---|
1224 | # sunday 22nd week in 1996
|
---|
1225 | ($dofw,$which,$y)=($1,$2,$3);
|
---|
1226 | ($y,$m,$d)=_Date_NthWeekOfYear($y,$which,$dofw);
|
---|
1227 | last PARSE;
|
---|
1228 | }
|
---|
1229 |
|
---|
1230 | # Get rid of day of week
|
---|
1231 | if (/(^|[^a-z])$week($|[^a-z])/i) {
|
---|
1232 | $wk=$2;
|
---|
1233 | (s/(^|[^a-z])$week,/$1 /i) ||
|
---|
1234 | s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
|
---|
1235 | s/^\s+//;
|
---|
1236 | s/\s+$//;
|
---|
1237 | }
|
---|
1238 |
|
---|
1239 | {
|
---|
1240 | # So that we can handle negative epoch times, let's convert
|
---|
1241 | # things like "epoch -" to "epochNEGATIVE " before we strip out
|
---|
1242 | # the $sep chars, which include '-'.
|
---|
1243 | s,epoch\s*-,epochNEGATIVE ,g;
|
---|
1244 |
|
---|
1245 | # Non-ISO8601 dates
|
---|
1246 | s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces
|
---|
1247 | s,^\s*,,; # remove leading/trailing space
|
---|
1248 | s,\s*$,,;
|
---|
1249 |
|
---|
1250 | if (/^$D\s+$D(?:\s+$YY)?$/) {
|
---|
1251 | # MM DD YY (DD MM YY non-US)
|
---|
1252 | ($m,$d,$y)=($1,$2,$3);
|
---|
1253 | ($m,$d)=($d,$m) if ($type ne "US");
|
---|
1254 | last PARSE;
|
---|
1255 |
|
---|
1256 | } elsif (/^$D4\s*$D\s*$D$/) {
|
---|
1257 | # YYYY MM DD
|
---|
1258 | ($y,$m,$d)=($1,$2,$3);
|
---|
1259 | last PARSE;
|
---|
1260 |
|
---|
1261 | } elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
|
---|
1262 | ($m)=($2);
|
---|
1263 |
|
---|
1264 | if (/^\s*$D(?:\s+$YY)?\s*$/) {
|
---|
1265 | # mmm DD YY
|
---|
1266 | # DD mmm YY
|
---|
1267 | # DD YY mmm
|
---|
1268 | ($d,$y)=($1,$2);
|
---|
1269 | last PARSE;
|
---|
1270 |
|
---|
1271 | } elsif (/^\s*$D$D4\s*$/) {
|
---|
1272 | # mmm DD YYYY
|
---|
1273 | # DD mmm YYYY
|
---|
1274 | # DD YYYY mmm
|
---|
1275 | ($d,$y)=($1,$2);
|
---|
1276 | last PARSE;
|
---|
1277 |
|
---|
1278 | } elsif (/^\s*$D4\s*$D\s*$/) {
|
---|
1279 | # mmm YYYY DD
|
---|
1280 | # YYYY mmm DD
|
---|
1281 | # YYYY DD mmm
|
---|
1282 | ($y,$d)=($1,$2);
|
---|
1283 | last PARSE;
|
---|
1284 |
|
---|
1285 | } elsif (/^\s*$D4\s*$/) {
|
---|
1286 | # mmm YYYY
|
---|
1287 | # YYYY mmm
|
---|
1288 | ($y,$d)=($1,1);
|
---|
1289 | last PARSE;
|
---|
1290 |
|
---|
1291 | } else {
|
---|
1292 | return "";
|
---|
1293 | }
|
---|
1294 |
|
---|
1295 | } elsif (/^epochNEGATIVE (\d+)$/) {
|
---|
1296 | $s=$1;
|
---|
1297 | $date=DateCalc("1970-01-01 00:00 GMT","-0:0:$s");
|
---|
1298 | } elsif (/^epoch\s*(\d+)$/i) {
|
---|
1299 | $s=$1;
|
---|
1300 | $date=DateCalc("1970-01-01 00:00 GMT","+0:0:$s");
|
---|
1301 |
|
---|
1302 | } elsif ( (/^$now$/i && ($tmp="Now")) ||
|
---|
1303 | (/^$today$/i && ($tmp="Today")) ) {
|
---|
1304 | # now, today
|
---|
1305 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1306 | $date=$Curr{$tmp};
|
---|
1307 | if ($time) {
|
---|
1308 | return ""
|
---|
1309 | if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
---|
1310 | $date=Date_SetTime($date,$h,$mn,$s);
|
---|
1311 | }
|
---|
1312 | last PARSE;
|
---|
1313 |
|
---|
1314 | } elsif (/^$offset$/i) {
|
---|
1315 | # yesterday, tomorrow
|
---|
1316 | ($offset)=($1);
|
---|
1317 | Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
---|
1318 | $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
|
---|
1319 | $date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
|
---|
1320 | if ($time) {
|
---|
1321 | return ""
|
---|
1322 | if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
---|
1323 | $date=Date_SetTime($date,$h,$mn,$s);
|
---|
1324 | }
|
---|
1325 | last PARSE;
|
---|
1326 |
|
---|
1327 | } else {
|
---|
1328 | return "";
|
---|
1329 | }
|
---|
1330 | }
|
---|
1331 | }
|
---|
1332 |
|
---|
1333 | if (! $date) {
|
---|
1334 | return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
---|
1335 | $date=_Date_Join($y,$m,$d,$h,$mn,$s);
|
---|
1336 | }
|
---|
1337 | $date=Date_ConvTZ($date,$z);
|
---|
1338 | if ($midnight) {
|
---|
1339 | $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0");
|
---|
1340 | }
|
---|
1341 | return $date;
|
---|
1342 | }
|
---|
1343 |
|
---|
1344 | sub ParseDate {
|
---|
1345 | print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
1346 | Date_Init() if (! $Curr{"InitDone"});
|
---|
1347 | my($args,@args,@a,$ref,$date)=();
|
---|
1348 | @a=@_;
|
---|
1349 |
|
---|
1350 | # @a : is the list of args to ParseDate. Currently, only one argument
|
---|
1351 | # is allowed and it must be a scalar (or a reference to a scalar)
|
---|
1352 | # or a reference to an array.
|
---|
1353 |
|
---|
1354 | if ($#a!=0) {
|
---|
1355 | print "ERROR: Invalid number of arguments to ParseDate.\n";
|
---|
1356 | return "";
|
---|
1357 | }
|
---|
1358 | $args=$a[0];
|
---|
1359 | $ref=ref $args;
|
---|
1360 | if (! $ref) {
|
---|
1361 | return $args if (_Date_Split($args));
|
---|
1362 | @args=($args);
|
---|
1363 | } elsif ($ref eq "ARRAY") {
|
---|
1364 | @args=@$args;
|
---|
1365 | } elsif ($ref eq "SCALAR") {
|
---|
1366 | return $$args if (_Date_Split($$args));
|
---|
1367 | @args=($$args);
|
---|
1368 | } else {
|
---|
1369 | print "ERROR: Invalid arguments to ParseDate.\n";
|
---|
1370 | return "";
|
---|
1371 | }
|
---|
1372 | @a=@args;
|
---|
1373 |
|
---|
1374 | # @args : a list containing all the arguments (dereferenced if appropriate)
|
---|
1375 | # @a : a list containing all the arguments currently being examined
|
---|
1376 | # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
|
---|
1377 | # reference to a scalar, or a reference to an array was passed in
|
---|
1378 | # $args : the scalar or refererence passed in
|
---|
1379 |
|
---|
1380 | PARSE: while($#a>=0) {
|
---|
1381 | $date=join(" ",@a);
|
---|
1382 | $date=ParseDateString($date);
|
---|
1383 | last if ($date);
|
---|
1384 | pop(@a);
|
---|
1385 | } # PARSE
|
---|
1386 |
|
---|
1387 | splice(@args,0,$#a + 1);
|
---|
1388 | @$args= @args if (defined $ref and $ref eq "ARRAY");
|
---|
1389 | $date;
|
---|
1390 | }
|
---|
1391 |
|
---|
1392 | sub Date_Cmp {
|
---|
1393 | my($D1,$D2)=@_;
|
---|
1394 | my($date1)=ParseDateString($D1);
|
---|
1395 | my($date2)=ParseDateString($D2);
|
---|
1396 | return $date1 cmp $date2;
|
---|
1397 | }
|
---|
1398 |
|
---|
1399 | # **NOTE**
|
---|
1400 | # The calc routines all call parse routines, so it is never necessary to
|
---|
1401 | # call Date_Init in the calc routines.
|
---|
1402 | sub DateCalc {
|
---|
1403 | print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
1404 | my($D1,$D2,@arg)=@_;
|
---|
1405 | my($ref,$err,$errref,$mode)=();
|
---|
1406 |
|
---|
1407 | ($errref,$mode) = (@arg);
|
---|
1408 | $ref=0;
|
---|
1409 |
|
---|
1410 | if (defined $errref) {
|
---|
1411 | if (ref $errref) {
|
---|
1412 | $ref=1;
|
---|
1413 | } elsif (! defined $mode) {
|
---|
1414 | $mode=$errref;
|
---|
1415 | $errref="";
|
---|
1416 | }
|
---|
1417 | }
|
---|
1418 |
|
---|
1419 | my(@date,@delta,$ret,$tmp,$oldincalc,$oldmode)=();
|
---|
1420 |
|
---|
1421 | if (exists $Curr{"Mode"}) {
|
---|
1422 | $oldmode = $Curr{"Mode"};
|
---|
1423 | } else {
|
---|
1424 | $oldmode = 0;
|
---|
1425 | }
|
---|
1426 |
|
---|
1427 | if (defined $mode and $mode>=0 and $mode<=3) {
|
---|
1428 | $Curr{"Mode"}=$mode;
|
---|
1429 | } else {
|
---|
1430 | $Curr{"Mode"}=0;
|
---|
1431 | }
|
---|
1432 |
|
---|
1433 | if (exists $Curr{"InCalc"}) {
|
---|
1434 | $oldincalc = $Curr{"InCalc"};
|
---|
1435 | } else {
|
---|
1436 | $oldincalc = 0;
|
---|
1437 | }
|
---|
1438 | $Curr{"InCalc"}=1;
|
---|
1439 |
|
---|
1440 | if ($tmp=ParseDateString($D1)) {
|
---|
1441 | # If we've already parsed the date, we don't want to do it a second
|
---|
1442 | # time (so we don't convert timezones twice).
|
---|
1443 | if (_Date_Split($D1)) {
|
---|
1444 | push(@date,$D1);
|
---|
1445 | } else {
|
---|
1446 | push(@date,$tmp);
|
---|
1447 | }
|
---|
1448 | } elsif ($tmp=ParseDateDelta($D1)) {
|
---|
1449 | push(@delta,$tmp);
|
---|
1450 | } else {
|
---|
1451 | $$errref=1 if ($ref);
|
---|
1452 | $Curr{"InCalc"} = $oldincalc;
|
---|
1453 | $Curr{"Mode"} = $oldmode;
|
---|
1454 | return;
|
---|
1455 | }
|
---|
1456 |
|
---|
1457 | if ($tmp=ParseDateString($D2)) {
|
---|
1458 | if (_Date_Split($D2)) {
|
---|
1459 | push(@date,$D2);
|
---|
1460 | } else {
|
---|
1461 | push(@date,$tmp);
|
---|
1462 | }
|
---|
1463 | } elsif ($tmp=ParseDateDelta($D2)) {
|
---|
1464 | push(@delta,$tmp);
|
---|
1465 | $mode = $Curr{"Mode"};
|
---|
1466 | } else {
|
---|
1467 | $$errref=2 if ($ref);
|
---|
1468 | $Curr{"InCalc"} = $oldincalc;
|
---|
1469 | $Curr{"Mode"} = $oldmode;
|
---|
1470 | return;
|
---|
1471 | }
|
---|
1472 |
|
---|
1473 | $Curr{"InCalc"} = $oldincalc;
|
---|
1474 | $Curr{"Mode"} = $oldmode;
|
---|
1475 |
|
---|
1476 | if ($#date==1) {
|
---|
1477 | $ret=_DateCalc_DateDate(@date,$mode);
|
---|
1478 | } elsif ($#date==0) {
|
---|
1479 | $ret=_DateCalc_DateDelta(@date,@delta,\$err,$mode);
|
---|
1480 | $$errref=$err if ($ref);
|
---|
1481 | } else {
|
---|
1482 | $ret=_DateCalc_DeltaDelta(@delta,$mode);
|
---|
1483 | }
|
---|
1484 | $ret;
|
---|
1485 | }
|
---|
1486 |
|
---|
1487 | sub ParseDateDelta {
|
---|
1488 | print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
1489 | my($args,@args,@a,$ref)=();
|
---|
1490 | local($_)=();
|
---|
1491 | @a=@_;
|
---|
1492 |
|
---|
1493 | # @a : is the list of args to ParseDateDelta. Currently, only one argument
|
---|
1494 | # is allowed and it must be a scalar (or a reference to a scalar)
|
---|
1495 | # or a reference to an array.
|
---|
1496 |
|
---|
1497 | if ($#a!=0) {
|
---|
1498 | print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
|
---|
1499 | return "";
|
---|
1500 | }
|
---|
1501 | $args=$a[0];
|
---|
1502 | $ref=ref $args;
|
---|
1503 | if (! $ref) {
|
---|
1504 | @args=($args);
|
---|
1505 | } elsif ($ref eq "ARRAY") {
|
---|
1506 | @args=@$args;
|
---|
1507 | } elsif ($ref eq "SCALAR") {
|
---|
1508 | @args=($$args);
|
---|
1509 | } else {
|
---|
1510 | print "ERROR: Invalid arguments to ParseDateDelta.\n";
|
---|
1511 | return "";
|
---|
1512 | }
|
---|
1513 | @a=@args;
|
---|
1514 |
|
---|
1515 | # @args : a list containing all the arguments (dereferenced if appropriate)
|
---|
1516 | # @a : a list containing all the arguments currently being examined
|
---|
1517 | # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
|
---|
1518 | # reference to a scalar, or a reference to an array was passed in
|
---|
1519 | # $args : the scalar or refererence passed in
|
---|
1520 |
|
---|
1521 | my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=();
|
---|
1522 | my($len,$tmp,$tmp2,$tmpl)=();
|
---|
1523 | my($from,$to)=();
|
---|
1524 | my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1;
|
---|
1525 |
|
---|
1526 | Date_Init() if (! $Curr{"InitDone"});
|
---|
1527 | # A sign can be a sequence of zero or more + and - signs, this
|
---|
1528 | # allows for deltas like '+ -2 days'.
|
---|
1529 | my($signexp)='((?:[+-]\s*)*)';
|
---|
1530 | my($numexp)='(\d+)';
|
---|
1531 | my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)";
|
---|
1532 | my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=();
|
---|
1533 | $yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()";
|
---|
1534 | $yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?";
|
---|
1535 | $mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?";
|
---|
1536 | $wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?";
|
---|
1537 | $dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?";
|
---|
1538 | $hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?";
|
---|
1539 | $mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?";
|
---|
1540 | $sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?";
|
---|
1541 | my($future)=$Lang{$Cnf{"Language"}}{"Future"};
|
---|
1542 | my($later)=$Lang{$Cnf{"Language"}}{"Later"};
|
---|
1543 | my($past)=$Lang{$Cnf{"Language"}}{"Past"};
|
---|
1544 |
|
---|
1545 | $delta="";
|
---|
1546 | PARSE: while (@a) {
|
---|
1547 | $_ = join(" ", grep {defined;} @a);
|
---|
1548 | s/\s+$//;
|
---|
1549 | last if ($_ eq "");
|
---|
1550 |
|
---|
1551 | # Mode is set in DateCalc. ParseDateDelta only overrides it if the
|
---|
1552 | # string contains a mode.
|
---|
1553 | if ($Lang{$Cnf{"Language"}}{"Exact"} &&
|
---|
1554 | s/$Lang{$Cnf{"Language"}}{"Exact"}//) {
|
---|
1555 | $Curr{"Mode"}=0;
|
---|
1556 | } elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
|
---|
1557 | s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
|
---|
1558 | $Curr{"Mode"}=1;
|
---|
1559 | } elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
|
---|
1560 | s/$Lang{$Cnf{"Language"}}{"Business"}//) {
|
---|
1561 | $Curr{"Mode"}=2;
|
---|
1562 | } elsif (! exists $Curr{"Mode"}) {
|
---|
1563 | $Curr{"Mode"}=0;
|
---|
1564 | }
|
---|
1565 | $workweek=7 if ($Curr{"Mode"} != 2);
|
---|
1566 |
|
---|
1567 | foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) {
|
---|
1568 | $to=$Lang{$Cnf{"Language"}}{"Repl"}{$from};
|
---|
1569 | s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
|
---|
1570 | }
|
---|
1571 |
|
---|
1572 | # in or ago
|
---|
1573 | #
|
---|
1574 | # We need to make sure that $later, $future, and $past don't contain each
|
---|
1575 | # other... Romanian pointed this out where $past is "in urma" and $future
|
---|
1576 | # is "in". When they do, we have to take this into account.
|
---|
1577 | # $len length of best match (greatest wins)
|
---|
1578 | # $tmp string after best match
|
---|
1579 | # $dir direction (prior, after) of best match
|
---|
1580 | #
|
---|
1581 | # $tmp2 string before/after current match
|
---|
1582 | # $tmpl length of current match
|
---|
1583 |
|
---|
1584 | $len=0;
|
---|
1585 | $tmp=$_;
|
---|
1586 | $dir=1;
|
---|
1587 |
|
---|
1588 | $tmp2=$_;
|
---|
1589 | if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
|
---|
1590 | $tmpl=length($2);
|
---|
1591 | if ($tmpl>$len) {
|
---|
1592 | $tmp=$tmp2;
|
---|
1593 | $dir=1;
|
---|
1594 | $len=$tmpl;
|
---|
1595 | }
|
---|
1596 | }
|
---|
1597 |
|
---|
1598 | $tmp2=$_;
|
---|
1599 | if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
|
---|
1600 | $tmpl=length($2);
|
---|
1601 | if ($tmpl>$len) {
|
---|
1602 | $tmp=$tmp2;
|
---|
1603 | $dir=1;
|
---|
1604 | $len=$tmpl;
|
---|
1605 | }
|
---|
1606 | }
|
---|
1607 |
|
---|
1608 | $tmp2=$_;
|
---|
1609 | if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
|
---|
1610 | $tmpl=length($2);
|
---|
1611 | if ($tmpl>$len) {
|
---|
1612 | $tmp=$tmp2;
|
---|
1613 | $dir=-1;
|
---|
1614 | $len=$tmpl;
|
---|
1615 | }
|
---|
1616 | }
|
---|
1617 |
|
---|
1618 | $_ = $tmp;
|
---|
1619 | s/\s*$//;
|
---|
1620 |
|
---|
1621 | # the colon part of the delta
|
---|
1622 | $colon="";
|
---|
1623 | if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
|
---|
1624 | $colon=$1;
|
---|
1625 | s/\s+$//;
|
---|
1626 | }
|
---|
1627 | @colon=split(/:/,$colon);
|
---|
1628 |
|
---|
1629 | # the non-colon part of the delta
|
---|
1630 | $sign="+";
|
---|
1631 | @delta=();
|
---|
1632 | $i=6;
|
---|
1633 | foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
|
---|
1634 | last if ($#colon>=$i--);
|
---|
1635 | $val=0;
|
---|
1636 | if (s/^$exp1//ix) {
|
---|
1637 | $val=$2 if ($2);
|
---|
1638 | $sign=$1 if ($1);
|
---|
1639 | }
|
---|
1640 |
|
---|
1641 | # Collapse a sign like '+ -' into a single character like '-',
|
---|
1642 | # by counting the occurrences of '-'.
|
---|
1643 | #
|
---|
1644 | $sign =~ s/\s+//g;
|
---|
1645 | $sign =~ tr/+//d;
|
---|
1646 | my $count = ($sign =~ tr/-//d);
|
---|
1647 | die "bad characters in sign: $sign" if length $sign;
|
---|
1648 | $sign = $count % 2 ? '-' : '+';
|
---|
1649 |
|
---|
1650 | push(@delta,"$sign$val");
|
---|
1651 | }
|
---|
1652 | if (! /^\s*$/) {
|
---|
1653 | pop(@a);
|
---|
1654 | next PARSE;
|
---|
1655 | }
|
---|
1656 |
|
---|
1657 | # make sure that the colon part has a sign
|
---|
1658 | for ($i=0; $i<=$#colon; $i++) {
|
---|
1659 | $val=0;
|
---|
1660 | if ($colon[$i] =~ /^$signexp$numexp?/) {
|
---|
1661 | $val=$2 if ($2);
|
---|
1662 | $sign=$1 if ($1);
|
---|
1663 | }
|
---|
1664 | $colon[$i] = "$sign$val";
|
---|
1665 | }
|
---|
1666 |
|
---|
1667 | # combine the two
|
---|
1668 | push(@delta,@colon);
|
---|
1669 | if ($dir<0) {
|
---|
1670 | for ($i=0; $i<=$#delta; $i++) {
|
---|
1671 | $delta[$i] =~ tr/-+/+-/;
|
---|
1672 | }
|
---|
1673 | }
|
---|
1674 |
|
---|
1675 | # form the delta and shift off the valid part
|
---|
1676 | $delta=join(":",@delta);
|
---|
1677 | splice(@args,0,$#a+1);
|
---|
1678 | @$args=@args if (defined $ref and $ref eq "ARRAY");
|
---|
1679 | last PARSE;
|
---|
1680 | }
|
---|
1681 |
|
---|
1682 | $delta=_Delta_Normalize($delta,$Curr{"Mode"});
|
---|
1683 | return $delta;
|
---|
1684 | }
|
---|
1685 |
|
---|
1686 | sub UnixDate {
|
---|
1687 | print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
1688 | my($date,@format)=@_;
|
---|
1689 | local($_)=();
|
---|
1690 | my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
|
---|
1691 | my($scalar)=();
|
---|
1692 | $date=ParseDateString($date);
|
---|
1693 | return if (! $date);
|
---|
1694 |
|
---|
1695 | my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
|
---|
1696 | _Date_Split($date, 1);
|
---|
1697 | $f{"y"}=substr $f{"Y"},2;
|
---|
1698 | Date_Init() if (! $Curr{"InitDone"});
|
---|
1699 |
|
---|
1700 | if (! wantarray) {
|
---|
1701 | $format=join(" ",@format);
|
---|
1702 | @format=($format);
|
---|
1703 | $scalar=1;
|
---|
1704 | }
|
---|
1705 |
|
---|
1706 | # month, week
|
---|
1707 | $_=$m;
|
---|
1708 | s/^0//;
|
---|
1709 | $f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
|
---|
1710 | $f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
|
---|
1711 | $_=$m;
|
---|
1712 | s/^0/ /;
|
---|
1713 | $f{"f"}=$_;
|
---|
1714 | $f{"U"}=Date_WeekOfYear($m,$d,$y,7);
|
---|
1715 | $f{"W"}=Date_WeekOfYear($m,$d,$y,1);
|
---|
1716 |
|
---|
1717 | # check week 52,53 and 0
|
---|
1718 | $f{"G"}=$f{"L"}=$y;
|
---|
1719 | if ($f{"W"}>=52 || $f{"U"}>=52) {
|
---|
1720 | my($dd,$mm,$yy)=($d,$m,$y);
|
---|
1721 | $dd+=7;
|
---|
1722 | if ($dd>31) {
|
---|
1723 | $dd-=31;
|
---|
1724 | $mm=1;
|
---|
1725 | $yy++;
|
---|
1726 | if (Date_WeekOfYear($mm,$dd,$yy,1)==2) {
|
---|
1727 | $f{"G"}=$yy;
|
---|
1728 | $f{"W"}=1;
|
---|
1729 | }
|
---|
1730 | if (Date_WeekOfYear($mm,$dd,$yy,7)==2) {
|
---|
1731 | $f{"L"}=$yy;
|
---|
1732 | $f{"U"}=1;
|
---|
1733 | }
|
---|
1734 | }
|
---|
1735 | }
|
---|
1736 | if ($f{"W"}==0) {
|
---|
1737 | my($dd,$mm,$yy)=($d,$m,$y);
|
---|
1738 | $dd-=7;
|
---|
1739 | $dd+=31 if ($dd<1);
|
---|
1740 | $yy = sprintf "%04d", $yy-1;
|
---|
1741 | $mm=12;
|
---|
1742 | $f{"G"}=$yy;
|
---|
1743 | $f{"W"}=Date_WeekOfYear($mm,$dd,$yy,1)+1;
|
---|
1744 | }
|
---|
1745 | if ($f{"U"}==0) {
|
---|
1746 | my($dd,$mm,$yy)=($d,$m,$y);
|
---|
1747 | $dd-=7;
|
---|
1748 | $dd+=31 if ($dd<1);
|
---|
1749 | $yy = sprintf "%04d", $yy-1;
|
---|
1750 | $mm=12;
|
---|
1751 | $f{"L"}=$yy;
|
---|
1752 | $f{"U"}=Date_WeekOfYear($mm,$dd,$yy,7)+1;
|
---|
1753 | }
|
---|
1754 |
|
---|
1755 | $f{"U"}="0".$f{"U"} if (length $f{"U"} < 2);
|
---|
1756 | $f{"W"}="0".$f{"W"} if (length $f{"W"} < 2);
|
---|
1757 |
|
---|
1758 | # day
|
---|
1759 | $f{"j"}=Date_DayOfYear($m,$d,$y);
|
---|
1760 | $f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
|
---|
1761 | $_=$d;
|
---|
1762 | s/^0/ /;
|
---|
1763 | $f{"e"}=$_;
|
---|
1764 | $f{"w"}=Date_DayOfWeek($m,$d,$y);
|
---|
1765 | $f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1];
|
---|
1766 | $f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2);
|
---|
1767 | $f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1];
|
---|
1768 | $f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1];
|
---|
1769 | $f{"E"}=Date_DaySuffix($f{"e"});
|
---|
1770 |
|
---|
1771 | # hour
|
---|
1772 | $_=$h;
|
---|
1773 | s/^0/ /;
|
---|
1774 | $f{"k"}=$_;
|
---|
1775 | $f{"i"}=$f{"k"}+1;
|
---|
1776 | $f{"i"}=$f{"k"};
|
---|
1777 | $f{"i"}=12 if ($f{"k"}==0);
|
---|
1778 | $f{"i"}=$f{"k"}-12 if ($f{"k"}>12);
|
---|
1779 | $f{"i"}=$f{"i"}-12 if ($f{"i"}>12);
|
---|
1780 | $f{"i"}=" ".$f{"i"} if (length($f{"i"})<2);
|
---|
1781 | $f{"I"}=$f{"i"};
|
---|
1782 | $f{"I"}=~ s/^ /0/;
|
---|
1783 | $f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"};
|
---|
1784 | $f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11);
|
---|
1785 |
|
---|
1786 | # minute, second, timezone
|
---|
1787 | $f{"o"}=Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
|
---|
1788 | $f{"s"}=Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s);
|
---|
1789 | $f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ?
|
---|
1790 | $Cnf{"TZ"} : $Cnf{"ConvTZ"};
|
---|
1791 | $f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || "");
|
---|
1792 |
|
---|
1793 | # date, time
|
---|
1794 | $f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
|
---|
1795 | $f{"C"}=$f{"u"}=
|
---|
1796 | qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|;
|
---|
1797 | $f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|;
|
---|
1798 | $f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|;
|
---|
1799 | $f{"x"}=qq|$d/$m/$f{"y"}| if ($Cnf{"DateFormat"} ne "US");
|
---|
1800 | $f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|;
|
---|
1801 | $f{"R"}=qq|$h:$mn|;
|
---|
1802 | $f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
|
---|
1803 | $f{"V"}=qq|$m$d$h$mn$f{"y"}|;
|
---|
1804 | $f{"Q"}="$y$m$d";
|
---|
1805 | $f{"q"}=qq|$y$m$d$h$mn$s|;
|
---|
1806 | $f{"P"}=qq|$y$m$d$h:$mn:$s|;
|
---|
1807 | $f{"O"}=qq|$y-$m-${d}T$h:$mn:$s|;
|
---|
1808 | $f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|;
|
---|
1809 | if ($f{"W"}==0) {
|
---|
1810 | $y--;
|
---|
1811 | $tmp=Date_WeekOfYear(12,31,$y,1);
|
---|
1812 | $tmp="0$tmp" if (length($tmp) < 2);
|
---|
1813 | $f{"J"}=qq|$y-W$tmp-$f{"w"}|;
|
---|
1814 | } else {
|
---|
1815 | $f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|;
|
---|
1816 | }
|
---|
1817 | $f{"K"}=qq|$y-$f{"j"}|;
|
---|
1818 | # %l is a special case. Since it requires the use of the calculator
|
---|
1819 | # which requires this routine, an infinite recursion results. To get
|
---|
1820 | # around this, %l is NOT determined every time this is called so the
|
---|
1821 | # recursion breaks.
|
---|
1822 |
|
---|
1823 | # other formats
|
---|
1824 | $f{"n"}="\n";
|
---|
1825 | $f{"t"}="\t";
|
---|
1826 | $f{"%"}="%";
|
---|
1827 | $f{"+"}="+";
|
---|
1828 |
|
---|
1829 | foreach $format (@format) {
|
---|
1830 | $format=reverse($format);
|
---|
1831 | $out="";
|
---|
1832 | while ($format ne "") {
|
---|
1833 | $c=chop($format);
|
---|
1834 | if ($c eq "%") {
|
---|
1835 | $c=chop($format);
|
---|
1836 | if ($c eq "l") {
|
---|
1837 | Date_Init();
|
---|
1838 | $date1=_DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0");
|
---|
1839 | $date2=_DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0");
|
---|
1840 | if (Date_Cmp($date,$date1)>=0 && Date_Cmp($date,$date2)<=0) {
|
---|
1841 | $f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|;
|
---|
1842 | } else {
|
---|
1843 | $f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
|
---|
1844 | }
|
---|
1845 | $out .= $f{"$c"};
|
---|
1846 | } elsif (exists $f{"$c"}) {
|
---|
1847 | $out .= $f{"$c"};
|
---|
1848 | } else {
|
---|
1849 | $out .= $c;
|
---|
1850 | }
|
---|
1851 | } else {
|
---|
1852 | $out .= $c;
|
---|
1853 | }
|
---|
1854 | }
|
---|
1855 | push(@out,$out);
|
---|
1856 | }
|
---|
1857 | if ($scalar) {
|
---|
1858 | return $out[0];
|
---|
1859 | } else {
|
---|
1860 | return (@out);
|
---|
1861 | }
|
---|
1862 | }
|
---|
1863 |
|
---|
1864 | # Can't be in "use integer" because we're doing decimal arithmatic
|
---|
1865 | no integer;
|
---|
1866 | sub Delta_Format {
|
---|
1867 | print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
1868 | my($delta,@arg)=@_;
|
---|
1869 | my($mode);
|
---|
1870 | if (lc($arg[0]) eq "approx") {
|
---|
1871 | $mode = "approx";
|
---|
1872 | shift(@arg);
|
---|
1873 | } else {
|
---|
1874 | $mode = "exact";
|
---|
1875 | }
|
---|
1876 | my($dec,@format) = @arg;
|
---|
1877 |
|
---|
1878 | $delta=ParseDateDelta($delta);
|
---|
1879 | return "" if (! $delta);
|
---|
1880 | my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
|
---|
1881 | local($_)=$delta;
|
---|
1882 | my($y,$M,$w,$d,$h,$m,$s)=_Delta_Split($delta);
|
---|
1883 | # Get rid of positive signs.
|
---|
1884 | ($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s);
|
---|
1885 |
|
---|
1886 | if (defined $dec && $dec>0) {
|
---|
1887 | $dec="%." . ($dec*1) . "f";
|
---|
1888 | } else {
|
---|
1889 | $dec="%f";
|
---|
1890 | }
|
---|
1891 |
|
---|
1892 | if (! wantarray) {
|
---|
1893 | $format=join(" ",@format);
|
---|
1894 | @format=($format);
|
---|
1895 | $scalar=1;
|
---|
1896 | }
|
---|
1897 |
|
---|
1898 | # Length of each unit in seconds
|
---|
1899 | my($sl,$ml,$hl,$dl,$wl,$Ml,$yl)=();
|
---|
1900 | $sl = 1;
|
---|
1901 | $ml = $sl*60;
|
---|
1902 | $hl = $ml*60;
|
---|
1903 | $dl = $hl*24;
|
---|
1904 | $wl = $dl*7;
|
---|
1905 | $yl = $dl*365.25;
|
---|
1906 | $Ml = $yl/12;
|
---|
1907 |
|
---|
1908 | # The decimal amount of each unit contained in all smaller units
|
---|
1909 | my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
|
---|
1910 | if ($mode eq "exact") {
|
---|
1911 | $yd = $M/12;
|
---|
1912 | $Md = 0;
|
---|
1913 | } else {
|
---|
1914 | $yd = ($M*$Ml + $w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
|
---|
1915 | $Md = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$Ml;
|
---|
1916 | }
|
---|
1917 |
|
---|
1918 | $wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
|
---|
1919 | $dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
|
---|
1920 | $hd = ($m*$ml + $s*$sl)/$hl;
|
---|
1921 | $md = ($s*$sl)/$ml;
|
---|
1922 | $sd = 0;
|
---|
1923 |
|
---|
1924 | # The amount of each unit contained in higher units.
|
---|
1925 | my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
|
---|
1926 | $yh = 0;
|
---|
1927 | $Mh = ($yh+$y)*12;
|
---|
1928 |
|
---|
1929 | if ($mode eq "exact") {
|
---|
1930 | $wh = 0;
|
---|
1931 | $dh = ($wh+$w)*7;
|
---|
1932 | } else {
|
---|
1933 | $wh = ($yh+$y+$M/12)*365.25/7;
|
---|
1934 | $dh = ($wh+$w)*7;
|
---|
1935 | }
|
---|
1936 |
|
---|
1937 | $hh = ($dh+$d)*24;
|
---|
1938 | $mh = ($hh+$h)*60;
|
---|
1939 | $sh = ($mh+$m)*60;
|
---|
1940 |
|
---|
1941 | # Set up the formats
|
---|
1942 |
|
---|
1943 | $f{"yv"} = $y;
|
---|
1944 | $f{"Mv"} = $M;
|
---|
1945 | $f{"wv"} = $w;
|
---|
1946 | $f{"dv"} = $d;
|
---|
1947 | $f{"hv"} = $h;
|
---|
1948 | $f{"mv"} = $m;
|
---|
1949 | $f{"sv"} = $s;
|
---|
1950 |
|
---|
1951 | $f{"yh"} = $y+$yh;
|
---|
1952 | $f{"Mh"} = $M+$Mh;
|
---|
1953 | $f{"wh"} = $w+$wh;
|
---|
1954 | $f{"dh"} = $d+$dh;
|
---|
1955 | $f{"hh"} = $h+$hh;
|
---|
1956 | $f{"mh"} = $m+$mh;
|
---|
1957 | $f{"sh"} = $s+$sh;
|
---|
1958 |
|
---|
1959 | $f{"yd"} = sprintf($dec,$y+$yd);
|
---|
1960 | $f{"Md"} = sprintf($dec,$M+$Md);
|
---|
1961 | $f{"wd"} = sprintf($dec,$w+$wd);
|
---|
1962 | $f{"dd"} = sprintf($dec,$d+$dd);
|
---|
1963 | $f{"hd"} = sprintf($dec,$h+$hd);
|
---|
1964 | $f{"md"} = sprintf($dec,$m+$md);
|
---|
1965 | $f{"sd"} = sprintf($dec,$s+$sd);
|
---|
1966 |
|
---|
1967 | $f{"yt"} = sprintf($dec,$yh+$y+$yd);
|
---|
1968 | $f{"Mt"} = sprintf($dec,$Mh+$M+$Md);
|
---|
1969 | $f{"wt"} = sprintf($dec,$wh+$w+$wd);
|
---|
1970 | $f{"dt"} = sprintf($dec,$dh+$d+$dd);
|
---|
1971 | $f{"ht"} = sprintf($dec,$hh+$h+$hd);
|
---|
1972 | $f{"mt"} = sprintf($dec,$mh+$m+$md);
|
---|
1973 | $f{"st"} = sprintf($dec,$sh+$s+$sd);
|
---|
1974 |
|
---|
1975 | $f{"%"} = "%";
|
---|
1976 |
|
---|
1977 | foreach $format (@format) {
|
---|
1978 | $format=reverse($format);
|
---|
1979 | $out="";
|
---|
1980 | PARSE: while ($format) {
|
---|
1981 | $c1=chop($format);
|
---|
1982 | if ($c1 eq "%") {
|
---|
1983 | $c1=chop($format);
|
---|
1984 | if (exists($f{$c1})) {
|
---|
1985 | $out .= $f{$c1};
|
---|
1986 | next PARSE;
|
---|
1987 | }
|
---|
1988 | $c2=chop($format);
|
---|
1989 | if (exists($f{"$c1$c2"})) {
|
---|
1990 | $out .= $f{"$c1$c2"};
|
---|
1991 | next PARSE;
|
---|
1992 | }
|
---|
1993 | $out .= $c1;
|
---|
1994 | $format .= $c2;
|
---|
1995 | } else {
|
---|
1996 | $out .= $c1;
|
---|
1997 | }
|
---|
1998 | }
|
---|
1999 | push(@out,$out);
|
---|
2000 | }
|
---|
2001 | if ($scalar) {
|
---|
2002 | return $out[0];
|
---|
2003 | } else {
|
---|
2004 | return (@out);
|
---|
2005 | }
|
---|
2006 | }
|
---|
2007 | use integer;
|
---|
2008 |
|
---|
2009 | sub ParseRecur {
|
---|
2010 | print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
2011 | Date_Init() if (! $Curr{"InitDone"});
|
---|
2012 |
|
---|
2013 | my($recur,$dateb,$date0,$date1,$flag)=@_;
|
---|
2014 | local($_)=$recur;
|
---|
2015 |
|
---|
2016 | my($recur_0,$recur_1,@recur0,@recur1)=();
|
---|
2017 | my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=();
|
---|
2018 | my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=();
|
---|
2019 |
|
---|
2020 | # $date0, $date1, $dateb, $flag : passed in (these are always the final say
|
---|
2021 | # in determining whether a date matches a
|
---|
2022 | # recurrence IF they are present.
|
---|
2023 | # $date_b, $date_0, $date_1 : if a value can be determined from the
|
---|
2024 | # $flag_t recurrence, they are stored here.
|
---|
2025 | #
|
---|
2026 | # If values can be determined from the recurrence AND are passed in, the
|
---|
2027 | # following are used:
|
---|
2028 | # max($date0,$date_0) i.e. the later of the two dates
|
---|
2029 | # min($date1,$date_1) i.e. the earlier of the two dates
|
---|
2030 | #
|
---|
2031 | # The base date that is used is the first one defined from
|
---|
2032 | # $dateb $date_b
|
---|
2033 | # The base date is only used if necessary (as determined by the recur).
|
---|
2034 | # For example, "every other friday" requires a base date, but "2nd
|
---|
2035 | # friday of every month" doesn't.
|
---|
2036 |
|
---|
2037 | my($date_b,$date_0,$date_1,$flag_t);
|
---|
2038 |
|
---|
2039 | #
|
---|
2040 | # Check the arguments passed in.
|
---|
2041 | #
|
---|
2042 |
|
---|
2043 | $date0="" if (! defined $date0);
|
---|
2044 | $date1="" if (! defined $date1);
|
---|
2045 | $dateb="" if (! defined $dateb);
|
---|
2046 | $flag ="" if (! defined $flag);
|
---|
2047 |
|
---|
2048 | if ($dateb) {
|
---|
2049 | $dateb=ParseDateString($dateb);
|
---|
2050 | return "" if (! $dateb);
|
---|
2051 | }
|
---|
2052 | if ($date0) {
|
---|
2053 | $date0=ParseDateString($date0);
|
---|
2054 | return "" if (! $date0);
|
---|
2055 | }
|
---|
2056 | if ($date1) {
|
---|
2057 | $date1=ParseDateString($date1);
|
---|
2058 | return "" if (! $date1);
|
---|
2059 | }
|
---|
2060 |
|
---|
2061 | #
|
---|
2062 | # Parse the recur. $date_b, $date_0, and $date_e are values obtained
|
---|
2063 | # from the recur.
|
---|
2064 | #
|
---|
2065 |
|
---|
2066 | @tmp=_Recur_Split($_);
|
---|
2067 |
|
---|
2068 | if (@tmp) {
|
---|
2069 | ($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp;
|
---|
2070 | $recur_0 = "" if (! defined $recur_0);
|
---|
2071 | $recur_1 = "" if (! defined $recur_1);
|
---|
2072 | $flag_t = "" if (! defined $flag_t);
|
---|
2073 | $date_b = "" if (! defined $date_b);
|
---|
2074 | $date_0 = "" if (! defined $date_0);
|
---|
2075 | $date_1 = "" if (! defined $date_1);
|
---|
2076 |
|
---|
2077 | @recur0 = split(/:/,$recur_0);
|
---|
2078 | @recur1 = split(/:/,$recur_1);
|
---|
2079 | return "" if ($#recur0 + $#recur1 + 2 != 7);
|
---|
2080 |
|
---|
2081 | if ($date_b) {
|
---|
2082 | $date_b=ParseDateString($date_b);
|
---|
2083 | return "" if (! $date_b);
|
---|
2084 | }
|
---|
2085 | if ($date_0) {
|
---|
2086 | $date_0=ParseDateString($date_0);
|
---|
2087 | return "" if (! $date_0);
|
---|
2088 | }
|
---|
2089 | if ($date_1) {
|
---|
2090 | $date_1=ParseDateString($date_1);
|
---|
2091 | return "" if (! $date_1);
|
---|
2092 | }
|
---|
2093 |
|
---|
2094 | } else {
|
---|
2095 |
|
---|
2096 | my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...)
|
---|
2097 | my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... }
|
---|
2098 | my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...)
|
---|
2099 | my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... }
|
---|
2100 | my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days)
|
---|
2101 | my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months)
|
---|
2102 | my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks)
|
---|
2103 | my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st)
|
---|
2104 | my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} };
|
---|
2105 | # { 1st=>1,first=>1,...}
|
---|
2106 | my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of)
|
---|
2107 | my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last)
|
---|
2108 | my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every)
|
---|
2109 |
|
---|
2110 | my($D)='\s*(\d+)';
|
---|
2111 | my($Y)='\s*(\d{4}|\d{2})';
|
---|
2112 |
|
---|
2113 | # Change 1st to 1
|
---|
2114 | if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
|
---|
2115 | $tmp=lc($2);
|
---|
2116 | $tmp=$dayshash{"$tmp"};
|
---|
2117 | s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
|
---|
2118 | }
|
---|
2119 | s/\s*$//;
|
---|
2120 |
|
---|
2121 | # Get rid of "each"
|
---|
2122 | if (/(^|[^a-z])$each($|[^a-z])/i) {
|
---|
2123 | s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
|
---|
2124 | $each=1;
|
---|
2125 | } else {
|
---|
2126 | $each=0;
|
---|
2127 | }
|
---|
2128 |
|
---|
2129 | if ($each) {
|
---|
2130 |
|
---|
2131 | if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
|
---|
2132 | /^$D?$day(?:$of$mmm())?$/i) {
|
---|
2133 | # every [2nd] day in [june] 1997
|
---|
2134 | # every [2nd] day [in june]
|
---|
2135 | ($num,$m,$y)=($1,$2,$3);
|
---|
2136 | $num=1 if (! defined $num);
|
---|
2137 | $m="" if (! defined $m);
|
---|
2138 | $y="" if (! defined $y);
|
---|
2139 |
|
---|
2140 | $y=$Curr{"Y"} if (! $y);
|
---|
2141 | if ($m) {
|
---|
2142 | $m=$mmm{lc($m)};
|
---|
2143 | $date_0=_Date_Join($y,$m,1,0,0,0);
|
---|
2144 | $date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
|
---|
2145 | } else {
|
---|
2146 | $date_0=_Date_Join($y, 1,1,0,0,0);
|
---|
2147 | $date_1=_Date_Join($y+1,1,1,0,0,0);
|
---|
2148 | }
|
---|
2149 | $date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0);
|
---|
2150 | @recur0=(0,0,0,$num,0,0,0);
|
---|
2151 | @recur1=();
|
---|
2152 |
|
---|
2153 | } elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
|
---|
2154 | # 2nd [day] of every month [in 1997]
|
---|
2155 | ($num,$y)=($1,$2);
|
---|
2156 | $y=$Curr{"Y"} if (! $y);
|
---|
2157 |
|
---|
2158 | $date_0=_Date_Join($y, 1,1,0,0,0);
|
---|
2159 | $date_1=_Date_Join($y+1,1,1,0,0,0);
|
---|
2160 | $date_b=$date_0;
|
---|
2161 |
|
---|
2162 | @recur0=(0,1,0);
|
---|
2163 | @recur1=($num,0,0,0);
|
---|
2164 |
|
---|
2165 | } elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ ||
|
---|
2166 | /^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) {
|
---|
2167 | # 2nd tuesday of every month [in 1997]
|
---|
2168 | # last tuesday of every month [in 1997]
|
---|
2169 | ($num,$d,$y)=($1,$2,$3);
|
---|
2170 | $y=$Curr{"Y"} if (! $y);
|
---|
2171 | $d=$week{lc($d)};
|
---|
2172 | $num=-1 if ($num !~ /^$D$/);
|
---|
2173 |
|
---|
2174 | $date_0=_Date_Join($y,1,1,0,0,0);
|
---|
2175 | $date_1=_Date_Join($y+1,1,1,0,0,0);
|
---|
2176 | $date_b=$date_0;
|
---|
2177 |
|
---|
2178 | @recur0=(0,1);
|
---|
2179 | @recur1=($num,$d,0,0,0);
|
---|
2180 |
|
---|
2181 | } elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i ||
|
---|
2182 | /^$D?$wkexp(?:$of$mmm())?$/i) {
|
---|
2183 | # every tuesday in june 1997
|
---|
2184 | # every 2nd tuesday in june 1997
|
---|
2185 | ($num,$d,$m,$y)=($1,$2,$3,$4);
|
---|
2186 | $y=$Curr{"Y"} if (! $y);
|
---|
2187 | $num=1 if (! defined $num);
|
---|
2188 | $m="" if (! defined $m);
|
---|
2189 | $d=$week{lc($d)};
|
---|
2190 |
|
---|
2191 | if ($m) {
|
---|
2192 | $m=$mmm{lc($m)};
|
---|
2193 | $date_0=_Date_Join($y,$m,1,0,0,0);
|
---|
2194 | $date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
|
---|
2195 | } else {
|
---|
2196 | $date_0=_Date_Join($y,1,1,0,0,0);
|
---|
2197 | $date_1=_Date_Join($y+1,1,1,0,0,0);
|
---|
2198 | }
|
---|
2199 | $date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0);
|
---|
2200 |
|
---|
2201 | @recur0=(0,0,$num);
|
---|
2202 | @recur1=($d,0,0,0);
|
---|
2203 |
|
---|
2204 | } else {
|
---|
2205 | return "";
|
---|
2206 | }
|
---|
2207 |
|
---|
2208 | $date_0="" if ($date0);
|
---|
2209 | $date_1="" if ($date1);
|
---|
2210 | } else {
|
---|
2211 | return "";
|
---|
2212 | }
|
---|
2213 | }
|
---|
2214 |
|
---|
2215 | #
|
---|
2216 | # Override with any values passed in
|
---|
2217 | #
|
---|
2218 |
|
---|
2219 | $date0 = $date_0 if (! $date0);
|
---|
2220 | $date1 = $date_1 if (! $date1);
|
---|
2221 | $dateb = $date_b if (! $dateb);
|
---|
2222 | if ($flag =~ s/^\+//) {
|
---|
2223 | $flag = "$flag_t,$flag" if ($flag_t);
|
---|
2224 | }
|
---|
2225 | $flag = $flag_t if (! $flag);
|
---|
2226 | $flag = "" if (! $flag);
|
---|
2227 |
|
---|
2228 | if (! wantarray) {
|
---|
2229 | $tmp = join(":",@recur0);
|
---|
2230 | $tmp .= "*" . join(":",@recur1) if (@recur1);
|
---|
2231 | $tmp .= "*$flag*$dateb*$date0*$date1";
|
---|
2232 | return $tmp;
|
---|
2233 | }
|
---|
2234 | if (@recur0) {
|
---|
2235 | return () if (! $date0 || ! $date1); # dateb is NOT required in all case
|
---|
2236 | }
|
---|
2237 |
|
---|
2238 | #
|
---|
2239 | # Some flags affect parsing.
|
---|
2240 | #
|
---|
2241 |
|
---|
2242 | @flags = split(/,/,$flag);
|
---|
2243 | my($f);
|
---|
2244 | foreach $f (@flags) {
|
---|
2245 | if ($f =~ /^EASTER$/i) {
|
---|
2246 | ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
|
---|
2247 | # We want something that will return Jan 1 for the given years.
|
---|
2248 | if ($#recur0==-1) {
|
---|
2249 | @recur1=($y,1,0,1,$h,$mn,$s);
|
---|
2250 | } elsif ($#recur0<=3) {
|
---|
2251 | @recur0=($y,0,0,0);
|
---|
2252 | @recur1=($h,$mn,$s);
|
---|
2253 | } elsif ($#recur0==4) {
|
---|
2254 | @recur0=($y,0,0,0,0);
|
---|
2255 | @recur1=($mn,$s);
|
---|
2256 | } elsif ($#recur0==5) {
|
---|
2257 | @recur0=($y,0,0,0,0,0);
|
---|
2258 | @recur1=($s);
|
---|
2259 | } else {
|
---|
2260 | @recur0=($y,0,0,0,0,0,0);
|
---|
2261 | }
|
---|
2262 | }
|
---|
2263 | }
|
---|
2264 |
|
---|
2265 | #
|
---|
2266 | # Determine the dates referenced by the recur. Also, fix the base date
|
---|
2267 | # as necessary for the recurrences which require it.
|
---|
2268 | #
|
---|
2269 |
|
---|
2270 | ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
|
---|
2271 | @y=@m=@w=@d=();
|
---|
2272 | my(@time)=($h,$mn,$s);
|
---|
2273 |
|
---|
2274 | RECUR: while (1) {
|
---|
2275 |
|
---|
2276 | if ($#recur0==-1) {
|
---|
2277 | # * 0-M-W-D-H-MN-S => 0 * M-W-D-H-MN-S
|
---|
2278 |
|
---|
2279 | if ($y eq "0") {
|
---|
2280 | push(@recur0,1);
|
---|
2281 | shift(@recur1);
|
---|
2282 | next RECUR;
|
---|
2283 | }
|
---|
2284 |
|
---|
2285 | # Y-M-W-D-H-MN-S
|
---|
2286 |
|
---|
2287 | @y=_ReturnList($y);
|
---|
2288 | foreach $y (@y) {
|
---|
2289 | $y=_Date_FixYear($y) if (length($y)==2);
|
---|
2290 | return () if (length($y)!=4 || ! _IsInt($y));
|
---|
2291 | }
|
---|
2292 |
|
---|
2293 | $date0=ParseDate("0000-01-01") if (! $date0);
|
---|
2294 | $date1=ParseDate("9999-12-31 23:59:59") if (! $date1);
|
---|
2295 |
|
---|
2296 | if ($m eq "0" and $w eq "0") {
|
---|
2297 |
|
---|
2298 | # * Y-0-0-0-H-MN-S
|
---|
2299 | # * Y-0-0-DOY-H-MN-S
|
---|
2300 |
|
---|
2301 | if ($d eq "0") {
|
---|
2302 | @d=(1);
|
---|
2303 | } else {
|
---|
2304 | @d=_ReturnList($d);
|
---|
2305 | return () if (! @d);
|
---|
2306 | foreach $d (@d) {
|
---|
2307 | return () if (! _IsInt($d,-366,366) || $d==0);
|
---|
2308 | }
|
---|
2309 | }
|
---|
2310 |
|
---|
2311 | @date=();
|
---|
2312 | foreach $yy (@y) {
|
---|
2313 | my $diy = Date_DaysInYear($yy);
|
---|
2314 | foreach $d (@d) {
|
---|
2315 | my $tmpd = $d;
|
---|
2316 | $tmpd += ($diy+1) if ($tmpd < 0);
|
---|
2317 | next if (! _IsInt($tmpd,1,$diy));
|
---|
2318 | ($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd);
|
---|
2319 | push(@date, _Date_Join($y,$m,$dd,0,0,0));
|
---|
2320 | }
|
---|
2321 | }
|
---|
2322 | last RECUR;
|
---|
2323 |
|
---|
2324 | } elsif ($w eq "0") {
|
---|
2325 |
|
---|
2326 | # * Y-M-0-0-H-MN-S
|
---|
2327 | # * Y-M-0-DOM-H-MN-S
|
---|
2328 |
|
---|
2329 | @m=_ReturnList($m);
|
---|
2330 | return () if (! @m);
|
---|
2331 | foreach $m (@m) {
|
---|
2332 | return () if (! _IsInt($m,1,12));
|
---|
2333 | }
|
---|
2334 |
|
---|
2335 | if ($d eq "0") {
|
---|
2336 | @d=(1);
|
---|
2337 | } else {
|
---|
2338 | @d=_ReturnList($d);
|
---|
2339 | return () if (! @d);
|
---|
2340 | foreach $d (@d) {
|
---|
2341 | return () if (! _IsInt($d,-31,31) || $d==0);
|
---|
2342 | }
|
---|
2343 | }
|
---|
2344 |
|
---|
2345 | @date=();
|
---|
2346 | foreach $y (@y) {
|
---|
2347 | foreach $m (@m) {
|
---|
2348 | my $dim = Date_DaysInMonth($m,$y);
|
---|
2349 | foreach $d (@d) {
|
---|
2350 | my $tmpd = $d;
|
---|
2351 | $tmpd += ($dim+1) if ($d<0);
|
---|
2352 | next if (! _IsInt($tmpd,1,$dim));
|
---|
2353 | $date=_Date_Join($y,$m,$tmpd,0,0,0);
|
---|
2354 | push(@date,$date);
|
---|
2355 | }
|
---|
2356 | }
|
---|
2357 | }
|
---|
2358 | last RECUR;
|
---|
2359 |
|
---|
2360 | } elsif ($m eq "0") {
|
---|
2361 |
|
---|
2362 | # * Y-0-WOY-DOW-H-MN-S
|
---|
2363 | # * Y-0-WOY-0-H-MN-S
|
---|
2364 |
|
---|
2365 | @w=_ReturnList($w);
|
---|
2366 | return () if (! @w);
|
---|
2367 | foreach $w (@w) {
|
---|
2368 | return () if (! _IsInt($w,-53,53) || $w==0);
|
---|
2369 | }
|
---|
2370 |
|
---|
2371 | if ($d eq "0") {
|
---|
2372 | @d=(1);
|
---|
2373 | } else {
|
---|
2374 | @d=_ReturnList($d);
|
---|
2375 | return () if (! @d);
|
---|
2376 | foreach $d (@d) {
|
---|
2377 | $d += 8 if ($d<0);
|
---|
2378 | return () if (! _IsInt($d,1,7));
|
---|
2379 | }
|
---|
2380 | }
|
---|
2381 |
|
---|
2382 | @date=();
|
---|
2383 | foreach $y (@y) {
|
---|
2384 | foreach $w (@w) {
|
---|
2385 | foreach $d (@d) {
|
---|
2386 | my($tmpw,$del);
|
---|
2387 | if ($w<0) {
|
---|
2388 | $date="$y-12-31-00:00:00";
|
---|
2389 | $tmpw = (-$w)-1;
|
---|
2390 | $del="-0:0:$tmpw:0:0:0:0";
|
---|
2391 | $date=Date_GetPrev($date,$d,1);
|
---|
2392 | } else {
|
---|
2393 | $date="$y-01-01-00:00:00";
|
---|
2394 | $tmpw = ($w)-1;
|
---|
2395 | $del="0:0:$tmpw:0:0:0:0";
|
---|
2396 | $date=Date_GetNext($date,$d,1);
|
---|
2397 | }
|
---|
2398 | $date=_DateCalc_DateDelta($date,$del);
|
---|
2399 | push(@date,$date) if ( (_Date_Split($date))[0] == $y);
|
---|
2400 | }
|
---|
2401 | }
|
---|
2402 | }
|
---|
2403 | last RECUR;
|
---|
2404 |
|
---|
2405 | } else {
|
---|
2406 |
|
---|
2407 | # * Y-M-WOM-DOW-H-MN-S
|
---|
2408 | # * Y-M-WOM-0-H-MN-S
|
---|
2409 |
|
---|
2410 | @m=_ReturnList($m);
|
---|
2411 | return () if (! @m);
|
---|
2412 | @w=_ReturnList($w);
|
---|
2413 | return () if (! @w);
|
---|
2414 | if ($d eq "0") {
|
---|
2415 | @d=(1);
|
---|
2416 | } else {
|
---|
2417 | @d=_ReturnList($d);
|
---|
2418 | }
|
---|
2419 |
|
---|
2420 | @date=_Date_Recur_WoM(\@y,\@m,\@w,\@d);
|
---|
2421 | last RECUR;
|
---|
2422 | }
|
---|
2423 | }
|
---|
2424 |
|
---|
2425 | if ($#recur0==0) {
|
---|
2426 |
|
---|
2427 | # Y * M-W-D-H-MN-S
|
---|
2428 | $n=$y;
|
---|
2429 | $n=1 if ($n==0);
|
---|
2430 |
|
---|
2431 | if ($m eq "0") {
|
---|
2432 |
|
---|
2433 | # Y * 0-W-D-H-MN-S => Y-0 * W-D-H-MN-S
|
---|
2434 | push(@recur0,0);
|
---|
2435 | shift(@recur1);
|
---|
2436 |
|
---|
2437 | } elsif ($w eq "0") {
|
---|
2438 |
|
---|
2439 | # Y * M-0-DOM-H-MN-S
|
---|
2440 | return () if (! $dateb && $y != 1);
|
---|
2441 |
|
---|
2442 | @m=_ReturnList($m);
|
---|
2443 | return () if (! @m);
|
---|
2444 | foreach $m (@m) {
|
---|
2445 | return () if (! _IsInt($m,1,12));
|
---|
2446 | }
|
---|
2447 |
|
---|
2448 | if ($d eq "0") {
|
---|
2449 | @d = (1);
|
---|
2450 | } else {
|
---|
2451 | @d=_ReturnList($d);
|
---|
2452 | return () if (! @d);
|
---|
2453 | foreach $d (@d) {
|
---|
2454 | return () if (! _IsInt($d,-31,31) || $d==0);
|
---|
2455 | }
|
---|
2456 | }
|
---|
2457 |
|
---|
2458 | # We need to find years that are a multiple of $n from $y(base)
|
---|
2459 | ($y0)=( _Date_Split($date0, 1) )[0];
|
---|
2460 | ($y1)=( _Date_Split($date1, 1) )[0];
|
---|
2461 | if ($dateb) {
|
---|
2462 | ($yb)=( _Date_Split($dateb, 1) )[0];
|
---|
2463 | } else {
|
---|
2464 | # If $y=1, there is no base year
|
---|
2465 | $yb=0;
|
---|
2466 | }
|
---|
2467 |
|
---|
2468 | @date=();
|
---|
2469 | for ($yy=$y0; $yy<=$y1; $yy++) {
|
---|
2470 | if (($yy-$yb)%$n == 0) {
|
---|
2471 | foreach $m (@m) {
|
---|
2472 | foreach $d (@d) {
|
---|
2473 | my $dim = Date_DaysInMonth($m,$yy);
|
---|
2474 | my $tmpd = $d;
|
---|
2475 | if ($tmpd < 0) {
|
---|
2476 | $tmpd += ($dim+1);
|
---|
2477 | }
|
---|
2478 | next if (! _IsInt($tmpd,1,$dim));
|
---|
2479 | $date=_Date_Join($yy,$m,$tmpd,0,0,0);
|
---|
2480 | push(@date,$date);
|
---|
2481 | }
|
---|
2482 | }
|
---|
2483 | }
|
---|
2484 | }
|
---|
2485 | last RECUR;
|
---|
2486 |
|
---|
2487 | } else {
|
---|
2488 |
|
---|
2489 | # Y * M-WOM-DOW-H-MN-S
|
---|
2490 | # Y * M-WOM-0-H-MN-S
|
---|
2491 | return () if (! $dateb && $y != 1);
|
---|
2492 |
|
---|
2493 | @m=_ReturnList($m);
|
---|
2494 | return () if (! @m);
|
---|
2495 | @w=_ReturnList($w);
|
---|
2496 | return () if (! @w);
|
---|
2497 |
|
---|
2498 | if ($d eq "0") {
|
---|
2499 | @d=(1);
|
---|
2500 | } else {
|
---|
2501 | @d=_ReturnList($d);
|
---|
2502 | }
|
---|
2503 |
|
---|
2504 | ($y0)=( _Date_Split($date0, 1) )[0];
|
---|
2505 | ($y1)=( _Date_Split($date1, 1) )[0];
|
---|
2506 | if ($dateb) {
|
---|
2507 | ($yb)=( _Date_Split($dateb, 1) )[0];
|
---|
2508 | } else {
|
---|
2509 | # If $y=1, there is no base year
|
---|
2510 | $yb=0;
|
---|
2511 | }
|
---|
2512 | @y=();
|
---|
2513 | for ($yy=$y0; $yy<=$y1; $yy++) {
|
---|
2514 | if (($yy-$yb)%$n == 0) {
|
---|
2515 | push(@y,$yy);
|
---|
2516 | }
|
---|
2517 | }
|
---|
2518 |
|
---|
2519 | @date=_Date_Recur_WoM(\@y,\@m,\@w,\@d);
|
---|
2520 | last RECUR;
|
---|
2521 | }
|
---|
2522 | }
|
---|
2523 |
|
---|
2524 | if ($#recur0==1) {
|
---|
2525 |
|
---|
2526 | # Y-M * W-D-H-MN-S
|
---|
2527 |
|
---|
2528 | if ($w eq "0") {
|
---|
2529 | # Y-M * 0-D-H-MN-S => Y-M-0 * D-H-MN-S
|
---|
2530 | push(@recur0,0);
|
---|
2531 | shift(@recur1);
|
---|
2532 |
|
---|
2533 | } elsif ($m==0) {
|
---|
2534 |
|
---|
2535 | # Y-0 * WOY-0-H-MN-S
|
---|
2536 | # Y-0 * WOY-DOW-H-MN-S
|
---|
2537 | return () if (! $dateb && $y != 1);
|
---|
2538 | $n=$y;
|
---|
2539 | $n=1 if ($n==0);
|
---|
2540 |
|
---|
2541 | @w=_ReturnList($w);
|
---|
2542 | return () if (! @w);
|
---|
2543 | foreach $w (@w) {
|
---|
2544 | return () if ($w==0 || ! _IsInt($w,-53,53));
|
---|
2545 | }
|
---|
2546 |
|
---|
2547 | if ($d eq "0") {
|
---|
2548 | @d=(1);
|
---|
2549 | } else {
|
---|
2550 | @d=_ReturnList($d);
|
---|
2551 | return () if (! @d);
|
---|
2552 | foreach $d (@d) {
|
---|
2553 | $d += 8 if ($d<0);
|
---|
2554 | return () if (! _IsInt($d,1,7));
|
---|
2555 | }
|
---|
2556 | }
|
---|
2557 |
|
---|
2558 | # We need to find years that are a multiple of $n from $y(base)
|
---|
2559 | ($y0)=( _Date_Split($date0, 1) )[0];
|
---|
2560 | ($y1)=( _Date_Split($date1, 1) )[0];
|
---|
2561 | if ($dateb) {
|
---|
2562 | ($yb)=( _Date_Split($dateb, 1) )[0];
|
---|
2563 | } else {
|
---|
2564 | # If $y=1, there is no base year
|
---|
2565 | $yb=0;
|
---|
2566 | }
|
---|
2567 |
|
---|
2568 | @date=();
|
---|
2569 | for ($yy=$y0; $yy<=$y1; $yy++) {
|
---|
2570 | if (($yy-$yb)%$n == 0) {
|
---|
2571 | foreach $w (@w) {
|
---|
2572 | foreach $d (@d) {
|
---|
2573 | my($tmpw,$del);
|
---|
2574 | if ($w<0) {
|
---|
2575 | $date="$yy-12-31-00:00:00";
|
---|
2576 | $tmpw = (-$w)-1;
|
---|
2577 | $del="-0:0:$tmpw:0:0:0:0";
|
---|
2578 | $date=Date_GetPrev($date,$d,1);
|
---|
2579 | } else {
|
---|
2580 | $date="$yy-01-01-00:00:00";
|
---|
2581 | $tmpw = ($w)-1;
|
---|
2582 | $del="0:0:$tmpw:0:0:0:0";
|
---|
2583 | $date=Date_GetNext($date,$d,1);
|
---|
2584 | }
|
---|
2585 | $date=DateCalc($date,$del);
|
---|
2586 | next if ((_Date_Split($date))[0] != $yy);
|
---|
2587 | push(@date,$date);
|
---|
2588 | }
|
---|
2589 | }
|
---|
2590 | }
|
---|
2591 | }
|
---|
2592 | last RECUR;
|
---|
2593 |
|
---|
2594 | } else {
|
---|
2595 |
|
---|
2596 | # Y-M * WOM-0-H-MN-S
|
---|
2597 | # Y-M * WOM-DOW-H-MN-S
|
---|
2598 | return () if (! $dateb && ($y != 0 || $m != 1));
|
---|
2599 | @tmp=(@recur0);
|
---|
2600 | push(@tmp,0) while ($#tmp<6);
|
---|
2601 | $delta=join(":",@tmp);
|
---|
2602 | $dateb=$date0 if (! $dateb);
|
---|
2603 | @tmp=_Date_Recur($date0,$date1,$dateb,$delta);
|
---|
2604 |
|
---|
2605 | @w=_ReturnList($w);
|
---|
2606 | @m=();
|
---|
2607 | if ($d eq "0") {
|
---|
2608 | @d=(1);
|
---|
2609 | } else {
|
---|
2610 | @d=_ReturnList($d);
|
---|
2611 | }
|
---|
2612 |
|
---|
2613 | @date=_Date_Recur_WoM(\@tmp,\@m,\@w,\@d);
|
---|
2614 | last RECUR;
|
---|
2615 | }
|
---|
2616 | }
|
---|
2617 |
|
---|
2618 | if ($#recur0==2) {
|
---|
2619 | # Y-M-W * D-H-MN-S
|
---|
2620 |
|
---|
2621 | if ($d eq "0") {
|
---|
2622 |
|
---|
2623 | # Y-M-W * 0-H-MN-S
|
---|
2624 | return () if (! $dateb);
|
---|
2625 | $y=1 if ($y==0 && $m==0 && $w==0);
|
---|
2626 | $delta="$y:$m:$w:0:0:0:0";
|
---|
2627 | @date=_Date_Recur($date0,$date1,$dateb,$delta);
|
---|
2628 | last RECUR;
|
---|
2629 |
|
---|
2630 | } elsif ($m==0 && $w==0) {
|
---|
2631 |
|
---|
2632 | # Y-0-0 * DOY-H-MN-S
|
---|
2633 | $y=1 if ($y==0);
|
---|
2634 | $n=$y;
|
---|
2635 | return () if (! $dateb && $y!=1);
|
---|
2636 |
|
---|
2637 | @d=_ReturnList($d);
|
---|
2638 | return () if (! @d);
|
---|
2639 | foreach $d (@d) {
|
---|
2640 | return () if (! _IsInt($d,-366,366) || $d==0);
|
---|
2641 | }
|
---|
2642 |
|
---|
2643 | # We need to find years that are a multiple of $n from $y(base)
|
---|
2644 | ($y0)=( _Date_Split($date0, 1) )[0];
|
---|
2645 | ($y1)=( _Date_Split($date1, 1) )[0];
|
---|
2646 | if ($dateb) {
|
---|
2647 | ($yb)=( _Date_Split($dateb, 1) )[0];
|
---|
2648 | } else {
|
---|
2649 | # If $y=1, there is no base year
|
---|
2650 | $yb=0;
|
---|
2651 | }
|
---|
2652 | @date=();
|
---|
2653 | for ($yy=$y0; $yy<=$y1; $yy++) {
|
---|
2654 | my $diy = Date_DaysInYear($yy);
|
---|
2655 | if (($yy-$yb)%$n == 0) {
|
---|
2656 | foreach $d (@d) {
|
---|
2657 | my $tmpd = $d;
|
---|
2658 | $tmpd += ($diy+1) if ($tmpd<0);
|
---|
2659 | next if (! _IsInt($tmpd,1,$diy));
|
---|
2660 | ($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd);
|
---|
2661 | push(@date, _Date_Join($y,$m,$dd,0,0,0));
|
---|
2662 | }
|
---|
2663 | }
|
---|
2664 | }
|
---|
2665 | last RECUR;
|
---|
2666 |
|
---|
2667 | } elsif ($w>0) {
|
---|
2668 |
|
---|
2669 | # Y-M-W * DOW-H-MN-S
|
---|
2670 | return () if (! $dateb && ($y != 0 && $m != 0 && $w != 1));
|
---|
2671 | @tmp=(@recur0);
|
---|
2672 | push(@tmp,0) while ($#tmp<6);
|
---|
2673 | $delta=join(":",@tmp);
|
---|
2674 |
|
---|
2675 | @d=_ReturnList($d);
|
---|
2676 | return () if (! @d);
|
---|
2677 | foreach $d (@d) {
|
---|
2678 | $d += 8 if ($d<0);
|
---|
2679 | return () if (! _IsInt($d,1,7));
|
---|
2680 | }
|
---|
2681 |
|
---|
2682 | # Find out what DofW the basedate is.
|
---|
2683 | $dateb = $date0 if (! $dateb);
|
---|
2684 | @tmp2=_Date_Split($dateb, 1);
|
---|
2685 | $tmp=Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]);
|
---|
2686 |
|
---|
2687 | @date=();
|
---|
2688 | foreach $d (@d) {
|
---|
2689 | $date_b=$dateb;
|
---|
2690 | # Move basedate to DOW in the same week
|
---|
2691 | if ($d != $tmp) {
|
---|
2692 | if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
|
---|
2693 | ($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
|
---|
2694 | ($tmp<$d && $d<$Cnf{"FirstDay"})) {
|
---|
2695 | $date_b=Date_GetNext($date_b,$d);
|
---|
2696 | } else {
|
---|
2697 | $date_b=Date_GetPrev($date_b,$d);
|
---|
2698 | }
|
---|
2699 | }
|
---|
2700 | push(@date,_Date_Recur($date0,$date1,$date_b,$delta));
|
---|
2701 | }
|
---|
2702 | last RECUR;
|
---|
2703 |
|
---|
2704 | } elsif ($m>0) {
|
---|
2705 |
|
---|
2706 | # Y-M-0 * DOM-H-MN-S
|
---|
2707 | return () if (! $dateb && ($y != 0 && $m != 1));
|
---|
2708 | @tmp=(@recur0);
|
---|
2709 | push(@tmp,0) while ($#tmp<6);
|
---|
2710 | $delta=join(":",@tmp);
|
---|
2711 |
|
---|
2712 | @d=_ReturnList($d);
|
---|
2713 | return () if (! @d);
|
---|
2714 | foreach $d (@d) {
|
---|
2715 | return () if ($d==0 || ! _IsInt($d,-31,31));
|
---|
2716 | }
|
---|
2717 | $dateb = $date0 if (! $dateb);
|
---|
2718 |
|
---|
2719 | @tmp2=_Date_Recur($date0,$date1,$dateb,$delta);
|
---|
2720 | @date=();
|
---|
2721 | foreach $date (@tmp2) {
|
---|
2722 | ($y,$m)=( _Date_Split($date, 1) )[0..1];
|
---|
2723 | my $dim=Date_DaysInMonth($m,$y);
|
---|
2724 | foreach $d (@d) {
|
---|
2725 | my $tmpd = $d;
|
---|
2726 | $tmpd += ($dim+1) if ($tmpd<0);
|
---|
2727 | next if (! _IsInt($tmpd,1,$dim));
|
---|
2728 | push(@date,_Date_Join($y,$m,$tmpd,0,0,0));
|
---|
2729 | }
|
---|
2730 | }
|
---|
2731 | last RECUR;
|
---|
2732 |
|
---|
2733 | } else {
|
---|
2734 | return ();
|
---|
2735 | }
|
---|
2736 | }
|
---|
2737 |
|
---|
2738 | if ($#recur0>2) {
|
---|
2739 |
|
---|
2740 | # Y-M-W-D * H-MN-S
|
---|
2741 | # Y-M-W-D-H * MN-S
|
---|
2742 | # Y-M-W-D-H-MN * S
|
---|
2743 | # Y-M-W-D-H-S
|
---|
2744 | if (($#recur0 == 3 &&
|
---|
2745 | ($y == 0 && $m == 0 && $w == 0 && $d == 1)) ||
|
---|
2746 | ($#recur0 == 4 &&
|
---|
2747 | ($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 1)) ||
|
---|
2748 | ($#recur0 == 5 &&
|
---|
2749 | ($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 0 &&
|
---|
2750 | $mn == 1))) {
|
---|
2751 | $dateb = $date0;
|
---|
2752 | }
|
---|
2753 | return () if (! $dateb);
|
---|
2754 | @tmp=(@recur0);
|
---|
2755 | push(@tmp,0) while ($#tmp<6);
|
---|
2756 | $delta=join(":",@tmp);
|
---|
2757 | return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
|
---|
2758 | @date=_Date_Recur($date0,$date1,$dateb,$delta);
|
---|
2759 | if (@recur1) {
|
---|
2760 | unshift(@recur1,-1) while ($#recur1<2);
|
---|
2761 | @time=@recur1;
|
---|
2762 | } else {
|
---|
2763 | shift(@date);
|
---|
2764 | pop(@date);
|
---|
2765 | @time=();
|
---|
2766 | }
|
---|
2767 | }
|
---|
2768 |
|
---|
2769 | last RECUR;
|
---|
2770 | }
|
---|
2771 | @date=_Date_RecurSetTime($date0,$date1,\@date,@time) if (@time);
|
---|
2772 |
|
---|
2773 | #
|
---|
2774 | # We've got a list of dates. Operate on them with the flags.
|
---|
2775 | #
|
---|
2776 |
|
---|
2777 | my($sign,$forw,$today,$df,$db,$work,$i);
|
---|
2778 | if (@flags) {
|
---|
2779 | FLAG: foreach $f (@flags) {
|
---|
2780 | $f = uc($f);
|
---|
2781 |
|
---|
2782 | if ($f =~ /^(P|N)(D|T)([1-7])$/) {
|
---|
2783 | @tmp=($1,$2,$3);
|
---|
2784 | $forw =($tmp[0] eq "P" ? 0 : 1);
|
---|
2785 | $today=($tmp[1] eq "D" ? 0 : 1);
|
---|
2786 | $d=$tmp[2];
|
---|
2787 | @tmp=();
|
---|
2788 | foreach $date (@date) {
|
---|
2789 | if ($forw) {
|
---|
2790 | push(@tmp, Date_GetNext($date,$d,$today));
|
---|
2791 | } else {
|
---|
2792 | push(@tmp, Date_GetPrev($date,$d,$today));
|
---|
2793 | }
|
---|
2794 | }
|
---|
2795 | @date=@tmp;
|
---|
2796 | next FLAG;
|
---|
2797 | }
|
---|
2798 |
|
---|
2799 | # We want to go forward exact amounts of time instead of
|
---|
2800 | # business mode calculations so that we don't change the time
|
---|
2801 | # (which may have been set in the recur).
|
---|
2802 | if ($f =~ /^(F|B)(D|W)(\d+)$/) {
|
---|
2803 | @tmp=($1,$2,$3);
|
---|
2804 | $sign="+";
|
---|
2805 | $sign="-" if ($tmp[0] eq "B");
|
---|
2806 | $work=0;
|
---|
2807 | $work=1 if ($tmp[1] eq "W");
|
---|
2808 | $n=$tmp[2];
|
---|
2809 | @tmp=();
|
---|
2810 | foreach $date (@date) {
|
---|
2811 | for ($i=1; $i<=$n; $i++) {
|
---|
2812 | while (1) {
|
---|
2813 | $date=DateCalc($date,"${sign}0:0:0:1:0:0:0");
|
---|
2814 | last if (! $work || Date_IsWorkDay($date,0));
|
---|
2815 | }
|
---|
2816 | }
|
---|
2817 | push(@tmp,$date);
|
---|
2818 | }
|
---|
2819 | @date=@tmp;
|
---|
2820 | next FLAG;
|
---|
2821 | }
|
---|
2822 |
|
---|
2823 | if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
|
---|
2824 | $tmp=$1;
|
---|
2825 | my $noalt = $2 ? 1 : 0;
|
---|
2826 | if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
|
---|
2827 | $forw=1;
|
---|
2828 | } else {
|
---|
2829 | $forw=0;
|
---|
2830 | }
|
---|
2831 |
|
---|
2832 | @tmp=();
|
---|
2833 | DATE: foreach $date (@date) {
|
---|
2834 | $df=$db=$date;
|
---|
2835 | if (Date_IsWorkDay($date)) {
|
---|
2836 | push(@tmp,$date);
|
---|
2837 | next DATE;
|
---|
2838 | }
|
---|
2839 | while (1) {
|
---|
2840 | if ($forw) {
|
---|
2841 | $d=$df=DateCalc($df,"+0:0:0:1:0:0:0");
|
---|
2842 | } else {
|
---|
2843 | $d=$db=DateCalc($db,"-0:0:0:1:0:0:0");
|
---|
2844 | }
|
---|
2845 | if (Date_IsWorkDay($d)) {
|
---|
2846 | push(@tmp,$d);
|
---|
2847 | next DATE;
|
---|
2848 | }
|
---|
2849 | $forw=1-$forw if (! $noalt);
|
---|
2850 | }
|
---|
2851 | }
|
---|
2852 | @date=@tmp;
|
---|
2853 | next FLAG;
|
---|
2854 | }
|
---|
2855 |
|
---|
2856 | if ($f eq "EASTER") {
|
---|
2857 | @tmp=();
|
---|
2858 | foreach $date (@date) {
|
---|
2859 | ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
|
---|
2860 | ($m,$d)=_Date_Easter($y);
|
---|
2861 | $date=_Date_Join($y,$m,$d,$h,$mn,$s);
|
---|
2862 | next if (Date_Cmp($date,$date0)<0 ||
|
---|
2863 | Date_Cmp($date,$date1)>0);
|
---|
2864 | push(@tmp,$date);
|
---|
2865 | }
|
---|
2866 | @date=@tmp;
|
---|
2867 | }
|
---|
2868 | }
|
---|
2869 | }
|
---|
2870 |
|
---|
2871 | @date = sort { Date_Cmp($a,$b) } @date;
|
---|
2872 | return @date;
|
---|
2873 | }
|
---|
2874 |
|
---|
2875 | sub Date_GetPrev {
|
---|
2876 | print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
2877 | my($date,$dow,$today,$hr,$min,$sec)=@_;
|
---|
2878 | Date_Init() if (! $Curr{"InitDone"});
|
---|
2879 | my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
|
---|
2880 | $adjust,$curr)=();
|
---|
2881 | $hr="00" if (defined $hr && $hr eq "0");
|
---|
2882 | $min="00" if (defined $min && $min eq "0");
|
---|
2883 | $sec="00" if (defined $sec && $sec eq "0");
|
---|
2884 |
|
---|
2885 | if (! _Date_Split($date)) {
|
---|
2886 | $date=ParseDateString($date);
|
---|
2887 | return "" if (! $date);
|
---|
2888 | }
|
---|
2889 | $curr=$date;
|
---|
2890 | ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
|
---|
2891 |
|
---|
2892 | if ($dow) {
|
---|
2893 | $curr_dow=Date_DayOfWeek($m,$d,$y);
|
---|
2894 | %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
|
---|
2895 | if (_IsInt($dow)) {
|
---|
2896 | return "" if ($dow<1 || $dow>7);
|
---|
2897 | } else {
|
---|
2898 | return "" if (! exists $dow{lc($dow)});
|
---|
2899 | $dow=$dow{lc($dow)};
|
---|
2900 | }
|
---|
2901 | if ($dow == $curr_dow) {
|
---|
2902 | $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today);
|
---|
2903 | $adjust=1 if ($today==2);
|
---|
2904 | } else {
|
---|
2905 | $dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
|
---|
2906 | $num = $curr_dow - $dow;
|
---|
2907 | $date=_DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0);
|
---|
2908 | }
|
---|
2909 | $date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
|
---|
2910 | $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0)
|
---|
2911 | if ($adjust && Date_Cmp($date,$curr)>0);
|
---|
2912 |
|
---|
2913 | } else {
|
---|
2914 | ($h,$mn,$s)=( _Date_Split($date, 1) )[3..5];
|
---|
2915 | ($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec);
|
---|
2916 | if ($hr) {
|
---|
2917 | ($hr,$min,$sec)=($th,$tm,$ts);
|
---|
2918 | $delta="-0:0:0:1:0:0:0";
|
---|
2919 | } elsif ($min) {
|
---|
2920 | ($hr,$min,$sec)=($h,$tm,$ts);
|
---|
2921 | $delta="-0:0:0:0:1:0:0";
|
---|
2922 | } elsif ($sec) {
|
---|
2923 | ($hr,$min,$sec)=($h,$mn,$ts);
|
---|
2924 | $delta="-0:0:0:0:0:1:0";
|
---|
2925 | } else {
|
---|
2926 | confess "ERROR: invalid arguments in Date_GetPrev.\n";
|
---|
2927 | }
|
---|
2928 |
|
---|
2929 | $d=Date_SetTime($date,$hr,$min,$sec);
|
---|
2930 | if ($today) {
|
---|
2931 | $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>0);
|
---|
2932 | } else {
|
---|
2933 | $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>=0);
|
---|
2934 | }
|
---|
2935 | $date=$d;
|
---|
2936 | }
|
---|
2937 | return $date;
|
---|
2938 | }
|
---|
2939 |
|
---|
2940 | sub Date_GetNext {
|
---|
2941 | print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
2942 | my($date,$dow,$today,$hr,$min,$sec)=@_;
|
---|
2943 | Date_Init() if (! $Curr{"InitDone"});
|
---|
2944 | my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
|
---|
2945 | $adjust,$curr)=();
|
---|
2946 | $hr="00" if (defined $hr && $hr eq "0");
|
---|
2947 | $min="00" if (defined $min && $min eq "0");
|
---|
2948 | $sec="00" if (defined $sec && $sec eq "0");
|
---|
2949 |
|
---|
2950 | if (! _Date_Split($date)) {
|
---|
2951 | $date=ParseDateString($date);
|
---|
2952 | return "" if (! $date);
|
---|
2953 | }
|
---|
2954 | $curr=$date;
|
---|
2955 | ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
|
---|
2956 |
|
---|
2957 | if ($dow) {
|
---|
2958 | $curr_dow=Date_DayOfWeek($m,$d,$y);
|
---|
2959 | %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
|
---|
2960 | if (_IsInt($dow)) {
|
---|
2961 | return "" if ($dow<1 || $dow>7);
|
---|
2962 | } else {
|
---|
2963 | return "" if (! exists $dow{lc($dow)});
|
---|
2964 | $dow=$dow{lc($dow)};
|
---|
2965 | }
|
---|
2966 | if ($dow == $curr_dow) {
|
---|
2967 | $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today);
|
---|
2968 | $adjust=1 if ($today==2);
|
---|
2969 | } else {
|
---|
2970 | $curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
|
---|
2971 | $num = $dow - $curr_dow;
|
---|
2972 | $date=_DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0);
|
---|
2973 | }
|
---|
2974 | $date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
|
---|
2975 | $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0)
|
---|
2976 | if ($adjust && Date_Cmp($date,$curr)<0);
|
---|
2977 |
|
---|
2978 | } else {
|
---|
2979 | ($h,$mn,$s)=( _Date_Split($date, 1) )[3..5];
|
---|
2980 | ($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec);
|
---|
2981 | if ($hr) {
|
---|
2982 | ($hr,$min,$sec)=($th,$tm,$ts);
|
---|
2983 | $delta="+0:0:0:1:0:0:0";
|
---|
2984 | } elsif ($min) {
|
---|
2985 | ($hr,$min,$sec)=($h,$tm,$ts);
|
---|
2986 | $delta="+0:0:0:0:1:0:0";
|
---|
2987 | } elsif ($sec) {
|
---|
2988 | ($hr,$min,$sec)=($h,$mn,$ts);
|
---|
2989 | $delta="+0:0:0:0:0:1:0";
|
---|
2990 | } else {
|
---|
2991 | confess "ERROR: invalid arguments in Date_GetNext.\n";
|
---|
2992 | }
|
---|
2993 |
|
---|
2994 | $d=Date_SetTime($date,$hr,$min,$sec);
|
---|
2995 | if ($today) {
|
---|
2996 | $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<0);
|
---|
2997 | } else {
|
---|
2998 | $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<1);
|
---|
2999 | }
|
---|
3000 | $date=$d;
|
---|
3001 | }
|
---|
3002 |
|
---|
3003 | return $date;
|
---|
3004 | }
|
---|
3005 |
|
---|
3006 | sub Date_IsHoliday {
|
---|
3007 | print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3008 | my($date)=@_;
|
---|
3009 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3010 | $date=ParseDateString($date);
|
---|
3011 | return undef if (! $date);
|
---|
3012 | $date=Date_SetTime($date,0,0,0);
|
---|
3013 | my($y)=(_Date_Split($date, 1))[0];
|
---|
3014 | _Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y});
|
---|
3015 | return undef if (! exists $Holiday{"dates"}{$y}{$date});
|
---|
3016 | my($name)=$Holiday{"dates"}{$y}{$date};
|
---|
3017 | return "" if (! $name);
|
---|
3018 | $name;
|
---|
3019 | }
|
---|
3020 |
|
---|
3021 | sub Events_List {
|
---|
3022 | print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3023 | my(@args)=@_;
|
---|
3024 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3025 | _Events_ParseRaw();
|
---|
3026 |
|
---|
3027 | my($tmp,$date0,$date1,$flag);
|
---|
3028 | $date0=ParseDateString($args[0]);
|
---|
3029 | warn "Invalid date $args[0]", return undef if (! $date0);
|
---|
3030 |
|
---|
3031 | if ($#args == 0) {
|
---|
3032 | return _Events_Calc($date0);
|
---|
3033 | }
|
---|
3034 |
|
---|
3035 | if ($args[1]) {
|
---|
3036 | $date1=ParseDateString($args[1]);
|
---|
3037 | warn "Invalid date $args[1]\n", return undef if (! $date1);
|
---|
3038 | if (Date_Cmp($date0,$date1)>0) {
|
---|
3039 | $tmp=$date1;
|
---|
3040 | $date1=$date0;
|
---|
3041 | $date0=$tmp;
|
---|
3042 | }
|
---|
3043 | } else {
|
---|
3044 | $date0=Date_SetTime($date0,"00:00:00");
|
---|
3045 | $date1=_DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0");
|
---|
3046 | }
|
---|
3047 |
|
---|
3048 | $tmp=_Events_Calc($date0,$date1);
|
---|
3049 |
|
---|
3050 | $flag=$args[2];
|
---|
3051 | return $tmp if (! $flag);
|
---|
3052 |
|
---|
3053 | my(@tmp,%ret,$delta)=();
|
---|
3054 | @tmp=@$tmp;
|
---|
3055 | push(@tmp,$date1);
|
---|
3056 |
|
---|
3057 | if ($flag==1) {
|
---|
3058 | while ($#tmp>0) {
|
---|
3059 | ($date0,$tmp)=splice(@tmp,0,2);
|
---|
3060 | $date1=$tmp[0];
|
---|
3061 | $delta=_DateCalc_DateDate($date0,$date1);
|
---|
3062 | foreach $flag (@$tmp) {
|
---|
3063 | if (exists $ret{$flag}) {
|
---|
3064 | $ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta);
|
---|
3065 | } else {
|
---|
3066 | $ret{$flag}=$delta;
|
---|
3067 | }
|
---|
3068 | }
|
---|
3069 | }
|
---|
3070 | return \%ret;
|
---|
3071 |
|
---|
3072 | } elsif ($flag==2) {
|
---|
3073 | while ($#tmp>0) {
|
---|
3074 | ($date0,$tmp)=splice(@tmp,0,2);
|
---|
3075 | $date1=$tmp[0];
|
---|
3076 | $delta=_DateCalc_DateDate($date0,$date1);
|
---|
3077 | $flag=join("+",sort { Date_Cmp($a,$b) } @$tmp);
|
---|
3078 | next if (! $flag);
|
---|
3079 | if (exists $ret{$flag}) {
|
---|
3080 | $ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta);
|
---|
3081 | } else {
|
---|
3082 | $ret{$flag}=$delta;
|
---|
3083 | }
|
---|
3084 | }
|
---|
3085 | return \%ret;
|
---|
3086 | }
|
---|
3087 |
|
---|
3088 | warn "Invalid flag $flag\n";
|
---|
3089 | return undef;
|
---|
3090 | }
|
---|
3091 |
|
---|
3092 | ###
|
---|
3093 | # NOTE: The following routines may be called in the routines below with very
|
---|
3094 | # little time penalty.
|
---|
3095 | ###
|
---|
3096 | sub Date_SetTime {
|
---|
3097 | print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3098 | my($date,$h,$mn,$s)=@_;
|
---|
3099 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3100 | my($y,$m,$d)=();
|
---|
3101 |
|
---|
3102 | if (! _Date_Split($date)) {
|
---|
3103 | $date=ParseDateString($date);
|
---|
3104 | return "" if (! $date);
|
---|
3105 | }
|
---|
3106 |
|
---|
3107 | ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
|
---|
3108 | ($h,$mn,$s)=_Date_ParseTime($h,$mn,$s);
|
---|
3109 |
|
---|
3110 | my($ampm,$wk);
|
---|
3111 | return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
---|
3112 | _Date_Join($y,$m,$d,$h,$mn,$s);
|
---|
3113 | }
|
---|
3114 |
|
---|
3115 | sub Date_SetDateField {
|
---|
3116 | print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3117 | my($date,$field,$val,$nocheck)=@_;
|
---|
3118 | my($y,$m,$d,$h,$mn,$s)=();
|
---|
3119 | $nocheck=0 if (! defined $nocheck);
|
---|
3120 |
|
---|
3121 | ($y,$m,$d,$h,$mn,$s)=_Date_Split($date);
|
---|
3122 |
|
---|
3123 | if (! $y) {
|
---|
3124 | $date=ParseDateString($date);
|
---|
3125 | return "" if (! $date);
|
---|
3126 | ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
|
---|
3127 | }
|
---|
3128 |
|
---|
3129 | if (lc($field) eq "y") {
|
---|
3130 | $y=$val;
|
---|
3131 | } elsif (lc($field) eq "m") {
|
---|
3132 | $m=$val;
|
---|
3133 | } elsif (lc($field) eq "d") {
|
---|
3134 | $d=$val;
|
---|
3135 | } elsif (lc($field) eq "h") {
|
---|
3136 | $h=$val;
|
---|
3137 | } elsif (lc($field) eq "mn") {
|
---|
3138 | $mn=$val;
|
---|
3139 | } elsif (lc($field) eq "s") {
|
---|
3140 | $s=$val;
|
---|
3141 | } else {
|
---|
3142 | confess "ERROR: Date_SetDateField: invalid field: $field\n";
|
---|
3143 | }
|
---|
3144 |
|
---|
3145 | $date=_Date_Join($y,$m,$d,$h,$mn,$s);
|
---|
3146 | return $date if ($nocheck || _Date_Split($date));
|
---|
3147 | return "";
|
---|
3148 | }
|
---|
3149 |
|
---|
3150 | ########################################################################
|
---|
3151 | # OTHER SUBROUTINES
|
---|
3152 | ########################################################################
|
---|
3153 | # NOTE: These routines should not call any of the routines above as
|
---|
3154 | # there will be a severe time penalty (and the possibility of
|
---|
3155 | # infinite recursion). The last couple routines above are
|
---|
3156 | # exceptions.
|
---|
3157 | # NOTE: Date_Init is a special case. It should be called (conditionally)
|
---|
3158 | # in every routine that uses any variable from the Date::Manip
|
---|
3159 | # namespace.
|
---|
3160 | ########################################################################
|
---|
3161 |
|
---|
3162 | sub Date_DaysInMonth {
|
---|
3163 | print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3164 | my($m,$y)=@_;
|
---|
3165 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3166 | my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
---|
3167 | $d_in_m[2]=29 if (Date_LeapYear($y));
|
---|
3168 | return $d_in_m[$m];
|
---|
3169 | }
|
---|
3170 |
|
---|
3171 | sub Date_DayOfWeek {
|
---|
3172 | print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3173 | my($m,$d,$y)=@_;
|
---|
3174 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3175 | my($dayofweek,$dec31)=();
|
---|
3176 |
|
---|
3177 | $dec31=5; # Dec 31, 1BC was Friday
|
---|
3178 | $dayofweek=(Date_DaysSince1BC($m,$d,$y)+$dec31) % 7;
|
---|
3179 | $dayofweek=7 if ($dayofweek==0);
|
---|
3180 | return $dayofweek;
|
---|
3181 | }
|
---|
3182 |
|
---|
3183 | # Can't be in "use integer" because the numbers are too big.
|
---|
3184 | no integer;
|
---|
3185 | sub Date_SecsSince1970 {
|
---|
3186 | print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3187 | my($m,$d,$y,$h,$mn,$s)=@_;
|
---|
3188 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3189 | my($sec_now,$sec_70)=();
|
---|
3190 | $sec_now=(Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s;
|
---|
3191 | # $sec_70 =(Date_DaysSince1BC(1,1,1970)-1)*24*3600;
|
---|
3192 | $sec_70 =62167219200;
|
---|
3193 | return ($sec_now-$sec_70);
|
---|
3194 | }
|
---|
3195 |
|
---|
3196 | sub Date_SecsSince1970GMT {
|
---|
3197 | print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3198 | my($m,$d,$y,$h,$mn,$s)=@_;
|
---|
3199 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3200 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3201 |
|
---|
3202 | my($sec)=Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
|
---|
3203 | return $sec if ($Cnf{"ConvTZ"} eq "IGNORE");
|
---|
3204 |
|
---|
3205 | my($tz)=$Cnf{"ConvTZ"};
|
---|
3206 | $tz=$Cnf{"TZ"} if (! $tz);
|
---|
3207 | $tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
|
---|
3208 |
|
---|
3209 | my($tzs)=1;
|
---|
3210 | $tzs=-1 if ($tz<0);
|
---|
3211 | $tz=~/.(..)(..)/;
|
---|
3212 | my($tzh,$tzm)=($1,$2);
|
---|
3213 | $sec - $tzs*($tzh*3600+$tzm*60);
|
---|
3214 | }
|
---|
3215 | use integer;
|
---|
3216 |
|
---|
3217 | sub Date_DaysSince1BC {
|
---|
3218 | print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3219 | my($m,$d,$y)=@_;
|
---|
3220 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3221 | my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
|
---|
3222 | my($cc,$yy)=();
|
---|
3223 |
|
---|
3224 | $y=~ /(\d{2})(\d{2})/;
|
---|
3225 | ($cc,$yy)=($1,$2);
|
---|
3226 |
|
---|
3227 | # Number of full years since Dec 31, 1BC (counting the year 0000).
|
---|
3228 | $Ny=$y;
|
---|
3229 |
|
---|
3230 | # Number of full 4th years (incl. 0000) since Dec 31, 1BC
|
---|
3231 | $N4=($Ny-1)/4 + 1;
|
---|
3232 | $N4=0 if ($y==0);
|
---|
3233 |
|
---|
3234 | # Number of full 100th years (incl. 0000)
|
---|
3235 | $N100=$cc + 1;
|
---|
3236 | $N100-- if ($yy==0);
|
---|
3237 | $N100=0 if ($y==0);
|
---|
3238 |
|
---|
3239 | # Number of full 400th years (incl. 0000)
|
---|
3240 | $N400=($N100-1)/4 + 1;
|
---|
3241 | $N400=0 if ($y==0);
|
---|
3242 |
|
---|
3243 | $dayofyear=Date_DayOfYear($m,$d,$y);
|
---|
3244 | $days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
|
---|
3245 |
|
---|
3246 | return $days;
|
---|
3247 | }
|
---|
3248 |
|
---|
3249 | sub Date_DayOfYear {
|
---|
3250 | print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3251 | my($m,$d,$y)=@_;
|
---|
3252 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3253 | # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
|
---|
3254 | my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
|
---|
3255 | my($ly)=0;
|
---|
3256 | $ly=1 if ($m>2 && Date_LeapYear($y));
|
---|
3257 | return ($days[$m-1]+$d+$ly);
|
---|
3258 | }
|
---|
3259 |
|
---|
3260 | sub Date_DaysInYear {
|
---|
3261 | print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3262 | my($y)=@_;
|
---|
3263 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3264 | return 366 if (Date_LeapYear($y));
|
---|
3265 | return 365;
|
---|
3266 | }
|
---|
3267 |
|
---|
3268 | sub Date_WeekOfYear {
|
---|
3269 | print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3270 | my($m,$d,$y,$f)=@_;
|
---|
3271 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3272 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3273 |
|
---|
3274 | my($day,$dow,$doy)=();
|
---|
3275 | $doy=Date_DayOfYear($m,$d,$y);
|
---|
3276 |
|
---|
3277 | # The current DayOfYear and DayOfWeek
|
---|
3278 | if ($Cnf{"Jan1Week1"}) {
|
---|
3279 | $day=1;
|
---|
3280 | } else {
|
---|
3281 | $day=4;
|
---|
3282 | }
|
---|
3283 | $dow=Date_DayOfWeek(1,$day,$y);
|
---|
3284 |
|
---|
3285 | # Move back to the first day of week 1.
|
---|
3286 | $f-=7 if ($f>$dow);
|
---|
3287 | $day-= ($dow-$f);
|
---|
3288 |
|
---|
3289 | return 0 if ($day>$doy); # Day is in last week of previous year
|
---|
3290 | return (($doy-$day)/7 + 1);
|
---|
3291 | }
|
---|
3292 |
|
---|
3293 | sub Date_LeapYear {
|
---|
3294 | print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3295 | my($y)=@_;
|
---|
3296 | $y=_Date_FixYear($y) if (length($y)!=4);
|
---|
3297 | return 0 unless $y % 4 == 0;
|
---|
3298 | return 1 unless $y % 100 == 0;
|
---|
3299 | return 0 unless $y % 400 == 0;
|
---|
3300 | return 1;
|
---|
3301 | }
|
---|
3302 |
|
---|
3303 | sub Date_DaySuffix {
|
---|
3304 | print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3305 | my($d)=@_;
|
---|
3306 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3307 | return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
|
---|
3308 | }
|
---|
3309 |
|
---|
3310 | sub Date_ConvTZ {
|
---|
3311 | print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3312 | my($date,$from,$to,$level)=@_;
|
---|
3313 | if (not _Date_Split($date)) {
|
---|
3314 | my $err = "date passed in ('$date') is not a Date::Manip object";
|
---|
3315 | if (! $level) {
|
---|
3316 | croak $err;
|
---|
3317 | } elsif ($level==1) {
|
---|
3318 | carp $err;
|
---|
3319 | }
|
---|
3320 | return "";
|
---|
3321 | }
|
---|
3322 |
|
---|
3323 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3324 | my($gmt)=();
|
---|
3325 |
|
---|
3326 | if (! $from) {
|
---|
3327 |
|
---|
3328 | if (! $to) {
|
---|
3329 | # TZ -> ConvTZ
|
---|
3330 | return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
|
---|
3331 | $from=$Cnf{"TZ"};
|
---|
3332 | $to=$Cnf{"ConvTZ"};
|
---|
3333 |
|
---|
3334 | } else {
|
---|
3335 | # ConvTZ,TZ -> $to
|
---|
3336 | $from=$Cnf{"ConvTZ"};
|
---|
3337 | $from=$Cnf{"TZ"} if (! $from);
|
---|
3338 | }
|
---|
3339 |
|
---|
3340 | } else {
|
---|
3341 |
|
---|
3342 | if (! $to) {
|
---|
3343 | # $from -> ConvTZ,TZ
|
---|
3344 | return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
|
---|
3345 | $to=$Cnf{"ConvTZ"};
|
---|
3346 | $to=$Cnf{"TZ"} if (! $to);
|
---|
3347 |
|
---|
3348 | } else {
|
---|
3349 | # $from -> $to
|
---|
3350 | }
|
---|
3351 | }
|
---|
3352 |
|
---|
3353 | $to=$Zone{"n2o"}{lc($to)}
|
---|
3354 | if (exists $Zone{"n2o"}{lc($to)});
|
---|
3355 | $from=$Zone{"n2o"}{lc($from)}
|
---|
3356 | if (exists $Zone{"n2o"}{lc($from)});
|
---|
3357 | $gmt=$Zone{"n2o"}{"gmt"};
|
---|
3358 |
|
---|
3359 | return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/);
|
---|
3360 | return $date if ($from eq $to);
|
---|
3361 |
|
---|
3362 | my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=();
|
---|
3363 | # We're going to try to do the calculation without calling DateCalc.
|
---|
3364 | ($yr,$mon,$d,$h,$m,$sec)=_Date_Split($date, 1);
|
---|
3365 |
|
---|
3366 | # Convert $date from $from to GMT
|
---|
3367 | $from=~/([+-])(\d{2})(\d{2})/;
|
---|
3368 | ($s1,$h1,$m1)=($1,$2,$3);
|
---|
3369 | $s1= ($s1 eq "-" ? "+" : "-"); # switch sign
|
---|
3370 | $sign=$s1 . "1"; # + or - 1
|
---|
3371 |
|
---|
3372 | # and from GMT to $to
|
---|
3373 | $to=~/([+-])(\d{2})(\d{2})/;
|
---|
3374 | ($s2,$h2,$m2)=($1,$2,$3);
|
---|
3375 |
|
---|
3376 | if ($s1 eq $s2) {
|
---|
3377 | # Both the same sign
|
---|
3378 | $m+= $sign*($m1+$m2);
|
---|
3379 | $h+= $sign*($h1+$h2);
|
---|
3380 | } else {
|
---|
3381 | $sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
|
---|
3382 | $m+= $sign*($m1-$m2);
|
---|
3383 | $h+= $sign*($h1-$h2);
|
---|
3384 | }
|
---|
3385 |
|
---|
3386 | if ($m>59) {
|
---|
3387 | $h+= $m/60;
|
---|
3388 | $m-= ($m/60)*60;
|
---|
3389 | } elsif ($m<0) {
|
---|
3390 | $h+= ($m/60 - 1);
|
---|
3391 | $m-= ($m/60 - 1)*60;
|
---|
3392 | }
|
---|
3393 |
|
---|
3394 | if ($h>23) {
|
---|
3395 | $delta=$h/24;
|
---|
3396 | $h -= $delta*24;
|
---|
3397 | if (($d + $delta) > 28) {
|
---|
3398 | $date=_Date_Join($yr,$mon,$d,$h,$m,$sec);
|
---|
3399 | return _DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0);
|
---|
3400 | }
|
---|
3401 | $d+= $delta;
|
---|
3402 | } elsif ($h<0) {
|
---|
3403 | $delta=-$h/24 + 1;
|
---|
3404 | $h += $delta*24;
|
---|
3405 | if (($d - $delta) < 1) {
|
---|
3406 | $date=_Date_Join($yr,$mon,$d,$h,$m,$sec);
|
---|
3407 | return _DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0);
|
---|
3408 | }
|
---|
3409 | $d-= $delta;
|
---|
3410 | }
|
---|
3411 | return _Date_Join($yr,$mon,$d,$h,$m,$sec);
|
---|
3412 | }
|
---|
3413 |
|
---|
3414 | sub Date_TimeZone {
|
---|
3415 | print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3416 | my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=();
|
---|
3417 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3418 |
|
---|
3419 | # Get timezones from all of the relevant places
|
---|
3420 |
|
---|
3421 | push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var
|
---|
3422 | push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var
|
---|
3423 | push(@tz,$ENV{'SYS$TIMEZONE_RULE'})
|
---|
3424 | if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var
|
---|
3425 | push(@tz,$ENV{'SYS$TIMEZONE_NAME'})
|
---|
3426 | if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var
|
---|
3427 | push(@tz,$ENV{'UCX$TZ'})
|
---|
3428 | if defined $ENV{'UCX$TZ'}; # VMS TZ environ var
|
---|
3429 | push(@tz,$ENV{'TCPIP$TZ'})
|
---|
3430 | if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var
|
---|
3431 |
|
---|
3432 | # The `date` command... if we're doing taint checking, we need to
|
---|
3433 | # always call it with a full path... otherwise, use the user's path.
|
---|
3434 | #
|
---|
3435 | # Microsoft operating systems don't have a date command built in. Try
|
---|
3436 | # to trap all the various ways of knowing we are on one of these systems.
|
---|
3437 | #
|
---|
3438 | # We'll try `date +%Z` first, and if that fails, we'll take just the
|
---|
3439 | # `date` program and assume the output is of the format:
|
---|
3440 | # Thu Aug 31 14:57:46 EDT 2000
|
---|
3441 |
|
---|
3442 | unless (($^O ne 'cygwin' && $^X =~ /perl\.exe$/i) or
|
---|
3443 | ($OS eq "Windows") or
|
---|
3444 | ($OS eq "Netware") or
|
---|
3445 | ($OS eq "VMS")) {
|
---|
3446 | if ($Date::Manip::NoTaint) {
|
---|
3447 | if ($OS eq "VMS") {
|
---|
3448 | $tz=$ENV{'SYS$TIMEZONE_NAME'};
|
---|
3449 | if (! $tz) {
|
---|
3450 | $tz=$ENV{'MULTINET_TIMEZONE'};
|
---|
3451 | if (! $tz) {
|
---|
3452 | $tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
|
---|
3453 | }
|
---|
3454 | }
|
---|
3455 | } else {
|
---|
3456 | $tz=`date +%Z 2> /dev/null`;
|
---|
3457 | chomp($tz);
|
---|
3458 | if (! $tz) {
|
---|
3459 | $tz=`date 2> /dev/null`;
|
---|
3460 | chomp($tz);
|
---|
3461 | $tz=(split(/\s+/,$tz))[4];
|
---|
3462 | }
|
---|
3463 | }
|
---|
3464 | push(@tz,$tz) if (defined $tz);
|
---|
3465 | } else {
|
---|
3466 | # We need to satisfy taint checking, but also look in all the
|
---|
3467 | # directories in @DatePath.
|
---|
3468 | #
|
---|
3469 | local $ENV{PATH} = join(':', @Date::Manip::DatePath);
|
---|
3470 | local $ENV{BASH_ENV} = '';
|
---|
3471 | $tz=`date +%Z 2> /dev/null`;
|
---|
3472 | chomp($tz);
|
---|
3473 | if (! $tz) {
|
---|
3474 | $tz=`date 2> /dev/null`;
|
---|
3475 | chomp($tz);
|
---|
3476 | $tz=(split(/\s+/,$tz))[4];
|
---|
3477 | }
|
---|
3478 | push(@tz,$tz) if (defined $tz);
|
---|
3479 | }
|
---|
3480 | }
|
---|
3481 |
|
---|
3482 | push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ
|
---|
3483 |
|
---|
3484 | if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE
|
---|
3485 | $in=new IO::File;
|
---|
3486 | $in->open("/etc/TIMEZONE","r");
|
---|
3487 | while (! eof($in)) {
|
---|
3488 | $tmp=<$in>;
|
---|
3489 | if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
|
---|
3490 | push(@tz,$1);
|
---|
3491 | last;
|
---|
3492 | }
|
---|
3493 | }
|
---|
3494 | $in->close;
|
---|
3495 | }
|
---|
3496 |
|
---|
3497 | if (-s "/etc/timezone") { # /etc/timezone
|
---|
3498 | $in=new IO::File;
|
---|
3499 | $in->open("/etc/timezone","r");
|
---|
3500 | while (! eof($in)) {
|
---|
3501 | $tmp=<$in>;
|
---|
3502 | next if ($tmp =~ /^\s*\043/);
|
---|
3503 | chomp($tmp);
|
---|
3504 | if ($tmp =~ /^\s*(.*?)\s*$/) {
|
---|
3505 | push(@tz,$1);
|
---|
3506 | last;
|
---|
3507 | }
|
---|
3508 | }
|
---|
3509 | $in->close;
|
---|
3510 | }
|
---|
3511 |
|
---|
3512 | print STDERR "Found time zones: @tz\n";
|
---|
3513 |
|
---|
3514 | # Now parse each one to find the first valid one.
|
---|
3515 | foreach $tz (@tz) {
|
---|
3516 | $tz =~ s/\s*$//;
|
---|
3517 | $tz =~ s/^\s*//;
|
---|
3518 | $tz =~ s/^://;
|
---|
3519 | next if ($tz eq "");
|
---|
3520 |
|
---|
3521 | return uc($tz)
|
---|
3522 | if (defined $Zone{"n2o"}{lc($tz)});
|
---|
3523 |
|
---|
3524 | if ($tz =~ /^[+-]\d{4}$/) {
|
---|
3525 | return $tz;
|
---|
3526 | } elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
|
---|
3527 | my($h,$m)=($1,$2);
|
---|
3528 | $m="00" if (! $m);
|
---|
3529 | return "$h$m";
|
---|
3530 | }
|
---|
3531 |
|
---|
3532 | # Handle US/Eastern format
|
---|
3533 | if ($tz =~ /^$Zone{"tzones"}$/i) {
|
---|
3534 | $tmp=lc $1;
|
---|
3535 | $tz=$Zone{"tz2z"}{$tmp};
|
---|
3536 | }
|
---|
3537 |
|
---|
3538 | # Handle STD#DST# format (and STD-#DST-# formats)
|
---|
3539 | if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
|
---|
3540 | ($std,$dst)=($1,$2);
|
---|
3541 | next if (! defined $Zone{"n2o"}{lc($std)} or
|
---|
3542 | ! defined $Zone{"n2o"}{lc($dst)});
|
---|
3543 | $time = time();
|
---|
3544 | ($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
|
---|
3545 | localtime($time);
|
---|
3546 | return uc($dst) if ($isdst);
|
---|
3547 | return uc($std);
|
---|
3548 | }
|
---|
3549 | }
|
---|
3550 |
|
---|
3551 | confess "ERROR: Date::Manip unable to determine Time Zone.\n";
|
---|
3552 | }
|
---|
3553 |
|
---|
3554 | # Returns 1 if $date is a work day. If $time is non-zero, the time is
|
---|
3555 | # also checked to see if it falls within work hours. Returns "" if
|
---|
3556 | # an invalid date is passed in.
|
---|
3557 | sub Date_IsWorkDay {
|
---|
3558 | print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3559 | my($date,$time)=@_;
|
---|
3560 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3561 | $date=ParseDateString($date);
|
---|
3562 | return "" if (! $date);
|
---|
3563 | my($d)=$date;
|
---|
3564 | $d=Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time);
|
---|
3565 |
|
---|
3566 | my($y,$mon,$day,$h,$m,$s,$dow)=();
|
---|
3567 | ($y,$mon,$day,$h,$m,$s)=_Date_Split($d, 1);
|
---|
3568 | $dow=Date_DayOfWeek($mon,$day,$y);
|
---|
3569 |
|
---|
3570 | return 0 if ($dow<$Cnf{"WorkWeekBeg"} or
|
---|
3571 | $dow>$Cnf{"WorkWeekEnd"} or
|
---|
3572 | "$h:$m" lt $Cnf{"WorkDayBeg"} or
|
---|
3573 | "$h:$m" ge $Cnf{"WorkDayEnd"});
|
---|
3574 |
|
---|
3575 | if (! exists $Holiday{"dates"}{$y}) {
|
---|
3576 | # There will be recursion problems if we ever end up here twice.
|
---|
3577 | $Holiday{"dates"}{$y}={};
|
---|
3578 | _Date_UpdateHolidays($y)
|
---|
3579 | }
|
---|
3580 | $d=Date_SetTime($date,"00:00:00");
|
---|
3581 | return 0 if (exists $Holiday{"dates"}{$y}{$d});
|
---|
3582 | 1;
|
---|
3583 | }
|
---|
3584 |
|
---|
3585 | # Finds the day $off work days from now. If $time is passed in, we must
|
---|
3586 | # also take into account the time of day.
|
---|
3587 | #
|
---|
3588 | # If $time is not passed in, day 0 is today (if today is a workday) or the
|
---|
3589 | # next work day if it isn't. In any case, the time of day is unaffected.
|
---|
3590 | #
|
---|
3591 | # If $time is passed in, day 0 is now (if now is part of a workday) or the
|
---|
3592 | # start of the very next work day.
|
---|
3593 | sub Date_NextWorkDay {
|
---|
3594 | print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3595 | my($date,$off,$time)=@_;
|
---|
3596 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3597 | $date=ParseDateString($date);
|
---|
3598 | my($err)=();
|
---|
3599 |
|
---|
3600 | if (! Date_IsWorkDay($date,$time)) {
|
---|
3601 | if ($time) {
|
---|
3602 | while (1) {
|
---|
3603 | $date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
|
---|
3604 | last if (Date_IsWorkDay($date,$time));
|
---|
3605 | }
|
---|
3606 | } else {
|
---|
3607 | while (1) {
|
---|
3608 | $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
|
---|
3609 | last if (Date_IsWorkDay($date,$time));
|
---|
3610 | }
|
---|
3611 | }
|
---|
3612 | }
|
---|
3613 |
|
---|
3614 | while ($off>0) {
|
---|
3615 | while (1) {
|
---|
3616 | $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
|
---|
3617 | last if (Date_IsWorkDay($date,$time));
|
---|
3618 | }
|
---|
3619 | $off--;
|
---|
3620 | }
|
---|
3621 |
|
---|
3622 | return $date;
|
---|
3623 | }
|
---|
3624 |
|
---|
3625 | # Finds the day $off work days before now. If $time is passed in, we must
|
---|
3626 | # also take into account the time of day.
|
---|
3627 | #
|
---|
3628 | # If $time is not passed in, day 0 is today (if today is a workday) or the
|
---|
3629 | # previous work day if it isn't. In any case, the time of day is unaffected.
|
---|
3630 | #
|
---|
3631 | # If $time is passed in, day 0 is now (if now is part of a workday) or the
|
---|
3632 | # end of the previous work period. Note that since the end of a work day
|
---|
3633 | # will automatically be turned into the start of the next one, this time
|
---|
3634 | # may actually be treated as AFTER the current time.
|
---|
3635 | sub Date_PrevWorkDay {
|
---|
3636 | print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3637 | my($date,$off,$time)=@_;
|
---|
3638 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3639 | $date=ParseDateString($date);
|
---|
3640 | my($err)=();
|
---|
3641 |
|
---|
3642 | if (! Date_IsWorkDay($date,$time)) {
|
---|
3643 | if ($time) {
|
---|
3644 | while (1) {
|
---|
3645 | $date=Date_GetPrev($date,undef,0,$Cnf{"WorkDayEnd"});
|
---|
3646 | last if (Date_IsWorkDay($date,$time));
|
---|
3647 | }
|
---|
3648 | while (1) {
|
---|
3649 | $date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
|
---|
3650 | last if (Date_IsWorkDay($date,$time));
|
---|
3651 | }
|
---|
3652 | } else {
|
---|
3653 | while (1) {
|
---|
3654 | $date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
|
---|
3655 | last if (Date_IsWorkDay($date,$time));
|
---|
3656 | }
|
---|
3657 | }
|
---|
3658 | }
|
---|
3659 |
|
---|
3660 | while ($off>0) {
|
---|
3661 | while (1) {
|
---|
3662 | $date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
|
---|
3663 | last if (Date_IsWorkDay($date,$time));
|
---|
3664 | }
|
---|
3665 | $off--;
|
---|
3666 | }
|
---|
3667 |
|
---|
3668 | return $date;
|
---|
3669 | }
|
---|
3670 |
|
---|
3671 | # This finds the nearest workday to $date. If $date is a workday, it
|
---|
3672 | # is returned.
|
---|
3673 | sub Date_NearestWorkDay {
|
---|
3674 | print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3675 | my($date,$tomorrow)=@_;
|
---|
3676 | Date_Init() if (! $Curr{"InitDone"});
|
---|
3677 | $date=ParseDateString($date);
|
---|
3678 | my($a,$b,$dela,$delb,$err)=();
|
---|
3679 | $tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow);
|
---|
3680 |
|
---|
3681 | return $date if (Date_IsWorkDay($date));
|
---|
3682 |
|
---|
3683 | # Find the nearest one.
|
---|
3684 | if ($tomorrow) {
|
---|
3685 | $dela="+0:0:0:1:0:0:0";
|
---|
3686 | $delb="-0:0:0:1:0:0:0";
|
---|
3687 | } else {
|
---|
3688 | $dela="-0:0:0:1:0:0:0";
|
---|
3689 | $delb="+0:0:0:1:0:0:0";
|
---|
3690 | }
|
---|
3691 | $a=$b=$date;
|
---|
3692 |
|
---|
3693 | while (1) {
|
---|
3694 | $a=_DateCalc_DateDelta($a,$dela,\$err);
|
---|
3695 | return $a if (Date_IsWorkDay($a));
|
---|
3696 | $b=_DateCalc_DateDelta($b,$delb,\$err);
|
---|
3697 | return $b if (Date_IsWorkDay($b));
|
---|
3698 | }
|
---|
3699 | }
|
---|
3700 |
|
---|
3701 | # Date_NthDayOfYear($y,$n);
|
---|
3702 | # Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year.
|
---|
3703 | sub Date_NthDayOfYear {
|
---|
3704 | no integer;
|
---|
3705 | print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3706 | my($y,$n)=@_;
|
---|
3707 | $y=$Curr{"Y"} if (! $y);
|
---|
3708 | $n=1 if (! defined $n or $n eq "");
|
---|
3709 | $n+=0; # to turn 023 into 23
|
---|
3710 | $y=_Date_FixYear($y) if (length($y)<4);
|
---|
3711 | my $leap=Date_LeapYear($y);
|
---|
3712 | return () if ($n<1);
|
---|
3713 | return () if ($n >= ($leap ? 367 : 366));
|
---|
3714 |
|
---|
3715 | my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31);
|
---|
3716 | $d_in_m[1]=29 if ($leap);
|
---|
3717 |
|
---|
3718 | # Calculate the hours, minutes, and seconds into the day.
|
---|
3719 | my $remain=($n - int($n))*24;
|
---|
3720 | my $h=int($remain);
|
---|
3721 | $remain=($remain - $h)*60;
|
---|
3722 | my $mn=int($remain);
|
---|
3723 | $remain=($remain - $mn)*60;
|
---|
3724 | my $s=$remain;
|
---|
3725 |
|
---|
3726 | # Calculate the month and the day.
|
---|
3727 | my($m,$d)=(0,0);
|
---|
3728 | $n=int($n);
|
---|
3729 | while ($n>0) {
|
---|
3730 | $m++;
|
---|
3731 | if ($n<=$d_in_m[0]) {
|
---|
3732 | $d=int($n);
|
---|
3733 | $n=0;
|
---|
3734 | } else {
|
---|
3735 | $n-= $d_in_m[0];
|
---|
3736 | shift(@d_in_m);
|
---|
3737 | }
|
---|
3738 | }
|
---|
3739 |
|
---|
3740 | ($y,$m,$d,$h,$mn,$s);
|
---|
3741 | }
|
---|
3742 |
|
---|
3743 | ########################################################################
|
---|
3744 | # NOT FOR EXPORT
|
---|
3745 | ########################################################################
|
---|
3746 |
|
---|
3747 | # This is used in Date_Init to fill in a hash based on international
|
---|
3748 | # data. It takes a list of keys and values and returns both a hash
|
---|
3749 | # with these values and a regular expression of keys.
|
---|
3750 | #
|
---|
3751 | # IN:
|
---|
3752 | # $data = [ key1 val1 key2 val2 ... ]
|
---|
3753 | # $opts = lc : lowercase the keys in the regexp
|
---|
3754 | # sort : sort (by length) the keys in the regexp
|
---|
3755 | # back : create a regexp with a back reference
|
---|
3756 | # escape : escape all strings in the regexp
|
---|
3757 | #
|
---|
3758 | # OUT:
|
---|
3759 | # $regexp = '(?:key1|key2|...)'
|
---|
3760 | # $hash = { key1=>val1 key2=>val2 ... }
|
---|
3761 |
|
---|
3762 | sub _Date_InitHash {
|
---|
3763 | print "DEBUG: _Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3764 | my($data,$regexp,$opts,$hash)=@_;
|
---|
3765 | my(@data)=@$data;
|
---|
3766 | my($key,$val,@list)=();
|
---|
3767 |
|
---|
3768 | # Parse the options
|
---|
3769 | my($lc,$sort,$back,$escape)=(0,0,0,0);
|
---|
3770 | $lc=1 if ($opts =~ /lc/i);
|
---|
3771 | $sort=1 if ($opts =~ /sort/i);
|
---|
3772 | $back=1 if ($opts =~ /back/i);
|
---|
3773 | $escape=1 if ($opts =~ /escape/i);
|
---|
3774 |
|
---|
3775 | # Create the hash
|
---|
3776 | while (@data) {
|
---|
3777 | ($key,$val,@data)=@data;
|
---|
3778 | $key=lc($key) if ($lc);
|
---|
3779 | $$hash{$key}=$val;
|
---|
3780 | }
|
---|
3781 |
|
---|
3782 | # Create the regular expression
|
---|
3783 | if ($regexp) {
|
---|
3784 | @list=keys(%$hash);
|
---|
3785 | @list=sort _sortByLength(@list) if ($sort);
|
---|
3786 | if ($escape) {
|
---|
3787 | foreach $val (@list) {
|
---|
3788 | $val="\Q$val\E";
|
---|
3789 | }
|
---|
3790 | }
|
---|
3791 | if ($back) {
|
---|
3792 | $$regexp="(" . join("|",@list) . ")";
|
---|
3793 | } else {
|
---|
3794 | $$regexp="(?:" . join("|",@list) . ")";
|
---|
3795 | }
|
---|
3796 | }
|
---|
3797 | }
|
---|
3798 |
|
---|
3799 | # This is used in Date_Init to fill in regular expressions, lists, and
|
---|
3800 | # hashes based on international data. It takes a list of lists which have
|
---|
3801 | # to be stored as regular expressions (to find any element in the list),
|
---|
3802 | # lists, and hashes (indicating the location in the lists).
|
---|
3803 | #
|
---|
3804 | # IN:
|
---|
3805 | # $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ]
|
---|
3806 | # [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ]
|
---|
3807 | # ...
|
---|
3808 | # [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ]
|
---|
3809 | # $lists = [ \@listA \@listB ... \@listZ ]
|
---|
3810 | # $opts = lc : lowercase the values in the regexp
|
---|
3811 | # sort : sort (by length) the values in the regexp
|
---|
3812 | # back : create a regexp with a back reference
|
---|
3813 | # escape : escape all strings in the regexp
|
---|
3814 | # $hash = [ \%hash, TYPE ]
|
---|
3815 | # TYPE 0 : $hash{ valBn=>n-1 }
|
---|
3816 | # TYPE 1 : $hash{ valBn=>n }
|
---|
3817 | #
|
---|
3818 | # OUT:
|
---|
3819 | # $regexp = '(?:valA1|valA2|...|valB1|...)'
|
---|
3820 | # $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
|
---|
3821 | # [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
|
---|
3822 | # $hash
|
---|
3823 |
|
---|
3824 | sub _Date_InitLists {
|
---|
3825 | print "DEBUG: _Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3826 | my($data,$regexp,$opts,$lists,$hash)=@_;
|
---|
3827 | my(@data)=@$data;
|
---|
3828 | my(@lists)=@$lists;
|
---|
3829 | my($i,@ele,$ele,@list,$j,$tmp)=();
|
---|
3830 |
|
---|
3831 | # Parse the options
|
---|
3832 | my($lc,$sort,$back,$escape)=(0,0,0,0);
|
---|
3833 | $lc=1 if ($opts =~ /lc/i);
|
---|
3834 | $sort=1 if ($opts =~ /sort/i);
|
---|
3835 | $back=1 if ($opts =~ /back/i);
|
---|
3836 | $escape=1 if ($opts =~ /escape/i);
|
---|
3837 |
|
---|
3838 | # Set each of the lists
|
---|
3839 | if (@lists) {
|
---|
3840 | confess "ERROR: _Date_InitLists: lists must be 1 per data\n"
|
---|
3841 | if ($#lists != $#data);
|
---|
3842 | for ($i=0; $i<=$#data; $i++) {
|
---|
3843 | @ele=@{ $data[$i] };
|
---|
3844 | if ($Cnf{"IntCharSet"} && $#ele>0) {
|
---|
3845 | @{ $lists[$i] } = @{ $ele[1] };
|
---|
3846 | } else {
|
---|
3847 | @{ $lists[$i] } = @{ $ele[0] };
|
---|
3848 | }
|
---|
3849 | }
|
---|
3850 | }
|
---|
3851 |
|
---|
3852 | # Create the hash
|
---|
3853 | my($hashtype,$hashsave,%hash)=();
|
---|
3854 | if (@$hash) {
|
---|
3855 | ($hash,$hashtype)=@$hash;
|
---|
3856 | $hashsave=1;
|
---|
3857 | } else {
|
---|
3858 | $hashtype=0;
|
---|
3859 | $hashsave=0;
|
---|
3860 | }
|
---|
3861 | for ($i=0; $i<=$#data; $i++) {
|
---|
3862 | @ele=@{ $data[$i] };
|
---|
3863 | foreach $ele (@ele) {
|
---|
3864 | @list = @{ $ele };
|
---|
3865 | for ($j=0; $j<=$#list; $j++) {
|
---|
3866 | $tmp=$list[$j];
|
---|
3867 | next if (! $tmp);
|
---|
3868 | $tmp=lc($tmp) if ($lc);
|
---|
3869 | $hash{$tmp}= $j+$hashtype;
|
---|
3870 | }
|
---|
3871 | }
|
---|
3872 | }
|
---|
3873 | %$hash = %hash if ($hashsave);
|
---|
3874 |
|
---|
3875 | # Create the regular expression
|
---|
3876 | if ($regexp) {
|
---|
3877 | @list=keys(%hash);
|
---|
3878 | @list=sort _sortByLength(@list) if ($sort);
|
---|
3879 | if ($escape) {
|
---|
3880 | foreach $ele (@list) {
|
---|
3881 | $ele="\Q$ele\E";
|
---|
3882 | }
|
---|
3883 | }
|
---|
3884 | if ($back) {
|
---|
3885 | $$regexp="(" . join("|",@list) . ")";
|
---|
3886 | } else {
|
---|
3887 | $$regexp="(?:" . join("|",@list) . ")";
|
---|
3888 | }
|
---|
3889 | }
|
---|
3890 | }
|
---|
3891 |
|
---|
3892 | # This is used in Date_Init to fill in regular expressions and lists based
|
---|
3893 | # on international data. This takes a list of strings and returns a regular
|
---|
3894 | # expression (to find any one of them).
|
---|
3895 | #
|
---|
3896 | # IN:
|
---|
3897 | # $data = [ string1 string2 ... ]
|
---|
3898 | # $opts = lc : lowercase the values in the regexp
|
---|
3899 | # sort : sort (by length) the values in the regexp
|
---|
3900 | # back : create a regexp with a back reference
|
---|
3901 | # escape : escape all strings in the regexp
|
---|
3902 | #
|
---|
3903 | # OUT:
|
---|
3904 | # $regexp = '(string1|string2|...)'
|
---|
3905 |
|
---|
3906 | sub _Date_InitStrings {
|
---|
3907 | print "DEBUG: _Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
3908 | my($data,$regexp,$opts)=@_;
|
---|
3909 | my(@list)=@{ $data };
|
---|
3910 |
|
---|
3911 | # Parse the options
|
---|
3912 | my($lc,$sort,$back,$escape)=(0,0,0,0);
|
---|
3913 | $lc=1 if ($opts =~ /lc/i);
|
---|
3914 | $sort=1 if ($opts =~ /sort/i);
|
---|
3915 | $back=1 if ($opts =~ /back/i);
|
---|
3916 | $escape=1 if ($opts =~ /escape/i);
|
---|
3917 |
|
---|
3918 | # Create the regular expression
|
---|
3919 | my($ele)=();
|
---|
3920 | @list=sort _sortByLength(@list) if ($sort);
|
---|
3921 | if ($escape) {
|
---|
3922 | foreach $ele (@list) {
|
---|
3923 | $ele="\Q$ele\E";
|
---|
3924 | }
|
---|
3925 | }
|
---|
3926 | if ($back) {
|
---|
3927 | $$regexp="(" . join("|",@list) . ")";
|
---|
3928 | } else {
|
---|
3929 | $$regexp="(?:" . join("|",@list) . ")";
|
---|
3930 | }
|
---|
3931 | $$regexp=lc($$regexp) if ($lc);
|
---|
3932 | }
|
---|
3933 |
|
---|
3934 | # items is passed in (either as a space separated string, or a reference to
|
---|
3935 | # a list) and a regular expression which matches any one of the items is
|
---|
3936 | # prepared. The regular expression will be of one of the forms:
|
---|
3937 | # "(a|b)" @list not empty, back option included
|
---|
3938 | # "(?:a|b)" @list not empty
|
---|
3939 | # "()" @list empty, back option included
|
---|
3940 | # "" @list empty
|
---|
3941 | # $options is a string which contains any of the following strings:
|
---|
3942 | # back : the regular expression has a backreference
|
---|
3943 | # opt : the regular expression is optional and a "?" is appended in
|
---|
3944 | # the first two forms
|
---|
3945 | # optws : the regular expression is optional and may be replaced by
|
---|
3946 | # whitespace
|
---|
3947 | # optWs : the regular expression is optional, but if not present, must
|
---|
3948 | # be replaced by whitespace
|
---|
3949 | # sort : the items in the list are sorted by length (longest first)
|
---|
3950 | # lc : the string is lowercased
|
---|
3951 | # under : any underscores are converted to spaces
|
---|
3952 | # pre : it may be preceded by whitespace
|
---|
3953 | # Pre : it must be preceded by whitespace
|
---|
3954 | # PRE : it must be preceded by whitespace or the start
|
---|
3955 | # post : it may be followed by whitespace
|
---|
3956 | # Post : it must be followed by whitespace
|
---|
3957 | # POST : it must be followed by whitespace or the end
|
---|
3958 | # Spaces due to pre/post options will not be included in the back reference.
|
---|
3959 | #
|
---|
3960 | # If $array is included, then the elements will also be returned as a list.
|
---|
3961 | # $array is a string which may contain any of the following:
|
---|
3962 | # keys : treat the list as a hash and only the keys go into the regexp
|
---|
3963 | # key0 : treat the list as the values of a hash with keys 0 .. N-1
|
---|
3964 | # key1 : treat the list as the values of a hash with keys 1 .. N
|
---|
3965 | # val0 : treat the list as the keys of a hash with values 0 .. N-1
|
---|
3966 | # val1 : treat the list as the keys of a hash with values 1 .. N
|
---|
3967 |
|
---|
3968 | # _Date_InitLists([$lang{"month_name"},$lang{"month_abb"}],
|
---|
3969 | # [\$Month,"lc,sort,back"],
|
---|
3970 | # [\@Month,\@Mon],
|
---|
3971 | # [\%Month,1]);
|
---|
3972 |
|
---|
3973 | # This is used in Date_Init to prepare regular expressions. A list of
|
---|
3974 | # items is passed in (either as a space separated string, or a reference to
|
---|
3975 | # a list) and a regular expression which matches any one of the items is
|
---|
3976 | # prepared. The regular expression will be of one of the forms:
|
---|
3977 | # "(a|b)" @list not empty, back option included
|
---|
3978 | # "(?:a|b)" @list not empty
|
---|
3979 | # "()" @list empty, back option included
|
---|
3980 | # "" @list empty
|
---|
3981 | # $options is a string which contains any of the following strings:
|
---|
3982 | # back : the regular expression has a backreference
|
---|
3983 | # opt : the regular expression is optional and a "?" is appended in
|
---|
3984 | # the first two forms
|
---|
3985 | # optws : the regular expression is optional and may be replaced by
|
---|
3986 | # whitespace
|
---|
3987 | # optWs : the regular expression is optional, but if not present, must
|
---|
3988 | # be replaced by whitespace
|
---|
3989 | # sort : the items in the list are sorted by length (longest first)
|
---|
3990 | # lc : the string is lowercased
|
---|
3991 | # under : any underscores are converted to spaces
|
---|
3992 | # pre : it may be preceded by whitespace
|
---|
3993 | # Pre : it must be preceded by whitespace
|
---|
3994 | # PRE : it must be preceded by whitespace or the start
|
---|
3995 | # post : it may be followed by whitespace
|
---|
3996 | # Post : it must be followed by whitespace
|
---|
3997 | # POST : it must be followed by whitespace or the end
|
---|
3998 | # Spaces due to pre/post options will not be included in the back reference.
|
---|
3999 | #
|
---|
4000 | # If $array is included, then the elements will also be returned as a list.
|
---|
4001 | # $array is a string which may contain any of the following:
|
---|
4002 | # keys : treat the list as a hash and only the keys go into the regexp
|
---|
4003 | # key0 : treat the list as the values of a hash with keys 0 .. N-1
|
---|
4004 | # key1 : treat the list as the values of a hash with keys 1 .. N
|
---|
4005 | # val0 : treat the list as the keys of a hash with values 0 .. N-1
|
---|
4006 | # val1 : treat the list as the keys of a hash with values 1 .. N
|
---|
4007 | sub _Date_Regexp {
|
---|
4008 | print "DEBUG: _Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4009 | my($list,$options,$array)=@_;
|
---|
4010 | my(@list,$ret,%hash,$i)=();
|
---|
4011 | local($_)=();
|
---|
4012 | $options="" if (! defined $options);
|
---|
4013 | $array="" if (! defined $array);
|
---|
4014 |
|
---|
4015 | my($sort,$lc,$under)=(0,0,0);
|
---|
4016 | $sort =1 if ($options =~ /sort/i);
|
---|
4017 | $lc =1 if ($options =~ /lc/i);
|
---|
4018 | $under=1 if ($options =~ /under/i);
|
---|
4019 | my($back,$opt,$pre,$post,$ws)=("?:","","","","");
|
---|
4020 | $back ="" if ($options =~ /back/i);
|
---|
4021 | $opt ="?" if ($options =~ /opt/i);
|
---|
4022 | $pre ='\s*' if ($options =~ /pre/);
|
---|
4023 | $pre ='\s+' if ($options =~ /Pre/);
|
---|
4024 | $pre ='(?:\s+|^)' if ($options =~ /PRE/);
|
---|
4025 | $post ='\s*' if ($options =~ /post/);
|
---|
4026 | $post ='\s+' if ($options =~ /Post/);
|
---|
4027 | $post ='(?:$|\s+)' if ($options =~ /POST/);
|
---|
4028 | $ws ='\s*' if ($options =~ /optws/);
|
---|
4029 | $ws ='\s+' if ($options =~ /optws/);
|
---|
4030 |
|
---|
4031 | my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0);
|
---|
4032 | $keys =1 if ($array =~ /keys/i);
|
---|
4033 | $key0 =1 if ($array =~ /key0/i);
|
---|
4034 | $key1 =1 if ($array =~ /key1/i);
|
---|
4035 | $val0 =1 if ($array =~ /val0/i);
|
---|
4036 | $val1 =1 if ($array =~ /val1/i);
|
---|
4037 | $hash =1 if ($keys or $key0 or $key1 or $val0 or $val1);
|
---|
4038 |
|
---|
4039 | my($ref)=ref $list;
|
---|
4040 | if (! $ref) {
|
---|
4041 | $list =~ s/\s*$//;
|
---|
4042 | $list =~ s/^\s*//;
|
---|
4043 | $list =~ s/\s+/&&&/g;
|
---|
4044 | } elsif ($ref eq "ARRAY") {
|
---|
4045 | $list = join("&&&",@$list);
|
---|
4046 | } else {
|
---|
4047 | confess "ERROR: _Date_Regexp.\n";
|
---|
4048 | }
|
---|
4049 |
|
---|
4050 | if (! $list) {
|
---|
4051 | if ($back eq "") {
|
---|
4052 | return "()";
|
---|
4053 | } else {
|
---|
4054 | return "";
|
---|
4055 | }
|
---|
4056 | }
|
---|
4057 |
|
---|
4058 | $list=lc($list) if ($lc);
|
---|
4059 | $list=~ s/_/ /g if ($under);
|
---|
4060 | @list=split(/&&&/,$list);
|
---|
4061 | if ($keys) {
|
---|
4062 | %hash=@list;
|
---|
4063 | @list=keys %hash;
|
---|
4064 | } elsif ($key0 or $key1 or $val0 or $val1) {
|
---|
4065 | $i=0;
|
---|
4066 | $i=1 if ($key1 or $val1);
|
---|
4067 | if ($key0 or $key1) {
|
---|
4068 | %hash= map { $_,$i++ } @list;
|
---|
4069 | } else {
|
---|
4070 | %hash= map { $i++,$_ } @list;
|
---|
4071 | }
|
---|
4072 | }
|
---|
4073 | @list=sort _sortByLength(@list) if ($sort);
|
---|
4074 |
|
---|
4075 | $ret="($back" . join("|",@list) . ")";
|
---|
4076 | $ret="(?:$pre$ret$post)" if ($pre or $post);
|
---|
4077 | $ret.=$opt;
|
---|
4078 | $ret="(?:$ret|$ws)" if ($ws);
|
---|
4079 |
|
---|
4080 | if ($array and $hash) {
|
---|
4081 | return ($ret,%hash);
|
---|
4082 | } elsif ($array) {
|
---|
4083 | return ($ret,@list);
|
---|
4084 | } else {
|
---|
4085 | return $ret;
|
---|
4086 | }
|
---|
4087 | }
|
---|
4088 |
|
---|
4089 | # This will produce a delta with the correct number of signs. At most two
|
---|
4090 | # signs will be in it normally (one before the year, and one in front of
|
---|
4091 | # the day), but if appropriate, signs will be in front of all elements.
|
---|
4092 | # Also, as many of the signs will be equivalent as possible.
|
---|
4093 | sub _Delta_Normalize {
|
---|
4094 | print "DEBUG: _Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4095 | my($delta,$mode)=@_;
|
---|
4096 | return "" if (! $delta);
|
---|
4097 | return "+0:+0:+0:+0:+0:+0:+0"
|
---|
4098 | if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"});
|
---|
4099 | return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/);
|
---|
4100 |
|
---|
4101 | my($tmp,$sign1,$sign2,$len)=();
|
---|
4102 |
|
---|
4103 | # Calculate the length of the day in minutes
|
---|
4104 | $len=24*60;
|
---|
4105 | $len=$Curr{"WDlen"} if ($mode==2 || $mode==3);
|
---|
4106 |
|
---|
4107 | # We have to get the sign of every component explicitely so that a "-0"
|
---|
4108 | # or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must
|
---|
4109 | # be a negative delta).
|
---|
4110 |
|
---|
4111 | my($y,$mon,$w,$d,$h,$m,$s)=_Delta_Split($delta);
|
---|
4112 |
|
---|
4113 | # We need to make sure that the signs of all parts of a delta are the
|
---|
4114 | # same. The easiest way to do this is to convert all of the large
|
---|
4115 | # components to the smallest ones, then convert the smaller components
|
---|
4116 | # back to the larger ones.
|
---|
4117 |
|
---|
4118 | # Do the year/month part
|
---|
4119 |
|
---|
4120 | $mon += $y*12; # convert y to m
|
---|
4121 | $sign1="+";
|
---|
4122 | if ($mon<0) {
|
---|
4123 | $mon *= -1;
|
---|
4124 | $sign1="-";
|
---|
4125 | }
|
---|
4126 |
|
---|
4127 | $y = $mon/12; # convert m to y
|
---|
4128 | $mon -= $y*12;
|
---|
4129 |
|
---|
4130 | $y=0 if ($y eq "-0"); # get around silly -0 problem
|
---|
4131 | $mon=0 if ($mon eq "-0");
|
---|
4132 |
|
---|
4133 | # Do the wk/day/hour/min/sec part
|
---|
4134 |
|
---|
4135 | {
|
---|
4136 | # Unfortunately, $s is overflowing for dates more than ~70 years
|
---|
4137 | # apart.
|
---|
4138 | no integer;
|
---|
4139 |
|
---|
4140 | if ($mode==3 || $mode==2) {
|
---|
4141 | $s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
|
---|
4142 | } else {
|
---|
4143 | $s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
|
---|
4144 | }
|
---|
4145 | $sign2="+";
|
---|
4146 | if ($s<0) {
|
---|
4147 | $s*=-1;
|
---|
4148 | $sign2="-";
|
---|
4149 | }
|
---|
4150 |
|
---|
4151 | $m = int($s/60); # convert s to m
|
---|
4152 | $s -= $m*60;
|
---|
4153 | $d = int($m/$len); # convert m to d
|
---|
4154 | $m -= $d*$len;
|
---|
4155 |
|
---|
4156 | # The rest should be fine.
|
---|
4157 | }
|
---|
4158 | $h = $m/60; # convert m to h
|
---|
4159 | $m -= $h*60;
|
---|
4160 | if ($mode == 3 || $mode == 2) {
|
---|
4161 | $w = $w*1; # get around +0 problem
|
---|
4162 | } else {
|
---|
4163 | $w = $d/7; # convert d to w
|
---|
4164 | $d -= $w*7;
|
---|
4165 | }
|
---|
4166 |
|
---|
4167 | $w=0 if ($w eq "-0"); # get around silly -0 problem
|
---|
4168 | $d=0 if ($d eq "-0");
|
---|
4169 | $h=0 if ($h eq "-0");
|
---|
4170 | $m=0 if ($m eq "-0");
|
---|
4171 | $s=0 if ($s eq "-0");
|
---|
4172 |
|
---|
4173 | # Only include two signs if necessary
|
---|
4174 | $sign1=$sign2 if ($y==0 and $mon==0);
|
---|
4175 | $sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0);
|
---|
4176 | $sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"});
|
---|
4177 |
|
---|
4178 | if ($Cnf{"DeltaSigns"}) {
|
---|
4179 | return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s";
|
---|
4180 | } else {
|
---|
4181 | return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s";
|
---|
4182 | }
|
---|
4183 | }
|
---|
4184 |
|
---|
4185 | # This checks a delta to make sure it is valid. If it is, it splits
|
---|
4186 | # it and returns the elements with a sign on each. The 2nd argument
|
---|
4187 | # specifies the default sign. Blank elements are set to 0. If the
|
---|
4188 | # third element is non-nil, exactly 7 elements must be included.
|
---|
4189 | sub _Delta_Split {
|
---|
4190 | print "DEBUG: _Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4191 | my($delta,$sign,$exact)=@_;
|
---|
4192 | my(@delta)=split(/:/,$delta);
|
---|
4193 | return () if ($exact and $#delta != 6);
|
---|
4194 | my($i)=();
|
---|
4195 | $sign="+" if (! defined $sign);
|
---|
4196 | for ($i=0; $i<=$#delta; $i++) {
|
---|
4197 | $delta[$i]="0" if (! $delta[$i]);
|
---|
4198 | return () if ($delta[$i] !~ /^[+-]?\d+$/);
|
---|
4199 | $sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign);
|
---|
4200 | $delta[$i] = $sign.$delta[$i];
|
---|
4201 | }
|
---|
4202 | @delta;
|
---|
4203 | }
|
---|
4204 |
|
---|
4205 | # Reads up to 3 arguments. $h may contain the time in any international
|
---|
4206 | # format. Any empty elements are set to 0.
|
---|
4207 | sub _Date_ParseTime {
|
---|
4208 | print "DEBUG: _Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4209 | my($h,$m,$s)=@_;
|
---|
4210 | my($t)=_CheckTime("one");
|
---|
4211 |
|
---|
4212 | if (defined $h and $h =~ /$t/) {
|
---|
4213 | $h=$1;
|
---|
4214 | $m=$2;
|
---|
4215 | $s=$3 if (defined $3);
|
---|
4216 | }
|
---|
4217 | $h="00" if (! defined $h);
|
---|
4218 | $m="00" if (! defined $m);
|
---|
4219 | $s="00" if (! defined $s);
|
---|
4220 |
|
---|
4221 | ($h,$m,$s);
|
---|
4222 | }
|
---|
4223 |
|
---|
4224 | # Forms a date with the 6 elements passed in (all of which must be defined).
|
---|
4225 | # No check as to validity is made.
|
---|
4226 | sub _Date_Join {
|
---|
4227 | print "DEBUG: _Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4228 | foreach (0 .. $#_) {
|
---|
4229 | croak "undefined arg $_ to _Date_Join()" if not defined $_[$_];
|
---|
4230 | }
|
---|
4231 | my($y,$m,$d,$h,$mn,$s)=@_;
|
---|
4232 | my($ym,$md,$dh,$hmn,$mns)=();
|
---|
4233 |
|
---|
4234 | if ($Cnf{"Internal"} == 0) {
|
---|
4235 | $ym=$md=$dh="";
|
---|
4236 | $hmn=$mns=":";
|
---|
4237 |
|
---|
4238 | } elsif ($Cnf{"Internal"} == 1) {
|
---|
4239 | $ym=$md=$dh=$hmn=$mns="";
|
---|
4240 |
|
---|
4241 | } elsif ($Cnf{"Internal"} == 2) {
|
---|
4242 | $ym=$md="-";
|
---|
4243 | $dh=" ";
|
---|
4244 | $hmn=$mns=":";
|
---|
4245 |
|
---|
4246 | } else {
|
---|
4247 | confess "ERROR: Invalid internal format in _Date_Join.\n";
|
---|
4248 | }
|
---|
4249 | $m="0$m" if (length($m)==1);
|
---|
4250 | $d="0$d" if (length($d)==1);
|
---|
4251 | $h="0$h" if (length($h)==1);
|
---|
4252 | $mn="0$mn" if (length($mn)==1);
|
---|
4253 | $s="0$s" if (length($s)==1);
|
---|
4254 | "$y$ym$m$md$d$dh$h$hmn$mn$mns$s";
|
---|
4255 | }
|
---|
4256 |
|
---|
4257 | # This checks a time. If it is valid, it splits it and returns 3 elements.
|
---|
4258 | # If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is
|
---|
4259 | # returned.
|
---|
4260 | sub _CheckTime {
|
---|
4261 | print "DEBUG: _CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4262 | my($time)=@_;
|
---|
4263 | my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
|
---|
4264 | my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
|
---|
4265 | my($m)='[0-5][0-9]';
|
---|
4266 | my($s)=$m;
|
---|
4267 | my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)";
|
---|
4268 | my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)";
|
---|
4269 | my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"};
|
---|
4270 | my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
|
---|
4271 | if ($time eq "one") {
|
---|
4272 | return $t;
|
---|
4273 | } elsif ($time eq "two") {
|
---|
4274 | $t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
|
---|
4275 | return $t;
|
---|
4276 | }
|
---|
4277 |
|
---|
4278 | if ($time =~ /$t/i) {
|
---|
4279 | ($h,$m,$s)=($1,$2,$3);
|
---|
4280 | $h="0$h" if (length($h)<2);
|
---|
4281 | $m="0$m" if (length($m)<2);
|
---|
4282 | $s="00" if (! defined $s);
|
---|
4283 | return ($h,$m,$s);
|
---|
4284 | } else {
|
---|
4285 | return ();
|
---|
4286 | }
|
---|
4287 | }
|
---|
4288 |
|
---|
4289 | # This checks a recurrence. If it is valid, it splits it and returns the
|
---|
4290 | # elements. Otherwise, it returns an empty list.
|
---|
4291 | # ($recur0,$recur1,$flags,$dateb,$date0,$date1)=_Recur_Split($recur);
|
---|
4292 | sub _Recur_Split {
|
---|
4293 | print "DEBUG: _Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4294 | my($recur)=@_;
|
---|
4295 | my(@ret,@tmp);
|
---|
4296 |
|
---|
4297 | my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
|
---|
4298 | my($F) = '(?:\*([^*]*))';
|
---|
4299 | my($DB,$D0,$D1);
|
---|
4300 | $DB=$D0=$D1=$F;
|
---|
4301 |
|
---|
4302 | if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
|
---|
4303 | @ret=($1,$2,$3,$4,$5);
|
---|
4304 | @tmp=split(/\*/,shift(@ret));
|
---|
4305 | return () if ($#tmp>1);
|
---|
4306 | return (@tmp,"",@ret) if ($#tmp==0);
|
---|
4307 | return (@tmp,@ret);
|
---|
4308 | }
|
---|
4309 | return ();
|
---|
4310 | }
|
---|
4311 |
|
---|
4312 | # This checks a date. If it is valid, it splits it and returns the elements.
|
---|
4313 | #
|
---|
4314 | # The optional second argument says 'I really expect this to be a
|
---|
4315 | # valid Date::Manip object, please throw an exception if it is not'.
|
---|
4316 | # Otherwise, if the date passed in is undef or '', a regular
|
---|
4317 | # expression for the date is returned; if the string is nonempty but
|
---|
4318 | # still not valid, () is returned.
|
---|
4319 | #
|
---|
4320 | sub _Date_Split {
|
---|
4321 | print "DEBUG: _Date_Split\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4322 | my($date, $definitely_valid)=@_;
|
---|
4323 | $definitely_valid = 0 if not defined $definitely_valid;
|
---|
4324 | my($ym,$md,$dh,$hmn,$mns)=();
|
---|
4325 | my($y)='(\d{4})';
|
---|
4326 | my($m)='(0[1-9]|1[0-2])';
|
---|
4327 | my($d)='(0[1-9]|[1-2][0-9]|3[0-1])';
|
---|
4328 | my($h)='([0-1][0-9]|2[0-3])';
|
---|
4329 | my($mn)='([0-5][0-9])';
|
---|
4330 | my($s)=$mn;
|
---|
4331 |
|
---|
4332 | if ($Cnf{"Internal"} == 0) {
|
---|
4333 | $ym=$md=$dh="";
|
---|
4334 | $hmn=$mns=":";
|
---|
4335 |
|
---|
4336 | } elsif ($Cnf{"Internal"} == 1) {
|
---|
4337 | $ym=$md=$dh=$hmn=$mns="";
|
---|
4338 |
|
---|
4339 | } elsif ($Cnf{"Internal"} == 2) {
|
---|
4340 | $ym=$md="-";
|
---|
4341 | $dh=" ";
|
---|
4342 | $hmn=$mns=":";
|
---|
4343 |
|
---|
4344 | } else {
|
---|
4345 | confess "ERROR: Invalid internal format in _Date_Split.\n";
|
---|
4346 | }
|
---|
4347 |
|
---|
4348 | my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$";
|
---|
4349 |
|
---|
4350 | if (not defined $date or $date eq '') {
|
---|
4351 | if ($definitely_valid) {
|
---|
4352 | die "bad date '$date'";
|
---|
4353 | } else {
|
---|
4354 | return $t;
|
---|
4355 | }
|
---|
4356 | }
|
---|
4357 |
|
---|
4358 | if ($date =~ /$t/) {
|
---|
4359 | ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
|
---|
4360 | my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
---|
4361 | $d_in_m[2]=29 if (Date_LeapYear($y));
|
---|
4362 | if ($d>$d_in_m[$m]) {
|
---|
4363 | my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
|
---|
4364 | if ($definitely_valid) {
|
---|
4365 | die $msg;
|
---|
4366 | }
|
---|
4367 | else {
|
---|
4368 | warn $msg;
|
---|
4369 | return ();
|
---|
4370 | }
|
---|
4371 | }
|
---|
4372 | return ($y,$m,$d,$h,$mn,$s);
|
---|
4373 | }
|
---|
4374 |
|
---|
4375 | if ($definitely_valid) {
|
---|
4376 | die "invalid date $date: doesn't match regexp $t";
|
---|
4377 | }
|
---|
4378 | return ();
|
---|
4379 | }
|
---|
4380 |
|
---|
4381 | # This returns the date easter occurs on for a given year as ($month,$day).
|
---|
4382 | # This is from the Calendar FAQ.
|
---|
4383 | sub _Date_Easter {
|
---|
4384 | my($y)=@_;
|
---|
4385 | $y=_Date_FixYear($y) if (length($y)==2);
|
---|
4386 |
|
---|
4387 | my($c) = $y/100;
|
---|
4388 | my($g) = $y % 19;
|
---|
4389 | my($k) = ($c-17)/25;
|
---|
4390 | my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30;
|
---|
4391 | $i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11));
|
---|
4392 | my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7;
|
---|
4393 | my($l) = $i-$j;
|
---|
4394 | my($m) = 3 + ($l+40)/44;
|
---|
4395 | my($d) = $l + 28 - 31*($m/4);
|
---|
4396 | return ($m,$d);
|
---|
4397 | }
|
---|
4398 |
|
---|
4399 | # This takes a list of years, months, WeekOfMonth's, and DayOfWeek's, and
|
---|
4400 | # returns a list of dates. Optionally, a list of dates can be passed in as
|
---|
4401 | # the 1st argument (with the 2nd argument the null list) and the year/month
|
---|
4402 | # of these will be used.
|
---|
4403 | sub _Date_Recur_WoM {
|
---|
4404 | my($y,$m,$w,$d)=@_;
|
---|
4405 | my(@y)=@$y;
|
---|
4406 | my(@m)=@$m;
|
---|
4407 | my(@w)=@$w;
|
---|
4408 | my(@d)=@$d;
|
---|
4409 | my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
|
---|
4410 |
|
---|
4411 | if (@m) {
|
---|
4412 | foreach $m (@m) {
|
---|
4413 | return () if (! _IsInt($m,1,12));
|
---|
4414 | }
|
---|
4415 |
|
---|
4416 | @tmp=@tmp2=();
|
---|
4417 | foreach $y (@y) {
|
---|
4418 | foreach $m (@m) {
|
---|
4419 | push(@tmp,$y);
|
---|
4420 | push(@tmp2,$m);
|
---|
4421 | }
|
---|
4422 | }
|
---|
4423 |
|
---|
4424 | @y=@tmp;
|
---|
4425 | @m=@tmp2;
|
---|
4426 |
|
---|
4427 | } else {
|
---|
4428 | foreach $d0 (@y) {
|
---|
4429 | @tmp=_Date_Split($d0);
|
---|
4430 | return () if (! @tmp);
|
---|
4431 | push(@tmp2,$tmp[0]);
|
---|
4432 | push(@m,$tmp[1]);
|
---|
4433 | }
|
---|
4434 | @y=@tmp2;
|
---|
4435 | }
|
---|
4436 |
|
---|
4437 | return () if (! @w);
|
---|
4438 | foreach $w (@w) {
|
---|
4439 | return () if ($w==0 || ! _IsInt($w,-5,5));
|
---|
4440 | }
|
---|
4441 |
|
---|
4442 | if (@d) {
|
---|
4443 | foreach $d (@d) {
|
---|
4444 | return () if ($d==0 || ! _IsInt($d,-7,7));
|
---|
4445 | $d += 8 if ($d < 0);
|
---|
4446 | }
|
---|
4447 | }
|
---|
4448 |
|
---|
4449 | @date=();
|
---|
4450 | foreach $y (@y) {
|
---|
4451 | $m=shift(@m);
|
---|
4452 |
|
---|
4453 | # Find 1st day of this month and next month
|
---|
4454 | $date0=_Date_Join($y,$m,1,0,0,0);
|
---|
4455 | $date1=_DateCalc_DateDelta($date0,"+0:1:0:0:0:0:0");
|
---|
4456 |
|
---|
4457 | foreach $d (@d) {
|
---|
4458 | # Find 1st occurence of DOW (in both months)
|
---|
4459 | $d0=Date_GetNext($date0,$d,1);
|
---|
4460 | $d1=Date_GetNext($date1,$d,1);
|
---|
4461 |
|
---|
4462 | @tmp=();
|
---|
4463 | while (Date_Cmp($d0,$d1)<0) {
|
---|
4464 | push(@tmp,$d0);
|
---|
4465 | $d0=_DateCalc_DateDelta($d0,"+0:0:1:0:0:0:0");
|
---|
4466 | }
|
---|
4467 |
|
---|
4468 | @tmp2=();
|
---|
4469 | foreach $w (@w) {
|
---|
4470 | if ($w>0) {
|
---|
4471 | next if ($w > $#tmp+1);
|
---|
4472 | push(@tmp2,$tmp[$w-1]);
|
---|
4473 | } else {
|
---|
4474 | next if (-$w > $#tmp+1);
|
---|
4475 | push(@tmp2,$tmp[$#tmp+1+$w]);
|
---|
4476 | }
|
---|
4477 | }
|
---|
4478 | @tmp2=sort { Date_Cmp($a,$b) } @tmp2;
|
---|
4479 | push(@date,@tmp2);
|
---|
4480 | }
|
---|
4481 | }
|
---|
4482 |
|
---|
4483 | @date;
|
---|
4484 | }
|
---|
4485 |
|
---|
4486 | # This returns a sorted list of dates formed by adding/subtracting
|
---|
4487 | # $delta to $dateb in the range $date0<=$d<$dateb. The first date in
|
---|
4488 | # the list is actually the first date<$date0 and the last date in the
|
---|
4489 | # list is the first date>=$date1 (because sometimes the set part will
|
---|
4490 | # move the date back into the range).
|
---|
4491 | sub _Date_Recur {
|
---|
4492 | my($date0,$date1,$dateb,$delta)=@_;
|
---|
4493 | my(@ret,$d)=();
|
---|
4494 |
|
---|
4495 | while (Date_Cmp($dateb,$date0)<0) {
|
---|
4496 | $dateb=_DateCalc_DateDelta($dateb,$delta);
|
---|
4497 | }
|
---|
4498 | while (Date_Cmp($dateb,$date1)>=0) {
|
---|
4499 | $dateb=_DateCalc_DateDelta($dateb,"-$delta");
|
---|
4500 | }
|
---|
4501 |
|
---|
4502 | # Add the dates $date0..$dateb
|
---|
4503 | $d=$dateb;
|
---|
4504 | while (Date_Cmp($d,$date0)>=0) {
|
---|
4505 | unshift(@ret,$d);
|
---|
4506 | $d=_DateCalc_DateDelta($d,"-$delta");
|
---|
4507 | }
|
---|
4508 | # Add the first date earler than the range
|
---|
4509 | unshift(@ret,$d);
|
---|
4510 |
|
---|
4511 | # Add the dates $dateb..$date1
|
---|
4512 | $d=_DateCalc_DateDelta($dateb,$delta);
|
---|
4513 | while (Date_Cmp($d,$date1)<0) {
|
---|
4514 | push(@ret,$d);
|
---|
4515 | $d=_DateCalc_DateDelta($d,$delta);
|
---|
4516 | }
|
---|
4517 | # Add the first date later than the range
|
---|
4518 | push(@ret,$d);
|
---|
4519 |
|
---|
4520 | @ret;
|
---|
4521 | }
|
---|
4522 |
|
---|
4523 | # This sets the values in each date of a recurrence.
|
---|
4524 | #
|
---|
4525 | # $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1",
|
---|
4526 | # they are not set (and none of the larger elements are set).
|
---|
4527 | sub _Date_RecurSetTime {
|
---|
4528 | my($date0,$date1,$dates,$h,$m,$s)=@_;
|
---|
4529 | my(@dates)=@$dates;
|
---|
4530 | my(@h,@m,@s,$date,@tmp)=();
|
---|
4531 |
|
---|
4532 | $m="-1" if ($s eq "-1");
|
---|
4533 | $h="-1" if ($m eq "-1");
|
---|
4534 |
|
---|
4535 | if ($h ne "-1") {
|
---|
4536 | @h=_ReturnList($h);
|
---|
4537 | return () if ! (@h);
|
---|
4538 | @h=sort { $a<=>$b } (@h);
|
---|
4539 |
|
---|
4540 | @tmp=();
|
---|
4541 | foreach $date (@dates) {
|
---|
4542 | foreach $h (@h) {
|
---|
4543 | push(@tmp,Date_SetDateField($date,"h",$h,1));
|
---|
4544 | }
|
---|
4545 | }
|
---|
4546 | @dates=@tmp;
|
---|
4547 | }
|
---|
4548 |
|
---|
4549 | if ($m ne "-1") {
|
---|
4550 | @m=_ReturnList($m);
|
---|
4551 | return () if ! (@m);
|
---|
4552 | @m=sort { $a<=>$b } (@m);
|
---|
4553 |
|
---|
4554 | @tmp=();
|
---|
4555 | foreach $date (@dates) {
|
---|
4556 | foreach $m (@m) {
|
---|
4557 | push(@tmp,Date_SetDateField($date,"mn",$m,1));
|
---|
4558 | }
|
---|
4559 | }
|
---|
4560 | @dates=@tmp;
|
---|
4561 | }
|
---|
4562 |
|
---|
4563 | if ($s ne "-1") {
|
---|
4564 | @s=_ReturnList($s);
|
---|
4565 | return () if ! (@s);
|
---|
4566 | @s=sort { $a<=>$b } (@s);
|
---|
4567 |
|
---|
4568 | @tmp=();
|
---|
4569 | foreach $date (@dates) {
|
---|
4570 | foreach $s (@s) {
|
---|
4571 | push(@tmp,Date_SetDateField($date,"s",$s,1));
|
---|
4572 | }
|
---|
4573 | }
|
---|
4574 | @dates=@tmp;
|
---|
4575 | }
|
---|
4576 |
|
---|
4577 | @tmp=();
|
---|
4578 | foreach $date (@dates) {
|
---|
4579 | push(@tmp,$date) if (Date_Cmp($date,$date0)>=0 &&
|
---|
4580 | Date_Cmp($date,$date1)<0 &&
|
---|
4581 | _Date_Split($date));
|
---|
4582 | }
|
---|
4583 |
|
---|
4584 | @tmp;
|
---|
4585 | }
|
---|
4586 |
|
---|
4587 | sub _DateCalc_DateDate {
|
---|
4588 | print "DEBUG: _DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4589 | my($D1,$D2,$mode)=@_;
|
---|
4590 | my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
---|
4591 | $mode=0 if (! defined $mode);
|
---|
4592 |
|
---|
4593 | # Exact mode
|
---|
4594 | if ($mode==0) {
|
---|
4595 | my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($D1, 1);
|
---|
4596 | my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($D2, 1);
|
---|
4597 | my($i,@delta,$d,$delta,$y)=();
|
---|
4598 |
|
---|
4599 | # form the delta for hour/min/sec
|
---|
4600 | $delta[4]=$h2-$h1;
|
---|
4601 | $delta[5]=$mn2-$mn1;
|
---|
4602 | $delta[6]=$s2-$s1;
|
---|
4603 |
|
---|
4604 | # form the delta for yr/mon/day
|
---|
4605 | $delta[0]=$delta[1]=0;
|
---|
4606 | $d=0;
|
---|
4607 | if ($y2>$y1) {
|
---|
4608 | $d=Date_DaysInYear($y1) - Date_DayOfYear($m1,$d1,$y1);
|
---|
4609 | $d+=Date_DayOfYear($m2,$d2,$y2);
|
---|
4610 | for ($y=$y1+1; $y<$y2; $y++) {
|
---|
4611 | $d+= Date_DaysInYear($y);
|
---|
4612 | }
|
---|
4613 | } elsif ($y2<$y1) {
|
---|
4614 | $d=Date_DaysInYear($y2) - Date_DayOfYear($m2,$d2,$y2);
|
---|
4615 | $d+=Date_DayOfYear($m1,$d1,$y1);
|
---|
4616 | for ($y=$y2+1; $y<$y1; $y++) {
|
---|
4617 | $d+= Date_DaysInYear($y);
|
---|
4618 | }
|
---|
4619 | $d *= -1;
|
---|
4620 | } else {
|
---|
4621 | $d=Date_DayOfYear($m2,$d2,$y2) - Date_DayOfYear($m1,$d1,$y1);
|
---|
4622 | }
|
---|
4623 | $delta[2]=0;
|
---|
4624 | $delta[3]=$d;
|
---|
4625 |
|
---|
4626 | for ($i=0; $i<7; $i++) {
|
---|
4627 | $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
|
---|
4628 | }
|
---|
4629 |
|
---|
4630 | $delta=join(":",@delta);
|
---|
4631 | $delta=_Delta_Normalize($delta,0);
|
---|
4632 | return $delta;
|
---|
4633 | }
|
---|
4634 |
|
---|
4635 | my($date1,$date2)=($D1,$D2);
|
---|
4636 | my($tmp,$sign,$err,@tmp)=();
|
---|
4637 |
|
---|
4638 | # make sure both are work days
|
---|
4639 | if ($mode==2 || $mode==3) {
|
---|
4640 | $date1=Date_NextWorkDay($date1,0,1);
|
---|
4641 | $date2=Date_NextWorkDay($date2,0,1);
|
---|
4642 | }
|
---|
4643 |
|
---|
4644 | # make sure date1 comes before date2
|
---|
4645 | if (Date_Cmp($date1,$date2)>0) {
|
---|
4646 | $sign="-";
|
---|
4647 | $tmp=$date1;
|
---|
4648 | $date1=$date2;
|
---|
4649 | $date2=$tmp;
|
---|
4650 | } else {
|
---|
4651 | $sign="+";
|
---|
4652 | }
|
---|
4653 | if (Date_Cmp($date1,$date2)==0) {
|
---|
4654 | return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
|
---|
4655 | return "+0:0:0:0:0:0:0";
|
---|
4656 | }
|
---|
4657 |
|
---|
4658 | my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($date1, 1);
|
---|
4659 | my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($date2, 1);
|
---|
4660 | my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0);
|
---|
4661 |
|
---|
4662 | if ($mode != 3) {
|
---|
4663 |
|
---|
4664 | # Do years
|
---|
4665 | $dy=$y2-$y1;
|
---|
4666 | $dm=0;
|
---|
4667 | if ($dy>0) {
|
---|
4668 | $tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0);
|
---|
4669 | if (Date_Cmp($tmp,$date2)>0) {
|
---|
4670 | $dy--;
|
---|
4671 | $tmp=$date1;
|
---|
4672 | $tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0)
|
---|
4673 | if ($dy>0);
|
---|
4674 | $dm=12;
|
---|
4675 | }
|
---|
4676 | $date1=$tmp;
|
---|
4677 | }
|
---|
4678 |
|
---|
4679 | # Do months
|
---|
4680 | $dm+=$m2-$m1;
|
---|
4681 | if ($dm>0) {
|
---|
4682 | $tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0);
|
---|
4683 | if (Date_Cmp($tmp,$date2)>0) {
|
---|
4684 | $dm--;
|
---|
4685 | $tmp=$date1;
|
---|
4686 | $tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0)
|
---|
4687 | if ($dm>0);
|
---|
4688 | }
|
---|
4689 | $date1=$tmp;
|
---|
4690 | }
|
---|
4691 |
|
---|
4692 | # At this point, check to see that we're on a business day again so that
|
---|
4693 | # Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month
|
---|
4694 | if ($mode==2) {
|
---|
4695 | if (! Date_IsWorkDay($date1,0)) {
|
---|
4696 | $date1=Date_NextWorkDay($date1,0,1);
|
---|
4697 | }
|
---|
4698 | }
|
---|
4699 | }
|
---|
4700 |
|
---|
4701 | # Do days
|
---|
4702 | if ($mode==2 || $mode==3) {
|
---|
4703 | $dd=0;
|
---|
4704 | while (1) {
|
---|
4705 | $tmp=Date_NextWorkDay($date1,1,1);
|
---|
4706 | if (Date_Cmp($tmp,$date2)<=0) {
|
---|
4707 | $dd++;
|
---|
4708 | $date1=$tmp;
|
---|
4709 | } else {
|
---|
4710 | last;
|
---|
4711 | }
|
---|
4712 | }
|
---|
4713 |
|
---|
4714 | } else {
|
---|
4715 | ($y1,$m1,$d1)=( _Date_Split($date1, 1) )[0..2];
|
---|
4716 | $dd=0;
|
---|
4717 | # If we're jumping across months, set $d1 to the first of the next month
|
---|
4718 | # (or possibly the 0th of next month which is equivalent to the last day
|
---|
4719 | # of this month)
|
---|
4720 | if ($m1!=$m2) {
|
---|
4721 | $d_in_m[2]=29 if (Date_LeapYear($y1));
|
---|
4722 | $dd=$d_in_m[$m1]-$d1+1;
|
---|
4723 | $d1=1;
|
---|
4724 | $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
|
---|
4725 | if (Date_Cmp($tmp,$date2)>0) {
|
---|
4726 | $dd--;
|
---|
4727 | $d1--;
|
---|
4728 | $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
|
---|
4729 | }
|
---|
4730 | $date1=$tmp;
|
---|
4731 | }
|
---|
4732 |
|
---|
4733 | $ddd=0;
|
---|
4734 | if ($d1<$d2) {
|
---|
4735 | $ddd=$d2-$d1;
|
---|
4736 | $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
|
---|
4737 | if (Date_Cmp($tmp,$date2)>0) {
|
---|
4738 | $ddd--;
|
---|
4739 | $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
|
---|
4740 | }
|
---|
4741 | $date1=$tmp;
|
---|
4742 | }
|
---|
4743 | $dd+=$ddd;
|
---|
4744 | }
|
---|
4745 |
|
---|
4746 | # in business mode, make sure h1 comes before h2 (if not find delta between
|
---|
4747 | # now and end of day and move to start of next business day)
|
---|
4748 | $d1=( _Date_Split($date1, 1) )[2];
|
---|
4749 | $dh=$dmn=$ds=0;
|
---|
4750 | if ($mode==2 || $mode==3 and $d1 != $d2) {
|
---|
4751 | $tmp=Date_SetTime($date1,$Cnf{"WorkDayEnd"});
|
---|
4752 | $tmp=_DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0")
|
---|
4753 | if ($Cnf{"WorkDay24Hr"});
|
---|
4754 | $tmp=_DateCalc_DateDate($date1,$tmp,0);
|
---|
4755 | ($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=_Delta_Split($tmp);
|
---|
4756 | $date1=Date_NextWorkDay($date1,1,0);
|
---|
4757 | $date1=Date_SetTime($date1,$Cnf{"WorkDayBeg"});
|
---|
4758 | $d1=( _Date_Split($date1, 1) )[2];
|
---|
4759 | confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2);
|
---|
4760 | }
|
---|
4761 |
|
---|
4762 | # Hours, minutes, seconds
|
---|
4763 | $tmp=_DateCalc_DateDate($date1,$date2,0);
|
---|
4764 | @tmp=_Delta_Split($tmp);
|
---|
4765 | $dh += $tmp[4];
|
---|
4766 | $dmn += $tmp[5];
|
---|
4767 | $ds += $tmp[6];
|
---|
4768 |
|
---|
4769 | $tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds";
|
---|
4770 | _Delta_Normalize($tmp,$mode);
|
---|
4771 | }
|
---|
4772 |
|
---|
4773 | sub _DateCalc_DeltaDelta {
|
---|
4774 | print "DEBUG: _DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4775 | my($D1,$D2,$mode)=@_;
|
---|
4776 | my(@delta1,@delta2,$i,$delta,@delta)=();
|
---|
4777 | $mode=0 if (! defined $mode);
|
---|
4778 |
|
---|
4779 | @delta1=_Delta_Split($D1);
|
---|
4780 | @delta2=_Delta_Split($D2);
|
---|
4781 | for ($i=0; $i<7; $i++) {
|
---|
4782 | $delta[$i]=$delta1[$i]+$delta2[$i];
|
---|
4783 | $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
|
---|
4784 | }
|
---|
4785 |
|
---|
4786 | $delta=join(":",@delta);
|
---|
4787 | $delta=_Delta_Normalize($delta,$mode);
|
---|
4788 | return $delta;
|
---|
4789 | }
|
---|
4790 |
|
---|
4791 | sub _DateCalc_DateDelta {
|
---|
4792 | print "DEBUG: _DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4793 | my($D1,$D2,$errref,$mode)=@_;
|
---|
4794 | my($date)=();
|
---|
4795 | my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
---|
4796 | my($h1,$m1,$h2,$m2,$len,$hh,$mm)=();
|
---|
4797 | $mode=0 if (! defined $mode);
|
---|
4798 |
|
---|
4799 | if ($mode==2 || $mode==3) {
|
---|
4800 | $h1=$Curr{"WDBh"};
|
---|
4801 | $m1=$Curr{"WDBm"};
|
---|
4802 | $h2=$Curr{"WDEh"};
|
---|
4803 | $m2=$Curr{"WDEm"};
|
---|
4804 | $hh=$h2-$h1;
|
---|
4805 | $mm=$m2-$m1;
|
---|
4806 | if ($mm<0) {
|
---|
4807 | $hh--;
|
---|
4808 | $mm+=60;
|
---|
4809 | }
|
---|
4810 | }
|
---|
4811 |
|
---|
4812 | # Date, delta
|
---|
4813 | my($y,$m,$d,$h,$mn,$s)=_Date_Split($D1, 1);
|
---|
4814 | my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=_Delta_Split($D2);
|
---|
4815 |
|
---|
4816 | # do the month/year part
|
---|
4817 | $y+=$dy;
|
---|
4818 | while (length($y)<4) {
|
---|
4819 | $y = "0$y";
|
---|
4820 | }
|
---|
4821 | _ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11
|
---|
4822 | $d_in_m[2]=29 if (Date_LeapYear($y));
|
---|
4823 |
|
---|
4824 | # if we have gone past the last day of a month, move the date back to
|
---|
4825 | # the last day of the month
|
---|
4826 | if ($d>$d_in_m[$m]) {
|
---|
4827 | $d=$d_in_m[$m];
|
---|
4828 | }
|
---|
4829 |
|
---|
4830 | # do the week part
|
---|
4831 | if ($mode==0 || $mode==1) {
|
---|
4832 | $dd += $dw*7;
|
---|
4833 | } else {
|
---|
4834 | $date=_DateCalc_DateDelta(_Date_Join($y,$m,$d,$h,$mn,$s),
|
---|
4835 | "+0:0:$dw:0:0:0:0",0);
|
---|
4836 | ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
|
---|
4837 | }
|
---|
4838 |
|
---|
4839 | # in business mode, set the day to a work day at this point so the h/mn/s
|
---|
4840 | # stuff will work out
|
---|
4841 | if ($mode==2 || $mode==3) {
|
---|
4842 | $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
|
---|
4843 | $date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),0,1);
|
---|
4844 | ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
|
---|
4845 | }
|
---|
4846 |
|
---|
4847 | # seconds, minutes, hours
|
---|
4848 | _ModuloAddition(60,$ds,\$s,\$mn);
|
---|
4849 | if ($mode==2 || $mode==3) {
|
---|
4850 | while (1) {
|
---|
4851 | _ModuloAddition(60,$dmn,\$mn,\$h);
|
---|
4852 | $h+= $dh;
|
---|
4853 |
|
---|
4854 | if ($h>$h2 or $h==$h2 && $mn>$m2) {
|
---|
4855 | $dh=$h-$h2;
|
---|
4856 | $dmn=$mn-$m2;
|
---|
4857 | $h=$h1;
|
---|
4858 | $mn=$m1;
|
---|
4859 | $dd++;
|
---|
4860 |
|
---|
4861 | } elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
|
---|
4862 | $dh=$h-$h1;
|
---|
4863 | $dmn=$m1-$mn;
|
---|
4864 | $h=$h2;
|
---|
4865 | $mn=$m2;
|
---|
4866 | $dd--;
|
---|
4867 |
|
---|
4868 | } elsif ($h==$h2 && $mn==$m2) {
|
---|
4869 | $dd++;
|
---|
4870 | $dh=-$hh;
|
---|
4871 | $dmn=-$mm;
|
---|
4872 |
|
---|
4873 | } else {
|
---|
4874 | last;
|
---|
4875 | }
|
---|
4876 | }
|
---|
4877 |
|
---|
4878 | } else {
|
---|
4879 | _ModuloAddition(60,$dmn,\$mn,\$h);
|
---|
4880 | _ModuloAddition(24,$dh,\$h,\$d);
|
---|
4881 | }
|
---|
4882 |
|
---|
4883 | # If we have just gone past the last day of the month, we need to make
|
---|
4884 | # up for this:
|
---|
4885 | if ($d>$d_in_m[$m]) {
|
---|
4886 | $dd+= $d-$d_in_m[$m];
|
---|
4887 | $d=$d_in_m[$m];
|
---|
4888 | }
|
---|
4889 |
|
---|
4890 | # days
|
---|
4891 | if ($mode==2 || $mode==3) {
|
---|
4892 | if ($dd>=0) {
|
---|
4893 | $date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),$dd,1);
|
---|
4894 | } else {
|
---|
4895 | $date=Date_PrevWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1);
|
---|
4896 | }
|
---|
4897 | ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
|
---|
4898 |
|
---|
4899 | } else {
|
---|
4900 | $d_in_m[2]=29 if (Date_LeapYear($y));
|
---|
4901 | $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
|
---|
4902 | $d += $dd;
|
---|
4903 | while ($d<1) {
|
---|
4904 | $m--;
|
---|
4905 | if ($m==0) {
|
---|
4906 | $m=12;
|
---|
4907 | $y--;
|
---|
4908 | if (Date_LeapYear($y)) {
|
---|
4909 | $d_in_m[2]=29;
|
---|
4910 | } else {
|
---|
4911 | $d_in_m[2]=28;
|
---|
4912 | }
|
---|
4913 | }
|
---|
4914 | $d += $d_in_m[$m];
|
---|
4915 | }
|
---|
4916 | while ($d>$d_in_m[$m]) {
|
---|
4917 | $d -= $d_in_m[$m];
|
---|
4918 | $m++;
|
---|
4919 | if ($m==13) {
|
---|
4920 | $m=1;
|
---|
4921 | $y++;
|
---|
4922 | if (Date_LeapYear($y)) {
|
---|
4923 | $d_in_m[2]=29;
|
---|
4924 | } else {
|
---|
4925 | $d_in_m[2]=28;
|
---|
4926 | }
|
---|
4927 | }
|
---|
4928 | }
|
---|
4929 | }
|
---|
4930 |
|
---|
4931 | if ($y<0 or $y>9999) {
|
---|
4932 | $$errref=3;
|
---|
4933 | return;
|
---|
4934 | }
|
---|
4935 | _Date_Join($y,$m,$d,$h,$mn,$s);
|
---|
4936 | }
|
---|
4937 |
|
---|
4938 | sub _Date_UpdateHolidays {
|
---|
4939 | print "DEBUG: _Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4940 | my($year)=@_;
|
---|
4941 | $Holiday{"year"}=$year;
|
---|
4942 | $Holiday{"dates"}{$year}={};
|
---|
4943 |
|
---|
4944 | my($date,$delta,$err)=();
|
---|
4945 | my($key,@tmp,$tmp);
|
---|
4946 |
|
---|
4947 | foreach $key (keys %{ $Holiday{"desc"} }) {
|
---|
4948 | @tmp=_Recur_Split($key);
|
---|
4949 | if (@tmp) {
|
---|
4950 | $tmp=ParseDateString("${year}010100:00:00");
|
---|
4951 | ($date)=ParseRecur($key,$tmp,$tmp,($year+1)."-01-01");
|
---|
4952 | next if (! $date);
|
---|
4953 |
|
---|
4954 | } elsif ($key =~ /^(.*)([+-].*)$/) {
|
---|
4955 | # Date +/- Delta
|
---|
4956 | ($date,$delta)=($1,$2);
|
---|
4957 | $tmp=ParseDateString("$date $year");
|
---|
4958 | if ($tmp) {
|
---|
4959 | $date=$tmp;
|
---|
4960 | } else {
|
---|
4961 | $date=ParseDateString($date);
|
---|
4962 | next if ($date !~ /^$year/);
|
---|
4963 | }
|
---|
4964 | $date=DateCalc($date,$delta,\$err,0);
|
---|
4965 |
|
---|
4966 | } else {
|
---|
4967 | # Date
|
---|
4968 | $date=$key;
|
---|
4969 | $tmp=ParseDateString("$date $year");
|
---|
4970 | if ($tmp) {
|
---|
4971 | $date=$tmp;
|
---|
4972 | } else {
|
---|
4973 | $date=ParseDateString($date);
|
---|
4974 | next if ($date !~ /^$year/);
|
---|
4975 | }
|
---|
4976 | }
|
---|
4977 | $Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key};
|
---|
4978 | }
|
---|
4979 | }
|
---|
4980 |
|
---|
4981 | # This sets a Date::Manip config variable.
|
---|
4982 | sub _Date_SetConfigVariable {
|
---|
4983 | print "DEBUG: _Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
4984 | my($var,$val)=@_;
|
---|
4985 |
|
---|
4986 | # These are most appropriate for command line options instead of in files.
|
---|
4987 | $Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i);
|
---|
4988 | $Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i);
|
---|
4989 | $Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i);
|
---|
4990 | EraseHolidays(), return if ($var =~ /^EraseHolidays$/i);
|
---|
4991 | $Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i);
|
---|
4992 | $Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i);
|
---|
4993 |
|
---|
4994 | $Curr{"InitLang"}=1,
|
---|
4995 | $Cnf{"Language"}=$val, return if ($var =~ /^Language$/i);
|
---|
4996 | $Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i);
|
---|
4997 | $Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i);
|
---|
4998 | $Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i);
|
---|
4999 | $Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i);
|
---|
5000 | $Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i);
|
---|
5001 | $Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i);
|
---|
5002 | $Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i);
|
---|
5003 | $Cnf{"WorkDayBeg"}=$val,
|
---|
5004 | $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
|
---|
5005 | $Cnf{"WorkDayEnd"}=$val,
|
---|
5006 | $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i);
|
---|
5007 | $Cnf{"WorkDay24Hr"}=$val,
|
---|
5008 | $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i);
|
---|
5009 | $Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i);
|
---|
5010 | $Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i);
|
---|
5011 | $Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i);
|
---|
5012 | $Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i);
|
---|
5013 | $Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i);
|
---|
5014 | $Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i);
|
---|
5015 | $Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i);
|
---|
5016 | $Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i);
|
---|
5017 | $Cnf{"TodayIsMidnight"}=$val, return if ($var =~ /^TodayIsMidnight$/i);
|
---|
5018 |
|
---|
5019 | confess "ERROR: Unknown configuration variable $var in Date::Manip.\n";
|
---|
5020 | }
|
---|
5021 |
|
---|
5022 | sub EraseHolidays {
|
---|
5023 | print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5024 |
|
---|
5025 | $Cnf{"EraseHolidays"}=0;
|
---|
5026 | delete $Holiday{"list"};
|
---|
5027 | $Holiday{"list"}={};
|
---|
5028 | delete $Holiday{"desc"};
|
---|
5029 | $Holiday{"desc"}={};
|
---|
5030 | $Holiday{"dates"}={};
|
---|
5031 | }
|
---|
5032 |
|
---|
5033 | # This returns a pointer to a list of times and events in the format
|
---|
5034 | # [ date [ events ], date, [ events ], ... ]
|
---|
5035 | # where each list of events are events that are in effect at the date
|
---|
5036 | # immediately preceding the list.
|
---|
5037 | #
|
---|
5038 | # This takes either one date or two dates as arguments.
|
---|
5039 | sub _Events_Calc {
|
---|
5040 | print "DEBUG: _Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5041 |
|
---|
5042 | my($date0,$date1)=@_;
|
---|
5043 |
|
---|
5044 | my($tmp);
|
---|
5045 | $date0=ParseDateString($date0);
|
---|
5046 | return undef if (! $date0);
|
---|
5047 | if ($date1) {
|
---|
5048 | $date1=ParseDateString($date1);
|
---|
5049 | if (Date_Cmp($date0,$date1)>0) {
|
---|
5050 | $tmp=$date1;
|
---|
5051 | $date1=$date0;
|
---|
5052 | $date0=$tmp;
|
---|
5053 | }
|
---|
5054 | } else {
|
---|
5055 | $date1=_DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1");
|
---|
5056 | }
|
---|
5057 |
|
---|
5058 | #
|
---|
5059 | # [ d0,d1,del,name ] => [ d0, d1+del )
|
---|
5060 | # [ d0,0,del,name ] => [ d0, d0+del )
|
---|
5061 | #
|
---|
5062 | my(%ret,$d0,$d1,$del,$name,$c0,$c1);
|
---|
5063 | my(@tmp)=@{ $Events{"dates"} };
|
---|
5064 | DATE: while (@tmp) {
|
---|
5065 | ($d0,$d1,$del,$name)=splice(@tmp,0,4);
|
---|
5066 | $d0=ParseDateString($d0);
|
---|
5067 | $d1=ParseDateString($d1) if ($d1);
|
---|
5068 | $del=ParseDateDelta($del) if ($del);
|
---|
5069 | if ($d1) {
|
---|
5070 | if ($del) {
|
---|
5071 | $d1=_DateCalc_DateDelta($d1,$del);
|
---|
5072 | }
|
---|
5073 | } else {
|
---|
5074 | $d1=_DateCalc_DateDelta($d0,$del);
|
---|
5075 | }
|
---|
5076 | if (Date_Cmp($d0,$d1)>0) {
|
---|
5077 | $tmp=$d1;
|
---|
5078 | $d1=$d0;
|
---|
5079 | $d0=$tmp;
|
---|
5080 | }
|
---|
5081 | # [ date0,date1 )
|
---|
5082 | # [ d0,d1 ) OR [ d0,d1 )
|
---|
5083 | next DATE if (Date_Cmp($d1,$date0)<=0 ||
|
---|
5084 | Date_Cmp($d0,$date1)>=0);
|
---|
5085 | # [ date0,date1 )
|
---|
5086 | # [ d0,d1 )
|
---|
5087 | # [ d0, d1 )
|
---|
5088 | if (Date_Cmp($d0,$date0)<=0) {
|
---|
5089 | push @{ $ret{$date0} },$name;
|
---|
5090 | push @{ $ret{$d1} },"!$name" if (Date_Cmp($d1,$date1)<0);
|
---|
5091 | next DATE;
|
---|
5092 | }
|
---|
5093 | # [ date0,date1 )
|
---|
5094 | # [ d0,d1 )
|
---|
5095 | if (Date_Cmp($d1,$date1)>=0) {
|
---|
5096 | push @{ $ret{$d0} },$name;
|
---|
5097 | next DATE;
|
---|
5098 | }
|
---|
5099 | # [ date0,date1 )
|
---|
5100 | # [ d0,d1 )
|
---|
5101 | push @{ $ret{$d0} },$name;
|
---|
5102 | push @{ $ret{$d1} },"!$name";
|
---|
5103 | }
|
---|
5104 |
|
---|
5105 | #
|
---|
5106 | # [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
|
---|
5107 | #
|
---|
5108 | my($rec,$del0,$del1,@d);
|
---|
5109 | @tmp=@{ $Events{"recur"} };
|
---|
5110 | RECUR: while (@tmp) {
|
---|
5111 | ($rec,$del0,$del1,$name)=splice(@tmp,0,4);
|
---|
5112 | @d=();
|
---|
5113 |
|
---|
5114 | }
|
---|
5115 |
|
---|
5116 | # Sort them AND take into account the "!$name" entries.
|
---|
5117 | my(%tmp,$date,@tmp2,@ret);
|
---|
5118 | @d=sort { Date_Cmp($a,$b) } keys %ret;
|
---|
5119 | foreach $date (@d) {
|
---|
5120 | @tmp=@{ $ret{$date} };
|
---|
5121 | @tmp2=();
|
---|
5122 | foreach $tmp (@tmp) {
|
---|
5123 | push(@tmp2,$tmp), next if ($tmp =~ /^!/);
|
---|
5124 | $tmp{$tmp}=1;
|
---|
5125 | }
|
---|
5126 | foreach $tmp (@tmp2) {
|
---|
5127 | $tmp =~ s/^!//;
|
---|
5128 | delete $tmp{$tmp};
|
---|
5129 | }
|
---|
5130 | push(@ret,$date,[ keys %tmp ]);
|
---|
5131 | }
|
---|
5132 |
|
---|
5133 | %tmp = @ret;
|
---|
5134 | @ret = ();
|
---|
5135 | foreach my $d (sort { Date_Cmp($a,$b) } keys %tmp) {
|
---|
5136 | my $e = $tmp{$d};
|
---|
5137 | push @ret,($d,[ sort @$e ]);
|
---|
5138 | }
|
---|
5139 | return \@ret;
|
---|
5140 | }
|
---|
5141 |
|
---|
5142 | # This parses the raw events list
|
---|
5143 | sub _Events_ParseRaw {
|
---|
5144 | print "DEBUG: _Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5145 |
|
---|
5146 | # Only need to be parsed once
|
---|
5147 | my($force)=@_;
|
---|
5148 | $Events{"parsed"}=0 if ($force);
|
---|
5149 | return if ($Events{"parsed"});
|
---|
5150 | $Events{"parsed"}=1;
|
---|
5151 |
|
---|
5152 | my(@events)=@{ $Events{"raw"} };
|
---|
5153 | my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
|
---|
5154 | $recur);
|
---|
5155 | EVENT: while (@events) {
|
---|
5156 | ($event,$name)=splice(@events,0,2);
|
---|
5157 | @event=split(/\s*;\s*/,$event);
|
---|
5158 |
|
---|
5159 | if ($#event == 0) {
|
---|
5160 |
|
---|
5161 | if ($date0=ParseDateString($event[0])) {
|
---|
5162 | #
|
---|
5163 | # date = event
|
---|
5164 | #
|
---|
5165 | $tmp=ParseDateString("$event[0] 00:00:00");
|
---|
5166 | if ($tmp && $tmp eq $date0) {
|
---|
5167 | $delta="+0:0:0:1:0:0:0";
|
---|
5168 | } else {
|
---|
5169 | $delta="+0:0:0:0:1:0:0";
|
---|
5170 | }
|
---|
5171 | push @{ $Events{"dates"} },($date0,0,$delta,$name);
|
---|
5172 |
|
---|
5173 | } elsif ($recur=ParseRecur($event[0])) {
|
---|
5174 | #
|
---|
5175 | # recur = event
|
---|
5176 | #
|
---|
5177 | ($recur0,$recur1)=_Recur_Split($recur);
|
---|
5178 | if ($recur0) {
|
---|
5179 | if ($recur1) {
|
---|
5180 | $r="$recur0:$recur1";
|
---|
5181 | } else {
|
---|
5182 | $r=$recur0;
|
---|
5183 | }
|
---|
5184 | } else {
|
---|
5185 | $r=$recur1;
|
---|
5186 | }
|
---|
5187 | (@recur)=split(/:/,$r);
|
---|
5188 | if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
|
---|
5189 | $delta="+0:0:0:1:0:0:0";
|
---|
5190 | } else {
|
---|
5191 | $delta="+0:0:0:0:1:0:0";
|
---|
5192 | }
|
---|
5193 | push @{ $Events{"recur"} },($recur,0,$delta,$name);
|
---|
5194 |
|
---|
5195 | } else {
|
---|
5196 | # ??? = event
|
---|
5197 | warn "WARNING: illegal event ignored [ @event ]\n";
|
---|
5198 | next EVENT;
|
---|
5199 | }
|
---|
5200 |
|
---|
5201 | } elsif ($#event == 1) {
|
---|
5202 |
|
---|
5203 | if ($date0=ParseDateString($event[0])) {
|
---|
5204 |
|
---|
5205 | if ($date1=ParseDateString($event[1])) {
|
---|
5206 | #
|
---|
5207 | # date ; date = event
|
---|
5208 | #
|
---|
5209 | $tmp=ParseDateString("$event[1] 00:00:00");
|
---|
5210 | if ($tmp && $tmp eq $date1) {
|
---|
5211 | $date1=_DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0");
|
---|
5212 | }
|
---|
5213 | push @{ $Events{"dates"} },($date0,$date1,0,$name);
|
---|
5214 |
|
---|
5215 | } elsif ($delta=ParseDateDelta($event[1])) {
|
---|
5216 | #
|
---|
5217 | # date ; delta = event
|
---|
5218 | #
|
---|
5219 | push @{ $Events{"dates"} },($date0,0,$delta,$name);
|
---|
5220 |
|
---|
5221 | } else {
|
---|
5222 | # date ; ??? = event
|
---|
5223 | warn "WARNING: illegal event ignored [ @event ]\n";
|
---|
5224 | next EVENT;
|
---|
5225 | }
|
---|
5226 |
|
---|
5227 | } elsif ($recur=ParseRecur($event[0])) {
|
---|
5228 |
|
---|
5229 | if ($delta=ParseDateDelta($event[1])) {
|
---|
5230 | #
|
---|
5231 | # recur ; delta = event
|
---|
5232 | #
|
---|
5233 | push @{ $Events{"recur"} },($recur,0,$delta,$name);
|
---|
5234 |
|
---|
5235 | } else {
|
---|
5236 | # recur ; ??? = event
|
---|
5237 | warn "WARNING: illegal event ignored [ @event ]\n";
|
---|
5238 | next EVENT;
|
---|
5239 | }
|
---|
5240 |
|
---|
5241 | } else {
|
---|
5242 | # ??? ; ??? = event
|
---|
5243 | warn "WARNING: illegal event ignored [ @event ]\n";
|
---|
5244 | next EVENT;
|
---|
5245 | }
|
---|
5246 |
|
---|
5247 | } else {
|
---|
5248 | # date ; delta0 ; delta1 = event
|
---|
5249 | # recur ; delta0 ; delta1 = event
|
---|
5250 | # ??? ; ??? ; ??? ... = event
|
---|
5251 | warn "WARNING: illegal event ignored [ @event ]\n";
|
---|
5252 | next EVENT;
|
---|
5253 | }
|
---|
5254 | }
|
---|
5255 | }
|
---|
5256 |
|
---|
5257 | # This reads an init file.
|
---|
5258 | sub _Date_InitFile {
|
---|
5259 | print "DEBUG: _Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5260 | my($file)=@_;
|
---|
5261 | my($in)=new IO::File;
|
---|
5262 | local($_)=();
|
---|
5263 | my($section)="vars";
|
---|
5264 | my($var,$val,$recur,$name)=();
|
---|
5265 |
|
---|
5266 | $in->open($file) || return;
|
---|
5267 | while(defined ($_=<$in>)) {
|
---|
5268 | chomp;
|
---|
5269 | s/^\s+//;
|
---|
5270 | s/\s+$//;
|
---|
5271 | next if (! $_ or /^\#/);
|
---|
5272 |
|
---|
5273 | if (/^\*holiday/i) {
|
---|
5274 | $section="holiday";
|
---|
5275 | EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
|
---|
5276 | next;
|
---|
5277 | } elsif (/^\*events/i) {
|
---|
5278 | $section="events";
|
---|
5279 | next;
|
---|
5280 | }
|
---|
5281 |
|
---|
5282 | if ($section =~ /var/i) {
|
---|
5283 | confess "ERROR: invalid Date::Manip config file line.\n $_\n"
|
---|
5284 | if (! /(.*\S)\s*=\s*(.*)$/);
|
---|
5285 | ($var,$val)=($1,$2);
|
---|
5286 | _Date_SetConfigVariable($var,$val);
|
---|
5287 |
|
---|
5288 | } elsif ($section =~ /holiday/i) {
|
---|
5289 | confess "ERROR: invalid Date::Manip config file line.\n $_\n"
|
---|
5290 | if (! /(.*\S)\s*=\s*(.*)$/);
|
---|
5291 | ($recur,$name)=($1,$2);
|
---|
5292 | $name="" if (! defined $name);
|
---|
5293 | $Holiday{"desc"}{$recur}=$name;
|
---|
5294 |
|
---|
5295 | } elsif ($section =~ /events/i) {
|
---|
5296 | confess "ERROR: invalid Date::Manip config file line.\n $_\n"
|
---|
5297 | if (! /(.*\S)\s*=\s*(.*)$/);
|
---|
5298 | ($val,$var)=($1,$2);
|
---|
5299 | push @{ $Events{"raw"} },($val,$var);
|
---|
5300 |
|
---|
5301 | } else {
|
---|
5302 | # A section not currently used by Date::Manip (but may be
|
---|
5303 | # used by some extension to it).
|
---|
5304 | next;
|
---|
5305 | }
|
---|
5306 | }
|
---|
5307 | close($in);
|
---|
5308 | }
|
---|
5309 |
|
---|
5310 | # $flag=_Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
|
---|
5311 | # Returns 1 if any of the fields are bad. All fields are optional, and
|
---|
5312 | # all possible checks are done on the data. If a field is not passed in,
|
---|
5313 | # it is set to default values. If data is missing, appropriate defaults
|
---|
5314 | # are supplied.
|
---|
5315 | sub _Date_TimeCheck {
|
---|
5316 | print "DEBUG: _Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5317 | my($h,$mn,$s,$ampm)=@_;
|
---|
5318 | my($tmp1,$tmp2,$tmp3)=();
|
---|
5319 |
|
---|
5320 | $$h="" if (! defined $$h);
|
---|
5321 | $$mn="" if (! defined $$mn);
|
---|
5322 | $$s="" if (! defined $$s);
|
---|
5323 | $$ampm="" if (! defined $$ampm);
|
---|
5324 | $$ampm=uc($$ampm) if ($$ampm);
|
---|
5325 |
|
---|
5326 | # Check hour
|
---|
5327 | $tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
|
---|
5328 | $tmp2="";
|
---|
5329 | if ($$ampm =~ /^$tmp1$/i) {
|
---|
5330 | $tmp3=$Lang{$Cnf{"Language"}}{"AM"};
|
---|
5331 | $tmp2="AM" if ($$ampm =~ /^$tmp3$/i);
|
---|
5332 | $tmp3=$Lang{$Cnf{"Language"}}{"PM"};
|
---|
5333 | $tmp2="PM" if ($$ampm =~ /^$tmp3$/i);
|
---|
5334 | } elsif ($$ampm) {
|
---|
5335 | return 1;
|
---|
5336 | }
|
---|
5337 | if ($tmp2 eq "AM" || $tmp2 eq "PM") {
|
---|
5338 | $$h="0$$h" if (length($$h)==1);
|
---|
5339 | return 1 if ($$h<1 || $$h>12);
|
---|
5340 | $$h="00" if ($tmp2 eq "AM" and $$h==12);
|
---|
5341 | $$h += 12 if ($tmp2 eq "PM" and $$h!=12);
|
---|
5342 | } else {
|
---|
5343 | $$h="00" if ($$h eq "");
|
---|
5344 | $$h="0$$h" if (length($$h)==1);
|
---|
5345 | return 1 if (! _IsInt($$h,0,23));
|
---|
5346 | $tmp2="AM" if ($$h<12);
|
---|
5347 | $tmp2="PM" if ($$h>=12);
|
---|
5348 | }
|
---|
5349 | $$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
|
---|
5350 | $$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
|
---|
5351 |
|
---|
5352 | # Check minutes
|
---|
5353 | $$mn="00" if ($$mn eq "");
|
---|
5354 | $$mn="0$$mn" if (length($$mn)==1);
|
---|
5355 | return 1 if (! _IsInt($$mn,0,59));
|
---|
5356 |
|
---|
5357 | # Check seconds
|
---|
5358 | $$s="00" if ($$s eq "");
|
---|
5359 | $$s="0$$s" if (length($$s)==1);
|
---|
5360 | return 1 if (! _IsInt($$s,0,59));
|
---|
5361 |
|
---|
5362 | return 0;
|
---|
5363 | }
|
---|
5364 |
|
---|
5365 | # $flag=_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
|
---|
5366 | # Returns 1 if any of the fields are bad. All fields are optional, and
|
---|
5367 | # all possible checks are done on the data. If a field is not passed in,
|
---|
5368 | # it is set to default values. If data is missing, appropriate defaults
|
---|
5369 | # are supplied.
|
---|
5370 | #
|
---|
5371 | # If the flag UpdateHolidays is set, the year is set to
|
---|
5372 | # CurrHolidayYear.
|
---|
5373 | sub _Date_DateCheck {
|
---|
5374 | print "DEBUG: _Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5375 | my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_;
|
---|
5376 | my($tmp1,$tmp2,$tmp3)=();
|
---|
5377 |
|
---|
5378 | my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
---|
5379 | my($curr_y)=$Curr{"Y"};
|
---|
5380 | my($curr_m)=$Curr{"M"};
|
---|
5381 | my($curr_d)=$Curr{"D"};
|
---|
5382 | $$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d);
|
---|
5383 | $$y="" if (! defined $$y);
|
---|
5384 | $$m="" if (! defined $$m);
|
---|
5385 | $$d="" if (! defined $$d);
|
---|
5386 | $$wk="" if (! defined $$wk);
|
---|
5387 | $$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq "");
|
---|
5388 |
|
---|
5389 | # Check year.
|
---|
5390 | $$y=$curr_y if ($$y eq "");
|
---|
5391 | $$y=_Date_FixYear($$y) if (length($$y)<4);
|
---|
5392 | return 1 if (! _IsInt($$y,0,9999));
|
---|
5393 | $d_in_m[2]=29 if (Date_LeapYear($$y));
|
---|
5394 |
|
---|
5395 | # Check month
|
---|
5396 | $$m=$curr_m if ($$m eq "");
|
---|
5397 | $$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}
|
---|
5398 | if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)});
|
---|
5399 | $$m="0$$m" if (length($$m)==1);
|
---|
5400 | return 1 if (! _IsInt($$m,1,12));
|
---|
5401 |
|
---|
5402 | # Check day
|
---|
5403 | $$d="01" if ($$d eq "");
|
---|
5404 | $$d="0$$d" if (length($$d)==1);
|
---|
5405 | return 1 if (! _IsInt($$d,1,$d_in_m[$$m]));
|
---|
5406 | if ($$wk) {
|
---|
5407 | $tmp1=Date_DayOfWeek($$m,$$d,$$y);
|
---|
5408 | $tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}
|
---|
5409 | if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)});
|
---|
5410 | return 1 if ($tmp1 != $tmp2);
|
---|
5411 | }
|
---|
5412 |
|
---|
5413 | return _Date_TimeCheck($h,$mn,$s,$ampm);
|
---|
5414 | }
|
---|
5415 |
|
---|
5416 | # Takes a year in 2 digit form and returns it in 4 digit form
|
---|
5417 | sub _Date_FixYear {
|
---|
5418 | print "DEBUG: _Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5419 | my($y)=@_;
|
---|
5420 | my($curr_y)=$Curr{"Y"};
|
---|
5421 | $y=$curr_y if (! defined $y or ! $y);
|
---|
5422 | return $y if (length($y)==4);
|
---|
5423 | confess "ERROR: Invalid year ($y)\n" if (length($y)!=2);
|
---|
5424 | my($y1,$y2)=();
|
---|
5425 |
|
---|
5426 | if (lc($Cnf{"YYtoYYYY"}) eq "c") {
|
---|
5427 | $y1=substr($y,0,2);
|
---|
5428 | $y="$y1$y";
|
---|
5429 |
|
---|
5430 | } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
|
---|
5431 | $y1=$1;
|
---|
5432 | $y="$y1$y";
|
---|
5433 |
|
---|
5434 | } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
|
---|
5435 | $y1="$1$2";
|
---|
5436 | $y ="$1$y";
|
---|
5437 | $y += 100 if ($y<$y1);
|
---|
5438 |
|
---|
5439 | } else {
|
---|
5440 | $y1=$curr_y-$Cnf{"YYtoYYYY"};
|
---|
5441 | $y2=$y1+99;
|
---|
5442 | $y="19$y";
|
---|
5443 | while ($y<$y1) {
|
---|
5444 | $y+=100;
|
---|
5445 | }
|
---|
5446 | while ($y>$y2) {
|
---|
5447 | $y-=100;
|
---|
5448 | }
|
---|
5449 | }
|
---|
5450 | $y;
|
---|
5451 | }
|
---|
5452 |
|
---|
5453 | # _Date_NthWeekOfYear($y,$n);
|
---|
5454 | # Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
|
---|
5455 | # year.
|
---|
5456 | # _Date_NthWeekOfYear($y,$n,$dow,$flag);
|
---|
5457 | # Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag
|
---|
5458 | # is nil, the first DoW of the year may actually be in the previous
|
---|
5459 | # year (since the 1st week may include days from the previous year).
|
---|
5460 | # If flag is non-nil, the 1st DoW of the year refers to the 1st one
|
---|
5461 | # actually in the year
|
---|
5462 | sub _Date_NthWeekOfYear {
|
---|
5463 | print "DEBUG: _Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5464 | my($y,$n,$dow,$flag)=@_;
|
---|
5465 | my($m,$d,$err,$tmp,$date,%dow)=();
|
---|
5466 | $y=$Curr{"Y"} if (! defined $y or ! $y);
|
---|
5467 | $n=1 if (! defined $n or $n eq "");
|
---|
5468 | return () if ($n<0 || $n>53);
|
---|
5469 | if (defined $dow) {
|
---|
5470 | $dow=lc($dow);
|
---|
5471 | %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
|
---|
5472 | $dow=$dow{$dow} if (exists $dow{$dow});
|
---|
5473 | return () if ($dow<1 || $dow>7);
|
---|
5474 | $flag="" if (! defined $flag);
|
---|
5475 | } else {
|
---|
5476 | $dow="";
|
---|
5477 | $flag="";
|
---|
5478 | }
|
---|
5479 |
|
---|
5480 | $y=_Date_FixYear($y) if (length($y)<4);
|
---|
5481 | if ($Cnf{"Jan1Week1"}) {
|
---|
5482 | $date=_Date_Join($y,1,1,0,0,0);
|
---|
5483 | } else {
|
---|
5484 | $date=_Date_Join($y,1,4,0,0,0);
|
---|
5485 | }
|
---|
5486 | $date=Date_GetPrev($date,$Cnf{"FirstDay"},1);
|
---|
5487 | $date=Date_GetNext($date,$dow,1) if ($dow ne "");
|
---|
5488 |
|
---|
5489 | if ($flag) {
|
---|
5490 | ($tmp)=_Date_Split($date, 1);
|
---|
5491 | $n++ if ($tmp != $y);
|
---|
5492 | }
|
---|
5493 |
|
---|
5494 | if ($n>1) {
|
---|
5495 | $date=_DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0);
|
---|
5496 | } elsif ($n==0) {
|
---|
5497 | $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0);
|
---|
5498 | }
|
---|
5499 | ($y,$m,$d)=_Date_Split($date, 1);
|
---|
5500 | ($y,$m,$d);
|
---|
5501 | }
|
---|
5502 |
|
---|
5503 | ########################################################################
|
---|
5504 | # LANGUAGE INITIALIZATION
|
---|
5505 | ########################################################################
|
---|
5506 |
|
---|
5507 | # 8-bit international characters can be gotten by "\xXX". I don't know
|
---|
5508 | # how to get 16-bit characters. I've got to read up on perllocale.
|
---|
5509 | sub _Char_8Bit {
|
---|
5510 | my($hash)=@_;
|
---|
5511 |
|
---|
5512 | # grave `
|
---|
5513 | # A` 00c0 a` 00e0
|
---|
5514 | # E` 00c8 e` 00e8
|
---|
5515 | # I` 00cc i` 00ec
|
---|
5516 | # O` 00d2 o` 00f2
|
---|
5517 | # U` 00d9 u` 00f9
|
---|
5518 | # W` 1e80 w` 1e81
|
---|
5519 | # Y` 1ef2 y` 1ef3
|
---|
5520 |
|
---|
5521 | $$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE
|
---|
5522 | $$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE
|
---|
5523 | $$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE
|
---|
5524 | $$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE
|
---|
5525 | $$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE
|
---|
5526 | $$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE
|
---|
5527 | $$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE
|
---|
5528 | $$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE
|
---|
5529 | $$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE
|
---|
5530 | $$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE
|
---|
5531 |
|
---|
5532 | # acute '
|
---|
5533 | # A' 00c1 a' 00e1
|
---|
5534 | # C' 0106 c' 0107
|
---|
5535 | # E' 00c9 e' 00e9
|
---|
5536 | # I' 00cd i' 00ed
|
---|
5537 | # L' 0139 l' 013a
|
---|
5538 | # N' 0143 n' 0144
|
---|
5539 | # O' 00d3 o' 00f3
|
---|
5540 | # R' 0154 r' 0155
|
---|
5541 | # S' 015a s' 015b
|
---|
5542 | # U' 00da u' 00fa
|
---|
5543 | # W' 1e82 w' 1e83
|
---|
5544 | # Y' 00dd y' 00fd
|
---|
5545 | # Z' 0179 z' 017a
|
---|
5546 |
|
---|
5547 | $$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE
|
---|
5548 | $$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE
|
---|
5549 | $$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE
|
---|
5550 | $$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE
|
---|
5551 | $$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE
|
---|
5552 | $$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE
|
---|
5553 | $$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE
|
---|
5554 | $$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE
|
---|
5555 | $$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE
|
---|
5556 | $$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE
|
---|
5557 | $$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE
|
---|
5558 | $$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE
|
---|
5559 |
|
---|
5560 | # double acute " "
|
---|
5561 | # O" 0150 o" 0151
|
---|
5562 | # U" 0170 u" 0171
|
---|
5563 |
|
---|
5564 | # circumflex ^
|
---|
5565 | # A^ 00c2 a^ 00e2
|
---|
5566 | # C^ 0108 c^ 0109
|
---|
5567 | # E^ 00ca e^ 00ea
|
---|
5568 | # G^ 011c g^ 011d
|
---|
5569 | # H^ 0124 h^ 0125
|
---|
5570 | # I^ 00ce i^ 00ee
|
---|
5571 | # J^ 0134 j^ 0135
|
---|
5572 | # O^ 00d4 o^ 00f4
|
---|
5573 | # S^ 015c s^ 015d
|
---|
5574 | # U^ 00db u^ 00fb
|
---|
5575 | # W^ 0174 w^ 0175
|
---|
5576 | # Y^ 0176 y^ 0177
|
---|
5577 |
|
---|
5578 | $$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
|
---|
5579 | $$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
|
---|
5580 | $$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
|
---|
5581 | $$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
|
---|
5582 | $$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
|
---|
5583 | $$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX
|
---|
5584 | $$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX
|
---|
5585 | $$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX
|
---|
5586 | $$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX
|
---|
5587 | $$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX
|
---|
5588 |
|
---|
5589 | # tilde ~
|
---|
5590 | # A~ 00c3 a~ 00e3
|
---|
5591 | # I~ 0128 i~ 0129
|
---|
5592 | # N~ 00d1 n~ 00f1
|
---|
5593 | # O~ 00d5 o~ 00f5
|
---|
5594 | # U~ 0168 u~ 0169
|
---|
5595 |
|
---|
5596 | $$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE
|
---|
5597 | $$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE
|
---|
5598 | $$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE
|
---|
5599 | $$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE
|
---|
5600 | $$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE
|
---|
5601 | $$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE
|
---|
5602 |
|
---|
5603 | # macron -
|
---|
5604 | # A- 0100 a- 0101
|
---|
5605 | # E- 0112 e- 0113
|
---|
5606 | # I- 012a i- 012b
|
---|
5607 | # O- 014c o- 014d
|
---|
5608 | # U- 016a u- 016b
|
---|
5609 |
|
---|
5610 | # breve ( [half circle up]
|
---|
5611 | # A( 0102 a( 0103
|
---|
5612 | # G( 011e g( 011f
|
---|
5613 | # U( 016c u( 016d
|
---|
5614 |
|
---|
5615 | # dot .
|
---|
5616 | # C. 010a c. 010b
|
---|
5617 | # E. 0116 e. 0117
|
---|
5618 | # G. 0120 g. 0121
|
---|
5619 | # I. 0130
|
---|
5620 | # Z. 017b z. 017c
|
---|
5621 |
|
---|
5622 | # diaeresis : [side by side dots]
|
---|
5623 | # A: 00c4 a: 00e4
|
---|
5624 | # E: 00cb e: 00eb
|
---|
5625 | # I: 00cf i: 00ef
|
---|
5626 | # O: 00d6 o: 00f6
|
---|
5627 | # U: 00dc u: 00fc
|
---|
5628 | # W: 1e84 w: 1e85
|
---|
5629 | # Y: 0178 y: 00ff
|
---|
5630 |
|
---|
5631 | $$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS
|
---|
5632 | $$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS
|
---|
5633 | $$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS
|
---|
5634 | $$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS
|
---|
5635 | $$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS
|
---|
5636 | $$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS
|
---|
5637 | $$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS
|
---|
5638 | $$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS
|
---|
5639 | $$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS
|
---|
5640 | $$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS
|
---|
5641 | $$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS
|
---|
5642 |
|
---|
5643 | # ring o
|
---|
5644 | # U0 016e u0 016f
|
---|
5645 |
|
---|
5646 | # cedilla , [squiggle down and left below the letter]
|
---|
5647 | # ,C 00c7 ,c 00e7
|
---|
5648 | # ,G 0122 ,g 0123
|
---|
5649 | # ,K 0136 ,k 0137
|
---|
5650 | # ,L 013b ,l 013c
|
---|
5651 | # ,N 0145 ,n 0146
|
---|
5652 | # ,R 0156 ,r 0157
|
---|
5653 | # ,S 015e ,s 015f
|
---|
5654 | # ,T 0162 ,t 0163
|
---|
5655 |
|
---|
5656 | $$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA
|
---|
5657 | $$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA
|
---|
5658 |
|
---|
5659 | # ogonek ; [squiggle down and right below the letter]
|
---|
5660 | # A; 0104 a; 0105
|
---|
5661 | # E; 0118 e; 0119
|
---|
5662 | # I; 012e i; 012f
|
---|
5663 | # U; 0172 u; 0173
|
---|
5664 |
|
---|
5665 | # caron < [little v on top]
|
---|
5666 | # A< 01cd a< 01ce
|
---|
5667 | # C< 010c c< 010d
|
---|
5668 | # D< 010e d< 010f
|
---|
5669 | # E< 011a e< 011b
|
---|
5670 | # L< 013d l< 013e
|
---|
5671 | # N< 0147 n< 0148
|
---|
5672 | # R< 0158 r< 0159
|
---|
5673 | # S< 0160 s< 0161
|
---|
5674 | # T< 0164 t< 0165
|
---|
5675 | # Z< 017d z< 017e
|
---|
5676 |
|
---|
5677 |
|
---|
5678 | # Other characters
|
---|
5679 |
|
---|
5680 | # First character is below, 2nd character is above
|
---|
5681 | $$hash{"||"} = "\xa6"; # BROKEN BAR
|
---|
5682 | $$hash{" :"} = "\xa8"; # DIAERESIS
|
---|
5683 | $$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR
|
---|
5684 | #$$hash{" -"}= "\xaf"; # MACRON (narrow bar)
|
---|
5685 | $$hash{" -"} = "\xad"; # HYPHEN (wide bar)
|
---|
5686 | $$hash{" o"} = "\xb0"; # DEGREE SIGN
|
---|
5687 | $$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN
|
---|
5688 | $$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE
|
---|
5689 | $$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO
|
---|
5690 | $$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE
|
---|
5691 | $$hash{" '"} = "\xb4"; # ACUTE ACCENT
|
---|
5692 | $$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR
|
---|
5693 | $$hash{" ."} = "\xb7"; # MIDDLE DOT
|
---|
5694 | $$hash{", "} = "\xb8"; # CEDILLA
|
---|
5695 | $$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE
|
---|
5696 | $$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE
|
---|
5697 | $$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH
|
---|
5698 |
|
---|
5699 | # upside down characters
|
---|
5700 |
|
---|
5701 | $$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
|
---|
5702 | $$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
|
---|
5703 |
|
---|
5704 | # overlay characters
|
---|
5705 |
|
---|
5706 | $$hash{"X o"} = "\xa4"; # CURRENCY SIGN
|
---|
5707 | $$hash{"Y ="} = "\xa5"; # YEN SIGN
|
---|
5708 | $$hash{"S o"} = "\xa7"; # SECTION SIGN
|
---|
5709 | $$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright
|
---|
5710 | $$hash{"O R"} = "\xae"; # REGISTERED SIGN
|
---|
5711 | $$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH
|
---|
5712 | $$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE
|
---|
5713 | $$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE
|
---|
5714 |
|
---|
5715 | # special names
|
---|
5716 |
|
---|
5717 | $$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER
|
---|
5718 | $$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF
|
---|
5719 | $$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS
|
---|
5720 | $$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK
|
---|
5721 | $$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK
|
---|
5722 | $$hash{"cent"}= "\xa2"; # CENT SIGN
|
---|
5723 | $$hash{"lb"} = "\xa3"; # POUND SIGN
|
---|
5724 | $$hash{"mu"} = "\xb5"; # MICRO SIGN
|
---|
5725 | $$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S
|
---|
5726 | $$hash{"para"}= "\xb6"; # PILCROW SIGN
|
---|
5727 | $$hash{"-|"} = "\xac"; # NOT SIGN
|
---|
5728 | $$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE
|
---|
5729 | $$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE
|
---|
5730 | $$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN
|
---|
5731 | $$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN
|
---|
5732 | $$hash{"/"} = "\xf7"; # DIVISION SIGN
|
---|
5733 | $$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN
|
---|
5734 | }
|
---|
5735 |
|
---|
5736 | # $hashref = _Date_Init_LANGUAGE;
|
---|
5737 | # This returns a hash containing all of the initialization for a
|
---|
5738 | # specific language. The hash elements are:
|
---|
5739 | #
|
---|
5740 | # @ month_name full month names January February ...
|
---|
5741 | # @ month_abb month abbreviations Jan Feb ...
|
---|
5742 | # @ day_name day names Monday Tuesday ...
|
---|
5743 | # @ day_abb day abbreviations Mon Tue ...
|
---|
5744 | # @ day_char day character abbrevs M T ...
|
---|
5745 | # @ am AM notations
|
---|
5746 | # @ pm PM notations
|
---|
5747 | #
|
---|
5748 | # @ num_suff number with suffix 1st 2nd ...
|
---|
5749 | # @ num_word numbers spelled out first second ...
|
---|
5750 | #
|
---|
5751 | # $ now words which mean now now ...
|
---|
5752 | # $ today words which mean today today ...
|
---|
5753 | # $ last words which mean last last final ...
|
---|
5754 | # $ each words which mean each each every ...
|
---|
5755 | # $ of of (as in a member of) in of ...
|
---|
5756 | # ex. 4th day OF June
|
---|
5757 | # $ at at 4:00 at
|
---|
5758 | # $ on on Sunday on
|
---|
5759 | # $ future in the future in
|
---|
5760 | # $ past in the past ago
|
---|
5761 | # $ next next item next
|
---|
5762 | # $ prev previous item last previous
|
---|
5763 | # $ later 2 hours later
|
---|
5764 | #
|
---|
5765 | # % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 }
|
---|
5766 | # % times a hash of times { noon->12:00:00 ... }
|
---|
5767 | #
|
---|
5768 | # $ years words for year y yr year ...
|
---|
5769 | # $ months words for month
|
---|
5770 | # $ weeks words for week
|
---|
5771 | # $ days words for day
|
---|
5772 | # $ hours words for hour
|
---|
5773 | # $ minutes words for minute
|
---|
5774 | # $ seconds words for second
|
---|
5775 | # % replace
|
---|
5776 | # The replace element is quite important, but a bit tricky. In
|
---|
5777 | # English (and probably other languages), one of the abbreviations
|
---|
5778 | # for the word month that would be nice is "m". The problem is that
|
---|
5779 | # "m" matches the "m" in "minute" which causes the string to be
|
---|
5780 | # improperly matched in some cases. Hence, the list of abbreviations
|
---|
5781 | # for month is given as:
|
---|
5782 | # "mon month months"
|
---|
5783 | # In order to allow you to enter "m", replacements can be done.
|
---|
5784 | # $replace is a list of pairs of words which are matched and replaced
|
---|
5785 | # AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that
|
---|
5786 | # the entire word "m" will be replaced with "month". This allows the
|
---|
5787 | # desired abbreviation to be used. Make sure that replace contains
|
---|
5788 | # an even number of words (i.e. all must be pairs). Any time a
|
---|
5789 | # desired abbreviation matches the start of any other, it has to go
|
---|
5790 | # here.
|
---|
5791 | #
|
---|
5792 | # $ exact exact mode exactly
|
---|
5793 | # $ approx approximate mode approximately
|
---|
5794 | # $ business business mode business
|
---|
5795 | #
|
---|
5796 | # r sephm hour/minute separator (?::)
|
---|
5797 | # r sepms minute/second separator (?::)
|
---|
5798 | # r sepss second/fraction separator (?:[.:])
|
---|
5799 | #
|
---|
5800 | # Elements marked with an asterix (@) are returned as a set of lists.
|
---|
5801 | # Each list contains the strings for each element. The first set is used
|
---|
5802 | # when the 7-bit ASCII (US) character set is wanted. The 2nd set is used
|
---|
5803 | # when an international character set is available. Both of the 1st two
|
---|
5804 | # sets should be complete (but the 2nd list can be left empty to force the
|
---|
5805 | # first set to be used always). The 3rd set and later can be partial sets
|
---|
5806 | # if desired.
|
---|
5807 | #
|
---|
5808 | # Elements marked with a dollar ($) are returned as a simple list of words.
|
---|
5809 | #
|
---|
5810 | # Elements marked with a percent (%) are returned as a hash list.
|
---|
5811 | #
|
---|
5812 | # Elements marked with (r) are regular expression elements which must not
|
---|
5813 | # create a back reference.
|
---|
5814 | #
|
---|
5815 | # ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in
|
---|
5816 | # every language.
|
---|
5817 |
|
---|
5818 | sub _Date_Init_English {
|
---|
5819 | print "DEBUG: _Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5820 | my($d)=@_;
|
---|
5821 |
|
---|
5822 | $$d{"month_name"}=
|
---|
5823 | [["January","February","March","April","May","June",
|
---|
5824 | "July","August","September","October","November","December"]];
|
---|
5825 |
|
---|
5826 | $$d{"month_abb"}=
|
---|
5827 | [["Jan","Feb","Mar","Apr","May","Jun",
|
---|
5828 | "Jul","Aug","Sep","Oct","Nov","Dec"],
|
---|
5829 | [],
|
---|
5830 | ["","","","","","","","","Sept"]];
|
---|
5831 |
|
---|
5832 | $$d{"day_name"}=
|
---|
5833 | [["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
|
---|
5834 | $$d{"day_abb"}=
|
---|
5835 | [["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
|
---|
5836 | ["", "Tues","", "Thur","", "", ""]];
|
---|
5837 | $$d{"day_char"}=
|
---|
5838 | [["M","T","W","Th","F","Sa","S"]];
|
---|
5839 |
|
---|
5840 | $$d{"num_suff"}=
|
---|
5841 | [["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th",
|
---|
5842 | "11th","12th","13th","14th","15th","16th","17th","18th","19th","20th",
|
---|
5843 | "21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th",
|
---|
5844 | "31st"]];
|
---|
5845 | $$d{"num_word"}=
|
---|
5846 | [["first","second","third","fourth","fifth","sixth","seventh","eighth",
|
---|
5847 | "ninth","tenth","eleventh","twelfth","thirteenth","fourteenth",
|
---|
5848 | "fifteenth","sixteenth","seventeenth","eighteenth","nineteenth",
|
---|
5849 | "twentieth","twenty-first","twenty-second","twenty-third",
|
---|
5850 | "twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh",
|
---|
5851 | "twenty-eighth","twenty-ninth","thirtieth","thirty-first"]];
|
---|
5852 |
|
---|
5853 | $$d{"now"} =["now"];
|
---|
5854 | $$d{"today"} =["today"];
|
---|
5855 | $$d{"last"} =["last","final"];
|
---|
5856 | $$d{"each"} =["each","every"];
|
---|
5857 | $$d{"of"} =["in","of"];
|
---|
5858 | $$d{"at"} =["at"];
|
---|
5859 | $$d{"on"} =["on"];
|
---|
5860 | $$d{"future"} =["in"];
|
---|
5861 | $$d{"past"} =["ago"];
|
---|
5862 | $$d{"next"} =["next"];
|
---|
5863 | $$d{"prev"} =["previous","last"];
|
---|
5864 | $$d{"later"} =["later"];
|
---|
5865 |
|
---|
5866 | $$d{"exact"} =["exactly"];
|
---|
5867 | $$d{"approx"} =["approximately"];
|
---|
5868 | $$d{"business"}=["business"];
|
---|
5869 |
|
---|
5870 | $$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"];
|
---|
5871 | $$d{"times"} =["noon","12:00:00","midnight","00:00:00"];
|
---|
5872 |
|
---|
5873 | $$d{"years"} =["y","yr","year","yrs","years"];
|
---|
5874 | $$d{"months"} =["mon","month","months"];
|
---|
5875 | $$d{"weeks"} =["w","wk","wks","week","weeks"];
|
---|
5876 | $$d{"days"} =["d","day","days"];
|
---|
5877 | $$d{"hours"} =["h","hr","hrs","hour","hours"];
|
---|
5878 | $$d{"minutes"} =["mn","min","minute","minutes"];
|
---|
5879 | $$d{"seconds"} =["s","sec","second","seconds"];
|
---|
5880 | $$d{"replace"} =["m","month"];
|
---|
5881 |
|
---|
5882 | $$d{"sephm"} =':';
|
---|
5883 | $$d{"sepms"} =':';
|
---|
5884 | $$d{"sepss"} ='[.:]';
|
---|
5885 |
|
---|
5886 | $$d{"am"} = ["AM","A.M."];
|
---|
5887 | $$d{"pm"} = ["PM","P.M."];
|
---|
5888 | }
|
---|
5889 |
|
---|
5890 | sub _Date_Init_Italian {
|
---|
5891 | print "DEBUG: _Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5892 | my($d)=@_;
|
---|
5893 | my(%h)=();
|
---|
5894 | _Char_8Bit(\%h);
|
---|
5895 | my($i)=$h{"i`"};
|
---|
5896 |
|
---|
5897 | $$d{"month_name"}=
|
---|
5898 | [[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
|
---|
5899 | Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
|
---|
5900 |
|
---|
5901 | $$d{"month_abb"}=
|
---|
5902 | [[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
|
---|
5903 |
|
---|
5904 | $$d{"day_name"}=
|
---|
5905 | [[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
|
---|
5906 | [qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
|
---|
5907 | $$d{"day_abb"}=
|
---|
5908 | [[qw(Lun Mar Mer Gio Ven Sab Dom)]];
|
---|
5909 | $$d{"day_char"}=
|
---|
5910 | [[qw(L Ma Me G V S D)]];
|
---|
5911 |
|
---|
5912 | $$d{"num_suff"}=
|
---|
5913 | [[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo
|
---|
5914 | 16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo
|
---|
5915 | 29mo 3mo 31mo)]];
|
---|
5916 | $$d{"num_word"}=
|
---|
5917 | [[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo
|
---|
5918 | undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo
|
---|
5919 | sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo
|
---|
5920 | ventunesimo ventiduesimo ventitreesimo ventiquattresimo
|
---|
5921 | venticinquesimo ventiseiesimo ventisettesimo ventottesimo
|
---|
5922 | ventinovesimo trentesimo trentunesimo)]];
|
---|
5923 |
|
---|
5924 | $$d{"now"} =[qw(adesso)];
|
---|
5925 | $$d{"today"} =[qw(oggi)];
|
---|
5926 | $$d{"last"} =[qw(ultimo)];
|
---|
5927 | $$d{"each"} =[qw(ogni)];
|
---|
5928 | $$d{"of"} =[qw(della del)];
|
---|
5929 | $$d{"at"} =[qw(alle)];
|
---|
5930 | $$d{"on"} =[qw(di)];
|
---|
5931 | $$d{"future"} =[qw(fra)];
|
---|
5932 | $$d{"past"} =[qw(fa)];
|
---|
5933 | $$d{"next"} =[qw(prossimo)];
|
---|
5934 | $$d{"prev"} =[qw(ultimo)];
|
---|
5935 | $$d{"later"} =[qw(dopo)];
|
---|
5936 |
|
---|
5937 | $$d{"exact"} =[qw(esattamente)];
|
---|
5938 | $$d{"approx"} =[qw(circa)];
|
---|
5939 | $$d{"business"}=[qw(lavorativi lavorativo)];
|
---|
5940 |
|
---|
5941 | $$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)];
|
---|
5942 | $$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)];
|
---|
5943 |
|
---|
5944 | $$d{"years"} =[qw(anni anno a)];
|
---|
5945 | $$d{"months"} =[qw(mesi mese mes)];
|
---|
5946 | $$d{"weeks"} =[qw(settimane settimana sett)];
|
---|
5947 | $$d{"days"} =[qw(giorni giorno g)];
|
---|
5948 | $$d{"hours"} =[qw(ore ora h)];
|
---|
5949 | $$d{"minutes"} =[qw(minuti minuto min)];
|
---|
5950 | $$d{"seconds"} =[qw(secondi secondo sec)];
|
---|
5951 | $$d{"replace"} =[qw(s sec m mes)];
|
---|
5952 |
|
---|
5953 | $$d{"sephm"} =':';
|
---|
5954 | $$d{"sepms"} =':';
|
---|
5955 | $$d{"sepss"} ='[.:]';
|
---|
5956 |
|
---|
5957 | $$d{"am"} = [qw(AM)];
|
---|
5958 | $$d{"pm"} = [qw(PM)];
|
---|
5959 | }
|
---|
5960 |
|
---|
5961 | sub _Date_Init_French {
|
---|
5962 | print "DEBUG: _Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
5963 | my($d)=@_;
|
---|
5964 | my(%h)=();
|
---|
5965 | _Char_8Bit(\%h);
|
---|
5966 | my($e)=$h{"e'"};
|
---|
5967 | my($u)=$h{"u^"};
|
---|
5968 | my($a)=$h{"a'"};
|
---|
5969 |
|
---|
5970 | $$d{"month_name"}=
|
---|
5971 | [["janvier","fevrier","mars","avril","mai","juin",
|
---|
5972 | "juillet","aout","septembre","octobre","novembre","decembre"],
|
---|
5973 | ["janvier","f${e}vrier","mars","avril","mai","juin",
|
---|
5974 | "juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]];
|
---|
5975 | $$d{"month_abb"}=
|
---|
5976 | [["jan","fev","mar","avr","mai","juin",
|
---|
5977 | "juil","aout","sept","oct","nov","dec"],
|
---|
5978 | ["jan","f${e}v","mar","avr","mai","juin",
|
---|
5979 | "juil","ao${u}t","sept","oct","nov","d${e}c"]];
|
---|
5980 |
|
---|
5981 | $$d{"day_name"}=
|
---|
5982 | [["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
|
---|
5983 | $$d{"day_abb"}=
|
---|
5984 | [["lun","mar","mer","jeu","ven","sam","dim"]];
|
---|
5985 | $$d{"day_char"}=
|
---|
5986 | [["l","ma","me","j","v","s","d"]];
|
---|
5987 |
|
---|
5988 | $$d{"num_suff"}=
|
---|
5989 | [["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e",
|
---|
5990 | "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
|
---|
5991 | "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
|
---|
5992 | "31e"]];
|
---|
5993 | $$d{"num_word"}=
|
---|
5994 | [["premier","deux","trois","quatre","cinq","six","sept","huit","neuf",
|
---|
5995 | "dix","onze","douze","treize","quatorze","quinze","seize","dix-sept",
|
---|
5996 | "dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois",
|
---|
5997 | "vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit",
|
---|
5998 | "vingt-neuf","trente","trente et un"],
|
---|
5999 | ["1re"]];
|
---|
6000 |
|
---|
6001 | $$d{"now"} =["maintenant"];
|
---|
6002 | $$d{"today"} =["aujourd'hui"];
|
---|
6003 | $$d{"last"} =["dernier"];
|
---|
6004 | $$d{"each"} =["chaque","tous les","toutes les"];
|
---|
6005 | $$d{"of"} =["en","de"];
|
---|
6006 | $$d{"at"} =["a","${a}0"];
|
---|
6007 | $$d{"on"} =["sur"];
|
---|
6008 | $$d{"future"} =["en"];
|
---|
6009 | $$d{"past"} =["il y a"];
|
---|
6010 | $$d{"next"} =["suivant"];
|
---|
6011 | $$d{"prev"} =["precedent","pr${e}c${e}dent"];
|
---|
6012 | $$d{"later"} =["plus tard"];
|
---|
6013 |
|
---|
6014 | $$d{"exact"} =["exactement"];
|
---|
6015 | $$d{"approx"} =["approximativement"];
|
---|
6016 | $$d{"business"}=["professionel"];
|
---|
6017 |
|
---|
6018 | $$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"];
|
---|
6019 | $$d{"times"} =["midi","12:00:00","minuit","00:00:00"];
|
---|
6020 |
|
---|
6021 | $$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"];
|
---|
6022 | $$d{"months"} =["mois"];
|
---|
6023 | $$d{"weeks"} =["sem","semaine"];
|
---|
6024 | $$d{"days"} =["j","jour","jours"];
|
---|
6025 | $$d{"hours"} =["h","heure","heures"];
|
---|
6026 | $$d{"minutes"} =["mn","min","minute","minutes"];
|
---|
6027 | $$d{"seconds"} =["s","sec","seconde","secondes"];
|
---|
6028 | $$d{"replace"} =["m","mois"];
|
---|
6029 |
|
---|
6030 | $$d{"sephm"} ='[h:]';
|
---|
6031 | $$d{"sepms"} =':';
|
---|
6032 | $$d{"sepss"} ='[.:,]';
|
---|
6033 |
|
---|
6034 | $$d{"am"} = ["du matin"];
|
---|
6035 | $$d{"pm"} = ["du soir"];
|
---|
6036 | }
|
---|
6037 |
|
---|
6038 | sub _Date_Init_Romanian {
|
---|
6039 | print "DEBUG: _Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6040 | my($d)=@_;
|
---|
6041 | my(%h)=();
|
---|
6042 | _Char_8Bit(\%h);
|
---|
6043 | my($p)=$h{"p"};
|
---|
6044 | my($i)=$h{"i^"};
|
---|
6045 | my($a)=$h{"a~"};
|
---|
6046 | my($o)=$h{"-o"};
|
---|
6047 |
|
---|
6048 | $$d{"month_name"}=
|
---|
6049 | [["ianuarie","februarie","martie","aprilie","mai","iunie",
|
---|
6050 | "iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
|
---|
6051 | $$d{"month_abb"}=
|
---|
6052 | [["ian","febr","mart","apr","mai","iun",
|
---|
6053 | "iul","aug","sept","oct","nov","dec"],
|
---|
6054 | ["","feb"]];
|
---|
6055 |
|
---|
6056 | $$d{"day_name"}=
|
---|
6057 | [["luni","marti","miercuri","joi","vineri","simbata","duminica"],
|
---|
6058 | ["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
|
---|
6059 | "duminic${a}"]];
|
---|
6060 | $$d{"day_abb"}=
|
---|
6061 | [["lun","mar","mie","joi","vin","sim","dum"],
|
---|
6062 | ["lun","mar","mie","joi","vin","s${i}m","dum"]];
|
---|
6063 | $$d{"day_char"}=
|
---|
6064 | [["L","Ma","Mi","J","V","S","D"]];
|
---|
6065 |
|
---|
6066 | $$d{"num_suff"}=
|
---|
6067 | [["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a",
|
---|
6068 | "a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a",
|
---|
6069 | "a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a",
|
---|
6070 | "a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a",
|
---|
6071 | "a 30-a","a 31-a"]];
|
---|
6072 |
|
---|
6073 | $$d{"num_word"}=
|
---|
6074 | [["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea",
|
---|
6075 | "a opta","a noua","a zecea","a unsprezecea","a doisprezecea",
|
---|
6076 | "a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea",
|
---|
6077 | "a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea",
|
---|
6078 | "a douazecisiuna","a douazecisidoua","a douazecisitreia",
|
---|
6079 | "a douazecisipatra","a douazecisicincea","a douazecisisasea",
|
---|
6080 | "a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea",
|
---|
6081 | "a treizecisiuna"],
|
---|
6082 | ["prima","a doua","a treia","a patra","a cincea","a ${o}asea",
|
---|
6083 | "a ${o}aptea","a opta","a noua","a zecea","a unsprezecea",
|
---|
6084 | "a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea",
|
---|
6085 | "a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea",
|
---|
6086 | "a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna",
|
---|
6087 | "a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia",
|
---|
6088 | "a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea",
|
---|
6089 | "a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea",
|
---|
6090 | "a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea",
|
---|
6091 | "a treizeci${o}iuna"],
|
---|
6092 | ["intii", "doi", "trei", "patru", "cinci", "sase", "sapte",
|
---|
6093 | "opt","noua","zece","unsprezece","doisprezece",
|
---|
6094 | "treisprezece","patrusprezece","cincisprezece","saiprezece",
|
---|
6095 | "saptesprezece","optsprezece","nouasprezece","douazeci",
|
---|
6096 | "douazecisiunu","douazecisidoi","douazecisitrei",
|
---|
6097 | "douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte",
|
---|
6098 | "douazecisiopt","douazecisinoua","treizeci","treizecisiunu"],
|
---|
6099 | ["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte",
|
---|
6100 | "opt","nou${a}","zece","unsprezece","doisprezece",
|
---|
6101 | "treisprezece","patrusprezece","cincisprezece","${o}aiprezece",
|
---|
6102 | "${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci",
|
---|
6103 | "dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei",
|
---|
6104 | "dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase",
|
---|
6105 | "dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt",
|
---|
6106 | "dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]];
|
---|
6107 |
|
---|
6108 | $$d{"now"} =["acum"];
|
---|
6109 | $$d{"today"} =["azi","astazi","ast${a}zi"];
|
---|
6110 | $$d{"last"} =["ultima"];
|
---|
6111 | $$d{"each"} =["fiecare"];
|
---|
6112 | $$d{"of"} =["din","in","n"];
|
---|
6113 | $$d{"at"} =["la"];
|
---|
6114 | $$d{"on"} =["on"];
|
---|
6115 | $$d{"future"} =["in","${i}n"];
|
---|
6116 | $$d{"past"} =["in urma", "${i}n urm${a}"];
|
---|
6117 | $$d{"next"} =["urmatoarea","urm${a}toarea"];
|
---|
6118 | $$d{"prev"} =["precedenta","ultima"];
|
---|
6119 | $$d{"later"} =["mai tirziu", "mai t${i}rziu"];
|
---|
6120 |
|
---|
6121 | $$d{"exact"} =["exact"];
|
---|
6122 | $$d{"approx"} =["aproximativ"];
|
---|
6123 | $$d{"business"}=["de lucru","lucratoare","lucr${a}toare"];
|
---|
6124 |
|
---|
6125 | $$d{"offset"} =["ieri","-0:0:0:1:0:0:0",
|
---|
6126 | "alaltaieri", "-0:0:0:2:0:0:0",
|
---|
6127 | "alalt${a}ieri","-0:0:0:2:0:0:0",
|
---|
6128 | "miine","+0:0:0:1:0:0:0",
|
---|
6129 | "m${i}ine","+0:0:0:1:0:0:0",
|
---|
6130 | "poimiine","+0:0:0:2:0:0:0",
|
---|
6131 | "poim${i}ine","+0:0:0:2:0:0:0"];
|
---|
6132 | $$d{"times"} =["amiaza","12:00:00",
|
---|
6133 | "amiaz${a}","12:00:00",
|
---|
6134 | "miezul noptii","00:00:00",
|
---|
6135 | "miezul nop${p}ii","00:00:00"];
|
---|
6136 |
|
---|
6137 | $$d{"years"} =["ani","an","a"];
|
---|
6138 | $$d{"months"} =["luni","luna","lun${a}","l"];
|
---|
6139 | $$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina",
|
---|
6140 | "s${a}pt${a}m${i}na","sapt","s${a}pt"];
|
---|
6141 | $$d{"days"} =["zile","zi","z"];
|
---|
6142 | $$d{"hours"} =["ore", "ora", "or${a}", "h"];
|
---|
6143 | $$d{"minutes"} =["minute","min","m"];
|
---|
6144 | $$d{"seconds"} =["secunde","sec",];
|
---|
6145 | $$d{"replace"} =["s","secunde"];
|
---|
6146 |
|
---|
6147 | $$d{"sephm"} =':';
|
---|
6148 | $$d{"sepms"} =':';
|
---|
6149 | $$d{"sepss"} ='[.:,]';
|
---|
6150 |
|
---|
6151 | $$d{"am"} = ["AM","A.M."];
|
---|
6152 | $$d{"pm"} = ["PM","P.M."];
|
---|
6153 | }
|
---|
6154 |
|
---|
6155 | sub _Date_Init_Swedish {
|
---|
6156 | print "DEBUG: _Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6157 | my($d)=@_;
|
---|
6158 | my(%h)=();
|
---|
6159 | _Char_8Bit(\%h);
|
---|
6160 | my($ao)=$h{"ao"};
|
---|
6161 | my($o) =$h{"o:"};
|
---|
6162 | my($a) =$h{"a:"};
|
---|
6163 |
|
---|
6164 | $$d{"month_name"}=
|
---|
6165 | [["Januari","Februari","Mars","April","Maj","Juni",
|
---|
6166 | "Juli","Augusti","September","Oktober","November","December"]];
|
---|
6167 | $$d{"month_abb"}=
|
---|
6168 | [["Jan","Feb","Mar","Apr","Maj","Jun",
|
---|
6169 | "Jul","Aug","Sep","Okt","Nov","Dec"]];
|
---|
6170 |
|
---|
6171 | $$d{"day_name"}=
|
---|
6172 | [["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
|
---|
6173 | ["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
|
---|
6174 | "S${o}ndag"]];
|
---|
6175 | $$d{"day_abb"}=
|
---|
6176 | [["Man","Tis","Ons","Tor","Fre","Lor","Son"],
|
---|
6177 | ["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
|
---|
6178 | $$d{"day_char"}=
|
---|
6179 | [["M","Ti","O","To","F","L","S"]];
|
---|
6180 |
|
---|
6181 | $$d{"num_suff"}=
|
---|
6182 | [["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
|
---|
6183 | "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
|
---|
6184 | "21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
|
---|
6185 | "31:a"]];
|
---|
6186 | $$d{"num_word"}=
|
---|
6187 | [["forsta","andra","tredje","fjarde","femte","sjatte","sjunde",
|
---|
6188 | "attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
|
---|
6189 | "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
|
---|
6190 | "tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte",
|
---|
6191 | "tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde",
|
---|
6192 | "trettionde","trettioforsta"],
|
---|
6193 | ["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde",
|
---|
6194 | "${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
|
---|
6195 | "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
|
---|
6196 | "tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte",
|
---|
6197 | "tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde",
|
---|
6198 | "trettionde","trettiof${o}rsta"]];
|
---|
6199 |
|
---|
6200 | $$d{"now"} =["nu"];
|
---|
6201 | $$d{"today"} =["idag"];
|
---|
6202 | $$d{"last"} =["forra","f${o}rra","senaste"];
|
---|
6203 | $$d{"each"} =["varje"];
|
---|
6204 | $$d{"of"} =["om"];
|
---|
6205 | $$d{"at"} =["kl","kl.","klockan"];
|
---|
6206 | $$d{"on"} =["pa","p${ao}"];
|
---|
6207 | $$d{"future"} =["om"];
|
---|
6208 | $$d{"past"} =["sedan"];
|
---|
6209 | $$d{"next"} =["nasta","n${a}sta"];
|
---|
6210 | $$d{"prev"} =["forra","f${o}rra"];
|
---|
6211 | $$d{"later"} =["senare"];
|
---|
6212 |
|
---|
6213 | $$d{"exact"} =["exakt"];
|
---|
6214 | $$d{"approx"} =["ungefar","ungef${a}r"];
|
---|
6215 | $$d{"business"}=["arbetsdag","arbetsdagar"];
|
---|
6216 |
|
---|
6217 | $$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
|
---|
6218 | "imorgon","+0:0:0:1:0:0:0"];
|
---|
6219 | $$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00",
|
---|
6220 | "midnatt","00:00:00"];
|
---|
6221 |
|
---|
6222 | $$d{"years"} =["ar","${ao}r"];
|
---|
6223 | $$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"];
|
---|
6224 | $$d{"weeks"} =["v","vecka","veckor"];
|
---|
6225 | $$d{"days"} =["d","dag","dagar"];
|
---|
6226 | $$d{"hours"} =["t","tim","timme","timmar"];
|
---|
6227 | $$d{"minutes"} =["min","minut","minuter"];
|
---|
6228 | $$d{"seconds"} =["s","sek","sekund","sekunder"];
|
---|
6229 | $$d{"replace"} =["m","minut"];
|
---|
6230 |
|
---|
6231 | $$d{"sephm"} ='[.:]';
|
---|
6232 | $$d{"sepms"} =':';
|
---|
6233 | $$d{"sepss"} ='[.:]';
|
---|
6234 |
|
---|
6235 | $$d{"am"} = ["FM"];
|
---|
6236 | $$d{"pm"} = ["EM"];
|
---|
6237 | }
|
---|
6238 |
|
---|
6239 | sub _Date_Init_German {
|
---|
6240 | print "DEBUG: _Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6241 | my($d)=@_;
|
---|
6242 | my(%h)=();
|
---|
6243 | _Char_8Bit(\%h);
|
---|
6244 | my($a)=$h{"a:"};
|
---|
6245 | my($u)=$h{"u:"};
|
---|
6246 | my($o)=$h{"o:"};
|
---|
6247 | my($b)=$h{"beta"};
|
---|
6248 |
|
---|
6249 | $$d{"month_name"}=
|
---|
6250 | [["Januar","Februar","Maerz","April","Mai","Juni",
|
---|
6251 | "Juli","August","September","Oktober","November","Dezember"],
|
---|
6252 | ["J${a}nner","Februar","M${a}rz","April","Mai","Juni",
|
---|
6253 | "Juli","August","September","Oktober","November","Dezember"]];
|
---|
6254 | $$d{"month_abb"}=
|
---|
6255 | [["Jan","Feb","Mar","Apr","Mai","Jun",
|
---|
6256 | "Jul","Aug","Sep","Okt","Nov","Dez"],
|
---|
6257 | ["J${a}n","Feb","M${a}r","Apr","Mai","Jun",
|
---|
6258 | "Jul","Aug","Sep","Okt","Nov","Dez"]];
|
---|
6259 |
|
---|
6260 | $$d{"day_name"}=
|
---|
6261 | [["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
|
---|
6262 | "Sonntag"]];
|
---|
6263 | $$d{"day_abb"}=
|
---|
6264 | [["Mo","Di","Mi","Do","Fr","Sa","So"]];
|
---|
6265 | $$d{"day_char"}=
|
---|
6266 | [["M","Di","Mi","Do","F","Sa","So"]];
|
---|
6267 |
|
---|
6268 | $$d{"num_suff"}=
|
---|
6269 | [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
|
---|
6270 | "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
|
---|
6271 | "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
|
---|
6272 | "31."]];
|
---|
6273 | $$d{"num_word"}=
|
---|
6274 | [
|
---|
6275 | ["erste","zweite","dritte","vierte","funfte","sechste","siebente",
|
---|
6276 | "achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte",
|
---|
6277 | "funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte",
|
---|
6278 | "zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste",
|
---|
6279 | "vierundzwanzigste","funfundzwanzigste","sechundzwanzigste",
|
---|
6280 | "siebundzwanzigste","achtundzwanzigste","neunundzwanzigste",
|
---|
6281 | "dreibigste","einunddreibigste"],
|
---|
6282 | ["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente",
|
---|
6283 | "achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte",
|
---|
6284 | "vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte",
|
---|
6285 | "neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste",
|
---|
6286 | "dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste",
|
---|
6287 | "sechundzwanzigste","siebundzwanzigste","achtundzwanzigste",
|
---|
6288 | "neunundzwanzigste","drei${b}igste","einunddrei${b}igste"],
|
---|
6289 | ["erster"]];
|
---|
6290 |
|
---|
6291 | $$d{"now"} =["jetzt"];
|
---|
6292 | $$d{"today"} =["heute"];
|
---|
6293 | $$d{"last"} =["letzte","letzten"];
|
---|
6294 | $$d{"each"} =["jeden"];
|
---|
6295 | $$d{"of"} =["der","im","des"];
|
---|
6296 | $$d{"at"} =["um"];
|
---|
6297 | $$d{"on"} =["am"];
|
---|
6298 | $$d{"future"} =["in"];
|
---|
6299 | $$d{"past"} =["vor"];
|
---|
6300 | $$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
|
---|
6301 | $$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
|
---|
6302 | $$d{"later"} =["spater","sp${a}ter"];
|
---|
6303 |
|
---|
6304 | $$d{"exact"} =["genau"];
|
---|
6305 | $$d{"approx"} =["ungefahr","ungef${a}hr"];
|
---|
6306 | $$d{"business"}=["Arbeitstag"];
|
---|
6307 |
|
---|
6308 | $$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"];
|
---|
6309 | $$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"];
|
---|
6310 |
|
---|
6311 | $$d{"years"} =["j","Jahr","Jahre","Jahren"];
|
---|
6312 | $$d{"months"} =["Monat","Monate","Monaten"];
|
---|
6313 | $$d{"weeks"} =["w","Woche","Wochen"];
|
---|
6314 | $$d{"days"} =["t","Tag","Tage","Tagen"];
|
---|
6315 | $$d{"hours"} =["h","std","Stunde","Stunden"];
|
---|
6316 | $$d{"minutes"} =["min","Minute","Minuten"];
|
---|
6317 | $$d{"seconds"} =["s","sek","Sekunde","Sekunden"];
|
---|
6318 | $$d{"replace"} =["m","Monat"];
|
---|
6319 |
|
---|
6320 | $$d{"sephm"} =':';
|
---|
6321 | $$d{"sepms"} ='[: ]';
|
---|
6322 | $$d{"sepss"} ='[.:]';
|
---|
6323 |
|
---|
6324 | $$d{"am"} = ["FM"];
|
---|
6325 | $$d{"pm"} = ["EM"];
|
---|
6326 | }
|
---|
6327 |
|
---|
6328 | sub _Date_Init_Dutch {
|
---|
6329 | print "DEBUG: _Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6330 | my($d)=@_;
|
---|
6331 | my(%h)=();
|
---|
6332 | _Char_8Bit(\%h);
|
---|
6333 |
|
---|
6334 | $$d{"month_name"}=
|
---|
6335 | [["januari","februari","maart","april","mei","juni","juli","augustus",
|
---|
6336 | "september","october","november","december"],
|
---|
6337 | ["","","","","","","","","","oktober"]];
|
---|
6338 |
|
---|
6339 | $$d{"month_abb"}=
|
---|
6340 | [["jan","feb","maa","apr","mei","jun","jul",
|
---|
6341 | "aug","sep","oct","nov","dec"],
|
---|
6342 | ["","","mrt","","","","","","","okt"]];
|
---|
6343 | $$d{"day_name"}=
|
---|
6344 | [["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
|
---|
6345 | "zondag"]];
|
---|
6346 | $$d{"day_abb"}=
|
---|
6347 | [["ma","di","wo","do","vr","zat","zon"],
|
---|
6348 | ["","","","","","za","zo"]];
|
---|
6349 | $$d{"day_char"}=
|
---|
6350 | [["M","D","W","D","V","Za","Zo"]];
|
---|
6351 |
|
---|
6352 | $$d{"num_suff"}=
|
---|
6353 | [["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de",
|
---|
6354 | "11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste",
|
---|
6355 | "21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste",
|
---|
6356 | "30ste","31ste"]];
|
---|
6357 | $$d{"num_word"}=
|
---|
6358 | [["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
|
---|
6359 | "negende","tiende","elfde","twaalfde",
|
---|
6360 | map {"${_}tiende";} qw (der veer vijf zes zeven acht negen),
|
---|
6361 | "twintigste",
|
---|
6362 | map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht
|
---|
6363 | negen),
|
---|
6364 | "dertigste","eenendertigste"],
|
---|
6365 | ["","","","","","","","","","","","","","","","","","","","",
|
---|
6366 | map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht
|
---|
6367 | negen),
|
---|
6368 | "dertigste","een-en-dertigste"],
|
---|
6369 | ["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
|
---|
6370 | "elf","twaalf",
|
---|
6371 | map {"${_}tien"} qw (der veer vijf zes zeven acht negen),
|
---|
6372 | "twintig",
|
---|
6373 | map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen),
|
---|
6374 | "dertig","eenendertig"],
|
---|
6375 | ["","","","","","","","","","","","","","","","","","","","",
|
---|
6376 | map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht
|
---|
6377 | negen),
|
---|
6378 | "dertig","een-en-dertig"]];
|
---|
6379 |
|
---|
6380 | $$d{"now"} =["nu","nou"];
|
---|
6381 | $$d{"today"} =["vandaag"];
|
---|
6382 | $$d{"last"} =["laatste"];
|
---|
6383 | $$d{"each"} =["elke","elk"];
|
---|
6384 | $$d{"of"} =["in","van"];
|
---|
6385 | $$d{"at"} =["om"];
|
---|
6386 | $$d{"on"} =["op"];
|
---|
6387 | $$d{"future"} =["over"];
|
---|
6388 | $$d{"past"} =["geleden","vroeger","eerder"];
|
---|
6389 | $$d{"next"} =["volgende","volgend"];
|
---|
6390 | $$d{"prev"} =["voorgaande","voorgaand"];
|
---|
6391 | $$d{"later"} =["later"];
|
---|
6392 |
|
---|
6393 | $$d{"exact"} =["exact","precies","nauwkeurig"];
|
---|
6394 | $$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.'];
|
---|
6395 | $$d{"business"}=["werk","zakelijke","zakelijk"];
|
---|
6396 |
|
---|
6397 | $$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0",
|
---|
6398 | "gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"];
|
---|
6399 | $$d{"times"} =["noen","12:00:00","middernacht","00:00:00"];
|
---|
6400 |
|
---|
6401 | $$d{"years"} =["jaar","jaren","ja","j"];
|
---|
6402 | $$d{"months"} =["maand","maanden","mnd"];
|
---|
6403 | $$d{"weeks"} =["week","weken","w"];
|
---|
6404 | $$d{"days"} =["dag","dagen","d"];
|
---|
6405 | $$d{"hours"} =["uur","uren","u","h"];
|
---|
6406 | $$d{"minutes"} =["minuut","minuten","min"];
|
---|
6407 | $$d{"seconds"} =["seconde","seconden","sec","s"];
|
---|
6408 | $$d{"replace"} =["m","minuten"];
|
---|
6409 |
|
---|
6410 | $$d{"sephm"} ='[:.uh]';
|
---|
6411 | $$d{"sepms"} ='[:.m]';
|
---|
6412 | $$d{"sepss"} ='[.:]';
|
---|
6413 |
|
---|
6414 | $$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends",
|
---|
6415 | "ochtend","'s_nachts","nacht"];
|
---|
6416 | $$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag",
|
---|
6417 | "'s_avonds","avond"];
|
---|
6418 | }
|
---|
6419 |
|
---|
6420 | sub _Date_Init_Polish {
|
---|
6421 | print "DEBUG: _Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6422 | my($d)=@_;
|
---|
6423 |
|
---|
6424 | $$d{"month_name"}=
|
---|
6425 | [["stycznia","luty","marca","kwietnia","maja","czerwca",
|
---|
6426 | "lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"],
|
---|
6427 | ["stycznia","luty","marca","kwietnia","maja","czerwca","lipca",
|
---|
6428 | "sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]];
|
---|
6429 | $$d{"month_abb"}=
|
---|
6430 | [["sty.","lut.","mar.","kwi.","maj","cze.",
|
---|
6431 | "lip.","sie.","wrz.","paz.","lis.","gru."],
|
---|
6432 | ["sty.","lut.","mar.","kwi.","maj","cze.",
|
---|
6433 | "lip.","sie.","wrz.","pa\x9f.","lis.","gru."]];
|
---|
6434 |
|
---|
6435 | $$d{"day_name"}=
|
---|
6436 | [["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
|
---|
6437 | "niedziela"],
|
---|
6438 | ["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
|
---|
6439 | "sobota","niedziela"]];
|
---|
6440 | $$d{"day_abb"}=
|
---|
6441 | [["po.","wt.","sr.","cz.","pi.","so.","ni."],
|
---|
6442 | ["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
|
---|
6443 | $$d{"day_char"}=
|
---|
6444 | [["p","w","e","c","p","s","n"],
|
---|
6445 | ["p","w","\x9c.","c","p","s","n"]];
|
---|
6446 |
|
---|
6447 | $$d{"num_suff"}=
|
---|
6448 | [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
|
---|
6449 | "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
|
---|
6450 | "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
|
---|
6451 | "31."]];
|
---|
6452 | $$d{"num_word"}=
|
---|
6453 | [["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
|
---|
6454 | "siodmego","osmego","dziewiatego","dziesiatego",
|
---|
6455 | "jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
|
---|
6456 | "szestnastego","siedemnastego","osiemnastego","dziewietnastego",
|
---|
6457 | "dwudziestego",
|
---|
6458 | "dwudziestego pierwszego","dwudziestego drugiego",
|
---|
6459 | "dwudziestego trzeczego","dwudziestego czwartego",
|
---|
6460 | "dwudziestego piatego","dwudziestego szostego",
|
---|
6461 | "dwudziestego siodmego","dwudziestego osmego",
|
---|
6462 | "dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"],
|
---|
6463 | ["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego",
|
---|
6464 | "sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego",
|
---|
6465 | "dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego",
|
---|
6466 | "czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego",
|
---|
6467 | "osiemnastego","dziewietnastego","dwudziestego",
|
---|
6468 | "dwudziestego pierwszego","dwudziestego drugiego",
|
---|
6469 | "dwudziestego trzeczego","dwudziestego czwartego",
|
---|
6470 | "dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego",
|
---|
6471 | "dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego",
|
---|
6472 | "dwudziestego dziewi\x81\xb9tego","trzydziestego",
|
---|
6473 | "trzydziestego pierwszego"]];
|
---|
6474 |
|
---|
6475 | $$d{"now"} =["teraz"];
|
---|
6476 | $$d{"today"} =["dzisaj"];
|
---|
6477 | $$d{"last"} =["ostatni","ostatna"];
|
---|
6478 | $$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"];
|
---|
6479 | $$d{"of"} =["w","z"];
|
---|
6480 | $$d{"at"} =["o","u"];
|
---|
6481 | $$d{"on"} =["na"];
|
---|
6482 | $$d{"future"} =["za"];
|
---|
6483 | $$d{"past"} =["temu"];
|
---|
6484 | $$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
|
---|
6485 | "przyszly","przysz\x81\xb3y","przyszlym",
|
---|
6486 | "przysz\x81\xb3ym"];
|
---|
6487 | $$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
|
---|
6488 | $$d{"later"} =["later"];
|
---|
6489 |
|
---|
6490 | $$d{"exact"} =["doklandnie","dok\x81\xb3andnie"];
|
---|
6491 | $$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej",
|
---|
6492 | "mniej wi\x81\xeacej","okolo","oko\x81\xb3o"];
|
---|
6493 | $$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym",
|
---|
6494 | "s\x81\xb3u\x81\xbfbowym"];
|
---|
6495 |
|
---|
6496 | $$d{"times"} =["po\x81\xb3udnie","12:00:00",
|
---|
6497 | "p\x81\xf3\x81\xb3noc","00:00:00",
|
---|
6498 | "poludnie","12:00:00","polnoc","00:00:00"];
|
---|
6499 | $$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"];
|
---|
6500 |
|
---|
6501 | $$d{"years"} =["rok","lat","lata","latach"];
|
---|
6502 | $$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy",
|
---|
6503 | "miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"];
|
---|
6504 | $$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"];
|
---|
6505 | $$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"];
|
---|
6506 | $$d{"hours"} =["g.","godzina","godziny","godzinie"];
|
---|
6507 | $$d{"minutes"} =["mn.","min.","minut","minuty"];
|
---|
6508 | $$d{"seconds"} =["s.","sekund","sekundy"];
|
---|
6509 | $$d{"replace"} =["m.","miesiac"];
|
---|
6510 |
|
---|
6511 | $$d{"sephm"} =':';
|
---|
6512 | $$d{"sepms"} =':';
|
---|
6513 | $$d{"sepss"} ='[.:]';
|
---|
6514 |
|
---|
6515 | $$d{"am"} = ["AM","A.M."];
|
---|
6516 | $$d{"pm"} = ["PM","P.M."];
|
---|
6517 | }
|
---|
6518 |
|
---|
6519 | sub _Date_Init_Spanish {
|
---|
6520 | print "DEBUG: _Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6521 | my($d)=@_;
|
---|
6522 | my(%h)=();
|
---|
6523 | _Char_8Bit(\%h);
|
---|
6524 |
|
---|
6525 | $$d{"month_name"}=
|
---|
6526 | [["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
|
---|
6527 | "Septiembre","Octubre","Noviembre","Diciembre"]];
|
---|
6528 |
|
---|
6529 | $$d{"month_abb"}=
|
---|
6530 | [["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
|
---|
6531 | "Nov","Dic"]];
|
---|
6532 |
|
---|
6533 | $$d{"day_name"}=
|
---|
6534 | [["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
|
---|
6535 | $$d{"day_abb"}=
|
---|
6536 | [["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
|
---|
6537 | $$d{"day_char"}=
|
---|
6538 | [["L","Ma","Mi","J","V","S","D"]];
|
---|
6539 |
|
---|
6540 | $$d{"num_suff"}=
|
---|
6541 | [["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o",
|
---|
6542 | "11o","12o","13o","14o","15o","16o","17o","18o","19o","20o",
|
---|
6543 | "21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"],
|
---|
6544 | ["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a",
|
---|
6545 | "11a","12a","13a","14a","15a","16a","17a","18a","19a","20a",
|
---|
6546 | "21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]];
|
---|
6547 | $$d{"num_word"}=
|
---|
6548 | [["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo",
|
---|
6549 | "Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo",
|
---|
6550 | "Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto",
|
---|
6551 | "Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo",
|
---|
6552 | "Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero",
|
---|
6553 | "Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto",
|
---|
6554 | "Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo",
|
---|
6555 | "Trigesimo Primero"],
|
---|
6556 | ["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima",
|
---|
6557 | "Octava","Novena","Decima","Decimo Primera","Decimo Segunda",
|
---|
6558 | "Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta",
|
---|
6559 | "Decimo Septima","Decimo Octava","Decimo Novena","Vigesima",
|
---|
6560 | "Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera",
|
---|
6561 | "Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta",
|
---|
6562 | "Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima",
|
---|
6563 | "Trigesimo Primera"]];
|
---|
6564 |
|
---|
6565 | $$d{"now"} =["Ahora"];
|
---|
6566 | $$d{"today"} =["Hoy"];
|
---|
6567 | $$d{"last"} =["ultimo"];
|
---|
6568 | $$d{"each"} =["cada"];
|
---|
6569 | $$d{"of"} =["en","de"];
|
---|
6570 | $$d{"at"} =["a"];
|
---|
6571 | $$d{"on"} =["el"];
|
---|
6572 | $$d{"future"} =["en"];
|
---|
6573 | $$d{"past"} =["hace"];
|
---|
6574 | $$d{"next"} =["siguiente"];
|
---|
6575 | $$d{"prev"} =["anterior"];
|
---|
6576 | $$d{"later"} =["later"];
|
---|
6577 |
|
---|
6578 | $$d{"exact"} =["exactamente"];
|
---|
6579 | $$d{"approx"} =["aproximadamente"];
|
---|
6580 | $$d{"business"}=["laborales"];
|
---|
6581 |
|
---|
6582 | $$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"];
|
---|
6583 | $$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"];
|
---|
6584 |
|
---|
6585 | $$d{"years"} =["a","ano","ano","anos","anos"];
|
---|
6586 | $$d{"months"} =["m","mes","mes","meses"];
|
---|
6587 | $$d{"weeks"} =["sem","semana","semana","semanas"];
|
---|
6588 | $$d{"days"} =["d","dia","dias"];
|
---|
6589 | $$d{"hours"} =["hr","hrs","hora","horas"];
|
---|
6590 | $$d{"minutes"} =["min","min","minuto","minutos"];
|
---|
6591 | $$d{"seconds"} =["s","seg","segundo","segundos"];
|
---|
6592 | $$d{"replace"} =["m","mes"];
|
---|
6593 |
|
---|
6594 | $$d{"sephm"} =':';
|
---|
6595 | $$d{"sepms"} =':';
|
---|
6596 | $$d{"sepss"} ='[.:]';
|
---|
6597 |
|
---|
6598 | $$d{"am"} = ["AM","A.M."];
|
---|
6599 | $$d{"pm"} = ["PM","P.M."];
|
---|
6600 | }
|
---|
6601 |
|
---|
6602 | sub _Date_Init_Portuguese {
|
---|
6603 | print "DEBUG: _Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6604 | my($d)=@_;
|
---|
6605 | my(%h)=();
|
---|
6606 | _Char_8Bit(\%h);
|
---|
6607 | my($o) = $h{"-o"};
|
---|
6608 | my($c) = $h{",c"};
|
---|
6609 | my($a) = $h{"a'"};
|
---|
6610 | my($e) = $h{"e'"};
|
---|
6611 | my($u) = $h{"u'"};
|
---|
6612 | my($o2)= $h{"o'"};
|
---|
6613 | my($a2)= $h{"a`"};
|
---|
6614 | my($a3)= $h{"a~"};
|
---|
6615 | my($e2)= $h{"e^"};
|
---|
6616 |
|
---|
6617 | $$d{"month_name"}=
|
---|
6618 | [["Janeiro","Fevereiro","Marco","Abril","Maio","Junho",
|
---|
6619 | "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"],
|
---|
6620 | ["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho",
|
---|
6621 | "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]];
|
---|
6622 |
|
---|
6623 | $$d{"month_abb"}=
|
---|
6624 | [["Jan","Fev","Mar","Abr","Mai","Jun",
|
---|
6625 | "Jul","Ago","Set","Out","Nov","Dez"]];
|
---|
6626 |
|
---|
6627 | $$d{"day_name"}=
|
---|
6628 | [["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
|
---|
6629 | ["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
|
---|
6630 | $$d{"day_abb"}=
|
---|
6631 | [["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
|
---|
6632 | ["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
|
---|
6633 | $$d{"day_char"}=
|
---|
6634 | [["Sg","T","Qa","Qi","Sx","Sb","D"]];
|
---|
6635 |
|
---|
6636 | $$d{"num_suff"}=
|
---|
6637 | [["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}",
|
---|
6638 | "9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}",
|
---|
6639 | "16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}",
|
---|
6640 | "23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}",
|
---|
6641 | "30${o}","31${o}"]];
|
---|
6642 | $$d{"num_word"}=
|
---|
6643 | [["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo",
|
---|
6644 | "oitavo","nono","decimo","decimo primeiro","decimo segundo",
|
---|
6645 | "decimo terceiro","decimo quarto","decimo quinto","decimo sexto",
|
---|
6646 | "decimo setimo","decimo oitavo","decimo nono","vigesimo",
|
---|
6647 | "vigesimo primeiro","vigesimo segundo","vigesimo terceiro",
|
---|
6648 | "vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo",
|
---|
6649 | "vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"],
|
---|
6650 | ["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo",
|
---|
6651 | "oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo",
|
---|
6652 | "d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto",
|
---|
6653 | "d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo",
|
---|
6654 | "d${e}cimo nono","vig${e}simo","vig${e}simo primeiro",
|
---|
6655 | "vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto",
|
---|
6656 | "vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo",
|
---|
6657 | "vig${e}simo oitavo","vig${e}simo nono","trig${e}simo",
|
---|
6658 | "trig${e}simo primeiro"]];
|
---|
6659 |
|
---|
6660 | $$d{"now"} =["agora"];
|
---|
6661 | $$d{"today"} =["hoje"];
|
---|
6662 | $$d{"last"} =["${u}ltimo","ultimo"];
|
---|
6663 | $$d{"each"} =["cada"];
|
---|
6664 | $$d{"of"} =["da","do"];
|
---|
6665 | $$d{"at"} =["as","${a2}s"];
|
---|
6666 | $$d{"on"} =["na","no"];
|
---|
6667 | $$d{"future"} =["em"];
|
---|
6668 | $$d{"past"} =["a","${a2}"];
|
---|
6669 | $$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"];
|
---|
6670 | $$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"];
|
---|
6671 | $$d{"later"} =["passadas","passados"];
|
---|
6672 |
|
---|
6673 | $$d{"exact"} =["exactamente"];
|
---|
6674 | $$d{"approx"} =["aproximadamente"];
|
---|
6675 | $$d{"business"}=["util","uteis"];
|
---|
6676 |
|
---|
6677 | $$d{"offset"} =["ontem","-0:0:0:1:0:0:0",
|
---|
6678 | "amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"];
|
---|
6679 | $$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"];
|
---|
6680 |
|
---|
6681 | $$d{"years"} =["anos","ano","ans","an","a"];
|
---|
6682 | $$d{"months"} =["meses","m${e2}s","mes","m"];
|
---|
6683 | $$d{"weeks"} =["semanas","semana","sem","sems","s"];
|
---|
6684 | $$d{"days"} =["dias","dia","d"];
|
---|
6685 | $$d{"hours"} =["horas","hora","hr","hrs"];
|
---|
6686 | $$d{"minutes"} =["minutos","minuto","min","mn"];
|
---|
6687 | $$d{"seconds"} =["segundos","segundo","seg","sg"];
|
---|
6688 | $$d{"replace"} =["m","mes","s","sems"];
|
---|
6689 |
|
---|
6690 | $$d{"sephm"} =':';
|
---|
6691 | $$d{"sepms"} =':';
|
---|
6692 | $$d{"sepss"} ='[,]';
|
---|
6693 |
|
---|
6694 | $$d{"am"} = ["AM","A.M."];
|
---|
6695 | $$d{"pm"} = ["PM","P.M."];
|
---|
6696 | }
|
---|
6697 |
|
---|
6698 | sub _Date_Init_Russian {
|
---|
6699 | print "DEBUG: _Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6700 | my($d)=@_;
|
---|
6701 | my(%h)=();
|
---|
6702 | _Char_8Bit(\%h);
|
---|
6703 | my($a) =$h{"a:"};
|
---|
6704 |
|
---|
6705 | $$d{"month_name"}=
|
---|
6706 | [
|
---|
6707 | ["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1",
|
---|
6708 | "\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1",
|
---|
6709 | "\xc9\xc0\xce\xd1",
|
---|
6710 | "\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1",
|
---|
6711 | "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1",
|
---|
6712 | "\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"],
|
---|
6713 | ["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8",
|
---|
6714 | "\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca",
|
---|
6715 | "\xc9\xc0\xce\xd8",
|
---|
6716 | "\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4",
|
---|
6717 | "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8",
|
---|
6718 | "\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"]
|
---|
6719 | ];
|
---|
6720 |
|
---|
6721 | $$d{"month_abb"}=
|
---|
6722 | [["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2",
|
---|
6723 | "\xcd\xc1\xca","\xc9\xc0\xce",
|
---|
6724 | "\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4",
|
---|
6725 | "\xce\xcf\xd1\xc2","\xc4\xc5\xcb"],
|
---|
6726 | ["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","",
|
---|
6727 | "","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]];
|
---|
6728 |
|
---|
6729 | $$d{"day_name"}=
|
---|
6730 | [["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb",
|
---|
6731 | "\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1",
|
---|
6732 | "\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1",
|
---|
6733 | "\xd3\xd5\xc2\xc2\xcf\xd4\xc1",
|
---|
6734 | "\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]];
|
---|
6735 | $$d{"day_abb"}=
|
---|
6736 | [["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7",
|
---|
6737 | "\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"],
|
---|
6738 | ["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4",
|
---|
6739 | "\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]];
|
---|
6740 | $$d{"day_char"}=
|
---|
6741 | [["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
|
---|
6742 | "\xd7\xd3"]];
|
---|
6743 |
|
---|
6744 | $$d{"num_suff"}=
|
---|
6745 | [["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ",
|
---|
6746 | "11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ",
|
---|
6747 | "21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ",
|
---|
6748 | "31 "]];
|
---|
6749 | $$d{"num_word"}=
|
---|
6750 | [["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca",
|
---|
6751 | "\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
|
---|
6752 | "\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca",
|
---|
6753 | "\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca",
|
---|
6754 | "\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca",
|
---|
6755 | "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6756 | "\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca",
|
---|
6757 | "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6758 | "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6759 | "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6760 | "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6761 | "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6762 | "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6763 | "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6764 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6765 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca",
|
---|
6766 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca",
|
---|
6767 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca",
|
---|
6768 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
|
---|
6769 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca",
|
---|
6770 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca",
|
---|
6771 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca",
|
---|
6772 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca",
|
---|
6773 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca",
|
---|
6774 | "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca",
|
---|
6775 | "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"],
|
---|
6776 |
|
---|
6777 | ["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5",
|
---|
6778 | "\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
|
---|
6779 | "\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5",
|
---|
6780 | "\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5",
|
---|
6781 | "\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5",
|
---|
6782 | "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6783 | "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6784 | "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6785 | "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6786 | "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6787 | "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6788 | "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6789 | "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6790 | "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6791 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6792 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5",
|
---|
6793 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
|
---|
6794 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5",
|
---|
6795 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
|
---|
6796 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5",
|
---|
6797 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5",
|
---|
6798 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5",
|
---|
6799 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5",
|
---|
6800 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5",
|
---|
6801 | "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5",
|
---|
6802 | "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"],
|
---|
6803 |
|
---|
6804 | ["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf",
|
---|
6805 | "\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
|
---|
6806 | "\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf",
|
---|
6807 | "\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
|
---|
6808 | "\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
|
---|
6809 | "\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf",
|
---|
6810 | "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6811 | "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6812 | "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6813 | "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6814 | "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6815 | "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6816 | "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6817 | "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6818 | "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6819 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6820 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf",
|
---|
6821 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
|
---|
6822 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
|
---|
6823 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf",
|
---|
6824 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf",
|
---|
6825 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf",
|
---|
6826 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
|
---|
6827 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
|
---|
6828 | "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf",
|
---|
6829 | "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
---|
6830 | "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]];
|
---|
6831 |
|
---|
6832 | $$d{"now"} =["\xd3\xc5\xca\xde\xc1\xd3"];
|
---|
6833 | $$d{"today"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1"];
|
---|
6834 | $$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"];
|
---|
6835 | $$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"];
|
---|
6836 | $$d{"of"} =[" "];
|
---|
6837 | $$d{"at"} =["\xd7"];
|
---|
6838 | $$d{"on"} =["\xd7"];
|
---|
6839 | $$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"];
|
---|
6840 | $$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "];
|
---|
6841 | $$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"];
|
---|
6842 | $$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"];
|
---|
6843 | $$d{"later"} =["\xd0\xcf\xda\xd6\xc5"];
|
---|
6844 |
|
---|
6845 | $$d{"exact"} =["\xd4\xcf\xde\xce\xcf"];
|
---|
6846 | $$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"];
|
---|
6847 | $$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"];
|
---|
6848 |
|
---|
6849 | $$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0",
|
---|
6850 | "\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0",
|
---|
6851 | "\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0",
|
---|
6852 | "\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1",
|
---|
6853 | "+0:0:0:2:0:0:0"];
|
---|
6854 | $$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00",
|
---|
6855 | "\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"];
|
---|
6856 |
|
---|
6857 | $$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4",
|
---|
6858 | "\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"];
|
---|
6859 | $$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3",
|
---|
6860 | "\xcd\xc5\xd3\xd1\xc3\xc5\xd7"];
|
---|
6861 | $$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8",
|
---|
6862 | "\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"];
|
---|
6863 | $$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca",
|
---|
6864 | "\xc4\xce\xd1"];
|
---|
6865 | $$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3",
|
---|
6866 | "\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"];
|
---|
6867 | $$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1",
|
---|
6868 | "\xcd\xc9\xce\xd5\xd4"];
|
---|
6869 | $$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
|
---|
6870 | "\xd3\xc5\xcb\xd5\xce\xc4"];
|
---|
6871 | $$d{"replace"} =[];
|
---|
6872 |
|
---|
6873 | $$d{"sephm"} ="[:\xde]";
|
---|
6874 | $$d{"sepms"} ="[:\xcd]";
|
---|
6875 | $$d{"sepss"} ="[:.\xd3]";
|
---|
6876 |
|
---|
6877 | $$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
|
---|
6878 | "\xd5\xd4\xd2\xc1",
|
---|
6879 | "\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"];
|
---|
6880 | $$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1",
|
---|
6881 | "\xd7\xc5\xde\xc5\xd2\xc1",
|
---|
6882 | "\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1",
|
---|
6883 | "\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"];
|
---|
6884 | }
|
---|
6885 |
|
---|
6886 | sub _Date_Init_Turkish {
|
---|
6887 | print "DEBUG: _Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6888 | my($d)=@_;
|
---|
6889 |
|
---|
6890 | $$d{"month_name"}=
|
---|
6891 | [
|
---|
6892 | ["ocak","subat","mart","nisan","mayis","haziran",
|
---|
6893 | "temmuz","agustos","eylul","ekim","kasim","aralik"],
|
---|
6894 | ["ocak","\xfeubat","mart","nisan","may\xfds","haziran",
|
---|
6895 | "temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"]
|
---|
6896 | ];
|
---|
6897 |
|
---|
6898 | $$d{"month_abb"}=
|
---|
6899 | [
|
---|
6900 | ["oca","sub","mar","nis","may","haz",
|
---|
6901 | "tem","agu","eyl","eki","kas","ara"],
|
---|
6902 | ["oca","\xfeub","mar","nis","may","haz",
|
---|
6903 | "tem","a\xf0u","eyl","eki","kas","ara"]
|
---|
6904 | ];
|
---|
6905 |
|
---|
6906 | $$d{"day_name"}=
|
---|
6907 | [
|
---|
6908 | ["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
|
---|
6909 | ["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
|
---|
6910 | "cumartesi","pazar"],
|
---|
6911 | ];
|
---|
6912 |
|
---|
6913 | $$d{"day_abb"}=
|
---|
6914 | [
|
---|
6915 | ["pzt","sal","car","per","cum","cts","paz"],
|
---|
6916 | ["pzt","sal","\xe7ar","per","cum","cts","paz"],
|
---|
6917 | ];
|
---|
6918 |
|
---|
6919 | $$d{"day_char"}=
|
---|
6920 | [["Pt","S","Cr","Pr","C","Ct","P"],
|
---|
6921 | ["Pt","S","\xc7","Pr","C","Ct","P"]];
|
---|
6922 |
|
---|
6923 | $$d{"num_suff"}=
|
---|
6924 | [[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.",
|
---|
6925 | "11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.",
|
---|
6926 | "21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.",
|
---|
6927 | "31."]];
|
---|
6928 |
|
---|
6929 | $$d{"num_word"}=
|
---|
6930 | [
|
---|
6931 | ["birinci","ikinci","ucuncu","dorduncu",
|
---|
6932 | "besinci","altinci","yedinci","sekizinci",
|
---|
6933 | "dokuzuncu","onuncu","onbirinci","onikinci",
|
---|
6934 | "onucuncu","ondordoncu",
|
---|
6935 | "onbesinci","onaltinci","onyedinci","onsekizinci",
|
---|
6936 | "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
|
---|
6937 | "yirmiucuncu","yirmidorduncu",
|
---|
6938 | "yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci",
|
---|
6939 | "yirmidokuzuncu","otuzuncu","otuzbirinci"],
|
---|
6940 | ["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc",
|
---|
6941 | "be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci",
|
---|
6942 | "dokuzuncu","onuncu","onbirinci","onikinci",
|
---|
6943 | "on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc",
|
---|
6944 | "onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci",
|
---|
6945 | "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
|
---|
6946 | "yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc",
|
---|
6947 | "yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci",
|
---|
6948 | "yirmidokuzuncu","otuzuncu","otuzbirinci"]
|
---|
6949 | ];
|
---|
6950 |
|
---|
6951 | $$d{"now"} =["\xfeimdi", "simdi"];
|
---|
6952 | $$d{"today"} =["bugun", "bug\xfcn"];
|
---|
6953 | $$d{"last"} =["son", "sonuncu"];
|
---|
6954 | $$d{"each"} =["her"];
|
---|
6955 | $$d{"of"} =["of"];
|
---|
6956 | $$d{"at"} =["saat"];
|
---|
6957 | $$d{"on"} =["on"];
|
---|
6958 | $$d{"future"} =["gelecek"];
|
---|
6959 | $$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
|
---|
6960 | $$d{"next"} =["gelecek","sonraki"];
|
---|
6961 | $$d{"prev"} =["onceki","\xf6nceki"];
|
---|
6962 | $$d{"later"} =["sonra"];
|
---|
6963 |
|
---|
6964 | $$d{"exact"} =["tam"];
|
---|
6965 | $$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"];
|
---|
6966 | $$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"];
|
---|
6967 |
|
---|
6968 | $$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0",
|
---|
6969 | "dun", "-0:0:0:1:0:0:0",
|
---|
6970 | "yar\xfdn","+0:0:0:1:0:0:0",
|
---|
6971 | "yarin","+0:0:0:1:0:0:0"];
|
---|
6972 |
|
---|
6973 | $$d{"times"} =["\xf6\xf0len","12:00:00",
|
---|
6974 | "oglen","12:00:00",
|
---|
6975 | "yarim","12:300:00",
|
---|
6976 | "yar\xfdm","12:30:00",
|
---|
6977 | "gece yar\xfds\xfd","00:00:00",
|
---|
6978 | "gece yarisi","00:00:00"];
|
---|
6979 |
|
---|
6980 | $$d{"years"} =["yil","y"];
|
---|
6981 | $$d{"months"} =["ay","a"];
|
---|
6982 | $$d{"weeks"} =["hafta", "h"];
|
---|
6983 | $$d{"days"} =["gun","g"];
|
---|
6984 | $$d{"hours"} =["saat"];
|
---|
6985 | $$d{"minutes"} =["dakika","dak","d"];
|
---|
6986 | $$d{"seconds"} =["saniye","sn",];
|
---|
6987 | $$d{"replace"} =["s","saat"];
|
---|
6988 |
|
---|
6989 | $$d{"sephm"} =':';
|
---|
6990 | $$d{"sepms"} =':';
|
---|
6991 | $$d{"sepss"} ='[.:,]';
|
---|
6992 |
|
---|
6993 | $$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
|
---|
6994 | $$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
|
---|
6995 | }
|
---|
6996 |
|
---|
6997 | sub _Date_Init_Danish {
|
---|
6998 | print "DEBUG: _Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
6999 | my($d)=@_;
|
---|
7000 |
|
---|
7001 | $$d{"month_name"}=
|
---|
7002 | [["Januar","Februar","Marts","April","Maj","Juni",
|
---|
7003 | "Juli","August","September","Oktober","November","December"]];
|
---|
7004 | $$d{"month_abb"}=
|
---|
7005 | [["Jan","Feb","Mar","Apr","Maj","Jun",
|
---|
7006 | "Jul","Aug","Sep","Okt","Nov","Dec"]];
|
---|
7007 |
|
---|
7008 | $$d{"day_name"}=
|
---|
7009 | [["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
|
---|
7010 | ["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
|
---|
7011 |
|
---|
7012 | $$d{"day_abb"}=
|
---|
7013 | [["Man","Tir","Ons","Tor","Fre","Lor","Son"],
|
---|
7014 | ["Man","Tir","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
|
---|
7015 | $$d{"day_char"}=
|
---|
7016 | [["M","Ti","O","To","F","L","S"]];
|
---|
7017 |
|
---|
7018 | $$d{"num_suff"}=
|
---|
7019 | [["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
|
---|
7020 | "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
|
---|
7021 | "21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
|
---|
7022 | "31:e"]];
|
---|
7023 | $$d{"num_word"}=
|
---|
7024 | [["forste","anden","tredie","fjerde","femte","sjette","syvende",
|
---|
7025 | "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
|
---|
7026 | "femtende","sekstende","syttende","attende","nittende","tyvende",
|
---|
7027 | "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
|
---|
7028 | "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
|
---|
7029 | "tredivte","enogtredivte"],
|
---|
7030 | ["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende",
|
---|
7031 | "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
|
---|
7032 | "femtende","sekstende","syttende","attende","nittende","tyvende",
|
---|
7033 | "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
|
---|
7034 | "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
|
---|
7035 | "tredivte","enogtredivte"]];
|
---|
7036 |
|
---|
7037 | $$d{"now"} =["nu"];
|
---|
7038 | $$d{"today"} =["idag"];
|
---|
7039 | $$d{"last"} =["forrige","sidste","nyeste"];
|
---|
7040 | $$d{"each"} =["hver"];
|
---|
7041 | $$d{"of"} =["om"];
|
---|
7042 | $$d{"at"} =["kl","kl.","klokken"];
|
---|
7043 | $$d{"on"} =["pa","p\xe5"];
|
---|
7044 | $$d{"future"} =["om"];
|
---|
7045 | $$d{"past"} =["siden"];
|
---|
7046 | $$d{"next"} =["nasta","n\xe6ste"];
|
---|
7047 | $$d{"prev"} =["forrige"];
|
---|
7048 | $$d{"later"} =["senere"];
|
---|
7049 |
|
---|
7050 | $$d{"exact"} =["pracist","pr\xe6cist"];
|
---|
7051 | $$d{"approx"} =["circa"];
|
---|
7052 | $$d{"business"}=["arbejdsdag","arbejdsdage"];
|
---|
7053 |
|
---|
7054 | $$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
|
---|
7055 | "imorgen","+0:0:0:1:0:0:0"];
|
---|
7056 | $$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00",
|
---|
7057 | "midnat","00:00:00"];
|
---|
7058 |
|
---|
7059 | $$d{"years"} =["ar","\xe5r"];
|
---|
7060 | $$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"];
|
---|
7061 | $$d{"weeks"} =["u","uge","uger"];
|
---|
7062 | $$d{"days"} =["d","dag","dage"];
|
---|
7063 | $$d{"hours"} =["t","tim","time","timer"];
|
---|
7064 | $$d{"minutes"} =["min","minut","minutter"];
|
---|
7065 | $$d{"seconds"} =["s","sek","sekund","sekunder"];
|
---|
7066 | $$d{"replace"} =["m","minut"];
|
---|
7067 |
|
---|
7068 | $$d{"sephm"} ='[.:]';
|
---|
7069 | $$d{"sepms"} =':';
|
---|
7070 | $$d{"sepss"} ='[.:]';
|
---|
7071 |
|
---|
7072 | $$d{"am"} = ["FM"];
|
---|
7073 | $$d{"pm"} = ["EM"];
|
---|
7074 | }
|
---|
7075 |
|
---|
7076 | sub _Date_Init_Catalan {
|
---|
7077 | print "DEBUG: _Date_Init_Catalan\n" if ($Curr{"Debug"} =~ /trace/);
|
---|
7078 | my($d)=@_;
|
---|
7079 |
|
---|
7080 | $$d{"month_name"}=
|
---|
7081 | [["Gener","Febrer","Marc","Abril","Maig","Juny",
|
---|
7082 | "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
|
---|
7083 | ["Gener","Febrer","Març","Abril","Maig","Juny",
|
---|
7084 | "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
|
---|
7085 | ["Gener","Febrer","Marc,","Abril","Maig","Juny",
|
---|
7086 | "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"]];
|
---|
7087 |
|
---|
7088 | $$d{"month_abb"}=
|
---|
7089 | [["Gen","Feb","Mar","Abr","Mai","Jun",
|
---|
7090 | "Jul","Ago","Set","Oct","Nov","Des"],
|
---|
7091 | [],
|
---|
7092 | ["","","","","","",
|
---|
7093 | "","","","","","Dec"] #common mistake
|
---|
7094 | ];
|
---|
7095 |
|
---|
7096 | $$d{"day_name"}=
|
---|
7097 | [["Dilluns","Dimarts","Dimecres","Dijous","Divendres","Dissabte","Diumenge"]];
|
---|
7098 | $$d{"day_abb"}=
|
---|
7099 | [["Dll","Dmt","Dmc","Dij","Div","Dis","Diu"],
|
---|
7100 | ["","Dim","","","","",""],
|
---|
7101 | ["","","Dic","","","",""]
|
---|
7102 | ];
|
---|
7103 | $$d{"day_char"}=
|
---|
7104 | [["Dl","Dm","Dc","Dj","Dv","Ds","Du"] ,
|
---|
7105 | ["L","M","X","J","V","S","U"]];
|
---|
7106 |
|
---|
7107 | $$d{"num_suff"}=
|
---|
7108 | [["1er","2n","3r","4t","5e","6e","7e","8e","9e","10e",
|
---|
7109 | "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
|
---|
7110 | "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
|
---|
7111 | "31e"],
|
---|
7112 | ["1er","2n","3r","4t","5è","6è","7è","8è","9è","10è",
|
---|
7113 | "11è","12è","13è","14è","15è","16è","17è","18è","19è","20è",
|
---|
7114 | "21è","22è","23è","24è","25è","26è","27è","28è","29è","30è",
|
---|
7115 | "31è"]];
|
---|
7116 | $$d{"num_word"}=
|
---|
7117 | [["primer","segon","tercer","quart","cinque","sise","sete","vuite",
|
---|
7118 | "nove","dese","onze","dotze","tretze","catorze",
|
---|
7119 | "quinze","setze","dissete","divuite","dinove",
|
---|
7120 | "vinte","vint-i-une","vint-i-dose","vint-i-trese",
|
---|
7121 | "vint-i-quatre","vint-i-cinque","vint-i-sise","vint-i-sete",
|
---|
7122 | "vint-i-vuite","vint-i-nove","trente","trenta-une"],
|
---|
7123 | ["primer","segon","tercer","quart","cinquè","sisè","setè","vuitè",
|
---|
7124 | "novè","desè","onzè","dotzè","tretzè","catorzè",
|
---|
7125 | "quinzè","setzè","dissetè","divuitè","dinovè",
|
---|
7126 | "vintè","vint-i-unè","vint-i-dosè","vint-i-tresè",
|
---|
7127 | "vint-i-quatrè","vint-i-cinquè","vint-i-sisè","vint-i-setè",
|
---|
7128 | "vint-i-vuitè","vint-i-novè","trentè","trenta-unè"]];
|
---|
7129 |
|
---|
7130 | $$d{"now"} =["avui","ara"];
|
---|
7131 | $$d{"last"} =["darrer","últim","darrera","última"];
|
---|
7132 | $$d{"each"} =["cada","cadascun","cadascuna"];
|
---|
7133 | $$d{"of"} =["de","d'"];
|
---|
7134 | $$d{"at"} =["a les","a","al"];
|
---|
7135 | $$d{"on"} =["el"];
|
---|
7136 | $$d{"future"} =["d'aquí a"];
|
---|
7137 | $$d{"past"} =["fa"];
|
---|
7138 | $$d{"next"} =["proper"];
|
---|
7139 | $$d{"prev"} =["passat","proppassat","anterior"];
|
---|
7140 | $$d{"later"} =["més tard"];
|
---|
7141 |
|
---|
7142 | $$d{"exact"} =["exactament"];
|
---|
7143 | $$d{"approx"} =["approximadament"];
|
---|
7144 | $$d{"business"}=["empresa"];
|
---|
7145 |
|
---|
7146 | $$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",];
|
---|
7147 | $$d{"times"} =["migdia","12:00:00","mitjanit","00:00:00"];
|
---|
7148 |
|
---|
7149 | $$d{"years"} =["a","an","any","anys"];
|
---|
7150 | $$d{"months"} =["mes","me","ms"];
|
---|
7151 | $$d{"weeks"} =["se","set","setm","setmana","setmanes"];
|
---|
7152 | $$d{"days"} =["d","dia","dies"];
|
---|
7153 | $$d{"hours"} =["h","ho","hores","hora"];
|
---|
7154 | $$d{"minutes"} =["mn","min","minut","minuts"];
|
---|
7155 | $$d{"seconds"} =["s","seg","segon","segons"];
|
---|
7156 | $$d{"replace"} =["m","mes","s","setmana"];
|
---|
7157 |
|
---|
7158 | $$d{"sephm"} =':';
|
---|
7159 | $$d{"sepms"} =':';
|
---|
7160 | $$d{"sepss"} ='[.:]';
|
---|
7161 |
|
---|
7162 | $$d{"am"} = ["AM","A.M."];
|
---|
7163 | $$d{"pm"} = ["PM","P.M."];
|
---|
7164 | }
|
---|
7165 |
|
---|
7166 | ########################################################################
|
---|
7167 | # FROM MY PERSONAL LIBRARIES
|
---|
7168 | ########################################################################
|
---|
7169 |
|
---|
7170 | no integer;
|
---|
7171 |
|
---|
7172 | # _ModuloAddition($N,$add,\$val,\$rem);
|
---|
7173 | # This calculates $val=$val+$add and forces $val to be in a certain range.
|
---|
7174 | # This is useful for adding numbers for which only a certain range is
|
---|
7175 | # allowed (for example, minutes can be between 0 and 59 or months can be
|
---|
7176 | # between 1 and 12). The absolute value of $N determines the range and
|
---|
7177 | # the sign of $N determines whether the range is 0 to N-1 (if N>0) or
|
---|
7178 | # 1 to N (N<0). The remainder (as modulo N) is added to $rem.
|
---|
7179 | # Example:
|
---|
7180 | # To add 2 hours together (with the excess returned in days) use:
|
---|
7181 | # _ModuloAddition(60,$s1,\$s,\$day);
|
---|
7182 | sub _ModuloAddition {
|
---|
7183 | my($N,$add,$val,$rem)=@_;
|
---|
7184 | return if ($N==0);
|
---|
7185 | $$val+=$add;
|
---|
7186 | if ($N<0) {
|
---|
7187 | # 1 to N
|
---|
7188 | $N = -$N;
|
---|
7189 | if ($$val>$N) {
|
---|
7190 | $$rem+= int(($$val-1)/$N);
|
---|
7191 | $$val = ($$val-1)%$N +1;
|
---|
7192 | } elsif ($$val<1) {
|
---|
7193 | $$rem-= int(-$$val/$N)+1;
|
---|
7194 | $$val = $N-(-$$val % $N);
|
---|
7195 | }
|
---|
7196 |
|
---|
7197 | } else {
|
---|
7198 | # 0 to N-1
|
---|
7199 | if ($$val>($N-1)) {
|
---|
7200 | $$rem+= int($$val/$N);
|
---|
7201 | $$val = $$val%$N;
|
---|
7202 | } elsif ($$val<0) {
|
---|
7203 | $$rem-= int(-($$val+1)/$N)+1;
|
---|
7204 | $$val = ($N-1)-(-($$val+1)%$N);
|
---|
7205 | }
|
---|
7206 | }
|
---|
7207 | }
|
---|
7208 |
|
---|
7209 | # $Flag=_IsInt($String [,$low, $high]);
|
---|
7210 | # Returns 1 if $String is a valid integer, 0 otherwise. If $low is
|
---|
7211 | # entered, $String must be >= $low. If $high is entered, $String must
|
---|
7212 | # be <= $high. It is valid to check only one of the bounds.
|
---|
7213 | sub _IsInt {
|
---|
7214 | my($N,$low,$high)=@_;
|
---|
7215 | return 0 if (! defined $N or
|
---|
7216 | $N !~ /^\s*[-+]?\d+\s*$/ or
|
---|
7217 | defined $low && $N<$low or
|
---|
7218 | defined $high && $N>$high);
|
---|
7219 | return 1;
|
---|
7220 | }
|
---|
7221 |
|
---|
7222 | # $File=_CleanFile($file);
|
---|
7223 | # This cleans up a path to remove the following things:
|
---|
7224 | # double slash /a//b -> /a/b
|
---|
7225 | # trailing dot /a/. -> /a
|
---|
7226 | # leading dot ./a -> a
|
---|
7227 | # trailing slash a/ -> a
|
---|
7228 | sub _CleanFile {
|
---|
7229 | my($file)=@_;
|
---|
7230 | $file =~ s/\s*$//;
|
---|
7231 | $file =~ s/^\s*//;
|
---|
7232 | $file =~ s|//+|/|g; # multiple slash
|
---|
7233 | $file =~ s|/\.$|/|; # trailing /. (leaves trailing slash)
|
---|
7234 | $file =~ s|^\./|| # leading ./
|
---|
7235 | if ($file ne "./");
|
---|
7236 | $file =~ s|/$|| # trailing slash
|
---|
7237 | if ($file ne "/");
|
---|
7238 | return $file;
|
---|
7239 | }
|
---|
7240 |
|
---|
7241 | # $File=_ExpandTilde($file);
|
---|
7242 | # This checks to see if a "~" appears as the first character in a path.
|
---|
7243 | # If it does, the "~" expansion is interpreted (if possible) and the full
|
---|
7244 | # path is returned. If a "~" expansion is used but cannot be
|
---|
7245 | # interpreted, an empty string is returned.
|
---|
7246 | #
|
---|
7247 | # This is Windows/Mac friendly.
|
---|
7248 | # This is efficient.
|
---|
7249 | sub _ExpandTilde {
|
---|
7250 | my($file)=shift;
|
---|
7251 | my($user,$home)=();
|
---|
7252 | # ~aaa/bbb= ~ aaa /bbb
|
---|
7253 | if ($file =~ s|^~([^/]*)||) {
|
---|
7254 | $user=$1;
|
---|
7255 | # Single user operating systems (Mac, MSWindows) don't have the getpwnam
|
---|
7256 | # and getpwuid routines defined. Try to catch various different ways
|
---|
7257 | # of knowing we are on one of these systems:
|
---|
7258 | return "" if ($OS eq "Windows" or
|
---|
7259 | $OS eq "Mac" or
|
---|
7260 | $OS eq "Netware" or
|
---|
7261 | $OS eq "MPE");
|
---|
7262 | $user="" if (! defined $user);
|
---|
7263 |
|
---|
7264 | if ($user) {
|
---|
7265 | $home= (getpwnam($user))[7];
|
---|
7266 | } else {
|
---|
7267 | $home= (getpwuid($<))[7];
|
---|
7268 | }
|
---|
7269 | $home = VMS::Filespec::unixpath($home) if ($OS eq "VMS");
|
---|
7270 | return "" if (! $home);
|
---|
7271 | $file="$home/$file";
|
---|
7272 | }
|
---|
7273 | $file;
|
---|
7274 | }
|
---|
7275 |
|
---|
7276 | # $File=_FullFilePath($file);
|
---|
7277 | # Returns the full or relative path to $file (expanding "~" if necessary).
|
---|
7278 | # Returns an empty string if a "~" expansion cannot be interpreted. The
|
---|
7279 | # path does not need to exist. _CleanFile is called.
|
---|
7280 | sub _FullFilePath {
|
---|
7281 | my($file)=shift;
|
---|
7282 | my($rootpat) = '^/'; #default pattern to match absolute path
|
---|
7283 | $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
|
---|
7284 | $file=_ExpandTilde($file);
|
---|
7285 | return "" if (! $file);
|
---|
7286 | return _CleanFile($file);
|
---|
7287 | }
|
---|
7288 |
|
---|
7289 | # $Flag=_CheckFilePath($file [,$mode]);
|
---|
7290 | # Checks to see if $file exists, to see what type it is, and whether
|
---|
7291 | # the script can access it. If it exists and has the correct mode, 1
|
---|
7292 | # is returned.
|
---|
7293 | #
|
---|
7294 | # $mode is a string which may contain any of the valid file test operator
|
---|
7295 | # characters except t, M, A, C. The appropriate test is run for each
|
---|
7296 | # character. For example, if $mode is "re" the -r and -e tests are both
|
---|
7297 | # run.
|
---|
7298 | #
|
---|
7299 | # An empty string is returned if the file doesn't exist. A 0 is returned
|
---|
7300 | # if the file exists but any test fails.
|
---|
7301 | #
|
---|
7302 | # All characters in $mode which do not correspond to valid tests are
|
---|
7303 | # ignored.
|
---|
7304 | sub _CheckFilePath {
|
---|
7305 | my($file,$mode)=@_;
|
---|
7306 | my($test)=();
|
---|
7307 | $file=_FullFilePath($file);
|
---|
7308 | $mode = "" if (! defined $mode);
|
---|
7309 |
|
---|
7310 | # Run tests
|
---|
7311 | return 0 if (! defined $file or ! $file);
|
---|
7312 | return 0 if (( ! -e $file) or
|
---|
7313 | ($mode =~ /r/ && ! -r $file) or
|
---|
7314 | ($mode =~ /w/ && ! -w $file) or
|
---|
7315 | ($mode =~ /x/ && ! -x $file) or
|
---|
7316 | ($mode =~ /R/ && ! -R $file) or
|
---|
7317 | ($mode =~ /W/ && ! -W $file) or
|
---|
7318 | ($mode =~ /X/ && ! -X $file) or
|
---|
7319 | ($mode =~ /o/ && ! -o $file) or
|
---|
7320 | ($mode =~ /O/ && ! -O $file) or
|
---|
7321 | ($mode =~ /z/ && ! -z $file) or
|
---|
7322 | ($mode =~ /s/ && ! -s $file) or
|
---|
7323 | ($mode =~ /f/ && ! -f $file) or
|
---|
7324 | ($mode =~ /d/ && ! -d $file) or
|
---|
7325 | ($mode =~ /l/ && ! -l $file) or
|
---|
7326 | ($mode =~ /s/ && ! -s $file) or
|
---|
7327 | ($mode =~ /p/ && ! -p $file) or
|
---|
7328 | ($mode =~ /b/ && ! -b $file) or
|
---|
7329 | ($mode =~ /c/ && ! -c $file) or
|
---|
7330 | ($mode =~ /u/ && ! -u $file) or
|
---|
7331 | ($mode =~ /g/ && ! -g $file) or
|
---|
7332 | ($mode =~ /k/ && ! -k $file) or
|
---|
7333 | ($mode =~ /T/ && ! -T $file) or
|
---|
7334 | ($mode =~ /B/ && ! -B $file));
|
---|
7335 | return 1;
|
---|
7336 | }
|
---|
7337 | #&&
|
---|
7338 |
|
---|
7339 | # $Path=_FixPath($path [,$full] [,$mode] [,$error]);
|
---|
7340 | # Makes sure that every directory in $path (a colon separated list of
|
---|
7341 | # directories) appears as a full path or relative path. All "~"
|
---|
7342 | # expansions are removed. All trailing slashes are removed also. If
|
---|
7343 | # $full is non-nil, relative paths are expanded to full paths as well.
|
---|
7344 | #
|
---|
7345 | # If $mode is given, it may be either "e", "r", or "w". In this case,
|
---|
7346 | # additional checking is done to each directory. If $mode is "e", it
|
---|
7347 | # need ony exist to pass the check. If $mode is "r", it must have have
|
---|
7348 | # read and execute permission. If $mode is "w", it must have read,
|
---|
7349 | # write, and execute permission.
|
---|
7350 | #
|
---|
7351 | # The value of $error determines what happens if the directory does not
|
---|
7352 | # pass the test. If it is non-nil, if any directory does not pass the
|
---|
7353 | # test, the subroutine returns the empty string. Otherwise, it is simply
|
---|
7354 | # removed from $path.
|
---|
7355 | #
|
---|
7356 | # The corrected path is returned.
|
---|
7357 | sub _FixPath {
|
---|
7358 | my($path,$full,$mode,$err)=@_;
|
---|
7359 | local($_)="";
|
---|
7360 | my(@dir)=split(/$Cnf{"PathSep"}/,$path);
|
---|
7361 | $full=0 if (! defined $full);
|
---|
7362 | $mode="" if (! defined $mode);
|
---|
7363 | $err=0 if (! defined $err);
|
---|
7364 | $path="";
|
---|
7365 | if ($mode eq "e") {
|
---|
7366 | $mode="de";
|
---|
7367 | } elsif ($mode eq "r") {
|
---|
7368 | $mode="derx";
|
---|
7369 | } elsif ($mode eq "w") {
|
---|
7370 | $mode="derwx";
|
---|
7371 | }
|
---|
7372 |
|
---|
7373 | foreach (@dir) {
|
---|
7374 |
|
---|
7375 | # Expand path
|
---|
7376 | if ($full) {
|
---|
7377 | $_=_FullFilePath($_);
|
---|
7378 | } else {
|
---|
7379 | $_=_ExpandTilde($_);
|
---|
7380 | }
|
---|
7381 | if (! $_) {
|
---|
7382 | return "" if ($err);
|
---|
7383 | next;
|
---|
7384 | }
|
---|
7385 |
|
---|
7386 | # Check mode
|
---|
7387 | if (! $mode or _CheckFilePath($_,$mode)) {
|
---|
7388 | $path .= $Cnf{"PathSep"} . $_;
|
---|
7389 | } else {
|
---|
7390 | return "" if ($err);
|
---|
7391 | }
|
---|
7392 | }
|
---|
7393 | $path =~ s/^$Cnf{"PathSep"}//;
|
---|
7394 | return $path;
|
---|
7395 | }
|
---|
7396 | #&&
|
---|
7397 |
|
---|
7398 | # $File=_SearchPath($file,$path [,$mode] [,@suffixes]);
|
---|
7399 | # Searches through directories in $path for a file named $file. The
|
---|
7400 | # full path is returned if one is found, or an empty string otherwise.
|
---|
7401 | # The file may exist with one of the @suffixes. The mode is checked
|
---|
7402 | # similar to _CheckFilePath.
|
---|
7403 | #
|
---|
7404 | # The first full path that matches the name and mode is returned. If none
|
---|
7405 | # is found, an empty string is returned.
|
---|
7406 | sub _SearchPath {
|
---|
7407 | my($file,$path,$mode,@suff)=@_;
|
---|
7408 | my($f,$s,$d,@dir,$fs)=();
|
---|
7409 | $path=_FixPath($path,1,"r");
|
---|
7410 | @dir=split(/$Cnf{"PathSep"}/,$path);
|
---|
7411 | foreach $d (@dir) {
|
---|
7412 | $f="$d/$file";
|
---|
7413 | $f=~ s|//|/|g;
|
---|
7414 | return $f if (_CheckFilePath($f,$mode));
|
---|
7415 | foreach $s (@suff) {
|
---|
7416 | $fs="$f.$s";
|
---|
7417 | return $fs if (_CheckFilePath($fs,$mode));
|
---|
7418 | }
|
---|
7419 | }
|
---|
7420 | return "";
|
---|
7421 | }
|
---|
7422 |
|
---|
7423 | # @list=_ReturnList($str);
|
---|
7424 | # This takes a string which should be a comma separated list of integers
|
---|
7425 | # or ranges (5-7). It returns a sorted list of all integers referred to
|
---|
7426 | # by the string, or () if there is an invalid element.
|
---|
7427 | #
|
---|
7428 | # Negative integers are also handled. "-2--1" is equivalent to "-2,-1".
|
---|
7429 | sub _ReturnList {
|
---|
7430 | my($str)=@_;
|
---|
7431 | my(@ret,@str,$from,$to,$tmp)=();
|
---|
7432 | @str=split(/,/,$str);
|
---|
7433 | foreach $str (@str) {
|
---|
7434 | if ($str =~ /^[-+]?\d+$/) {
|
---|
7435 | push(@ret,$str);
|
---|
7436 | } elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {
|
---|
7437 | ($from,$to)=($1,$2);
|
---|
7438 | if ($from>$to) {
|
---|
7439 | $tmp=$from;
|
---|
7440 | $from=$to;
|
---|
7441 | $to=$tmp;
|
---|
7442 | }
|
---|
7443 | push(@ret,$from..$to);
|
---|
7444 | } else {
|
---|
7445 | return ();
|
---|
7446 | }
|
---|
7447 | }
|
---|
7448 | @ret;
|
---|
7449 | }
|
---|
7450 |
|
---|
7451 | 1;
|
---|
7452 | # Local Variables:
|
---|
7453 | # mode: cperl
|
---|
7454 | # indent-tabs-mode: nil
|
---|
7455 | # cperl-indent-level: 3
|
---|
7456 | # cperl-continued-statement-offset: 2
|
---|
7457 | # cperl-continued-brace-offset: 0
|
---|
7458 | # cperl-brace-offset: 0
|
---|
7459 | # cperl-brace-imaginary-offset: 0
|
---|
7460 | # cperl-label-offset: -2
|
---|
7461 | # End:
|
---|