projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Date / Manip.pm
CommitLineData
86530b38
AT		 1package 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
9use 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=();
55if ($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
162require 5.000;
163require 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);
201use strict;
202use integer;
203use Carp;
204
205use 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
235no strict "vars";
236# This sorts from longest to shortest element
237sub sortByLength {
238 return (length $b <=> length $a);
239}
240use strict "vars";
241
242sub DateManipVersion {
243 print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
244 return $VERSION;
245}
246
247sub 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
770sub 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
1393sub 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
1441sub 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.
1451sub 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
1520sub 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
1719sub 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
1896no integer;
1897sub 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}
2029use integer;
2030
2031sub 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
2828sub 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
2893sub 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
2959sub 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
2974sub 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###
3049sub 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
3068sub 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
3115sub 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
3124sub 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.
3137no integer;
3138sub 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
3149sub 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}
3168use integer;
3169
3170sub 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
3202sub 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
3213sub 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
3221sub 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
3246sub 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
3256sub 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
3263sub 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
3361sub 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.
3501sub 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.
3537sub 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.
3579sub 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.
3617sub 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.
3647sub 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
3706sub 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
3768sub 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
3850sub 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
3951sub 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.
4037sub 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.
4133sub 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.
4151sub 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.
4170sub 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.
4204sub 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);
4236sub 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#
4263sub 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.
4326sub 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).
4350sub 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).
4482sub 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).
4518sub 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
4578sub 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
4764sub 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
4782sub 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
4929sub 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.
4973sub 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
5012sub 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.
5029sub 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
5127sub 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.
5242sub 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.
5299sub 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.
5357sub 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
5401sub 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
5446sub 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.
5493sub 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
5801sub 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
5872sub 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
5942sub 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
6018sub 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
6134sub 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
6217sub 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
6305sub 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
6396sub 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
6494sub 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
6576sub 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
6671sub 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
6858sub 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
6968sub 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
7050no 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);
7062sub 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.
7093sub 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).
7107sub 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
7122sub 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
7139sub 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.
7160sub 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.
7191sub 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.
7215sub 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.
7268sub 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.
7317sub 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".
7340sub 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
73621;
Full OpenSPARC design & verification tarball including full HDL.