|
1 package Date::Manip; |
|
2 # Copyright (c) 1995-2003 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 vars qw($OS %Lang %Holiday %Events %Curr %Cnf %Zone $VERSION @ISA @EXPORT); |
|
10 |
|
11 # Determine the type of OS... |
|
12 $OS="Unix"; |
|
13 $OS="Windows" if ((defined $^O and |
|
14 $^O =~ /MSWin32/i || |
|
15 $^O =~ /Windows_95/i || |
|
16 $^O =~ /Windows_NT/i) || |
|
17 (defined $ENV{OS} and |
|
18 $ENV{OS} =~ /MSWin32/i || |
|
19 $ENV{OS} =~ /Windows_95/i || |
|
20 $ENV{OS} =~ /Windows_NT/i)); |
|
21 $OS="Netware" if (defined $^O and |
|
22 $^O =~ /NetWare/i); |
|
23 $OS="Mac" if ((defined $^O and |
|
24 $^O =~ /MacOS/i) || |
|
25 (defined $ENV{OS} and |
|
26 $ENV{OS} =~ /MacOS/i)); |
|
27 $OS="MPE" if (defined $^O and |
|
28 $^O =~ /MPE/i); |
|
29 $OS="OS2" if (defined $^O and |
|
30 $^O =~ /os2/i); |
|
31 $OS="VMS" if (defined $^O and |
|
32 $^O =~ /VMS/i); |
|
33 |
|
34 # Determine if we're doing taint checking |
|
35 $Date::Manip::NoTaint = eval { local $^W; unlink "$^X$^T"; 1 }; |
|
36 |
|
37 ########################################################################### |
|
38 # CUSTOMIZATION |
|
39 ########################################################################### |
|
40 # |
|
41 # See the section of the POD documentation section CUSTOMIZING DATE::MANIP |
|
42 # below for a complete description of each of these variables. |
|
43 |
|
44 |
|
45 # Location of a the global config file. Tilde (~) expansions are allowed. |
|
46 # This should be set in Date_Init arguments. |
|
47 $Cnf{"GlobalCnf"}=""; |
|
48 $Cnf{"IgnoreGlobalCnf"}=""; |
|
49 |
|
50 # Name of a personal config file and the path to search for it. Tilde (~) |
|
51 # expansions are allowed. This should be set in Date_Init arguments or in |
|
52 # the global config file. |
|
53 |
|
54 @Date::Manip::DatePath=(); |
|
55 if ($OS eq "Windows") { |
|
56 $Cnf{"PathSep"} = ";"; |
|
57 $Cnf{"PersonalCnf"} = "Manip.cnf"; |
|
58 $Cnf{"PersonalCnfPath"} = "."; |
|
59 |
|
60 } elsif ($OS eq "Netware") { |
|
61 $Cnf{"PathSep"} = ";"; |
|
62 $Cnf{"PersonalCnf"} = "Manip.cnf"; |
|
63 $Cnf{"PersonalCnfPath"} = "."; |
|
64 |
|
65 } elsif ($OS eq "MPE") { |
|
66 $Cnf{"PathSep"} = ":"; |
|
67 $Cnf{"PersonalCnf"} = "Manip.cnf"; |
|
68 $Cnf{"PersonalCnfPath"} = "."; |
|
69 |
|
70 } elsif ($OS eq "OS2") { |
|
71 $Cnf{"PathSep"} = ":"; |
|
72 $Cnf{"PersonalCnf"} = "Manip.cnf"; |
|
73 $Cnf{"PersonalCnfPath"} = "."; |
|
74 |
|
75 } elsif ($OS eq "Mac") { |
|
76 $Cnf{"PathSep"} = ":"; |
|
77 $Cnf{"PersonalCnf"} = "Manip.cnf"; |
|
78 $Cnf{"PersonalCnfPath"} = "."; |
|
79 |
|
80 } elsif ($OS eq "VMS") { |
|
81 # VMS doesn't like files starting with "." |
|
82 $Cnf{"PathSep"} = "\n"; |
|
83 $Cnf{"PersonalCnf"} = "Manip.cnf"; |
|
84 $Cnf{"PersonalCnfPath"} = ".\n~"; |
|
85 |
|
86 } else { |
|
87 # Unix |
|
88 $Cnf{"PathSep"} = ":"; |
|
89 $Cnf{"PersonalCnf"} = ".DateManip.cnf"; |
|
90 $Cnf{"PersonalCnfPath"} = ".:~"; |
|
91 @Date::Manip::DatePath=qw(/bin /usr/bin /usr/local/bin); |
|
92 } |
|
93 |
|
94 ### Date::Manip variables set in the global or personal config file |
|
95 |
|
96 # Which language to use when parsing dates. |
|
97 $Cnf{"Language"}="English"; |
|
98 |
|
99 # 12/10 = Dec 10 (US) or Oct 12 (anything else) |
|
100 $Cnf{"DateFormat"}="US"; |
|
101 |
|
102 # Local timezone |
|
103 $Cnf{"TZ"}=""; |
|
104 |
|
105 # Timezone to work in (""=local, "IGNORE", or a timezone) |
|
106 $Cnf{"ConvTZ"}=""; |
|
107 |
|
108 # Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS) |
|
109 $Cnf{"Internal"}=0; |
|
110 |
|
111 # First day of the week (1=monday, 7=sunday). ISO 8601 says monday. |
|
112 $Cnf{"FirstDay"}=1; |
|
113 |
|
114 # First and last day of the work week (1=monday, 7=sunday) |
|
115 $Cnf{"WorkWeekBeg"}=1; |
|
116 $Cnf{"WorkWeekEnd"}=5; |
|
117 |
|
118 # If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd |
|
119 # ignored) |
|
120 $Cnf{"WorkDay24Hr"}=0; |
|
121 |
|
122 # Start and end time of the work day (any time format allowed, seconds |
|
123 # ignored) |
|
124 $Cnf{"WorkDayBeg"}="08:00"; |
|
125 $Cnf{"WorkDayEnd"}="17:00"; |
|
126 |
|
127 # If "today" is a holiday, we look either to "tomorrow" or "yesterday" for |
|
128 # the nearest business day. By default, we'll always look "tomorrow" |
|
129 # first. |
|
130 $Cnf{"TomorrowFirst"}=1; |
|
131 |
|
132 # Erase the old holidays |
|
133 $Cnf{"EraseHolidays"}=""; |
|
134 |
|
135 # Set this to non-zero to be produce completely backwards compatible deltas |
|
136 $Cnf{"DeltaSigns"}=0; |
|
137 |
|
138 # If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1, |
|
139 # make week 1 contain Jan 1. |
|
140 $Cnf{"Jan1Week1"}=0; |
|
141 |
|
142 # 2 digit years fall into the 100 year period given by [ CURR-N, |
|
143 # CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful |
|
144 # numbers might be 0 (forced to be this year or later) and 99 (forced to be |
|
145 # this year or earlier). It can also be set to "c" (current century) or |
|
146 # "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the |
|
147 # form cNNNN to give the 100 year period NNNN to NNNN+99. |
|
148 $Cnf{"YYtoYYYY"}=89; |
|
149 |
|
150 # Set this to 1 if you want a long-running script to always update the |
|
151 # timezone. This will slow Date::Manip down. Read the POD documentation. |
|
152 $Cnf{"UpdateCurrTZ"}=0; |
|
153 |
|
154 # Use an international character set. |
|
155 $Cnf{"IntCharSet"}=0; |
|
156 |
|
157 # Use this to force the current date to be set to this: |
|
158 $Cnf{"ForceDate"}=""; |
|
159 |
|
160 ########################################################################### |
|
161 |
|
162 require 5.000; |
|
163 require Exporter; |
|
164 @ISA = qw(Exporter); |
|
165 @EXPORT = qw( |
|
166 DateManipVersion |
|
167 Date_Init |
|
168 ParseDateString |
|
169 ParseDate |
|
170 ParseRecur |
|
171 Date_Cmp |
|
172 DateCalc |
|
173 ParseDateDelta |
|
174 UnixDate |
|
175 Delta_Format |
|
176 Date_GetPrev |
|
177 Date_GetNext |
|
178 Date_SetTime |
|
179 Date_SetDateField |
|
180 Date_IsHoliday |
|
181 Events_List |
|
182 |
|
183 Date_DaysInMonth |
|
184 Date_DayOfWeek |
|
185 Date_SecsSince1970 |
|
186 Date_SecsSince1970GMT |
|
187 Date_DaysSince1BC |
|
188 Date_DayOfYear |
|
189 Date_DaysInYear |
|
190 Date_WeekOfYear |
|
191 Date_LeapYear |
|
192 Date_DaySuffix |
|
193 Date_ConvTZ |
|
194 Date_TimeZone |
|
195 Date_IsWorkDay |
|
196 Date_NextWorkDay |
|
197 Date_PrevWorkDay |
|
198 Date_NearestWorkDay |
|
199 Date_NthDayOfYear |
|
200 ); |
|
201 use strict; |
|
202 use integer; |
|
203 use Carp; |
|
204 |
|
205 use IO::File; |
|
206 |
|
207 $VERSION="5.42"; |
|
208 |
|
209 ######################################################################## |
|
210 ######################################################################## |
|
211 |
|
212 $Curr{"InitLang"} = 1; # Whether a language is being init'ed |
|
213 $Curr{"InitDone"} = 0; # Whether Init_Date has been called |
|
214 $Curr{"InitFilesRead"} = 0; |
|
215 $Curr{"ResetWorkDay"} = 1; |
|
216 $Curr{"Debug"} = ""; |
|
217 $Curr{"DebugVal"} = ""; |
|
218 |
|
219 $Holiday{"year"} = 0; |
|
220 $Holiday{"dates"} = {}; |
|
221 $Holiday{"desc"} = {}; |
|
222 |
|
223 $Events{"raw"} = []; |
|
224 $Events{"parsed"} = 0; |
|
225 $Events{"dates"} = []; |
|
226 $Events{"recur"} = []; |
|
227 |
|
228 ######################################################################## |
|
229 ######################################################################## |
|
230 # THESE ARE THE MAIN ROUTINES |
|
231 ######################################################################## |
|
232 ######################################################################## |
|
233 |
|
234 # Get rid of a problem with old versions of perl |
|
235 no strict "vars"; |
|
236 # This sorts from longest to shortest element |
|
237 sub sortByLength { |
|
238 return (length $b <=> length $a); |
|
239 } |
|
240 use strict "vars"; |
|
241 |
|
242 sub DateManipVersion { |
|
243 print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/); |
|
244 return $VERSION; |
|
245 } |
|
246 |
|
247 sub Date_Init { |
|
248 print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/); |
|
249 $Curr{"Debug"}=""; |
|
250 |
|
251 my(@args)=@_; |
|
252 $Curr{"InitDone"}=1; |
|
253 local($_)=(); |
|
254 my($internal,$firstday)=(); |
|
255 my($var,$val,$file,@tmp)=(); |
|
256 |
|
257 # InitFilesRead = 0 : no conf files read yet |
|
258 # 1 : global read, no personal read |
|
259 # 2 : personal read |
|
260 |
|
261 $Cnf{"EraseHolidays"}=0; |
|
262 foreach (@args) { |
|
263 s/\s*$//; |
|
264 s/^\s*//; |
|
265 /^(\S+) \s* = \s* (.+)$/x; |
|
266 ($var,$val)=($1,$2); |
|
267 if ($var =~ /^GlobalCnf$/i) { |
|
268 $Cnf{"GlobalCnf"}=$val; |
|
269 if ($val) { |
|
270 $Curr{"InitFilesRead"}=0; |
|
271 &EraseHolidays(); |
|
272 } |
|
273 } elsif ($var =~ /^PathSep$/i) { |
|
274 $Cnf{"PathSep"}=$val; |
|
275 } elsif ($var =~ /^PersonalCnf$/i) { |
|
276 $Cnf{"PersonalCnf"}=$val; |
|
277 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2); |
|
278 } elsif ($var =~ /^PersonalCnfPath$/i) { |
|
279 $Cnf{"PersonalCnfPath"}=$val; |
|
280 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2); |
|
281 } elsif ($var =~ /^IgnoreGlobalCnf$/i) { |
|
282 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0); |
|
283 $Cnf{"IgnoreGlobalCnf"}=1; |
|
284 } elsif ($var =~ /^EraseHolidays$/i) { |
|
285 &EraseHolidays(); |
|
286 } else { |
|
287 push(@tmp,$_); |
|
288 } |
|
289 } |
|
290 @args=@tmp; |
|
291 |
|
292 # Read global config file |
|
293 if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) { |
|
294 $Curr{"InitFilesRead"}=1; |
|
295 |
|
296 if ($Cnf{"GlobalCnf"}) { |
|
297 $file=&ExpandTilde($Cnf{"GlobalCnf"}); |
|
298 &Date_InitFile($file) if ($file); |
|
299 } |
|
300 } |
|
301 |
|
302 # Read personal config file |
|
303 if ($Curr{"InitFilesRead"}<2) { |
|
304 $Curr{"InitFilesRead"}=2; |
|
305 |
|
306 if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) { |
|
307 $file=&SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r"); |
|
308 &Date_InitFile($file) if ($file); |
|
309 } |
|
310 } |
|
311 |
|
312 foreach (@args) { |
|
313 s/\s*$//; |
|
314 s/^\s*//; |
|
315 /^(\S+) \s* = \s* (.*)$/x; |
|
316 ($var,$val)=($1,$2); |
|
317 $val="" if (! defined $val); |
|
318 &Date_SetConfigVariable($var,$val); |
|
319 } |
|
320 |
|
321 confess "ERROR: Unknown FirstDay in Date::Manip.\n" |
|
322 if (! &IsInt($Cnf{"FirstDay"},1,7)); |
|
323 confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n" |
|
324 if (! &IsInt($Cnf{"WorkWeekBeg"},1,7)); |
|
325 confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n" |
|
326 if (! &IsInt($Cnf{"WorkWeekEnd"},1,7)); |
|
327 confess "ERROR: Invalid WorkWeek in Date::Manip.\n" |
|
328 if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"}); |
|
329 |
|
330 my(%lang, |
|
331 $tmp,%tmp,$tmp2,@tmp2, |
|
332 $i,$j,@tmp3, |
|
333 $zonesrfc,@zones)=(); |
|
334 |
|
335 my($L)=$Cnf{"Language"}; |
|
336 |
|
337 if ($Curr{"InitLang"}) { |
|
338 $Curr{"InitLang"}=0; |
|
339 |
|
340 if ($L eq "English") { |
|
341 &Date_Init_English(\%lang); |
|
342 |
|
343 } elsif ($L eq "French") { |
|
344 &Date_Init_French(\%lang); |
|
345 |
|
346 } elsif ($L eq "Swedish") { |
|
347 &Date_Init_Swedish(\%lang); |
|
348 |
|
349 } elsif ($L eq "German") { |
|
350 &Date_Init_German(\%lang); |
|
351 |
|
352 } elsif ($L eq "Polish") { |
|
353 &Date_Init_Polish(\%lang); |
|
354 |
|
355 } elsif ($L eq "Dutch" || |
|
356 $L eq "Nederlands") { |
|
357 &Date_Init_Dutch(\%lang); |
|
358 |
|
359 } elsif ($L eq "Spanish") { |
|
360 &Date_Init_Spanish(\%lang); |
|
361 |
|
362 } elsif ($L eq "Portuguese") { |
|
363 &Date_Init_Portuguese(\%lang); |
|
364 |
|
365 } elsif ($L eq "Romanian") { |
|
366 &Date_Init_Romanian(\%lang); |
|
367 |
|
368 } elsif ($L eq "Italian") { |
|
369 &Date_Init_Italian(\%lang); |
|
370 |
|
371 } elsif ($L eq "Russian") { |
|
372 &Date_Init_Russian(\%lang); |
|
373 |
|
374 } elsif ($L eq "Turkish") { |
|
375 &Date_Init_Turkish(\%lang); |
|
376 |
|
377 } elsif ($L eq "Danish") { |
|
378 &Date_Init_Danish(\%lang); |
|
379 |
|
380 } else { |
|
381 confess "ERROR: Unknown language in Date::Manip.\n"; |
|
382 } |
|
383 |
|
384 # variables for months |
|
385 # Month = "(jan|january|feb|february ... )" |
|
386 # MonL = [ "Jan","Feb",... ] |
|
387 # MonthL = [ "January","February", ... ] |
|
388 # MonthH = { "january"=>1, "jan"=>1, ... } |
|
389 |
|
390 $Lang{$L}{"MonthH"}={}; |
|
391 $Lang{$L}{"MonthL"}=[]; |
|
392 $Lang{$L}{"MonL"}=[]; |
|
393 &Date_InitLists([$lang{"month_name"}, |
|
394 $lang{"month_abb"}], |
|
395 \$Lang{$L}{"Month"},"lc,sort,back", |
|
396 [$Lang{$L}{"MonthL"}, |
|
397 $Lang{$L}{"MonL"}], |
|
398 [$Lang{$L}{"MonthH"},1]); |
|
399 |
|
400 # variables for day of week |
|
401 # Week = "(mon|monday|tue|tuesday ... )" |
|
402 # WL = [ "M","T",... ] |
|
403 # WkL = [ "Mon","Tue",... ] |
|
404 # WeekL = [ "Monday","Tudesday",... ] |
|
405 # WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... } |
|
406 |
|
407 $Lang{$L}{"WeekH"}={}; |
|
408 $Lang{$L}{"WeekL"}=[]; |
|
409 $Lang{$L}{"WkL"}=[]; |
|
410 $Lang{$L}{"WL"}=[]; |
|
411 &Date_InitLists([$lang{"day_name"}, |
|
412 $lang{"day_abb"}], |
|
413 \$Lang{$L}{"Week"},"lc,sort,back", |
|
414 [$Lang{$L}{"WeekL"}, |
|
415 $Lang{$L}{"WkL"}], |
|
416 [$Lang{$L}{"WeekH"},1]); |
|
417 &Date_InitLists([$lang{"day_char"}], |
|
418 "","lc", |
|
419 [$Lang{$L}{"WL"}], |
|
420 [\%tmp,1]); |
|
421 %{ $Lang{$L}{"WeekH"} } = |
|
422 (%{ $Lang{$L}{"WeekH"} },%tmp); |
|
423 |
|
424 # variables for last |
|
425 # Last = "(last)" |
|
426 # LastL = [ "last" ] |
|
427 # Each = "(each)" |
|
428 # EachL = [ "each" ] |
|
429 # variables for day of month |
|
430 # DoM = "(1st|first ... 31st)" |
|
431 # DoML = [ "1st","2nd",... "31st" ] |
|
432 # DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 } |
|
433 # variables for week of month |
|
434 # WoM = "(1st|first| ... 5th|last)" |
|
435 # WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 } |
|
436 |
|
437 $Lang{$L}{"LastL"}=$lang{"last"}; |
|
438 &Date_InitStrings($lang{"last"}, |
|
439 \$Lang{$L}{"Last"},"lc,sort"); |
|
440 |
|
441 $Lang{$L}{"EachL"}=$lang{"each"}; |
|
442 &Date_InitStrings($lang{"each"}, |
|
443 \$Lang{$L}{"Each"},"lc,sort"); |
|
444 |
|
445 $Lang{$L}{"DoMH"}={}; |
|
446 $Lang{$L}{"DoML"}=[]; |
|
447 &Date_InitLists([$lang{"num_suff"}, |
|
448 $lang{"num_word"}], |
|
449 \$Lang{$L}{"DoM"},"lc,sort,back,escape", |
|
450 [$Lang{$L}{"DoML"}, |
|
451 \@tmp], |
|
452 [$Lang{$L}{"DoMH"},1]); |
|
453 |
|
454 @tmp=(); |
|
455 foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) { |
|
456 $tmp2=$Lang{$L}{"DoMH"}{$tmp}; |
|
457 if ($tmp2<6) { |
|
458 $Lang{$L}{"WoMH"}{$tmp} = $tmp2; |
|
459 push(@tmp,$tmp); |
|
460 } |
|
461 } |
|
462 foreach $tmp (@{ $Lang{$L}{"LastL"} }) { |
|
463 $Lang{$L}{"WoMH"}{$tmp} = -1; |
|
464 push(@tmp,$tmp); |
|
465 } |
|
466 &Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"}, |
|
467 "lc,sort,back,escape"); |
|
468 |
|
469 # variables for AM or PM |
|
470 # AM = "(am)" |
|
471 # PM = "(pm)" |
|
472 # AmPm = "(am|pm)" |
|
473 # AMstr = "AM" |
|
474 # PMstr = "PM" |
|
475 |
|
476 &Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape"); |
|
477 &Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape"); |
|
478 &Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"}, |
|
479 "lc,back,sort,escape"); |
|
480 $Lang{$L}{"AMstr"}=$lang{"am"}[0]; |
|
481 $Lang{$L}{"PMstr"}=$lang{"pm"}[0]; |
|
482 |
|
483 # variables for expressions used in parsing deltas |
|
484 # Yabb = "(?:y|yr|year|years)" |
|
485 # Mabb = similar for months |
|
486 # Wabb = similar for weeks |
|
487 # Dabb = similar for days |
|
488 # Habb = similar for hours |
|
489 # MNabb = similar for minutes |
|
490 # Sabb = similar for seconds |
|
491 # Repl = { "abb"=>"replacement" } |
|
492 # Whenever an abbreviation could potentially refer to two different |
|
493 # strings (M standing for Minutes or Months), the abbreviation must |
|
494 # be listed in Repl instead of in the appropriate Xabb values. This |
|
495 # only applies to abbreviations which are substrings of other values |
|
496 # (so there is no confusion between Mn and Month). |
|
497 |
|
498 &Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort"); |
|
499 &Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort"); |
|
500 &Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort"); |
|
501 &Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort"); |
|
502 &Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort"); |
|
503 &Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort"); |
|
504 &Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort"); |
|
505 $Lang{$L}{"Repl"}={}; |
|
506 &Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"}); |
|
507 |
|
508 # variables for special dates that are offsets from now |
|
509 # Now = "(now|today)" |
|
510 # Offset = "(yesterday|tomorrow)" |
|
511 # OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ] |
|
512 # Times = "(noon|midnight)" |
|
513 # TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" } |
|
514 # SepHM = hour/minute separator |
|
515 # SepMS = minute/second separator |
|
516 # SepSS = second/fraction separator |
|
517 |
|
518 $Lang{$L}{"TimesH"}={}; |
|
519 &Date_InitHash($lang{"times"}, |
|
520 \$Lang{$L}{"Times"},"lc,sort,back", |
|
521 $Lang{$L}{"TimesH"}); |
|
522 &Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort"); |
|
523 $Lang{$L}{"OffsetH"}={}; |
|
524 &Date_InitHash($lang{"offset"}, |
|
525 \$Lang{$L}{"Offset"},"lc,sort,back", |
|
526 $Lang{$L}{"OffsetH"}); |
|
527 $Lang{$L}{"SepHM"}=$lang{"sephm"}; |
|
528 $Lang{$L}{"SepMS"}=$lang{"sepms"}; |
|
529 $Lang{$L}{"SepSS"}=$lang{"sepss"}; |
|
530 |
|
531 # variables for time zones |
|
532 # zones = regular expression with all zone names (EST) |
|
533 # n2o = a hash of all parsable zone names with their offsets |
|
534 # tzones = reguar expression with all tzdata timezones (US/Eastern) |
|
535 # tz2z = hash of all tzdata timezones to full timezone (EST#EDT) |
|
536 |
|
537 $zonesrfc= |
|
538 "idlw -1200 ". # International Date Line West |
|
539 "nt -1100 ". # Nome |
|
540 "hst -1000 ". # Hawaii Standard |
|
541 "cat -1000 ". # Central Alaska |
|
542 "ahst -1000 ". # Alaska-Hawaii Standard |
|
543 "akst -0900 ". # Alaska Standard |
|
544 "yst -0900 ". # Yukon Standard |
|
545 "hdt -0900 ". # Hawaii Daylight |
|
546 "akdt -0800 ". # Alaska Daylight |
|
547 "ydt -0800 ". # Yukon Daylight |
|
548 "pst -0800 ". # Pacific Standard |
|
549 "pdt -0700 ". # Pacific Daylight |
|
550 "mst -0700 ". # Mountain Standard |
|
551 "mdt -0600 ". # Mountain Daylight |
|
552 "cst -0600 ". # Central Standard |
|
553 "cdt -0500 ". # Central Daylight |
|
554 "est -0500 ". # Eastern Standard |
|
555 "act -0500 ". # Brazil, Acre |
|
556 "sat -0400 ". # Chile |
|
557 "bot -0400 ". # Bolivia |
|
558 "amt -0400 ". # Brazil, Amazon |
|
559 "acst -0400 ". # Brazil, Acre Daylight |
|
560 "edt -0400 ". # Eastern Daylight |
|
561 "ast -0400 ". # Atlantic Standard |
|
562 #"nst -0330 ". # Newfoundland Standard nst=North Sumatra +0630 |
|
563 "nft -0330 ". # Newfoundland |
|
564 #"gst -0300 ". # Greenland Standard gst=Guam Standard +1000 |
|
565 #"bst -0300 ". # Brazil Standard bst=British Summer +0100 |
|
566 "brt -0300 ". # Brazil Standard (official time) |
|
567 "brst -0300 ". # Brazil Standard |
|
568 "adt -0300 ". # Atlantic Daylight |
|
569 "art -0300 ". # Argentina |
|
570 "amst -0300 ". # Brazil, Amazon Daylight |
|
571 "ndt -0230 ". # Newfoundland Daylight |
|
572 "brst -0200 ". # Brazil Daylight (official time) |
|
573 "fnt -0200 ". # Brazil, Fernando de Noronha |
|
574 "at -0200 ". # Azores |
|
575 "wat -0100 ". # West Africa |
|
576 "fnst -0100 ". # Brazil, Fernando de Noronha Daylight |
|
577 "gmt +0000 ". # Greenwich Mean |
|
578 "ut +0000 ". # Universal |
|
579 "utc +0000 ". # Universal (Coordinated) |
|
580 "wet +0000 ". # Western European |
|
581 "cet +0100 ". # Central European |
|
582 "fwt +0100 ". # French Winter |
|
583 "met +0100 ". # Middle European |
|
584 "mez +0100 ". # Middle European |
|
585 "mewt +0100 ". # Middle European Winter |
|
586 "swt +0100 ". # Swedish Winter |
|
587 "bst +0100 ". # British Summer bst=Brazil standard -0300 |
|
588 "gb +0100 ". # GMT with daylight savings |
|
589 "west +0000 ". # Western European Daylight |
|
590 "eet +0200 ". # Eastern Europe, USSR Zone 1 |
|
591 "cest +0200 ". # Central European Summer |
|
592 "fst +0200 ". # French Summer |
|
593 "ist +0200 ". # Israel standard |
|
594 "mest +0200 ". # Middle European Summer |
|
595 "mesz +0200 ". # Middle European Summer |
|
596 "metdst +0200 ". # An alias for mest used by HP-UX |
|
597 "sast +0200 ". # South African Standard |
|
598 "sst +0200 ". # Swedish Summer sst=South Sumatra +0700 |
|
599 "bt +0300 ". # Baghdad, USSR Zone 2 |
|
600 "eest +0300 ". # Eastern Europe Summer |
|
601 "eetedt +0300 ". # Eastern Europe, USSR Zone 1 |
|
602 "idt +0300 ". # Israel Daylight |
|
603 "msk +0300 ". # Moscow |
|
604 "eat +0300 ". # East Africa |
|
605 "it +0330 ". # Iran |
|
606 "zp4 +0400 ". # USSR Zone 3 |
|
607 "msd +0400 ". # Moscow Daylight |
|
608 "zp5 +0500 ". # USSR Zone 4 |
|
609 "ist +0530 ". # Indian Standard |
|
610 "zp6 +0600 ". # USSR Zone 5 |
|
611 "novst +0600 ". # Novosibirsk time zone, Russia |
|
612 "nst +0630 ". # North Sumatra nst=Newfoundland Std -0330 |
|
613 #"sst +0700 ". # South Sumatra, USSR Zone 6 sst=Swedish Summer +0200 |
|
614 "javt +0700 ". # Java |
|
615 "hkt +0800 ". # Hong Kong |
|
616 "sgt +0800 ". # Singapore |
|
617 "cct +0800 ". # China Coast, USSR Zone 7 |
|
618 "awst +0800 ". # Australian Western Standard |
|
619 "wst +0800 ". # West Australian Standard |
|
620 "pht +0800 ". # Asia Manila |
|
621 "kst +0900 ". # Republic of Korea |
|
622 "jst +0900 ". # Japan Standard, USSR Zone 8 |
|
623 "rok +0900 ". # Republic of Korea |
|
624 "acst +0930 ". # Australian Central Standard |
|
625 "cast +0930 ". # Central Australian Standard |
|
626 "aest +1000 ". # Australian Eastern Standard |
|
627 "east +1000 ". # Eastern Australian Standard |
|
628 "gst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300 |
|
629 "acdt +1030 ". # Australian Central Daylight |
|
630 "cadt +1030 ". # Central Australian Daylight |
|
631 "aedt +1100 ". # Australian Eastern Daylight |
|
632 "eadt +1100 ". # Eastern Australian Daylight |
|
633 "idle +1200 ". # International Date Line East |
|
634 "nzst +1200 ". # New Zealand Standard |
|
635 "nzt +1200 ". # New Zealand |
|
636 "nzdt +1300 ". # New Zealand Daylight |
|
637 "z +0000 ". |
|
638 "a +0100 b +0200 c +0300 d +0400 e +0500 f +0600 g +0700 h +0800 ". |
|
639 "i +0900 k +1000 l +1100 m +1200 ". |
|
640 "n -0100 o -0200 p -0300 q -0400 r -0500 s -0600 t -0700 u -0800 ". |
|
641 "v -0900 w -1000 x -1100 y -1200"; |
|
642 |
|
643 $Zone{"n2o"} = {}; |
|
644 ($Zone{"zones"},%{ $Zone{"n2o"} })= |
|
645 &Date_Regexp($zonesrfc,"sort,lc,under,back", |
|
646 "keys"); |
|
647 |
|
648 $tmp= |
|
649 "US/Pacific PST8PDT ". |
|
650 "US/Mountain MST7MDT ". |
|
651 "US/Central CST6CDT ". |
|
652 "US/Eastern EST5EDT ". |
|
653 "Canada/Pacific PST8PDT ". |
|
654 "Canada/Mountain MST7MDT ". |
|
655 "Canada/Central CST6CDT ". |
|
656 "Canada/Eastern EST5EDT"; |
|
657 |
|
658 $Zone{"tz2z"} = {}; |
|
659 ($Zone{"tzones"},%{ $Zone{"tz2z"} })= |
|
660 &Date_Regexp($tmp,"lc,under,back","keys"); |
|
661 $Cnf{"TZ"}=&Date_TimeZone; |
|
662 |
|
663 # misc. variables |
|
664 # At = "(?:at)" |
|
665 # Of = "(?:in|of)" |
|
666 # On = "(?:on)" |
|
667 # Future = "(?:in)" |
|
668 # Later = "(?:later)" |
|
669 # Past = "(?:ago)" |
|
670 # Next = "(?:next)" |
|
671 # Prev = "(?:last|previous)" |
|
672 |
|
673 &Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort"); |
|
674 &Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort"); |
|
675 &Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort"); |
|
676 &Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort"); |
|
677 &Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort"); |
|
678 &Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort"); |
|
679 &Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort"); |
|
680 &Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort"); |
|
681 |
|
682 # calc mode variables |
|
683 # Approx = "(?:approximately)" |
|
684 # Exact = "(?:exactly)" |
|
685 # Business = "(?:business)" |
|
686 |
|
687 &Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort"); |
|
688 &Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort"); |
|
689 &Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort"); |
|
690 |
|
691 ############### END OF LANGUAGE INITIALIZATION |
|
692 } |
|
693 |
|
694 if ($Curr{"ResetWorkDay"}) { |
|
695 my($h1,$m1,$h2,$m2)=(); |
|
696 if ($Cnf{"WorkDay24Hr"}) { |
|
697 ($Curr{"WDBh"},$Curr{"WDBm"})=(0,0); |
|
698 ($Curr{"WDEh"},$Curr{"WDEm"})=(24,0); |
|
699 $Curr{"WDlen"}=24*60; |
|
700 $Cnf{"WorkDayBeg"}="00:00"; |
|
701 $Cnf{"WorkDayEnd"}="23:59"; |
|
702 |
|
703 } else { |
|
704 confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n" |
|
705 if (! (($h1,$m1)=&CheckTime($Cnf{"WorkDayBeg"}))); |
|
706 $Cnf{"WorkDayBeg"}="$h1:$m1"; |
|
707 confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n" |
|
708 if (! (($h2,$m2)=&CheckTime($Cnf{"WorkDayEnd"}))); |
|
709 $Cnf{"WorkDayEnd"}="$h2:$m2"; |
|
710 |
|
711 ($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1); |
|
712 ($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2); |
|
713 |
|
714 # Work day length = h1:m1 or 0:len (len minutes) |
|
715 $h1=$h2-$h1; |
|
716 $m1=$m2-$m1; |
|
717 if ($m1<0) { |
|
718 $h1--; |
|
719 $m1+=60; |
|
720 } |
|
721 $Curr{"WDlen"}=$h1*60+$m1; |
|
722 } |
|
723 $Curr{"ResetWorkDay"}=0; |
|
724 } |
|
725 |
|
726 # current time |
|
727 my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=(); |
|
728 if ($Cnf{"ForceDate"}=~ |
|
729 /^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) { |
|
730 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6); |
|
731 } else { |
|
732 ($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time); |
|
733 $y+=1900; |
|
734 $m++; |
|
735 } |
|
736 &Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk); |
|
737 $Curr{"Y"}=$y; |
|
738 $Curr{"M"}=$m; |
|
739 $Curr{"D"}=$d; |
|
740 $Curr{"H"}=$h; |
|
741 $Curr{"Mn"}=$mn; |
|
742 $Curr{"S"}=$s; |
|
743 $Curr{"AmPm"}=$ampm; |
|
744 $Curr{"Now"}=&Date_Join($y,$m,$d,$h,$mn,$s); |
|
745 |
|
746 $Curr{"Debug"}=$Curr{"DebugVal"}; |
|
747 |
|
748 # If we're in array context, let's return a list of config variables |
|
749 # that could be passed to Date_Init to get the same state as we're |
|
750 # currently in. |
|
751 if (wantarray) { |
|
752 # Some special variables that have to be in a specific order |
|
753 my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath); |
|
754 my(%tmp)=map { $_,1 } @special; |
|
755 my(@tmp,$key,$val); |
|
756 foreach $key (@special) { |
|
757 $val=$Cnf{$key}; |
|
758 push(@tmp,"$key=$val"); |
|
759 } |
|
760 foreach $key (keys %Cnf) { |
|
761 next if (exists $tmp{$key}); |
|
762 $val=$Cnf{$key}; |
|
763 push(@tmp,"$key=$val"); |
|
764 } |
|
765 return @tmp; |
|
766 } |
|
767 return (); |
|
768 } |
|
769 |
|
770 sub ParseDateString { |
|
771 print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/); |
|
772 local($_)=@_; |
|
773 return "" if (! $_); |
|
774 |
|
775 my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=(); |
|
776 my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=(); |
|
777 |
|
778 # We only need to reinitialize if we have to determine what NOW is. |
|
779 &Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"}); |
|
780 |
|
781 my($L)=$Cnf{"Language"}; |
|
782 my($type)=$Cnf{"DateFormat"}; |
|
783 |
|
784 # Mode is set in DateCalc. ParseDate only overrides it if the string |
|
785 # contains a mode. |
|
786 if ($Lang{$L}{"Exact"} && |
|
787 s/$Lang{$L}{"Exact"}//) { |
|
788 $Curr{"Mode"}=0; |
|
789 } elsif ($Lang{$L}{"Approx"} && |
|
790 s/$Lang{$L}{"Approx"}//) { |
|
791 $Curr{"Mode"}=1; |
|
792 } elsif ($Lang{$L}{"Business"} && |
|
793 s/$Lang{$L}{"Business"}//) { |
|
794 $Curr{"Mode"}=2; |
|
795 } elsif (! exists $Curr{"Mode"}) { |
|
796 $Curr{"Mode"}=0; |
|
797 } |
|
798 |
|
799 # Unfortunately, some deltas can be parsed as dates. An example is |
|
800 # 1 second == 1 2nd == 1 2 |
|
801 # But, some dates can be parsed as deltas. The most important being: |
|
802 # 1998010101:00:00 |
|
803 # We'll check to see if a "date" can be parsed as a delta. If so, we'll |
|
804 # assume that it is a delta (since they are much simpler, it is much |
|
805 # less likely that we'll mistake a delta for a date than vice versa) |
|
806 # unless it is an ISO-8601 date. |
|
807 # |
|
808 # This is important because we are using DateCalc to test whether a |
|
809 # string is a date or a delta. Dates are tested first, so we need to |
|
810 # be able to pass a delta into this routine and have it correctly NOT |
|
811 # interpreted as a date. |
|
812 # |
|
813 # We will insist that the string contain something other than digits and |
|
814 # colons so that the following will get correctly interpreted as a date |
|
815 # rather than a delta: |
|
816 # 12:30 |
|
817 # 19980101 |
|
818 |
|
819 $delta=""; |
|
820 $delta=&ParseDateDelta($_) if (/[^:0-9]/); |
|
821 |
|
822 # Put parse in a simple loop for an easy exit. |
|
823 PARSE: { |
|
824 my(@tmp)=&Date_Split($_); |
|
825 if (@tmp) { |
|
826 ($y,$m,$d,$h,$mn,$s)=@tmp; |
|
827 last PARSE; |
|
828 } |
|
829 |
|
830 # Fundamental regular expressions |
|
831 |
|
832 my($month)=$Lang{$L}{"Month"}; # (jan|january|...) |
|
833 my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... } |
|
834 my($week)=$Lang{$L}{"Week"}; # (mon|monday|...) |
|
835 my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... } |
|
836 my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last) |
|
837 my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 } |
|
838 my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st) |
|
839 my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... } |
|
840 my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm) |
|
841 my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight) |
|
842 my($now)=$Lang{$L}{"Now"}; # (now|today) |
|
843 my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow) |
|
844 my($zone)=$Zone{"zones"} . '(?:\s+|$)'; # (edt|est|...)\s+ |
|
845 my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days) |
|
846 my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months) |
|
847 my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks) |
|
848 my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next) |
|
849 my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous) |
|
850 my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago) |
|
851 my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in) |
|
852 my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later) |
|
853 my($at)=$Lang{$L}{"At"}; # (?:at) |
|
854 my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of) |
|
855 my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)'; |
|
856 # \s*(?:on)\s* or \s+ |
|
857 my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last) |
|
858 my($hm)=$Lang{$L}{"SepHM"}; # : |
|
859 my($ms)=$Lang{$L}{"SepMS"}; # : |
|
860 my($ss)=$Lang{$L}{"SepSS"}; # . |
|
861 |
|
862 # Other regular expressions |
|
863 |
|
864 my($D4)='(\d{4})'; # 4 digits (yr) |
|
865 my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr) |
|
866 my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec) |
|
867 my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr) |
|
868 my($FS)="(?:$ss\\d+)?"; # fractional secs |
|
869 my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators |
|
870 # absolute time zone +0700 (GMT) |
|
871 my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23 |
|
872 my($mzone)='(?:[0-5][0-9])'; # 00 - 59 |
|
873 my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))". |
|
874 # +0700 +07:00 -07 |
|
875 '(?:\s*\([^)]+\))?)'; # (GMT) |
|
876 |
|
877 # A regular expression for the time EXCEPT for the hour part |
|
878 my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?"; |
|
879 |
|
880 # A special regular expression for /YYYY:HH:MN:SS used by Apache |
|
881 my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD"; |
|
882 |
|
883 my($time)=""; |
|
884 $ampm=""; |
|
885 $date=""; |
|
886 |
|
887 # Substitute all special time expressions. |
|
888 if (/(^|[^a-z])$timeexp($|[^a-z])/i) { |
|
889 $tmp=$2; |
|
890 $tmp=$Lang{$L}{"TimesH"}{lc($tmp)}; |
|
891 s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i; |
|
892 } |
|
893 |
|
894 # Remove some punctuation |
|
895 s/[,]/ /g; |
|
896 |
|
897 # Make sure that ...7EST works (i.e. a timezone immediately following |
|
898 # a digit. |
|
899 s/(\d)$zone(\s+|$|[0-9])/$1 $2$3/i; |
|
900 $zone = '\s+'.$zone; |
|
901 |
|
902 # Remove the time |
|
903 $iso=1; |
|
904 $midnight=0; |
|
905 $from="24${hm}00(?:${ms}00)?"; |
|
906 $falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00 |
|
907 $to="00${hm}00${ms}00"; |
|
908 $midnight=1 if (!/$falsefrom/ && s/$from/$to/); |
|
909 |
|
910 $h=$mn=$s=0; |
|
911 if (/$D$mnsec/i || /$ampmexp/i) { |
|
912 $iso=0; |
|
913 $tmp=0; |
|
914 $tmp=1 if (/$mnsec$zone2?\s*$/i); # or /$mnsec$zone/ ?? |
|
915 $tmp=0 if (/$ampmexp/i); |
|
916 if (s/$apachetime$zone()/$1 /i || |
|
917 s/$apachetime$zone2?/$1 /i || |
|
918 s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i || |
|
919 s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i || |
|
920 s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i || |
|
921 s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i || |
|
922 (s/(t)$D$mnsec$zone()/$1 /i and (($iso=-$tmp) || 1)) || |
|
923 (s/(t)$D$mnsec$zone2?/$1 /i and (($iso=-$tmp) || 1)) || |
|
924 (s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) || |
|
925 (s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) || |
|
926 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i || |
|
927 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i || |
|
928 0 |
|
929 ) { |
|
930 ($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7); |
|
931 if (defined ($z)) { |
|
932 if ($z =~ /^[+-]\d{2}:\d{2}$/) { |
|
933 $z=~ s/://; |
|
934 } elsif ($z =~ /^[+-]\d{2}$/) { |
|
935 $z .= "00"; |
|
936 } |
|
937 } |
|
938 $time=1; |
|
939 &Date_TimeCheck(\$h,\$mn,\$s,\$ampm); |
|
940 $y=$m=$d=""; |
|
941 # We're going to be calling TimeCheck again below (when we check the |
|
942 # final date), so get rid of $ampm so that we don't have an error |
|
943 # due to "15:30:00 PM". It'll get reset below. |
|
944 $ampm=""; |
|
945 if (/^\s*$/) { |
|
946 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
947 last PARSE; |
|
948 } |
|
949 } |
|
950 } |
|
951 $time=0 if ($time ne "1"); |
|
952 s/\s+$//; |
|
953 s/^\s+//; |
|
954 |
|
955 # dateTtime ISO 8601 formats |
|
956 my($orig)=$_; |
|
957 s/t$//i if ($iso<0); |
|
958 |
|
959 # Parse ISO 8601 dates now (which may still have a zone stuck to it). |
|
960 if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) || |
|
961 ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) || |
|
962 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) || |
|
963 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) || |
|
964 0) { |
|
965 |
|
966 # ISO 8601 dates |
|
967 ($_,$z,$z2) = ($1,$2); |
|
968 s,-, ,g; # Change all ISO8601 seps to spaces |
|
969 s/^\s+//; |
|
970 s/\s+$//; |
|
971 |
|
972 if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i || |
|
973 /^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i || |
|
974 0 |
|
975 ) { |
|
976 # ISO 8601 Dates with times |
|
977 # YYYYMMDDHHMNSSFFFF... |
|
978 # YYYYMMDDHHMNSS |
|
979 # YYYYMMDDHHMN |
|
980 # YYYYMMDDHH |
|
981 # YY MMDDHHMNSSFFFF... |
|
982 # YY MMDDHHMNSS |
|
983 # YY MMDDHHMN |
|
984 # YY MMDDHH |
|
985 ($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7); |
|
986 if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) { |
|
987 $h=0; |
|
988 $midnight=1; |
|
989 } |
|
990 $z = "" if (! defined $h); |
|
991 return "" if ($time && defined $h); |
|
992 last PARSE; |
|
993 |
|
994 } elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ || |
|
995 /^$DD(?:\s+$DD(?:\s*$DD)?)?$/) { |
|
996 # ISO 8601 Dates |
|
997 # YYYYMMDD |
|
998 # YYYYMM |
|
999 # YYYY |
|
1000 # YY MMDD |
|
1001 # YY MM |
|
1002 # YY |
|
1003 ($y,$m,$d)=($1,$2,$3); |
|
1004 last PARSE; |
|
1005 |
|
1006 } elsif (/^$YY\s+$D\s+$D/) { |
|
1007 # YY-M-D |
|
1008 ($y,$m,$d)=($1,$2,$3); |
|
1009 last PARSE; |
|
1010 |
|
1011 } elsif (/^$YY\s*W$DD\s*(\d)?$/i) { |
|
1012 # YY-W##-D |
|
1013 ($y,$wofm,$dofw)=($1,$2,$3); |
|
1014 ($y,$m,$d)=&Date_NthWeekOfYear($y,$wofm,$dofw); |
|
1015 last PARSE; |
|
1016 |
|
1017 } elsif (/^$D4\s*(\d{3})$/ || |
|
1018 /^$DD\s*(\d{3})$/) { |
|
1019 # YYDOY |
|
1020 ($y,$which)=($1,$2); |
|
1021 ($y,$m,$d)=&Date_NthDayOfYear($y,$which); |
|
1022 last PARSE; |
|
1023 |
|
1024 } elsif ($iso<0) { |
|
1025 # We confused something like 1999/August12:00:00 |
|
1026 # with a dateTtime format |
|
1027 $_=$orig; |
|
1028 |
|
1029 } else { |
|
1030 return ""; |
|
1031 } |
|
1032 } |
|
1033 |
|
1034 # All deltas that are not ISO-8601 dates are NOT dates. |
|
1035 return "" if ($Curr{"InCalc"} && $delta); |
|
1036 if ($delta) { |
|
1037 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1038 return &DateCalc_DateDelta($Curr{"Now"},$delta); |
|
1039 } |
|
1040 |
|
1041 # Check for some special types of dates (next, prev) |
|
1042 foreach $from (keys %{ $Lang{$L}{"Repl"} }) { |
|
1043 $to=$Lang{$L}{"Repl"}{$from}; |
|
1044 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i; |
|
1045 } |
|
1046 if (/$wom/i || /$future/i || /$later/i || /$past/i || |
|
1047 /$next/i || /$prev/i || /^$week$/i || /$wkabb/i) { |
|
1048 $tmp=0; |
|
1049 |
|
1050 if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) { |
|
1051 # last friday in October 95 |
|
1052 ($wofm,$dofw,$m,$y)=($1,$2,$3,$4); |
|
1053 # fix $m, $y |
|
1054 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
|
1055 $dofw=$week{lc($dofw)}; |
|
1056 $wofm=$wom{lc($wofm)}; |
|
1057 # Get the first day of the month |
|
1058 $date=&Date_Join($y,$m,1,$h,$mn,$s); |
|
1059 if ($wofm==-1) { |
|
1060 $date=&DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0); |
|
1061 $date=&Date_GetPrev($date,$dofw,0); |
|
1062 } else { |
|
1063 for ($i=0; $i<$wofm; $i++) { |
|
1064 if ($i==0) { |
|
1065 $date=&Date_GetNext($date,$dofw,1); |
|
1066 } else { |
|
1067 $date=&Date_GetNext($date,$dofw,0); |
|
1068 } |
|
1069 } |
|
1070 } |
|
1071 last PARSE; |
|
1072 |
|
1073 } elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) { |
|
1074 # last day in month |
|
1075 ($m,$y)=($1,$2); |
|
1076 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1077 $y=&Date_FixYear($y) if (! defined $y or length($y)<4); |
|
1078 $m=$month{lc($m)}; |
|
1079 $d=&Date_DaysInMonth($m,$y); |
|
1080 last PARSE; |
|
1081 |
|
1082 } elsif (/^$week$/i) { |
|
1083 # friday |
|
1084 ($dofw)=($1); |
|
1085 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1086 $date=&Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1); |
|
1087 $date=&Date_GetNext($date,$dofw,1,$h,$mn,$s); |
|
1088 last PARSE; |
|
1089 |
|
1090 } elsif (/^$next\s*$week$/i) { |
|
1091 # next friday |
|
1092 ($dofw)=($1); |
|
1093 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1094 $date=&Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s); |
|
1095 last PARSE; |
|
1096 |
|
1097 } elsif (/^$prev\s*$week$/i) { |
|
1098 # last friday |
|
1099 ($dofw)=($1); |
|
1100 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1101 $date=&Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s); |
|
1102 last PARSE; |
|
1103 |
|
1104 } elsif (/^$next$wkabb$/i) { |
|
1105 # next week |
|
1106 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1107 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0); |
|
1108 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1109 last PARSE; |
|
1110 } elsif (/^$prev$wkabb$/i) { |
|
1111 # last week |
|
1112 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1113 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0); |
|
1114 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1115 last PARSE; |
|
1116 |
|
1117 } elsif (/^$next$mabb$/i) { |
|
1118 # next month |
|
1119 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1120 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0); |
|
1121 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1122 last PARSE; |
|
1123 } elsif (/^$prev$mabb$/i) { |
|
1124 # last month |
|
1125 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1126 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0); |
|
1127 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1128 last PARSE; |
|
1129 |
|
1130 } elsif (/^$future\s*(\d+)$day$/i || |
|
1131 /^(\d+)$day$later$/i) { |
|
1132 # in 2 days |
|
1133 # 2 days later |
|
1134 ($num)=($1); |
|
1135 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1136 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0", |
|
1137 \$err,0); |
|
1138 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1139 last PARSE; |
|
1140 } elsif (/^(\d+)$day$past$/i) { |
|
1141 # 2 days ago |
|
1142 ($num)=($1); |
|
1143 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1144 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0", |
|
1145 \$err,0); |
|
1146 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1147 last PARSE; |
|
1148 |
|
1149 } elsif (/^$future\s*(\d+)$wkabb$/i || |
|
1150 /^(\d+)$wkabb$later$/i) { |
|
1151 # in 2 weeks |
|
1152 # 2 weeks later |
|
1153 ($num)=($1); |
|
1154 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1155 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0", |
|
1156 \$err,0); |
|
1157 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1158 last PARSE; |
|
1159 } elsif (/^(\d+)$wkabb$past$/i) { |
|
1160 # 2 weeks ago |
|
1161 ($num)=($1); |
|
1162 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1163 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0", |
|
1164 \$err,0); |
|
1165 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1166 last PARSE; |
|
1167 |
|
1168 } elsif (/^$future\s*(\d+)$mabb$/i || |
|
1169 /^(\d+)$mabb$later$/i) { |
|
1170 # in 2 months |
|
1171 # 2 months later |
|
1172 ($num)=($1); |
|
1173 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1174 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0", |
|
1175 \$err,0); |
|
1176 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1177 last PARSE; |
|
1178 } elsif (/^(\d+)$mabb$past$/i) { |
|
1179 # 2 months ago |
|
1180 ($num)=($1); |
|
1181 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1182 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0", |
|
1183 \$err,0); |
|
1184 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1185 last PARSE; |
|
1186 |
|
1187 } elsif (/^$week$future\s*(\d+)$wkabb$/i || |
|
1188 /^$week\s*(\d+)$wkabb$later$/i) { |
|
1189 # friday in 2 weeks |
|
1190 # friday 2 weeks later |
|
1191 ($dofw,$num)=($1,$2); |
|
1192 $tmp="+"; |
|
1193 } elsif (/^$week\s*(\d+)$wkabb$past$/i) { |
|
1194 # friday 2 weeks ago |
|
1195 ($dofw,$num)=($1,$2); |
|
1196 $tmp="-"; |
|
1197 } elsif (/^$future\s*(\d+)$wkabb$on$week$/i || |
|
1198 /^(\d+)$wkabb$later$on$week$/i) { |
|
1199 # in 2 weeks on friday |
|
1200 # 2 weeks later on friday |
|
1201 ($num,$dofw)=($1,$2); |
|
1202 $tmp="+" |
|
1203 } elsif (/^(\d+)$wkabb$past$on$week$/i) { |
|
1204 # 2 weeks ago on friday |
|
1205 ($num,$dofw)=($1,$2); |
|
1206 $tmp="-"; |
|
1207 } elsif (/^$week\s*$wkabb$/i) { |
|
1208 # monday week (British date: in 1 week on monday) |
|
1209 $dofw=$1; |
|
1210 $num=1; |
|
1211 $tmp="+"; |
|
1212 } elsif (/^$now\s*$wkabb$/i) { |
|
1213 # today week (British date: 1 week from today) |
|
1214 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1215 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0); |
|
1216 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h); |
|
1217 last PARSE; |
|
1218 } elsif (/^$offset\s*$wkabb$/i) { |
|
1219 # tomorrow week (British date: 1 week from tomorrow) |
|
1220 ($offset)=($1); |
|
1221 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1222 $offset=$Lang{$L}{"OffsetH"}{lc($offset)}; |
|
1223 $date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0); |
|
1224 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0); |
|
1225 if ($time) { |
|
1226 return "" |
|
1227 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
|
1228 $date=&Date_SetTime($date,$h,$mn,$s); |
|
1229 } |
|
1230 last PARSE; |
|
1231 } |
|
1232 |
|
1233 if ($tmp) { |
|
1234 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1235 $date=&DateCalc_DateDelta($Curr{"Now"}, |
|
1236 $tmp . "0:0:$num:0:0:0:0",\$err,0); |
|
1237 $date=&Date_GetPrev($date,$Cnf{"FirstDay"},1); |
|
1238 $date=&Date_GetNext($date,$dofw,1,$h,$mn,$s); |
|
1239 last PARSE; |
|
1240 } |
|
1241 } |
|
1242 |
|
1243 # Change (2nd, second) to 2 |
|
1244 $tmp=0; |
|
1245 if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) { |
|
1246 if (/^\s*$dom\s*$/) { |
|
1247 ($d)=($1); |
|
1248 $d=$dom{lc($d)}; |
|
1249 $m=$Curr{"M"}; |
|
1250 last PARSE; |
|
1251 } |
|
1252 my $from = $2; |
|
1253 my $to = $dom{ lc($from) }; |
|
1254 s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i; |
|
1255 s/^\s+//; |
|
1256 s/\s+$//; |
|
1257 } |
|
1258 |
|
1259 # Another set of special dates (Nth week) |
|
1260 if (/^$D\s*$week(?:$of?\s*$YY)?$/i) { |
|
1261 # 22nd sunday in 1996 |
|
1262 ($which,$dofw,$y)=($1,$2,$3); |
|
1263 $y=$Curr{"Y"} if (! $y); |
|
1264 $y--; # previous year |
|
1265 $tmp=&Date_GetNext("$y-12-31",$dofw,0); |
|
1266 if ($which>1) { |
|
1267 $tmp=&DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0); |
|
1268 } |
|
1269 ($y,$m,$d)=(&Date_Split($tmp, 1))[0..2]; |
|
1270 last PARSE; |
|
1271 } elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i || |
|
1272 /^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) { |
|
1273 # sunday week 22 in 1996 |
|
1274 # sunday 22nd week in 1996 |
|
1275 ($dofw,$which,$y)=($1,$2,$3); |
|
1276 ($y,$m,$d)=&Date_NthWeekOfYear($y,$which,$dofw); |
|
1277 last PARSE; |
|
1278 } |
|
1279 |
|
1280 # Get rid of day of week |
|
1281 if (/(^|[^a-z])$week($|[^a-z])/i) { |
|
1282 $wk=$2; |
|
1283 (s/(^|[^a-z])$week,/$1 /i) || |
|
1284 s/(^|[^a-z])$week($|[^a-z])/$1 $3/i; |
|
1285 s/^\s+//; |
|
1286 s/\s+$//; |
|
1287 } |
|
1288 |
|
1289 { |
|
1290 # So that we can handle negative epoch times, let's convert |
|
1291 # things like "epoch -" to "epochNEGATIVE " before we strip out |
|
1292 # the $sep chars, which include '-'. |
|
1293 s,epoch\s*-,epochNEGATIVE ,g; |
|
1294 |
|
1295 # Non-ISO8601 dates |
|
1296 s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces |
|
1297 s,^\s*,,; # remove leading/trailing space |
|
1298 s,\s*$,,; |
|
1299 |
|
1300 if (/^$D\s+$D(?:\s+$YY)?$/) { |
|
1301 # MM DD YY (DD MM YY non-US) |
|
1302 ($m,$d,$y)=($1,$2,$3); |
|
1303 ($m,$d)=($d,$m) if ($type ne "US"); |
|
1304 last PARSE; |
|
1305 |
|
1306 } elsif (/^$D4\s*$D\s*$D$/) { |
|
1307 # YYYY MM DD |
|
1308 ($y,$m,$d)=($1,$2,$3); |
|
1309 last PARSE; |
|
1310 |
|
1311 } elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) { |
|
1312 ($m)=($2); |
|
1313 |
|
1314 if (/^\s*$D(?:\s+$YY)?\s*$/) { |
|
1315 # mmm DD YY |
|
1316 # DD mmm YY |
|
1317 # DD YY mmm |
|
1318 ($d,$y)=($1,$2); |
|
1319 last PARSE; |
|
1320 |
|
1321 } elsif (/^\s*$D$D4\s*$/) { |
|
1322 # mmm DD YYYY |
|
1323 # DD mmm YYYY |
|
1324 # DD YYYY mmm |
|
1325 ($d,$y)=($1,$2); |
|
1326 last PARSE; |
|
1327 |
|
1328 } elsif (/^\s*$D4\s*$D\s*$/) { |
|
1329 # mmm YYYY DD |
|
1330 # YYYY mmm DD |
|
1331 # YYYY DD mmm |
|
1332 ($y,$d)=($1,$2); |
|
1333 last PARSE; |
|
1334 |
|
1335 } elsif (/^\s*$D4\s*$/) { |
|
1336 # mmm YYYY |
|
1337 # YYYY mmm |
|
1338 ($y,$d)=($1,1); |
|
1339 last PARSE; |
|
1340 |
|
1341 } else { |
|
1342 return ""; |
|
1343 } |
|
1344 |
|
1345 } elsif (/^epochNEGATIVE (\d+)$/) { |
|
1346 $s=$1; |
|
1347 $date=&DateCalc("1970-01-01 00:00 GMT","-0:0:$s"); |
|
1348 } elsif (/^epoch\s*(\d+)$/i) { |
|
1349 $s=$1; |
|
1350 $date=&DateCalc("1970-01-01 00:00 GMT","+0:0:$s"); |
|
1351 |
|
1352 } elsif (/^$now$/i) { |
|
1353 # now, today |
|
1354 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1355 $date=$Curr{"Now"}; |
|
1356 if ($time) { |
|
1357 return "" |
|
1358 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
|
1359 $date=&Date_SetTime($date,$h,$mn,$s); |
|
1360 } |
|
1361 last PARSE; |
|
1362 |
|
1363 } elsif (/^$offset$/i) { |
|
1364 # yesterday, tomorrow |
|
1365 ($offset)=($1); |
|
1366 &Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
|
1367 $offset=$Lang{$L}{"OffsetH"}{lc($offset)}; |
|
1368 $date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0); |
|
1369 if ($time) { |
|
1370 return "" |
|
1371 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
|
1372 $date=&Date_SetTime($date,$h,$mn,$s); |
|
1373 } |
|
1374 last PARSE; |
|
1375 |
|
1376 } else { |
|
1377 return ""; |
|
1378 } |
|
1379 } |
|
1380 } |
|
1381 |
|
1382 if (! $date) { |
|
1383 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
|
1384 $date=&Date_Join($y,$m,$d,$h,$mn,$s); |
|
1385 } |
|
1386 $date=&Date_ConvTZ($date,$z); |
|
1387 if ($midnight) { |
|
1388 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0"); |
|
1389 } |
|
1390 return $date; |
|
1391 } |
|
1392 |
|
1393 sub ParseDate { |
|
1394 print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/); |
|
1395 &Date_Init() if (! $Curr{"InitDone"}); |
|
1396 my($args,@args,@a,$ref,$date)=(); |
|
1397 @a=@_; |
|
1398 |
|
1399 # @a : is the list of args to ParseDate. Currently, only one argument |
|
1400 # is allowed and it must be a scalar (or a reference to a scalar) |
|
1401 # or a reference to an array. |
|
1402 |
|
1403 if ($#a!=0) { |
|
1404 print "ERROR: Invalid number of arguments to ParseDate.\n"; |
|
1405 return ""; |
|
1406 } |
|
1407 $args=$a[0]; |
|
1408 $ref=ref $args; |
|
1409 if (! $ref) { |
|
1410 return $args if (&Date_Split($args)); |
|
1411 @args=($args); |
|
1412 } elsif ($ref eq "ARRAY") { |
|
1413 @args=@$args; |
|
1414 } elsif ($ref eq "SCALAR") { |
|
1415 return $$args if (&Date_Split($$args)); |
|
1416 @args=($$args); |
|
1417 } else { |
|
1418 print "ERROR: Invalid arguments to ParseDate.\n"; |
|
1419 return ""; |
|
1420 } |
|
1421 @a=@args; |
|
1422 |
|
1423 # @args : a list containing all the arguments (dereferenced if appropriate) |
|
1424 # @a : a list containing all the arguments currently being examined |
|
1425 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a |
|
1426 # reference to a scalar, or a reference to an array was passed in |
|
1427 # $args : the scalar or refererence passed in |
|
1428 |
|
1429 PARSE: while($#a>=0) { |
|
1430 $date=join(" ",@a); |
|
1431 $date=&ParseDateString($date); |
|
1432 last if ($date); |
|
1433 pop(@a); |
|
1434 } # PARSE |
|
1435 |
|
1436 splice(@args,0,$#a + 1); |
|
1437 @$args= @args if (defined $ref and $ref eq "ARRAY"); |
|
1438 $date; |
|
1439 } |
|
1440 |
|
1441 sub Date_Cmp { |
|
1442 my($D1,$D2)=@_; |
|
1443 my($date1)=&ParseDateString($D1); |
|
1444 my($date2)=&ParseDateString($D2); |
|
1445 return $date1 cmp $date2; |
|
1446 } |
|
1447 |
|
1448 # **NOTE** |
|
1449 # The calc routines all call parse routines, so it is never necessary to |
|
1450 # call Date_Init in the calc routines. |
|
1451 sub DateCalc { |
|
1452 print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/); |
|
1453 my($D1,$D2,@arg)=@_; |
|
1454 my($ref,$err,$errref,$mode)=(); |
|
1455 |
|
1456 $errref=shift(@arg); |
|
1457 $ref=0; |
|
1458 if (defined $errref) { |
|
1459 if (ref $errref) { |
|
1460 $mode=shift(@arg); |
|
1461 $ref=1; |
|
1462 } else { |
|
1463 $mode=$errref; |
|
1464 $errref=""; |
|
1465 } |
|
1466 } |
|
1467 |
|
1468 my(@date,@delta,$ret,$tmp,$old)=(); |
|
1469 |
|
1470 if (defined $mode and $mode>=0 and $mode<=3) { |
|
1471 $Curr{"Mode"}=$mode; |
|
1472 } else { |
|
1473 $Curr{"Mode"}=0; |
|
1474 } |
|
1475 |
|
1476 $old=$Curr{"InCalc"}; |
|
1477 $Curr{"InCalc"}=1; |
|
1478 |
|
1479 if ($tmp=&ParseDateString($D1)) { |
|
1480 # If we've already parsed the date, we don't want to do it a second |
|
1481 # time (so we don't convert timezones twice). |
|
1482 if (&Date_Split($D1)) { |
|
1483 push(@date,$D1); |
|
1484 } else { |
|
1485 push(@date,$tmp); |
|
1486 } |
|
1487 } elsif ($tmp=&ParseDateDelta($D1)) { |
|
1488 push(@delta,$tmp); |
|
1489 } else { |
|
1490 $$errref=1 if ($ref); |
|
1491 return; |
|
1492 } |
|
1493 |
|
1494 if ($tmp=&ParseDateString($D2)) { |
|
1495 if (&Date_Split($D2)) { |
|
1496 push(@date,$D2); |
|
1497 } else { |
|
1498 push(@date,$tmp); |
|
1499 } |
|
1500 } elsif ($tmp=&ParseDateDelta($D2)) { |
|
1501 push(@delta,$tmp); |
|
1502 } else { |
|
1503 $$errref=2 if ($ref); |
|
1504 return; |
|
1505 } |
|
1506 $mode=$Curr{"Mode"}; |
|
1507 $Curr{"InCalc"}=$old; |
|
1508 |
|
1509 if ($#date==1) { |
|
1510 $ret=&DateCalc_DateDate(@date,$mode); |
|
1511 } elsif ($#date==0) { |
|
1512 $ret=&DateCalc_DateDelta(@date,@delta,\$err,$mode); |
|
1513 $$errref=$err if ($ref); |
|
1514 } else { |
|
1515 $ret=&DateCalc_DeltaDelta(@delta,$mode); |
|
1516 } |
|
1517 $ret; |
|
1518 } |
|
1519 |
|
1520 sub ParseDateDelta { |
|
1521 print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/); |
|
1522 my($args,@args,@a,$ref)=(); |
|
1523 local($_)=(); |
|
1524 @a=@_; |
|
1525 |
|
1526 # @a : is the list of args to ParseDateDelta. Currently, only one argument |
|
1527 # is allowed and it must be a scalar (or a reference to a scalar) |
|
1528 # or a reference to an array. |
|
1529 |
|
1530 if ($#a!=0) { |
|
1531 print "ERROR: Invalid number of arguments to ParseDateDelta.\n"; |
|
1532 return ""; |
|
1533 } |
|
1534 $args=$a[0]; |
|
1535 $ref=ref $args; |
|
1536 if (! $ref) { |
|
1537 @args=($args); |
|
1538 } elsif ($ref eq "ARRAY") { |
|
1539 @args=@$args; |
|
1540 } elsif ($ref eq "SCALAR") { |
|
1541 @args=($$args); |
|
1542 } else { |
|
1543 print "ERROR: Invalid arguments to ParseDateDelta.\n"; |
|
1544 return ""; |
|
1545 } |
|
1546 @a=@args; |
|
1547 |
|
1548 # @args : a list containing all the arguments (dereferenced if appropriate) |
|
1549 # @a : a list containing all the arguments currently being examined |
|
1550 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a |
|
1551 # reference to a scalar, or a reference to an array was passed in |
|
1552 # $args : the scalar or refererence passed in |
|
1553 |
|
1554 my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=(); |
|
1555 my($len,$tmp,$tmp2,$tmpl)=(); |
|
1556 my($from,$to)=(); |
|
1557 my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1; |
|
1558 |
|
1559 &Date_Init() if (! $Curr{"InitDone"}); |
|
1560 # A sign can be a sequence of zero or more + and - signs, this |
|
1561 # allows for deltas like '+ -2 days'. |
|
1562 my($signexp)='((?:[+-]\s*)*)'; |
|
1563 my($numexp)='(\d+)'; |
|
1564 my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)"; |
|
1565 my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=(); |
|
1566 $yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()"; |
|
1567 $yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?"; |
|
1568 $mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?"; |
|
1569 $wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?"; |
|
1570 $dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?"; |
|
1571 $hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?"; |
|
1572 $mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?"; |
|
1573 $sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?"; |
|
1574 my($future)=$Lang{$Cnf{"Language"}}{"Future"}; |
|
1575 my($later)=$Lang{$Cnf{"Language"}}{"Later"}; |
|
1576 my($past)=$Lang{$Cnf{"Language"}}{"Past"}; |
|
1577 |
|
1578 $delta=""; |
|
1579 PARSE: while (@a) { |
|
1580 $_ = join(" ", grep {defined;} @a); |
|
1581 s/\s+$//; |
|
1582 last if ($_ eq ""); |
|
1583 |
|
1584 # Mode is set in DateCalc. ParseDateDelta only overrides it if the |
|
1585 # string contains a mode. |
|
1586 if ($Lang{$Cnf{"Language"}}{"Exact"} && |
|
1587 s/$Lang{$Cnf{"Language"}}{"Exact"}//) { |
|
1588 $Curr{"Mode"}=0; |
|
1589 } elsif ($Lang{$Cnf{"Language"}}{"Approx"} && |
|
1590 s/$Lang{$Cnf{"Language"}}{"Approx"}//) { |
|
1591 $Curr{"Mode"}=1; |
|
1592 } elsif ($Lang{$Cnf{"Language"}}{"Business"} && |
|
1593 s/$Lang{$Cnf{"Language"}}{"Business"}//) { |
|
1594 $Curr{"Mode"}=2; |
|
1595 } elsif (! exists $Curr{"Mode"}) { |
|
1596 $Curr{"Mode"}=0; |
|
1597 } |
|
1598 $workweek=7 if ($Curr{"Mode"} != 2); |
|
1599 |
|
1600 foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) { |
|
1601 $to=$Lang{$Cnf{"Language"}}{"Repl"}{$from}; |
|
1602 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i; |
|
1603 } |
|
1604 |
|
1605 # in or ago |
|
1606 # |
|
1607 # We need to make sure that $later, $future, and $past don't contain each |
|
1608 # other... Romanian pointed this out where $past is "in urma" and $future |
|
1609 # is "in". When they do, we have to take this into account. |
|
1610 # $len length of best match (greatest wins) |
|
1611 # $tmp string after best match |
|
1612 # $dir direction (prior, after) of best match |
|
1613 # |
|
1614 # $tmp2 string before/after current match |
|
1615 # $tmpl length of current match |
|
1616 |
|
1617 $len=0; |
|
1618 $tmp=$_; |
|
1619 $dir=1; |
|
1620 |
|
1621 $tmp2=$_; |
|
1622 if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) { |
|
1623 $tmpl=length($2); |
|
1624 if ($tmpl>$len) { |
|
1625 $tmp=$tmp2; |
|
1626 $dir=1; |
|
1627 $len=$tmpl; |
|
1628 } |
|
1629 } |
|
1630 |
|
1631 $tmp2=$_; |
|
1632 if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) { |
|
1633 $tmpl=length($2); |
|
1634 if ($tmpl>$len) { |
|
1635 $tmp=$tmp2; |
|
1636 $dir=1; |
|
1637 $len=$tmpl; |
|
1638 } |
|
1639 } |
|
1640 |
|
1641 $tmp2=$_; |
|
1642 if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) { |
|
1643 $tmpl=length($2); |
|
1644 if ($tmpl>$len) { |
|
1645 $tmp=$tmp2; |
|
1646 $dir=-1; |
|
1647 $len=$tmpl; |
|
1648 } |
|
1649 } |
|
1650 |
|
1651 $_ = $tmp; |
|
1652 s/\s*$//; |
|
1653 |
|
1654 # the colon part of the delta |
|
1655 $colon=""; |
|
1656 if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) { |
|
1657 $colon=$1; |
|
1658 s/\s+$//; |
|
1659 } |
|
1660 @colon=split(/:/,$colon); |
|
1661 |
|
1662 # the non-colon part of the delta |
|
1663 $sign="+"; |
|
1664 @delta=(); |
|
1665 $i=6; |
|
1666 foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) { |
|
1667 last if ($#colon>=$i--); |
|
1668 $val=0; |
|
1669 if (s/^$exp1//ix) { |
|
1670 $val=$2 if ($2); |
|
1671 $sign=$1 if ($1); |
|
1672 } |
|
1673 |
|
1674 # Collapse a sign like '+ -' into a single character like '-', |
|
1675 # by counting the occurrences of '-'. |
|
1676 # |
|
1677 $sign =~ s/\s+//g; |
|
1678 $sign =~ tr/+//d; |
|
1679 my $count = ($sign =~ tr/-//d); |
|
1680 die "bad characters in sign: $sign" if length $sign; |
|
1681 $sign = $count % 2 ? '-' : '+'; |
|
1682 |
|
1683 push(@delta,"$sign$val"); |
|
1684 } |
|
1685 if (! /^\s*$/) { |
|
1686 pop(@a); |
|
1687 next PARSE; |
|
1688 } |
|
1689 |
|
1690 # make sure that the colon part has a sign |
|
1691 for ($i=0; $i<=$#colon; $i++) { |
|
1692 $val=0; |
|
1693 if ($colon[$i] =~ /^$signexp$numexp?/) { |
|
1694 $val=$2 if ($2); |
|
1695 $sign=$1 if ($1); |
|
1696 } |
|
1697 $colon[$i] = "$sign$val"; |
|
1698 } |
|
1699 |
|
1700 # combine the two |
|
1701 push(@delta,@colon); |
|
1702 if ($dir<0) { |
|
1703 for ($i=0; $i<=$#delta; $i++) { |
|
1704 $delta[$i] =~ tr/-+/+-/; |
|
1705 } |
|
1706 } |
|
1707 |
|
1708 # form the delta and shift off the valid part |
|
1709 $delta=join(":",@delta); |
|
1710 splice(@args,0,$#a+1); |
|
1711 @$args=@args if (defined $ref and $ref eq "ARRAY"); |
|
1712 last PARSE; |
|
1713 } |
|
1714 |
|
1715 $delta=&Delta_Normalize($delta,$Curr{"Mode"}); |
|
1716 return $delta; |
|
1717 } |
|
1718 |
|
1719 sub UnixDate { |
|
1720 print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/); |
|
1721 my($date,@format)=@_; |
|
1722 local($_)=(); |
|
1723 my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=(); |
|
1724 my($scalar)=(); |
|
1725 $date=&ParseDateString($date); |
|
1726 return if (! $date); |
|
1727 |
|
1728 my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})= |
|
1729 &Date_Split($date, 1); |
|
1730 $f{"y"}=substr $f{"Y"},2; |
|
1731 &Date_Init() if (! $Curr{"InitDone"}); |
|
1732 |
|
1733 if (! wantarray) { |
|
1734 $format=join(" ",@format); |
|
1735 @format=($format); |
|
1736 $scalar=1; |
|
1737 } |
|
1738 |
|
1739 # month, week |
|
1740 $_=$m; |
|
1741 s/^0//; |
|
1742 $f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1]; |
|
1743 $f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1]; |
|
1744 $_=$m; |
|
1745 s/^0/ /; |
|
1746 $f{"f"}=$_; |
|
1747 $f{"U"}=&Date_WeekOfYear($m,$d,$y,7); |
|
1748 $f{"W"}=&Date_WeekOfYear($m,$d,$y,1); |
|
1749 |
|
1750 # check week 52,53 and 0 |
|
1751 $f{"G"}=$f{"L"}=$y; |
|
1752 if ($f{"W"}>=52 || $f{"U"}>=52) { |
|
1753 my($dd,$mm,$yy)=($d,$m,$y); |
|
1754 $dd+=7; |
|
1755 if ($dd>31) { |
|
1756 $dd-=31; |
|
1757 $mm=1; |
|
1758 $yy++; |
|
1759 if (&Date_WeekOfYear($mm,$dd,$yy,1)==2) { |
|
1760 $f{"G"}=$yy; |
|
1761 $f{"W"}=1; |
|
1762 } |
|
1763 if (&Date_WeekOfYear($mm,$dd,$yy,7)==2) { |
|
1764 $f{"L"}=$yy; |
|
1765 $f{"U"}=1; |
|
1766 } |
|
1767 } |
|
1768 } |
|
1769 if ($f{"W"}==0) { |
|
1770 my($dd,$mm,$yy)=($d,$m,$y); |
|
1771 $dd-=7; |
|
1772 $dd+=31 if ($dd<1); |
|
1773 $yy--; |
|
1774 $mm=12; |
|
1775 $f{"G"}=$yy; |
|
1776 $f{"W"}=&Date_WeekOfYear($mm,$dd,$yy,1)+1; |
|
1777 } |
|
1778 if ($f{"U"}==0) { |
|
1779 my($dd,$mm,$yy)=($d,$m,$y); |
|
1780 $dd-=7; |
|
1781 $dd+=31 if ($dd<1); |
|
1782 $yy--; |
|
1783 $mm=12; |
|
1784 $f{"L"}=$yy; |
|
1785 $f{"U"}=&Date_WeekOfYear($mm,$dd,$yy,7)+1; |
|
1786 } |
|
1787 |
|
1788 $f{"U"}="0".$f{"U"} if (length $f{"U"} < 2); |
|
1789 $f{"W"}="0".$f{"W"} if (length $f{"W"} < 2); |
|
1790 |
|
1791 # day |
|
1792 $f{"j"}=&Date_DayOfYear($m,$d,$y); |
|
1793 $f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3); |
|
1794 $_=$d; |
|
1795 s/^0/ /; |
|
1796 $f{"e"}=$_; |
|
1797 $f{"w"}=&Date_DayOfWeek($m,$d,$y); |
|
1798 $f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1]; |
|
1799 $f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2); |
|
1800 $f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1]; |
|
1801 $f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1]; |
|
1802 $f{"E"}=&Date_DaySuffix($f{"e"}); |
|
1803 |
|
1804 # hour |
|
1805 $_=$h; |
|
1806 s/^0/ /; |
|
1807 $f{"k"}=$_; |
|
1808 $f{"i"}=$f{"k"}+1; |
|
1809 $f{"i"}=$f{"k"}; |
|
1810 $f{"i"}=12 if ($f{"k"}==0); |
|
1811 $f{"i"}=$f{"k"}-12 if ($f{"k"}>12); |
|
1812 $f{"i"}=$f{"i"}-12 if ($f{"i"}>12); |
|
1813 $f{"i"}=" ".$f{"i"} if (length($f{"i"})<2); |
|
1814 $f{"I"}=$f{"i"}; |
|
1815 $f{"I"}=~ s/^ /0/; |
|
1816 $f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"}; |
|
1817 $f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11); |
|
1818 |
|
1819 # minute, second, timezone |
|
1820 $f{"o"}=&Date_SecsSince1970($m,$d,$y,$h,$mn,$s); |
|
1821 $f{"s"}=&Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s); |
|
1822 $f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ? |
|
1823 $Cnf{"TZ"} : $Cnf{"ConvTZ"}; |
|
1824 $f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || ""); |
|
1825 |
|
1826 # date, time |
|
1827 $f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|; |
|
1828 $f{"C"}=$f{"u"}= |
|
1829 qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|; |
|
1830 $f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|; |
|
1831 $f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|; |
|
1832 $f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|; |
|
1833 $f{"R"}=qq|$h:$mn|; |
|
1834 $f{"T"}=$f{"X"}=qq|$h:$mn:$s|; |
|
1835 $f{"V"}=qq|$m$d$h$mn$f{"y"}|; |
|
1836 $f{"Q"}="$y$m$d"; |
|
1837 $f{"q"}=qq|$y$m$d$h$mn$s|; |
|
1838 $f{"P"}=qq|$y$m$d$h:$mn:$s|; |
|
1839 $f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|; |
|
1840 if ($f{"W"}==0) { |
|
1841 $y--; |
|
1842 $tmp=&Date_WeekOfYear(12,31,$y,1); |
|
1843 $tmp="0$tmp" if (length($tmp) < 2); |
|
1844 $f{"J"}=qq|$y-W$tmp-$f{"w"}|; |
|
1845 } else { |
|
1846 $f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|; |
|
1847 } |
|
1848 $f{"K"}=qq|$y-$f{"j"}|; |
|
1849 # %l is a special case. Since it requires the use of the calculator |
|
1850 # which requires this routine, an infinite recursion results. To get |
|
1851 # around this, %l is NOT determined every time this is called so the |
|
1852 # recursion breaks. |
|
1853 |
|
1854 # other formats |
|
1855 $f{"n"}="\n"; |
|
1856 $f{"t"}="\t"; |
|
1857 $f{"%"}="%"; |
|
1858 $f{"+"}="+"; |
|
1859 |
|
1860 foreach $format (@format) { |
|
1861 $format=reverse($format); |
|
1862 $out=""; |
|
1863 while ($format ne "") { |
|
1864 $c=chop($format); |
|
1865 if ($c eq "%") { |
|
1866 $c=chop($format); |
|
1867 if ($c eq "l") { |
|
1868 &Date_Init(); |
|
1869 $date1=&DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0"); |
|
1870 $date2=&DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0"); |
|
1871 if (&Date_Cmp($date,$date1)>=0 && &Date_Cmp($date,$date2)<=0) { |
|
1872 $f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|; |
|
1873 } else { |
|
1874 $f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|; |
|
1875 } |
|
1876 $out .= $f{"$c"}; |
|
1877 } elsif (exists $f{"$c"}) { |
|
1878 $out .= $f{"$c"}; |
|
1879 } else { |
|
1880 $out .= $c; |
|
1881 } |
|
1882 } else { |
|
1883 $out .= $c; |
|
1884 } |
|
1885 } |
|
1886 push(@out,$out); |
|
1887 } |
|
1888 if ($scalar) { |
|
1889 return $out[0]; |
|
1890 } else { |
|
1891 return (@out); |
|
1892 } |
|
1893 } |
|
1894 |
|
1895 # Can't be in "use integer" because we're doing decimal arithmatic |
|
1896 no integer; |
|
1897 sub Delta_Format { |
|
1898 print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/); |
|
1899 my($delta,$dec,@format)=@_; |
|
1900 $delta=&ParseDateDelta($delta); |
|
1901 return "" if (! $delta); |
|
1902 my(@out,%f,$out,$c1,$c2,$scalar,$format)=(); |
|
1903 local($_)=$delta; |
|
1904 my($y,$M,$w,$d,$h,$m,$s)=&Delta_Split($delta); |
|
1905 # Get rid of positive signs. |
|
1906 ($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s); |
|
1907 |
|
1908 if (defined $dec && $dec>0) { |
|
1909 $dec="%." . ($dec*1) . "f"; |
|
1910 } else { |
|
1911 $dec="%f"; |
|
1912 } |
|
1913 |
|
1914 if (! wantarray) { |
|
1915 $format=join(" ",@format); |
|
1916 @format=($format); |
|
1917 $scalar=1; |
|
1918 } |
|
1919 |
|
1920 # Length of each unit in seconds |
|
1921 my($sl,$ml,$hl,$dl,$wl,$yl)=(); |
|
1922 $sl = 1; |
|
1923 $ml = $sl*60; |
|
1924 $hl = $ml*60; |
|
1925 $dl = $hl*24; |
|
1926 $wl = $dl*7; |
|
1927 $yl = $dl*365.25; |
|
1928 |
|
1929 # The decimal amount of each unit contained in all smaller units |
|
1930 my($yd,$Md,$sd,$md,$hd,$dd,$wd)=(); |
|
1931 if ($M) { |
|
1932 $yd = $M/12; |
|
1933 $Md = 0; |
|
1934 } else { |
|
1935 $yd = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl; |
|
1936 $Md = 0; |
|
1937 } |
|
1938 |
|
1939 $wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl; |
|
1940 $dd = ($h*$hl + $m*$ml + $s*$sl)/$dl; |
|
1941 $hd = ($m*$ml + $s*$sl)/$hl; |
|
1942 $md = ($s*$sl)/$ml; |
|
1943 $sd = 0; |
|
1944 |
|
1945 # The amount of each unit contained in higher units. |
|
1946 my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=(); |
|
1947 $yh = 0; |
|
1948 |
|
1949 if ($M) { |
|
1950 $Mh = ($yh+$y)*12; |
|
1951 $wh = 0; |
|
1952 $dh = ($wh+$w)*7; |
|
1953 } else { |
|
1954 $Mh = 0; |
|
1955 $wh = ($yh+$y)*365.25/7; |
|
1956 $dh = ($yh+$y)*365.25 + $w*7; |
|
1957 } |
|
1958 |
|
1959 $hh = ($dh+$d)*24; |
|
1960 $mh = ($hh+$h)*60; |
|
1961 $sh = ($mh+$m)*60; |
|
1962 |
|
1963 # Set up the formats |
|
1964 |
|
1965 $f{"yv"} = $y; |
|
1966 $f{"Mv"} = $M; |
|
1967 $f{"wv"} = $w; |
|
1968 $f{"dv"} = $d; |
|
1969 $f{"hv"} = $h; |
|
1970 $f{"mv"} = $m; |
|
1971 $f{"sv"} = $s; |
|
1972 |
|
1973 $f{"yh"} = $y+$yh; |
|
1974 $f{"Mh"} = $M+$Mh; |
|
1975 $f{"wh"} = $w+$wh; |
|
1976 $f{"dh"} = $d+$dh; |
|
1977 $f{"hh"} = $h+$hh; |
|
1978 $f{"mh"} = $m+$mh; |
|
1979 $f{"sh"} = $s+$sh; |
|
1980 |
|
1981 $f{"yd"} = sprintf($dec,$y+$yd); |
|
1982 $f{"Md"} = sprintf($dec,$M+$Md); |
|
1983 $f{"wd"} = sprintf($dec,$w+$wd); |
|
1984 $f{"dd"} = sprintf($dec,$d+$dd); |
|
1985 $f{"hd"} = sprintf($dec,$h+$hd); |
|
1986 $f{"md"} = sprintf($dec,$m+$md); |
|
1987 $f{"sd"} = sprintf($dec,$s+$sd); |
|
1988 |
|
1989 $f{"yt"} = sprintf($dec,$yh+$y+$yd); |
|
1990 $f{"Mt"} = sprintf($dec,$Mh+$M+$Md); |
|
1991 $f{"wt"} = sprintf($dec,$wh+$w+$wd); |
|
1992 $f{"dt"} = sprintf($dec,$dh+$d+$dd); |
|
1993 $f{"ht"} = sprintf($dec,$hh+$h+$hd); |
|
1994 $f{"mt"} = sprintf($dec,$mh+$m+$md); |
|
1995 $f{"st"} = sprintf($dec,$sh+$s+$sd); |
|
1996 |
|
1997 $f{"%"} = "%"; |
|
1998 |
|
1999 foreach $format (@format) { |
|
2000 $format=reverse($format); |
|
2001 $out=""; |
|
2002 PARSE: while ($format) { |
|
2003 $c1=chop($format); |
|
2004 if ($c1 eq "%") { |
|
2005 $c1=chop($format); |
|
2006 if (exists($f{$c1})) { |
|
2007 $out .= $f{$c1}; |
|
2008 next PARSE; |
|
2009 } |
|
2010 $c2=chop($format); |
|
2011 if (exists($f{"$c1$c2"})) { |
|
2012 $out .= $f{"$c1$c2"}; |
|
2013 next PARSE; |
|
2014 } |
|
2015 $out .= $c1; |
|
2016 $format .= $c2; |
|
2017 } else { |
|
2018 $out .= $c1; |
|
2019 } |
|
2020 } |
|
2021 push(@out,$out); |
|
2022 } |
|
2023 if ($scalar) { |
|
2024 return $out[0]; |
|
2025 } else { |
|
2026 return (@out); |
|
2027 } |
|
2028 } |
|
2029 use integer; |
|
2030 |
|
2031 sub ParseRecur { |
|
2032 print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/); |
|
2033 &Date_Init() if (! $Curr{"InitDone"}); |
|
2034 |
|
2035 my($recur,$dateb,$date0,$date1,$flag)=@_; |
|
2036 local($_)=$recur; |
|
2037 |
|
2038 my($recur_0,$recur_1,@recur0,@recur1)=(); |
|
2039 my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=(); |
|
2040 my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=(); |
|
2041 |
|
2042 # $date0, $date1, $dateb, $flag : passed in (these are always the final say |
|
2043 # in determining whether a date matches a |
|
2044 # recurrence IF they are present. |
|
2045 # $date_b, $date_0, $date_1 : if a value can be determined from the |
|
2046 # $flag_t recurrence, they are stored here. |
|
2047 # |
|
2048 # If values can be determined from the recurrence AND are passed in, the |
|
2049 # following are used: |
|
2050 # max($date0,$date_0) i.e. the later of the two dates |
|
2051 # min($date1,$date_1) i.e. the earlier of the two dates |
|
2052 # |
|
2053 # The base date that is used is the first one defined from |
|
2054 # $dateb $date_b |
|
2055 # The base date is only used if necessary (as determined by the recur). |
|
2056 # For example, "every other friday" requires a base date, but "2nd |
|
2057 # friday of every month" doesn't. |
|
2058 |
|
2059 my($date_b,$date_0,$date_1,$flag_t); |
|
2060 |
|
2061 # |
|
2062 # Check the arguments passed in. |
|
2063 # |
|
2064 |
|
2065 $date0="" if (! defined $date0); |
|
2066 $date1="" if (! defined $date1); |
|
2067 $dateb="" if (! defined $dateb); |
|
2068 $flag ="" if (! defined $flag); |
|
2069 |
|
2070 if ($dateb) { |
|
2071 $dateb=&ParseDateString($dateb); |
|
2072 return "" if (! $dateb); |
|
2073 } |
|
2074 if ($date0) { |
|
2075 $date0=&ParseDateString($date0); |
|
2076 return "" if (! $date0); |
|
2077 } |
|
2078 if ($date1) { |
|
2079 $date1=&ParseDateString($date1); |
|
2080 return "" if (! $date1); |
|
2081 } |
|
2082 |
|
2083 # |
|
2084 # Parse the recur. $date_b, $date_0, and $date_e are values obtained |
|
2085 # from the recur. |
|
2086 # |
|
2087 |
|
2088 @tmp=&Recur_Split($_); |
|
2089 |
|
2090 if (@tmp) { |
|
2091 ($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp; |
|
2092 $recur_0 = "" if (! defined $recur_0); |
|
2093 $recur_1 = "" if (! defined $recur_1); |
|
2094 $flag_t = "" if (! defined $flag_t); |
|
2095 $date_b = "" if (! defined $date_b); |
|
2096 $date_0 = "" if (! defined $date_0); |
|
2097 $date_1 = "" if (! defined $date_1); |
|
2098 |
|
2099 @recur0 = split(/:/,$recur_0); |
|
2100 @recur1 = split(/:/,$recur_1); |
|
2101 return "" if ($#recur0 + $#recur1 + 2 != 7); |
|
2102 |
|
2103 if ($date_b) { |
|
2104 $date_b=&ParseDateString($date_b); |
|
2105 return "" if (! $date_b); |
|
2106 } |
|
2107 if ($date_0) { |
|
2108 $date_0=&ParseDateString($date_0); |
|
2109 return "" if (! $date_0); |
|
2110 } |
|
2111 if ($date_1) { |
|
2112 $date_1=&ParseDateString($date_1); |
|
2113 return "" if (! $date_1); |
|
2114 } |
|
2115 |
|
2116 } else { |
|
2117 |
|
2118 my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...) |
|
2119 my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... } |
|
2120 my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...) |
|
2121 my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... } |
|
2122 my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days) |
|
2123 my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months) |
|
2124 my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks) |
|
2125 my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st) |
|
2126 my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} }; |
|
2127 # { 1st=>1,first=>1,...} |
|
2128 my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of) |
|
2129 my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last) |
|
2130 my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every) |
|
2131 |
|
2132 my($D)='\s*(\d+)'; |
|
2133 my($Y)='\s*(\d{4}|\d{2})'; |
|
2134 |
|
2135 # Change 1st to 1 |
|
2136 if (/(^|[^a-z])$daysexp($|[^a-z])/i) { |
|
2137 $tmp=lc($2); |
|
2138 $tmp=$dayshash{"$tmp"}; |
|
2139 s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i; |
|
2140 } |
|
2141 s/\s*$//; |
|
2142 |
|
2143 # Get rid of "each" |
|
2144 if (/(^|[^a-z])$each($|[^a-z])/i) { |
|
2145 s/(^|[^a-z])$each($|[^a-z])/$1 $2/i; |
|
2146 $each=1; |
|
2147 } else { |
|
2148 $each=0; |
|
2149 } |
|
2150 |
|
2151 if ($each) { |
|
2152 |
|
2153 if (/^$D?$day(?:$of$mmm?$Y)?$/i || |
|
2154 /^$D?$day(?:$of$mmm())?$/i) { |
|
2155 # every [2nd] day in [june] 1997 |
|
2156 # every [2nd] day [in june] |
|
2157 ($num,$m,$y)=($1,$2,$3); |
|
2158 $num=1 if (! defined $num); |
|
2159 $m="" if (! defined $m); |
|
2160 $y="" if (! defined $y); |
|
2161 |
|
2162 $y=$Curr{"Y"} if (! $y); |
|
2163 if ($m) { |
|
2164 $m=$mmm{lc($m)}; |
|
2165 $date_0=&Date_Join($y,$m,1,0,0,0); |
|
2166 $date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0); |
|
2167 } else { |
|
2168 $date_0=&Date_Join($y, 1,1,0,0,0); |
|
2169 $date_1=&Date_Join($y+1,1,1,0,0,0); |
|
2170 } |
|
2171 $date_b=&DateCalc($date_0,"-0:0:0:1:0:0:0",0); |
|
2172 @recur0=(0,0,0,$num,0,0,0); |
|
2173 @recur1=(); |
|
2174 |
|
2175 } elsif (/^$D$day?$of$month(?:$of?$Y)?$/) { |
|
2176 # 2nd [day] of every month [in 1997] |
|
2177 ($num,$y)=($1,$2); |
|
2178 $y=$Curr{"Y"} if (! $y); |
|
2179 |
|
2180 $date_0=&Date_Join($y, 1,1,0,0,0); |
|
2181 $date_1=&Date_Join($y+1,1,1,0,0,0); |
|
2182 $date_b=$date_0; |
|
2183 |
|
2184 @recur0=(0,1,0); |
|
2185 @recur1=($num,0,0,0); |
|
2186 |
|
2187 } elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ || |
|
2188 /^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) { |
|
2189 # 2nd tuesday of every month [in 1997] |
|
2190 # last tuesday of every month [in 1997] |
|
2191 ($num,$d,$y)=($1,$2,$3); |
|
2192 $y=$Curr{"Y"} if (! $y); |
|
2193 $d=$week{lc($d)}; |
|
2194 $num=-1 if ($num !~ /^$D$/); |
|
2195 |
|
2196 $date_0=&Date_Join($y,1,1,0,0,0); |
|
2197 $date_1=&Date_Join($y+1,1,1,0,0,0); |
|
2198 $date_b=$date_0; |
|
2199 |
|
2200 @recur0=(0,1); |
|
2201 @recur1=($num,$d,0,0,0); |
|
2202 |
|
2203 } elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i || |
|
2204 /^$D?$wkexp(?:$of$mmm())?$/i) { |
|
2205 # every tuesday in june 1997 |
|
2206 # every 2nd tuesday in june 1997 |
|
2207 ($num,$d,$m,$y)=($1,$2,$3,$4); |
|
2208 $y=$Curr{"Y"} if (! $y); |
|
2209 $num=1 if (! defined $num); |
|
2210 $m="" if (! defined $m); |
|
2211 $d=$week{lc($d)}; |
|
2212 |
|
2213 if ($m) { |
|
2214 $m=$mmm{lc($m)}; |
|
2215 $date_0=&Date_Join($y,$m,1,0,0,0); |
|
2216 $date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0); |
|
2217 } else { |
|
2218 $date_0=&Date_Join($y,1,1,0,0,0); |
|
2219 $date_1=&Date_Join($y+1,1,1,0,0,0); |
|
2220 } |
|
2221 $date_b=&DateCalc($date_0,"-0:0:0:1:0:0:0",0); |
|
2222 |
|
2223 @recur0=(0,0,$num); |
|
2224 @recur1=($d,0,0,0); |
|
2225 |
|
2226 } else { |
|
2227 return ""; |
|
2228 } |
|
2229 |
|
2230 $date_0="" if ($date0); |
|
2231 $date_1="" if ($date1); |
|
2232 } else { |
|
2233 return ""; |
|
2234 } |
|
2235 } |
|
2236 |
|
2237 # |
|
2238 # Override with any values passed in |
|
2239 # |
|
2240 |
|
2241 if ($date0 && $date_0) { |
|
2242 $date0=( &Date_Cmp($date0,$date_0) > 1 ? $date0 : $date_0); |
|
2243 } elsif ($date_0) { |
|
2244 $date0 = $date_0; |
|
2245 } |
|
2246 |
|
2247 if ($date1 && $date_1) { |
|
2248 $date1=( &Date_Cmp($date1,$date_1) > 1 ? $date_1 : $date1); |
|
2249 } elsif ($date_1) { |
|
2250 $date1 = $date_1; |
|
2251 } |
|
2252 |
|
2253 $dateb=$date_b if (! $dateb); |
|
2254 |
|
2255 if ($flag =~ s/^\+//) { |
|
2256 if ($flag_t) { |
|
2257 $flag="$flag_t,$flag"; |
|
2258 } |
|
2259 } |
|
2260 $flag =$flag_t if (! $flag && $flag_t); |
|
2261 |
|
2262 if (! wantarray) { |
|
2263 $tmp = join(":",@recur0); |
|
2264 $tmp .= "*" . join(":",@recur1) if (@recur1); |
|
2265 $tmp .= "*$flag*$dateb*$date0*$date1"; |
|
2266 return $tmp; |
|
2267 } |
|
2268 if (@recur0) { |
|
2269 return () if (! $date0 || ! $date1); # dateb is NOT required in all case |
|
2270 } |
|
2271 |
|
2272 # |
|
2273 # Some flags affect parsing. |
|
2274 # |
|
2275 |
|
2276 @flags = split(/,/,$flag); |
|
2277 my($MDn) = 0; |
|
2278 my($MWn) = 7; |
|
2279 my($f); |
|
2280 foreach $f (@flags) { |
|
2281 if ($f =~ /^MW([1-7])$/i) { |
|
2282 $MWn=$1; |
|
2283 $MDn=0; |
|
2284 |
|
2285 } elsif ($f =~ /^MD([1-7])$/i) { |
|
2286 $MDn=$1; |
|
2287 $MWn=0; |
|
2288 |
|
2289 } elsif ($f =~ /^EASTER$/i) { |
|
2290 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1); |
|
2291 # We want something that will return Jan 1 for the given years. |
|
2292 if ($#recur0==-1) { |
|
2293 @recur1=($y,1,0,1,$h,$mn,$s); |
|
2294 } elsif ($#recur0<=3) { |
|
2295 @recur0=($y,0,0,0); |
|
2296 @recur1=($h,$mn,$s); |
|
2297 } elsif ($#recur0==4) { |
|
2298 @recur0=($y,0,0,0,0); |
|
2299 @recur1=($mn,$s); |
|
2300 } elsif ($#recur0==5) { |
|
2301 @recur0=($y,0,0,0,0,0); |
|
2302 @recur1=($s); |
|
2303 } else { |
|
2304 @recur0=($y,0,0,0,0,0,0); |
|
2305 } |
|
2306 } |
|
2307 } |
|
2308 |
|
2309 # |
|
2310 # Determine the dates referenced by the recur. Also, fix the base date |
|
2311 # as necessary for the recurrences which require it. |
|
2312 # |
|
2313 |
|
2314 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1); |
|
2315 @y=@m=@w=@d=(); |
|
2316 my(@time)=($h,$mn,$s); |
|
2317 |
|
2318 RECUR: while (1) { |
|
2319 |
|
2320 if ($#recur0==-1) { |
|
2321 # * Y-M-W-D-H-MN-S |
|
2322 if ($y eq "0") { |
|
2323 push(@recur0,0); |
|
2324 shift(@recur1); |
|
2325 |
|
2326 } else { |
|
2327 @y=&ReturnList($y); |
|
2328 foreach $y (@y) { |
|
2329 $y=&Date_FixYear($y) if (length($y)==2); |
|
2330 return () if (length($y)!=4 || ! &IsInt($y)); |
|
2331 } |
|
2332 @y=sort { $a<=>$b } @y; |
|
2333 |
|
2334 $date0=&ParseDate("0000-01-01") if (! $date0); |
|
2335 $date1=&ParseDate("9999-12-31 23:59:59") if (! $date1); |
|
2336 |
|
2337 if ($m eq "0" and $w eq "0") { |
|
2338 # * Y-0-0-0-H-MN-S |
|
2339 # * Y-0-0-DOY-H-MN-S |
|
2340 if ($d eq "0") { |
|
2341 @d=(1); |
|
2342 } else { |
|
2343 @d=&ReturnList($d); |
|
2344 return () if (! @d); |
|
2345 foreach $d (@d) { |
|
2346 return () if (! &IsInt($d,1,366)); |
|
2347 } |
|
2348 @d=sort { $a<=>$b } (@d); |
|
2349 } |
|
2350 |
|
2351 @date=(); |
|
2352 foreach $yy (@y) { |
|
2353 foreach $d (@d) { |
|
2354 ($y,$m,$dd)=&Date_NthDayOfYear($yy,$d); |
|
2355 push(@date, &Date_Join($y,$m,$dd,0,0,0)); |
|
2356 } |
|
2357 } |
|
2358 last RECUR; |
|
2359 |
|
2360 } elsif ($w eq "0") { |
|
2361 # * Y-M-0-0-H-MN-S |
|
2362 # * Y-M-0-DOM-H-MN-S |
|
2363 |
|
2364 @m=&ReturnList($m); |
|
2365 return () if (! @m); |
|
2366 foreach $m (@m) { |
|
2367 return () if (! &IsInt($m,1,12)); |
|
2368 } |
|
2369 @m=sort { $a<=>$b } (@m); |
|
2370 |
|
2371 if ($d eq "0") { |
|
2372 @d=(1); |
|
2373 } else { |
|
2374 @d=&ReturnList($d); |
|
2375 return () if (! @d); |
|
2376 foreach $d (@d) { |
|
2377 return () if (! &IsInt($d,1,31)); |
|
2378 } |
|
2379 @d=sort { $a<=>$b } (@d); |
|
2380 } |
|
2381 |
|
2382 @date=(); |
|
2383 foreach $y (@y) { |
|
2384 foreach $m (@m) { |
|
2385 foreach $d (@d) { |
|
2386 $date=&Date_Join($y,$m,$d,0,0,0); |
|
2387 push(@date,$date) if ($d<29 || &Date_Split($date)); |
|
2388 } |
|
2389 } |
|
2390 } |
|
2391 last RECUR; |
|
2392 |
|
2393 } elsif ($m eq "0") { |
|
2394 # * Y-0-WOY-DOW-H-MN-S |
|
2395 # * Y-0-WOY-0-H-MN-S |
|
2396 @w=&ReturnList($w); |
|
2397 return () if (! @w); |
|
2398 foreach $w (@w) { |
|
2399 return () if (! &IsInt($w,1,53)); |
|
2400 } |
|
2401 |
|
2402 if ($d eq "0") { |
|
2403 @d=($Cnf{"FirstDay"}); |
|
2404 } else { |
|
2405 @d=&ReturnList($d); |
|
2406 return () if (! @d); |
|
2407 foreach $d (@d) { |
|
2408 return () if (! &IsInt($d,1,7)); |
|
2409 } |
|
2410 @d=sort { $a<=>$b } (@d); |
|
2411 } |
|
2412 |
|
2413 @date=(); |
|
2414 foreach $y (@y) { |
|
2415 foreach $w (@w) { |
|
2416 $w="0$w" if (length($w)==1); |
|
2417 foreach $d (@d) { |
|
2418 $date=&ParseDateString("$y-W$w-$d"); |
|
2419 push(@date,$date); |
|
2420 } |
|
2421 } |
|
2422 } |
|
2423 last RECUR; |
|
2424 |
|
2425 } else { |
|
2426 # * Y-M-WOM-DOW-H-MN-S |
|
2427 # * Y-M-WOM-0-H-MN-S |
|
2428 |
|
2429 @m=&ReturnList($m); |
|
2430 return () if (! @m); |
|
2431 foreach $m (@m) { |
|
2432 return () if (! &IsInt($m,1,12)); |
|
2433 } |
|
2434 @m=sort { $a<=>$b } (@m); |
|
2435 |
|
2436 @w=&ReturnList($w); |
|
2437 |
|
2438 if ($d eq "0") { |
|
2439 @d=(); |
|
2440 } else { |
|
2441 @d=&ReturnList($d); |
|
2442 } |
|
2443 |
|
2444 @date=&Date_Recur_WoM(\@y,\@m,\@w,\@d,$MWn,$MDn); |
|
2445 last RECUR; |
|
2446 } |
|
2447 } |
|
2448 } |
|
2449 |
|
2450 if ($#recur0==0) { |
|
2451 # Y * M-W-D-H-MN-S |
|
2452 $n=$y; |
|
2453 $n=1 if ($n==0); |
|
2454 |
|
2455 @m=&ReturnList($m); |
|
2456 return () if (! @m); |
|
2457 foreach $m (@m) { |
|
2458 return () if (! &IsInt($m,1,12)); |
|
2459 } |
|
2460 @m=sort { $a<=>$b } (@m); |
|
2461 |
|
2462 if ($m eq "0") { |
|
2463 # Y * 0-W-D-H-MN-S (equiv to Y-0 * W-D-H-MN-S) |
|
2464 push(@recur0,0); |
|
2465 shift(@recur1); |
|
2466 |
|
2467 } elsif ($w eq "0") { |
|
2468 # Y * M-0-DOM-H-MN-S |
|
2469 return () if (! $dateb); |
|
2470 $d=1 if ($d eq "0"); |
|
2471 |
|
2472 @d=&ReturnList($d); |
|
2473 return () if (! @d); |
|
2474 foreach $d (@d) { |
|
2475 return () if (! &IsInt($d,1,31)); |
|
2476 } |
|
2477 @d=sort { $a<=>$b } (@d); |
|
2478 |
|
2479 # We need to find years that are a multiple of $n from $y(base) |
|
2480 ($y0)=( &Date_Split($date0, 1) )[0]; |
|
2481 ($y1)=( &Date_Split($date1, 1) )[0]; |
|
2482 ($yb)=( &Date_Split($dateb, 1) )[0]; |
|
2483 @date=(); |
|
2484 for ($yy=$y0; $yy<=$y1; $yy++) { |
|
2485 if (($yy-$yb)%$n == 0) { |
|
2486 foreach $m (@m) { |
|
2487 foreach $d (@d) { |
|
2488 $date=&Date_Join($yy,$m,$d,0,0,0); |
|
2489 push(@date,$date) if ($d<29 || &Date_Split($date)); |
|
2490 } |
|
2491 } |
|
2492 } |
|
2493 } |
|
2494 last RECUR; |
|
2495 |
|
2496 } else { |
|
2497 # Y * M-WOM-DOW-H-MN-S |
|
2498 # Y * M-WOM-0-H-MN-S |
|
2499 return () if (! $dateb); |
|
2500 @m=&ReturnList($m); |
|
2501 @w=&ReturnList($w); |
|
2502 if ($d eq "0") { |
|
2503 @d=(); |
|
2504 } else { |
|
2505 @d=&ReturnList($d); |
|
2506 } |
|
2507 |
|
2508 ($y0)=( &Date_Split($date0, 1) )[0]; |
|
2509 ($y1)=( &Date_Split($date1, 1) )[0]; |
|
2510 ($yb)=( &Date_Split($dateb, 1) )[0]; |
|
2511 @y=(); |
|
2512 for ($yy=$y0; $yy<=$y1; $yy++) { |
|
2513 if (($yy-$yb)%$n == 0) { |
|
2514 push(@y,$yy); |
|
2515 } |
|
2516 } |
|
2517 |
|
2518 @date=&Date_Recur_WoM(\@y,\@m,\@w,\@d,$MWn,$MDn); |
|
2519 last RECUR; |
|
2520 } |
|
2521 } |
|
2522 |
|
2523 if ($#recur0==1) { |
|
2524 # Y-M * W-D-H-MN-S |
|
2525 |
|
2526 if ($w eq "0") { |
|
2527 # Y-M * 0-D-H-MN-S (equiv to Y-M-0 * D-H-MN-S) |
|
2528 push(@recur0,0); |
|
2529 shift(@recur1); |
|
2530 |
|
2531 } elsif ($m==0) { |
|
2532 # Y-0 * WOY-0-H-MN-S |
|
2533 # Y-0 * WOY-DOW-H-MN-S |
|
2534 return () if (! $dateb); |
|
2535 $n=$y; |
|
2536 $n=1 if ($n==0); |
|
2537 |
|
2538 @w=&ReturnList($w); |
|
2539 return () if (! @w); |
|
2540 foreach $w (@w) { |
|
2541 return () if (! &IsInt($w,1,53)); |
|
2542 } |
|
2543 |
|
2544 if ($d eq "0") { |
|
2545 @d=($Cnf{"FirstDay"}); |
|
2546 } else { |
|
2547 @d=&ReturnList($d); |
|
2548 return () if (! @d); |
|
2549 foreach $d (@d) { |
|
2550 return () if (! &IsInt($d,1,7)); |
|
2551 } |
|
2552 @d=sort { $a<=>$b } (@d); |
|
2553 } |
|
2554 |
|
2555 # We need to find years that are a multiple of $n from $y(base) |
|
2556 ($y0)=( &Date_Split($date0, 1) )[0]; |
|
2557 ($y1)=( &Date_Split($date1, 1) )[0]; |
|
2558 ($yb)=( &Date_Split($dateb, 1) )[0]; |
|
2559 @date=(); |
|
2560 for ($yy=$y0; $yy<=$y1; $yy++) { |
|
2561 if (($yy-$yb)%$n == 0) { |
|
2562 foreach $w (@w) { |
|
2563 $w="0$w" if (length($w)==1); |
|
2564 foreach $tmp (@d) { |
|
2565 $date=&ParseDateString("$yy-W$w-$tmp"); |
|
2566 push(@date,$date); |
|
2567 } |
|
2568 } |
|
2569 } |
|
2570 } |
|
2571 last RECUR; |
|
2572 |
|
2573 } else { |
|
2574 # Y-M * WOM-0-H-MN-S |
|
2575 # Y-M * WOM-DOW-H-MN-S |
|
2576 return () if (! $dateb); |
|
2577 @tmp=(@recur0); |
|
2578 push(@tmp,0) while ($#tmp<6); |
|
2579 $delta=join(":",@tmp); |
|
2580 @tmp=&Date_Recur($date0,$date1,$dateb,$delta); |
|
2581 |
|
2582 @w=&ReturnList($w); |
|
2583 @m=(); |
|
2584 if ($d eq "0") { |
|
2585 @d=(); |
|
2586 } else { |
|
2587 @d=&ReturnList($d); |
|
2588 } |
|
2589 |
|
2590 @date=&Date_Recur_WoM(\@tmp,\@m,\@w,\@d,$MWn,$MDn); |
|
2591 last RECUR; |
|
2592 } |
|
2593 } |
|
2594 |
|
2595 if ($#recur0==2) { |
|
2596 # Y-M-W * D-H-MN-S |
|
2597 |
|
2598 if ($d eq "0") { |
|
2599 # Y-M-W * 0-H-MN-S |
|
2600 return () if (! $dateb); |
|
2601 $y=1 if ($y==0 && $m==0 && $w==0); |
|
2602 $delta="$y:$m:$w:0:0:0:0"; |
|
2603 @date=&Date_Recur($date0,$date1,$dateb,$delta); |
|
2604 last RECUR; |
|
2605 |
|
2606 } elsif ($m==0 && $w==0) { |
|
2607 # Y-0-0 * DOY-H-MN-S |
|
2608 $y=1 if ($y==0); |
|
2609 $n=$y; |
|
2610 return () if (! $dateb && $y!=1); |
|
2611 |
|
2612 @d=&ReturnList($d); |
|
2613 return () if (! @d); |
|
2614 foreach $d (@d) { |
|
2615 return () if (! &IsInt($d,1,366)); |
|
2616 } |
|
2617 @d=sort { $a<=>$b } (@d); |
|
2618 |
|
2619 # We need to find years that are a multiple of $n from $y(base) |
|
2620 ($y0)=( &Date_Split($date0, 1) )[0]; |
|
2621 ($y1)=( &Date_Split($date1, 1) )[0]; |
|
2622 ($yb)=( &Date_Split($dateb, 1) )[0]; |
|
2623 @date=(); |
|
2624 for ($yy=$y0; $yy<=$y1; $yy++) { |
|
2625 if (($yy-$yb)%$n == 0) { |
|
2626 foreach $d (@d) { |
|
2627 ($y,$m,$dd)=&Date_NthDayOfYear($yy,$d); |
|
2628 push(@date, &Date_Join($y,$m,$dd,0,0,0)); |
|
2629 } |
|
2630 } |
|
2631 } |
|
2632 last RECUR; |
|
2633 |
|
2634 } elsif ($w>0) { |
|
2635 # Y-M-W * DOW-H-MN-S |
|
2636 return () if (! $dateb); |
|
2637 @tmp=(@recur0); |
|
2638 push(@tmp,0) while ($#tmp<6); |
|
2639 $delta=join(":",@tmp); |
|
2640 |
|
2641 @d=&ReturnList($d); |
|
2642 return () if (! @d); |
|
2643 foreach $d (@d) { |
|
2644 return () if (! &IsInt($d,1,7)); |
|
2645 } |
|
2646 |
|
2647 # Find out what DofW the basedate is. |
|
2648 @tmp2=&Date_Split($dateb, 1); |
|
2649 $tmp=&Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]); |
|
2650 |
|
2651 @date=(); |
|
2652 foreach $d (@d) { |
|
2653 $date_b=$dateb; |
|
2654 # Move basedate to DOW |
|
2655 if ($d != $tmp) { |
|
2656 if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) || |
|
2657 ($tmp>=$Cnf{"FirstDay"} && $d>$tmp) || |
|
2658 ($tmp<$d && $d<$Cnf{"FirstDay"})) { |
|
2659 $date_b=&Date_GetNext($date_b,$d); |
|
2660 } else { |
|
2661 $date_b=&Date_GetPrev($date_b,$d); |
|
2662 } |
|
2663 } |
|
2664 push(@date,&Date_Recur($date0,$date1,$date_b,$delta)); |
|
2665 } |
|
2666 @date=sort(@date); |
|
2667 last RECUR; |
|
2668 |
|
2669 } elsif ($m>0) { |
|
2670 # Y-M-0 * DOM-H-MN-S |
|
2671 return () if (! $dateb); |
|
2672 @tmp=(@recur0); |
|
2673 push(@tmp,0) while ($#tmp<6); |
|
2674 $delta=join(":",@tmp); |
|
2675 |
|
2676 @d=&ReturnList($d); |
|
2677 return () if (! @d); |
|
2678 foreach $d (@d) { |
|
2679 return () if (! &IsInt($d,-31,31) || $d==0); |
|
2680 } |
|
2681 @d=sort { $a<=>$b } (@d); |
|
2682 |
|
2683 @tmp2=&Date_Recur($date0,$date1,$dateb,$delta); |
|
2684 @date=(); |
|
2685 foreach $date (@tmp2) { |
|
2686 ($y,$m)=( &Date_Split($date, 1) )[0..1]; |
|
2687 $tmp2=&Date_DaysInMonth($m,$y); |
|
2688 foreach $d (@d) { |
|
2689 $d2=$d; |
|
2690 $d2=$tmp2+1+$d if ($d<0); |
|
2691 push(@date,&Date_Join($y,$m,$d2,0,0,0)) if ($d2<=$tmp2); |
|
2692 } |
|
2693 } |
|
2694 @date=sort (@date); |
|
2695 last RECUR; |
|
2696 |
|
2697 } else { |
|
2698 return (); |
|
2699 } |
|
2700 } |
|
2701 |
|
2702 if ($#recur0>2) { |
|
2703 # Y-M-W-D * H-MN-S |
|
2704 # Y-M-W-D-H * MN-S |
|
2705 # Y-M-W-D-H-MN * S |
|
2706 # Y-M-W-D-H-S |
|
2707 return () if (! $dateb); |
|
2708 @tmp=(@recur0); |
|
2709 push(@tmp,0) while ($#tmp<6); |
|
2710 $delta=join(":",@tmp); |
|
2711 return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0" |
|
2712 @date=&Date_Recur($date0,$date1,$dateb,$delta); |
|
2713 if (@recur1) { |
|
2714 unshift(@recur1,-1) while ($#recur1<2); |
|
2715 @time=@recur1; |
|
2716 } else { |
|
2717 shift(@date); |
|
2718 pop(@date); |
|
2719 @time=(); |
|
2720 } |
|
2721 } |
|
2722 |
|
2723 last RECUR; |
|
2724 } |
|
2725 @date=&Date_RecurSetTime($date0,$date1,\@date,@time) if (@time); |
|
2726 |
|
2727 # |
|
2728 # We've got a list of dates. Operate on them with the flags. |
|
2729 # |
|
2730 |
|
2731 my($sign,$forw,$today,$df,$db,$work,$i); |
|
2732 if (@flags) { |
|
2733 FLAG: foreach $f (@flags) { |
|
2734 $f = uc($f); |
|
2735 |
|
2736 if ($f =~ /^(P|N)(D|T)([1-7])$/) { |
|
2737 @tmp=($1,$2,$3); |
|
2738 $forw =($tmp[0] eq "P" ? 0 : 1); |
|
2739 $today=($tmp[1] eq "D" ? 0 : 1); |
|
2740 $d=$tmp[2]; |
|
2741 @tmp=(); |
|
2742 foreach $date (@date) { |
|
2743 if ($forw) { |
|
2744 push(@tmp, &Date_GetNext($date,$d,$today)); |
|
2745 } else { |
|
2746 push(@tmp, &Date_GetPrev($date,$d,$today)); |
|
2747 } |
|
2748 } |
|
2749 @date=@tmp; |
|
2750 next FLAG; |
|
2751 } |
|
2752 |
|
2753 # We want to go forward exact amounts of time instead of |
|
2754 # business mode calculations so that we don't change the time |
|
2755 # (which may have been set in the recur). |
|
2756 if ($f =~ /^(F|B)(D|W)(\d+)$/) { |
|
2757 @tmp=($1,$2,$3); |
|
2758 $sign="+"; |
|
2759 $sign="-" if ($tmp[0] eq "B"); |
|
2760 $work=0; |
|
2761 $work=1 if ($tmp[1] eq "W"); |
|
2762 $n=$tmp[2]; |
|
2763 @tmp=(); |
|
2764 foreach $date (@date) { |
|
2765 for ($i=1; $i<=$n; $i++) { |
|
2766 while (1) { |
|
2767 $date=&DateCalc($date,"${sign}0:0:0:1:0:0:0"); |
|
2768 last if (! $work || &Date_IsWorkDay($date,0)); |
|
2769 } |
|
2770 } |
|
2771 push(@tmp,$date); |
|
2772 } |
|
2773 @date=@tmp; |
|
2774 next FLAG; |
|
2775 } |
|
2776 |
|
2777 if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) { |
|
2778 $tmp=$1; |
|
2779 my $noalt = $2 ? 1 : 0; |
|
2780 if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) { |
|
2781 $forw=1; |
|
2782 } else { |
|
2783 $forw=0; |
|
2784 } |
|
2785 |
|
2786 @tmp=(); |
|
2787 DATE: foreach $date (@date) { |
|
2788 $df=$db=$date; |
|
2789 if (&Date_IsWorkDay($date)) { |
|
2790 push(@tmp,$date); |
|
2791 next DATE; |
|
2792 } |
|
2793 while (1) { |
|
2794 if ($forw) { |
|
2795 $d=$df=&DateCalc($df,"+0:0:0:1:0:0:0"); |
|
2796 } else { |
|
2797 $d=$db=&DateCalc($db,"-0:0:0:1:0:0:0"); |
|
2798 } |
|
2799 if (&Date_IsWorkDay($d)) { |
|
2800 push(@tmp,$d); |
|
2801 next DATE; |
|
2802 } |
|
2803 $forw=1-$forw if (! $noalt); |
|
2804 } |
|
2805 } |
|
2806 @date=@tmp; |
|
2807 next FLAG; |
|
2808 } |
|
2809 |
|
2810 if ($f eq "EASTER") { |
|
2811 @tmp=(); |
|
2812 foreach $date (@date) { |
|
2813 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1); |
|
2814 ($m,$d)=&Date_Easter($y); |
|
2815 $date=&Date_Join($y,$m,$d,$h,$mn,$s); |
|
2816 next if (&Date_Cmp($date,$date0)<0 || |
|
2817 &Date_Cmp($date,$date1)>0); |
|
2818 push(@tmp,$date); |
|
2819 } |
|
2820 @date=@tmp; |
|
2821 } |
|
2822 } |
|
2823 @date = sort(@date); |
|
2824 } |
|
2825 @date; |
|
2826 } |
|
2827 |
|
2828 sub Date_GetPrev { |
|
2829 print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/); |
|
2830 my($date,$dow,$today,$hr,$min,$sec)=@_; |
|
2831 &Date_Init() if (! $Curr{"InitDone"}); |
|
2832 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts, |
|
2833 $adjust,$curr)=(); |
|
2834 $hr="00" if (defined $hr && $hr eq "0"); |
|
2835 $min="00" if (defined $min && $min eq "0"); |
|
2836 $sec="00" if (defined $sec && $sec eq "0"); |
|
2837 |
|
2838 if (! &Date_Split($date)) { |
|
2839 $date=&ParseDateString($date); |
|
2840 return "" if (! $date); |
|
2841 } |
|
2842 $curr=$date; |
|
2843 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2]; |
|
2844 |
|
2845 if ($dow) { |
|
2846 $curr_dow=&Date_DayOfWeek($m,$d,$y); |
|
2847 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; |
|
2848 if (&IsInt($dow)) { |
|
2849 return "" if ($dow<1 || $dow>7); |
|
2850 } else { |
|
2851 return "" if (! exists $dow{lc($dow)}); |
|
2852 $dow=$dow{lc($dow)}; |
|
2853 } |
|
2854 if ($dow == $curr_dow) { |
|
2855 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today); |
|
2856 $adjust=1 if ($today==2); |
|
2857 } else { |
|
2858 $dow -= 7 if ($dow>$curr_dow); # make sure previous day is less |
|
2859 $num = $curr_dow - $dow; |
|
2860 $date=&DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0); |
|
2861 } |
|
2862 $date=&Date_SetTime($date,$hr,$min,$sec) if (defined $hr); |
|
2863 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) |
|
2864 if ($adjust && &Date_Cmp($date,$curr)>0); |
|
2865 |
|
2866 } else { |
|
2867 ($h,$mn,$s)=( &Date_Split($date, 1) )[3..5]; |
|
2868 ($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec); |
|
2869 if ($hr) { |
|
2870 ($hr,$min,$sec)=($th,$tm,$ts); |
|
2871 $delta="-0:0:0:1:0:0:0"; |
|
2872 } elsif ($min) { |
|
2873 ($hr,$min,$sec)=($h,$tm,$ts); |
|
2874 $delta="-0:0:0:0:1:0:0"; |
|
2875 } elsif ($sec) { |
|
2876 ($hr,$min,$sec)=($h,$mn,$ts); |
|
2877 $delta="-0:0:0:0:0:1:0"; |
|
2878 } else { |
|
2879 confess "ERROR: invalid arguments in Date_GetPrev.\n"; |
|
2880 } |
|
2881 |
|
2882 $d=&Date_SetTime($date,$hr,$min,$sec); |
|
2883 if ($today) { |
|
2884 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>0); |
|
2885 } else { |
|
2886 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>=0); |
|
2887 } |
|
2888 $date=$d; |
|
2889 } |
|
2890 return $date; |
|
2891 } |
|
2892 |
|
2893 sub Date_GetNext { |
|
2894 print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/); |
|
2895 my($date,$dow,$today,$hr,$min,$sec)=@_; |
|
2896 &Date_Init() if (! $Curr{"InitDone"}); |
|
2897 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts, |
|
2898 $adjust,$curr)=(); |
|
2899 $hr="00" if (defined $hr && $hr eq "0"); |
|
2900 $min="00" if (defined $min && $min eq "0"); |
|
2901 $sec="00" if (defined $sec && $sec eq "0"); |
|
2902 |
|
2903 if (! &Date_Split($date)) { |
|
2904 $date=&ParseDateString($date); |
|
2905 return "" if (! $date); |
|
2906 } |
|
2907 $curr=$date; |
|
2908 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2]; |
|
2909 |
|
2910 if ($dow) { |
|
2911 $curr_dow=&Date_DayOfWeek($m,$d,$y); |
|
2912 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; |
|
2913 if (&IsInt($dow)) { |
|
2914 return "" if ($dow<1 || $dow>7); |
|
2915 } else { |
|
2916 return "" if (! exists $dow{lc($dow)}); |
|
2917 $dow=$dow{lc($dow)}; |
|
2918 } |
|
2919 if ($dow == $curr_dow) { |
|
2920 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today); |
|
2921 $adjust=1 if ($today==2); |
|
2922 } else { |
|
2923 $curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater |
|
2924 $num = $dow - $curr_dow; |
|
2925 $date=&DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0); |
|
2926 } |
|
2927 $date=&Date_SetTime($date,$hr,$min,$sec) if (defined $hr); |
|
2928 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) |
|
2929 if ($adjust && &Date_Cmp($date,$curr)<0); |
|
2930 |
|
2931 } else { |
|
2932 ($h,$mn,$s)=( &Date_Split($date, 1) )[3..5]; |
|
2933 ($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec); |
|
2934 if ($hr) { |
|
2935 ($hr,$min,$sec)=($th,$tm,$ts); |
|
2936 $delta="+0:0:0:1:0:0:0"; |
|
2937 } elsif ($min) { |
|
2938 ($hr,$min,$sec)=($h,$tm,$ts); |
|
2939 $delta="+0:0:0:0:1:0:0"; |
|
2940 } elsif ($sec) { |
|
2941 ($hr,$min,$sec)=($h,$mn,$ts); |
|
2942 $delta="+0:0:0:0:0:1:0"; |
|
2943 } else { |
|
2944 confess "ERROR: invalid arguments in Date_GetNext.\n"; |
|
2945 } |
|
2946 |
|
2947 $d=&Date_SetTime($date,$hr,$min,$sec); |
|
2948 if ($today) { |
|
2949 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<0); |
|
2950 } else { |
|
2951 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<1); |
|
2952 } |
|
2953 $date=$d; |
|
2954 } |
|
2955 |
|
2956 return $date; |
|
2957 } |
|
2958 |
|
2959 sub Date_IsHoliday { |
|
2960 print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/); |
|
2961 my($date)=@_; |
|
2962 &Date_Init() if (! $Curr{"InitDone"}); |
|
2963 $date=&ParseDateString($date); |
|
2964 return undef if (! $date); |
|
2965 $date=&Date_SetTime($date,0,0,0); |
|
2966 my($y)=(&Date_Split($date, 1))[0]; |
|
2967 &Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y}); |
|
2968 return undef if (! exists $Holiday{"dates"}{$y}{$date}); |
|
2969 my($name)=$Holiday{"dates"}{$y}{$date}; |
|
2970 return "" if (! $name); |
|
2971 $name; |
|
2972 } |
|
2973 |
|
2974 sub Events_List { |
|
2975 print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/); |
|
2976 my(@args)=@_; |
|
2977 &Date_Init() if (! $Curr{"InitDone"}); |
|
2978 &Events_ParseRaw(); |
|
2979 |
|
2980 my($tmp,$date0,$date1,$flag); |
|
2981 $date0=&ParseDateString($args[0]); |
|
2982 warn "Invalid date $args[0]", return undef if (! $date0); |
|
2983 |
|
2984 if ($#args == 0) { |
|
2985 return &Events_Calc($date0); |
|
2986 } |
|
2987 |
|
2988 if ($args[1]) { |
|
2989 $date1=&ParseDateString($args[1]); |
|
2990 warn "Invalid date $args[1]\n", return undef if (! $date1); |
|
2991 if (&Date_Cmp($date0,$date1)>0) { |
|
2992 $tmp=$date1; |
|
2993 $date1=$date0; |
|
2994 $date0=$tmp; |
|
2995 } |
|
2996 } else { |
|
2997 $date0=&Date_SetTime($date0,"00:00:00"); |
|
2998 $date1=&DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0"); |
|
2999 } |
|
3000 |
|
3001 $tmp=&Events_Calc($date0,$date1); |
|
3002 |
|
3003 $flag=$args[2]; |
|
3004 return $tmp if (! $flag); |
|
3005 |
|
3006 my(@tmp,%ret,$delta)=(); |
|
3007 @tmp=@$tmp; |
|
3008 push(@tmp,$date1); |
|
3009 |
|
3010 if ($flag==1) { |
|
3011 while ($#tmp>0) { |
|
3012 ($date0,$tmp)=splice(@tmp,0,2); |
|
3013 $date1=$tmp[0]; |
|
3014 $delta=&DateCalc_DateDate($date0,$date1); |
|
3015 foreach $flag (@$tmp) { |
|
3016 if (exists $ret{$flag}) { |
|
3017 $ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta); |
|
3018 } else { |
|
3019 $ret{$flag}=$delta; |
|
3020 } |
|
3021 } |
|
3022 } |
|
3023 return \%ret; |
|
3024 |
|
3025 } elsif ($flag==2) { |
|
3026 while ($#tmp>0) { |
|
3027 ($date0,$tmp)=splice(@tmp,0,2); |
|
3028 $date1=$tmp[0]; |
|
3029 $delta=&DateCalc_DateDate($date0,$date1); |
|
3030 $flag=join("+",sort @$tmp); |
|
3031 next if (! $flag); |
|
3032 if (exists $ret{$flag}) { |
|
3033 $ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta); |
|
3034 } else { |
|
3035 $ret{$flag}=$delta; |
|
3036 } |
|
3037 } |
|
3038 return \%ret; |
|
3039 } |
|
3040 |
|
3041 warn "Invalid flag $flag\n"; |
|
3042 return undef; |
|
3043 } |
|
3044 |
|
3045 ### |
|
3046 # NOTE: The following routines may be called in the routines below with very |
|
3047 # little time penalty. |
|
3048 ### |
|
3049 sub Date_SetTime { |
|
3050 print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/); |
|
3051 my($date,$h,$mn,$s)=@_; |
|
3052 &Date_Init() if (! $Curr{"InitDone"}); |
|
3053 my($y,$m,$d)=(); |
|
3054 |
|
3055 if (! &Date_Split($date)) { |
|
3056 $date=&ParseDateString($date); |
|
3057 return "" if (! $date); |
|
3058 } |
|
3059 |
|
3060 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2]; |
|
3061 ($h,$mn,$s)=&Date_ParseTime($h,$mn,$s); |
|
3062 |
|
3063 my($ampm,$wk); |
|
3064 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
|
3065 &Date_Join($y,$m,$d,$h,$mn,$s); |
|
3066 } |
|
3067 |
|
3068 sub Date_SetDateField { |
|
3069 print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/); |
|
3070 my($date,$field,$val,$nocheck)=@_; |
|
3071 my($y,$m,$d,$h,$mn,$s)=(); |
|
3072 $nocheck=0 if (! defined $nocheck); |
|
3073 |
|
3074 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date); |
|
3075 |
|
3076 if (! $y) { |
|
3077 $date=&ParseDateString($date); |
|
3078 return "" if (! $date); |
|
3079 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1); |
|
3080 } |
|
3081 |
|
3082 if (lc($field) eq "y") { |
|
3083 $y=$val; |
|
3084 } elsif (lc($field) eq "m") { |
|
3085 $m=$val; |
|
3086 } elsif (lc($field) eq "d") { |
|
3087 $d=$val; |
|
3088 } elsif (lc($field) eq "h") { |
|
3089 $h=$val; |
|
3090 } elsif (lc($field) eq "mn") { |
|
3091 $mn=$val; |
|
3092 } elsif (lc($field) eq "s") { |
|
3093 $s=$val; |
|
3094 } else { |
|
3095 confess "ERROR: Date_SetDateField: invalid field: $field\n"; |
|
3096 } |
|
3097 |
|
3098 $date=&Date_Join($y,$m,$d,$h,$mn,$s); |
|
3099 return $date if ($nocheck || &Date_Split($date)); |
|
3100 return ""; |
|
3101 } |
|
3102 |
|
3103 ######################################################################## |
|
3104 # OTHER SUBROUTINES |
|
3105 ######################################################################## |
|
3106 # NOTE: These routines should not call any of the routines above as |
|
3107 # there will be a severe time penalty (and the possibility of |
|
3108 # infinite recursion). The last couple routines above are |
|
3109 # exceptions. |
|
3110 # NOTE: Date_Init is a special case. It should be called (conditionally) |
|
3111 # in every routine that uses any variable from the Date::Manip |
|
3112 # namespace. |
|
3113 ######################################################################## |
|
3114 |
|
3115 sub Date_DaysInMonth { |
|
3116 print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/); |
|
3117 my($m,$y)=@_; |
|
3118 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3119 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
|
3120 $d_in_m[2]=29 if (&Date_LeapYear($y)); |
|
3121 return $d_in_m[$m]; |
|
3122 } |
|
3123 |
|
3124 sub Date_DayOfWeek { |
|
3125 print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/); |
|
3126 my($m,$d,$y)=@_; |
|
3127 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3128 my($dayofweek,$dec31)=(); |
|
3129 |
|
3130 $dec31=5; # Dec 31, 1BC was Friday |
|
3131 $dayofweek=(&Date_DaysSince1BC($m,$d,$y)+$dec31) % 7; |
|
3132 $dayofweek=7 if ($dayofweek==0); |
|
3133 return $dayofweek; |
|
3134 } |
|
3135 |
|
3136 # Can't be in "use integer" because the numbers are too big. |
|
3137 no integer; |
|
3138 sub Date_SecsSince1970 { |
|
3139 print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/); |
|
3140 my($m,$d,$y,$h,$mn,$s)=@_; |
|
3141 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3142 my($sec_now,$sec_70)=(); |
|
3143 $sec_now=(&Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s; |
|
3144 # $sec_70 =(&Date_DaysSince1BC(1,1,1970)-1)*24*3600; |
|
3145 $sec_70 =62167219200; |
|
3146 return ($sec_now-$sec_70); |
|
3147 } |
|
3148 |
|
3149 sub Date_SecsSince1970GMT { |
|
3150 print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/); |
|
3151 my($m,$d,$y,$h,$mn,$s)=@_; |
|
3152 &Date_Init() if (! $Curr{"InitDone"}); |
|
3153 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3154 |
|
3155 my($sec)=&Date_SecsSince1970($m,$d,$y,$h,$mn,$s); |
|
3156 return $sec if ($Cnf{"ConvTZ"} eq "IGNORE"); |
|
3157 |
|
3158 my($tz)=$Cnf{"ConvTZ"}; |
|
3159 $tz=$Cnf{"TZ"} if (! $tz); |
|
3160 $tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/); |
|
3161 |
|
3162 my($tzs)=1; |
|
3163 $tzs=-1 if ($tz<0); |
|
3164 $tz=~/.(..)(..)/; |
|
3165 my($tzh,$tzm)=($1,$2); |
|
3166 $sec - $tzs*($tzh*3600+$tzm*60); |
|
3167 } |
|
3168 use integer; |
|
3169 |
|
3170 sub Date_DaysSince1BC { |
|
3171 print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/); |
|
3172 my($m,$d,$y)=@_; |
|
3173 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3174 my($Ny,$N4,$N100,$N400,$dayofyear,$days)=(); |
|
3175 my($cc,$yy)=(); |
|
3176 |
|
3177 $y=~ /(\d{2})(\d{2})/; |
|
3178 ($cc,$yy)=($1,$2); |
|
3179 |
|
3180 # Number of full years since Dec 31, 1BC (counting the year 0000). |
|
3181 $Ny=$y; |
|
3182 |
|
3183 # Number of full 4th years (incl. 0000) since Dec 31, 1BC |
|
3184 $N4=($Ny-1)/4 + 1; |
|
3185 $N4=0 if ($y==0); |
|
3186 |
|
3187 # Number of full 100th years (incl. 0000) |
|
3188 $N100=$cc + 1; |
|
3189 $N100-- if ($yy==0); |
|
3190 $N100=0 if ($y==0); |
|
3191 |
|
3192 # Number of full 400th years (incl. 0000) |
|
3193 $N400=($N100-1)/4 + 1; |
|
3194 $N400=0 if ($y==0); |
|
3195 |
|
3196 $dayofyear=&Date_DayOfYear($m,$d,$y); |
|
3197 $days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear; |
|
3198 |
|
3199 return $days; |
|
3200 } |
|
3201 |
|
3202 sub Date_DayOfYear { |
|
3203 print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/); |
|
3204 my($m,$d,$y)=@_; |
|
3205 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3206 # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) |
|
3207 my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365); |
|
3208 my($ly)=0; |
|
3209 $ly=1 if ($m>2 && &Date_LeapYear($y)); |
|
3210 return ($days[$m-1]+$d+$ly); |
|
3211 } |
|
3212 |
|
3213 sub Date_DaysInYear { |
|
3214 print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/); |
|
3215 my($y)=@_; |
|
3216 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3217 return 366 if (&Date_LeapYear($y)); |
|
3218 return 365; |
|
3219 } |
|
3220 |
|
3221 sub Date_WeekOfYear { |
|
3222 print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/); |
|
3223 my($m,$d,$y,$f)=@_; |
|
3224 &Date_Init() if (! $Curr{"InitDone"}); |
|
3225 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3226 |
|
3227 my($day,$dow,$doy)=(); |
|
3228 $doy=&Date_DayOfYear($m,$d,$y); |
|
3229 |
|
3230 # The current DayOfYear and DayOfWeek |
|
3231 if ($Cnf{"Jan1Week1"}) { |
|
3232 $day=1; |
|
3233 } else { |
|
3234 $day=4; |
|
3235 } |
|
3236 $dow=&Date_DayOfWeek(1,$day,$y); |
|
3237 |
|
3238 # Move back to the first day of week 1. |
|
3239 $f-=7 if ($f>$dow); |
|
3240 $day-= ($dow-$f); |
|
3241 |
|
3242 return 0 if ($day>$doy); # Day is in last week of previous year |
|
3243 return (($doy-$day)/7 + 1); |
|
3244 } |
|
3245 |
|
3246 sub Date_LeapYear { |
|
3247 print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/); |
|
3248 my($y)=@_; |
|
3249 $y=&Date_FixYear($y) if (length($y)!=4); |
|
3250 return 0 unless $y % 4 == 0; |
|
3251 return 1 unless $y % 100 == 0; |
|
3252 return 0 unless $y % 400 == 0; |
|
3253 return 1; |
|
3254 } |
|
3255 |
|
3256 sub Date_DaySuffix { |
|
3257 print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/); |
|
3258 my($d)=@_; |
|
3259 &Date_Init() if (! $Curr{"InitDone"}); |
|
3260 return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1]; |
|
3261 } |
|
3262 |
|
3263 sub Date_ConvTZ { |
|
3264 print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/); |
|
3265 my($date,$from,$to)=@_; |
|
3266 if (not Date_Split($date)) { |
|
3267 croak "date passed in ('$date') is not a Date::Manip object"; |
|
3268 } |
|
3269 |
|
3270 &Date_Init() if (! $Curr{"InitDone"}); |
|
3271 my($gmt)=(); |
|
3272 |
|
3273 if (! $from) { |
|
3274 |
|
3275 if (! $to) { |
|
3276 # TZ -> ConvTZ |
|
3277 return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"}); |
|
3278 $from=$Cnf{"TZ"}; |
|
3279 $to=$Cnf{"ConvTZ"}; |
|
3280 |
|
3281 } else { |
|
3282 # ConvTZ,TZ -> $to |
|
3283 $from=$Cnf{"ConvTZ"}; |
|
3284 $from=$Cnf{"TZ"} if (! $from); |
|
3285 } |
|
3286 |
|
3287 } else { |
|
3288 |
|
3289 if (! $to) { |
|
3290 # $from -> ConvTZ,TZ |
|
3291 return $date if ($Cnf{"ConvTZ"} eq "IGNORE"); |
|
3292 $to=$Cnf{"ConvTZ"}; |
|
3293 $to=$Cnf{"TZ"} if (! $to); |
|
3294 |
|
3295 } else { |
|
3296 # $from -> $to |
|
3297 } |
|
3298 } |
|
3299 |
|
3300 $to=$Zone{"n2o"}{lc($to)} |
|
3301 if (exists $Zone{"n2o"}{lc($to)}); |
|
3302 $from=$Zone{"n2o"}{lc($from)} |
|
3303 if (exists $Zone{"n2o"}{lc($from)}); |
|
3304 $gmt=$Zone{"n2o"}{"gmt"}; |
|
3305 |
|
3306 return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/); |
|
3307 return $date if ($from eq $to); |
|
3308 |
|
3309 my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=(); |
|
3310 # We're going to try to do the calculation without calling DateCalc. |
|
3311 ($yr,$mon,$d,$h,$m,$sec)=&Date_Split($date, 1); |
|
3312 |
|
3313 # Convert $date from $from to GMT |
|
3314 $from=~/([+-])(\d{2})(\d{2})/; |
|
3315 ($s1,$h1,$m1)=($1,$2,$3); |
|
3316 $s1= ($s1 eq "-" ? "+" : "-"); # switch sign |
|
3317 $sign=$s1 . "1"; # + or - 1 |
|
3318 |
|
3319 # and from GMT to $to |
|
3320 $to=~/([+-])(\d{2})(\d{2})/; |
|
3321 ($s2,$h2,$m2)=($1,$2,$3); |
|
3322 |
|
3323 if ($s1 eq $s2) { |
|
3324 # Both the same sign |
|
3325 $m+= $sign*($m1+$m2); |
|
3326 $h+= $sign*($h1+$h2); |
|
3327 } else { |
|
3328 $sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2)); |
|
3329 $m+= $sign*($m1-$m2); |
|
3330 $h+= $sign*($h1-$h2); |
|
3331 } |
|
3332 |
|
3333 if ($m>59) { |
|
3334 $h+= $m/60; |
|
3335 $m-= ($m/60)*60; |
|
3336 } elsif ($m<0) { |
|
3337 $h+= ($m/60 - 1); |
|
3338 $m-= ($m/60 - 1)*60; |
|
3339 } |
|
3340 |
|
3341 if ($h>23) { |
|
3342 $delta=$h/24; |
|
3343 $h -= $delta*24; |
|
3344 if (($d + $delta) > 28) { |
|
3345 $date=&Date_Join($yr,$mon,$d,$h,$m,$sec); |
|
3346 return &DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0); |
|
3347 } |
|
3348 $d+= $delta; |
|
3349 } elsif ($h<0) { |
|
3350 $delta=-$h/24 + 1; |
|
3351 $h += $delta*24; |
|
3352 if (($d - $delta) < 1) { |
|
3353 $date=&Date_Join($yr,$mon,$d,$h,$m,$sec); |
|
3354 return &DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0); |
|
3355 } |
|
3356 $d-= $delta; |
|
3357 } |
|
3358 return &Date_Join($yr,$mon,$d,$h,$m,$sec); |
|
3359 } |
|
3360 |
|
3361 sub Date_TimeZone { |
|
3362 print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/); |
|
3363 my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=(); |
|
3364 &Date_Init() if (! $Curr{"InitDone"}); |
|
3365 |
|
3366 # Get timezones from all of the relevant places |
|
3367 |
|
3368 push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var |
|
3369 push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var |
|
3370 push(@tz,$ENV{'SYS$TIMEZONE_RULE'}) |
|
3371 if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var |
|
3372 push(@tz,$ENV{'SYS$TIMEZONE_NAME'}) |
|
3373 if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var |
|
3374 push(@tz,$ENV{'UCX$TZ'}) |
|
3375 if defined $ENV{'UCX$TZ'}; # VMS TZ environ var |
|
3376 push(@tz,$ENV{'TCPIP$TZ'}) |
|
3377 if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var |
|
3378 |
|
3379 # The `date` command... if we're doing taint checking, we need to |
|
3380 # always call it with a full path... otherwise, use the user's path. |
|
3381 # |
|
3382 # Microsoft operating systems don't have a date command built in. Try |
|
3383 # to trap all the various ways of knowing we are on one of these systems. |
|
3384 # |
|
3385 # We'll try `date +%Z` first, and if that fails, we'll take just the |
|
3386 # `date` program and assume the output is of the format: |
|
3387 # Thu Aug 31 14:57:46 EDT 2000 |
|
3388 |
|
3389 unless (($^X =~ /perl\.exe$/i) or |
|
3390 ($OS eq "Windows") or |
|
3391 ($OS eq "Netware") or |
|
3392 ($OS eq "VMS")) { |
|
3393 if ($Date::Manip::NoTaint) { |
|
3394 if ($OS eq "VMS") { |
|
3395 $tz=$ENV{'SYS$TIMEZONE_NAME'}; |
|
3396 if (! $tz) { |
|
3397 $tz=$ENV{'MULTINET_TIMEZONE'}; |
|
3398 if (! $tz) { |
|
3399 $tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT |
|
3400 } |
|
3401 } |
|
3402 } else { |
|
3403 $tz=`date +%Z 2> /dev/null`; |
|
3404 chomp($tz); |
|
3405 if (! $tz) { |
|
3406 $tz=`date 2> /dev/null`; |
|
3407 chomp($tz); |
|
3408 $tz=(split(/\s+/,$tz))[4]; |
|
3409 } |
|
3410 } |
|
3411 push(@tz,$tz); |
|
3412 } else { |
|
3413 # We need to satisfy taint checking, but also look in all the |
|
3414 # directories in @DatePath. |
|
3415 # |
|
3416 local $ENV{PATH} = join(':', @Date::Manip::DatePath); |
|
3417 local $ENV{BASH_ENV} = ''; |
|
3418 $tz=`date +%Z 2> /dev/null`; |
|
3419 chomp($tz); |
|
3420 if (! $tz) { |
|
3421 $tz=`date 2> /dev/null`; |
|
3422 chomp($tz); |
|
3423 $tz=(split(/\s+/,$tz))[4]; |
|
3424 } |
|
3425 push(@tz,$tz); |
|
3426 } |
|
3427 } |
|
3428 |
|
3429 push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ |
|
3430 |
|
3431 if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE |
|
3432 $in=new IO::File; |
|
3433 $in->open("/etc/TIMEZONE","r"); |
|
3434 while (! eof($in)) { |
|
3435 $tmp=<$in>; |
|
3436 if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) { |
|
3437 push(@tz,$1); |
|
3438 last; |
|
3439 } |
|
3440 } |
|
3441 $in->close; |
|
3442 } |
|
3443 |
|
3444 if (-s "/etc/timezone") { # /etc/timezone |
|
3445 $in=new IO::File; |
|
3446 $in->open("/etc/timezone","r"); |
|
3447 while (! eof($in)) { |
|
3448 $tmp=<$in>; |
|
3449 next if ($tmp =~ /^\s*\043/); |
|
3450 chomp($tmp); |
|
3451 if ($tmp =~ /^\s*(.*?)\s*$/) { |
|
3452 push(@tz,$1); |
|
3453 last; |
|
3454 } |
|
3455 } |
|
3456 $in->close; |
|
3457 } |
|
3458 |
|
3459 # Now parse each one to find the first valid one. |
|
3460 foreach $tz (@tz) { |
|
3461 $tz =~ s/\s*$//; |
|
3462 $tz =~ s/^\s*//; |
|
3463 next if (! $tz); |
|
3464 |
|
3465 return uc($tz) |
|
3466 if (defined $Zone{"n2o"}{lc($tz)}); |
|
3467 |
|
3468 if ($tz =~ /^[+-]\d{4}$/) { |
|
3469 return $tz; |
|
3470 } elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) { |
|
3471 my($h,$m)=($1,$2); |
|
3472 $m="00" if (! $m); |
|
3473 return "$h$m"; |
|
3474 } |
|
3475 |
|
3476 # Handle US/Eastern format |
|
3477 if ($tz =~ /^$Zone{"tzones"}$/i) { |
|
3478 $tmp=lc $1; |
|
3479 $tz=$Zone{"tz2z"}{$tmp}; |
|
3480 } |
|
3481 |
|
3482 # Handle STD#DST# format (and STD-#DST-# formats) |
|
3483 if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) { |
|
3484 ($std,$dst)=($1,$2); |
|
3485 next if (! defined $Zone{"n2o"}{lc($std)} or |
|
3486 ! defined $Zone{"n2o"}{lc($dst)}); |
|
3487 $time = time(); |
|
3488 ($null,$null,$null,$null,$null,$null,$null,$null,$isdst) = |
|
3489 localtime($time); |
|
3490 return uc($dst) if ($isdst); |
|
3491 return uc($std); |
|
3492 } |
|
3493 } |
|
3494 |
|
3495 confess "ERROR: Date::Manip unable to determine TimeZone.\n"; |
|
3496 } |
|
3497 |
|
3498 # Returns 1 if $date is a work day. If $time is non-zero, the time is |
|
3499 # also checked to see if it falls within work hours. Returns "" if |
|
3500 # an invalid date is passed in. |
|
3501 sub Date_IsWorkDay { |
|
3502 print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/); |
|
3503 my($date,$time)=@_; |
|
3504 &Date_Init() if (! $Curr{"InitDone"}); |
|
3505 $date=&ParseDateString($date); |
|
3506 return "" if (! $date); |
|
3507 my($d)=$date; |
|
3508 $d=&Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time); |
|
3509 |
|
3510 my($y,$mon,$day,$tmp,$h,$m,$dow)=(); |
|
3511 ($y,$mon,$day,$h,$m,$tmp)=&Date_Split($d, 1); |
|
3512 $dow=&Date_DayOfWeek($mon,$day,$y); |
|
3513 |
|
3514 return 0 if ($dow<$Cnf{"WorkWeekBeg"} or |
|
3515 $dow>$Cnf{"WorkWeekEnd"} or |
|
3516 "$h:$m" lt $Cnf{"WorkDayBeg"} or |
|
3517 "$h:$m" gt $Cnf{"WorkDayEnd"}); |
|
3518 |
|
3519 if (! exists $Holiday{"dates"}{$y}) { |
|
3520 # There will be recursion problems if we ever end up here twice. |
|
3521 $Holiday{"dates"}{$y}={}; |
|
3522 &Date_UpdateHolidays($y) |
|
3523 } |
|
3524 $d=&Date_SetTime($date,"00:00:00"); |
|
3525 return 0 if (exists $Holiday{"dates"}{$y}{$d}); |
|
3526 1; |
|
3527 } |
|
3528 |
|
3529 # Finds the day $off work days from now. If $time is passed in, we must |
|
3530 # also take into account the time of day. |
|
3531 # |
|
3532 # If $time is not passed in, day 0 is today (if today is a workday) or the |
|
3533 # next work day if it isn't. In any case, the time of day is unaffected. |
|
3534 # |
|
3535 # If $time is passed in, day 0 is now (if now is part of a workday) or the |
|
3536 # start of the very next work day. |
|
3537 sub Date_NextWorkDay { |
|
3538 print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/); |
|
3539 my($date,$off,$time)=@_; |
|
3540 &Date_Init() if (! $Curr{"InitDone"}); |
|
3541 $date=&ParseDateString($date); |
|
3542 my($err)=(); |
|
3543 |
|
3544 if (! &Date_IsWorkDay($date,$time)) { |
|
3545 if ($time) { |
|
3546 while (1) { |
|
3547 $date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"}); |
|
3548 last if (&Date_IsWorkDay($date,$time)); |
|
3549 } |
|
3550 } else { |
|
3551 while (1) { |
|
3552 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0); |
|
3553 last if (&Date_IsWorkDay($date,$time)); |
|
3554 } |
|
3555 } |
|
3556 } |
|
3557 |
|
3558 while ($off>0) { |
|
3559 while (1) { |
|
3560 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0); |
|
3561 last if (&Date_IsWorkDay($date,$time)); |
|
3562 } |
|
3563 $off--; |
|
3564 } |
|
3565 |
|
3566 return $date; |
|
3567 } |
|
3568 |
|
3569 # Finds the day $off work days before now. If $time is passed in, we must |
|
3570 # also take into account the time of day. |
|
3571 # |
|
3572 # If $time is not passed in, day 0 is today (if today is a workday) or the |
|
3573 # previous work day if it isn't. In any case, the time of day is unaffected. |
|
3574 # |
|
3575 # If $time is passed in, day 0 is now (if now is part of a workday) or the |
|
3576 # end of the previous work period. Note that since the end of a work day |
|
3577 # will automatically be turned into the start of the next one, this time |
|
3578 # may actually be treated as AFTER the current time. |
|
3579 sub Date_PrevWorkDay { |
|
3580 print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/); |
|
3581 my($date,$off,$time)=@_; |
|
3582 &Date_Init() if (! $Curr{"InitDone"}); |
|
3583 $date=&ParseDateString($date); |
|
3584 my($err)=(); |
|
3585 |
|
3586 if (! &Date_IsWorkDay($date,$time)) { |
|
3587 if ($time) { |
|
3588 while (1) { |
|
3589 $date=&Date_GetPrev($date,undef,0,$Cnf{"WorkDayEnd"}); |
|
3590 last if (&Date_IsWorkDay($date,$time)); |
|
3591 } |
|
3592 while (1) { |
|
3593 $date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"}); |
|
3594 last if (&Date_IsWorkDay($date,$time)); |
|
3595 } |
|
3596 } else { |
|
3597 while (1) { |
|
3598 $date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0); |
|
3599 last if (&Date_IsWorkDay($date,$time)); |
|
3600 } |
|
3601 } |
|
3602 } |
|
3603 |
|
3604 while ($off>0) { |
|
3605 while (1) { |
|
3606 $date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0); |
|
3607 last if (&Date_IsWorkDay($date,$time)); |
|
3608 } |
|
3609 $off--; |
|
3610 } |
|
3611 |
|
3612 return $date; |
|
3613 } |
|
3614 |
|
3615 # This finds the nearest workday to $date. If $date is a workday, it |
|
3616 # is returned. |
|
3617 sub Date_NearestWorkDay { |
|
3618 print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/); |
|
3619 my($date,$tomorrow)=@_; |
|
3620 &Date_Init() if (! $Curr{"InitDone"}); |
|
3621 $date=&ParseDateString($date); |
|
3622 my($a,$b,$dela,$delb,$err)=(); |
|
3623 $tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow); |
|
3624 |
|
3625 return $date if (&Date_IsWorkDay($date)); |
|
3626 |
|
3627 # Find the nearest one. |
|
3628 if ($tomorrow) { |
|
3629 $dela="+0:0:0:1:0:0:0"; |
|
3630 $delb="-0:0:0:1:0:0:0"; |
|
3631 } else { |
|
3632 $dela="-0:0:0:1:0:0:0"; |
|
3633 $delb="+0:0:0:1:0:0:0"; |
|
3634 } |
|
3635 $a=$b=$date; |
|
3636 |
|
3637 while (1) { |
|
3638 $a=&DateCalc_DateDelta($a,$dela,\$err); |
|
3639 return $a if (&Date_IsWorkDay($a)); |
|
3640 $b=&DateCalc_DateDelta($b,$delb,\$err); |
|
3641 return $b if (&Date_IsWorkDay($b)); |
|
3642 } |
|
3643 } |
|
3644 |
|
3645 # &Date_NthDayOfYear($y,$n); |
|
3646 # Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year. |
|
3647 sub Date_NthDayOfYear { |
|
3648 no integer; |
|
3649 print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/); |
|
3650 my($y,$n)=@_; |
|
3651 $y=$Curr{"Y"} if (! $y); |
|
3652 $n=1 if (! defined $n or $n eq ""); |
|
3653 $n+=0; # to turn 023 into 23 |
|
3654 $y=&Date_FixYear($y) if (length($y)<4); |
|
3655 my $leap=&Date_LeapYear($y); |
|
3656 return () if ($n<1); |
|
3657 return () if ($n >= ($leap ? 367 : 366)); |
|
3658 |
|
3659 my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31); |
|
3660 $d_in_m[1]=29 if ($leap); |
|
3661 |
|
3662 # Calculate the hours, minutes, and seconds into the day. |
|
3663 my $remain=($n - int($n))*24; |
|
3664 my $h=int($remain); |
|
3665 $remain=($remain - $h)*60; |
|
3666 my $mn=int($remain); |
|
3667 $remain=($remain - $mn)*60; |
|
3668 my $s=$remain; |
|
3669 |
|
3670 # Calculate the month and the day. |
|
3671 my($m,$d)=(0,0); |
|
3672 $n=int($n); |
|
3673 while ($n>0) { |
|
3674 $m++; |
|
3675 if ($n<=$d_in_m[0]) { |
|
3676 $d=int($n); |
|
3677 $n=0; |
|
3678 } else { |
|
3679 $n-= $d_in_m[0]; |
|
3680 shift(@d_in_m); |
|
3681 } |
|
3682 } |
|
3683 |
|
3684 ($y,$m,$d,$h,$mn,$s); |
|
3685 } |
|
3686 |
|
3687 ######################################################################## |
|
3688 # NOT FOR EXPORT |
|
3689 ######################################################################## |
|
3690 |
|
3691 # This is used in Date_Init to fill in a hash based on international |
|
3692 # data. It takes a list of keys and values and returns both a hash |
|
3693 # with these values and a regular expression of keys. |
|
3694 # |
|
3695 # IN: |
|
3696 # $data = [ key1 val1 key2 val2 ... ] |
|
3697 # $opts = lc : lowercase the keys in the regexp |
|
3698 # sort : sort (by length) the keys in the regexp |
|
3699 # back : create a regexp with a back reference |
|
3700 # escape : escape all strings in the regexp |
|
3701 # |
|
3702 # OUT: |
|
3703 # $regexp = '(?:key1|key2|...)' |
|
3704 # $hash = { key1=>val1 key2=>val2 ... } |
|
3705 |
|
3706 sub Date_InitHash { |
|
3707 print "DEBUG: Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/); |
|
3708 my($data,$regexp,$opts,$hash)=@_; |
|
3709 my(@data)=@$data; |
|
3710 my($key,$val,@list)=(); |
|
3711 |
|
3712 # Parse the options |
|
3713 my($lc,$sort,$back,$escape)=(0,0,0,0); |
|
3714 $lc=1 if ($opts =~ /lc/i); |
|
3715 $sort=1 if ($opts =~ /sort/i); |
|
3716 $back=1 if ($opts =~ /back/i); |
|
3717 $escape=1 if ($opts =~ /escape/i); |
|
3718 |
|
3719 # Create the hash |
|
3720 while (@data) { |
|
3721 ($key,$val,@data)=@data; |
|
3722 $key=lc($key) if ($lc); |
|
3723 $$hash{$key}=$val; |
|
3724 } |
|
3725 |
|
3726 # Create the regular expression |
|
3727 if ($regexp) { |
|
3728 @list=keys(%$hash); |
|
3729 @list=sort sortByLength(@list) if ($sort); |
|
3730 if ($escape) { |
|
3731 foreach $val (@list) { |
|
3732 $val="\Q$val\E"; |
|
3733 } |
|
3734 } |
|
3735 if ($back) { |
|
3736 $$regexp="(" . join("|",@list) . ")"; |
|
3737 } else { |
|
3738 $$regexp="(?:" . join("|",@list) . ")"; |
|
3739 } |
|
3740 } |
|
3741 } |
|
3742 |
|
3743 # This is used in Date_Init to fill in regular expressions, lists, and |
|
3744 # hashes based on international data. It takes a list of lists which have |
|
3745 # to be stored as regular expressions (to find any element in the list), |
|
3746 # lists, and hashes (indicating the location in the lists). |
|
3747 # |
|
3748 # IN: |
|
3749 # $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ] |
|
3750 # [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ] |
|
3751 # ... |
|
3752 # [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ] |
|
3753 # $lists = [ \@listA \@listB ... \@listZ ] |
|
3754 # $opts = lc : lowercase the values in the regexp |
|
3755 # sort : sort (by length) the values in the regexp |
|
3756 # back : create a regexp with a back reference |
|
3757 # escape : escape all strings in the regexp |
|
3758 # $hash = [ \%hash, TYPE ] |
|
3759 # TYPE 0 : $hash{ valBn=>n-1 } |
|
3760 # TYPE 1 : $hash{ valBn=>n } |
|
3761 # |
|
3762 # OUT: |
|
3763 # $regexp = '(?:valA1|valA2|...|valB1|...)' |
|
3764 # $lists = [ [ valA1 valA2 ... ] # only the 1st list (or |
|
3765 # [ valB1 valB2 ... ] ... ] # 2nd for int. characters) |
|
3766 # $hash |
|
3767 |
|
3768 sub Date_InitLists { |
|
3769 print "DEBUG: Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/); |
|
3770 my($data,$regexp,$opts,$lists,$hash)=@_; |
|
3771 my(@data)=@$data; |
|
3772 my(@lists)=@$lists; |
|
3773 my($i,@ele,$ele,@list,$j,$tmp)=(); |
|
3774 |
|
3775 # Parse the options |
|
3776 my($lc,$sort,$back,$escape)=(0,0,0,0); |
|
3777 $lc=1 if ($opts =~ /lc/i); |
|
3778 $sort=1 if ($opts =~ /sort/i); |
|
3779 $back=1 if ($opts =~ /back/i); |
|
3780 $escape=1 if ($opts =~ /escape/i); |
|
3781 |
|
3782 # Set each of the lists |
|
3783 if (@lists) { |
|
3784 confess "ERROR: Date_InitLists: lists must be 1 per data\n" |
|
3785 if ($#lists != $#data); |
|
3786 for ($i=0; $i<=$#data; $i++) { |
|
3787 @ele=@{ $data[$i] }; |
|
3788 if ($Cnf{"IntCharSet"} && $#ele>0) { |
|
3789 @{ $lists[$i] } = @{ $ele[1] }; |
|
3790 } else { |
|
3791 @{ $lists[$i] } = @{ $ele[0] }; |
|
3792 } |
|
3793 } |
|
3794 } |
|
3795 |
|
3796 # Create the hash |
|
3797 my($hashtype,$hashsave,%hash)=(); |
|
3798 if (@$hash) { |
|
3799 ($hash,$hashtype)=@$hash; |
|
3800 $hashsave=1; |
|
3801 } else { |
|
3802 $hashtype=0; |
|
3803 $hashsave=0; |
|
3804 } |
|
3805 for ($i=0; $i<=$#data; $i++) { |
|
3806 @ele=@{ $data[$i] }; |
|
3807 foreach $ele (@ele) { |
|
3808 @list = @{ $ele }; |
|
3809 for ($j=0; $j<=$#list; $j++) { |
|
3810 $tmp=$list[$j]; |
|
3811 next if (! $tmp); |
|
3812 $tmp=lc($tmp) if ($lc); |
|
3813 $hash{$tmp}= $j+$hashtype; |
|
3814 } |
|
3815 } |
|
3816 } |
|
3817 %$hash = %hash if ($hashsave); |
|
3818 |
|
3819 # Create the regular expression |
|
3820 if ($regexp) { |
|
3821 @list=keys(%hash); |
|
3822 @list=sort sortByLength(@list) if ($sort); |
|
3823 if ($escape) { |
|
3824 foreach $ele (@list) { |
|
3825 $ele="\Q$ele\E"; |
|
3826 } |
|
3827 } |
|
3828 if ($back) { |
|
3829 $$regexp="(" . join("|",@list) . ")"; |
|
3830 } else { |
|
3831 $$regexp="(?:" . join("|",@list) . ")"; |
|
3832 } |
|
3833 } |
|
3834 } |
|
3835 |
|
3836 # This is used in Date_Init to fill in regular expressions and lists based |
|
3837 # on international data. This takes a list of strings and returns a regular |
|
3838 # expression (to find any one of them). |
|
3839 # |
|
3840 # IN: |
|
3841 # $data = [ string1 string2 ... ] |
|
3842 # $opts = lc : lowercase the values in the regexp |
|
3843 # sort : sort (by length) the values in the regexp |
|
3844 # back : create a regexp with a back reference |
|
3845 # escape : escape all strings in the regexp |
|
3846 # |
|
3847 # OUT: |
|
3848 # $regexp = '(string1|string2|...)' |
|
3849 |
|
3850 sub Date_InitStrings { |
|
3851 print "DEBUG: Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/); |
|
3852 my($data,$regexp,$opts)=@_; |
|
3853 my(@list)=@{ $data }; |
|
3854 |
|
3855 # Parse the options |
|
3856 my($lc,$sort,$back,$escape)=(0,0,0,0); |
|
3857 $lc=1 if ($opts =~ /lc/i); |
|
3858 $sort=1 if ($opts =~ /sort/i); |
|
3859 $back=1 if ($opts =~ /back/i); |
|
3860 $escape=1 if ($opts =~ /escape/i); |
|
3861 |
|
3862 # Create the regular expression |
|
3863 my($ele)=(); |
|
3864 @list=sort sortByLength(@list) if ($sort); |
|
3865 if ($escape) { |
|
3866 foreach $ele (@list) { |
|
3867 $ele="\Q$ele\E"; |
|
3868 } |
|
3869 } |
|
3870 if ($back) { |
|
3871 $$regexp="(" . join("|",@list) . ")"; |
|
3872 } else { |
|
3873 $$regexp="(?:" . join("|",@list) . ")"; |
|
3874 } |
|
3875 $$regexp=lc($$regexp) if ($lc); |
|
3876 } |
|
3877 |
|
3878 # items is passed in (either as a space separated string, or a reference to |
|
3879 # a list) and a regular expression which matches any one of the items is |
|
3880 # prepared. The regular expression will be of one of the forms: |
|
3881 # "(a|b)" @list not empty, back option included |
|
3882 # "(?:a|b)" @list not empty |
|
3883 # "()" @list empty, back option included |
|
3884 # "" @list empty |
|
3885 # $options is a string which contains any of the following strings: |
|
3886 # back : the regular expression has a backreference |
|
3887 # opt : the regular expression is optional and a "?" is appended in |
|
3888 # the first two forms |
|
3889 # optws : the regular expression is optional and may be replaced by |
|
3890 # whitespace |
|
3891 # optWs : the regular expression is optional, but if not present, must |
|
3892 # be replaced by whitespace |
|
3893 # sort : the items in the list are sorted by length (longest first) |
|
3894 # lc : the string is lowercased |
|
3895 # under : any underscores are converted to spaces |
|
3896 # pre : it may be preceded by whitespace |
|
3897 # Pre : it must be preceded by whitespace |
|
3898 # PRE : it must be preceded by whitespace or the start |
|
3899 # post : it may be followed by whitespace |
|
3900 # Post : it must be followed by whitespace |
|
3901 # POST : it must be followed by whitespace or the end |
|
3902 # Spaces due to pre/post options will not be included in the back reference. |
|
3903 # |
|
3904 # If $array is included, then the elements will also be returned as a list. |
|
3905 # $array is a string which may contain any of the following: |
|
3906 # keys : treat the list as a hash and only the keys go into the regexp |
|
3907 # key0 : treat the list as the values of a hash with keys 0 .. N-1 |
|
3908 # key1 : treat the list as the values of a hash with keys 1 .. N |
|
3909 # val0 : treat the list as the keys of a hash with values 0 .. N-1 |
|
3910 # val1 : treat the list as the keys of a hash with values 1 .. N |
|
3911 |
|
3912 # &Date_InitLists([$lang{"month_name"},$lang{"month_abb"}], |
|
3913 # [\$Month,"lc,sort,back"], |
|
3914 # [\@Month,\@Mon], |
|
3915 # [\%Month,1]); |
|
3916 |
|
3917 # This is used in Date_Init to prepare regular expressions. A list of |
|
3918 # items is passed in (either as a space separated string, or a reference to |
|
3919 # a list) and a regular expression which matches any one of the items is |
|
3920 # prepared. The regular expression will be of one of the forms: |
|
3921 # "(a|b)" @list not empty, back option included |
|
3922 # "(?:a|b)" @list not empty |
|
3923 # "()" @list empty, back option included |
|
3924 # "" @list empty |
|
3925 # $options is a string which contains any of the following strings: |
|
3926 # back : the regular expression has a backreference |
|
3927 # opt : the regular expression is optional and a "?" is appended in |
|
3928 # the first two forms |
|
3929 # optws : the regular expression is optional and may be replaced by |
|
3930 # whitespace |
|
3931 # optWs : the regular expression is optional, but if not present, must |
|
3932 # be replaced by whitespace |
|
3933 # sort : the items in the list are sorted by length (longest first) |
|
3934 # lc : the string is lowercased |
|
3935 # under : any underscores are converted to spaces |
|
3936 # pre : it may be preceded by whitespace |
|
3937 # Pre : it must be preceded by whitespace |
|
3938 # PRE : it must be preceded by whitespace or the start |
|
3939 # post : it may be followed by whitespace |
|
3940 # Post : it must be followed by whitespace |
|
3941 # POST : it must be followed by whitespace or the end |
|
3942 # Spaces due to pre/post options will not be included in the back reference. |
|
3943 # |
|
3944 # If $array is included, then the elements will also be returned as a list. |
|
3945 # $array is a string which may contain any of the following: |
|
3946 # keys : treat the list as a hash and only the keys go into the regexp |
|
3947 # key0 : treat the list as the values of a hash with keys 0 .. N-1 |
|
3948 # key1 : treat the list as the values of a hash with keys 1 .. N |
|
3949 # val0 : treat the list as the keys of a hash with values 0 .. N-1 |
|
3950 # val1 : treat the list as the keys of a hash with values 1 .. N |
|
3951 sub Date_Regexp { |
|
3952 print "DEBUG: Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/); |
|
3953 my($list,$options,$array)=@_; |
|
3954 my(@list,$ret,%hash,$i)=(); |
|
3955 local($_)=(); |
|
3956 $options="" if (! defined $options); |
|
3957 $array="" if (! defined $array); |
|
3958 |
|
3959 my($sort,$lc,$under)=(0,0,0); |
|
3960 $sort =1 if ($options =~ /sort/i); |
|
3961 $lc =1 if ($options =~ /lc/i); |
|
3962 $under=1 if ($options =~ /under/i); |
|
3963 my($back,$opt,$pre,$post,$ws)=("?:","","","",""); |
|
3964 $back ="" if ($options =~ /back/i); |
|
3965 $opt ="?" if ($options =~ /opt/i); |
|
3966 $pre ='\s*' if ($options =~ /pre/); |
|
3967 $pre ='\s+' if ($options =~ /Pre/); |
|
3968 $pre ='(?:\s+|^)' if ($options =~ /PRE/); |
|
3969 $post ='\s*' if ($options =~ /post/); |
|
3970 $post ='\s+' if ($options =~ /Post/); |
|
3971 $post ='(?:$|\s+)' if ($options =~ /POST/); |
|
3972 $ws ='\s*' if ($options =~ /optws/); |
|
3973 $ws ='\s+' if ($options =~ /optws/); |
|
3974 |
|
3975 my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0); |
|
3976 $keys =1 if ($array =~ /keys/i); |
|
3977 $key0 =1 if ($array =~ /key0/i); |
|
3978 $key1 =1 if ($array =~ /key1/i); |
|
3979 $val0 =1 if ($array =~ /val0/i); |
|
3980 $val1 =1 if ($array =~ /val1/i); |
|
3981 $hash =1 if ($keys or $key0 or $key1 or $val0 or $val1); |
|
3982 |
|
3983 my($ref)=ref $list; |
|
3984 if (! $ref) { |
|
3985 $list =~ s/\s*$//; |
|
3986 $list =~ s/^\s*//; |
|
3987 $list =~ s/\s+/&&&/g; |
|
3988 } elsif ($ref eq "ARRAY") { |
|
3989 $list = join("&&&",@$list); |
|
3990 } else { |
|
3991 confess "ERROR: Date_Regexp.\n"; |
|
3992 } |
|
3993 |
|
3994 if (! $list) { |
|
3995 if ($back eq "") { |
|
3996 return "()"; |
|
3997 } else { |
|
3998 return ""; |
|
3999 } |
|
4000 } |
|
4001 |
|
4002 $list=lc($list) if ($lc); |
|
4003 $list=~ s/_/ /g if ($under); |
|
4004 @list=split(/&&&/,$list); |
|
4005 if ($keys) { |
|
4006 %hash=@list; |
|
4007 @list=keys %hash; |
|
4008 } elsif ($key0 or $key1 or $val0 or $val1) { |
|
4009 $i=0; |
|
4010 $i=1 if ($key1 or $val1); |
|
4011 if ($key0 or $key1) { |
|
4012 %hash= map { $_,$i++ } @list; |
|
4013 } else { |
|
4014 %hash= map { $i++,$_ } @list; |
|
4015 } |
|
4016 } |
|
4017 @list=sort sortByLength(@list) if ($sort); |
|
4018 |
|
4019 $ret="($back" . join("|",@list) . ")"; |
|
4020 $ret="(?:$pre$ret$post)" if ($pre or $post); |
|
4021 $ret.=$opt; |
|
4022 $ret="(?:$ret|$ws)" if ($ws); |
|
4023 |
|
4024 if ($array and $hash) { |
|
4025 return ($ret,%hash); |
|
4026 } elsif ($array) { |
|
4027 return ($ret,@list); |
|
4028 } else { |
|
4029 return $ret; |
|
4030 } |
|
4031 } |
|
4032 |
|
4033 # This will produce a delta with the correct number of signs. At most two |
|
4034 # signs will be in it normally (one before the year, and one in front of |
|
4035 # the day), but if appropriate, signs will be in front of all elements. |
|
4036 # Also, as many of the signs will be equivalent as possible. |
|
4037 sub Delta_Normalize { |
|
4038 print "DEBUG: Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/); |
|
4039 my($delta,$mode)=@_; |
|
4040 return "" if (! $delta); |
|
4041 return "+0:+0:+0:+0:+0:+0:+0" |
|
4042 if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"}); |
|
4043 return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/); |
|
4044 |
|
4045 my($tmp,$sign1,$sign2,$len)=(); |
|
4046 |
|
4047 # Calculate the length of the day in minutes |
|
4048 $len=24*60; |
|
4049 $len=$Curr{"WDlen"} if ($mode==2 || $mode==3); |
|
4050 |
|
4051 # We have to get the sign of every component explicitely so that a "-0" |
|
4052 # or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must |
|
4053 # be a negative delta). |
|
4054 |
|
4055 my($y,$mon,$w,$d,$h,$m,$s)=&Delta_Split($delta); |
|
4056 |
|
4057 # We need to make sure that the signs of all parts of a delta are the |
|
4058 # same. The easiest way to do this is to convert all of the large |
|
4059 # components to the smallest ones, then convert the smaller components |
|
4060 # back to the larger ones. |
|
4061 |
|
4062 # Do the year/month part |
|
4063 |
|
4064 $mon += $y*12; # convert y to m |
|
4065 $sign1="+"; |
|
4066 if ($mon<0) { |
|
4067 $mon *= -1; |
|
4068 $sign1="-"; |
|
4069 } |
|
4070 |
|
4071 $y = $mon/12; # convert m to y |
|
4072 $mon -= $y*12; |
|
4073 |
|
4074 $y=0 if ($y eq "-0"); # get around silly -0 problem |
|
4075 $mon=0 if ($mon eq "-0"); |
|
4076 |
|
4077 # Do the wk/day/hour/min/sec part |
|
4078 |
|
4079 { |
|
4080 # Unfortunately, $s is overflowing for dates more than ~70 years |
|
4081 # apart. |
|
4082 no integer; |
|
4083 |
|
4084 if ($mode==3 || $mode==2) { |
|
4085 $s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s |
|
4086 } else { |
|
4087 $s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s |
|
4088 } |
|
4089 $sign2="+"; |
|
4090 if ($s<0) { |
|
4091 $s*=-1; |
|
4092 $sign2="-"; |
|
4093 } |
|
4094 |
|
4095 $m = int($s/60); # convert s to m |
|
4096 $s -= $m*60; |
|
4097 $d = int($m/$len); # convert m to d |
|
4098 $m -= $d*$len; |
|
4099 |
|
4100 # The rest should be fine. |
|
4101 } |
|
4102 $h = $m/60; # convert m to h |
|
4103 $m -= $h*60; |
|
4104 if ($mode == 3 || $mode == 2) { |
|
4105 $w = $w*1; # get around +0 problem |
|
4106 } else { |
|
4107 $w = $d/7; # convert d to w |
|
4108 $d -= $w*7; |
|
4109 } |
|
4110 |
|
4111 $w=0 if ($w eq "-0"); # get around silly -0 problem |
|
4112 $d=0 if ($d eq "-0"); |
|
4113 $h=0 if ($h eq "-0"); |
|
4114 $m=0 if ($m eq "-0"); |
|
4115 $s=0 if ($s eq "-0"); |
|
4116 |
|
4117 # Only include two signs if necessary |
|
4118 $sign1=$sign2 if ($y==0 and $mon==0); |
|
4119 $sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0); |
|
4120 $sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"}); |
|
4121 |
|
4122 if ($Cnf{"DeltaSigns"}) { |
|
4123 return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s"; |
|
4124 } else { |
|
4125 return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s"; |
|
4126 } |
|
4127 } |
|
4128 |
|
4129 # This checks a delta to make sure it is valid. If it is, it splits |
|
4130 # it and returns the elements with a sign on each. The 2nd argument |
|
4131 # specifies the default sign. Blank elements are set to 0. If the |
|
4132 # third element is non-nil, exactly 7 elements must be included. |
|
4133 sub Delta_Split { |
|
4134 print "DEBUG: Delta_Split\n" if ($Curr{"Debug"} =~ /trace/); |
|
4135 my($delta,$sign,$exact)=@_; |
|
4136 my(@delta)=split(/:/,$delta); |
|
4137 return () if ($exact and $#delta != 6); |
|
4138 my($i)=(); |
|
4139 $sign="+" if (! defined $sign); |
|
4140 for ($i=0; $i<=$#delta; $i++) { |
|
4141 $delta[$i]="0" if (! $delta[$i]); |
|
4142 return () if ($delta[$i] !~ /^[+-]?\d+$/); |
|
4143 $sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign); |
|
4144 $delta[$i] = $sign.$delta[$i]; |
|
4145 } |
|
4146 @delta; |
|
4147 } |
|
4148 |
|
4149 # Reads up to 3 arguments. $h may contain the time in any international |
|
4150 # format. Any empty elements are set to 0. |
|
4151 sub Date_ParseTime { |
|
4152 print "DEBUG: Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/); |
|
4153 my($h,$m,$s)=@_; |
|
4154 my($t)=&CheckTime("one"); |
|
4155 |
|
4156 if (defined $h and $h =~ /$t/) { |
|
4157 $h=$1; |
|
4158 $m=$2; |
|
4159 $s=$3 if (defined $3); |
|
4160 } |
|
4161 $h="00" if (! defined $h); |
|
4162 $m="00" if (! defined $m); |
|
4163 $s="00" if (! defined $s); |
|
4164 |
|
4165 ($h,$m,$s); |
|
4166 } |
|
4167 |
|
4168 # Forms a date with the 6 elements passed in (all of which must be defined). |
|
4169 # No check as to validity is made. |
|
4170 sub Date_Join { |
|
4171 print "DEBUG: Date_Join\n" if ($Curr{"Debug"} =~ /trace/); |
|
4172 foreach (0 .. $#_) { |
|
4173 croak "undefined arg $_ to Date_Join()" if not defined $_[$_]; |
|
4174 } |
|
4175 my($y,$m,$d,$h,$mn,$s)=@_; |
|
4176 my($ym,$md,$dh,$hmn,$mns)=(); |
|
4177 |
|
4178 if ($Cnf{"Internal"} == 0) { |
|
4179 $ym=$md=$dh=""; |
|
4180 $hmn=$mns=":"; |
|
4181 |
|
4182 } elsif ($Cnf{"Internal"} == 1) { |
|
4183 $ym=$md=$dh=$hmn=$mns=""; |
|
4184 |
|
4185 } elsif ($Cnf{"Internal"} == 2) { |
|
4186 $ym=$md="-"; |
|
4187 $dh=" "; |
|
4188 $hmn=$mns=":"; |
|
4189 |
|
4190 } else { |
|
4191 confess "ERROR: Invalid internal format in Date_Join.\n"; |
|
4192 } |
|
4193 $m="0$m" if (length($m)==1); |
|
4194 $d="0$d" if (length($d)==1); |
|
4195 $h="0$h" if (length($h)==1); |
|
4196 $mn="0$mn" if (length($mn)==1); |
|
4197 $s="0$s" if (length($s)==1); |
|
4198 "$y$ym$m$md$d$dh$h$hmn$mn$mns$s"; |
|
4199 } |
|
4200 |
|
4201 # This checks a time. If it is valid, it splits it and returns 3 elements. |
|
4202 # If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is |
|
4203 # returned. |
|
4204 sub CheckTime { |
|
4205 print "DEBUG: CheckTime\n" if ($Curr{"Debug"} =~ /trace/); |
|
4206 my($time)=@_; |
|
4207 my($h)='(?:0?[0-9]|1[0-9]|2[0-3])'; |
|
4208 my($h2)='(?:0[0-9]|1[0-9]|2[0-3])'; |
|
4209 my($m)='[0-5][0-9]'; |
|
4210 my($s)=$m; |
|
4211 my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)"; |
|
4212 my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)"; |
|
4213 my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"}; |
|
4214 my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$"; |
|
4215 if ($time eq "one") { |
|
4216 return $t; |
|
4217 } elsif ($time eq "two") { |
|
4218 $t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$"; |
|
4219 return $t; |
|
4220 } |
|
4221 |
|
4222 if ($time =~ /$t/i) { |
|
4223 ($h,$m,$s)=($1,$2,$3); |
|
4224 $h="0$h" if (length($h)<2); |
|
4225 $m="0$m" if (length($m)<2); |
|
4226 $s="00" if (! defined $s); |
|
4227 return ($h,$m,$s); |
|
4228 } else { |
|
4229 return (); |
|
4230 } |
|
4231 } |
|
4232 |
|
4233 # This checks a recurrence. If it is valid, it splits it and returns the |
|
4234 # elements. Otherwise, it returns an empty list. |
|
4235 # ($recur0,$recur1,$flags,$dateb,$date0,$date1)=&Recur_Split($recur); |
|
4236 sub Recur_Split { |
|
4237 print "DEBUG: Recur_Split\n" if ($Curr{"Debug"} =~ /trace/); |
|
4238 my($recur)=@_; |
|
4239 my(@ret,@tmp); |
|
4240 |
|
4241 my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)'; |
|
4242 my($F) = '(?:\*([^*]*))'; |
|
4243 my($DB,$D0,$D1); |
|
4244 $DB=$D0=$D1=$F; |
|
4245 |
|
4246 if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) { |
|
4247 @ret=($1,$2,$3,$4,$5); |
|
4248 @tmp=split(/\*/,shift(@ret)); |
|
4249 return () if ($#tmp>1); |
|
4250 return (@tmp,"",@ret) if ($#tmp==0); |
|
4251 return (@tmp,@ret); |
|
4252 } |
|
4253 return (); |
|
4254 } |
|
4255 |
|
4256 # This checks a date. If it is valid, it splits it and returns the elements. |
|
4257 # If no date is passed in, it returns a regular expression for the date. |
|
4258 # |
|
4259 # The optional second argument says 'I really expect this to be a |
|
4260 # valid Date::Manip object, please throw an exception if it is |
|
4261 # not'. Otherwise, errors are signalled by returning (). |
|
4262 # |
|
4263 sub Date_Split { |
|
4264 print "DEBUG: Date_Split\n" if ($Curr{"Debug"} =~ /trace/); |
|
4265 my($date, $definitely_valid)=@_; |
|
4266 $definitely_valid = 0 if not defined $definitely_valid; |
|
4267 my($ym,$md,$dh,$hmn,$mns)=(); |
|
4268 my($y)='(\d{4})'; |
|
4269 my($m)='(0[1-9]|1[0-2])'; |
|
4270 my($d)='(0[1-9]|[1-2][0-9]|3[0-1])'; |
|
4271 my($h)='([0-1][0-9]|2[0-3])'; |
|
4272 my($mn)='([0-5][0-9])'; |
|
4273 my($s)=$mn; |
|
4274 |
|
4275 if ($Cnf{"Internal"} == 0) { |
|
4276 $ym=$md=$dh=""; |
|
4277 $hmn=$mns=":"; |
|
4278 |
|
4279 } elsif ($Cnf{"Internal"} == 1) { |
|
4280 $ym=$md=$dh=$hmn=$mns=""; |
|
4281 |
|
4282 } elsif ($Cnf{"Internal"} == 2) { |
|
4283 $ym=$md="-"; |
|
4284 $dh=" "; |
|
4285 $hmn=$mns=":"; |
|
4286 |
|
4287 } else { |
|
4288 confess "ERROR: Invalid internal format in Date_Split.\n"; |
|
4289 } |
|
4290 |
|
4291 my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$"; |
|
4292 |
|
4293 if (not defined $date or $date eq '') { |
|
4294 if ($definitely_valid) { |
|
4295 die "bad date '$date'"; |
|
4296 } else { |
|
4297 return $t; |
|
4298 } |
|
4299 } |
|
4300 |
|
4301 if ($date =~ /$t/) { |
|
4302 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6); |
|
4303 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
|
4304 $d_in_m[2]=29 if (&Date_LeapYear($y)); |
|
4305 if ($d>$d_in_m[$m]) { |
|
4306 my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month"; |
|
4307 if ($definitely_valid) { |
|
4308 die $msg; |
|
4309 } |
|
4310 else { |
|
4311 warn $msg; |
|
4312 return (); |
|
4313 } |
|
4314 } |
|
4315 return ($y,$m,$d,$h,$mn,$s); |
|
4316 } |
|
4317 |
|
4318 if ($definitely_valid) { |
|
4319 die "invalid date $date: doesn't match regexp $t"; |
|
4320 } |
|
4321 return (); |
|
4322 } |
|
4323 |
|
4324 # This returns the date easter occurs on for a given year as ($month,$day). |
|
4325 # This is from the Calendar FAQ. |
|
4326 sub Date_Easter { |
|
4327 my($y)=@_; |
|
4328 $y=&Date_FixYear($y) if (length($y)==2); |
|
4329 |
|
4330 my($c) = $y/100; |
|
4331 my($g) = $y % 19; |
|
4332 my($k) = ($c-17)/25; |
|
4333 my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30; |
|
4334 $i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11)); |
|
4335 my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7; |
|
4336 my($l) = $i-$j; |
|
4337 my($m) = 3 + ($l+40)/44; |
|
4338 my($d) = $l + 28 - 31*($m/4); |
|
4339 return ($m,$d); |
|
4340 } |
|
4341 |
|
4342 # This takes a list of years, months, WeekOfMonth's, and optionally |
|
4343 # DayOfWeek's, and returns a list of dates. Optionally, a list of dates |
|
4344 # can be passed in as the 1st argument (with the 2nd argument the null list) |
|
4345 # and the year/month of these will be used. |
|
4346 # |
|
4347 # If $FDn is non-zero, the first week of the month contains the first |
|
4348 # occurence of this day (1=Monday). If $FIn is non-zero, the first week of |
|
4349 # the month contains the date (i.e. $FIn'th day of the month). |
|
4350 sub Date_Recur_WoM { |
|
4351 my($y,$m,$w,$d,$FDn,$FIn)=@_; |
|
4352 my(@y)=@$y; |
|
4353 my(@m)=@$m; |
|
4354 my(@w)=@$w; |
|
4355 my(@d)=@$d; |
|
4356 my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=(); |
|
4357 |
|
4358 if (@m) { |
|
4359 @tmp=(); |
|
4360 foreach $y (@y) { |
|
4361 return () if (length($y)==1 || length($y)==3 || ! &IsInt($y,0,9999)); |
|
4362 $y=&Date_FixYear($y) if (length($y)==2); |
|
4363 push(@tmp,$y); |
|
4364 } |
|
4365 @y=sort { $a<=>$b } (@tmp); |
|
4366 |
|
4367 return () if (! @m); |
|
4368 foreach $m (@m) { |
|
4369 return () if (! &IsInt($m,1,12)); |
|
4370 } |
|
4371 @m=sort { $a<=>$b } (@m); |
|
4372 |
|
4373 @tmp=@tmp2=(); |
|
4374 foreach $y (@y) { |
|
4375 foreach $m (@m) { |
|
4376 push(@tmp,$y); |
|
4377 push(@tmp2,$m); |
|
4378 } |
|
4379 } |
|
4380 |
|
4381 @y=@tmp; |
|
4382 @m=@tmp2; |
|
4383 |
|
4384 } else { |
|
4385 foreach $d0 (@y) { |
|
4386 @tmp=&Date_Split($d0); |
|
4387 return () if (! @tmp); |
|
4388 push(@tmp2,$tmp[0]); |
|
4389 push(@m,$tmp[1]); |
|
4390 } |
|
4391 @y=@tmp2; |
|
4392 } |
|
4393 |
|
4394 return () if (! @w); |
|
4395 foreach $w (@w) { |
|
4396 return () if ($w==0 || ! &IsInt($w,-5,5)); |
|
4397 } |
|
4398 |
|
4399 if (@d) { |
|
4400 foreach $d (@d) { |
|
4401 return () if (! &IsInt($d,1,7)); |
|
4402 } |
|
4403 @d=sort { $a<=>$b } (@d); |
|
4404 } |
|
4405 |
|
4406 @date=(); |
|
4407 foreach $y (@y) { |
|
4408 $m=shift(@m); |
|
4409 |
|
4410 # Find 1st day of this month and next month |
|
4411 $date0=&Date_Join($y,$m,1,0,0,0); |
|
4412 $date1=&DateCalc($date0,"+0:1:0:0:0:0:0"); |
|
4413 |
|
4414 if (@d) { |
|
4415 foreach $d (@d) { |
|
4416 # Find 1st occurence of DOW (in both months) |
|
4417 $d0=&Date_GetNext($date0,$d,1); |
|
4418 $d1=&Date_GetNext($date1,$d,1); |
|
4419 |
|
4420 @tmp=(); |
|
4421 while (&Date_Cmp($d0,$d1)<0) { |
|
4422 push(@tmp,$d0); |
|
4423 $d0=&DateCalc($d0,"+0:0:1:0:0:0:0"); |
|
4424 } |
|
4425 |
|
4426 @tmp2=(); |
|
4427 foreach $w (@w) { |
|
4428 if ($w>0) { |
|
4429 push(@tmp2,$tmp[$w-1]); |
|
4430 } else { |
|
4431 push(@tmp2,$tmp[$#tmp+1+$w]); |
|
4432 } |
|
4433 } |
|
4434 @tmp2=sort(@tmp2); |
|
4435 push(@date,@tmp2); |
|
4436 } |
|
4437 |
|
4438 } else { |
|
4439 # Find 1st day of 1st week |
|
4440 if ($FDn != 0) { |
|
4441 $date0=&Date_GetNext($date0,$FDn,1); |
|
4442 } else { |
|
4443 $date0=&Date_Join($y,$m,$FIn,0,0,0); |
|
4444 } |
|
4445 $date0=&Date_GetPrev($date0,$Cnf{"FirstDay"},1); |
|
4446 |
|
4447 # Find 1st day of 1st week of next month |
|
4448 if ($FDn != 0) { |
|
4449 $date1=&Date_GetNext($date1,$FDn,1); |
|
4450 } else { |
|
4451 $date1=&DateCalc($date1,"+0:0:0:".($FIn-1).":0:0:0") if ($FIn>1); |
|
4452 } |
|
4453 $date1=&Date_GetPrev($date1,$Cnf{"FirstDay"},1); |
|
4454 |
|
4455 @tmp=(); |
|
4456 while (&Date_Cmp($date0,$date1)<0) { |
|
4457 push(@tmp,$date0); |
|
4458 $date0=&DateCalc($date0,"+0:0:1:0:0:0:0"); |
|
4459 } |
|
4460 |
|
4461 @tmp2=(); |
|
4462 foreach $w (@w) { |
|
4463 if ($w>0) { |
|
4464 push(@tmp2,$tmp[$w-1]); |
|
4465 } else { |
|
4466 push(@tmp2,$tmp[$#tmp+1+$w]); |
|
4467 } |
|
4468 } |
|
4469 @tmp2=sort(@tmp2); |
|
4470 push(@date,@tmp2); |
|
4471 } |
|
4472 } |
|
4473 |
|
4474 @date; |
|
4475 } |
|
4476 |
|
4477 # This returns a sorted list of dates formed by adding/subtracting |
|
4478 # $delta to $dateb in the range $date0<=$d<$dateb. The first date int |
|
4479 # the list is actually the first date<$date0 and the last date in the |
|
4480 # list is the first date>=$date1 (because sometimes the set part will |
|
4481 # move the date back into the range). |
|
4482 sub Date_Recur { |
|
4483 my($date0,$date1,$dateb,$delta)=@_; |
|
4484 my(@ret,$d)=(); |
|
4485 |
|
4486 while (&Date_Cmp($dateb,$date0)<0) { |
|
4487 $dateb=&DateCalc_DateDelta($dateb,$delta); |
|
4488 } |
|
4489 while (&Date_Cmp($dateb,$date1)>=0) { |
|
4490 $dateb=&DateCalc_DateDelta($dateb,"-$delta"); |
|
4491 } |
|
4492 |
|
4493 # Add the dates $date0..$dateb |
|
4494 $d=$dateb; |
|
4495 while (&Date_Cmp($d,$date0)>=0) { |
|
4496 unshift(@ret,$d); |
|
4497 $d=&DateCalc_DateDelta($d,"-$delta"); |
|
4498 } |
|
4499 # Add the first date earler than the range |
|
4500 unshift(@ret,$d); |
|
4501 |
|
4502 # Add the dates $dateb..$date1 |
|
4503 $d=&DateCalc_DateDelta($dateb,$delta); |
|
4504 while (&Date_Cmp($d,$date1)<0) { |
|
4505 push(@ret,$d); |
|
4506 $d=&DateCalc_DateDelta($d,$delta); |
|
4507 } |
|
4508 # Add the first date later than the range |
|
4509 push(@ret,$d); |
|
4510 |
|
4511 @ret; |
|
4512 } |
|
4513 |
|
4514 # This sets the values in each date of a recurrence. |
|
4515 # |
|
4516 # $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1", |
|
4517 # they are not set (and none of the larger elements are set). |
|
4518 sub Date_RecurSetTime { |
|
4519 my($date0,$date1,$dates,$h,$m,$s)=@_; |
|
4520 my(@dates)=@$dates; |
|
4521 my(@h,@m,@s,$date,@tmp)=(); |
|
4522 |
|
4523 $m="-1" if ($s eq "-1"); |
|
4524 $h="-1" if ($m eq "-1"); |
|
4525 |
|
4526 if ($h ne "-1") { |
|
4527 @h=&ReturnList($h); |
|
4528 return () if ! (@h); |
|
4529 @h=sort { $a<=>$b } (@h); |
|
4530 |
|
4531 @tmp=(); |
|
4532 foreach $date (@dates) { |
|
4533 foreach $h (@h) { |
|
4534 push(@tmp,&Date_SetDateField($date,"h",$h,1)); |
|
4535 } |
|
4536 } |
|
4537 @dates=@tmp; |
|
4538 } |
|
4539 |
|
4540 if ($m ne "-1") { |
|
4541 @m=&ReturnList($m); |
|
4542 return () if ! (@m); |
|
4543 @m=sort { $a<=>$b } (@m); |
|
4544 |
|
4545 @tmp=(); |
|
4546 foreach $date (@dates) { |
|
4547 foreach $m (@m) { |
|
4548 push(@tmp,&Date_SetDateField($date,"mn",$m,1)); |
|
4549 } |
|
4550 } |
|
4551 @dates=@tmp; |
|
4552 } |
|
4553 |
|
4554 if ($s ne "-1") { |
|
4555 @s=&ReturnList($s); |
|
4556 return () if ! (@s); |
|
4557 @s=sort { $a<=>$b } (@s); |
|
4558 |
|
4559 @tmp=(); |
|
4560 foreach $date (@dates) { |
|
4561 foreach $s (@s) { |
|
4562 push(@tmp,&Date_SetDateField($date,"s",$s,1)); |
|
4563 } |
|
4564 } |
|
4565 @dates=@tmp; |
|
4566 } |
|
4567 |
|
4568 @tmp=(); |
|
4569 foreach $date (@dates) { |
|
4570 push(@tmp,$date) if (&Date_Cmp($date,$date0)>=0 && |
|
4571 &Date_Cmp($date,$date1)<0 && |
|
4572 &Date_Split($date)); |
|
4573 } |
|
4574 |
|
4575 @tmp; |
|
4576 } |
|
4577 |
|
4578 sub DateCalc_DateDate { |
|
4579 print "DEBUG: DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/); |
|
4580 my($D1,$D2,$mode)=@_; |
|
4581 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
|
4582 $mode=0 if (! defined $mode); |
|
4583 |
|
4584 # Exact mode |
|
4585 if ($mode==0) { |
|
4586 my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split($D1, 1); |
|
4587 my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split($D2, 1); |
|
4588 my($i,@delta,$d,$delta,$y)=(); |
|
4589 |
|
4590 # form the delta for hour/min/sec |
|
4591 $delta[4]=$h2-$h1; |
|
4592 $delta[5]=$mn2-$mn1; |
|
4593 $delta[6]=$s2-$s1; |
|
4594 |
|
4595 # form the delta for yr/mon/day |
|
4596 $delta[0]=$delta[1]=0; |
|
4597 $d=0; |
|
4598 if ($y2>$y1) { |
|
4599 $d=&Date_DaysInYear($y1) - &Date_DayOfYear($m1,$d1,$y1); |
|
4600 $d+=&Date_DayOfYear($m2,$d2,$y2); |
|
4601 for ($y=$y1+1; $y<$y2; $y++) { |
|
4602 $d+= &Date_DaysInYear($y); |
|
4603 } |
|
4604 } elsif ($y2<$y1) { |
|
4605 $d=&Date_DaysInYear($y2) - &Date_DayOfYear($m2,$d2,$y2); |
|
4606 $d+=&Date_DayOfYear($m1,$d1,$y1); |
|
4607 for ($y=$y2+1; $y<$y1; $y++) { |
|
4608 $d+= &Date_DaysInYear($y); |
|
4609 } |
|
4610 $d *= -1; |
|
4611 } else { |
|
4612 $d=&Date_DayOfYear($m2,$d2,$y2) - &Date_DayOfYear($m1,$d1,$y1); |
|
4613 } |
|
4614 $delta[2]=0; |
|
4615 $delta[3]=$d; |
|
4616 |
|
4617 for ($i=0; $i<7; $i++) { |
|
4618 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0); |
|
4619 } |
|
4620 |
|
4621 $delta=join(":",@delta); |
|
4622 $delta=&Delta_Normalize($delta,0); |
|
4623 return $delta; |
|
4624 } |
|
4625 |
|
4626 my($date1,$date2)=($D1,$D2); |
|
4627 my($tmp,$sign,$err,@tmp)=(); |
|
4628 |
|
4629 # make sure both are work days |
|
4630 if ($mode==2 || $mode==3) { |
|
4631 $date1=&Date_NextWorkDay($date1,0,1); |
|
4632 $date2=&Date_NextWorkDay($date2,0,1); |
|
4633 } |
|
4634 |
|
4635 # make sure date1 comes before date2 |
|
4636 if (&Date_Cmp($date1,$date2)>0) { |
|
4637 $sign="-"; |
|
4638 $tmp=$date1; |
|
4639 $date1=$date2; |
|
4640 $date2=$tmp; |
|
4641 } else { |
|
4642 $sign="+"; |
|
4643 } |
|
4644 if (&Date_Cmp($date1,$date2)==0) { |
|
4645 return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"}); |
|
4646 return "+0:0:0:0:0:0:0"; |
|
4647 } |
|
4648 |
|
4649 my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split($date1, 1); |
|
4650 my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split($date2, 1); |
|
4651 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0); |
|
4652 |
|
4653 if ($mode != 3) { |
|
4654 |
|
4655 # Do years |
|
4656 $dy=$y2-$y1; |
|
4657 $dm=0; |
|
4658 if ($dy>0) { |
|
4659 $tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0); |
|
4660 if (&Date_Cmp($tmp,$date2)>0) { |
|
4661 $dy--; |
|
4662 $tmp=$date1; |
|
4663 $tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0) |
|
4664 if ($dy>0); |
|
4665 $dm=12; |
|
4666 } |
|
4667 $date1=$tmp; |
|
4668 } |
|
4669 |
|
4670 # Do months |
|
4671 $dm+=$m2-$m1; |
|
4672 if ($dm>0) { |
|
4673 $tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0); |
|
4674 if (&Date_Cmp($tmp,$date2)>0) { |
|
4675 $dm--; |
|
4676 $tmp=$date1; |
|
4677 $tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0) |
|
4678 if ($dm>0); |
|
4679 } |
|
4680 $date1=$tmp; |
|
4681 } |
|
4682 |
|
4683 # At this point, check to see that we're on a business day again so that |
|
4684 # Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month |
|
4685 if ($mode==2) { |
|
4686 if (! &Date_IsWorkDay($date1,0)) { |
|
4687 $date1=&Date_NextWorkDay($date1,0,1); |
|
4688 } |
|
4689 } |
|
4690 } |
|
4691 |
|
4692 # Do days |
|
4693 if ($mode==2 || $mode==3) { |
|
4694 $dd=0; |
|
4695 while (1) { |
|
4696 $tmp=&Date_NextWorkDay($date1,1,1); |
|
4697 if (&Date_Cmp($tmp,$date2)<=0) { |
|
4698 $dd++; |
|
4699 $date1=$tmp; |
|
4700 } else { |
|
4701 last; |
|
4702 } |
|
4703 } |
|
4704 |
|
4705 } else { |
|
4706 ($y1,$m1,$d1)=( &Date_Split($date1, 1) )[0..2]; |
|
4707 $dd=0; |
|
4708 # If we're jumping across months, set $d1 to the first of the next month |
|
4709 # (or possibly the 0th of next month which is equivalent to the last day |
|
4710 # of this month) |
|
4711 if ($m1!=$m2) { |
|
4712 $d_in_m[2]=29 if (&Date_LeapYear($y1)); |
|
4713 $dd=$d_in_m[$m1]-$d1+1; |
|
4714 $d1=1; |
|
4715 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0); |
|
4716 if (&Date_Cmp($tmp,$date2)>0) { |
|
4717 $dd--; |
|
4718 $d1--; |
|
4719 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0); |
|
4720 } |
|
4721 $date1=$tmp; |
|
4722 } |
|
4723 |
|
4724 $ddd=0; |
|
4725 if ($d1<$d2) { |
|
4726 $ddd=$d2-$d1; |
|
4727 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0); |
|
4728 if (&Date_Cmp($tmp,$date2)>0) { |
|
4729 $ddd--; |
|
4730 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0); |
|
4731 } |
|
4732 $date1=$tmp; |
|
4733 } |
|
4734 $dd+=$ddd; |
|
4735 } |
|
4736 |
|
4737 # in business mode, make sure h1 comes before h2 (if not find delta between |
|
4738 # now and end of day and move to start of next business day) |
|
4739 $d1=( &Date_Split($date1, 1) )[2]; |
|
4740 $dh=$dmn=$ds=0; |
|
4741 if ($mode==2 || $mode==3 and $d1 != $d2) { |
|
4742 $tmp=&Date_SetTime($date1,$Cnf{"WorkDayEnd"}); |
|
4743 $tmp=&DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0") |
|
4744 if ($Cnf{"WorkDay24Hr"}); |
|
4745 $tmp=&DateCalc_DateDate($date1,$tmp,0); |
|
4746 ($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=&Delta_Split($tmp); |
|
4747 $date1=&Date_NextWorkDay($date1,1,0); |
|
4748 $date1=&Date_SetTime($date1,$Cnf{"WorkDayBeg"}); |
|
4749 $d1=( &Date_Split($date1, 1) )[2]; |
|
4750 confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2); |
|
4751 } |
|
4752 |
|
4753 # Hours, minutes, seconds |
|
4754 $tmp=&DateCalc_DateDate($date1,$date2,0); |
|
4755 @tmp=&Delta_Split($tmp); |
|
4756 $dh += $tmp[4]; |
|
4757 $dmn += $tmp[5]; |
|
4758 $ds += $tmp[6]; |
|
4759 |
|
4760 $tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds"; |
|
4761 &Delta_Normalize($tmp,$mode); |
|
4762 } |
|
4763 |
|
4764 sub DateCalc_DeltaDelta { |
|
4765 print "DEBUG: DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/); |
|
4766 my($D1,$D2,$mode)=@_; |
|
4767 my(@delta1,@delta2,$i,$delta,@delta)=(); |
|
4768 $mode=0 if (! defined $mode); |
|
4769 |
|
4770 @delta1=&Delta_Split($D1); |
|
4771 @delta2=&Delta_Split($D2); |
|
4772 for ($i=0; $i<7; $i++) { |
|
4773 $delta[$i]=$delta1[$i]+$delta2[$i]; |
|
4774 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0); |
|
4775 } |
|
4776 |
|
4777 $delta=join(":",@delta); |
|
4778 $delta=&Delta_Normalize($delta,$mode); |
|
4779 return $delta; |
|
4780 } |
|
4781 |
|
4782 sub DateCalc_DateDelta { |
|
4783 print "DEBUG: DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/); |
|
4784 my($D1,$D2,$errref,$mode)=@_; |
|
4785 my($date)=(); |
|
4786 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
|
4787 my($h1,$m1,$h2,$m2,$len,$hh,$mm)=(); |
|
4788 $mode=0 if (! defined $mode); |
|
4789 |
|
4790 if ($mode==2 || $mode==3) { |
|
4791 $h1=$Curr{"WDBh"}; |
|
4792 $m1=$Curr{"WDBm"}; |
|
4793 $h2=$Curr{"WDEh"}; |
|
4794 $m2=$Curr{"WDEm"}; |
|
4795 $hh=$h2-$h1; |
|
4796 $mm=$m2-$m1; |
|
4797 if ($mm<0) { |
|
4798 $hh--; |
|
4799 $mm+=60; |
|
4800 } |
|
4801 } |
|
4802 |
|
4803 # Date, delta |
|
4804 my($y,$m,$d,$h,$mn,$s)=&Date_Split($D1, 1); |
|
4805 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=&Delta_Split($D2); |
|
4806 |
|
4807 # do the month/year part |
|
4808 $y+=$dy; |
|
4809 while (length($y)<4) { |
|
4810 $y = "0$y"; |
|
4811 } |
|
4812 &ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11 |
|
4813 $d_in_m[2]=29 if (&Date_LeapYear($y)); |
|
4814 |
|
4815 # if we have gone past the last day of a month, move the date back to |
|
4816 # the last day of the month |
|
4817 if ($d>$d_in_m[$m]) { |
|
4818 $d=$d_in_m[$m]; |
|
4819 } |
|
4820 |
|
4821 # do the week part |
|
4822 if ($mode==0 || $mode==1) { |
|
4823 $dd += $dw*7; |
|
4824 } else { |
|
4825 $date=&DateCalc_DateDelta(&Date_Join($y,$m,$d,$h,$mn,$s), |
|
4826 "+0:0:$dw:0:0:0:0",0); |
|
4827 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1); |
|
4828 } |
|
4829 |
|
4830 # in business mode, set the day to a work day at this point so the h/mn/s |
|
4831 # stuff will work out |
|
4832 if ($mode==2 || $mode==3) { |
|
4833 $d=$d_in_m[$m] if ($d>$d_in_m[$m]); |
|
4834 $date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),0,1); |
|
4835 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1); |
|
4836 } |
|
4837 |
|
4838 # seconds, minutes, hours |
|
4839 &ModuloAddition(60,$ds,\$s,\$mn); |
|
4840 if ($mode==2 || $mode==3) { |
|
4841 while (1) { |
|
4842 &ModuloAddition(60,$dmn,\$mn,\$h); |
|
4843 $h+= $dh; |
|
4844 |
|
4845 if ($h>$h2 or $h==$h2 && $mn>$m2) { |
|
4846 $dh=$h-$h2; |
|
4847 $dmn=$mn-$m2; |
|
4848 $h=$h1; |
|
4849 $mn=$m1; |
|
4850 $dd++; |
|
4851 |
|
4852 } elsif ($h<$h1 or $h==$h1 && $mn<$m1) { |
|
4853 $dh=$h-$h1; |
|
4854 $dmn=$m1-$mn; |
|
4855 $h=$h2; |
|
4856 $mn=$m2; |
|
4857 $dd--; |
|
4858 |
|
4859 } elsif ($h==$h2 && $mn==$m2) { |
|
4860 $dd++; |
|
4861 $dh=-$hh; |
|
4862 $dmn=-$mm; |
|
4863 |
|
4864 } else { |
|
4865 last; |
|
4866 } |
|
4867 } |
|
4868 |
|
4869 } else { |
|
4870 &ModuloAddition(60,$dmn,\$mn,\$h); |
|
4871 &ModuloAddition(24,$dh,\$h,\$d); |
|
4872 } |
|
4873 |
|
4874 # If we have just gone past the last day of the month, we need to make |
|
4875 # up for this: |
|
4876 if ($d>$d_in_m[$m]) { |
|
4877 $dd+= $d-$d_in_m[$m]; |
|
4878 $d=$d_in_m[$m]; |
|
4879 } |
|
4880 |
|
4881 # days |
|
4882 if ($mode==2 || $mode==3) { |
|
4883 if ($dd>=0) { |
|
4884 $date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),$dd,1); |
|
4885 } else { |
|
4886 $date=&Date_PrevWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1); |
|
4887 } |
|
4888 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1); |
|
4889 |
|
4890 } else { |
|
4891 $d_in_m[2]=29 if (&Date_LeapYear($y)); |
|
4892 $d=$d_in_m[$m] if ($d>$d_in_m[$m]); |
|
4893 $d += $dd; |
|
4894 while ($d<1) { |
|
4895 $m--; |
|
4896 if ($m==0) { |
|
4897 $m=12; |
|
4898 $y--; |
|
4899 if (&Date_LeapYear($y)) { |
|
4900 $d_in_m[2]=29; |
|
4901 } else { |
|
4902 $d_in_m[2]=28; |
|
4903 } |
|
4904 } |
|
4905 $d += $d_in_m[$m]; |
|
4906 } |
|
4907 while ($d>$d_in_m[$m]) { |
|
4908 $d -= $d_in_m[$m]; |
|
4909 $m++; |
|
4910 if ($m==13) { |
|
4911 $m=1; |
|
4912 $y++; |
|
4913 if (&Date_LeapYear($y)) { |
|
4914 $d_in_m[2]=29; |
|
4915 } else { |
|
4916 $d_in_m[2]=28; |
|
4917 } |
|
4918 } |
|
4919 } |
|
4920 } |
|
4921 |
|
4922 if ($y<0 or $y>9999) { |
|
4923 $$errref=3; |
|
4924 return; |
|
4925 } |
|
4926 &Date_Join($y,$m,$d,$h,$mn,$s); |
|
4927 } |
|
4928 |
|
4929 sub Date_UpdateHolidays { |
|
4930 print "DEBUG: Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/); |
|
4931 my($year)=@_; |
|
4932 $Holiday{"year"}=$year; |
|
4933 $Holiday{"dates"}{$year}={}; |
|
4934 |
|
4935 my($date,$delta,$err)=(); |
|
4936 my($key,@tmp,$tmp); |
|
4937 |
|
4938 foreach $key (keys %{ $Holiday{"desc"} }) { |
|
4939 @tmp=&Recur_Split($key); |
|
4940 if (@tmp) { |
|
4941 $tmp=&ParseDateString("${year}010100:00:00"); |
|
4942 ($date)=&ParseRecur($key,$tmp,$tmp,($year+1)."-01-01"); |
|
4943 next if (! $date); |
|
4944 |
|
4945 } elsif ($key =~ /^(.*)([+-].*)$/) { |
|
4946 # Date +/- Delta |
|
4947 ($date,$delta)=($1,$2); |
|
4948 $tmp=&ParseDateString("$date $year"); |
|
4949 if ($tmp) { |
|
4950 $date=$tmp; |
|
4951 } else { |
|
4952 $date=&ParseDateString($date); |
|
4953 next if ($date !~ /^$year/); |
|
4954 } |
|
4955 $date=&DateCalc($date,$delta,\$err,0); |
|
4956 |
|
4957 } else { |
|
4958 # Date |
|
4959 $date=$key; |
|
4960 $tmp=&ParseDateString("$date $year"); |
|
4961 if ($tmp) { |
|
4962 $date=$tmp; |
|
4963 } else { |
|
4964 $date=&ParseDateString($date); |
|
4965 next if ($date !~ /^$year/); |
|
4966 } |
|
4967 } |
|
4968 $Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key}; |
|
4969 } |
|
4970 } |
|
4971 |
|
4972 # This sets a Date::Manip config variable. |
|
4973 sub Date_SetConfigVariable { |
|
4974 print "DEBUG: Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/); |
|
4975 my($var,$val)=@_; |
|
4976 |
|
4977 # These are most appropriate for command line options instead of in files. |
|
4978 $Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i); |
|
4979 $Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i); |
|
4980 $Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i); |
|
4981 &EraseHolidays(), return if ($var =~ /^EraseHolidays$/i); |
|
4982 $Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i); |
|
4983 $Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i); |
|
4984 |
|
4985 $Curr{"InitLang"}=1, |
|
4986 $Cnf{"Language"}=$val, return if ($var =~ /^Language$/i); |
|
4987 $Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i); |
|
4988 $Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i); |
|
4989 $Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i); |
|
4990 $Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i); |
|
4991 $Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i); |
|
4992 $Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i); |
|
4993 $Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i); |
|
4994 $Cnf{"WorkDayBeg"}=$val, |
|
4995 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i); |
|
4996 $Cnf{"WorkDayEnd"}=$val, |
|
4997 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i); |
|
4998 $Cnf{"WorkDay24Hr"}=$val, |
|
4999 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i); |
|
5000 $Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i); |
|
5001 $Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i); |
|
5002 $Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i); |
|
5003 $Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i); |
|
5004 $Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i); |
|
5005 $Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i); |
|
5006 $Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i); |
|
5007 $Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i); |
|
5008 |
|
5009 confess "ERROR: Unknown configuration variable $var in Date::Manip.\n"; |
|
5010 } |
|
5011 |
|
5012 sub EraseHolidays { |
|
5013 print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/); |
|
5014 |
|
5015 $Cnf{"EraseHolidays"}=0; |
|
5016 delete $Holiday{"list"}; |
|
5017 $Holiday{"list"}={}; |
|
5018 delete $Holiday{"desc"}; |
|
5019 $Holiday{"desc"}={}; |
|
5020 $Holiday{"dates"}={}; |
|
5021 } |
|
5022 |
|
5023 # This returns a pointer to a list of times and events in the format |
|
5024 # [ date, [ events ], date, [ events ], ... ] |
|
5025 # where each list of events are events that are in effect at the date |
|
5026 # immediately preceding the list. |
|
5027 # |
|
5028 # This takes either one date or two dates as arguments. |
|
5029 sub Events_Calc { |
|
5030 print "DEBUG: Events_Calc\n" if ($Curr{"Debug"} =~ /trace/); |
|
5031 |
|
5032 my($date0,$date1)=@_; |
|
5033 |
|
5034 my($tmp); |
|
5035 $date0=&ParseDateString($date0); |
|
5036 return undef if (! $date0); |
|
5037 if ($date1) { |
|
5038 $date1=&ParseDateString($date1); |
|
5039 if (&Date_Cmp($date0,$date1)>0) { |
|
5040 $tmp=$date1; |
|
5041 $date1=$date0; |
|
5042 $date0=$tmp; |
|
5043 } |
|
5044 } else { |
|
5045 $date1=&DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1"); |
|
5046 } |
|
5047 |
|
5048 # |
|
5049 # [ d0,d1,del,name ] => [ d0, d1+del ) |
|
5050 # [ d0,0,del,name ] => [ d0, d0+del ) |
|
5051 # |
|
5052 my(%ret,$d0,$d1,$del,$name,$c0,$c1); |
|
5053 my(@tmp)=@{ $Events{"dates"} }; |
|
5054 DATE: while (@tmp) { |
|
5055 ($d0,$d1,$del,$name)=splice(@tmp,0,4); |
|
5056 $d0=&ParseDateString($d0); |
|
5057 $d1=&ParseDateString($d1) if ($d1); |
|
5058 $del=&ParseDateDelta($del) if ($del); |
|
5059 if ($d1) { |
|
5060 if ($del) { |
|
5061 $d1=&DateCalc_DateDelta($d1,$del); |
|
5062 } |
|
5063 } else { |
|
5064 $d1=&DateCalc_DateDelta($d0,$del); |
|
5065 } |
|
5066 if (&Date_Cmp($d0,$d1)>0) { |
|
5067 $tmp=$d1; |
|
5068 $d1=$d0; |
|
5069 $d0=$tmp; |
|
5070 } |
|
5071 # [ date0,date1 ) |
|
5072 # [ d0,d1 ) OR [ d0,d1 ) |
|
5073 next DATE if (&Date_Cmp($d1,$date0)<=0 || |
|
5074 &Date_Cmp($d0,$date1)>=0); |
|
5075 # [ date0,date1 ) |
|
5076 # [ d0,d1 ) |
|
5077 # [ d0, d1 ) |
|
5078 if (&Date_Cmp($d0,$date0)<=0) { |
|
5079 push @{ $ret{$date0} },$name; |
|
5080 push @{ $ret{$d1} },"!$name" if (&Date_Cmp($d1,$date1)<0); |
|
5081 next DATE; |
|
5082 } |
|
5083 # [ date0,date1 ) |
|
5084 # [ d0,d1 ) |
|
5085 if (&Date_Cmp($d1,$date1)>=0) { |
|
5086 push @{ $ret{$d0} },$name; |
|
5087 next DATE; |
|
5088 } |
|
5089 # [ date0,date1 ) |
|
5090 # [ d0,d1 ) |
|
5091 push @{ $ret{$d0} },$name; |
|
5092 push @{ $ret{$d1} },"!$name"; |
|
5093 } |
|
5094 |
|
5095 # |
|
5096 # [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} ) |
|
5097 # |
|
5098 my($rec,$del0,$del1,@d); |
|
5099 @tmp=@{ $Events{"recur"} }; |
|
5100 RECUR: while (@tmp) { |
|
5101 ($rec,$del0,$del1,$name)=splice(@tmp,0,4); |
|
5102 @d=(); |
|
5103 |
|
5104 } |
|
5105 |
|
5106 # Sort them AND take into account the "!$name" entries. |
|
5107 my(%tmp,$date,@tmp2,@ret); |
|
5108 @d=sort { &Date_Cmp($a,$b) } keys %ret; |
|
5109 foreach $date (@d) { |
|
5110 @tmp=@{ $ret{$date} }; |
|
5111 @tmp2=(); |
|
5112 foreach $tmp (@tmp) { |
|
5113 push(@tmp2,$tmp), next if ($tmp =~ /^!/); |
|
5114 $tmp{$tmp}=1; |
|
5115 } |
|
5116 foreach $tmp (@tmp2) { |
|
5117 $tmp =~ s/^!//; |
|
5118 delete $tmp{$tmp}; |
|
5119 } |
|
5120 push(@ret,$date,[ keys %tmp ]); |
|
5121 } |
|
5122 |
|
5123 return \@ret; |
|
5124 } |
|
5125 |
|
5126 # This parses the raw events list |
|
5127 sub Events_ParseRaw { |
|
5128 print "DEBUG: Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/); |
|
5129 |
|
5130 # Only need to be parsed once |
|
5131 my($force)=@_; |
|
5132 $Events{"parsed"}=0 if ($force); |
|
5133 return if ($Events{"parsed"}); |
|
5134 $Events{"parsed"}=1; |
|
5135 |
|
5136 my(@events)=@{ $Events{"raw"} }; |
|
5137 my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r, |
|
5138 $recur); |
|
5139 EVENT: while (@events) { |
|
5140 ($event,$name)=splice(@events,0,2); |
|
5141 @event=split(/\s*;\s*/,$event); |
|
5142 |
|
5143 if ($#event == 0) { |
|
5144 |
|
5145 if ($date0=&ParseDateString($event[0])) { |
|
5146 # |
|
5147 # date = event |
|
5148 # |
|
5149 $tmp=&ParseDateString("$event[0] 00:00:00"); |
|
5150 if ($tmp && $tmp eq $date0) { |
|
5151 $delta="+0:0:0:1:0:0:0"; |
|
5152 } else { |
|
5153 $delta="+0:0:0:0:1:0:0"; |
|
5154 } |
|
5155 push @{ $Events{"dates"} },($date0,0,$delta,$name); |
|
5156 |
|
5157 } elsif ($recur=&ParseRecur($event[0])) { |
|
5158 # |
|
5159 # recur = event |
|
5160 # |
|
5161 ($recur0,$recur1)=&Recur_Split($recur); |
|
5162 if ($recur0) { |
|
5163 if ($recur1) { |
|
5164 $r="$recur0:$recur1"; |
|
5165 } else { |
|
5166 $r=$recur0; |
|
5167 } |
|
5168 } else { |
|
5169 $r=$recur1; |
|
5170 } |
|
5171 (@recur)=split(/:/,$r); |
|
5172 if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) { |
|
5173 $delta="+0:0:0:1:0:0:0"; |
|
5174 } else { |
|
5175 $delta="+0:0:0:0:1:0:0"; |
|
5176 } |
|
5177 push @{ $Events{"recur"} },($recur,0,$delta,$name); |
|
5178 |
|
5179 } else { |
|
5180 # ??? = event |
|
5181 warn "WARNING: illegal event ignored [ @event ]\n"; |
|
5182 next EVENT; |
|
5183 } |
|
5184 |
|
5185 } elsif ($#event == 1) { |
|
5186 |
|
5187 if ($date0=&ParseDateString($event[0])) { |
|
5188 |
|
5189 if ($date1=&ParseDateString($event[1])) { |
|
5190 # |
|
5191 # date ; date = event |
|
5192 # |
|
5193 $tmp=&ParseDateString("$event[1] 00:00:00"); |
|
5194 if ($tmp && $tmp eq $date1) { |
|
5195 $date1=&DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0"); |
|
5196 } |
|
5197 push @{ $Events{"dates"} },($date0,$date1,0,$name); |
|
5198 |
|
5199 } elsif ($delta=&ParseDateDelta($event[1])) { |
|
5200 # |
|
5201 # date ; delta = event |
|
5202 # |
|
5203 push @{ $Events{"dates"} },($date0,0,$delta,$name); |
|
5204 |
|
5205 } else { |
|
5206 # date ; ??? = event |
|
5207 warn "WARNING: illegal event ignored [ @event ]\n"; |
|
5208 next EVENT; |
|
5209 } |
|
5210 |
|
5211 } elsif ($recur=&ParseRecur($event[0])) { |
|
5212 |
|
5213 if ($delta=&ParseDateDelta($event[1])) { |
|
5214 # |
|
5215 # recur ; delta = event |
|
5216 # |
|
5217 push @{ $Events{"recur"} },($recur,0,$delta,$name); |
|
5218 |
|
5219 } else { |
|
5220 # recur ; ??? = event |
|
5221 warn "WARNING: illegal event ignored [ @event ]\n"; |
|
5222 next EVENT; |
|
5223 } |
|
5224 |
|
5225 } else { |
|
5226 # ??? ; ??? = event |
|
5227 warn "WARNING: illegal event ignored [ @event ]\n"; |
|
5228 next EVENT; |
|
5229 } |
|
5230 |
|
5231 } else { |
|
5232 # date ; delta0 ; delta1 = event |
|
5233 # recur ; delta0 ; delta1 = event |
|
5234 # ??? ; ??? ; ??? ... = event |
|
5235 warn "WARNING: illegal event ignored [ @event ]\n"; |
|
5236 next EVENT; |
|
5237 } |
|
5238 } |
|
5239 } |
|
5240 |
|
5241 # This reads an init file. |
|
5242 sub Date_InitFile { |
|
5243 print "DEBUG: Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/); |
|
5244 my($file)=@_; |
|
5245 my($in)=new IO::File; |
|
5246 local($_)=(); |
|
5247 my($section)="vars"; |
|
5248 my($var,$val,$recur,$name)=(); |
|
5249 |
|
5250 $in->open($file) || return; |
|
5251 while(defined ($_=<$in>)) { |
|
5252 chomp; |
|
5253 s/^\s+//; |
|
5254 s/\s+$//; |
|
5255 next if (! $_ or /^\#/); |
|
5256 |
|
5257 if (/^\*holiday/i) { |
|
5258 $section="holiday"; |
|
5259 &EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"}); |
|
5260 next; |
|
5261 } elsif (/^\*events/i) { |
|
5262 $section="events"; |
|
5263 next; |
|
5264 } |
|
5265 |
|
5266 if ($section =~ /var/i) { |
|
5267 confess "ERROR: invalid Date::Manip config file line.\n $_\n" |
|
5268 if (! /(.*\S)\s*=\s*(.*)$/); |
|
5269 ($var,$val)=($1,$2); |
|
5270 &Date_SetConfigVariable($var,$val); |
|
5271 |
|
5272 } elsif ($section =~ /holiday/i) { |
|
5273 confess "ERROR: invalid Date::Manip config file line.\n $_\n" |
|
5274 if (! /(.*\S)\s*=\s*(.*)$/); |
|
5275 ($recur,$name)=($1,$2); |
|
5276 $name="" if (! defined $name); |
|
5277 $Holiday{"desc"}{$recur}=$name; |
|
5278 |
|
5279 } elsif ($section =~ /events/i) { |
|
5280 confess "ERROR: invalid Date::Manip config file line.\n $_\n" |
|
5281 if (! /(.*\S)\s*=\s*(.*)$/); |
|
5282 ($val,$var)=($1,$2); |
|
5283 push @{ $Events{"raw"} },($val,$var); |
|
5284 |
|
5285 } else { |
|
5286 # A section not currently used by Date::Manip (but may be |
|
5287 # used by some extension to it). |
|
5288 next; |
|
5289 } |
|
5290 } |
|
5291 close($in); |
|
5292 } |
|
5293 |
|
5294 # $flag=&Date_TimeCheck(\$h,\$mn,\$s,\$ampm); |
|
5295 # Returns 1 if any of the fields are bad. All fields are optional, and |
|
5296 # all possible checks are done on the data. If a field is not passed in, |
|
5297 # it is set to default values. If data is missing, appropriate defaults |
|
5298 # are supplied. |
|
5299 sub Date_TimeCheck { |
|
5300 print "DEBUG: Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/); |
|
5301 my($h,$mn,$s,$ampm)=@_; |
|
5302 my($tmp1,$tmp2,$tmp3)=(); |
|
5303 |
|
5304 $$h="" if (! defined $$h); |
|
5305 $$mn="" if (! defined $$mn); |
|
5306 $$s="" if (! defined $$s); |
|
5307 $$ampm="" if (! defined $$ampm); |
|
5308 $$ampm=uc($$ampm) if ($$ampm); |
|
5309 |
|
5310 # Check hour |
|
5311 $tmp1=$Lang{$Cnf{"Language"}}{"AmPm"}; |
|
5312 $tmp2=""; |
|
5313 if ($$ampm =~ /^$tmp1$/i) { |
|
5314 $tmp3=$Lang{$Cnf{"Language"}}{"AM"}; |
|
5315 $tmp2="AM" if ($$ampm =~ /^$tmp3$/i); |
|
5316 $tmp3=$Lang{$Cnf{"Language"}}{"PM"}; |
|
5317 $tmp2="PM" if ($$ampm =~ /^$tmp3$/i); |
|
5318 } elsif ($$ampm) { |
|
5319 return 1; |
|
5320 } |
|
5321 if ($tmp2 eq "AM" || $tmp2 eq "PM") { |
|
5322 $$h="0$$h" if (length($$h)==1); |
|
5323 return 1 if ($$h<1 || $$h>12); |
|
5324 $$h="00" if ($tmp2 eq "AM" and $$h==12); |
|
5325 $$h += 12 if ($tmp2 eq "PM" and $$h!=12); |
|
5326 } else { |
|
5327 $$h="00" if ($$h eq ""); |
|
5328 $$h="0$$h" if (length($$h)==1); |
|
5329 return 1 if (! &IsInt($$h,0,23)); |
|
5330 $tmp2="AM" if ($$h<12); |
|
5331 $tmp2="PM" if ($$h>=12); |
|
5332 } |
|
5333 $$ampm=$Lang{$Cnf{"Language"}}{"AMstr"}; |
|
5334 $$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM"); |
|
5335 |
|
5336 # Check minutes |
|
5337 $$mn="00" if ($$mn eq ""); |
|
5338 $$mn="0$$mn" if (length($$mn)==1); |
|
5339 return 1 if (! &IsInt($$mn,0,59)); |
|
5340 |
|
5341 # Check seconds |
|
5342 $$s="00" if ($$s eq ""); |
|
5343 $$s="0$$s" if (length($$s)==1); |
|
5344 return 1 if (! &IsInt($$s,0,59)); |
|
5345 |
|
5346 return 0; |
|
5347 } |
|
5348 |
|
5349 # $flag=&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk); |
|
5350 # Returns 1 if any of the fields are bad. All fields are optional, and |
|
5351 # all possible checks are done on the data. If a field is not passed in, |
|
5352 # it is set to default values. If data is missing, appropriate defaults |
|
5353 # are supplied. |
|
5354 # |
|
5355 # If the flag UpdateHolidays is set, the year is set to |
|
5356 # CurrHolidayYear. |
|
5357 sub Date_DateCheck { |
|
5358 print "DEBUG: Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/); |
|
5359 my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_; |
|
5360 my($tmp1,$tmp2,$tmp3)=(); |
|
5361 |
|
5362 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
|
5363 my($curr_y)=$Curr{"Y"}; |
|
5364 my($curr_m)=$Curr{"M"}; |
|
5365 my($curr_d)=$Curr{"D"}; |
|
5366 $$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d); |
|
5367 $$y="" if (! defined $$y); |
|
5368 $$m="" if (! defined $$m); |
|
5369 $$d="" if (! defined $$d); |
|
5370 $$wk="" if (! defined $$wk); |
|
5371 $$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq ""); |
|
5372 |
|
5373 # Check year. |
|
5374 $$y=$curr_y if ($$y eq ""); |
|
5375 $$y=&Date_FixYear($$y) if (length($$y)<4); |
|
5376 return 1 if (! &IsInt($$y,0,9999)); |
|
5377 $d_in_m[2]=29 if (&Date_LeapYear($$y)); |
|
5378 |
|
5379 # Check month |
|
5380 $$m=$curr_m if ($$m eq ""); |
|
5381 $$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)} |
|
5382 if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}); |
|
5383 $$m="0$$m" if (length($$m)==1); |
|
5384 return 1 if (! &IsInt($$m,1,12)); |
|
5385 |
|
5386 # Check day |
|
5387 $$d="01" if ($$d eq ""); |
|
5388 $$d="0$$d" if (length($$d)==1); |
|
5389 return 1 if (! &IsInt($$d,1,$d_in_m[$$m])); |
|
5390 if ($$wk) { |
|
5391 $tmp1=&Date_DayOfWeek($$m,$$d,$$y); |
|
5392 $tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)} |
|
5393 if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}); |
|
5394 return 1 if ($tmp1 != $tmp2); |
|
5395 } |
|
5396 |
|
5397 return &Date_TimeCheck($h,$mn,$s,$ampm); |
|
5398 } |
|
5399 |
|
5400 # Takes a year in 2 digit form and returns it in 4 digit form |
|
5401 sub Date_FixYear { |
|
5402 print "DEBUG: Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/); |
|
5403 my($y)=@_; |
|
5404 my($curr_y)=$Curr{"Y"}; |
|
5405 $y=$curr_y if (! defined $y or ! $y); |
|
5406 return $y if (length($y)==4); |
|
5407 confess "ERROR: Invalid year ($y)\n" if (length($y)!=2); |
|
5408 my($y1,$y2)=(); |
|
5409 |
|
5410 if (lc($Cnf{"YYtoYYYY"}) eq "c") { |
|
5411 $y1=substring($y,0,2); |
|
5412 $y="$y1$y"; |
|
5413 |
|
5414 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) { |
|
5415 $y1=$1; |
|
5416 $y="$y1$y"; |
|
5417 |
|
5418 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) { |
|
5419 $y1="$1$2"; |
|
5420 $y ="$1$y"; |
|
5421 $y += 100 if ($y<$y1); |
|
5422 |
|
5423 } else { |
|
5424 $y1=$curr_y-$Cnf{"YYtoYYYY"}; |
|
5425 $y2=$y1+99; |
|
5426 $y="19$y"; |
|
5427 while ($y<$y1) { |
|
5428 $y+=100; |
|
5429 } |
|
5430 while ($y>$y2) { |
|
5431 $y-=100; |
|
5432 } |
|
5433 } |
|
5434 $y; |
|
5435 } |
|
5436 |
|
5437 # &Date_NthWeekOfYear($y,$n); |
|
5438 # Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the |
|
5439 # year. |
|
5440 # &Date_NthWeekOfYear($y,$n,$dow,$flag); |
|
5441 # Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag |
|
5442 # is nil, the first DoW of the year may actually be in the previous |
|
5443 # year (since the 1st week may include days from the previous year). |
|
5444 # If flag is non-nil, the 1st DoW of the year refers to the 1st one |
|
5445 # actually in the year |
|
5446 sub Date_NthWeekOfYear { |
|
5447 print "DEBUG: Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/); |
|
5448 my($y,$n,$dow,$flag)=@_; |
|
5449 my($m,$d,$err,$tmp,$date,%dow)=(); |
|
5450 $y=$Curr{"Y"} if (! defined $y or ! $y); |
|
5451 $n=1 if (! defined $n or $n eq ""); |
|
5452 return () if ($n<0 || $n>53); |
|
5453 if (defined $dow) { |
|
5454 $dow=lc($dow); |
|
5455 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; |
|
5456 $dow=$dow{$dow} if (exists $dow{$dow}); |
|
5457 return () if ($dow<1 || $dow>7); |
|
5458 $flag="" if (! defined $flag); |
|
5459 } else { |
|
5460 $dow=""; |
|
5461 $flag=""; |
|
5462 } |
|
5463 |
|
5464 $y=&Date_FixYear($y) if (length($y)<4); |
|
5465 if ($Cnf{"Jan1Week1"}) { |
|
5466 $date=&Date_Join($y,1,1,0,0,0); |
|
5467 } else { |
|
5468 $date=&Date_Join($y,1,4,0,0,0); |
|
5469 } |
|
5470 $date=&Date_GetPrev($date,$Cnf{"FirstDay"},1); |
|
5471 $date=&Date_GetNext($date,$dow,1) if ($dow ne ""); |
|
5472 |
|
5473 if ($flag) { |
|
5474 ($tmp)=&Date_Split($date, 1); |
|
5475 $n++ if ($tmp != $y); |
|
5476 } |
|
5477 |
|
5478 if ($n>1) { |
|
5479 $date=&DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0); |
|
5480 } elsif ($n==0) { |
|
5481 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0); |
|
5482 } |
|
5483 ($y,$m,$d)=&Date_Split($date, 1); |
|
5484 ($y,$m,$d); |
|
5485 } |
|
5486 |
|
5487 ######################################################################## |
|
5488 # LANGUAGE INITIALIZATION |
|
5489 ######################################################################## |
|
5490 |
|
5491 # 8-bit international characters can be gotten by "\xXX". I don't know |
|
5492 # how to get 16-bit characters. I've got to read up on perllocale. |
|
5493 sub Char_8Bit { |
|
5494 my($hash)=@_; |
|
5495 |
|
5496 # grave ` |
|
5497 # A` 00c0 a` 00e0 |
|
5498 # E` 00c8 e` 00e8 |
|
5499 # I` 00cc i` 00ec |
|
5500 # O` 00d2 o` 00f2 |
|
5501 # U` 00d9 u` 00f9 |
|
5502 # W` 1e80 w` 1e81 |
|
5503 # Y` 1ef2 y` 1ef3 |
|
5504 |
|
5505 $$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE |
|
5506 $$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE |
|
5507 $$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE |
|
5508 $$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE |
|
5509 $$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE |
|
5510 $$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE |
|
5511 $$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE |
|
5512 $$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE |
|
5513 $$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE |
|
5514 $$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE |
|
5515 |
|
5516 # acute ' |
|
5517 # A' 00c1 a' 00e1 |
|
5518 # C' 0106 c' 0107 |
|
5519 # E' 00c9 e' 00e9 |
|
5520 # I' 00cd i' 00ed |
|
5521 # L' 0139 l' 013a |
|
5522 # N' 0143 n' 0144 |
|
5523 # O' 00d3 o' 00f3 |
|
5524 # R' 0154 r' 0155 |
|
5525 # S' 015a s' 015b |
|
5526 # U' 00da u' 00fa |
|
5527 # W' 1e82 w' 1e83 |
|
5528 # Y' 00dd y' 00fd |
|
5529 # Z' 0179 z' 017a |
|
5530 |
|
5531 $$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE |
|
5532 $$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE |
|
5533 $$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE |
|
5534 $$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE |
|
5535 $$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE |
|
5536 $$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE |
|
5537 $$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE |
|
5538 $$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE |
|
5539 $$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE |
|
5540 $$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE |
|
5541 $$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE |
|
5542 $$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE |
|
5543 |
|
5544 # double acute " " |
|
5545 # O" 0150 o" 0151 |
|
5546 # U" 0170 u" 0171 |
|
5547 |
|
5548 # circumflex ^ |
|
5549 # A^ 00c2 a^ 00e2 |
|
5550 # C^ 0108 c^ 0109 |
|
5551 # E^ 00ca e^ 00ea |
|
5552 # G^ 011c g^ 011d |
|
5553 # H^ 0124 h^ 0125 |
|
5554 # I^ 00ce i^ 00ee |
|
5555 # J^ 0134 j^ 0135 |
|
5556 # O^ 00d4 o^ 00f4 |
|
5557 # S^ 015c s^ 015d |
|
5558 # U^ 00db u^ 00fb |
|
5559 # W^ 0174 w^ 0175 |
|
5560 # Y^ 0176 y^ 0177 |
|
5561 |
|
5562 $$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX |
|
5563 $$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX |
|
5564 $$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX |
|
5565 $$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX |
|
5566 $$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX |
|
5567 $$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX |
|
5568 $$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX |
|
5569 $$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX |
|
5570 $$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX |
|
5571 $$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX |
|
5572 |
|
5573 # tilde ~ |
|
5574 # A~ 00c3 a~ 00e3 |
|
5575 # I~ 0128 i~ 0129 |
|
5576 # N~ 00d1 n~ 00f1 |
|
5577 # O~ 00d5 o~ 00f5 |
|
5578 # U~ 0168 u~ 0169 |
|
5579 |
|
5580 $$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE |
|
5581 $$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE |
|
5582 $$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE |
|
5583 $$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE |
|
5584 $$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE |
|
5585 $$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE |
|
5586 |
|
5587 # macron - |
|
5588 # A- 0100 a- 0101 |
|
5589 # E- 0112 e- 0113 |
|
5590 # I- 012a i- 012b |
|
5591 # O- 014c o- 014d |
|
5592 # U- 016a u- 016b |
|
5593 |
|
5594 # breve ( [half circle up] |
|
5595 # A( 0102 a( 0103 |
|
5596 # G( 011e g( 011f |
|
5597 # U( 016c u( 016d |
|
5598 |
|
5599 # dot . |
|
5600 # C. 010a c. 010b |
|
5601 # E. 0116 e. 0117 |
|
5602 # G. 0120 g. 0121 |
|
5603 # I. 0130 |
|
5604 # Z. 017b z. 017c |
|
5605 |
|
5606 # diaeresis : [side by side dots] |
|
5607 # A: 00c4 a: 00e4 |
|
5608 # E: 00cb e: 00eb |
|
5609 # I: 00cf i: 00ef |
|
5610 # O: 00d6 o: 00f6 |
|
5611 # U: 00dc u: 00fc |
|
5612 # W: 1e84 w: 1e85 |
|
5613 # Y: 0178 y: 00ff |
|
5614 |
|
5615 $$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS |
|
5616 $$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS |
|
5617 $$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS |
|
5618 $$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS |
|
5619 $$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS |
|
5620 $$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS |
|
5621 $$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS |
|
5622 $$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS |
|
5623 $$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS |
|
5624 $$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS |
|
5625 $$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS |
|
5626 |
|
5627 # ring o |
|
5628 # U0 016e u0 016f |
|
5629 |
|
5630 # cedilla , [squiggle down and left below the letter] |
|
5631 # ,C 00c7 ,c 00e7 |
|
5632 # ,G 0122 ,g 0123 |
|
5633 # ,K 0136 ,k 0137 |
|
5634 # ,L 013b ,l 013c |
|
5635 # ,N 0145 ,n 0146 |
|
5636 # ,R 0156 ,r 0157 |
|
5637 # ,S 015e ,s 015f |
|
5638 # ,T 0162 ,t 0163 |
|
5639 |
|
5640 $$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA |
|
5641 $$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA |
|
5642 |
|
5643 # ogonek ; [squiggle down and right below the letter] |
|
5644 # A; 0104 a; 0105 |
|
5645 # E; 0118 e; 0119 |
|
5646 # I; 012e i; 012f |
|
5647 # U; 0172 u; 0173 |
|
5648 |
|
5649 # caron < [little v on top] |
|
5650 # A< 01cd a< 01ce |
|
5651 # C< 010c c< 010d |
|
5652 # D< 010e d< 010f |
|
5653 # E< 011a e< 011b |
|
5654 # L< 013d l< 013e |
|
5655 # N< 0147 n< 0148 |
|
5656 # R< 0158 r< 0159 |
|
5657 # S< 0160 s< 0161 |
|
5658 # T< 0164 t< 0165 |
|
5659 # Z< 017d z< 017e |
|
5660 |
|
5661 |
|
5662 # Other characters |
|
5663 |
|
5664 # First character is below, 2nd character is above |
|
5665 $$hash{"||"} = "\xa6"; # BROKEN BAR |
|
5666 $$hash{" :"} = "\xa8"; # DIAERESIS |
|
5667 $$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR |
|
5668 #$$hash{" -"}= "\xaf"; # MACRON (narrow bar) |
|
5669 $$hash{" -"} = "\xad"; # HYPHEN (wide bar) |
|
5670 $$hash{" o"} = "\xb0"; # DEGREE SIGN |
|
5671 $$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN |
|
5672 $$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE |
|
5673 $$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO |
|
5674 $$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE |
|
5675 $$hash{" '"} = "\xb4"; # ACUTE ACCENT |
|
5676 $$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR |
|
5677 $$hash{" ."} = "\xb7"; # MIDDLE DOT |
|
5678 $$hash{", "} = "\xb8"; # CEDILLA |
|
5679 $$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE |
|
5680 $$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE |
|
5681 $$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH |
|
5682 |
|
5683 # upside down characters |
|
5684 |
|
5685 $$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK |
|
5686 $$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK |
|
5687 |
|
5688 # overlay characters |
|
5689 |
|
5690 $$hash{"X o"} = "\xa4"; # CURRENCY SIGN |
|
5691 $$hash{"Y ="} = "\xa5"; # YEN SIGN |
|
5692 $$hash{"S o"} = "\xa7"; # SECTION SIGN |
|
5693 $$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright |
|
5694 $$hash{"O R"} = "\xae"; # REGISTERED SIGN |
|
5695 $$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH |
|
5696 $$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE |
|
5697 $$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE |
|
5698 |
|
5699 # special names |
|
5700 |
|
5701 $$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER |
|
5702 $$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF |
|
5703 $$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS |
|
5704 $$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK |
|
5705 $$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK |
|
5706 $$hash{"cent"}= "\xa2"; # CENT SIGN |
|
5707 $$hash{"lb"} = "\xa3"; # POUND SIGN |
|
5708 $$hash{"mu"} = "\xb5"; # MICRO SIGN |
|
5709 $$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S |
|
5710 $$hash{"para"}= "\xb6"; # PILCROW SIGN |
|
5711 $$hash{"-|"} = "\xac"; # NOT SIGN |
|
5712 $$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE |
|
5713 $$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE |
|
5714 $$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN |
|
5715 $$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN |
|
5716 $$hash{"/"} = "\xf7"; # DIVISION SIGN |
|
5717 $$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN |
|
5718 } |
|
5719 |
|
5720 # $hashref = &Date_Init_LANGUAGE; |
|
5721 # This returns a hash containing all of the initialization for a |
|
5722 # specific language. The hash elements are: |
|
5723 # |
|
5724 # @ month_name full month names January February ... |
|
5725 # @ month_abb month abbreviations Jan Feb ... |
|
5726 # @ day_name day names Monday Tuesday ... |
|
5727 # @ day_abb day abbreviations Mon Tue ... |
|
5728 # @ day_char day character abbrevs M T ... |
|
5729 # @ am AM notations |
|
5730 # @ pm PM notations |
|
5731 # |
|
5732 # @ num_suff number with suffix 1st 2nd ... |
|
5733 # @ num_word numbers spelled out first second ... |
|
5734 # |
|
5735 # $ now words which mean now now today ... |
|
5736 # $ last words which mean last last final ... |
|
5737 # $ each words which mean each each every ... |
|
5738 # $ of of (as in a member of) in of ... |
|
5739 # ex. 4th day OF June |
|
5740 # $ at at 4:00 at |
|
5741 # $ on on Sunday on |
|
5742 # $ future in the future in |
|
5743 # $ past in the past ago |
|
5744 # $ next next item next |
|
5745 # $ prev previous item last previous |
|
5746 # $ later 2 hours later |
|
5747 # |
|
5748 # % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 } |
|
5749 # % times a hash of times { noon->12:00:00 ... } |
|
5750 # |
|
5751 # $ years words for year y yr year ... |
|
5752 # $ months words for month |
|
5753 # $ weeks words for week |
|
5754 # $ days words for day |
|
5755 # $ hours words for hour |
|
5756 # $ minutes words for minute |
|
5757 # $ seconds words for second |
|
5758 # % replace |
|
5759 # The replace element is quite important, but a bit tricky. In |
|
5760 # English (and probably other languages), one of the abbreviations |
|
5761 # for the word month that would be nice is "m". The problem is that |
|
5762 # "m" matches the "m" in "minute" which causes the string to be |
|
5763 # improperly matched in some cases. Hence, the list of abbreviations |
|
5764 # for month is given as: |
|
5765 # "mon month months" |
|
5766 # In order to allow you to enter "m", replacements can be done. |
|
5767 # $replace is a list of pairs of words which are matched and replaced |
|
5768 # AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that |
|
5769 # the entire word "m" will be replaced with "month". This allows the |
|
5770 # desired abbreviation to be used. Make sure that replace contains |
|
5771 # an even number of words (i.e. all must be pairs). Any time a |
|
5772 # desired abbreviation matches the start of any other, it has to go |
|
5773 # here. |
|
5774 # |
|
5775 # $ exact exact mode exactly |
|
5776 # $ approx approximate mode approximately |
|
5777 # $ business business mode business |
|
5778 # |
|
5779 # r sephm hour/minute separator (?::) |
|
5780 # r sepms minute/second separator (?::) |
|
5781 # r sepss second/fraction separator (?:[.:]) |
|
5782 # |
|
5783 # Elements marked with an asterix (@) are returned as a set of lists. |
|
5784 # Each list contains the strings for each element. The first set is used |
|
5785 # when the 7-bit ASCII (US) character set is wanted. The 2nd set is used |
|
5786 # when an international character set is available. Both of the 1st two |
|
5787 # sets should be complete (but the 2nd list can be left empty to force the |
|
5788 # first set to be used always). The 3rd set and later can be partial sets |
|
5789 # if desired. |
|
5790 # |
|
5791 # Elements marked with a dollar ($) are returned as a simple list of words. |
|
5792 # |
|
5793 # Elements marked with a percent (%) are returned as a hash list. |
|
5794 # |
|
5795 # Elements marked with (r) are regular expression elements which must not |
|
5796 # create a back reference. |
|
5797 # |
|
5798 # ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in |
|
5799 # every language. |
|
5800 |
|
5801 sub Date_Init_English { |
|
5802 print "DEBUG: Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/); |
|
5803 my($d)=@_; |
|
5804 |
|
5805 $$d{"month_name"}= |
|
5806 [["January","February","March","April","May","June", |
|
5807 "July","August","September","October","November","December"]]; |
|
5808 |
|
5809 $$d{"month_abb"}= |
|
5810 [["Jan","Feb","Mar","Apr","May","Jun", |
|
5811 "Jul","Aug","Sep","Oct","Nov","Dec"], |
|
5812 [], |
|
5813 ["","","","","","","","","Sept"]]; |
|
5814 |
|
5815 $$d{"day_name"}= |
|
5816 [["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]]; |
|
5817 $$d{"day_abb"}= |
|
5818 [["Mon","Tue","Wed","Thu","Fri","Sat","Sun"], |
|
5819 ["", "Tues","", "Thur","", "", ""]]; |
|
5820 $$d{"day_char"}= |
|
5821 [["M","T","W","Th","F","Sa","S"]]; |
|
5822 |
|
5823 $$d{"num_suff"}= |
|
5824 [["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th", |
|
5825 "11th","12th","13th","14th","15th","16th","17th","18th","19th","20th", |
|
5826 "21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th", |
|
5827 "31st"]]; |
|
5828 $$d{"num_word"}= |
|
5829 [["first","second","third","fourth","fifth","sixth","seventh","eighth", |
|
5830 "ninth","tenth","eleventh","twelfth","thirteenth","fourteenth", |
|
5831 "fifteenth","sixteenth","seventeenth","eighteenth","nineteenth", |
|
5832 "twentieth","twenty-first","twenty-second","twenty-third", |
|
5833 "twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh", |
|
5834 "twenty-eighth","twenty-ninth","thirtieth","thirty-first"]]; |
|
5835 |
|
5836 $$d{"now"} =["today","now"]; |
|
5837 $$d{"last"} =["last","final"]; |
|
5838 $$d{"each"} =["each","every"]; |
|
5839 $$d{"of"} =["in","of"]; |
|
5840 $$d{"at"} =["at"]; |
|
5841 $$d{"on"} =["on"]; |
|
5842 $$d{"future"} =["in"]; |
|
5843 $$d{"past"} =["ago"]; |
|
5844 $$d{"next"} =["next"]; |
|
5845 $$d{"prev"} =["previous","last"]; |
|
5846 $$d{"later"} =["later"]; |
|
5847 |
|
5848 $$d{"exact"} =["exactly"]; |
|
5849 $$d{"approx"} =["approximately"]; |
|
5850 $$d{"business"}=["business"]; |
|
5851 |
|
5852 $$d{"offset"} =["yesterday","-0:0:0:1:0:0:0","tomorrow","+0:0:0:1:0:0:0"]; |
|
5853 $$d{"times"} =["noon","12:00:00","midnight","00:00:00"]; |
|
5854 |
|
5855 $$d{"years"} =["y","yr","year","yrs","years"]; |
|
5856 $$d{"months"} =["mon","month","months"]; |
|
5857 $$d{"weeks"} =["w","wk","wks","week","weeks"]; |
|
5858 $$d{"days"} =["d","day","days"]; |
|
5859 $$d{"hours"} =["h","hr","hrs","hour","hours"]; |
|
5860 $$d{"minutes"} =["mn","min","minute","minutes"]; |
|
5861 $$d{"seconds"} =["s","sec","second","seconds"]; |
|
5862 $$d{"replace"} =["m","month"]; |
|
5863 |
|
5864 $$d{"sephm"} =':'; |
|
5865 $$d{"sepms"} =':'; |
|
5866 $$d{"sepss"} ='[.:]'; |
|
5867 |
|
5868 $$d{"am"} = ["AM","A.M."]; |
|
5869 $$d{"pm"} = ["PM","P.M."]; |
|
5870 } |
|
5871 |
|
5872 sub Date_Init_Italian { |
|
5873 print "DEBUG: Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/); |
|
5874 my($d)=@_; |
|
5875 my(%h)=(); |
|
5876 &Char_8Bit(\%h); |
|
5877 my($i)=$h{"i'"}; |
|
5878 |
|
5879 $$d{"month_name"}= |
|
5880 [[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno |
|
5881 Luglio Agosto Settembre Ottobre Novembre Dicembre)]]; |
|
5882 |
|
5883 $$d{"month_abb"}= |
|
5884 [[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]]; |
|
5885 |
|
5886 $$d{"day_name"}= |
|
5887 [[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)], |
|
5888 [qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]]; |
|
5889 $$d{"day_abb"}= |
|
5890 [[qw(Lun Mar Mer Gio Ven Sab Dom)]]; |
|
5891 $$d{"day_char"}= |
|
5892 [[qw(L Ma Me G V S D)]]; |
|
5893 |
|
5894 $$d{"num_suff"}= |
|
5895 [[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo |
|
5896 16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo |
|
5897 29mo 3mo 31mo)]]; |
|
5898 $$d{"num_word"}= |
|
5899 [[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo |
|
5900 undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo |
|
5901 sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo |
|
5902 ventunesimo ventiduesimo ventitreesimo ventiquattresimo |
|
5903 venticinquesimo ventiseiesimo ventisettesimo ventottesimo |
|
5904 ventinovesimo trentesimo trentunesimo)]]; |
|
5905 |
|
5906 $$d{"now"} =[qw(adesso oggi)]; |
|
5907 $$d{"last"} =[qw(ultimo)]; |
|
5908 $$d{"each"} =[qw(ogni)]; |
|
5909 $$d{"of"} =[qw(della del)]; |
|
5910 $$d{"at"} =[qw(alle)]; |
|
5911 $$d{"on"} =[qw(di)]; |
|
5912 $$d{"future"} =[qw(fra)]; |
|
5913 $$d{"past"} =[qw(fa)]; |
|
5914 $$d{"next"} =[qw(prossimo)]; |
|
5915 $$d{"prev"} =[qw(ultimo)]; |
|
5916 $$d{"later"} =[qw(dopo)]; |
|
5917 |
|
5918 $$d{"exact"} =[qw(esattamente)]; |
|
5919 $$d{"approx"} =[qw(circa)]; |
|
5920 $$d{"business"}=[qw(lavorativi lavorativo)]; |
|
5921 |
|
5922 $$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)]; |
|
5923 $$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)]; |
|
5924 |
|
5925 $$d{"years"} =[qw(anni anno a)]; |
|
5926 $$d{"months"} =[qw(mesi mese mes)]; |
|
5927 $$d{"weeks"} =[qw(settimane settimana sett)]; |
|
5928 $$d{"days"} =[qw(giorni giorno g)]; |
|
5929 $$d{"hours"} =[qw(ore ora h)]; |
|
5930 $$d{"minutes"} =[qw(minuti minuto min)]; |
|
5931 $$d{"seconds"} =[qw(secondi secondo sec)]; |
|
5932 $$d{"replace"} =[qw(s sec m mes)]; |
|
5933 |
|
5934 $$d{"sephm"} =':'; |
|
5935 $$d{"sepms"} =':'; |
|
5936 $$d{"sepss"} ='[.:]'; |
|
5937 |
|
5938 $$d{"am"} = [qw(AM)]; |
|
5939 $$d{"pm"} = [qw(PM)]; |
|
5940 } |
|
5941 |
|
5942 sub Date_Init_French { |
|
5943 print "DEBUG: Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/); |
|
5944 my($d)=@_; |
|
5945 my(%h)=(); |
|
5946 &Char_8Bit(\%h); |
|
5947 my($e)=$h{"e'"}; |
|
5948 my($u)=$h{"u^"}; |
|
5949 my($a)=$h{"a'"}; |
|
5950 |
|
5951 $$d{"month_name"}= |
|
5952 [["janvier","fevrier","mars","avril","mai","juin", |
|
5953 "juillet","aout","septembre","octobre","novembre","decembre"], |
|
5954 ["janvier","f${e}vrier","mars","avril","mai","juin", |
|
5955 "juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]]; |
|
5956 $$d{"month_abb"}= |
|
5957 [["jan","fev","mar","avr","mai","juin", |
|
5958 "juil","aout","sept","oct","nov","dec"], |
|
5959 ["jan","f${e}v","mar","avr","mai","juin", |
|
5960 "juil","ao${u}t","sept","oct","nov","d${e}c"]]; |
|
5961 |
|
5962 $$d{"day_name"}= |
|
5963 [["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]]; |
|
5964 $$d{"day_abb"}= |
|
5965 [["lun","mar","mer","jeu","ven","sam","dim"]]; |
|
5966 $$d{"day_char"}= |
|
5967 [["l","ma","me","j","v","s","d"]]; |
|
5968 |
|
5969 $$d{"num_suff"}= |
|
5970 [["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e", |
|
5971 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e", |
|
5972 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e", |
|
5973 "31e"]]; |
|
5974 $$d{"num_word"}= |
|
5975 [["premier","deux","trois","quatre","cinq","six","sept","huit","neuf", |
|
5976 "dix","onze","douze","treize","quatorze","quinze","seize","dix-sept", |
|
5977 "dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois", |
|
5978 "vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit", |
|
5979 "vingt-neuf","trente","trente et un"], |
|
5980 ["1re"]]; |
|
5981 |
|
5982 $$d{"now"} =["aujourd'hui","maintenant"]; |
|
5983 $$d{"last"} =["dernier"]; |
|
5984 $$d{"each"} =["chaque","tous les","toutes les"]; |
|
5985 $$d{"of"} =["en","de"]; |
|
5986 $$d{"at"} =["a","${a}0"]; |
|
5987 $$d{"on"} =["sur"]; |
|
5988 $$d{"future"} =["en"]; |
|
5989 $$d{"past"} =["il y a"]; |
|
5990 $$d{"next"} =["suivant"]; |
|
5991 $$d{"prev"} =["precedent","pr${e}c${e}dent"]; |
|
5992 $$d{"later"} =["plus tard"]; |
|
5993 |
|
5994 $$d{"exact"} =["exactement"]; |
|
5995 $$d{"approx"} =["approximativement"]; |
|
5996 $$d{"business"}=["professionel"]; |
|
5997 |
|
5998 $$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"]; |
|
5999 $$d{"times"} =["midi","12:00:00","minuit","00:00:00"]; |
|
6000 |
|
6001 $$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"]; |
|
6002 $$d{"months"} =["mois"]; |
|
6003 $$d{"weeks"} =["sem","semaine"]; |
|
6004 $$d{"days"} =["j","jour","jours"]; |
|
6005 $$d{"hours"} =["h","heure","heures"]; |
|
6006 $$d{"minutes"} =["mn","min","minute","minutes"]; |
|
6007 $$d{"seconds"} =["s","sec","seconde","secondes"]; |
|
6008 $$d{"replace"} =["m","mois"]; |
|
6009 |
|
6010 $$d{"sephm"} ='[h:]'; |
|
6011 $$d{"sepms"} =':'; |
|
6012 $$d{"sepss"} ='[.:,]'; |
|
6013 |
|
6014 $$d{"am"} = ["du matin"]; |
|
6015 $$d{"pm"} = ["du soir"]; |
|
6016 } |
|
6017 |
|
6018 sub Date_Init_Romanian { |
|
6019 print "DEBUG: Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/); |
|
6020 my($d)=@_; |
|
6021 my(%h)=(); |
|
6022 &Char_8Bit(\%h); |
|
6023 my($p)=$h{"p"}; |
|
6024 my($i)=$h{"i^"}; |
|
6025 my($a)=$h{"a~"}; |
|
6026 my($o)=$h{"-o"}; |
|
6027 |
|
6028 $$d{"month_name"}= |
|
6029 [["ianuarie","februarie","martie","aprilie","mai","iunie", |
|
6030 "iulie","august","septembrie","octombrie","noiembrie","decembrie"]]; |
|
6031 $$d{"month_abb"}= |
|
6032 [["ian","febr","mart","apr","mai","iun", |
|
6033 "iul","aug","sept","oct","nov","dec"], |
|
6034 ["","feb"]]; |
|
6035 |
|
6036 $$d{"day_name"}= |
|
6037 [["luni","marti","miercuri","joi","vineri","simbata","duminica"], |
|
6038 ["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}", |
|
6039 "duminic${a}"]]; |
|
6040 $$d{"day_abb"}= |
|
6041 [["lun","mar","mie","joi","vin","sim","dum"], |
|
6042 ["lun","mar","mie","joi","vin","s${i}m","dum"]]; |
|
6043 $$d{"day_char"}= |
|
6044 [["L","Ma","Mi","J","V","S","D"]]; |
|
6045 |
|
6046 $$d{"num_suff"}= |
|
6047 [["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a", |
|
6048 "a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a", |
|
6049 "a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a", |
|
6050 "a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a", |
|
6051 "a 30-a","a 31-a"]]; |
|
6052 |
|
6053 $$d{"num_word"}= |
|
6054 [["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea", |
|
6055 "a opta","a noua","a zecea","a unsprezecea","a doisprezecea", |
|
6056 "a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea", |
|
6057 "a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea", |
|
6058 "a douazecisiuna","a douazecisidoua","a douazecisitreia", |
|
6059 "a douazecisipatra","a douazecisicincea","a douazecisisasea", |
|
6060 "a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea", |
|
6061 "a treizecisiuna"], |
|
6062 ["prima","a doua","a treia","a patra","a cincea","a ${o}asea", |
|
6063 "a ${o}aptea","a opta","a noua","a zecea","a unsprezecea", |
|
6064 "a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea", |
|
6065 "a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea", |
|
6066 "a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna", |
|
6067 "a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia", |
|
6068 "a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea", |
|
6069 "a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea", |
|
6070 "a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea", |
|
6071 "a treizeci${o}iuna"], |
|
6072 ["intii", "doi", "trei", "patru", "cinci", "sase", "sapte", |
|
6073 "opt","noua","zece","unsprezece","doisprezece", |
|
6074 "treisprezece","patrusprezece","cincisprezece","saiprezece", |
|
6075 "saptesprezece","optsprezece","nouasprezece","douazeci", |
|
6076 "douazecisiunu","douazecisidoi","douazecisitrei", |
|
6077 "douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte", |
|
6078 "douazecisiopt","douazecisinoua","treizeci","treizecisiunu"], |
|
6079 ["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte", |
|
6080 "opt","nou${a}","zece","unsprezece","doisprezece", |
|
6081 "treisprezece","patrusprezece","cincisprezece","${o}aiprezece", |
|
6082 "${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci", |
|
6083 "dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei", |
|
6084 "dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase", |
|
6085 "dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt", |
|
6086 "dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]]; |
|
6087 |
|
6088 $$d{"now"} =["acum","azi","astazi","ast${a}zi"]; |
|
6089 $$d{"last"} =["ultima"]; |
|
6090 $$d{"each"} =["fiecare"]; |
|
6091 $$d{"of"} =["din","in","n"]; |
|
6092 $$d{"at"} =["la"]; |
|
6093 $$d{"on"} =["on"]; |
|
6094 $$d{"future"} =["in","${i}n"]; |
|
6095 $$d{"past"} =["in urma", "${i}n urm${a}"]; |
|
6096 $$d{"next"} =["urmatoarea","urm${a}toarea"]; |
|
6097 $$d{"prev"} =["precedenta","ultima"]; |
|
6098 $$d{"later"} =["mai tirziu", "mai t${i}rziu"]; |
|
6099 |
|
6100 $$d{"exact"} =["exact"]; |
|
6101 $$d{"approx"} =["aproximativ"]; |
|
6102 $$d{"business"}=["de lucru","lucratoare","lucr${a}toare"]; |
|
6103 |
|
6104 $$d{"offset"} =["ieri","-0:0:0:1:0:0:0", |
|
6105 "alaltaieri", "-0:0:0:2:0:0:0", |
|
6106 "alalt${a}ieri","-0:0:0:2:0:0:0", |
|
6107 "miine","+0:0:0:1:0:0:0", |
|
6108 "m${i}ine","+0:0:0:1:0:0:0", |
|
6109 "poimiine","+0:0:0:2:0:0:0", |
|
6110 "poim${i}ine","+0:0:0:2:0:0:0"]; |
|
6111 $$d{"times"} =["amiaza","12:00:00", |
|
6112 "amiaz${a}","12:00:00", |
|
6113 "miezul noptii","00:00:00", |
|
6114 "miezul nop${p}ii","00:00:00"]; |
|
6115 |
|
6116 $$d{"years"} =["ani","an","a"]; |
|
6117 $$d{"months"} =["luni","luna","lun${a}","l"]; |
|
6118 $$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina", |
|
6119 "s${a}pt${a}m${i}na","sapt","s${a}pt"]; |
|
6120 $$d{"days"} =["zile","zi","z"]; |
|
6121 $$d{"hours"} =["ore", "ora", "or${a}", "h"]; |
|
6122 $$d{"minutes"} =["minute","min","m"]; |
|
6123 $$d{"seconds"} =["secunde","sec",]; |
|
6124 $$d{"replace"} =["s","secunde"]; |
|
6125 |
|
6126 $$d{"sephm"} =':'; |
|
6127 $$d{"sepms"} =':'; |
|
6128 $$d{"sepss"} ='[.:,]'; |
|
6129 |
|
6130 $$d{"am"} = ["AM","A.M."]; |
|
6131 $$d{"pm"} = ["PM","P.M."]; |
|
6132 } |
|
6133 |
|
6134 sub Date_Init_Swedish { |
|
6135 print "DEBUG: Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/); |
|
6136 my($d)=@_; |
|
6137 my(%h)=(); |
|
6138 &Char_8Bit(\%h); |
|
6139 my($ao)=$h{"ao"}; |
|
6140 my($o) =$h{"o:"}; |
|
6141 my($a) =$h{"a:"}; |
|
6142 |
|
6143 $$d{"month_name"}= |
|
6144 [["Januari","Februari","Mars","April","Maj","Juni", |
|
6145 "Juli","Augusti","September","Oktober","November","December"]]; |
|
6146 $$d{"month_abb"}= |
|
6147 [["Jan","Feb","Mar","Apr","Maj","Jun", |
|
6148 "Jul","Aug","Sep","Okt","Nov","Dec"]]; |
|
6149 |
|
6150 $$d{"day_name"}= |
|
6151 [["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"], |
|
6152 ["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag", |
|
6153 "S${o}ndag"]]; |
|
6154 $$d{"day_abb"}= |
|
6155 [["Man","Tis","Ons","Tor","Fre","Lor","Son"], |
|
6156 ["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]]; |
|
6157 $$d{"day_char"}= |
|
6158 [["M","Ti","O","To","F","L","S"]]; |
|
6159 |
|
6160 $$d{"num_suff"}= |
|
6161 [["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e", |
|
6162 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e", |
|
6163 "21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e", |
|
6164 "31:a"]]; |
|
6165 $$d{"num_word"}= |
|
6166 [["forsta","andra","tredje","fjarde","femte","sjatte","sjunde", |
|
6167 "attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde", |
|
6168 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde", |
|
6169 "tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte", |
|
6170 "tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde", |
|
6171 "trettionde","trettioforsta"], |
|
6172 ["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde", |
|
6173 "${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde", |
|
6174 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde", |
|
6175 "tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte", |
|
6176 "tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde", |
|
6177 "trettionde","trettiof${o}rsta"]]; |
|
6178 |
|
6179 $$d{"now"} =["idag","nu"]; |
|
6180 $$d{"last"} =["forra","f${o}rra","senaste"]; |
|
6181 $$d{"each"} =["varje"]; |
|
6182 $$d{"of"} =["om"]; |
|
6183 $$d{"at"} =["kl","kl.","klockan"]; |
|
6184 $$d{"on"} =["pa","p${ao}"]; |
|
6185 $$d{"future"} =["om"]; |
|
6186 $$d{"past"} =["sedan"]; |
|
6187 $$d{"next"} =["nasta","n${a}sta"]; |
|
6188 $$d{"prev"} =["forra","f${o}rra"]; |
|
6189 $$d{"later"} =["senare"]; |
|
6190 |
|
6191 $$d{"exact"} =["exakt"]; |
|
6192 $$d{"approx"} =["ungefar","ungef${a}r"]; |
|
6193 $$d{"business"}=["arbetsdag","arbetsdagar"]; |
|
6194 |
|
6195 $$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0", |
|
6196 "imorgon","+0:0:0:1:0:0:0"]; |
|
6197 $$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00", |
|
6198 "midnatt","00:00:00"]; |
|
6199 |
|
6200 $$d{"years"} =["ar","${ao}r"]; |
|
6201 $$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"]; |
|
6202 $$d{"weeks"} =["v","vecka","veckor"]; |
|
6203 $$d{"days"} =["d","dag","dagar"]; |
|
6204 $$d{"hours"} =["t","tim","timme","timmar"]; |
|
6205 $$d{"minutes"} =["min","minut","minuter"]; |
|
6206 $$d{"seconds"} =["s","sek","sekund","sekunder"]; |
|
6207 $$d{"replace"} =["m","minut"]; |
|
6208 |
|
6209 $$d{"sephm"} ='[.:]'; |
|
6210 $$d{"sepms"} =':'; |
|
6211 $$d{"sepss"} ='[.:]'; |
|
6212 |
|
6213 $$d{"am"} = ["FM"]; |
|
6214 $$d{"pm"} = ["EM"]; |
|
6215 } |
|
6216 |
|
6217 sub Date_Init_German { |
|
6218 print "DEBUG: Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/); |
|
6219 my($d)=@_; |
|
6220 my(%h)=(); |
|
6221 &Char_8Bit(\%h); |
|
6222 my($a)=$h{"a:"}; |
|
6223 my($u)=$h{"u:"}; |
|
6224 my($o)=$h{"o:"}; |
|
6225 my($b)=$h{"beta"}; |
|
6226 |
|
6227 $$d{"month_name"}= |
|
6228 [["Januar","Februar","Maerz","April","Mai","Juni", |
|
6229 "Juli","August","September","Oktober","November","Dezember"], |
|
6230 ["J${a}nner","Februar","M${a}rz","April","Mai","Juni", |
|
6231 "Juli","August","September","Oktober","November","Dezember"]]; |
|
6232 $$d{"month_abb"}= |
|
6233 [["Jan","Feb","Mar","Apr","Mai","Jun", |
|
6234 "Jul","Aug","Sep","Okt","Nov","Dez"], |
|
6235 ["J${a}n","Feb","M${a}r","Apr","Mai","Jun", |
|
6236 "Jul","Aug","Sep","Okt","Nov","Dez"]]; |
|
6237 |
|
6238 $$d{"day_name"}= |
|
6239 [["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag", |
|
6240 "Sonntag"]]; |
|
6241 $$d{"day_abb"}= |
|
6242 [["Mon","Die","Mit","Don","Fre","Sam","Son"]]; |
|
6243 $$d{"day_char"}= |
|
6244 [["M","Di","Mi","Do","F","Sa","So"]]; |
|
6245 |
|
6246 $$d{"num_suff"}= |
|
6247 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.", |
|
6248 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.", |
|
6249 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.", |
|
6250 "31."]]; |
|
6251 $$d{"num_word"}= |
|
6252 [ |
|
6253 ["erste","zweite","dritte","vierte","funfte","sechste","siebente", |
|
6254 "achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte", |
|
6255 "funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte", |
|
6256 "zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste", |
|
6257 "vierundzwanzigste","funfundzwanzigste","sechundzwanzigste", |
|
6258 "siebundzwanzigste","achtundzwanzigste","neunundzwanzigste", |
|
6259 "dreibigste","einunddreibigste"], |
|
6260 ["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente", |
|
6261 "achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte", |
|
6262 "vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte", |
|
6263 "neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste", |
|
6264 "dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste", |
|
6265 "sechundzwanzigste","siebundzwanzigste","achtundzwanzigste", |
|
6266 "neunundzwanzigste","drei${b}igste","einunddrei${b}igste"], |
|
6267 ["erster"]]; |
|
6268 |
|
6269 $$d{"now"} =["heute","jetzt"]; |
|
6270 $$d{"last"} =["letzte","letzten"]; |
|
6271 $$d{"each"} =["jeden"]; |
|
6272 $$d{"of"} =["der","im","des"]; |
|
6273 $$d{"at"} =["um"]; |
|
6274 $$d{"on"} =["am"]; |
|
6275 $$d{"future"} =["in"]; |
|
6276 $$d{"past"} =["vor"]; |
|
6277 $$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"]; |
|
6278 $$d{"prev"} =["vorherigen","vorherige","letzte","letzten"]; |
|
6279 $$d{"later"} =["spater","sp${a}ter"]; |
|
6280 |
|
6281 $$d{"exact"} =["genau"]; |
|
6282 $$d{"approx"} =["ungefahr","ungef${a}hr"]; |
|
6283 $$d{"business"}=["Arbeitstag"]; |
|
6284 |
|
6285 $$d{"offset"} =["gestern","-0:0:0:1:0:0:0","morgen","+0:0:0:1:0:0:0"]; |
|
6286 $$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"]; |
|
6287 |
|
6288 $$d{"years"} =["j","Jahr","Jahre"]; |
|
6289 $$d{"months"} =["Monat","Monate"]; |
|
6290 $$d{"weeks"} =["w","Woche","Wochen"]; |
|
6291 $$d{"days"} =["t","Tag","Tage"]; |
|
6292 $$d{"hours"} =["h","std","Stunde","Stunden"]; |
|
6293 $$d{"minutes"} =["min","Minute","Minuten"]; |
|
6294 $$d{"seconds"} =["s","sek","Sekunde","Sekunden"]; |
|
6295 $$d{"replace"} =["m","Monat"]; |
|
6296 |
|
6297 $$d{"sephm"} =':'; |
|
6298 $$d{"sepms"} ='[: ]'; |
|
6299 $$d{"sepss"} ='[.:]'; |
|
6300 |
|
6301 $$d{"am"} = ["FM"]; |
|
6302 $$d{"pm"} = ["EM"]; |
|
6303 } |
|
6304 |
|
6305 sub Date_Init_Dutch { |
|
6306 print "DEBUG: Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/); |
|
6307 my($d)=@_; |
|
6308 my(%h)=(); |
|
6309 &Char_8Bit(\%h); |
|
6310 |
|
6311 $$d{"month_name"}= |
|
6312 [["januari","februari","maart","april","mei","juni","juli","augustus", |
|
6313 "september","october","november","december"], |
|
6314 ["","","","","","","","","","oktober"]]; |
|
6315 |
|
6316 $$d{"month_abb"}= |
|
6317 [["jan","feb","maa","apr","mei","jun","jul", |
|
6318 "aug","sep","oct","nov","dec"], |
|
6319 ["","","mrt","","","","","","","okt"]]; |
|
6320 $$d{"day_name"}= |
|
6321 [["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag", |
|
6322 "zondag"]]; |
|
6323 $$d{"day_abb"}= |
|
6324 [["ma","di","wo","do","vr","zat","zon"], |
|
6325 ["","","","","","za","zo"]]; |
|
6326 $$d{"day_char"}= |
|
6327 [["M","D","W","D","V","Za","Zo"]]; |
|
6328 |
|
6329 $$d{"num_suff"}= |
|
6330 [["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de", |
|
6331 "11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste", |
|
6332 "21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste", |
|
6333 "30ste","31ste"]]; |
|
6334 $$d{"num_word"}= |
|
6335 [["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste", |
|
6336 "negende","tiende","elfde","twaalfde", |
|
6337 map {"${_}tiende";} qw (der veer vijf zes zeven acht negen), |
|
6338 "twintigste", |
|
6339 map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht |
|
6340 negen), |
|
6341 "dertigste","eenendertigste"], |
|
6342 ["","","","","","","","","","","","","","","","","","","","", |
|
6343 map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht |
|
6344 negen), |
|
6345 "dertigste","een-en-dertigste"], |
|
6346 ["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien", |
|
6347 "elf","twaalf", |
|
6348 map {"${_}tien"} qw (der veer vijf zes zeven acht negen), |
|
6349 "twintig", |
|
6350 map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen), |
|
6351 "dertig","eenendertig"], |
|
6352 ["","","","","","","","","","","","","","","","","","","","", |
|
6353 map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht |
|
6354 negen), |
|
6355 "dertig","een-en-dertig"]]; |
|
6356 |
|
6357 $$d{"now"} =["nu","nou","vandaag"]; |
|
6358 $$d{"last"} =["laatste"]; |
|
6359 $$d{"each"} =["elke","elk"]; |
|
6360 $$d{"of"} =["in","van"]; |
|
6361 $$d{"at"} =["om"]; |
|
6362 $$d{"on"} =["op"]; |
|
6363 $$d{"future"} =["over"]; |
|
6364 $$d{"past"} =["geleden","vroeger","eerder"]; |
|
6365 $$d{"next"} =["volgende","volgend"]; |
|
6366 $$d{"prev"} =["voorgaande","voorgaand"]; |
|
6367 $$d{"later"} =["later"]; |
|
6368 |
|
6369 $$d{"exact"} =["exact","precies","nauwkeurig"]; |
|
6370 $$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.']; |
|
6371 $$d{"business"}=["werk","zakelijke","zakelijk"]; |
|
6372 |
|
6373 $$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0", |
|
6374 "gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"]; |
|
6375 $$d{"times"} =["noen","12:00:00","middernacht","00:00:00"]; |
|
6376 |
|
6377 $$d{"years"} =["jaar","jaren","ja","j"]; |
|
6378 $$d{"months"} =["maand","maanden","mnd"]; |
|
6379 $$d{"weeks"} =["week","weken","w"]; |
|
6380 $$d{"days"} =["dag","dagen","d"]; |
|
6381 $$d{"hours"} =["uur","uren","u","h"]; |
|
6382 $$d{"minutes"} =["minuut","minuten","min"]; |
|
6383 $$d{"seconds"} =["seconde","seconden","sec","s"]; |
|
6384 $$d{"replace"} =["m","minuten"]; |
|
6385 |
|
6386 $$d{"sephm"} ='[:.uh]'; |
|
6387 $$d{"sepms"} ='[:.m]'; |
|
6388 $$d{"sepss"} ='[.:]'; |
|
6389 |
|
6390 $$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends", |
|
6391 "ochtend","'s_nachts","nacht"]; |
|
6392 $$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag", |
|
6393 "'s_avonds","avond"]; |
|
6394 } |
|
6395 |
|
6396 sub Date_Init_Polish { |
|
6397 print "DEBUG: Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/); |
|
6398 my($d)=@_; |
|
6399 |
|
6400 $$d{"month_name"}= |
|
6401 [["stycznia","luty","marca","kwietnia","maja","czerwca", |
|
6402 "lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"], |
|
6403 ["stycznia","luty","marca","kwietnia","maja","czerwca","lipca", |
|
6404 "sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]]; |
|
6405 $$d{"month_abb"}= |
|
6406 [["sty.","lut.","mar.","kwi.","maj","cze.", |
|
6407 "lip.","sie.","wrz.","paz.","lis.","gru."], |
|
6408 ["sty.","lut.","mar.","kwi.","maj","cze.", |
|
6409 "lip.","sie.","wrz.","pa\x9f.","lis.","gru."]]; |
|
6410 |
|
6411 $$d{"day_name"}= |
|
6412 [["poniedzialek","wtorek","sroda","czwartek","piatek","sobota", |
|
6413 "niedziela"], |
|
6414 ["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek", |
|
6415 "sobota","niedziela"]]; |
|
6416 $$d{"day_abb"}= |
|
6417 [["po.","wt.","sr.","cz.","pi.","so.","ni."], |
|
6418 ["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]]; |
|
6419 $$d{"day_char"}= |
|
6420 [["p","w","e","c","p","s","n"], |
|
6421 ["p","w","\x9c.","c","p","s","n"]]; |
|
6422 |
|
6423 $$d{"num_suff"}= |
|
6424 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.", |
|
6425 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.", |
|
6426 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.", |
|
6427 "31."]]; |
|
6428 $$d{"num_word"}= |
|
6429 [["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego", |
|
6430 "siodmego","osmego","dziewiatego","dziesiatego", |
|
6431 "jedenastego","dwunastego","trzynastego","czternastego","pietnastego", |
|
6432 "szestnastego","siedemnastego","osiemnastego","dziewietnastego", |
|
6433 "dwudziestego", |
|
6434 "dwudziestego pierwszego","dwudziestego drugiego", |
|
6435 "dwudziestego trzeczego","dwudziestego czwartego", |
|
6436 "dwudziestego piatego","dwudziestego szostego", |
|
6437 "dwudziestego siodmego","dwudziestego osmego", |
|
6438 "dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"], |
|
6439 ["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego", |
|
6440 "sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego", |
|
6441 "dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego", |
|
6442 "czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego", |
|
6443 "osiemnastego","dziewietnastego","dwudziestego", |
|
6444 "dwudziestego pierwszego","dwudziestego drugiego", |
|
6445 "dwudziestego trzeczego","dwudziestego czwartego", |
|
6446 "dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego", |
|
6447 "dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego", |
|
6448 "dwudziestego dziewi\x81\xb9tego","trzydziestego", |
|
6449 "trzydziestego pierwszego"]]; |
|
6450 |
|
6451 $$d{"now"} =["dzisaj","teraz"]; |
|
6452 $$d{"last"} =["ostatni","ostatna"]; |
|
6453 $$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"]; |
|
6454 $$d{"of"} =["w","z"]; |
|
6455 $$d{"at"} =["o","u"]; |
|
6456 $$d{"on"} =["na"]; |
|
6457 $$d{"future"} =["za"]; |
|
6458 $$d{"past"} =["temu"]; |
|
6459 $$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym", |
|
6460 "przyszly","przysz\x81\xb3y","przyszlym", |
|
6461 "przysz\x81\xb3ym"]; |
|
6462 $$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"]; |
|
6463 $$d{"later"} =["later"]; |
|
6464 |
|
6465 $$d{"exact"} =["doklandnie","dok\x81\xb3andnie"]; |
|
6466 $$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej", |
|
6467 "mniej wi\x81\xeacej","okolo","oko\x81\xb3o"]; |
|
6468 $$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym", |
|
6469 "s\x81\xb3u\x81\xbfbowym"]; |
|
6470 |
|
6471 $$d{"times"} =["po\x81\xb3udnie","12:00:00", |
|
6472 "p\x81\xf3\x81\xb3noc","00:00:00", |
|
6473 "poludnie","12:00:00","polnoc","00:00:00"]; |
|
6474 $$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"]; |
|
6475 |
|
6476 $$d{"years"} =["rok","lat","lata","latach"]; |
|
6477 $$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy", |
|
6478 "miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"]; |
|
6479 $$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"]; |
|
6480 $$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"]; |
|
6481 $$d{"hours"} =["g.","godzina","godziny","godzinie"]; |
|
6482 $$d{"minutes"} =["mn.","min.","minut","minuty"]; |
|
6483 $$d{"seconds"} =["s.","sekund","sekundy"]; |
|
6484 $$d{"replace"} =["m.","miesiac"]; |
|
6485 |
|
6486 $$d{"sephm"} =':'; |
|
6487 $$d{"sepms"} =':'; |
|
6488 $$d{"sepss"} ='[.:]'; |
|
6489 |
|
6490 $$d{"am"} = ["AM","A.M."]; |
|
6491 $$d{"pm"} = ["PM","P.M."]; |
|
6492 } |
|
6493 |
|
6494 sub Date_Init_Spanish { |
|
6495 print "DEBUG: Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/); |
|
6496 my($d)=@_; |
|
6497 my(%h)=(); |
|
6498 &Char_8Bit(\%h); |
|
6499 |
|
6500 $$d{"month_name"}= |
|
6501 [["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto", |
|
6502 "Septiembre","Octubre","Noviembre","Diciembre"]]; |
|
6503 |
|
6504 $$d{"month_abb"}= |
|
6505 [["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct", |
|
6506 "Nov","Dic"]]; |
|
6507 |
|
6508 $$d{"day_name"}= |
|
6509 [["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]]; |
|
6510 $$d{"day_abb"}= |
|
6511 [["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]]; |
|
6512 $$d{"day_char"}= |
|
6513 [["L","Ma","Mi","J","V","S","D"]]; |
|
6514 |
|
6515 $$d{"num_suff"}= |
|
6516 [["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o", |
|
6517 "11o","12o","13o","14o","15o","16o","17o","18o","19o","20o", |
|
6518 "21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"], |
|
6519 ["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a", |
|
6520 "11a","12a","13a","14a","15a","16a","17a","18a","19a","20a", |
|
6521 "21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]]; |
|
6522 $$d{"num_word"}= |
|
6523 [["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo", |
|
6524 "Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo", |
|
6525 "Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto", |
|
6526 "Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo", |
|
6527 "Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero", |
|
6528 "Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto", |
|
6529 "Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo", |
|
6530 "Trigesimo Primero"], |
|
6531 ["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima", |
|
6532 "Octava","Novena","Decima","Decimo Primera","Decimo Segunda", |
|
6533 "Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta", |
|
6534 "Decimo Septima","Decimo Octava","Decimo Novena","Vigesima", |
|
6535 "Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera", |
|
6536 "Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta", |
|
6537 "Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima", |
|
6538 "Trigesimo Primera"]]; |
|
6539 |
|
6540 $$d{"now"} =["Hoy","Ahora"]; |
|
6541 $$d{"last"} =["ultimo"]; |
|
6542 $$d{"each"} =["cada"]; |
|
6543 $$d{"of"} =["en","de"]; |
|
6544 $$d{"at"} =["a"]; |
|
6545 $$d{"on"} =["el"]; |
|
6546 $$d{"future"} =["en"]; |
|
6547 $$d{"past"} =["hace"]; |
|
6548 $$d{"next"} =["siguiente"]; |
|
6549 $$d{"prev"} =["anterior"]; |
|
6550 $$d{"later"} =["later"]; |
|
6551 |
|
6552 $$d{"exact"} =["exactamente"]; |
|
6553 $$d{"approx"} =["aproximadamente"]; |
|
6554 $$d{"business"}=["laborales"]; |
|
6555 |
|
6556 $$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"]; |
|
6557 $$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"]; |
|
6558 |
|
6559 $$d{"years"} =["a","ano","ano","anos","anos"]; |
|
6560 $$d{"months"} =["m","mes","mes","meses"]; |
|
6561 $$d{"weeks"} =["sem","semana","semana","semanas"]; |
|
6562 $$d{"days"} =["d","dia","dias"]; |
|
6563 $$d{"hours"} =["hr","hrs","hora","horas"]; |
|
6564 $$d{"minutes"} =["min","min","minuto","minutos"]; |
|
6565 $$d{"seconds"} =["s","seg","segundo","segundos"]; |
|
6566 $$d{"replace"} =["m","mes"]; |
|
6567 |
|
6568 $$d{"sephm"} =':'; |
|
6569 $$d{"sepms"} =':'; |
|
6570 $$d{"sepss"} ='[.:]'; |
|
6571 |
|
6572 $$d{"am"} = ["AM","A.M."]; |
|
6573 $$d{"pm"} = ["PM","P.M."]; |
|
6574 } |
|
6575 |
|
6576 sub Date_Init_Portuguese { |
|
6577 print "DEBUG: Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/); |
|
6578 my($d)=@_; |
|
6579 my(%h)=(); |
|
6580 &Char_8Bit(\%h); |
|
6581 my($o) = $h{"-o"}; |
|
6582 my($c) = $h{",c"}; |
|
6583 my($a) = $h{"a'"}; |
|
6584 my($e) = $h{"e'"}; |
|
6585 my($u) = $h{"u'"}; |
|
6586 my($o2)= $h{"o'"}; |
|
6587 my($a2)= $h{"a`"}; |
|
6588 my($a3)= $h{"a~"}; |
|
6589 my($e2)= $h{"e^"}; |
|
6590 |
|
6591 $$d{"month_name"}= |
|
6592 [["Janeiro","Fevereiro","Marco","Abril","Maio","Junho", |
|
6593 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"], |
|
6594 ["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho", |
|
6595 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]]; |
|
6596 |
|
6597 $$d{"month_abb"}= |
|
6598 [["Jan","Fev","Mar","Abr","Mai","Jun", |
|
6599 "Jul","Ago","Set","Out","Nov","Dez"]]; |
|
6600 |
|
6601 $$d{"day_name"}= |
|
6602 [["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"], |
|
6603 ["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]]; |
|
6604 $$d{"day_abb"}= |
|
6605 [["Seg","Ter","Qua","Qui","Sex","Sab","Dom"], |
|
6606 ["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]]; |
|
6607 $$d{"day_char"}= |
|
6608 [["Sg","T","Qa","Qi","Sx","Sb","D"]]; |
|
6609 |
|
6610 $$d{"num_suff"}= |
|
6611 [["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}", |
|
6612 "9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}", |
|
6613 "16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}", |
|
6614 "23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}", |
|
6615 "30${o}","31${o}"]]; |
|
6616 $$d{"num_word"}= |
|
6617 [["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo", |
|
6618 "oitavo","nono","decimo","decimo primeiro","decimo segundo", |
|
6619 "decimo terceiro","decimo quarto","decimo quinto","decimo sexto", |
|
6620 "decimo setimo","decimo oitavo","decimo nono","vigesimo", |
|
6621 "vigesimo primeiro","vigesimo segundo","vigesimo terceiro", |
|
6622 "vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo", |
|
6623 "vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"], |
|
6624 ["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo", |
|
6625 "oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo", |
|
6626 "d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto", |
|
6627 "d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo", |
|
6628 "d${e}cimo nono","vig${e}simo","vig${e}simo primeiro", |
|
6629 "vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto", |
|
6630 "vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo", |
|
6631 "vig${e}simo oitavo","vig${e}simo nono","trig${e}simo", |
|
6632 "trig${e}simo primeiro"]]; |
|
6633 |
|
6634 $$d{"now"} =["agora","hoje"]; |
|
6635 $$d{"last"} =["${u}ltimo","ultimo"]; |
|
6636 $$d{"each"} =["cada"]; |
|
6637 $$d{"of"} =["da","do"]; |
|
6638 $$d{"at"} =["as","${a2}s"]; |
|
6639 $$d{"on"} =["na","no"]; |
|
6640 $$d{"future"} =["em"]; |
|
6641 $$d{"past"} =["a","${a2}"]; |
|
6642 $$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"]; |
|
6643 $$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"]; |
|
6644 $$d{"later"} =["passadas","passados"]; |
|
6645 |
|
6646 $$d{"exact"} =["exactamente"]; |
|
6647 $$d{"approx"} =["aproximadamente"]; |
|
6648 $$d{"business"}=["util","uteis"]; |
|
6649 |
|
6650 $$d{"offset"} =["ontem","-0:0:0:1:0:0:0", |
|
6651 "amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"]; |
|
6652 $$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"]; |
|
6653 |
|
6654 $$d{"years"} =["anos","ano","ans","an","a"]; |
|
6655 $$d{"months"} =["meses","m${e2}s","mes","m"]; |
|
6656 $$d{"weeks"} =["semanas","semana","sem","sems","s"]; |
|
6657 $$d{"days"} =["dias","dia","d"]; |
|
6658 $$d{"hours"} =["horas","hora","hr","hrs"]; |
|
6659 $$d{"minutes"} =["minutos","minuto","min","mn"]; |
|
6660 $$d{"seconds"} =["segundos","segundo","seg","sg"]; |
|
6661 $$d{"replace"} =["m","mes","s","sems"]; |
|
6662 |
|
6663 $$d{"sephm"} =':'; |
|
6664 $$d{"sepms"} =':'; |
|
6665 $$d{"sepss"} ='[,]'; |
|
6666 |
|
6667 $$d{"am"} = ["AM","A.M."]; |
|
6668 $$d{"pm"} = ["PM","P.M."]; |
|
6669 } |
|
6670 |
|
6671 sub Date_Init_Russian { |
|
6672 print "DEBUG: Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/); |
|
6673 my($d)=@_; |
|
6674 my(%h)=(); |
|
6675 &Char_8Bit(\%h); |
|
6676 my($a) =$h{"a:"}; |
|
6677 |
|
6678 $$d{"month_name"}= |
|
6679 [ |
|
6680 ["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1", |
|
6681 "\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1", |
|
6682 "\xc9\xc0\xce\xd1", |
|
6683 "\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1", |
|
6684 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1", |
|
6685 "\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"], |
|
6686 ["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8", |
|
6687 "\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca", |
|
6688 "\xc9\xc0\xce\xd8", |
|
6689 "\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4", |
|
6690 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8", |
|
6691 "\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"] |
|
6692 ]; |
|
6693 |
|
6694 $$d{"month_abb"}= |
|
6695 [["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2", |
|
6696 "\xcd\xc1\xca","\xc9\xc0\xce", |
|
6697 "\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4", |
|
6698 "\xce\xcf\xd1\xc2","\xc4\xc5\xcb"], |
|
6699 ["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","", |
|
6700 "","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]]; |
|
6701 |
|
6702 $$d{"day_name"}= |
|
6703 [["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb", |
|
6704 "\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1", |
|
6705 "\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1", |
|
6706 "\xd3\xd5\xc2\xc2\xcf\xd4\xc1", |
|
6707 "\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]]; |
|
6708 $$d{"day_abb"}= |
|
6709 [["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7", |
|
6710 "\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"], |
|
6711 ["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4", |
|
6712 "\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]]; |
|
6713 $$d{"day_char"}= |
|
6714 [["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2", |
|
6715 "\xd7\xd3"]]; |
|
6716 |
|
6717 $$d{"num_suff"}= |
|
6718 [["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ", |
|
6719 "11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ", |
|
6720 "21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ", |
|
6721 "31 "]]; |
|
6722 $$d{"num_word"}= |
|
6723 [["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca", |
|
6724 "\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca", |
|
6725 "\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca", |
|
6726 "\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca", |
|
6727 "\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca", |
|
6728 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6729 "\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca", |
|
6730 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6731 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6732 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6733 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6734 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6735 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6736 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6737 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
|
6738 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca", |
|
6739 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca", |
|
6740 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca", |
|
6741 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca", |
|
6742 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca", |
|
6743 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca", |
|
6744 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca", |
|
6745 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca", |
|
6746 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca", |
|
6747 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca", |
|
6748 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"], |
|
6749 |
|
6750 ["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5", |
|
6751 "\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5", |
|
6752 "\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5", |
|
6753 "\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5", |
|
6754 "\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5", |
|
6755 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6756 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6757 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6758 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6759 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6760 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6761 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6762 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6763 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6764 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6765 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5", |
|
6766 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5", |
|
6767 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5", |
|
6768 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5", |
|
6769 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5", |
|
6770 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5", |
|
6771 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5", |
|
6772 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5", |
|
6773 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5", |
|
6774 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5", |
|
6775 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"], |
|
6776 |
|
6777 ["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf", |
|
6778 "\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf", |
|
6779 "\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf", |
|
6780 "\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf", |
|
6781 "\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf", |
|
6782 "\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf", |
|
6783 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6784 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6785 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6786 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6787 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6788 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6789 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6790 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6791 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6792 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6793 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf", |
|
6794 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5", |
|
6795 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf", |
|
6796 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf", |
|
6797 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf", |
|
6798 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf", |
|
6799 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf", |
|
6800 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf", |
|
6801 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf", |
|
6802 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
|
6803 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]]; |
|
6804 |
|
6805 $$d{"now"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1","\xd3\xc5\xca\xde\xc1\xd3"]; |
|
6806 $$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"]; |
|
6807 $$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"]; |
|
6808 $$d{"of"} =[" "]; |
|
6809 $$d{"at"} =["\xd7"]; |
|
6810 $$d{"on"} =["\xd7"]; |
|
6811 $$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"]; |
|
6812 $$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "]; |
|
6813 $$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"]; |
|
6814 $$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"]; |
|
6815 $$d{"later"} =["\xd0\xcf\xda\xd6\xc5"]; |
|
6816 |
|
6817 $$d{"exact"} =["\xd4\xcf\xde\xce\xcf"]; |
|
6818 $$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"]; |
|
6819 $$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"]; |
|
6820 |
|
6821 $$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0", |
|
6822 "\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0", |
|
6823 "\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0", |
|
6824 "\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1", |
|
6825 "+0:0:0:2:0:0:0"]; |
|
6826 $$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00", |
|
6827 "\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"]; |
|
6828 |
|
6829 $$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4", |
|
6830 "\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"]; |
|
6831 $$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3", |
|
6832 "\xcd\xc5\xd3\xd1\xc3\xc5\xd7"]; |
|
6833 $$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8", |
|
6834 "\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"]; |
|
6835 $$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca", |
|
6836 "\xc4\xce\xd1"]; |
|
6837 $$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3", |
|
6838 "\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"]; |
|
6839 $$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1", |
|
6840 "\xcd\xc9\xce\xd5\xd4"]; |
|
6841 $$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1", |
|
6842 "\xd3\xc5\xcb\xd5\xce\xc4"]; |
|
6843 $$d{"replace"} =[]; |
|
6844 |
|
6845 $$d{"sephm"} ="[:\xde]"; |
|
6846 $$d{"sepms"} ="[:\xcd]"; |
|
6847 $$d{"sepss"} ="[:.\xd3]"; |
|
6848 |
|
6849 $$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9", |
|
6850 "\xd5\xd4\xd2\xc1", |
|
6851 "\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"]; |
|
6852 $$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1", |
|
6853 "\xd7\xc5\xde\xc5\xd2\xc1", |
|
6854 "\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1", |
|
6855 "\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"]; |
|
6856 } |
|
6857 |
|
6858 sub Date_Init_Turkish { |
|
6859 print "DEBUG: Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/); |
|
6860 my($d)=@_; |
|
6861 |
|
6862 $$d{"month_name"}= |
|
6863 [ |
|
6864 ["ocak","subat","mart","nisan","mayis","haziran", |
|
6865 "temmuz","agustos","eylul","ekim","kasim","aralik"], |
|
6866 ["ocak","\xfeubat","mart","nisan","may\xfds","haziran", |
|
6867 "temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"] |
|
6868 ]; |
|
6869 |
|
6870 $$d{"month_abb"}= |
|
6871 [ |
|
6872 ["oca","sub","mar","nis","may","haz", |
|
6873 "tem","agu","eyl","eki","kas","ara"], |
|
6874 ["oca","\xfeub","mar","nis","may","haz", |
|
6875 "tem","a\xf0u","eyl","eki","kas","ara"] |
|
6876 ]; |
|
6877 |
|
6878 $$d{"day_name"}= |
|
6879 [ |
|
6880 ["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"], |
|
6881 ["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma", |
|
6882 "cumartesi","pazar"], |
|
6883 ]; |
|
6884 |
|
6885 $$d{"day_abb"}= |
|
6886 [ |
|
6887 ["pzt","sal","car","per","cum","cts","paz"], |
|
6888 ["pzt","sal","\xe7ar","per","cum","cts","paz"], |
|
6889 ]; |
|
6890 |
|
6891 $$d{"day_char"}= |
|
6892 [["Pt","S","Cr","Pr","C","Ct","P"], |
|
6893 ["Pt","S","\xc7","Pr","C","Ct","P"]]; |
|
6894 |
|
6895 $$d{"num_suff"}= |
|
6896 [[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.", |
|
6897 "11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.", |
|
6898 "21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.", |
|
6899 "31."]]; |
|
6900 |
|
6901 $$d{"num_word"}= |
|
6902 [ |
|
6903 ["birinci","ikinci","ucuncu","dorduncu", |
|
6904 "besinci","altinci","yedinci","sekizinci", |
|
6905 "dokuzuncu","onuncu","onbirinci","onikinci", |
|
6906 "onucuncu","ondordoncu", |
|
6907 "onbesinci","onaltinci","onyedinci","onsekizinci", |
|
6908 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci", |
|
6909 "yirmiucuncu","yirmidorduncu", |
|
6910 "yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci", |
|
6911 "yirmidokuzuncu","otuzuncu","otuzbirinci"], |
|
6912 ["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc", |
|
6913 "be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci", |
|
6914 "dokuzuncu","onuncu","onbirinci","onikinci", |
|
6915 "on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc", |
|
6916 "onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci", |
|
6917 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci", |
|
6918 "yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc", |
|
6919 "yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci", |
|
6920 "yirmidokuzuncu","otuzuncu","otuzbirinci"] |
|
6921 ]; |
|
6922 |
|
6923 $$d{"now"} =["\xfeimdi", "simdi", "bugun","bug\xfcn"]; |
|
6924 $$d{"last"} =["son", "sonuncu"]; |
|
6925 $$d{"each"} =["her"]; |
|
6926 $$d{"of"} =["of"]; |
|
6927 $$d{"at"} =["saat"]; |
|
6928 $$d{"on"} =["on"]; |
|
6929 $$d{"future"} =["gelecek"]; |
|
6930 $$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"]; |
|
6931 $$d{"next"} =["gelecek","sonraki"]; |
|
6932 $$d{"prev"} =["onceki","\xf6nceki"]; |
|
6933 $$d{"later"} =["sonra"]; |
|
6934 |
|
6935 $$d{"exact"} =["tam"]; |
|
6936 $$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"]; |
|
6937 $$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"]; |
|
6938 |
|
6939 $$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0", |
|
6940 "dun", "-0:0:0:1:0:0:0", |
|
6941 "yar\xfdn","+0:0:0:1:0:0:0", |
|
6942 "yarin","+0:0:0:1:0:0:0"]; |
|
6943 |
|
6944 $$d{"times"} =["\xf6\xf0len","12:00:00", |
|
6945 "oglen","12:00:00", |
|
6946 "yarim","12:300:00", |
|
6947 "yar\xfdm","12:30:00", |
|
6948 "gece yar\xfds\xfd","00:00:00", |
|
6949 "gece yarisi","00:00:00"]; |
|
6950 |
|
6951 $$d{"years"} =["yil","y"]; |
|
6952 $$d{"months"} =["ay","a"]; |
|
6953 $$d{"weeks"} =["hafta", "h"]; |
|
6954 $$d{"days"} =["gun","g"]; |
|
6955 $$d{"hours"} =["saat"]; |
|
6956 $$d{"minutes"} =["dakika","dak","d"]; |
|
6957 $$d{"seconds"} =["saniye","sn",]; |
|
6958 $$d{"replace"} =["s","saat"]; |
|
6959 |
|
6960 $$d{"sephm"} =':'; |
|
6961 $$d{"sepms"} =':'; |
|
6962 $$d{"sepss"} ='[.:,]'; |
|
6963 |
|
6964 $$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"]; |
|
6965 $$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"]; |
|
6966 } |
|
6967 |
|
6968 sub Date_Init_Danish { |
|
6969 print "DEBUG: Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/); |
|
6970 my($d)=@_; |
|
6971 |
|
6972 $$d{"month_name"}= |
|
6973 [["Januar","Februar","Marts","April","Maj","Juni", |
|
6974 "Juli","August","September","Oktober","November","December"]]; |
|
6975 $$d{"month_abb"}= |
|
6976 [["Jan","Feb","Mar","Apr","Maj","Jun", |
|
6977 "Jul","Aug","Sep","Okt","Nov","Dec"]]; |
|
6978 |
|
6979 $$d{"day_name"}= |
|
6980 [["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"], |
|
6981 ["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]]; |
|
6982 |
|
6983 $$d{"day_abb"}= |
|
6984 [["Man","Tis","Ons","Tor","Fre","Lor","Son"], |
|
6985 ["Man","Tis","Ons","Tor","Fre","L\xf8r","S\xf8n"]]; |
|
6986 $$d{"day_char"}= |
|
6987 [["M","Ti","O","To","F","L","S"]]; |
|
6988 |
|
6989 $$d{"num_suff"}= |
|
6990 [["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e", |
|
6991 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e", |
|
6992 "21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e", |
|
6993 "31:e"]]; |
|
6994 $$d{"num_word"}= |
|
6995 [["forste","anden","tredie","fjerde","femte","sjette","syvende", |
|
6996 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende", |
|
6997 "femtende","sekstende","syttende","attende","nittende","tyvende", |
|
6998 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende", |
|
6999 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende", |
|
7000 "tredivte","enogtredivte"], |
|
7001 ["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende", |
|
7002 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende", |
|
7003 "femtende","sekstende","syttende","attende","nittende","tyvende", |
|
7004 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende", |
|
7005 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende", |
|
7006 "tredivte","enogtredivte"]]; |
|
7007 |
|
7008 $$d{"now"} =["idag","nu"]; |
|
7009 $$d{"last"} =["forrige","sidste","nyeste"]; |
|
7010 $$d{"each"} =["hver"]; |
|
7011 $$d{"of"} =["om"]; |
|
7012 $$d{"at"} =["kl","kl.","klokken"]; |
|
7013 $$d{"on"} =["pa","p\xe5"]; |
|
7014 $$d{"future"} =["om"]; |
|
7015 $$d{"past"} =["siden"]; |
|
7016 $$d{"next"} =["nasta","n\xe6ste"]; |
|
7017 $$d{"prev"} =["forrige"]; |
|
7018 $$d{"later"} =["senere"]; |
|
7019 |
|
7020 $$d{"exact"} =["pracist","pr\xe6cist"]; |
|
7021 $$d{"approx"} =["circa"]; |
|
7022 $$d{"business"}=["arbejdsdag","arbejdsdage"]; |
|
7023 |
|
7024 $$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0", |
|
7025 "imorgen","+0:0:0:1:0:0:0"]; |
|
7026 $$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00", |
|
7027 "midnat","00:00:00"]; |
|
7028 |
|
7029 $$d{"years"} =["ar","\xe5r"]; |
|
7030 $$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"]; |
|
7031 $$d{"weeks"} =["u","uge","uger"]; |
|
7032 $$d{"days"} =["d","dag","dage"]; |
|
7033 $$d{"hours"} =["t","tim","time","timer"]; |
|
7034 $$d{"minutes"} =["min","minut","minutter"]; |
|
7035 $$d{"seconds"} =["s","sek","sekund","sekunder"]; |
|
7036 $$d{"replace"} =["m","minut"]; |
|
7037 |
|
7038 $$d{"sephm"} ='[.:]'; |
|
7039 $$d{"sepms"} =':'; |
|
7040 $$d{"sepss"} ='[.:]'; |
|
7041 |
|
7042 $$d{"am"} = ["FM"]; |
|
7043 $$d{"pm"} = ["EM"]; |
|
7044 } |
|
7045 |
|
7046 ######################################################################## |
|
7047 # FROM MY PERSONAL LIBRARIES |
|
7048 ######################################################################## |
|
7049 |
|
7050 no integer; |
|
7051 |
|
7052 # &ModuloAddition($N,$add,\$val,\$rem); |
|
7053 # This calculates $val=$val+$add and forces $val to be in a certain range. |
|
7054 # This is useful for adding numbers for which only a certain range is |
|
7055 # allowed (for example, minutes can be between 0 and 59 or months can be |
|
7056 # between 1 and 12). The absolute value of $N determines the range and |
|
7057 # the sign of $N determines whether the range is 0 to N-1 (if N>0) or |
|
7058 # 1 to N (N<0). The remainder (as modulo N) is added to $rem. |
|
7059 # Example: |
|
7060 # To add 2 hours together (with the excess returned in days) use: |
|
7061 # &ModuloAddition(60,$s1,\$s,\$day); |
|
7062 sub ModuloAddition { |
|
7063 my($N,$add,$val,$rem)=@_; |
|
7064 return if ($N==0); |
|
7065 $$val+=$add; |
|
7066 if ($N<0) { |
|
7067 # 1 to N |
|
7068 $N = -$N; |
|
7069 if ($$val>$N) { |
|
7070 $$rem+= int(($$val-1)/$N); |
|
7071 $$val = ($$val-1)%$N +1; |
|
7072 } elsif ($$val<1) { |
|
7073 $$rem-= int(-$$val/$N)+1; |
|
7074 $$val = $N-(-$$val % $N); |
|
7075 } |
|
7076 |
|
7077 } else { |
|
7078 # 0 to N-1 |
|
7079 if ($$val>($N-1)) { |
|
7080 $$rem+= int($$val/$N); |
|
7081 $$val = $$val%$N; |
|
7082 } elsif ($$val<0) { |
|
7083 $$rem-= int(-($$val+1)/$N)+1; |
|
7084 $$val = ($N-1)-(-($$val+1)%$N); |
|
7085 } |
|
7086 } |
|
7087 } |
|
7088 |
|
7089 # $Flag=&IsInt($String [,$low, $high]); |
|
7090 # Returns 1 if $String is a valid integer, 0 otherwise. If $low is |
|
7091 # entered, $String must be >= $low. If $high is entered, $String must |
|
7092 # be <= $high. It is valid to check only one of the bounds. |
|
7093 sub IsInt { |
|
7094 my($N,$low,$high)=@_; |
|
7095 return 0 if (! defined $N or |
|
7096 $N !~ /^\s*[-+]?\d+\s*$/ or |
|
7097 defined $low && $N<$low or |
|
7098 defined $high && $N>$high); |
|
7099 return 1; |
|
7100 } |
|
7101 |
|
7102 # $Pos=&SinLindex(\@List,$Str [,$offset [,$CaseInsensitive]]); |
|
7103 # Searches for an exact string in a list. |
|
7104 # |
|
7105 # This is similar to RinLindex except that it searches for elements |
|
7106 # which are exactly equal to $Str (possibly case insensitive). |
|
7107 sub SinLindex { |
|
7108 my($listref,$Str,$offset,$Insensitive)=@_; |
|
7109 my($i,$len,$tmp)=(); |
|
7110 $len=$#$listref; |
|
7111 return -2 if ($len<0 or ! $Str); |
|
7112 return -1 if (&Index_First(\$offset,$len)); |
|
7113 $Str=uc($Str) if ($Insensitive); |
|
7114 for ($i=$offset; $i<=$len; $i++) { |
|
7115 $tmp=$$listref[$i]; |
|
7116 $tmp=uc($tmp) if ($Insensitive); |
|
7117 return $i if ($tmp eq $Str); |
|
7118 } |
|
7119 return -1; |
|
7120 } |
|
7121 |
|
7122 sub Index_First { |
|
7123 my($offsetref,$max)=@_; |
|
7124 $$offsetref=0 if (! $$offsetref); |
|
7125 if ($$offsetref < 0) { |
|
7126 $$offsetref += $max + 1; |
|
7127 $$offsetref=0 if ($$offsetref < 0); |
|
7128 } |
|
7129 return -1 if ($$offsetref > $max); |
|
7130 return 0; |
|
7131 } |
|
7132 |
|
7133 # $File=&CleanFile($file); |
|
7134 # This cleans up a path to remove the following things: |
|
7135 # double slash /a//b -> /a/b |
|
7136 # trailing dot /a/. -> /a |
|
7137 # leading dot ./a -> a |
|
7138 # trailing slash a/ -> a |
|
7139 sub CleanFile { |
|
7140 my($file)=@_; |
|
7141 $file =~ s/\s*$//; |
|
7142 $file =~ s/^\s*//; |
|
7143 $file =~ s|//+|/|g; # multiple slash |
|
7144 $file =~ s|/\.$|/|; # trailing /. (leaves trailing slash) |
|
7145 $file =~ s|^\./|| # leading ./ |
|
7146 if ($file ne "./"); |
|
7147 $file =~ s|/$|| # trailing slash |
|
7148 if ($file ne "/"); |
|
7149 return $file; |
|
7150 } |
|
7151 |
|
7152 # $File=&ExpandTilde($file); |
|
7153 # This checks to see if a "~" appears as the first character in a path. |
|
7154 # If it does, the "~" expansion is interpreted (if possible) and the full |
|
7155 # path is returned. If a "~" expansion is used but cannot be |
|
7156 # interpreted, an empty string is returned. |
|
7157 # |
|
7158 # This is Windows/Mac friendly. |
|
7159 # This is efficient. |
|
7160 sub ExpandTilde { |
|
7161 my($file)=shift; |
|
7162 my($user,$home)=(); |
|
7163 # ~aaa/bbb= ~ aaa /bbb |
|
7164 if ($file =~ s|^~([^/]*)||) { |
|
7165 $user=$1; |
|
7166 # Single user operating systems (Mac, MSWindows) don't have the getpwnam |
|
7167 # and getpwuid routines defined. Try to catch various different ways |
|
7168 # of knowing we are on one of these systems: |
|
7169 return "" if ($OS eq "Windows" or |
|
7170 $OS eq "Mac" or |
|
7171 $OS eq "Netware" or |
|
7172 $OS eq "MPE"); |
|
7173 $user="" if (! defined $user); |
|
7174 |
|
7175 if ($user) { |
|
7176 $home= (getpwnam($user))[7]; |
|
7177 } else { |
|
7178 $home= (getpwuid($<))[7]; |
|
7179 } |
|
7180 $home = VMS::Filespec::unixpath($home) if ($OS eq "VMS"); |
|
7181 return "" if (! $home); |
|
7182 $file="$home/$file"; |
|
7183 } |
|
7184 $file; |
|
7185 } |
|
7186 |
|
7187 # $File=&FullFilePath($file); |
|
7188 # Returns the full or relative path to $file (expanding "~" if necessary). |
|
7189 # Returns an empty string if a "~" expansion cannot be interpreted. The |
|
7190 # path does not need to exist. CleanFile is called. |
|
7191 sub FullFilePath { |
|
7192 my($file)=shift; |
|
7193 my($rootpat) = '^/'; #default pattern to match absolute path |
|
7194 $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows'); |
|
7195 $file=&ExpandTilde($file); |
|
7196 return "" if (! $file); |
|
7197 return &CleanFile($file); |
|
7198 } |
|
7199 |
|
7200 # $Flag=&CheckFilePath($file [,$mode]); |
|
7201 # Checks to see if $file exists, to see what type it is, and whether |
|
7202 # the script can access it. If it exists and has the correct mode, 1 |
|
7203 # is returned. |
|
7204 # |
|
7205 # $mode is a string which may contain any of the valid file test operator |
|
7206 # characters except t, M, A, C. The appropriate test is run for each |
|
7207 # character. For example, if $mode is "re" the -r and -e tests are both |
|
7208 # run. |
|
7209 # |
|
7210 # An empty string is returned if the file doesn't exist. A 0 is returned |
|
7211 # if the file exists but any test fails. |
|
7212 # |
|
7213 # All characters in $mode which do not correspond to valid tests are |
|
7214 # ignored. |
|
7215 sub CheckFilePath { |
|
7216 my($file,$mode)=@_; |
|
7217 my($test)=(); |
|
7218 $file=&FullFilePath($file); |
|
7219 $mode = "" if (! defined $mode); |
|
7220 |
|
7221 # Run tests |
|
7222 return 0 if (! defined $file or ! $file); |
|
7223 return 0 if (( ! -e $file) or |
|
7224 ($mode =~ /r/ && ! -r $file) or |
|
7225 ($mode =~ /w/ && ! -w $file) or |
|
7226 ($mode =~ /x/ && ! -x $file) or |
|
7227 ($mode =~ /R/ && ! -R $file) or |
|
7228 ($mode =~ /W/ && ! -W $file) or |
|
7229 ($mode =~ /X/ && ! -X $file) or |
|
7230 ($mode =~ /o/ && ! -o $file) or |
|
7231 ($mode =~ /O/ && ! -O $file) or |
|
7232 ($mode =~ /z/ && ! -z $file) or |
|
7233 ($mode =~ /s/ && ! -s $file) or |
|
7234 ($mode =~ /f/ && ! -f $file) or |
|
7235 ($mode =~ /d/ && ! -d $file) or |
|
7236 ($mode =~ /l/ && ! -l $file) or |
|
7237 ($mode =~ /s/ && ! -s $file) or |
|
7238 ($mode =~ /p/ && ! -p $file) or |
|
7239 ($mode =~ /b/ && ! -b $file) or |
|
7240 ($mode =~ /c/ && ! -c $file) or |
|
7241 ($mode =~ /u/ && ! -u $file) or |
|
7242 ($mode =~ /g/ && ! -g $file) or |
|
7243 ($mode =~ /k/ && ! -k $file) or |
|
7244 ($mode =~ /T/ && ! -T $file) or |
|
7245 ($mode =~ /B/ && ! -B $file)); |
|
7246 return 1; |
|
7247 } |
|
7248 #&& |
|
7249 |
|
7250 # $Path=&FixPath($path [,$full] [,$mode] [,$error]); |
|
7251 # Makes sure that every directory in $path (a colon separated list of |
|
7252 # directories) appears as a full path or relative path. All "~" |
|
7253 # expansions are removed. All trailing slashes are removed also. If |
|
7254 # $full is non-nil, relative paths are expanded to full paths as well. |
|
7255 # |
|
7256 # If $mode is given, it may be either "e", "r", or "w". In this case, |
|
7257 # additional checking is done to each directory. If $mode is "e", it |
|
7258 # need ony exist to pass the check. If $mode is "r", it must have have |
|
7259 # read and execute permission. If $mode is "w", it must have read, |
|
7260 # write, and execute permission. |
|
7261 # |
|
7262 # The value of $error determines what happens if the directory does not |
|
7263 # pass the test. If it is non-nil, if any directory does not pass the |
|
7264 # test, the subroutine returns the empty string. Otherwise, it is simply |
|
7265 # removed from $path. |
|
7266 # |
|
7267 # The corrected path is returned. |
|
7268 sub FixPath { |
|
7269 my($path,$full,$mode,$err)=@_; |
|
7270 local($_)=""; |
|
7271 my(@dir)=split(/$Cnf{"PathSep"}/,$path); |
|
7272 $full=0 if (! defined $full); |
|
7273 $mode="" if (! defined $mode); |
|
7274 $err=0 if (! defined $err); |
|
7275 $path=""; |
|
7276 if ($mode eq "e") { |
|
7277 $mode="de"; |
|
7278 } elsif ($mode eq "r") { |
|
7279 $mode="derx"; |
|
7280 } elsif ($mode eq "w") { |
|
7281 $mode="derwx"; |
|
7282 } |
|
7283 |
|
7284 foreach (@dir) { |
|
7285 |
|
7286 # Expand path |
|
7287 if ($full) { |
|
7288 $_=&FullFilePath($_); |
|
7289 } else { |
|
7290 $_=&ExpandTilde($_); |
|
7291 } |
|
7292 if (! $_) { |
|
7293 return "" if ($err); |
|
7294 next; |
|
7295 } |
|
7296 |
|
7297 # Check mode |
|
7298 if (! $mode or &CheckFilePath($_,$mode)) { |
|
7299 $path .= $Cnf{"PathSep"} . $_; |
|
7300 } else { |
|
7301 return "" if ($err); |
|
7302 } |
|
7303 } |
|
7304 $path =~ s/^$Cnf{"PathSep"}//; |
|
7305 return $path; |
|
7306 } |
|
7307 #&& |
|
7308 |
|
7309 # $File=&SearchPath($file,$path [,$mode] [,@suffixes]); |
|
7310 # Searches through directories in $path for a file named $file. The |
|
7311 # full path is returned if one is found, or an empty string otherwise. |
|
7312 # The file may exist with one of the @suffixes. The mode is checked |
|
7313 # similar to &CheckFilePath. |
|
7314 # |
|
7315 # The first full path that matches the name and mode is returned. If none |
|
7316 # is found, an empty string is returned. |
|
7317 sub SearchPath { |
|
7318 my($file,$path,$mode,@suff)=@_; |
|
7319 my($f,$s,$d,@dir,$fs)=(); |
|
7320 $path=&FixPath($path,1,"r"); |
|
7321 @dir=split(/$Cnf{"PathSep"}/,$path); |
|
7322 foreach $d (@dir) { |
|
7323 $f="$d/$file"; |
|
7324 $f=~ s|//|/|g; |
|
7325 return $f if (&CheckFilePath($f,$mode)); |
|
7326 foreach $s (@suff) { |
|
7327 $fs="$f.$s"; |
|
7328 return $fs if (&CheckFilePath($fs,$mode)); |
|
7329 } |
|
7330 } |
|
7331 return ""; |
|
7332 } |
|
7333 |
|
7334 # @list=&ReturnList($str); |
|
7335 # This takes a string which should be a comma separated list of integers |
|
7336 # or ranges (5-7). It returns a sorted list of all integers referred to |
|
7337 # by the string, or () if there is an invalid element. |
|
7338 # |
|
7339 # Negative integers are also handled. "-2--1" is equivalent to "-2,-1". |
|
7340 sub ReturnList { |
|
7341 my($str)=@_; |
|
7342 my(@ret,@str,$from,$to,$tmp)=(); |
|
7343 @str=split(/,/,$str); |
|
7344 foreach $str (@str) { |
|
7345 if ($str =~ /^[-+]?\d+$/) { |
|
7346 push(@ret,$str); |
|
7347 } elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) { |
|
7348 ($from,$to)=($1,$2); |
|
7349 if ($from>$to) { |
|
7350 $tmp=$from; |
|
7351 $from=$to; |
|
7352 $to=$tmp; |
|
7353 } |
|
7354 push(@ret,$from..$to); |
|
7355 } else { |
|
7356 return (); |
|
7357 } |
|
7358 } |
|
7359 @ret; |
|
7360 } |
|
7361 |
|
7362 1; |