source: trunk/Cocoa/Pester/Source/Manip.pm@ 563

Last change on this file since 563 was 463, checked in by Nicholas Riley, 17 years ago

Handle Chilean time zone CLT.
File size: 235.2 KB
RevLine 
[360]1package Date::Manip;
2# Copyright (c) 1995-2007 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="Unix" if (defined $^O and
22 $^O =~ /cygwin/i);
23$OS="Netware" if (defined $^O and
24 $^O =~ /NetWare/i);
25$OS="Mac" if ((defined $^O and
26 $^O =~ /MacOS/i) ||
27 (defined $ENV{OS} and
28 $ENV{OS} =~ /MacOS/i));
29$OS="MPE" if (defined $^O and
30 $^O =~ /MPE/i);
31$OS="OS2" if (defined $^O and
32 $^O =~ /os2/i);
33$OS="VMS" if (defined $^O and
34 $^O =~ /VMS/i);
35$OS="AIX" if (defined $^O and
36 $^O =~ /aix/i);
37
38# Determine if we're doing taint checking
39$Date::Manip::NoTaint = eval { local $^W=0; eval("#" . substr($^X, 0, 0)); 1 };
40
41###########################################################################
42# CUSTOMIZATION
43###########################################################################
44#
45# See the section of the POD documentation section CUSTOMIZING DATE::MANIP
46# below for a complete description of each of these variables.
47
48
49# Location of a the global config file. Tilde (~) expansions are allowed.
50# This should be set in Date_Init arguments.
51$Cnf{"GlobalCnf"}="";
52$Cnf{"IgnoreGlobalCnf"}="";
53
54# Name of a personal config file and the path to search for it. Tilde (~)
55# expansions are allowed. This should be set in Date_Init arguments or in
56# the global config file.
57
58@Date::Manip::DatePath=();
59if ($OS eq "Windows") {
60 $Cnf{"PathSep"} = ";";
61 $Cnf{"PersonalCnf"} = "Manip.cnf";
62 $Cnf{"PersonalCnfPath"} = ".";
63
64} elsif ($OS eq "Netware") {
65 $Cnf{"PathSep"} = ";";
66 $Cnf{"PersonalCnf"} = "Manip.cnf";
67 $Cnf{"PersonalCnfPath"} = ".";
68
69} elsif ($OS eq "MPE") {
70 $Cnf{"PathSep"} = ":";
71 $Cnf{"PersonalCnf"} = "Manip.cnf";
72 $Cnf{"PersonalCnfPath"} = ".";
73
74} elsif ($OS eq "OS2") {
75 $Cnf{"PathSep"} = ":";
76 $Cnf{"PersonalCnf"} = "Manip.cnf";
77 $Cnf{"PersonalCnfPath"} = ".";
78
79} elsif ($OS eq "Mac") {
80 $Cnf{"PathSep"} = ":";
81 $Cnf{"PersonalCnf"} = "Manip.cnf";
82 $Cnf{"PersonalCnfPath"} = ".";
83
84} elsif ($OS eq "VMS") {
85 # VMS doesn't like files starting with "."
86 $Cnf{"PathSep"} = ",";
87 $Cnf{"PersonalCnf"} = "Manip.cnf";
88 $Cnf{"PersonalCnfPath"} = "/sys\$login";
89
90} else {
91 # Unix
92 $Cnf{"PathSep"} = ":";
93 $Cnf{"PersonalCnf"} = ".DateManip.cnf";
94 $Cnf{"PersonalCnfPath"} = ".:~";
95 @Date::Manip::DatePath=qw(/bin /usr/bin /usr/local/bin);
96}
97
98### Date::Manip variables set in the global or personal config file
99
100# Which language to use when parsing dates.
101$Cnf{"Language"}="English";
102
103# 12/10 = Dec 10 (US) or Oct 12 (anything else)
104$Cnf{"DateFormat"}="US";
105
106# Local timezone
107$Cnf{"TZ"}="";
108
109# Timezone to work in (""=local, "IGNORE", or a timezone)
110$Cnf{"ConvTZ"}="";
111
112# Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
113$Cnf{"Internal"}=0;
114
115# First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
116$Cnf{"FirstDay"}=1;
117
118# First and last day of the work week (1=monday, 7=sunday)
119$Cnf{"WorkWeekBeg"}=1;
120$Cnf{"WorkWeekEnd"}=5;
121
122# If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
123# ignored)
124$Cnf{"WorkDay24Hr"}=0;
125
126# Start and end time of the work day (any time format allowed, seconds
127# ignored)
128$Cnf{"WorkDayBeg"}="08:00";
129$Cnf{"WorkDayEnd"}="17:00";
130
131# If "today" is a holiday, we look either to "tomorrow" or "yesterday" for
132# the nearest business day. By default, we'll always look "tomorrow"
133# first.
134$Cnf{"TomorrowFirst"}=1;
135
136# Erase the old holidays
137$Cnf{"EraseHolidays"}="";
138
139# Set this to non-zero to be produce completely backwards compatible deltas
140$Cnf{"DeltaSigns"}=0;
141
142# If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
143# make week 1 contain Jan 1.
144$Cnf{"Jan1Week1"}=0;
145
146# 2 digit years fall into the 100 year period given by [ CURR-N,
147# CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful
148# numbers might be 0 (forced to be this year or later) and 99 (forced to be
149# this year or earlier). It can also be set to "c" (current century) or
150# "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the
151# form cNNNN to give the 100 year period NNNN to NNNN+99.
152$Cnf{"YYtoYYYY"}=89;
153
154# Set this to 1 if you want a long-running script to always update the
155# timezone. This will slow Date::Manip down. Read the POD documentation.
156$Cnf{"UpdateCurrTZ"}=0;
157
158# Use an international character set.
159$Cnf{"IntCharSet"}=0;
160
161# Use this to force the current date to be set to this:
162$Cnf{"ForceDate"}="";
163
164# Use this to make "today" mean "today at midnight".
165$Cnf{"TodayIsMidnight"}=0;
166
167###########################################################################
168
169require 5.000;
170require Exporter;
171@ISA = qw(Exporter);
172@EXPORT = qw(
173 DateManipVersion
174 Date_Init
175 ParseDateString
176 ParseDate
177 ParseRecur
178 Date_Cmp
179 DateCalc
180 ParseDateDelta
181 UnixDate
182 Delta_Format
183 Date_GetPrev
184 Date_GetNext
185 Date_SetTime
186 Date_SetDateField
187 Date_IsHoliday
188 Events_List
189
190 Date_DaysInMonth
191 Date_DayOfWeek
192 Date_SecsSince1970
193 Date_SecsSince1970GMT
194 Date_DaysSince1BC
195 Date_DayOfYear
196 Date_DaysInYear
197 Date_WeekOfYear
198 Date_LeapYear
199 Date_DaySuffix
200 Date_ConvTZ
201 Date_TimeZone
202 Date_IsWorkDay
203 Date_NextWorkDay
204 Date_PrevWorkDay
205 Date_NearestWorkDay
206 Date_NthDayOfYear
207);
208use strict;
209use integer;
210use Carp;
211
212use IO::File;
213
214$VERSION="5.47";
215
216########################################################################
217########################################################################
218
219$Curr{"InitLang"} = 1; # Whether a language is being init'ed
220$Curr{"InitDone"} = 0; # Whether Init_Date has been called
221$Curr{"InitFilesRead"} = 0;
222$Curr{"ResetWorkDay"} = 1;
223$Curr{"Debug"} = "";
224$Curr{"DebugVal"} = "";
225
226$Holiday{"year"} = 0;
227$Holiday{"dates"} = {};
228$Holiday{"desc"} = {};
229
230$Events{"raw"} = [];
231$Events{"parsed"} = 0;
232$Events{"dates"} = [];
233$Events{"recur"} = [];
234
235########################################################################
236########################################################################
237# THESE ARE THE MAIN ROUTINES
238########################################################################
239########################################################################
240
241# Get rid of a problem with old versions of perl
242no strict "vars";
243# This sorts from longest to shortest element
244sub sortByLength {
245 return (length $b <=> length $a);
246}
247use strict "vars";
248
249sub DateManipVersion {
250 print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
251 return $VERSION;
252}
253
254sub Date_Init {
255 print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
256 $Curr{"Debug"}="";
257
258 my(@args)=@_;
259 $Curr{"InitDone"}=1;
260 local($_)=();
261 my($internal,$firstday)=();
262 my($var,$val,$file,@tmp)=();
263
264 # InitFilesRead = 0 : no conf files read yet
265 # 1 : global read, no personal read
266 # 2 : personal read
267
268 $Cnf{"EraseHolidays"}=0;
269 foreach (@args) {
270 s/\s*$//;
271 s/^\s*//;
272 /^(\S+) \s* = \s* (.*)$/x;
273 ($var,$val)=($1,$2);
274 if ($var =~ /^GlobalCnf$/i) {
275 $Cnf{"GlobalCnf"}=$val;
276 if ($val) {
277 $Curr{"InitFilesRead"}=0;
278 &EraseHolidays();
279 }
280 } elsif ($var =~ /^PathSep$/i) {
281 $Cnf{"PathSep"}=$val;
282 } elsif ($var =~ /^PersonalCnf$/i) {
283 $Cnf{"PersonalCnf"}=$val;
284 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
285 } elsif ($var =~ /^PersonalCnfPath$/i) {
286 $Cnf{"PersonalCnfPath"}=$val;
287 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
288 } elsif ($var =~ /^IgnoreGlobalCnf$/i) {
289 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0);
290 $Cnf{"IgnoreGlobalCnf"}=1;
291 } elsif ($var =~ /^EraseHolidays$/i) {
292 &EraseHolidays();
293 } else {
294 push(@tmp,$_);
295 }
296 }
297 @args=@tmp;
298
299 # Read global config file
300 if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
301 $Curr{"InitFilesRead"}=1;
302
303 if ($Cnf{"GlobalCnf"}) {
304 $file=&ExpandTilde($Cnf{"GlobalCnf"});
305 &Date_InitFile($file) if ($file);
306 }
307 }
308
309 # Read personal config file
310 if ($Curr{"InitFilesRead"}<2) {
311 $Curr{"InitFilesRead"}=2;
312
313 if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) {
314 $file=&SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r");
315 &Date_InitFile($file) if ($file);
316 }
317 }
318
319 foreach (@args) {
320 s/\s*$//;
321 s/^\s*//;
322 /^(\S+) \s* = \s* (.*)$/x;
323 ($var,$val)=($1,$2);
324 $val="" if (! defined $val);
325 &Date_SetConfigVariable($var,$val);
326 }
327
328 confess "ERROR: Unknown FirstDay in Date::Manip.\n"
329 if (! &IsInt($Cnf{"FirstDay"},1,7));
330 confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n"
331 if (! &IsInt($Cnf{"WorkWeekBeg"},1,7));
332 confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n"
333 if (! &IsInt($Cnf{"WorkWeekEnd"},1,7));
334 confess "ERROR: Invalid WorkWeek in Date::Manip.\n"
335 if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"});
336
337 my(%lang,
338 $tmp,%tmp,$tmp2,@tmp2,
339 $i,$j,@tmp3,
340 $zonesrfc,@zones)=();
341
342 my($L)=$Cnf{"Language"};
343
344 if ($Curr{"InitLang"}) {
345 $Curr{"InitLang"}=0;
346
347 if ($L eq "English") {
348 &Date_Init_English(\%lang);
349
350 } elsif ($L eq "French") {
351 &Date_Init_French(\%lang);
352
353 } elsif ($L eq "Swedish") {
354 &Date_Init_Swedish(\%lang);
355
356 } elsif ($L eq "German") {
357 &Date_Init_German(\%lang);
358
359 } elsif ($L eq "Polish") {
360 &Date_Init_Polish(\%lang);
361
362 } elsif ($L eq "Dutch" ||
363 $L eq "Nederlands") {
364 &Date_Init_Dutch(\%lang);
365
366 } elsif ($L eq "Spanish") {
367 &Date_Init_Spanish(\%lang);
368
369 } elsif ($L eq "Portuguese") {
370 &Date_Init_Portuguese(\%lang);
371
372 } elsif ($L eq "Romanian") {
373 &Date_Init_Romanian(\%lang);
374
375 } elsif ($L eq "Italian") {
376 &Date_Init_Italian(\%lang);
377
378 } elsif ($L eq "Russian") {
379 &Date_Init_Russian(\%lang);
380
381 } elsif ($L eq "Turkish") {
382 &Date_Init_Turkish(\%lang);
383
384 } elsif ($L eq "Danish") {
385 &Date_Init_Danish(\%lang);
386
387 } elsif ($L eq "Catalan") {
388 &Date_Init_Catalan(\%lang);
389
390 } else {
391 confess "ERROR: Unknown language in Date::Manip.\n";
392 }
393
394 # variables for months
395 # Month = "(jan|january|feb|february ... )"
396 # MonL = [ "Jan","Feb",... ]
397 # MonthL = [ "January","February", ... ]
398 # MonthH = { "january"=>1, "jan"=>1, ... }
399
400 $Lang{$L}{"MonthH"}={};
401 $Lang{$L}{"MonthL"}=[];
402 $Lang{$L}{"MonL"}=[];
403 &Date_InitLists([$lang{"month_name"},
404 $lang{"month_abb"}],
405 \$Lang{$L}{"Month"},"lc,sort,back",
406 [$Lang{$L}{"MonthL"},
407 $Lang{$L}{"MonL"}],
408 [$Lang{$L}{"MonthH"},1]);
409
410 # variables for day of week
411 # Week = "(mon|monday|tue|tuesday ... )"
412 # WL = [ "M","T",... ]
413 # WkL = [ "Mon","Tue",... ]
414 # WeekL = [ "Monday","Tudesday",... ]
415 # WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
416
417 $Lang{$L}{"WeekH"}={};
418 $Lang{$L}{"WeekL"}=[];
419 $Lang{$L}{"WkL"}=[];
420 $Lang{$L}{"WL"}=[];
421 &Date_InitLists([$lang{"day_name"},
422 $lang{"day_abb"}],
423 \$Lang{$L}{"Week"},"lc,sort,back",
424 [$Lang{$L}{"WeekL"},
425 $Lang{$L}{"WkL"}],
426 [$Lang{$L}{"WeekH"},1]);
427 &Date_InitLists([$lang{"day_char"}],
428 "","lc",
429 [$Lang{$L}{"WL"}],
430 [\%tmp,1]);
431 %{ $Lang{$L}{"WeekH"} } =
432 (%{ $Lang{$L}{"WeekH"} },%tmp);
433
434 # variables for last
435 # Last = "(last)"
436 # LastL = [ "last" ]
437 # Each = "(each)"
438 # EachL = [ "each" ]
439 # variables for day of month
440 # DoM = "(1st|first ... 31st)"
441 # DoML = [ "1st","2nd",... "31st" ]
442 # DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 }
443 # variables for week of month
444 # WoM = "(1st|first| ... 5th|last)"
445 # WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 }
446
447 $Lang{$L}{"LastL"}=$lang{"last"};
448 &Date_InitStrings($lang{"last"},
449 \$Lang{$L}{"Last"},"lc,sort");
450
451 $Lang{$L}{"EachL"}=$lang{"each"};
452 &Date_InitStrings($lang{"each"},
453 \$Lang{$L}{"Each"},"lc,sort");
454
455 $Lang{$L}{"DoMH"}={};
456 $Lang{$L}{"DoML"}=[];
457 &Date_InitLists([$lang{"num_suff"},
458 $lang{"num_word"}],
459 \$Lang{$L}{"DoM"},"lc,sort,back,escape",
460 [$Lang{$L}{"DoML"},
461 \@tmp],
462 [$Lang{$L}{"DoMH"},1]);
463
464 @tmp=();
465 foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
466 $tmp2=$Lang{$L}{"DoMH"}{$tmp};
467 if ($tmp2<6) {
468 $Lang{$L}{"WoMH"}{$tmp} = $tmp2;
469 push(@tmp,$tmp);
470 }
471 }
472 foreach $tmp (@{ $Lang{$L}{"LastL"} }) {
473 $Lang{$L}{"WoMH"}{$tmp} = -1;
474 push(@tmp,$tmp);
475 }
476 &Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"},
477 "lc,sort,back,escape");
478
479 # variables for AM or PM
480 # AM = "(am)"
481 # PM = "(pm)"
482 # AmPm = "(am|pm)"
483 # AMstr = "AM"
484 # PMstr = "PM"
485
486 &Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape");
487 &Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape");
488 &Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"},
489 "lc,back,sort,escape");
490 $Lang{$L}{"AMstr"}=$lang{"am"}[0];
491 $Lang{$L}{"PMstr"}=$lang{"pm"}[0];
492
493 # variables for expressions used in parsing deltas
494 # Yabb = "(?:y|yr|year|years)"
495 # Mabb = similar for months
496 # Wabb = similar for weeks
497 # Dabb = similar for days
498 # Habb = similar for hours
499 # MNabb = similar for minutes
500 # Sabb = similar for seconds
501 # Repl = { "abb"=>"replacement" }
502 # Whenever an abbreviation could potentially refer to two different
503 # strings (M standing for Minutes or Months), the abbreviation must
504 # be listed in Repl instead of in the appropriate Xabb values. This
505 # only applies to abbreviations which are substrings of other values
506 # (so there is no confusion between Mn and Month).
507
508 &Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort");
509 &Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort");
510 &Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort");
511 &Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort");
512 &Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort");
513 &Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort");
514 &Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort");
515 $Lang{$L}{"Repl"}={};
516 &Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
517
518 # variables for special dates that are offsets from now
519 # Now = "now"
520 # Today = "today"
521 # Offset = "(yesterday|tomorrow)"
522 # OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ]
523 # Times = "(noon|midnight)"
524 # TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" }
525 # SepHM = hour/minute separator
526 # SepMS = minute/second separator
527 # SepSS = second/fraction separator
528
529 $Lang{$L}{"TimesH"}={};
530 &Date_InitHash($lang{"times"},
531 \$Lang{$L}{"Times"},"lc,sort,back",
532 $Lang{$L}{"TimesH"});
533 &Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort");
534 &Date_InitStrings($lang{"today"},\$Lang{$L}{"Today"},"lc,sort");
535 $Lang{$L}{"OffsetH"}={};
536 &Date_InitHash($lang{"offset"},
537 \$Lang{$L}{"Offset"},"lc,sort,back",
538 $Lang{$L}{"OffsetH"});
539 $Lang{$L}{"SepHM"}=$lang{"sephm"};
540 $Lang{$L}{"SepMS"}=$lang{"sepms"};
541 $Lang{$L}{"SepSS"}=$lang{"sepss"};
542
543 # variables for time zones
544 # zones = regular expression with all zone names (EST)
545 # n2o = a hash of all parsable zone names with their offsets
546 # tzones = reguar expression with all tzdata timezones (US/Eastern)
547 # tz2z = hash of all tzdata timezones to full timezone (EST#EDT)
548
549 $zonesrfc=
550 "idlw -1200 ". # International Date Line West
551 "nt -1100 ". # Nome
552 "hst -1000 ". # Hawaii Standard
553 "cat -1000 ". # Central Alaska
554 "ahst -1000 ". # Alaska-Hawaii Standard
555 "akst -0900 ". # Alaska Standard
556 "yst -0900 ". # Yukon Standard
557 "hdt -0900 ". # Hawaii Daylight
558 "akdt -0800 ". # Alaska Daylight
559 "ydt -0800 ". # Yukon Daylight
560 "pst -0800 ". # Pacific Standard
561 "pdt -0700 ". # Pacific Daylight
562 "mst -0700 ". # Mountain Standard
563 "mdt -0600 ". # Mountain Daylight
564 "cst -0600 ". # Central Standard
565 "cdt -0500 ". # Central Daylight
566 "est -0500 ". # Eastern Standard
567 "act -0500 ". # Brazil, Acre
568 "pet -0500 ". # Peruvian time
569 "sat -0400 ". # Chile
[463]570 "clt -0400 ". # Chile
[360]571 "clst -0400 ". # Chile Standard
572 "bot -0400 ". # Bolivia
573 "amt -0400 ". # Brazil, Amazon
574 "acst -0400 ". # Brazil, Acre Daylight
575 "edt -0400 ". # Eastern Daylight
576 "ast -0400 ". # Atlantic Standard
577 #"nst -0330 ". # Newfoundland Standard nst=North Sumatra +0630
578 "nft -0330 ". # Newfoundland
579 #"gst -0300 ". # Greenland Standard gst=Guam Standard +1000
580 "cldt -0300 ". # Chile Daylight
581 #"bst -0300 ". # Brazil Standard bst=British Summer +0100
582 "brt -0300 ". # Brazil Standard (official time)
583 #"brst -0300 ". # Brazil Standard
584 "adt -0300 ". # Atlantic Daylight
585 "art -0300 ". # Argentina
586 "amst -0300 ". # Brazil, Amazon Daylight
587 "uyt -0300 ". # Uruguay
588 "ndt -0230 ". # Newfoundland Daylight
589 "brst -0200 ". # Brazil Daylight (official time)
590 "fnt -0200 ". # Brazil, Fernando de Noronha
591 "at -0200 ". # Azores
592 "yust -0200 ". # Uruguay
593 "wat -0100 ". # West Africa
594 "fnst -0100 ". # Brazil, Fernando de Noronha Daylight
595 "gmt +0000 ". # Greenwich Mean
596 "ut +0000 ". # Universal
597 "utc +0000 ". # Universal (Coordinated)
598 "wet +0000 ". # Western European
599 "cet +0100 ". # Central European
600 "fwt +0100 ". # French Winter
601 "met +0100 ". # Middle European
602 "mez +0100 ". # Middle European
603 "mewt +0100 ". # Middle European Winter
604 "swt +0100 ". # Swedish Winter
605 "bst +0100 ". # British Summer bst=Brazil standard -0300
606 "gb +0100 ". # GMT with daylight savings
607 "west +0100 ". # Western European Daylight
608 "eet +0200 ". # Eastern Europe, USSR Zone 1
609 "cest +0200 ". # Central European Summer
610 "fst +0200 ". # French Summer
611 "ist +0200 ". # Israel standard
612 "mest +0200 ". # Middle European Summer
613 "mesz +0200 ". # Middle European Summer
614 "metdst +0200 ". # An alias for mest used by HP-UX
615 "sast +0200 ". # South African Standard
616 "sst +0200 ". # Swedish Summer sst=South Sumatra +0700
617 "bt +0300 ". # Baghdad, USSR Zone 2
618 "eest +0300 ". # Eastern Europe Summer
619 "eetdst +0300 ". # An alias for eest used by HP-UX
620 "eetedt +0300 ". # Eastern Europe, USSR Zone 1
621 "idt +0300 ". # Israel Daylight
622 "msk +0300 ". # Moscow
623 "eat +0300 ". # East Africa
624 "it +0330 ". # Iran
625 "zp4 +0400 ". # USSR Zone 3
626 "msd +0400 ". # Moscow Daylight
627 "zp5 +0500 ". # USSR Zone 4
628 "ist +0530 ". # Indian Standard
629 "zp6 +0600 ". # USSR Zone 5
630 "novt +0600 ". # Novosibirsk winter time zone, Russia
631 "nst +0630 ". # North Sumatra nst=Newfoundland Std -0330
632 #"sst +0700 ". # South Sumatra, USSR Zone 6 sst=Swedish Summer +0200
633 "javt +0700 ". # Java
634 "ict +0700 ". # Indo China Time
635 "novst +0700 ". # Novosibirsk summer time zone, Russia
636 "krat +0700 ". # Krasnoyarsk, Russia
637 "myt +0800 ". # Malaysia
638 "hkt +0800 ". # Hong Kong
639 "sgt +0800 ". # Singapore
640 "cct +0800 ". # China Coast, USSR Zone 7
641 "krast +0800 ". # Krasnoyarsk, Russia Daylight
642 "awst +0800 ". # Australian Western Standard
643 "wst +0800 ". # West Australian Standard
644 "pht +0800 ". # Asia Manila
645 "kst +0900 ". # Republic of Korea
646 "jst +0900 ". # Japan Standard, USSR Zone 8
647 "rok +0900 ". # Republic of Korea
648 "acst +0930 ". # Australian Central Standard
649 "cast +0930 ". # Central Australian Standard
650 "aest +1000 ". # Australian Eastern Standard
651 "east +1000 ". # Eastern Australian Standard
652 "gst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
653 "chst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
654 "acdt +1030 ". # Australian Central Daylight
655 "cadt +1030 ". # Central Australian Daylight
656 "aedt +1100 ". # Australian Eastern Daylight
657 "eadt +1100 ". # Eastern Australian Daylight
658 "idle +1200 ". # International Date Line East
659 "nzst +1200 ". # New Zealand Standard
660 "nzt +1200 ". # New Zealand
661 "nzdt +1300 ". # New Zealand Daylight
662 "z +0000 ".
663 "a +0100 b +0200 c +0300 d +0400 e +0500 f +0600 g +0700 h +0800 ".
664 "i +0900 k +1000 l +1100 m +1200 ".
665 "n -0100 o -0200 p -0300 q -0400 r -0500 s -0600 t -0700 u -0800 ".
666 "v -0900 w -1000 x -1100 y -1200";
667
668 $Zone{"n2o"} = {};
669 ($Zone{"zones"},%{ $Zone{"n2o"} })=
670 &Date_Regexp($zonesrfc,"sort,lc,under,back",
671 "keys");
672
673 $tmp=
674 "US/Pacific PST8PDT ".
675 "US/Mountain MST7MDT ".
676 "US/Central CST6CDT ".
677 "US/Eastern EST5EDT ".
678 "Canada/Pacific PST8PDT ".
679 "Canada/Mountain MST7MDT ".
680 "Canada/Central CST6CDT ".
681 "Canada/Eastern EST5EDT";
682
683 $Zone{"tz2z"} = {};
684 ($Zone{"tzones"},%{ $Zone{"tz2z"} })=
685 &Date_Regexp($tmp,"lc,under,back","keys");
686 $Cnf{"TZ"}=&Date_TimeZone;
687
688 # misc. variables
689 # At = "(?:at)"
690 # Of = "(?:in|of)"
691 # On = "(?:on)"
692 # Future = "(?:in)"
693 # Later = "(?:later)"
694 # Past = "(?:ago)"
695 # Next = "(?:next)"
696 # Prev = "(?:last|previous)"
697
698 &Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort");
699 &Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort");
700 &Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort");
701 &Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort");
702 &Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort");
703 &Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort");
704 &Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort");
705 &Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort");
706
707 # calc mode variables
708 # Approx = "(?:approximately)"
709 # Exact = "(?:exactly)"
710 # Business = "(?:business)"
711
712 &Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort");
713 &Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort");
714 &Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort");
715
716 ############### END OF LANGUAGE INITIALIZATION
717 }
718
719 if ($Curr{"ResetWorkDay"}) {
720 my($h1,$m1,$h2,$m2)=();
721 if ($Cnf{"WorkDay24Hr"}) {
722 ($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
723 ($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
724 $Curr{"WDlen"}=24*60;
725 $Cnf{"WorkDayBeg"}="00:00";
726 $Cnf{"WorkDayEnd"}="23:59";
727
728 } else {
729 confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n"
730 if (! (($h1,$m1)=&CheckTime($Cnf{"WorkDayBeg"})));
731 $Cnf{"WorkDayBeg"}="$h1:$m1";
732 confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n"
733 if (! (($h2,$m2)=&CheckTime($Cnf{"WorkDayEnd"})));
734 $Cnf{"WorkDayEnd"}="$h2:$m2";
735
736 ($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
737 ($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
738
739 # Work day length = h1:m1 or 0:len (len minutes)
740 $h1=$h2-$h1;
741 $m1=$m2-$m1;
742 if ($m1<0) {
743 $h1--;
744 $m1+=60;
745 }
746 $Curr{"WDlen"}=$h1*60+$m1;
747 }
748 $Curr{"ResetWorkDay"}=0;
749 }
750
751 # current time
752 my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
753 if ($Cnf{"ForceDate"}=~
754 /^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
755 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
756 } else {
757 ($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
758 $y+=1900;
759 $m++;
760 }
761 &Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
762 $Curr{"Y"}=$y;
763 $Curr{"M"}=$m;
764 $Curr{"D"}=$d;
765 $Curr{"H"}=$h;
766 $Curr{"Mn"}=$mn;
767 $Curr{"S"}=$s;
768 $Curr{"AmPm"}=$ampm;
769 $Curr{"Now"}=&Date_Join($y,$m,$d,$h,$mn,$s);
770 if ($Cnf{"TodayIsMidnight"}) {
771 $Curr{"Today"}=&Date_Join($y,$m,$d,0,0,0);
772 } else {
773 $Curr{"Today"}=$Curr{"Now"};
774 }
775
776 $Curr{"Debug"}=$Curr{"DebugVal"};
777
778 # If we're in array context, let's return a list of config variables
779 # that could be passed to Date_Init to get the same state as we're
780 # currently in.
781 if (wantarray) {
782 # Some special variables that have to be in a specific order
783 my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
784 my(%tmp)=map { $_,1 } @special;
785 my(@tmp,$key,$val);
786 foreach $key (@special) {
787 $val=$Cnf{$key};
788 push(@tmp,"$key=$val");
789 }
790 foreach $key (keys %Cnf) {
791 next if (exists $tmp{$key});
792 $val=$Cnf{$key};
793 push(@tmp,"$key=$val");
794 }
795 return @tmp;
796 }
797 return ();
798}
799
800sub ParseDateString {
801 print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
802 local($_)=@_;
803 return "" if (! $_);
804
805 my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
806 my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
807
808 # We only need to reinitialize if we have to determine what NOW is.
809 &Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
810
811 my($L)=$Cnf{"Language"};
812 my($type)=$Cnf{"DateFormat"};
813
814 # Mode is set in DateCalc. ParseDate only overrides it if the string
815 # contains a mode.
816 if ($Lang{$L}{"Exact"} &&
817 s/$Lang{$L}{"Exact"}//) {
818 $Curr{"Mode"}=0;
819 } elsif ($Lang{$L}{"Approx"} &&
820 s/$Lang{$L}{"Approx"}//) {
821 $Curr{"Mode"}=1;
822 } elsif ($Lang{$L}{"Business"} &&
823 s/$Lang{$L}{"Business"}//) {
824 $Curr{"Mode"}=2;
825 } elsif (! exists $Curr{"Mode"}) {
826 $Curr{"Mode"}=0;
827 }
828
829 # Unfortunately, some deltas can be parsed as dates. An example is
830 # 1 second == 1 2nd == 1 2
831 # But, some dates can be parsed as deltas. The most important being:
832 # 1998010101:00:00
833 #
834 # We'll check to see if a "date" can be parsed as a delta. If so, we'll
835 # assume that it is a delta (since they are much simpler, it is much
836 # less likely that we'll mistake a delta for a date than vice versa)
837 # unless it is an ISO-8601 date.
838 #
839 # This is important because we are using DateCalc to test whether a
840 # string is a date or a delta. Dates are tested first, so we need to
841 # be able to pass a delta into this routine and have it correctly NOT
842 # interpreted as a date.
843 #
844 # We will insist that the string contain something other than digits and
845 # colons so that the following will get correctly interpreted as a date
846 # rather than a delta:
847 # 12:30
848 # 19980101
849
850 $delta="";
851 $delta=&ParseDateDelta($_) if (/[^:0-9]/);
852
853 # Put parse in a simple loop for an easy exit.
854 PARSE: {
855 my(@tmp)=&Date_Split($_);
856 if (@tmp) {
857 ($y,$m,$d,$h,$mn,$s)=@tmp;
858 last PARSE;
859 }
860
861 # Fundamental regular expressions
862
863 my($month)=$Lang{$L}{"Month"}; # (jan|january|...)
864 my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
865 my($week)=$Lang{$L}{"Week"}; # (mon|monday|...)
866 my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
867 my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last)
868 my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
869 my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st)
870 my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
871 my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm)
872 my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight)
873 my($now)=$Lang{$L}{"Now"}; # now
874 my($today)=$Lang{$L}{"Today"}; # today
875 my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow)
876 my($zone)=$Zone{"zones"}; # (edt|est|...)
877 my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days)
878 my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months)
879 my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks)
880 my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next)
881 my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous)
882 my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago)
883 my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in)
884 my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later)
885 my($at)=$Lang{$L}{"At"}; # (?:at)
886 my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of)
887 my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)';
888 # \s*(?:on)\s* or \s+
889 my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last)
890 my($hm)=$Lang{$L}{"SepHM"}; # :
891 my($ms)=$Lang{$L}{"SepMS"}; # :
892 my($ss)=$Lang{$L}{"SepSS"}; # .
893
894 # Other regular expressions
895
896 my($D4)='(\d{4})'; # 4 digits (yr)
897 my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr)
898 my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
899 my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
900 my($FS)="(?:$ss\\d+)?"; # fractional secs
901 my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
902 # absolute time zone +0700 (GMT)
903 my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23
904 my($mzone)='(?:[0-5][0-9])'; # 00 - 59
905 my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))".
906 # +0700 +07:00 -07
907 '(?:\s*\([^)]+\))?)'; # (GMT)
908
909 # A regular expression for the time EXCEPT for the hour part
910 my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
911
912 # A special regular expression for /YYYY:HH:MN:SS used by Apache
913 my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
914
915 my($time)="";
916 $ampm="";
917 $date="";
918
919 # Substitute all special time expressions.
920 if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
921 $tmp=$2;
922 $tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
923 s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
924 }
925
926 # Remove some punctuation
927 s/[,]/ /g;
928
929 # When we have a digit followed immediately by a timezone (7EST), we
930 # will put a space between the digit, EXCEPT in the case of a single
931 # character military timezone. If the single character is followed
932 # by anything, no space is added.
933 $tmp = "";
934 while ( s/^(.*?\d)$zone(\s|$|[0-9])/$3/i ) {
935 my($bef,$z,$aft) = ($1,$2,$3);
936 if (length($z) != 1 || length($aft) == 0) {
937 $tmp .= "$bef $z";
938 } else {
939 $tmp .= "$bef$z";
940 }
941 }
942 $_ = "$tmp$_";
943 $zone = '\s+' . $zone . '(?:\s+|$)';
944
945 # Remove the time
946 $iso=1;
947 $midnight=0;
948 $from="24${hm}00(?:${ms}00)?";
949 $falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
950 $to="00${hm}00${ms}00";
951 $midnight=1 if (!/$falsefrom/ && s/$from/$to/);
952
953 $h=$mn=$s=0;
954 if (/$D$mnsec/i || /$ampmexp/i) {
955 $iso=0;
956 $tmp=0;
957 $tmp=1 if (/$mnsec$zone2?\s*$/i or /$mnsec$zone\s*$/i);
958 $tmp=0 if (/$ampmexp/i);
959 if (s/$apachetime$zone()/$1 /i ||
960 s/$apachetime$zone2?/$1 /i ||
961 s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i ||
962 s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i ||
963 s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i ||
964 s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i ||
965 (s/(t)$D$mnsec$zone()/$1 /i and (($iso=$tmp) || 1)) ||
966 (s/(t)$D$mnsec$zone2?/$1 /i and (($iso=$tmp) || 1)) ||
967 (s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) ||
968 (s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) ||
969 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i ||
970 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i ||
971 0
972 ) {
973 ($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
974 if (defined ($z)) {
975 if ($z =~ /^[+-]\d{2}:\d{2}$/) {
976 $z=~ s/://;
977 } elsif ($z =~ /^[+-]\d{2}$/) {
978 $z .= "00";
979 }
980 }
981 $time=1;
982 &Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
983 $y=$m=$d="";
984 # We're going to be calling TimeCheck again below (when we check the
985 # final date), so get rid of $ampm so that we don't have an error
986 # due to "15:30:00 PM". It'll get reset below.
987 $ampm="";
988 if (/^\s*$/) {
989 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
990 last PARSE;
991 }
992 }
993 }
994 $time=0 if ($time ne "1");
995 s/\s+$//;
996 s/^\s+//;
997
998 # if a zone was found, get rid of the regexps
999 if ($z) {
1000 $zone="";
1001 $zone2="";
1002 }
1003
1004 # dateTtime ISO 8601 formats
1005 my($orig)=$_;
1006
1007 # Parse ISO 8601 dates now (which may still have a zone stuck to it).
1008 if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) ||
1009 ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) ||
1010 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) ||
1011 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) ||
1012 ($iso && /^([0-9-]+)T$zone?$/i) ||
1013 ($iso && /^([0-9-]+)T$zone2?$/i) ||
1014 0) {
1015
1016 # If we already got a timezone, don't get another one.
1017 my(@z);
1018 if ($z) {
1019 @z=($z,$z2);
1020 $z="";
1021 }
1022 ($_,$z,$z2) = ($1,$2,$3);
1023 ($z,$z2)=@z if (@z);
1024
1025 s,([0-9])\s*-,$1 ,g; # Change all ISO8601 seps to spaces
1026 s/^\s+//;
1027 s/\s+$//;
1028
1029 if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
1030 /^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
1031 0
1032 ) {
1033 # ISO 8601 Dates with times
1034 # YYYYMMDDtHHMNSSFFFF...
1035 # YYYYMMDDtHHMNSS
1036 # YYYYMMDDtHHMN
1037 # YYYYMMDDtHH
1038 # YY MMDDtHHMNSSFFFF...
1039 # YY MMDDtHHMNSS
1040 # YY MMDDtHHMN
1041 # YY MMDDtHH
1042 # The t is an optional letter "t".
1043 ($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
1044 if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) {
1045 $h=0;
1046 $midnight=1;
1047 }
1048 $z = "" if (! defined $h);
1049 return "" if ($time && defined $h);
1050 last PARSE;
1051
1052 } elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
1053 /^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
1054 # ISO 8601 Dates
1055 # YYYYMMDD
1056 # YYYYMM
1057 # YYYY
1058 # YY MMDD
1059 # YY MM
1060 # YY
1061 ($y,$m,$d)=($1,$2,$3);
1062 last PARSE;
1063
1064 } elsif (/^$YY\s+$D\s+$D/) {
1065 # YY-M-D
1066 ($y,$m,$d)=($1,$2,$3);
1067 last PARSE;
1068
1069 } elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
1070 # YY-W##-D
1071 ($y,$wofm,$dofw)=($1,$2,$3);
1072 ($y,$m,$d)=&Date_NthWeekOfYear($y,$wofm,$dofw);
1073 last PARSE;
1074
1075 } elsif (/^$D4\s*(\d{3})$/ ||
1076 /^$DD\s*(\d{3})$/) {
1077 # YYDOY
1078 ($y,$which)=($1,$2);
1079 ($y,$m,$d)=&Date_NthDayOfYear($y,$which);
1080 last PARSE;
1081
1082 } elsif ($iso<0) {
1083 # We confused something like 1999/August12:00:00
1084 # with a dateTtime format
1085 $_=$orig;
1086
1087 } else {
1088 return "";
1089 }
1090 }
1091
1092 # All deltas that are not ISO-8601 dates are NOT dates.
1093 return "" if ($Curr{"InCalc"} && $delta);
1094 if ($delta) {
1095 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1096 return &DateCalc_DateDelta($Curr{"Now"},$delta);
1097 }
1098
1099 # Check for some special types of dates (next, prev)
1100 foreach $from (keys %{ $Lang{$L}{"Repl"} }) {
1101 $to=$Lang{$L}{"Repl"}{$from};
1102 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
1103 }
1104 if (/$wom/i || /$future/i || /$later/i || /$past/i ||
1105 /$next/i || /$prev/i || /^$week$/i || /$wkabb/i) {
1106 $tmp=0;
1107
1108 if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
1109 # last friday in October 95
1110 ($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
1111 # fix $m, $y
1112 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1113 $dofw=$week{lc($dofw)};
1114 $wofm=$wom{lc($wofm)};
1115 # Get the first day of the month
1116 $date=&Date_Join($y,$m,1,$h,$mn,$s);
1117 if ($wofm==-1) {
1118 $date=&DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0);
1119 $date=&Date_GetPrev($date,$dofw,0);
1120 } else {
1121 for ($i=0; $i<$wofm; $i++) {
1122 if ($i==0) {
1123 $date=&Date_GetNext($date,$dofw,1);
1124 } else {
1125 $date=&Date_GetNext($date,$dofw,0);
1126 }
1127 }
1128 }
1129 last PARSE;
1130
1131 } elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
1132 # last day in month
1133 ($m,$y)=($1,$2);
1134 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1135 $y=&Date_FixYear($y) if (! defined $y or length($y)<4);
1136 $m=$month{lc($m)};
1137 $d=&Date_DaysInMonth($m,$y);
1138 last PARSE;
1139
1140 } elsif (/^$week$/i) {
1141 # friday
1142 ($dofw)=($1);
1143 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1144 $date=&Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1);
1145 $date=&Date_GetNext($date,$dofw,1,$h,$mn,$s);
1146 last PARSE;
1147
1148 } elsif (/^$next\s*$week$/i) {
1149 # next friday
1150 ($dofw)=($1);
1151 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1152 $date=&Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s);
1153 last PARSE;
1154
1155 } elsif (/^$prev\s*$week$/i) {
1156 # last friday
1157 ($dofw)=($1);
1158 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1159 $date=&Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s);
1160 last PARSE;
1161
1162 } elsif (/^$next$wkabb$/i) {
1163 # next week
1164 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1165 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0);
1166 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1167 last PARSE;
1168 } elsif (/^$prev$wkabb$/i) {
1169 # last week
1170 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1171 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0);
1172 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1173 last PARSE;
1174
1175 } elsif (/^$next$mabb$/i) {
1176 # next month
1177 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1178 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0);
1179 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1180 last PARSE;
1181 } elsif (/^$prev$mabb$/i) {
1182 # last month
1183 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1184 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0);
1185 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1186 last PARSE;
1187
1188 } elsif (/^$future\s*(\d+)$day$/i ||
1189 /^(\d+)$day$later$/i) {
1190 # in 2 days
1191 # 2 days later
1192 ($num)=($1);
1193 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1194 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0",
1195 \$err,0);
1196 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1197 last PARSE;
1198 } elsif (/^(\d+)$day$past$/i) {
1199 # 2 days ago
1200 ($num)=($1);
1201 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1202 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0",
1203 \$err,0);
1204 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1205 last PARSE;
1206
1207 } elsif (/^$future\s*(\d+)$wkabb$/i ||
1208 /^(\d+)$wkabb$later$/i) {
1209 # in 2 weeks
1210 # 2 weeks later
1211 ($num)=($1);
1212 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1213 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0",
1214 \$err,0);
1215 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1216 last PARSE;
1217 } elsif (/^(\d+)$wkabb$past$/i) {
1218 # 2 weeks ago
1219 ($num)=($1);
1220 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1221 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0",
1222 \$err,0);
1223 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1224 last PARSE;
1225
1226 } elsif (/^$future\s*(\d+)$mabb$/i ||
1227 /^(\d+)$mabb$later$/i) {
1228 # in 2 months
1229 # 2 months later
1230 ($num)=($1);
1231 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1232 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0",
1233 \$err,0);
1234 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1235 last PARSE;
1236 } elsif (/^(\d+)$mabb$past$/i) {
1237 # 2 months ago
1238 ($num)=($1);
1239 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1240 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0",
1241 \$err,0);
1242 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1243 last PARSE;
1244
1245 } elsif (/^$week$future\s*(\d+)$wkabb$/i ||
1246 /^$week\s*(\d+)$wkabb$later$/i) {
1247 # friday in 2 weeks
1248 # friday 2 weeks later
1249 ($dofw,$num)=($1,$2);
1250 $tmp="+";
1251 } elsif (/^$week\s*(\d+)$wkabb$past$/i) {
1252 # friday 2 weeks ago
1253 ($dofw,$num)=($1,$2);
1254 $tmp="-";
1255 } elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
1256 /^(\d+)$wkabb$later$on$week$/i) {
1257 # in 2 weeks on friday
1258 # 2 weeks later on friday
1259 ($num,$dofw)=($1,$2);
1260 $tmp="+"
1261 } elsif (/^(\d+)$wkabb$past$on$week$/i) {
1262 # 2 weeks ago on friday
1263 ($num,$dofw)=($1,$2);
1264 $tmp="-";
1265 } elsif (/^$week\s*$wkabb$/i) {
1266 # monday week (British date: in 1 week on monday)
1267 $dofw=$1;
1268 $num=1;
1269 $tmp="+";
1270 } elsif ( (/^$now\s*$wkabb$/i && ($tmp="Now")) ||
1271 (/^$today\s*$wkabb$/i && ($tmp="Today")) ) {
1272 # now week (British date: 1 week from now)
1273 # today week (British date: 1 week from today)
1274 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1275 $date=&DateCalc_DateDelta($Curr{$tmp},"+0:0:1:0:0:0:0",\$err,0);
1276 $date=&Date_SetTime($date,$h,$mn,$s) if ($time);
1277 last PARSE;
1278 } elsif (/^$offset\s*$wkabb$/i) {
1279 # tomorrow week (British date: 1 week from tomorrow)
1280 ($offset)=($1);
1281 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1282 $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
1283 $date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1284 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0);
1285 if ($time) {
1286 return ""
1287 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1288 $date=&Date_SetTime($date,$h,$mn,$s);
1289 }
1290 last PARSE;
1291 }
1292
1293 if ($tmp) {
1294 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1295 $date=&DateCalc_DateDelta($Curr{"Now"},
1296 $tmp . "0:0:$num:0:0:0:0",\$err,0);
1297 $date=&Date_GetPrev($date,$Cnf{"FirstDay"},1);
1298 $date=&Date_GetNext($date,$dofw,1,$h,$mn,$s);
1299 last PARSE;
1300 }
1301 }
1302
1303 # Change (2nd, second) to 2
1304 $tmp=0;
1305 if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
1306 if (/^\s*$dom\s*$/) {
1307 ($d)=($1);
1308 $d=$dom{lc($d)};
1309 $m=$Curr{"M"};
1310 last PARSE;
1311 }
1312 my $from = $2;
1313 my $to = $dom{ lc($from) };
1314 s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
1315 s/^\s+//;
1316 s/\s+$//;
1317 }
1318
1319 # Another set of special dates (Nth week)
1320 if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
1321 # 22nd sunday in 1996
1322 ($which,$dofw,$y)=($1,$2,$3);
1323 $y=$Curr{"Y"} if (! $y);
1324 $y--; # previous year
1325 $tmp=&Date_GetNext("$y-12-31",$dofw,0);
1326 if ($which>1) {
1327 $tmp=&DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0);
1328 }
1329 ($y,$m,$d)=(&Date_Split($tmp, 1))[0..2];
1330 last PARSE;
1331 } elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
1332 /^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
1333 # sunday week 22 in 1996
1334 # sunday 22nd week in 1996
1335 ($dofw,$which,$y)=($1,$2,$3);
1336 ($y,$m,$d)=&Date_NthWeekOfYear($y,$which,$dofw);
1337 last PARSE;
1338 }
1339
1340 # Get rid of day of week
1341 if (/(^|[^a-z])$week($|[^a-z])/i) {
1342 $wk=$2;
1343 (s/(^|[^a-z])$week,/$1 /i) ||
1344 s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
1345 s/^\s+//;
1346 s/\s+$//;
1347 }
1348
1349 {
1350 # So that we can handle negative epoch times, let's convert
1351 # things like "epoch -" to "epochNEGATIVE " before we strip out
1352 # the $sep chars, which include '-'.
1353 s,epoch\s*-,epochNEGATIVE ,g;
1354
1355 # Non-ISO8601 dates
1356 s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces
1357 s,^\s*,,; # remove leading/trailing space
1358 s,\s*$,,;
1359
1360 if (/^$D\s+$D(?:\s+$YY)?$/) {
1361 # MM DD YY (DD MM YY non-US)
1362 ($m,$d,$y)=($1,$2,$3);
1363 ($m,$d)=($d,$m) if ($type ne "US");
1364 last PARSE;
1365
1366 } elsif (/^$D4\s*$D\s*$D$/) {
1367 # YYYY MM DD
1368 ($y,$m,$d)=($1,$2,$3);
1369 last PARSE;
1370
1371 } elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
1372 ($m)=($2);
1373
1374 if (/^\s*$D(?:\s+$YY)?\s*$/) {
1375 # mmm DD YY
1376 # DD mmm YY
1377 # DD YY mmm
1378 ($d,$y)=($1,$2);
1379 last PARSE;
1380
1381 } elsif (/^\s*$D$D4\s*$/) {
1382 # mmm DD YYYY
1383 # DD mmm YYYY
1384 # DD YYYY mmm
1385 ($d,$y)=($1,$2);
1386 last PARSE;
1387
1388 } elsif (/^\s*$D4\s*$D\s*$/) {
1389 # mmm YYYY DD
1390 # YYYY mmm DD
1391 # YYYY DD mmm
1392 ($y,$d)=($1,$2);
1393 last PARSE;
1394
1395 } elsif (/^\s*$D4\s*$/) {
1396 # mmm YYYY
1397 # YYYY mmm
1398 ($y,$d)=($1,1);
1399 last PARSE;
1400
1401 } else {
1402 return "";
1403 }
1404
1405 } elsif (/^epochNEGATIVE (\d+)$/) {
1406 $s=$1;
1407 $date=&DateCalc("1970-01-01 00:00 GMT","-0:0:$s");
1408 } elsif (/^epoch\s*(\d+)$/i) {
1409 $s=$1;
1410 $date=&DateCalc("1970-01-01 00:00 GMT","+0:0:$s");
1411
1412 } elsif ( (/^$now$/i && ($tmp="Now")) ||
1413 (/^$today$/i && ($tmp="Today")) ) {
1414 # now, today
1415 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1416 $date=$Curr{$tmp};
1417 if ($time) {
1418 return ""
1419 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1420 $date=&Date_SetTime($date,$h,$mn,$s);
1421 }
1422 last PARSE;
1423
1424 } elsif (/^$offset$/i) {
1425 # yesterday, tomorrow
1426 ($offset)=($1);
1427 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1428 $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
1429 $date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1430 if ($time) {
1431 return ""
1432 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1433 $date=&Date_SetTime($date,$h,$mn,$s);
1434 }
1435 last PARSE;
1436
1437 } else {
1438 return "";
1439 }
1440 }
1441 }
1442
1443 if (! $date) {
1444 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1445 $date=&Date_Join($y,$m,$d,$h,$mn,$s);
1446 }
1447 $date=&Date_ConvTZ($date,$z);
1448 if ($midnight) {
1449 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0");
1450 }
1451 return $date;
1452}
1453
1454sub ParseDate {
1455 print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
1456 &Date_Init() if (! $Curr{"InitDone"});
1457 my($args,@args,@a,$ref,$date)=();
1458 @a=@_;
1459
1460 # @a : is the list of args to ParseDate. Currently, only one argument
1461 # is allowed and it must be a scalar (or a reference to a scalar)
1462 # or a reference to an array.
1463
1464 if ($#a!=0) {
1465 print "ERROR: Invalid number of arguments to ParseDate.\n";
1466 return "";
1467 }
1468 $args=$a[0];
1469 $ref=ref $args;
1470 if (! $ref) {
1471 return $args if (&Date_Split($args));
1472 @args=($args);
1473 } elsif ($ref eq "ARRAY") {
1474 @args=@$args;
1475 } elsif ($ref eq "SCALAR") {
1476 return $$args if (&Date_Split($$args));
1477 @args=($$args);
1478 } else {
1479 print "ERROR: Invalid arguments to ParseDate.\n";
1480 return "";
1481 }
1482 @a=@args;
1483
1484 # @args : a list containing all the arguments (dereferenced if appropriate)
1485 # @a : a list containing all the arguments currently being examined
1486 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1487 # reference to a scalar, or a reference to an array was passed in
1488 # $args : the scalar or refererence passed in
1489
1490 PARSE: while($#a>=0) {
1491 $date=join(" ",@a);
1492 $date=&ParseDateString($date);
1493 last if ($date);
1494 pop(@a);
1495 } # PARSE
1496
1497 splice(@args,0,$#a + 1);
1498 @$args= @args if (defined $ref and $ref eq "ARRAY");
1499 $date;
1500}
1501
1502sub Date_Cmp {
1503 my($D1,$D2)=@_;
1504 my($date1)=&ParseDateString($D1);
1505 my($date2)=&ParseDateString($D2);
1506 return $date1 cmp $date2;
1507}
1508
1509# **NOTE**
1510# The calc routines all call parse routines, so it is never necessary to
1511# call Date_Init in the calc routines.
1512sub DateCalc {
1513 print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
1514 my($D1,$D2,@arg)=@_;
1515 my($ref,$err,$errref,$mode)=();
1516
1517 ($errref,$mode) = (@arg);
1518 $ref=0;
1519
1520 if (defined $errref) {
1521 if (ref $errref) {
1522 $ref=1;
1523 } elsif (! defined $mode) {
1524 $mode=$errref;
1525 $errref="";
1526 }
1527 }
1528
1529 my(@date,@delta,$ret,$tmp,$oldincalc,$oldmode)=();
1530
1531 if (exists $Curr{"Mode"}) {
1532 $oldmode = $Curr{"Mode"};
1533 } else {
1534 $oldmode = 0;
1535 }
1536
1537 if (defined $mode and $mode>=0 and $mode<=3) {
1538 $Curr{"Mode"}=$mode;
1539 } else {
1540 $Curr{"Mode"}=0;
1541 }
1542
1543 if (exists $Curr{"InCalc"}) {
1544 $oldincalc = $Curr{"InCalc"};
1545 } else {
1546 $oldincalc = 0;
1547 }
1548 $Curr{"InCalc"}=1;
1549
1550 if ($tmp=&ParseDateString($D1)) {
1551 # If we've already parsed the date, we don't want to do it a second
1552 # time (so we don't convert timezones twice).
1553 if (&Date_Split($D1)) {
1554 push(@date,$D1);
1555 } else {
1556 push(@date,$tmp);
1557 }
1558 } elsif ($tmp=&ParseDateDelta($D1)) {
1559 push(@delta,$tmp);
1560 } else {
1561 $$errref=1 if ($ref);
1562 $Curr{"InCalc"} = $oldincalc;
1563 $Curr{"Mode"} = $oldmode;
1564 return;
1565 }
1566
1567 if ($tmp=&ParseDateString($D2)) {
1568 if (&Date_Split($D2)) {
1569 push(@date,$D2);
1570 } else {
1571 push(@date,$tmp);
1572 }
1573 } elsif ($tmp=&ParseDateDelta($D2)) {
1574 push(@delta,$tmp);
1575 $mode = $Curr{"Mode"};
1576 } else {
1577 $$errref=2 if ($ref);
1578 $Curr{"InCalc"} = $oldincalc;
1579 $Curr{"Mode"} = $oldmode;
1580 return;
1581 }
1582
1583 $Curr{"InCalc"} = $oldincalc;
1584 $Curr{"Mode"} = $oldmode;
1585
1586 if ($#date==1) {
1587 $ret=&DateCalc_DateDate(@date,$mode);
1588 } elsif ($#date==0) {
1589 $ret=&DateCalc_DateDelta(@date,@delta,\$err,$mode);
1590 $$errref=$err if ($ref);
1591 } else {
1592 $ret=&DateCalc_DeltaDelta(@delta,$mode);
1593 }
1594 $ret;
1595}
1596
1597sub ParseDateDelta {
1598 print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
1599 my($args,@args,@a,$ref)=();
1600 local($_)=();
1601 @a=@_;
1602
1603 # @a : is the list of args to ParseDateDelta. Currently, only one argument
1604 # is allowed and it must be a scalar (or a reference to a scalar)
1605 # or a reference to an array.
1606
1607 if ($#a!=0) {
1608 print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
1609 return "";
1610 }
1611 $args=$a[0];
1612 $ref=ref $args;
1613 if (! $ref) {
1614 @args=($args);
1615 } elsif ($ref eq "ARRAY") {
1616 @args=@$args;
1617 } elsif ($ref eq "SCALAR") {
1618 @args=($$args);
1619 } else {
1620 print "ERROR: Invalid arguments to ParseDateDelta.\n";
1621 return "";
1622 }
1623 @a=@args;
1624
1625 # @args : a list containing all the arguments (dereferenced if appropriate)
1626 # @a : a list containing all the arguments currently being examined
1627 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1628 # reference to a scalar, or a reference to an array was passed in
1629 # $args : the scalar or refererence passed in
1630
1631 my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=();
1632 my($len,$tmp,$tmp2,$tmpl)=();
1633 my($from,$to)=();
1634 my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1;
1635
1636 &Date_Init() if (! $Curr{"InitDone"});
1637 # A sign can be a sequence of zero or more + and - signs, this
1638 # allows for deltas like '+ -2 days'.
1639 my($signexp)='((?:[+-]\s*)*)';
1640 my($numexp)='(\d+)';
1641 my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)";
1642 my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=();
1643 $yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()";
1644 $yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?";
1645 $mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?";
1646 $wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?";
1647 $dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?";
1648 $hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?";
1649 $mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?";
1650 $sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?";
1651 my($future)=$Lang{$Cnf{"Language"}}{"Future"};
1652 my($later)=$Lang{$Cnf{"Language"}}{"Later"};
1653 my($past)=$Lang{$Cnf{"Language"}}{"Past"};
1654
1655 $delta="";
1656 PARSE: while (@a) {
1657 $_ = join(" ", grep {defined;} @a);
1658 s/\s+$//;
1659 last if ($_ eq "");
1660
1661 # Mode is set in DateCalc. ParseDateDelta only overrides it if the
1662 # string contains a mode.
1663 if ($Lang{$Cnf{"Language"}}{"Exact"} &&
1664 s/$Lang{$Cnf{"Language"}}{"Exact"}//) {
1665 $Curr{"Mode"}=0;
1666 } elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
1667 s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
1668 $Curr{"Mode"}=1;
1669 } elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
1670 s/$Lang{$Cnf{"Language"}}{"Business"}//) {
1671 $Curr{"Mode"}=2;
1672 } elsif (! exists $Curr{"Mode"}) {
1673 $Curr{"Mode"}=0;
1674 }
1675 $workweek=7 if ($Curr{"Mode"} != 2);
1676
1677 foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) {
1678 $to=$Lang{$Cnf{"Language"}}{"Repl"}{$from};
1679 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
1680 }
1681
1682 # in or ago
1683 #
1684 # We need to make sure that $later, $future, and $past don't contain each
1685 # other... Romanian pointed this out where $past is "in urma" and $future
1686 # is "in". When they do, we have to take this into account.
1687 # $len length of best match (greatest wins)
1688 # $tmp string after best match
1689 # $dir direction (prior, after) of best match
1690 #
1691 # $tmp2 string before/after current match
1692 # $tmpl length of current match
1693
1694 $len=0;
1695 $tmp=$_;
1696 $dir=1;
1697
1698 $tmp2=$_;
1699 if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
1700 $tmpl=length($2);
1701 if ($tmpl>$len) {
1702 $tmp=$tmp2;
1703 $dir=1;
1704 $len=$tmpl;
1705 }
1706 }
1707
1708 $tmp2=$_;
1709 if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
1710 $tmpl=length($2);
1711 if ($tmpl>$len) {
1712 $tmp=$tmp2;
1713 $dir=1;
1714 $len=$tmpl;
1715 }
1716 }
1717
1718 $tmp2=$_;
1719 if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
1720 $tmpl=length($2);
1721 if ($tmpl>$len) {
1722 $tmp=$tmp2;
1723 $dir=-1;
1724 $len=$tmpl;
1725 }
1726 }
1727
1728 $_ = $tmp;
1729 s/\s*$//;
1730
1731 # the colon part of the delta
1732 $colon="";
1733 if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
1734 $colon=$1;
1735 s/\s+$//;
1736 }
1737 @colon=split(/:/,$colon);
1738
1739 # the non-colon part of the delta
1740 $sign="+";
1741 @delta=();
1742 $i=6;
1743 foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
1744 last if ($#colon>=$i--);
1745 $val=0;
1746 if (s/^$exp1//ix) {
1747 $val=$2 if ($2);
1748 $sign=$1 if ($1);
1749 }
1750
1751 # Collapse a sign like '+ -' into a single character like '-',
1752 # by counting the occurrences of '-'.
1753 #
1754 $sign =~ s/\s+//g;
1755 $sign =~ tr/+//d;
1756 my $count = ($sign =~ tr/-//d);
1757 die "bad characters in sign: $sign" if length $sign;
1758 $sign = $count % 2 ? '-' : '+';
1759
1760 push(@delta,"$sign$val");
1761 }
1762 if (! /^\s*$/) {
1763 pop(@a);
1764 next PARSE;
1765 }
1766
1767 # make sure that the colon part has a sign
1768 for ($i=0; $i<=$#colon; $i++) {
1769 $val=0;
1770 if ($colon[$i] =~ /^$signexp$numexp?/) {
1771 $val=$2 if ($2);
1772 $sign=$1 if ($1);
1773 }
1774 $colon[$i] = "$sign$val";
1775 }
1776
1777 # combine the two
1778 push(@delta,@colon);
1779 if ($dir<0) {
1780 for ($i=0; $i<=$#delta; $i++) {
1781 $delta[$i] =~ tr/-+/+-/;
1782 }
1783 }
1784
1785 # form the delta and shift off the valid part
1786 $delta=join(":",@delta);
1787 splice(@args,0,$#a+1);
1788 @$args=@args if (defined $ref and $ref eq "ARRAY");
1789 last PARSE;
1790 }
1791
1792 $delta=&Delta_Normalize($delta,$Curr{"Mode"});
1793 return $delta;
1794}
1795
1796sub UnixDate {
1797 print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
1798 my($date,@format)=@_;
1799 local($_)=();
1800 my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
1801 my($scalar)=();
1802 $date=&ParseDateString($date);
1803 return if (! $date);
1804
1805 my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
1806 &Date_Split($date, 1);
1807 $f{"y"}=substr $f{"Y"},2;
1808 &Date_Init() if (! $Curr{"InitDone"});
1809
1810 if (! wantarray) {
1811 $format=join(" ",@format);
1812 @format=($format);
1813 $scalar=1;
1814 }
1815
1816 # month, week
1817 $_=$m;
1818 s/^0//;
1819 $f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
1820 $f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
1821 $_=$m;
1822 s/^0/ /;
1823 $f{"f"}=$_;
1824 $f{"U"}=&Date_WeekOfYear($m,$d,$y,7);
1825 $f{"W"}=&Date_WeekOfYear($m,$d,$y,1);
1826
1827 # check week 52,53 and 0
1828 $f{"G"}=$f{"L"}=$y;
1829 if ($f{"W"}>=52 || $f{"U"}>=52) {
1830 my($dd,$mm,$yy)=($d,$m,$y);
1831 $dd+=7;
1832 if ($dd>31) {
1833 $dd-=31;
1834 $mm=1;
1835 $yy++;
1836 if (&Date_WeekOfYear($mm,$dd,$yy,1)==2) {
1837 $f{"G"}=$yy;
1838 $f{"W"}=1;
1839 }
1840 if (&Date_WeekOfYear($mm,$dd,$yy,7)==2) {
1841 $f{"L"}=$yy;
1842 $f{"U"}=1;
1843 }
1844 }
1845 }
1846 if ($f{"W"}==0) {
1847 my($dd,$mm,$yy)=($d,$m,$y);
1848 $dd-=7;
1849 $dd+=31 if ($dd<1);
1850 $yy = sprintf "%04d", $yy-1;
1851 $mm=12;
1852 $f{"G"}=$yy;
1853 $f{"W"}=&Date_WeekOfYear($mm,$dd,$yy,1)+1;
1854 }
1855 if ($f{"U"}==0) {
1856 my($dd,$mm,$yy)=($d,$m,$y);
1857 $dd-=7;
1858 $dd+=31 if ($dd<1);
1859 $yy = sprintf "%04d", $yy-1;
1860 $mm=12;
1861 $f{"L"}=$yy;
1862 $f{"U"}=&Date_WeekOfYear($mm,$dd,$yy,7)+1;
1863 }
1864
1865 $f{"U"}="0".$f{"U"} if (length $f{"U"} < 2);
1866 $f{"W"}="0".$f{"W"} if (length $f{"W"} < 2);
1867
1868 # day
1869 $f{"j"}=&Date_DayOfYear($m,$d,$y);
1870 $f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
1871 $_=$d;
1872 s/^0/ /;
1873 $f{"e"}=$_;
1874 $f{"w"}=&Date_DayOfWeek($m,$d,$y);
1875 $f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1];
1876 $f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2);
1877 $f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1];
1878 $f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1];
1879 $f{"E"}=&Date_DaySuffix($f{"e"});
1880
1881 # hour
1882 $_=$h;
1883 s/^0/ /;
1884 $f{"k"}=$_;
1885 $f{"i"}=$f{"k"}+1;
1886 $f{"i"}=$f{"k"};
1887 $f{"i"}=12 if ($f{"k"}==0);
1888 $f{"i"}=$f{"k"}-12 if ($f{"k"}>12);
1889 $f{"i"}=$f{"i"}-12 if ($f{"i"}>12);
1890 $f{"i"}=" ".$f{"i"} if (length($f{"i"})<2);
1891 $f{"I"}=$f{"i"};
1892 $f{"I"}=~ s/^ /0/;
1893 $f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"};
1894 $f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11);
1895
1896 # minute, second, timezone
1897 $f{"o"}=&Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
1898 $f{"s"}=&Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s);
1899 $f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ?
1900 $Cnf{"TZ"} : $Cnf{"ConvTZ"};
1901 $f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || "");
1902
1903 # date, time
1904 $f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
1905 $f{"C"}=$f{"u"}=
1906 qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|;
1907 $f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|;
1908 $f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|;
1909 $f{"x"}=qq|$d/$m/$f{"y"}| if ($Cnf{"DateFormat"} ne "US");
1910 $f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|;
1911 $f{"R"}=qq|$h:$mn|;
1912 $f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
1913 $f{"V"}=qq|$m$d$h$mn$f{"y"}|;
1914 $f{"Q"}="$y$m$d";
1915 $f{"q"}=qq|$y$m$d$h$mn$s|;
1916 $f{"P"}=qq|$y$m$d$h:$mn:$s|;
1917 $f{"O"}=qq|$y-$m-${d}T$h:$mn:$s|;
1918 $f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|;
1919 if ($f{"W"}==0) {
1920 $y--;
1921 $tmp=&Date_WeekOfYear(12,31,$y,1);
1922 $tmp="0$tmp" if (length($tmp) < 2);
1923 $f{"J"}=qq|$y-W$tmp-$f{"w"}|;
1924 } else {
1925 $f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|;
1926 }
1927 $f{"K"}=qq|$y-$f{"j"}|;
1928 # %l is a special case. Since it requires the use of the calculator
1929 # which requires this routine, an infinite recursion results. To get
1930 # around this, %l is NOT determined every time this is called so the
1931 # recursion breaks.
1932
1933 # other formats
1934 $f{"n"}="\n";
1935 $f{"t"}="\t";
1936 $f{"%"}="%";
1937 $f{"+"}="+";
1938
1939 foreach $format (@format) {
1940 $format=reverse($format);
1941 $out="";
1942 while ($format ne "") {
1943 $c=chop($format);
1944 if ($c eq "%") {
1945 $c=chop($format);
1946 if ($c eq "l") {
1947 &Date_Init();
1948 $date1=&DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0");
1949 $date2=&DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0");
1950 if (&Date_Cmp($date,$date1)>=0 && &Date_Cmp($date,$date2)<=0) {
1951 $f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|;
1952 } else {
1953 $f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
1954 }
1955 $out .= $f{"$c"};
1956 } elsif (exists $f{"$c"}) {
1957 $out .= $f{"$c"};
1958 } else {
1959 $out .= $c;
1960 }
1961 } else {
1962 $out .= $c;
1963 }
1964 }
1965 push(@out,$out);
1966 }
1967 if ($scalar) {
1968 return $out[0];
1969 } else {
1970 return (@out);
1971 }
1972}
1973
1974# Can't be in "use integer" because we're doing decimal arithmatic
1975no integer;
1976sub Delta_Format {
1977 print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
1978 my($delta,@arg)=@_;
1979 my($mode);
1980 if (lc($arg[0]) eq "approx") {
1981 $mode = "approx";
1982 shift(@arg);
1983 } else {
1984 $mode = "exact";
1985 }
1986 my($dec,@format) = @arg;
1987
1988 $delta=&ParseDateDelta($delta);
1989 return "" if (! $delta);
1990 my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
1991 local($_)=$delta;
1992 my($y,$M,$w,$d,$h,$m,$s)=&Delta_Split($delta);
1993 # Get rid of positive signs.
1994 ($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s);
1995
1996 if (defined $dec && $dec>0) {
1997 $dec="%." . ($dec*1) . "f";
1998 } else {
1999 $dec="%f";
2000 }
2001
2002 if (! wantarray) {
2003 $format=join(" ",@format);
2004 @format=($format);
2005 $scalar=1;
2006 }
2007
2008 # Length of each unit in seconds
2009 my($sl,$ml,$hl,$dl,$wl,$Ml,$yl)=();
2010 $sl = 1;
2011 $ml = $sl*60;
2012 $hl = $ml*60;
2013 $dl = $hl*24;
2014 $wl = $dl*7;
2015 $yl = $dl*365.25;
2016 $Ml = $yl/12;
2017
2018 # The decimal amount of each unit contained in all smaller units
2019 my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
2020 if ($mode eq "exact") {
2021 $yd = $M/12;
2022 $Md = 0;
2023 } else {
2024 $yd = ($M*$Ml + $w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
2025 $Md = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$Ml;
2026 }
2027
2028 $wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
2029 $dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
2030 $hd = ($m*$ml + $s*$sl)/$hl;
2031 $md = ($s*$sl)/$ml;
2032 $sd = 0;
2033
2034 # The amount of each unit contained in higher units.
2035 my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
2036 $yh = 0;
2037 $Mh = ($yh+$y)*12;
2038
2039 if ($mode eq "exact") {
2040 $wh = 0;
2041 $dh = ($wh+$w)*7;
2042 } else {
2043 $wh = ($yh+$y+$M/12)*365.25/7;
2044 $dh = ($wh+$w)*7;
2045 }
2046
2047 $hh = ($dh+$d)*24;
2048 $mh = ($hh+$h)*60;
2049 $sh = ($mh+$m)*60;
2050
2051 # Set up the formats
2052
2053 $f{"yv"} = $y;
2054 $f{"Mv"} = $M;
2055 $f{"wv"} = $w;
2056 $f{"dv"} = $d;
2057 $f{"hv"} = $h;
2058 $f{"mv"} = $m;
2059 $f{"sv"} = $s;
2060
2061 $f{"yh"} = $y+$yh;
2062 $f{"Mh"} = $M+$Mh;
2063 $f{"wh"} = $w+$wh;
2064 $f{"dh"} = $d+$dh;
2065 $f{"hh"} = $h+$hh;
2066 $f{"mh"} = $m+$mh;
2067 $f{"sh"} = $s+$sh;
2068
2069 $f{"yd"} = sprintf($dec,$y+$yd);
2070 $f{"Md"} = sprintf($dec,$M+$Md);
2071 $f{"wd"} = sprintf($dec,$w+$wd);
2072 $f{"dd"} = sprintf($dec,$d+$dd);
2073 $f{"hd"} = sprintf($dec,$h+$hd);
2074 $f{"md"} = sprintf($dec,$m+$md);
2075 $f{"sd"} = sprintf($dec,$s+$sd);
2076
2077 $f{"yt"} = sprintf($dec,$yh+$y+$yd);
2078 $f{"Mt"} = sprintf($dec,$Mh+$M+$Md);
2079 $f{"wt"} = sprintf($dec,$wh+$w+$wd);
2080 $f{"dt"} = sprintf($dec,$dh+$d+$dd);
2081 $f{"ht"} = sprintf($dec,$hh+$h+$hd);
2082 $f{"mt"} = sprintf($dec,$mh+$m+$md);
2083 $f{"st"} = sprintf($dec,$sh+$s+$sd);
2084
2085 $f{"%"} = "%";
2086
2087 foreach $format (@format) {
2088 $format=reverse($format);
2089 $out="";
2090 PARSE: while ($format) {
2091 $c1=chop($format);
2092 if ($c1 eq "%") {
2093 $c1=chop($format);
2094 if (exists($f{$c1})) {
2095 $out .= $f{$c1};
2096 next PARSE;
2097 }
2098 $c2=chop($format);
2099 if (exists($f{"$c1$c2"})) {
2100 $out .= $f{"$c1$c2"};
2101 next PARSE;
2102 }
2103 $out .= $c1;
2104 $format .= $c2;
2105 } else {
2106 $out .= $c1;
2107 }
2108 }
2109 push(@out,$out);
2110 }
2111 if ($scalar) {
2112 return $out[0];
2113 } else {
2114 return (@out);
2115 }
2116}
2117use integer;
2118
2119sub ParseRecur {
2120 print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
2121 &Date_Init() if (! $Curr{"InitDone"});
2122
2123 my($recur,$dateb,$date0,$date1,$flag)=@_;
2124 local($_)=$recur;
2125
2126 my($recur_0,$recur_1,@recur0,@recur1)=();
2127 my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=();
2128 my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=();
2129
2130 # $date0, $date1, $dateb, $flag : passed in (these are always the final say
2131 # in determining whether a date matches a
2132 # recurrence IF they are present.
2133 # $date_b, $date_0, $date_1 : if a value can be determined from the
2134 # $flag_t recurrence, they are stored here.
2135 #
2136 # If values can be determined from the recurrence AND are passed in, the
2137 # following are used:
2138 # max($date0,$date_0) i.e. the later of the two dates
2139 # min($date1,$date_1) i.e. the earlier of the two dates
2140 #
2141 # The base date that is used is the first one defined from
2142 # $dateb $date_b
2143 # The base date is only used if necessary (as determined by the recur).
2144 # For example, "every other friday" requires a base date, but "2nd
2145 # friday of every month" doesn't.
2146
2147 my($date_b,$date_0,$date_1,$flag_t);
2148
2149 #
2150 # Check the arguments passed in.
2151 #
2152
2153 $date0="" if (! defined $date0);
2154 $date1="" if (! defined $date1);
2155 $dateb="" if (! defined $dateb);
2156 $flag ="" if (! defined $flag);
2157
2158 if ($dateb) {
2159 $dateb=&ParseDateString($dateb);
2160 return "" if (! $dateb);
2161 }
2162 if ($date0) {
2163 $date0=&ParseDateString($date0);
2164 return "" if (! $date0);
2165 }
2166 if ($date1) {
2167 $date1=&ParseDateString($date1);
2168 return "" if (! $date1);
2169 }
2170
2171 #
2172 # Parse the recur. $date_b, $date_0, and $date_e are values obtained
2173 # from the recur.
2174 #
2175
2176 @tmp=&Recur_Split($_);
2177
2178 if (@tmp) {
2179 ($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp;
2180 $recur_0 = "" if (! defined $recur_0);
2181 $recur_1 = "" if (! defined $recur_1);
2182 $flag_t = "" if (! defined $flag_t);
2183 $date_b = "" if (! defined $date_b);
2184 $date_0 = "" if (! defined $date_0);
2185 $date_1 = "" if (! defined $date_1);
2186
2187 @recur0 = split(/:/,$recur_0);
2188 @recur1 = split(/:/,$recur_1);
2189 return "" if ($#recur0 + $#recur1 + 2 != 7);
2190
2191 if ($date_b) {
2192 $date_b=&ParseDateString($date_b);
2193 return "" if (! $date_b);
2194 }
2195 if ($date_0) {
2196 $date_0=&ParseDateString($date_0);
2197 return "" if (! $date_0);
2198 }
2199 if ($date_1) {
2200 $date_1=&ParseDateString($date_1);
2201 return "" if (! $date_1);
2202 }
2203
2204 } else {
2205
2206 my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...)
2207 my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... }
2208 my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...)
2209 my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... }
2210 my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days)
2211 my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months)
2212 my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks)
2213 my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st)
2214 my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} };
2215 # { 1st=>1,first=>1,...}
2216 my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of)
2217 my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last)
2218 my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every)
2219
2220 my($D)='\s*(\d+)';
2221 my($Y)='\s*(\d{4}|\d{2})';
2222
2223 # Change 1st to 1
2224 if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
2225 $tmp=lc($2);
2226 $tmp=$dayshash{"$tmp"};
2227 s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
2228 }
2229 s/\s*$//;
2230
2231 # Get rid of "each"
2232 if (/(^|[^a-z])$each($|[^a-z])/i) {
2233 s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
2234 $each=1;
2235 } else {
2236 $each=0;
2237 }
2238
2239 if ($each) {
2240
2241 if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
2242 /^$D?$day(?:$of$mmm())?$/i) {
2243 # every [2nd] day in [june] 1997
2244 # every [2nd] day [in june]
2245 ($num,$m,$y)=($1,$2,$3);
2246 $num=1 if (! defined $num);
2247 $m="" if (! defined $m);
2248 $y="" if (! defined $y);
2249
2250 $y=$Curr{"Y"} if (! $y);
2251 if ($m) {
2252 $m=$mmm{lc($m)};
2253 $date_0=&Date_Join($y,$m,1,0,0,0);
2254 $date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
2255 } else {
2256 $date_0=&Date_Join($y, 1,1,0,0,0);
2257 $date_1=&Date_Join($y+1,1,1,0,0,0);
2258 }
2259 $date_b=&DateCalc($date_0,"-0:0:0:1:0:0:0",0);
2260 @recur0=(0,0,0,$num,0,0,0);
2261 @recur1=();
2262
2263 } elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
2264 # 2nd [day] of every month [in 1997]
2265 ($num,$y)=($1,$2);
2266 $y=$Curr{"Y"} if (! $y);
2267
2268 $date_0=&Date_Join($y, 1,1,0,0,0);
2269 $date_1=&Date_Join($y+1,1,1,0,0,0);
2270 $date_b=$date_0;
2271
2272 @recur0=(0,1,0);
2273 @recur1=($num,0,0,0);
2274
2275 } elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ ||
2276 /^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) {
2277 # 2nd tuesday of every month [in 1997]
2278 # last tuesday of every month [in 1997]
2279 ($num,$d,$y)=($1,$2,$3);
2280 $y=$Curr{"Y"} if (! $y);
2281 $d=$week{lc($d)};
2282 $num=-1 if ($num !~ /^$D$/);
2283
2284 $date_0=&Date_Join($y,1,1,0,0,0);
2285 $date_1=&Date_Join($y+1,1,1,0,0,0);
2286 $date_b=$date_0;
2287
2288 @recur0=(0,1);
2289 @recur1=($num,$d,0,0,0);
2290
2291 } elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i ||
2292 /^$D?$wkexp(?:$of$mmm())?$/i) {
2293 # every tuesday in june 1997
2294 # every 2nd tuesday in june 1997
2295 ($num,$d,$m,$y)=($1,$2,$3,$4);
2296 $y=$Curr{"Y"} if (! $y);
2297 $num=1 if (! defined $num);
2298 $m="" if (! defined $m);
2299 $d=$week{lc($d)};
2300
2301 if ($m) {
2302 $m=$mmm{lc($m)};
2303 $date_0=&Date_Join($y,$m,1,0,0,0);
2304 $date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
2305 } else {
2306 $date_0=&Date_Join($y,1,1,0,0,0);
2307 $date_1=&Date_Join($y+1,1,1,0,0,0);
2308 }
2309 $date_b=&DateCalc($date_0,"-0:0:0:1:0:0:0",0);
2310
2311 @recur0=(0,0,$num);
2312 @recur1=($d,0,0,0);
2313
2314 } else {
2315 return "";
2316 }
2317
2318 $date_0="" if ($date0);
2319 $date_1="" if ($date1);
2320 } else {
2321 return "";
2322 }
2323 }
2324
2325 #
2326 # Override with any values passed in
2327 #
2328
2329 $date0 = $date_0 if (! $date0);
2330 $date1 = $date_1 if (! $date1);
2331 $dateb = $date_b if (! $dateb);
2332 if ($flag =~ s/^\+//) {
2333 $flag = "$flag_t,$flag" if ($flag_t);
2334 }
2335 $flag = $flag_t if (! $flag);
2336 $flag = "" if (! $flag);
2337
2338 if (! wantarray) {
2339 $tmp = join(":",@recur0);
2340 $tmp .= "*" . join(":",@recur1) if (@recur1);
2341 $tmp .= "*$flag*$dateb*$date0*$date1";
2342 return $tmp;
2343 }
2344 if (@recur0) {
2345 return () if (! $date0 || ! $date1); # dateb is NOT required in all case
2346 }
2347
2348 #
2349 # Some flags affect parsing.
2350 #
2351
2352 @flags = split(/,/,$flag);
2353 my($f);
2354 foreach $f (@flags) {
2355 if ($f =~ /^EASTER$/i) {
2356 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2357 # We want something that will return Jan 1 for the given years.
2358 if ($#recur0==-1) {
2359 @recur1=($y,1,0,1,$h,$mn,$s);
2360 } elsif ($#recur0<=3) {
2361 @recur0=($y,0,0,0);
2362 @recur1=($h,$mn,$s);
2363 } elsif ($#recur0==4) {
2364 @recur0=($y,0,0,0,0);
2365 @recur1=($mn,$s);
2366 } elsif ($#recur0==5) {
2367 @recur0=($y,0,0,0,0,0);
2368 @recur1=($s);
2369 } else {
2370 @recur0=($y,0,0,0,0,0,0);
2371 }
2372 }
2373 }
2374
2375 #
2376 # Determine the dates referenced by the recur. Also, fix the base date
2377 # as necessary for the recurrences which require it.
2378 #
2379
2380 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2381 @y=@m=@w=@d=();
2382 my(@time)=($h,$mn,$s);
2383
2384 RECUR: while (1) {
2385
2386 if ($#recur0==-1) {
2387 # * 0-M-W-D-H-MN-S => 0 * M-W-D-H-MN-S
2388
2389 if ($y eq "0") {
2390 push(@recur0,1);
2391 shift(@recur1);
2392 next RECUR;
2393 }
2394
2395 # Y-M-W-D-H-MN-S
2396
2397 @y=&ReturnList($y);
2398 foreach $y (@y) {
2399 $y=&Date_FixYear($y) if (length($y)==2);
2400 return () if (length($y)!=4 || ! &IsInt($y));
2401 }
2402
2403 $date0=&ParseDate("0000-01-01") if (! $date0);
2404 $date1=&ParseDate("9999-12-31 23:59:59") if (! $date1);
2405
2406 if ($m eq "0" and $w eq "0") {
2407
2408 # * Y-0-0-0-H-MN-S
2409 # * Y-0-0-DOY-H-MN-S
2410
2411 if ($d eq "0") {
2412 @d=(1);
2413 } else {
2414 @d=&ReturnList($d);
2415 return () if (! @d);
2416 foreach $d (@d) {
2417 return () if (! &IsInt($d,-366,366) || $d==0);
2418 }
2419 }
2420
2421 @date=();
2422 foreach $yy (@y) {
2423 my $diy = &Date_DaysInYear($yy);
2424 foreach $d (@d) {
2425 my $tmpd = $d;
2426 $tmpd += ($diy+1) if ($tmpd < 0);
2427 next if (! &IsInt($tmpd,1,$diy));
2428 ($y,$m,$dd)=&Date_NthDayOfYear($yy,$tmpd);
2429 push(@date, &Date_Join($y,$m,$dd,0,0,0));
2430 }
2431 }
2432 last RECUR;
2433
2434 } elsif ($w eq "0") {
2435
2436 # * Y-M-0-0-H-MN-S
2437 # * Y-M-0-DOM-H-MN-S
2438
2439 @m=&ReturnList($m);
2440 return () if (! @m);
2441 foreach $m (@m) {
2442 return () if (! &IsInt($m,1,12));
2443 }
2444
2445 if ($d eq "0") {
2446 @d=(1);
2447 } else {
2448 @d=&ReturnList($d);
2449 return () if (! @d);
2450 foreach $d (@d) {
2451 return () if (! &IsInt($d,-31,31) || $d==0);
2452 }
2453 }
2454
2455 @date=();
2456 foreach $y (@y) {
2457 foreach $m (@m) {
2458 my $dim = &Date_DaysInMonth($m,$y);
2459 foreach $d (@d) {
2460 my $tmpd = $d;
2461 $tmpd += ($dim+1) if ($d<0);
2462 next if (! &IsInt($tmpd,1,$dim));
2463 $date=&Date_Join($y,$m,$tmpd,0,0,0);
2464 push(@date,$date);
2465 }
2466 }
2467 }
2468 last RECUR;
2469
2470 } elsif ($m eq "0") {
2471
2472 # * Y-0-WOY-DOW-H-MN-S
2473 # * Y-0-WOY-0-H-MN-S
2474
2475 @w=&ReturnList($w);
2476 return () if (! @w);
2477 foreach $w (@w) {
2478 return () if (! &IsInt($w,-53,53) || $w==0);
2479 }
2480
2481 if ($d eq "0") {
2482 @d=(1);
2483 } else {
2484 @d=&ReturnList($d);
2485 return () if (! @d);
2486 foreach $d (@d) {
2487 $d += 8 if ($d<0);
2488 return () if (! &IsInt($d,1,7));
2489 }
2490 }
2491
2492 @date=();
2493 foreach $y (@y) {
2494 foreach $w (@w) {
2495 foreach $d (@d) {
2496 my($tmpw,$del);
2497 if ($w<0) {
2498 $date="$y-12-31-00:00:00";
2499 $tmpw = (-$w)-1;
2500 $del="-0:0:$tmpw:0:0:0:0";
2501 $date=Date_GetPrev($date,$d,1);
2502 } else {
2503 $date="$y-01-01-00:00:00";
2504 $tmpw = ($w)-1;
2505 $del="0:0:$tmpw:0:0:0:0";
2506 $date=Date_GetNext($date,$d,1);
2507 }
2508 $date=&DateCalc_DateDelta($date,$del);
2509 push(@date,$date) if ( (&Date_Split($date))[0] == $y);
2510 }
2511 }
2512 }
2513 last RECUR;
2514
2515 } else {
2516
2517 # * Y-M-WOM-DOW-H-MN-S
2518 # * Y-M-WOM-0-H-MN-S
2519
2520 @m=&ReturnList($m);
2521 return () if (! @m);
2522 @w=&ReturnList($w);
2523 return () if (! @w);
2524 if ($d eq "0") {
2525 @d=(1);
2526 } else {
2527 @d=&ReturnList($d);
2528 }
2529
2530 @date=&Date_Recur_WoM(\@y,\@m,\@w,\@d);
2531 last RECUR;
2532 }
2533 }
2534
2535 if ($#recur0==0) {
2536
2537 # Y * M-W-D-H-MN-S
2538 $n=$y;
2539 $n=1 if ($n==0);
2540
2541 if ($m eq "0") {
2542
2543 # Y * 0-W-D-H-MN-S => Y-0 * W-D-H-MN-S
2544 push(@recur0,0);
2545 shift(@recur1);
2546
2547 } elsif ($w eq "0") {
2548
2549 # Y * M-0-DOM-H-MN-S
2550 return () if (! $dateb && $y != 1);
2551
2552 @m=&ReturnList($m);
2553 return () if (! @m);
2554 foreach $m (@m) {
2555 return () if (! &IsInt($m,1,12));
2556 }
2557
2558 if ($d eq "0") {
2559 @d = (1);
2560 } else {
2561 @d=&ReturnList($d);
2562 return () if (! @d);
2563 foreach $d (@d) {
2564 return () if (! &IsInt($d,-31,31) || $d==0);
2565 }
2566 }
2567
2568 # We need to find years that are a multiple of $n from $y(base)
2569 ($y0)=( &Date_Split($date0, 1) )[0];
2570 ($y1)=( &Date_Split($date1, 1) )[0];
2571 if ($dateb) {
2572 ($yb)=( &Date_Split($dateb, 1) )[0];
2573 } else {
2574 # If $y=1, there is no base year
2575 $yb=0;
2576 }
2577
2578 @date=();
2579 for ($yy=$y0; $yy<=$y1; $yy++) {
2580 if (($yy-$yb)%$n == 0) {
2581 foreach $m (@m) {
2582 foreach $d (@d) {
2583 my $dim = &Date_DaysInMonth($m,$yy);
2584 my $tmpd = $d;
2585 if ($tmpd < 0) {
2586 $tmpd += ($dim+1);
2587 }
2588 next if (! &IsInt($tmpd,1,$dim));
2589 $date=&Date_Join($yy,$m,$tmpd,0,0,0);
2590 push(@date,$date);
2591 }
2592 }
2593 }
2594 }
2595 last RECUR;
2596
2597 } else {
2598
2599 # Y * M-WOM-DOW-H-MN-S
2600 # Y * M-WOM-0-H-MN-S
2601 return () if (! $dateb && $y != 1);
2602
2603 @m=&ReturnList($m);
2604 return () if (! @m);
2605 @w=&ReturnList($w);
2606 return () if (! @w);
2607
2608 if ($d eq "0") {
2609 @d=(1);
2610 } else {
2611 @d=&ReturnList($d);
2612 }
2613
2614 ($y0)=( &Date_Split($date0, 1) )[0];
2615 ($y1)=( &Date_Split($date1, 1) )[0];
2616 if ($dateb) {
2617 ($yb)=( &Date_Split($dateb, 1) )[0];
2618 } else {
2619 # If $y=1, there is no base year
2620 $yb=0;
2621 }
2622 @y=();
2623 for ($yy=$y0; $yy<=$y1; $yy++) {
2624 if (($yy-$yb)%$n == 0) {
2625 push(@y,$yy);
2626 }
2627 }
2628
2629 @date=&Date_Recur_WoM(\@y,\@m,\@w,\@d);
2630 last RECUR;
2631 }
2632 }
2633
2634 if ($#recur0==1) {
2635
2636 # Y-M * W-D-H-MN-S
2637
2638 if ($w eq "0") {
2639 # Y-M * 0-D-H-MN-S => Y-M-0 * D-H-MN-S
2640 push(@recur0,0);
2641 shift(@recur1);
2642
2643 } elsif ($m==0) {
2644
2645 # Y-0 * WOY-0-H-MN-S
2646 # Y-0 * WOY-DOW-H-MN-S
2647 return () if (! $dateb && $y != 1);
2648 $n=$y;
2649 $n=1 if ($n==0);
2650
2651 @w=&ReturnList($w);
2652 return () if (! @w);
2653 foreach $w (@w) {
2654 return () if ($w==0 || ! &IsInt($w,-53,53));
2655 }
2656
2657 if ($d eq "0") {
2658 @d=(1);
2659 } else {
2660 @d=&ReturnList($d);
2661 return () if (! @d);
2662 foreach $d (@d) {
2663 $d += 8 if ($d<0);
2664 return () if (! &IsInt($d,1,7));
2665 }
2666 }
2667
2668 # We need to find years that are a multiple of $n from $y(base)
2669 ($y0)=( &Date_Split($date0, 1) )[0];
2670 ($y1)=( &Date_Split($date1, 1) )[0];
2671 if ($dateb) {
2672 ($yb)=( &Date_Split($dateb, 1) )[0];
2673 } else {
2674 # If $y=1, there is no base year
2675 $yb=0;
2676 }
2677
2678 @date=();
2679 for ($yy=$y0; $yy<=$y1; $yy++) {
2680 if (($yy-$yb)%$n == 0) {
2681 foreach $w (@w) {
2682 foreach $d (@d) {
2683 my($tmpw,$del);
2684 if ($w<0) {
2685 $date="$yy-12-31-00:00:00";
2686 $tmpw = (-$w)-1;
2687 $del="-0:0:$tmpw:0:0:0:0";
2688 $date=Date_GetPrev($date,$d,1);
2689 } else {
2690 $date="$yy-01-01-00:00:00";
2691 $tmpw = ($w)-1;
2692 $del="0:0:$tmpw:0:0:0:0";
2693 $date=Date_GetNext($date,$d,1);
2694 }
2695 $date=&DateCalc($date,$del);
2696 next if ((&Date_Split($date))[0] != $yy);
2697 push(@date,$date);
2698 }
2699 }
2700 }
2701 }
2702 last RECUR;
2703
2704 } else {
2705
2706 # Y-M * WOM-0-H-MN-S
2707 # Y-M * WOM-DOW-H-MN-S
2708 return () if (! $dateb);
2709 @tmp=(@recur0);
2710 push(@tmp,0) while ($#tmp<6);
2711 $delta=join(":",@tmp);
2712 @tmp=&Date_Recur($date0,$date1,$dateb,$delta);
2713
2714 @w=&ReturnList($w);
2715 @m=();
2716 if ($d eq "0") {
2717 @d=(1);
2718 } else {
2719 @d=&ReturnList($d);
2720 }
2721
2722 @date=&Date_Recur_WoM(\@tmp,\@m,\@w,\@d);
2723 last RECUR;
2724 }
2725 }
2726
2727 if ($#recur0==2) {
2728 # Y-M-W * D-H-MN-S
2729
2730 if ($d eq "0") {
2731
2732 # Y-M-W * 0-H-MN-S
2733 return () if (! $dateb);
2734 $y=1 if ($y==0 && $m==0 && $w==0);
2735 $delta="$y:$m:$w:0:0:0:0";
2736 @date=&Date_Recur($date0,$date1,$dateb,$delta);
2737 last RECUR;
2738
2739 } elsif ($m==0 && $w==0) {
2740
2741 # Y-0-0 * DOY-H-MN-S
2742 $y=1 if ($y==0);
2743 $n=$y;
2744 return () if (! $dateb && $y!=1);
2745
2746 @d=&ReturnList($d);
2747 return () if (! @d);
2748 foreach $d (@d) {
2749 return () if (! &IsInt($d,-366,366) || $d==0);
2750 }
2751
2752 # We need to find years that are a multiple of $n from $y(base)
2753 ($y0)=( &Date_Split($date0, 1) )[0];
2754 ($y1)=( &Date_Split($date1, 1) )[0];
2755 if ($dateb) {
2756 ($yb)=( &Date_Split($dateb, 1) )[0];
2757 } else {
2758 # If $y=1, there is no base year
2759 $yb=0;
2760 }
2761 @date=();
2762 for ($yy=$y0; $yy<=$y1; $yy++) {
2763 my $diy = &Date_DaysInYear($yy);
2764 if (($yy-$yb)%$n == 0) {
2765 foreach $d (@d) {
2766 my $tmpd = $d;
2767 $tmpd += ($diy+1) if ($tmpd<0);
2768 next if (! &IsInt($tmpd,1,$diy));
2769 ($y,$m,$dd)=&Date_NthDayOfYear($yy,$tmpd);
2770 push(@date, &Date_Join($y,$m,$dd,0,0,0));
2771 }
2772 }
2773 }
2774 last RECUR;
2775
2776 } elsif ($w>0) {
2777
2778 # Y-M-W * DOW-H-MN-S
2779 return () if (! $dateb);
2780 @tmp=(@recur0);
2781 push(@tmp,0) while ($#tmp<6);
2782 $delta=join(":",@tmp);
2783
2784 @d=&ReturnList($d);
2785 return () if (! @d);
2786 foreach $d (@d) {
2787 $d += 8 if ($d<0);
2788 return () if (! &IsInt($d,1,7));
2789 }
2790
2791 # Find out what DofW the basedate is.
2792 @tmp2=&Date_Split($dateb, 1);
2793 $tmp=&Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]);
2794
2795 @date=();
2796 foreach $d (@d) {
2797 $date_b=$dateb;
2798 # Move basedate to DOW in the same week
2799 if ($d != $tmp) {
2800 if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
2801 ($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
2802 ($tmp<$d && $d<$Cnf{"FirstDay"})) {
2803 $date_b=&Date_GetNext($date_b,$d);
2804 } else {
2805 $date_b=&Date_GetPrev($date_b,$d);
2806 }
2807 }
2808 push(@date,&Date_Recur($date0,$date1,$date_b,$delta));
2809 }
2810 last RECUR;
2811
2812 } elsif ($m>0) {
2813
2814 # Y-M-0 * DOM-H-MN-S
2815 return () if (! $dateb);
2816 @tmp=(@recur0);
2817 push(@tmp,0) while ($#tmp<6);
2818 $delta=join(":",@tmp);
2819
2820 @d=&ReturnList($d);
2821 return () if (! @d);
2822 foreach $d (@d) {
2823 return () if ($d==0 || ! &IsInt($d,-31,31));
2824 }
2825
2826 @tmp2=&Date_Recur($date0,$date1,$dateb,$delta);
2827 @date=();
2828 foreach $date (@tmp2) {
2829 ($y,$m)=( &Date_Split($date, 1) )[0..1];
2830 my $dim=&Date_DaysInMonth($m,$y);
2831 foreach $d (@d) {
2832 my $tmpd = $d;
2833 $tmpd += ($dim+1) if ($tmpd<0);
2834 next if (! &IsInt($tmpd,1,$dim));
2835 push(@date,&Date_Join($y,$m,$tmpd,0,0,0));
2836 }
2837 }
2838 last RECUR;
2839
2840 } else {
2841 return ();
2842 }
2843 }
2844
2845 if ($#recur0>2) {
2846
2847 # Y-M-W-D * H-MN-S
2848 # Y-M-W-D-H * MN-S
2849 # Y-M-W-D-H-MN * S
2850 # Y-M-W-D-H-S
2851 return () if (! $dateb);
2852 @tmp=(@recur0);
2853 push(@tmp,0) while ($#tmp<6);
2854 $delta=join(":",@tmp);
2855 return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
2856 @date=&Date_Recur($date0,$date1,$dateb,$delta);
2857 if (@recur1) {
2858 unshift(@recur1,-1) while ($#recur1<2);
2859 @time=@recur1;
2860 } else {
2861 shift(@date);
2862 pop(@date);
2863 @time=();
2864 }
2865 }
2866
2867 last RECUR;
2868 }
2869 @date=&Date_RecurSetTime($date0,$date1,\@date,@time) if (@time);
2870
2871 #
2872 # We've got a list of dates. Operate on them with the flags.
2873 #
2874
2875 my($sign,$forw,$today,$df,$db,$work,$i);
2876 if (@flags) {
2877 FLAG: foreach $f (@flags) {
2878 $f = uc($f);
2879
2880 if ($f =~ /^(P|N)(D|T)([1-7])$/) {
2881 @tmp=($1,$2,$3);
2882 $forw =($tmp[0] eq "P" ? 0 : 1);
2883 $today=($tmp[1] eq "D" ? 0 : 1);
2884 $d=$tmp[2];
2885 @tmp=();
2886 foreach $date (@date) {
2887 if ($forw) {
2888 push(@tmp, &Date_GetNext($date,$d,$today));
2889 } else {
2890 push(@tmp, &Date_GetPrev($date,$d,$today));
2891 }
2892 }
2893 @date=@tmp;
2894 next FLAG;
2895 }
2896
2897 # We want to go forward exact amounts of time instead of
2898 # business mode calculations so that we don't change the time
2899 # (which may have been set in the recur).
2900 if ($f =~ /^(F|B)(D|W)(\d+)$/) {
2901 @tmp=($1,$2,$3);
2902 $sign="+";
2903 $sign="-" if ($tmp[0] eq "B");
2904 $work=0;
2905 $work=1 if ($tmp[1] eq "W");
2906 $n=$tmp[2];
2907 @tmp=();
2908 foreach $date (@date) {
2909 for ($i=1; $i<=$n; $i++) {
2910 while (1) {
2911 $date=&DateCalc($date,"${sign}0:0:0:1:0:0:0");
2912 last if (! $work || &Date_IsWorkDay($date,0));
2913 }
2914 }
2915 push(@tmp,$date);
2916 }
2917 @date=@tmp;
2918 next FLAG;
2919 }
2920
2921 if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
2922 $tmp=$1;
2923 my $noalt = $2 ? 1 : 0;
2924 if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
2925 $forw=1;
2926 } else {
2927 $forw=0;
2928 }
2929
2930 @tmp=();
2931 DATE: foreach $date (@date) {
2932 $df=$db=$date;
2933 if (&Date_IsWorkDay($date)) {
2934 push(@tmp,$date);
2935 next DATE;
2936 }
2937 while (1) {
2938 if ($forw) {
2939 $d=$df=&DateCalc($df,"+0:0:0:1:0:0:0");
2940 } else {
2941 $d=$db=&DateCalc($db,"-0:0:0:1:0:0:0");
2942 }
2943 if (&Date_IsWorkDay($d)) {
2944 push(@tmp,$d);
2945 next DATE;
2946 }
2947 $forw=1-$forw if (! $noalt);
2948 }
2949 }
2950 @date=@tmp;
2951 next FLAG;
2952 }
2953
2954 if ($f eq "EASTER") {
2955 @tmp=();
2956 foreach $date (@date) {
2957 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
2958 ($m,$d)=&Date_Easter($y);
2959 $date=&Date_Join($y,$m,$d,$h,$mn,$s);
2960 next if (&Date_Cmp($date,$date0)<0 ||
2961 &Date_Cmp($date,$date1)>0);
2962 push(@tmp,$date);
2963 }
2964 @date=@tmp;
2965 }
2966 }
2967 }
2968
2969 @date = sort { Date_Cmp($a,$b) } @date;
2970 return @date;
2971}
2972
2973sub Date_GetPrev {
2974 print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/);
2975 my($date,$dow,$today,$hr,$min,$sec)=@_;
2976 &Date_Init() if (! $Curr{"InitDone"});
2977 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
2978 $adjust,$curr)=();
2979 $hr="00" if (defined $hr && $hr eq "0");
2980 $min="00" if (defined $min && $min eq "0");
2981 $sec="00" if (defined $sec && $sec eq "0");
2982
2983 if (! &Date_Split($date)) {
2984 $date=&ParseDateString($date);
2985 return "" if (! $date);
2986 }
2987 $curr=$date;
2988 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
2989
2990 if ($dow) {
2991 $curr_dow=&Date_DayOfWeek($m,$d,$y);
2992 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
2993 if (&IsInt($dow)) {
2994 return "" if ($dow<1 || $dow>7);
2995 } else {
2996 return "" if (! exists $dow{lc($dow)});
2997 $dow=$dow{lc($dow)};
2998 }
2999 if ($dow == $curr_dow) {
3000 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today);
3001 $adjust=1 if ($today==2);
3002 } else {
3003 $dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
3004 $num = $curr_dow - $dow;
3005 $date=&DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0);
3006 }
3007 $date=&Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
3008 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0)
3009 if ($adjust && &Date_Cmp($date,$curr)>0);
3010
3011 } else {
3012 ($h,$mn,$s)=( &Date_Split($date, 1) )[3..5];
3013 ($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec);
3014 if ($hr) {
3015 ($hr,$min,$sec)=($th,$tm,$ts);
3016 $delta="-0:0:0:1:0:0:0";
3017 } elsif ($min) {
3018 ($hr,$min,$sec)=($h,$tm,$ts);
3019 $delta="-0:0:0:0:1:0:0";
3020 } elsif ($sec) {
3021 ($hr,$min,$sec)=($h,$mn,$ts);
3022 $delta="-0:0:0:0:0:1:0";
3023 } else {
3024 confess "ERROR: invalid arguments in Date_GetPrev.\n";
3025 }
3026
3027 $d=&Date_SetTime($date,$hr,$min,$sec);
3028 if ($today) {
3029 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>0);
3030 } else {
3031 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>=0);
3032 }
3033 $date=$d;
3034 }
3035 return $date;
3036}
3037
3038sub Date_GetNext {
3039 print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/);
3040 my($date,$dow,$today,$hr,$min,$sec)=@_;
3041 &Date_Init() if (! $Curr{"InitDone"});
3042 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
3043 $adjust,$curr)=();
3044 $hr="00" if (defined $hr && $hr eq "0");
3045 $min="00" if (defined $min && $min eq "0");
3046 $sec="00" if (defined $sec && $sec eq "0");
3047
3048 if (! &Date_Split($date)) {
3049 $date=&ParseDateString($date);
3050 return "" if (! $date);
3051 }
3052 $curr=$date;
3053 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
3054
3055 if ($dow) {
3056 $curr_dow=&Date_DayOfWeek($m,$d,$y);
3057 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
3058 if (&IsInt($dow)) {
3059 return "" if ($dow<1 || $dow>7);
3060 } else {
3061 return "" if (! exists $dow{lc($dow)});
3062 $dow=$dow{lc($dow)};
3063 }
3064 if ($dow == $curr_dow) {
3065 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today);
3066 $adjust=1 if ($today==2);
3067 } else {
3068 $curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
3069 $num = $dow - $curr_dow;
3070 $date=&DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0);
3071 }
3072 $date=&Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
3073 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0)
3074 if ($adjust && &Date_Cmp($date,$curr)<0);
3075
3076 } else {
3077 ($h,$mn,$s)=( &Date_Split($date, 1) )[3..5];
3078 ($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec);
3079 if ($hr) {
3080 ($hr,$min,$sec)=($th,$tm,$ts);
3081 $delta="+0:0:0:1:0:0:0";
3082 } elsif ($min) {
3083 ($hr,$min,$sec)=($h,$tm,$ts);
3084 $delta="+0:0:0:0:1:0:0";
3085 } elsif ($sec) {
3086 ($hr,$min,$sec)=($h,$mn,$ts);
3087 $delta="+0:0:0:0:0:1:0";
3088 } else {
3089 confess "ERROR: invalid arguments in Date_GetNext.\n";
3090 }
3091
3092 $d=&Date_SetTime($date,$hr,$min,$sec);
3093 if ($today) {
3094 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<0);
3095 } else {
3096 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<1);
3097 }
3098 $date=$d;
3099 }
3100
3101 return $date;
3102}
3103
3104sub Date_IsHoliday {
3105 print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
3106 my($date)=@_;
3107 &Date_Init() if (! $Curr{"InitDone"});
3108 $date=&ParseDateString($date);
3109 return undef if (! $date);
3110 $date=&Date_SetTime($date,0,0,0);
3111 my($y)=(&Date_Split($date, 1))[0];
3112 &Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y});
3113 return undef if (! exists $Holiday{"dates"}{$y}{$date});
3114 my($name)=$Holiday{"dates"}{$y}{$date};
3115 return "" if (! $name);
3116 $name;
3117}
3118
3119sub Events_List {
3120 print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
3121 my(@args)=@_;
3122 &Date_Init() if (! $Curr{"InitDone"});
3123 &Events_ParseRaw();
3124
3125 my($tmp,$date0,$date1,$flag);
3126 $date0=&ParseDateString($args[0]);
3127 warn "Invalid date $args[0]", return undef if (! $date0);
3128
3129 if ($#args == 0) {
3130 return &Events_Calc($date0);
3131 }
3132
3133 if ($args[1]) {
3134 $date1=&ParseDateString($args[1]);
3135 warn "Invalid date $args[1]\n", return undef if (! $date1);
3136 if (&Date_Cmp($date0,$date1)>0) {
3137 $tmp=$date1;
3138 $date1=$date0;
3139 $date0=$tmp;
3140 }
3141 } else {
3142 $date0=&Date_SetTime($date0,"00:00:00");
3143 $date1=&DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0");
3144 }
3145
3146 $tmp=&Events_Calc($date0,$date1);
3147
3148 $flag=$args[2];
3149 return $tmp if (! $flag);
3150
3151 my(@tmp,%ret,$delta)=();
3152 @tmp=@$tmp;
3153 push(@tmp,$date1);
3154
3155 if ($flag==1) {
3156 while ($#tmp>0) {
3157 ($date0,$tmp)=splice(@tmp,0,2);
3158 $date1=$tmp[0];
3159 $delta=&DateCalc_DateDate($date0,$date1);
3160 foreach $flag (@$tmp) {
3161 if (exists $ret{$flag}) {
3162 $ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta);
3163 } else {
3164 $ret{$flag}=$delta;
3165 }
3166 }
3167 }
3168 return \%ret;
3169
3170 } elsif ($flag==2) {
3171 while ($#tmp>0) {
3172 ($date0,$tmp)=splice(@tmp,0,2);
3173 $date1=$tmp[0];
3174 $delta=&DateCalc_DateDate($date0,$date1);
3175 $flag=join("+",sort { Date_Cmp($a,$b) } @$tmp);
3176 next if (! $flag);
3177 if (exists $ret{$flag}) {
3178 $ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta);
3179 } else {
3180 $ret{$flag}=$delta;
3181 }
3182 }
3183 return \%ret;
3184 }
3185
3186 warn "Invalid flag $flag\n";
3187 return undef;
3188}
3189
3190###
3191# NOTE: The following routines may be called in the routines below with very
3192# little time penalty.
3193###
3194sub Date_SetTime {
3195 print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
3196 my($date,$h,$mn,$s)=@_;
3197 &Date_Init() if (! $Curr{"InitDone"});
3198 my($y,$m,$d)=();
3199
3200 if (! &Date_Split($date)) {
3201 $date=&ParseDateString($date);
3202 return "" if (! $date);
3203 }
3204
3205 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
3206 ($h,$mn,$s)=&Date_ParseTime($h,$mn,$s);
3207
3208 my($ampm,$wk);
3209 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
3210 &Date_Join($y,$m,$d,$h,$mn,$s);
3211}
3212
3213sub Date_SetDateField {
3214 print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/);
3215 my($date,$field,$val,$nocheck)=@_;
3216 my($y,$m,$d,$h,$mn,$s)=();
3217 $nocheck=0 if (! defined $nocheck);
3218
3219 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date);
3220
3221 if (! $y) {
3222 $date=&ParseDateString($date);
3223 return "" if (! $date);
3224 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
3225 }
3226
3227 if (lc($field) eq "y") {
3228 $y=$val;
3229 } elsif (lc($field) eq "m") {
3230 $m=$val;
3231 } elsif (lc($field) eq "d") {
3232 $d=$val;
3233 } elsif (lc($field) eq "h") {
3234 $h=$val;
3235 } elsif (lc($field) eq "mn") {
3236 $mn=$val;
3237 } elsif (lc($field) eq "s") {
3238 $s=$val;
3239 } else {
3240 confess "ERROR: Date_SetDateField: invalid field: $field\n";
3241 }
3242
3243 $date=&Date_Join($y,$m,$d,$h,$mn,$s);
3244 return $date if ($nocheck || &Date_Split($date));
3245 return "";
3246}
3247
3248########################################################################
3249# OTHER SUBROUTINES
3250########################################################################
3251# NOTE: These routines should not call any of the routines above as
3252# there will be a severe time penalty (and the possibility of
3253# infinite recursion). The last couple routines above are
3254# exceptions.
3255# NOTE: Date_Init is a special case. It should be called (conditionally)
3256# in every routine that uses any variable from the Date::Manip
3257# namespace.
3258########################################################################
3259
3260sub Date_DaysInMonth {
3261 print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
3262 my($m,$y)=@_;
3263 $y=&Date_FixYear($y) if (length($y)!=4);
3264 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
3265 $d_in_m[2]=29 if (&Date_LeapYear($y));
3266 return $d_in_m[$m];
3267}
3268
3269sub Date_DayOfWeek {
3270 print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
3271 my($m,$d,$y)=@_;
3272 $y=&Date_FixYear($y) if (length($y)!=4);
3273 my($dayofweek,$dec31)=();
3274
3275 $dec31=5; # Dec 31, 1BC was Friday
3276 $dayofweek=(&Date_DaysSince1BC($m,$d,$y)+$dec31) % 7;
3277 $dayofweek=7 if ($dayofweek==0);
3278 return $dayofweek;
3279}
3280
3281# Can't be in "use integer" because the numbers are too big.
3282no integer;
3283sub Date_SecsSince1970 {
3284 print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
3285 my($m,$d,$y,$h,$mn,$s)=@_;
3286 $y=&Date_FixYear($y) if (length($y)!=4);
3287 my($sec_now,$sec_70)=();
3288 $sec_now=(&Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s;
3289# $sec_70 =(&Date_DaysSince1BC(1,1,1970)-1)*24*3600;
3290 $sec_70 =62167219200;
3291 return ($sec_now-$sec_70);
3292}
3293
3294sub Date_SecsSince1970GMT {
3295 print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/);
3296 my($m,$d,$y,$h,$mn,$s)=@_;
3297 &Date_Init() if (! $Curr{"InitDone"});
3298 $y=&Date_FixYear($y) if (length($y)!=4);
3299
3300 my($sec)=&Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
3301 return $sec if ($Cnf{"ConvTZ"} eq "IGNORE");
3302
3303 my($tz)=$Cnf{"ConvTZ"};
3304 $tz=$Cnf{"TZ"} if (! $tz);
3305 $tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
3306
3307 my($tzs)=1;
3308 $tzs=-1 if ($tz<0);
3309 $tz=~/.(..)(..)/;
3310 my($tzh,$tzm)=($1,$2);
3311 $sec - $tzs*($tzh*3600+$tzm*60);
3312}
3313use integer;
3314
3315sub Date_DaysSince1BC {
3316 print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
3317 my($m,$d,$y)=@_;
3318 $y=&Date_FixYear($y) if (length($y)!=4);
3319 my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
3320 my($cc,$yy)=();
3321
3322 $y=~ /(\d{2})(\d{2})/;
3323 ($cc,$yy)=($1,$2);
3324
3325 # Number of full years since Dec 31, 1BC (counting the year 0000).
3326 $Ny=$y;
3327
3328 # Number of full 4th years (incl. 0000) since Dec 31, 1BC
3329 $N4=($Ny-1)/4 + 1;
3330 $N4=0 if ($y==0);
3331
3332 # Number of full 100th years (incl. 0000)
3333 $N100=$cc + 1;
3334 $N100-- if ($yy==0);
3335 $N100=0 if ($y==0);
3336
3337 # Number of full 400th years (incl. 0000)
3338 $N400=($N100-1)/4 + 1;
3339 $N400=0 if ($y==0);
3340
3341 $dayofyear=&Date_DayOfYear($m,$d,$y);
3342 $days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
3343
3344 return $days;
3345}
3346
3347sub Date_DayOfYear {
3348 print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3349 my($m,$d,$y)=@_;
3350 $y=&Date_FixYear($y) if (length($y)!=4);
3351 # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
3352 my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
3353 my($ly)=0;
3354 $ly=1 if ($m>2 && &Date_LeapYear($y));
3355 return ($days[$m-1]+$d+$ly);
3356}
3357
3358sub Date_DaysInYear {
3359 print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
3360 my($y)=@_;
3361 $y=&Date_FixYear($y) if (length($y)!=4);
3362 return 366 if (&Date_LeapYear($y));
3363 return 365;
3364}
3365
3366sub Date_WeekOfYear {
3367 print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3368 my($m,$d,$y,$f)=@_;
3369 &Date_Init() if (! $Curr{"InitDone"});
3370 $y=&Date_FixYear($y) if (length($y)!=4);
3371
3372 my($day,$dow,$doy)=();
3373 $doy=&Date_DayOfYear($m,$d,$y);
3374
3375 # The current DayOfYear and DayOfWeek
3376 if ($Cnf{"Jan1Week1"}) {
3377 $day=1;
3378 } else {
3379 $day=4;
3380 }
3381 $dow=&Date_DayOfWeek(1,$day,$y);
3382
3383 # Move back to the first day of week 1.
3384 $f-=7 if ($f>$dow);
3385 $day-= ($dow-$f);
3386
3387 return 0 if ($day>$doy); # Day is in last week of previous year
3388 return (($doy-$day)/7 + 1);
3389}
3390
3391sub Date_LeapYear {
3392 print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
3393 my($y)=@_;
3394 $y=&Date_FixYear($y) if (length($y)!=4);
3395 return 0 unless $y % 4 == 0;
3396 return 1 unless $y % 100 == 0;
3397 return 0 unless $y % 400 == 0;
3398 return 1;
3399}
3400
3401sub Date_DaySuffix {
3402 print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
3403 my($d)=@_;
3404 &Date_Init() if (! $Curr{"InitDone"});
3405 return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
3406}
3407
3408sub Date_ConvTZ {
3409 print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
3410 my($date,$from,$to,$level)=@_;
3411 if (not Date_Split($date)) {
3412 my $err = "date passed in ('$date') is not a Date::Manip object";
3413 if (! $level) {
3414 croak $err;
3415 } elsif ($level==1) {
3416 carp $err;
3417 }
3418 return "";
3419 }
3420
3421 &Date_Init() if (! $Curr{"InitDone"});
3422 my($gmt)=();
3423
3424 if (! $from) {
3425
3426 if (! $to) {
3427 # TZ -> ConvTZ
3428 return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
3429 $from=$Cnf{"TZ"};
3430 $to=$Cnf{"ConvTZ"};
3431
3432 } else {
3433 # ConvTZ,TZ -> $to
3434 $from=$Cnf{"ConvTZ"};
3435 $from=$Cnf{"TZ"} if (! $from);
3436 }
3437
3438 } else {
3439
3440 if (! $to) {
3441 # $from -> ConvTZ,TZ
3442 return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
3443 $to=$Cnf{"ConvTZ"};
3444 $to=$Cnf{"TZ"} if (! $to);
3445
3446 } else {
3447 # $from -> $to
3448 }
3449 }
3450
3451 $to=$Zone{"n2o"}{lc($to)}
3452 if (exists $Zone{"n2o"}{lc($to)});
3453 $from=$Zone{"n2o"}{lc($from)}
3454 if (exists $Zone{"n2o"}{lc($from)});
3455 $gmt=$Zone{"n2o"}{"gmt"};
3456
3457 return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/);
3458 return $date if ($from eq $to);
3459
3460 my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=();
3461 # We're going to try to do the calculation without calling DateCalc.
3462 ($yr,$mon,$d,$h,$m,$sec)=&Date_Split($date, 1);
3463
3464 # Convert $date from $from to GMT
3465 $from=~/([+-])(\d{2})(\d{2})/;
3466 ($s1,$h1,$m1)=($1,$2,$3);
3467 $s1= ($s1 eq "-" ? "+" : "-"); # switch sign
3468 $sign=$s1 . "1"; # + or - 1
3469
3470 # and from GMT to $to
3471 $to=~/([+-])(\d{2})(\d{2})/;
3472 ($s2,$h2,$m2)=($1,$2,$3);
3473
3474 if ($s1 eq $s2) {
3475 # Both the same sign
3476 $m+= $sign*($m1+$m2);
3477 $h+= $sign*($h1+$h2);
3478 } else {
3479 $sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
3480 $m+= $sign*($m1-$m2);
3481 $h+= $sign*($h1-$h2);
3482 }
3483
3484 if ($m>59) {
3485 $h+= $m/60;
3486 $m-= ($m/60)*60;
3487 } elsif ($m<0) {
3488 $h+= ($m/60 - 1);
3489 $m-= ($m/60 - 1)*60;
3490 }
3491
3492 if ($h>23) {
3493 $delta=$h/24;
3494 $h -= $delta*24;
3495 if (($d + $delta) > 28) {
3496 $date=&Date_Join($yr,$mon,$d,$h,$m,$sec);
3497 return &DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0);
3498 }
3499 $d+= $delta;
3500 } elsif ($h<0) {
3501 $delta=-$h/24 + 1;
3502 $h += $delta*24;
3503 if (($d - $delta) < 1) {
3504 $date=&Date_Join($yr,$mon,$d,$h,$m,$sec);
3505 return &DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0);
3506 }
3507 $d-= $delta;
3508 }
3509 return &Date_Join($yr,$mon,$d,$h,$m,$sec);
3510}
3511
3512sub Date_TimeZone {
3513 print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/);
3514 my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=();
3515 &Date_Init() if (! $Curr{"InitDone"});
3516
3517 # Get timezones from all of the relevant places
3518
3519 push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var
3520 push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var
3521 push(@tz,$ENV{'SYS$TIMEZONE_RULE'})
3522 if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var
3523 push(@tz,$ENV{'SYS$TIMEZONE_NAME'})
3524 if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var
3525 push(@tz,$ENV{'UCX$TZ'})
3526 if defined $ENV{'UCX$TZ'}; # VMS TZ environ var
3527 push(@tz,$ENV{'TCPIP$TZ'})
3528 if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var
3529
3530 # The `date` command... if we're doing taint checking, we need to
3531 # always call it with a full path... otherwise, use the user's path.
3532 #
3533 # Microsoft operating systems don't have a date command built in. Try
3534 # to trap all the various ways of knowing we are on one of these systems.
3535 #
3536 # We'll try `date +%Z` first, and if that fails, we'll take just the
3537 # `date` program and assume the output is of the format:
3538 # Thu Aug 31 14:57:46 EDT 2000
3539
3540 unless (($^O ne 'cygwin' && $^X =~ /perl\.exe$/i) or
3541 ($OS eq "Windows") or
3542 ($OS eq "Netware") or
3543 ($OS eq "VMS")) {
3544 if ($Date::Manip::NoTaint) {
3545 if ($OS eq "VMS") {
3546 $tz=$ENV{'SYS$TIMEZONE_NAME'};
3547 if (! $tz) {
3548 $tz=$ENV{'MULTINET_TIMEZONE'};
3549 if (! $tz) {
3550 $tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
3551 }
3552 }
3553 } else {
3554 $tz=`date +%Z 2> /dev/null`;
3555 chomp($tz);
3556 if (! $tz) {
3557 $tz=`date 2> /dev/null`;
3558 chomp($tz);
3559 $tz=(split(/\s+/,$tz))[4];
3560 }
3561 }
3562 push(@tz,$tz);
3563 } else {
3564 # We need to satisfy taint checking, but also look in all the
3565 # directories in @DatePath.
3566 #
3567 local $ENV{PATH} = join(':', @Date::Manip::DatePath);
3568 local $ENV{BASH_ENV} = '';
3569 $tz=`date +%Z 2> /dev/null`;
3570 chomp($tz);
3571 if (! $tz) {
3572 $tz=`date 2> /dev/null`;
3573 chomp($tz);
3574 $tz=(split(/\s+/,$tz))[4];
3575 }
3576 push(@tz,$tz);
3577 }
3578 }
3579
3580 push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ
3581
3582 if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE
3583 $in=new IO::File;
3584 $in->open("/etc/TIMEZONE","r");
3585 while (! eof($in)) {
3586 $tmp=<$in>;
3587 if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
3588 push(@tz,$1);
3589 last;
3590 }
3591 }
3592 $in->close;
3593 }
3594
3595 if (-s "/etc/timezone") { # /etc/timezone
3596 $in=new IO::File;
3597 $in->open("/etc/timezone","r");
3598 while (! eof($in)) {
3599 $tmp=<$in>;
3600 next if ($tmp =~ /^\s*\043/);
3601 chomp($tmp);
3602 if ($tmp =~ /^\s*(.*?)\s*$/) {
3603 push(@tz,$1);
3604 last;
3605 }
3606 }
3607 $in->close;
3608 }
3609
3610 # Now parse each one to find the first valid one.
3611 foreach $tz (@tz) {
3612 $tz =~ s/\s*$//;
3613 $tz =~ s/^\s*//;
3614 $tz =~ s/^://;
3615 next if ($tz eq "");
3616
3617 return uc($tz)
3618 if (defined $Zone{"n2o"}{lc($tz)});
3619
3620 if ($tz =~ /^[+-]\d{4}$/) {
3621 return $tz;
3622 } elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
3623 my($h,$m)=($1,$2);
3624 $m="00" if (! $m);
3625 return "$h$m";
3626 }
3627
3628 # Handle US/Eastern format
3629 if ($tz =~ /^$Zone{"tzones"}$/i) {
3630 $tmp=lc $1;
3631 $tz=$Zone{"tz2z"}{$tmp};
3632 }
3633
3634 # Handle STD#DST# format (and STD-#DST-# formats)
3635 if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
3636 ($std,$dst)=($1,$2);
3637 next if (! defined $Zone{"n2o"}{lc($std)} or
3638 ! defined $Zone{"n2o"}{lc($dst)});
3639 $time = time();
3640 ($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
3641 localtime($time);
3642 return uc($dst) if ($isdst);
3643 return uc($std);
3644 }
3645 }
3646
3647 confess "ERROR: Date::Manip unable to determine Time Zone.\n";
3648}
3649
3650# Returns 1 if $date is a work day. If $time is non-zero, the time is
3651# also checked to see if it falls within work hours. Returns "" if
3652# an invalid date is passed in.
3653sub Date_IsWorkDay {
3654 print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3655 my($date,$time)=@_;
3656 &Date_Init() if (! $Curr{"InitDone"});
3657 $date=&ParseDateString($date);
3658 return "" if (! $date);
3659 my($d)=$date;
3660 $d=&Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time);
3661
3662 my($y,$mon,$day,$h,$m,$s,$dow)=();
3663 ($y,$mon,$day,$h,$m,$s)=&Date_Split($d, 1);
3664 $dow=&Date_DayOfWeek($mon,$day,$y);
3665
3666 return 0 if ($dow<$Cnf{"WorkWeekBeg"} or
3667 $dow>$Cnf{"WorkWeekEnd"} or
3668 "$h:$m" lt $Cnf{"WorkDayBeg"} or
3669 "$h:$m" ge $Cnf{"WorkDayEnd"});
3670
3671 if (! exists $Holiday{"dates"}{$y}) {
3672 # There will be recursion problems if we ever end up here twice.
3673 $Holiday{"dates"}{$y}={};
3674 &Date_UpdateHolidays($y)
3675 }
3676 $d=&Date_SetTime($date,"00:00:00");
3677 return 0 if (exists $Holiday{"dates"}{$y}{$d});
3678 1;
3679}
3680
3681# Finds the day $off work days from now. If $time is passed in, we must
3682# also take into account the time of day.
3683#
3684# If $time is not passed in, day 0 is today (if today is a workday) or the
3685# next work day if it isn't. In any case, the time of day is unaffected.
3686#
3687# If $time is passed in, day 0 is now (if now is part of a workday) or the
3688# start of the very next work day.
3689sub Date_NextWorkDay {
3690 print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3691 my($date,$off,$time)=@_;
3692 &Date_Init() if (! $Curr{"InitDone"});
3693 $date=&ParseDateString($date);
3694 my($err)=();
3695
3696 if (! &Date_IsWorkDay($date,$time)) {
3697 if ($time) {
3698 while (1) {
3699 $date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3700 last if (&Date_IsWorkDay($date,$time));
3701 }
3702 } else {
3703 while (1) {
3704 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3705 last if (&Date_IsWorkDay($date,$time));
3706 }
3707 }
3708 }
3709
3710 while ($off>0) {
3711 while (1) {
3712 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3713 last if (&Date_IsWorkDay($date,$time));
3714 }
3715 $off--;
3716 }
3717
3718 return $date;
3719}
3720
3721# Finds the day $off work days before now. If $time is passed in, we must
3722# also take into account the time of day.
3723#
3724# If $time is not passed in, day 0 is today (if today is a workday) or the
3725# previous work day if it isn't. In any case, the time of day is unaffected.
3726#
3727# If $time is passed in, day 0 is now (if now is part of a workday) or the
3728# end of the previous work period. Note that since the end of a work day
3729# will automatically be turned into the start of the next one, this time
3730# may actually be treated as AFTER the current time.
3731sub Date_PrevWorkDay {
3732 print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3733 my($date,$off,$time)=@_;
3734 &Date_Init() if (! $Curr{"InitDone"});
3735 $date=&ParseDateString($date);
3736 my($err)=();
3737
3738 if (! &Date_IsWorkDay($date,$time)) {
3739 if ($time) {
3740 while (1) {
3741 $date=&Date_GetPrev($date,undef,0,$Cnf{"WorkDayEnd"});
3742 last if (&Date_IsWorkDay($date,$time));
3743 }
3744 while (1) {
3745 $date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3746 last if (&Date_IsWorkDay($date,$time));
3747 }
3748 } else {
3749 while (1) {
3750 $date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3751 last if (&Date_IsWorkDay($date,$time));
3752 }
3753 }
3754 }
3755
3756 while ($off>0) {
3757 while (1) {
3758 $date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3759 last if (&Date_IsWorkDay($date,$time));
3760 }
3761 $off--;
3762 }
3763
3764 return $date;
3765}
3766
3767# This finds the nearest workday to $date. If $date is a workday, it
3768# is returned.
3769sub Date_NearestWorkDay {
3770 print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3771 my($date,$tomorrow)=@_;
3772 &Date_Init() if (! $Curr{"InitDone"});
3773 $date=&ParseDateString($date);
3774 my($a,$b,$dela,$delb,$err)=();
3775 $tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow);
3776
3777 return $date if (&Date_IsWorkDay($date));
3778
3779 # Find the nearest one.
3780 if ($tomorrow) {
3781 $dela="+0:0:0:1:0:0:0";
3782 $delb="-0:0:0:1:0:0:0";
3783 } else {
3784 $dela="-0:0:0:1:0:0:0";
3785 $delb="+0:0:0:1:0:0:0";
3786 }
3787 $a=$b=$date;
3788
3789 while (1) {
3790 $a=&DateCalc_DateDelta($a,$dela,\$err);
3791 return $a if (&Date_IsWorkDay($a));
3792 $b=&DateCalc_DateDelta($b,$delb,\$err);
3793 return $b if (&Date_IsWorkDay($b));
3794 }
3795}
3796
3797# &Date_NthDayOfYear($y,$n);
3798# Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year.
3799sub Date_NthDayOfYear {
3800 no integer;
3801 print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3802 my($y,$n)=@_;
3803 $y=$Curr{"Y"} if (! $y);
3804 $n=1 if (! defined $n or $n eq "");
3805 $n+=0; # to turn 023 into 23
3806 $y=&Date_FixYear($y) if (length($y)<4);
3807 my $leap=&Date_LeapYear($y);
3808 return () if ($n<1);
3809 return () if ($n >= ($leap ? 367 : 366));
3810
3811 my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31);
3812 $d_in_m[1]=29 if ($leap);
3813
3814 # Calculate the hours, minutes, and seconds into the day.
3815 my $remain=($n - int($n))*24;
3816 my $h=int($remain);
3817 $remain=($remain - $h)*60;
3818 my $mn=int($remain);
3819 $remain=($remain - $mn)*60;
3820 my $s=$remain;
3821
3822 # Calculate the month and the day.
3823 my($m,$d)=(0,0);
3824 $n=int($n);
3825 while ($n>0) {
3826 $m++;
3827 if ($n<=$d_in_m[0]) {
3828 $d=int($n);
3829 $n=0;
3830 } else {
3831 $n-= $d_in_m[0];
3832 shift(@d_in_m);
3833 }
3834 }
3835
3836 ($y,$m,$d,$h,$mn,$s);
3837}
3838
3839########################################################################
3840# NOT FOR EXPORT
3841########################################################################
3842
3843# This is used in Date_Init to fill in a hash based on international
3844# data. It takes a list of keys and values and returns both a hash
3845# with these values and a regular expression of keys.
3846#
3847# IN:
3848# $data = [ key1 val1 key2 val2 ... ]
3849# $opts = lc : lowercase the keys in the regexp
3850# sort : sort (by length) the keys in the regexp
3851# back : create a regexp with a back reference
3852# escape : escape all strings in the regexp
3853#
3854# OUT:
3855# $regexp = '(?:key1|key2|...)'
3856# $hash = { key1=>val1 key2=>val2 ... }
3857
3858sub Date_InitHash {
3859 print "DEBUG: Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
3860 my($data,$regexp,$opts,$hash)=@_;
3861 my(@data)=@$data;
3862 my($key,$val,@list)=();
3863
3864 # Parse the options
3865 my($lc,$sort,$back,$escape)=(0,0,0,0);
3866 $lc=1 if ($opts =~ /lc/i);
3867 $sort=1 if ($opts =~ /sort/i);
3868 $back=1 if ($opts =~ /back/i);
3869 $escape=1 if ($opts =~ /escape/i);
3870
3871 # Create the hash
3872 while (@data) {
3873 ($key,$val,@data)=@data;
3874 $key=lc($key) if ($lc);
3875 $$hash{$key}=$val;
3876 }
3877
3878 # Create the regular expression
3879 if ($regexp) {
3880 @list=keys(%$hash);
3881 @list=sort sortByLength(@list) if ($sort);
3882 if ($escape) {
3883 foreach $val (@list) {
3884 $val="\Q$val\E";
3885 }
3886 }
3887 if ($back) {
3888 $$regexp="(" . join("|",@list) . ")";
3889 } else {
3890 $$regexp="(?:" . join("|",@list) . ")";
3891 }
3892 }
3893}
3894
3895# This is used in Date_Init to fill in regular expressions, lists, and
3896# hashes based on international data. It takes a list of lists which have
3897# to be stored as regular expressions (to find any element in the list),
3898# lists, and hashes (indicating the location in the lists).
3899#
3900# IN:
3901# $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ]
3902# [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ]
3903# ...
3904# [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ]
3905# $lists = [ \@listA \@listB ... \@listZ ]
3906# $opts = lc : lowercase the values in the regexp
3907# sort : sort (by length) the values in the regexp
3908# back : create a regexp with a back reference
3909# escape : escape all strings in the regexp
3910# $hash = [ \%hash, TYPE ]
3911# TYPE 0 : $hash{ valBn=>n-1 }
3912# TYPE 1 : $hash{ valBn=>n }
3913#
3914# OUT:
3915# $regexp = '(?:valA1|valA2|...|valB1|...)'
3916# $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
3917# [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
3918# $hash
3919
3920sub Date_InitLists {
3921 print "DEBUG: Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
3922 my($data,$regexp,$opts,$lists,$hash)=@_;
3923 my(@data)=@$data;
3924 my(@lists)=@$lists;
3925 my($i,@ele,$ele,@list,$j,$tmp)=();
3926
3927 # Parse the options
3928 my($lc,$sort,$back,$escape)=(0,0,0,0);
3929 $lc=1 if ($opts =~ /lc/i);
3930 $sort=1 if ($opts =~ /sort/i);
3931 $back=1 if ($opts =~ /back/i);
3932 $escape=1 if ($opts =~ /escape/i);
3933
3934 # Set each of the lists
3935 if (@lists) {
3936 confess "ERROR: Date_InitLists: lists must be 1 per data\n"
3937 if ($#lists != $#data);
3938 for ($i=0; $i<=$#data; $i++) {
3939 @ele=@{ $data[$i] };
3940 if ($Cnf{"IntCharSet"} && $#ele>0) {
3941 @{ $lists[$i] } = @{ $ele[1] };
3942 } else {
3943 @{ $lists[$i] } = @{ $ele[0] };
3944 }
3945 }
3946 }
3947
3948 # Create the hash
3949 my($hashtype,$hashsave,%hash)=();
3950 if (@$hash) {
3951 ($hash,$hashtype)=@$hash;
3952 $hashsave=1;
3953 } else {
3954 $hashtype=0;
3955 $hashsave=0;
3956 }
3957 for ($i=0; $i<=$#data; $i++) {
3958 @ele=@{ $data[$i] };
3959 foreach $ele (@ele) {
3960 @list = @{ $ele };
3961 for ($j=0; $j<=$#list; $j++) {
3962 $tmp=$list[$j];
3963 next if (! $tmp);
3964 $tmp=lc($tmp) if ($lc);
3965 $hash{$tmp}= $j+$hashtype;
3966 }
3967 }
3968 }
3969 %$hash = %hash if ($hashsave);
3970
3971 # Create the regular expression
3972 if ($regexp) {
3973 @list=keys(%hash);
3974 @list=sort sortByLength(@list) if ($sort);
3975 if ($escape) {
3976 foreach $ele (@list) {
3977 $ele="\Q$ele\E";
3978 }
3979 }
3980 if ($back) {
3981 $$regexp="(" . join("|",@list) . ")";
3982 } else {
3983 $$regexp="(?:" . join("|",@list) . ")";
3984 }
3985 }
3986}
3987
3988# This is used in Date_Init to fill in regular expressions and lists based
3989# on international data. This takes a list of strings and returns a regular
3990# expression (to find any one of them).
3991#
3992# IN:
3993# $data = [ string1 string2 ... ]
3994# $opts = lc : lowercase the values in the regexp
3995# sort : sort (by length) the values in the regexp
3996# back : create a regexp with a back reference
3997# escape : escape all strings in the regexp
3998#
3999# OUT:
4000# $regexp = '(string1|string2|...)'
4001
4002sub Date_InitStrings {
4003 print "DEBUG: Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
4004 my($data,$regexp,$opts)=@_;
4005 my(@list)=@{ $data };
4006
4007 # Parse the options
4008 my($lc,$sort,$back,$escape)=(0,0,0,0);
4009 $lc=1 if ($opts =~ /lc/i);
4010 $sort=1 if ($opts =~ /sort/i);
4011 $back=1 if ($opts =~ /back/i);
4012 $escape=1 if ($opts =~ /escape/i);
4013
4014 # Create the regular expression
4015 my($ele)=();
4016 @list=sort sortByLength(@list) if ($sort);
4017 if ($escape) {
4018 foreach $ele (@list) {
4019 $ele="\Q$ele\E";
4020 }
4021 }
4022 if ($back) {
4023 $$regexp="(" . join("|",@list) . ")";
4024 } else {
4025 $$regexp="(?:" . join("|",@list) . ")";
4026 }
4027 $$regexp=lc($$regexp) if ($lc);
4028}
4029
4030# items is passed in (either as a space separated string, or a reference to
4031# a list) and a regular expression which matches any one of the items is
4032# prepared. The regular expression will be of one of the forms:
4033# "(a|b)" @list not empty, back option included
4034# "(?:a|b)" @list not empty
4035# "()" @list empty, back option included
4036# "" @list empty
4037# $options is a string which contains any of the following strings:
4038# back : the regular expression has a backreference
4039# opt : the regular expression is optional and a "?" is appended in
4040# the first two forms
4041# optws : the regular expression is optional and may be replaced by
4042# whitespace
4043# optWs : the regular expression is optional, but if not present, must
4044# be replaced by whitespace
4045# sort : the items in the list are sorted by length (longest first)
4046# lc : the string is lowercased
4047# under : any underscores are converted to spaces
4048# pre : it may be preceded by whitespace
4049# Pre : it must be preceded by whitespace
4050# PRE : it must be preceded by whitespace or the start
4051# post : it may be followed by whitespace
4052# Post : it must be followed by whitespace
4053# POST : it must be followed by whitespace or the end
4054# Spaces due to pre/post options will not be included in the back reference.
4055#
4056# If $array is included, then the elements will also be returned as a list.
4057# $array is a string which may contain any of the following:
4058# keys : treat the list as a hash and only the keys go into the regexp
4059# key0 : treat the list as the values of a hash with keys 0 .. N-1
4060# key1 : treat the list as the values of a hash with keys 1 .. N
4061# val0 : treat the list as the keys of a hash with values 0 .. N-1
4062# val1 : treat the list as the keys of a hash with values 1 .. N
4063
4064# &Date_InitLists([$lang{"month_name"},$lang{"month_abb"}],
4065# [\$Month,"lc,sort,back"],
4066# [\@Month,\@Mon],
4067# [\%Month,1]);
4068
4069# This is used in Date_Init to prepare regular expressions. A list of
4070# items is passed in (either as a space separated string, or a reference to
4071# a list) and a regular expression which matches any one of the items is
4072# prepared. The regular expression will be of one of the forms:
4073# "(a|b)" @list not empty, back option included
4074# "(?:a|b)" @list not empty
4075# "()" @list empty, back option included
4076# "" @list empty
4077# $options is a string which contains any of the following strings:
4078# back : the regular expression has a backreference
4079# opt : the regular expression is optional and a "?" is appended in
4080# the first two forms
4081# optws : the regular expression is optional and may be replaced by
4082# whitespace
4083# optWs : the regular expression is optional, but if not present, must
4084# be replaced by whitespace
4085# sort : the items in the list are sorted by length (longest first)
4086# lc : the string is lowercased
4087# under : any underscores are converted to spaces
4088# pre : it may be preceded by whitespace
4089# Pre : it must be preceded by whitespace
4090# PRE : it must be preceded by whitespace or the start
4091# post : it may be followed by whitespace
4092# Post : it must be followed by whitespace
4093# POST : it must be followed by whitespace or the end
4094# Spaces due to pre/post options will not be included in the back reference.
4095#
4096# If $array is included, then the elements will also be returned as a list.
4097# $array is a string which may contain any of the following:
4098# keys : treat the list as a hash and only the keys go into the regexp
4099# key0 : treat the list as the values of a hash with keys 0 .. N-1
4100# key1 : treat the list as the values of a hash with keys 1 .. N
4101# val0 : treat the list as the keys of a hash with values 0 .. N-1
4102# val1 : treat the list as the keys of a hash with values 1 .. N
4103sub Date_Regexp {
4104 print "DEBUG: Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
4105 my($list,$options,$array)=@_;
4106 my(@list,$ret,%hash,$i)=();
4107 local($_)=();
4108 $options="" if (! defined $options);
4109 $array="" if (! defined $array);
4110
4111 my($sort,$lc,$under)=(0,0,0);
4112 $sort =1 if ($options =~ /sort/i);
4113 $lc =1 if ($options =~ /lc/i);
4114 $under=1 if ($options =~ /under/i);
4115 my($back,$opt,$pre,$post,$ws)=("?:","","","","");
4116 $back ="" if ($options =~ /back/i);
4117 $opt ="?" if ($options =~ /opt/i);
4118 $pre ='\s*' if ($options =~ /pre/);
4119 $pre ='\s+' if ($options =~ /Pre/);
4120 $pre ='(?:\s+|^)' if ($options =~ /PRE/);
4121 $post ='\s*' if ($options =~ /post/);
4122 $post ='\s+' if ($options =~ /Post/);
4123 $post ='(?:$|\s+)' if ($options =~ /POST/);
4124 $ws ='\s*' if ($options =~ /optws/);
4125 $ws ='\s+' if ($options =~ /optws/);
4126
4127 my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0);
4128 $keys =1 if ($array =~ /keys/i);
4129 $key0 =1 if ($array =~ /key0/i);
4130 $key1 =1 if ($array =~ /key1/i);
4131 $val0 =1 if ($array =~ /val0/i);
4132 $val1 =1 if ($array =~ /val1/i);
4133 $hash =1 if ($keys or $key0 or $key1 or $val0 or $val1);
4134
4135 my($ref)=ref $list;
4136 if (! $ref) {
4137 $list =~ s/\s*$//;
4138 $list =~ s/^\s*//;
4139 $list =~ s/\s+/&&&/g;
4140 } elsif ($ref eq "ARRAY") {
4141 $list = join("&&&",@$list);
4142 } else {
4143 confess "ERROR: Date_Regexp.\n";
4144 }
4145
4146 if (! $list) {
4147 if ($back eq "") {
4148 return "()";
4149 } else {
4150 return "";
4151 }
4152 }
4153
4154 $list=lc($list) if ($lc);
4155 $list=~ s/_/ /g if ($under);
4156 @list=split(/&&&/,$list);
4157 if ($keys) {
4158 %hash=@list;
4159 @list=keys %hash;
4160 } elsif ($key0 or $key1 or $val0 or $val1) {
4161 $i=0;
4162 $i=1 if ($key1 or $val1);
4163 if ($key0 or $key1) {
4164 %hash= map { $_,$i++ } @list;
4165 } else {
4166 %hash= map { $i++,$_ } @list;
4167 }
4168 }
4169 @list=sort sortByLength(@list) if ($sort);
4170
4171 $ret="($back" . join("|",@list) . ")";
4172 $ret="(?:$pre$ret$post)" if ($pre or $post);
4173 $ret.=$opt;
4174 $ret="(?:$ret|$ws)" if ($ws);
4175
4176 if ($array and $hash) {
4177 return ($ret,%hash);
4178 } elsif ($array) {
4179 return ($ret,@list);
4180 } else {
4181 return $ret;
4182 }
4183}
4184
4185# This will produce a delta with the correct number of signs. At most two
4186# signs will be in it normally (one before the year, and one in front of
4187# the day), but if appropriate, signs will be in front of all elements.
4188# Also, as many of the signs will be equivalent as possible.
4189sub Delta_Normalize {
4190 print "DEBUG: Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
4191 my($delta,$mode)=@_;
4192 return "" if (! $delta);
4193 return "+0:+0:+0:+0:+0:+0:+0"
4194 if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"});
4195 return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/);
4196
4197 my($tmp,$sign1,$sign2,$len)=();
4198
4199 # Calculate the length of the day in minutes
4200 $len=24*60;
4201 $len=$Curr{"WDlen"} if ($mode==2 || $mode==3);
4202
4203 # We have to get the sign of every component explicitely so that a "-0"
4204 # or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must
4205 # be a negative delta).
4206
4207 my($y,$mon,$w,$d,$h,$m,$s)=&Delta_Split($delta);
4208
4209 # We need to make sure that the signs of all parts of a delta are the
4210 # same. The easiest way to do this is to convert all of the large
4211 # components to the smallest ones, then convert the smaller components
4212 # back to the larger ones.
4213
4214 # Do the year/month part
4215
4216 $mon += $y*12; # convert y to m
4217 $sign1="+";
4218 if ($mon<0) {
4219 $mon *= -1;
4220 $sign1="-";
4221 }
4222
4223 $y = $mon/12; # convert m to y
4224 $mon -= $y*12;
4225
4226 $y=0 if ($y eq "-0"); # get around silly -0 problem
4227 $mon=0 if ($mon eq "-0");
4228
4229 # Do the wk/day/hour/min/sec part
4230
4231 {
4232 # Unfortunately, $s is overflowing for dates more than ~70 years
4233 # apart.
4234 no integer;
4235
4236 if ($mode==3 || $mode==2) {
4237 $s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
4238 } else {
4239 $s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
4240 }
4241 $sign2="+";
4242 if ($s<0) {
4243 $s*=-1;
4244 $sign2="-";
4245 }
4246
4247 $m = int($s/60); # convert s to m
4248 $s -= $m*60;
4249 $d = int($m/$len); # convert m to d
4250 $m -= $d*$len;
4251
4252 # The rest should be fine.
4253 }
4254 $h = $m/60; # convert m to h
4255 $m -= $h*60;
4256 if ($mode == 3 || $mode == 2) {
4257 $w = $w*1; # get around +0 problem
4258 } else {
4259 $w = $d/7; # convert d to w
4260 $d -= $w*7;
4261 }
4262
4263 $w=0 if ($w eq "-0"); # get around silly -0 problem
4264 $d=0 if ($d eq "-0");
4265 $h=0 if ($h eq "-0");
4266 $m=0 if ($m eq "-0");
4267 $s=0 if ($s eq "-0");
4268
4269 # Only include two signs if necessary
4270 $sign1=$sign2 if ($y==0 and $mon==0);
4271 $sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0);
4272 $sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"});
4273
4274 if ($Cnf{"DeltaSigns"}) {
4275 return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s";
4276 } else {
4277 return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s";
4278 }
4279}
4280
4281# This checks a delta to make sure it is valid. If it is, it splits
4282# it and returns the elements with a sign on each. The 2nd argument
4283# specifies the default sign. Blank elements are set to 0. If the
4284# third element is non-nil, exactly 7 elements must be included.
4285sub Delta_Split {
4286 print "DEBUG: Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
4287 my($delta,$sign,$exact)=@_;
4288 my(@delta)=split(/:/,$delta);
4289 return () if ($exact and $#delta != 6);
4290 my($i)=();
4291 $sign="+" if (! defined $sign);
4292 for ($i=0; $i<=$#delta; $i++) {
4293 $delta[$i]="0" if (! $delta[$i]);
4294 return () if ($delta[$i] !~ /^[+-]?\d+$/);
4295 $sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign);
4296 $delta[$i] = $sign.$delta[$i];
4297 }
4298 @delta;
4299}
4300
4301# Reads up to 3 arguments. $h may contain the time in any international
4302# format. Any empty elements are set to 0.
4303sub Date_ParseTime {
4304 print "DEBUG: Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
4305 my($h,$m,$s)=@_;
4306 my($t)=&CheckTime("one");
4307
4308 if (defined $h and $h =~ /$t/) {
4309 $h=$1;
4310 $m=$2;
4311 $s=$3 if (defined $3);
4312 }
4313 $h="00" if (! defined $h);
4314 $m="00" if (! defined $m);
4315 $s="00" if (! defined $s);
4316
4317 ($h,$m,$s);
4318}
4319
4320# Forms a date with the 6 elements passed in (all of which must be defined).
4321# No check as to validity is made.
4322sub Date_Join {
4323 print "DEBUG: Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
4324 foreach (0 .. $#_) {
4325 croak "undefined arg $_ to Date_Join()" if not defined $_[$_];
4326 }
4327 my($y,$m,$d,$h,$mn,$s)=@_;
4328 my($ym,$md,$dh,$hmn,$mns)=();
4329
4330 if ($Cnf{"Internal"} == 0) {
4331 $ym=$md=$dh="";
4332 $hmn=$mns=":";
4333
4334 } elsif ($Cnf{"Internal"} == 1) {
4335 $ym=$md=$dh=$hmn=$mns="";
4336
4337 } elsif ($Cnf{"Internal"} == 2) {
4338 $ym=$md="-";
4339 $dh=" ";
4340 $hmn=$mns=":";
4341
4342 } else {
4343 confess "ERROR: Invalid internal format in Date_Join.\n";
4344 }
4345 $m="0$m" if (length($m)==1);
4346 $d="0$d" if (length($d)==1);
4347 $h="0$h" if (length($h)==1);
4348 $mn="0$mn" if (length($mn)==1);
4349 $s="0$s" if (length($s)==1);
4350 "$y$ym$m$md$d$dh$h$hmn$mn$mns$s";
4351}
4352
4353# This checks a time. If it is valid, it splits it and returns 3 elements.
4354# If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is
4355# returned.
4356sub CheckTime {
4357 print "DEBUG: CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
4358 my($time)=@_;
4359 my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
4360 my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
4361 my($m)='[0-5][0-9]';
4362 my($s)=$m;
4363 my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)";
4364 my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)";
4365 my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"};
4366 my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4367 if ($time eq "one") {
4368 return $t;
4369 } elsif ($time eq "two") {
4370 $t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4371 return $t;
4372 }
4373
4374 if ($time =~ /$t/i) {
4375 ($h,$m,$s)=($1,$2,$3);
4376 $h="0$h" if (length($h)<2);
4377 $m="0$m" if (length($m)<2);
4378 $s="00" if (! defined $s);
4379 return ($h,$m,$s);
4380 } else {
4381 return ();
4382 }
4383}
4384
4385# This checks a recurrence. If it is valid, it splits it and returns the
4386# elements. Otherwise, it returns an empty list.
4387# ($recur0,$recur1,$flags,$dateb,$date0,$date1)=&Recur_Split($recur);
4388sub Recur_Split {
4389 print "DEBUG: Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
4390 my($recur)=@_;
4391 my(@ret,@tmp);
4392
4393 my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
4394 my($F) = '(?:\*([^*]*))';
4395 my($DB,$D0,$D1);
4396 $DB=$D0=$D1=$F;
4397
4398 if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
4399 @ret=($1,$2,$3,$4,$5);
4400 @tmp=split(/\*/,shift(@ret));
4401 return () if ($#tmp>1);
4402 return (@tmp,"",@ret) if ($#tmp==0);
4403 return (@tmp,@ret);
4404 }
4405 return ();
4406}
4407
4408# This checks a date. If it is valid, it splits it and returns the elements.
4409#
4410# The optional second argument says 'I really expect this to be a
4411# valid Date::Manip object, please throw an exception if it is not'.
4412# Otherwise, if the date passed in is undef or '', a regular
4413# expression for the date is returned; if the string is nonempty but
4414# still not valid, () is returned.
4415#
4416sub Date_Split {
4417 print "DEBUG: Date_Split\n" if ($Curr{"Debug"} =~ /trace/);
4418 my($date, $definitely_valid)=@_;
4419 $definitely_valid = 0 if not defined $definitely_valid;
4420 my($ym,$md,$dh,$hmn,$mns)=();
4421 my($y)='(\d{4})';
4422 my($m)='(0[1-9]|1[0-2])';
4423 my($d)='(0[1-9]|[1-2][0-9]|3[0-1])';
4424 my($h)='([0-1][0-9]|2[0-3])';
4425 my($mn)='([0-5][0-9])';
4426 my($s)=$mn;
4427
4428 if ($Cnf{"Internal"} == 0) {
4429 $ym=$md=$dh="";
4430 $hmn=$mns=":";
4431
4432 } elsif ($Cnf{"Internal"} == 1) {
4433 $ym=$md=$dh=$hmn=$mns="";
4434
4435 } elsif ($Cnf{"Internal"} == 2) {
4436 $ym=$md="-";
4437 $dh=" ";
4438 $hmn=$mns=":";
4439
4440 } else {
4441 confess "ERROR: Invalid internal format in Date_Split.\n";
4442 }
4443
4444 my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$";
4445
4446 if (not defined $date or $date eq '') {
4447 if ($definitely_valid) {
4448 die "bad date '$date'";
4449 } else {
4450 return $t;
4451 }
4452 }
4453
4454 if ($date =~ /$t/) {
4455 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
4456 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4457 $d_in_m[2]=29 if (&Date_LeapYear($y));
4458 if ($d>$d_in_m[$m]) {
4459 my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
4460 if ($definitely_valid) {
4461 die $msg;
4462 }
4463 else {
4464 warn $msg;
4465 return ();
4466 }
4467 }
4468 return ($y,$m,$d,$h,$mn,$s);
4469 }
4470
4471 if ($definitely_valid) {
4472 die "invalid date $date: doesn't match regexp $t";
4473 }
4474 return ();
4475}
4476
4477# This returns the date easter occurs on for a given year as ($month,$day).
4478# This is from the Calendar FAQ.
4479sub Date_Easter {
4480 my($y)=@_;
4481 $y=&Date_FixYear($y) if (length($y)==2);
4482
4483 my($c) = $y/100;
4484 my($g) = $y % 19;
4485 my($k) = ($c-17)/25;
4486 my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30;
4487 $i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11));
4488 my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7;
4489 my($l) = $i-$j;
4490 my($m) = 3 + ($l+40)/44;
4491 my($d) = $l + 28 - 31*($m/4);
4492 return ($m,$d);
4493}
4494
4495# This takes a list of years, months, WeekOfMonth's, and DayOfWeek's, and
4496# returns a list of dates. Optionally, a list of dates can be passed in as
4497# the 1st argument (with the 2nd argument the null list) and the year/month
4498# of these will be used.
4499sub Date_Recur_WoM {
4500 my($y,$m,$w,$d)=@_;
4501 my(@y)=@$y;
4502 my(@m)=@$m;
4503 my(@w)=@$w;
4504 my(@d)=@$d;
4505 my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
4506
4507 if (@m) {
4508 foreach $m (@m) {
4509 return () if (! &IsInt($m,1,12));
4510 }
4511
4512 @tmp=@tmp2=();
4513 foreach $y (@y) {
4514 foreach $m (@m) {
4515 push(@tmp,$y);
4516 push(@tmp2,$m);
4517 }
4518 }
4519
4520 @y=@tmp;
4521 @m=@tmp2;
4522
4523 } else {
4524 foreach $d0 (@y) {
4525 @tmp=&Date_Split($d0);
4526 return () if (! @tmp);
4527 push(@tmp2,$tmp[0]);
4528 push(@m,$tmp[1]);
4529 }
4530 @y=@tmp2;
4531 }
4532
4533 return () if (! @w);
4534 foreach $w (@w) {
4535 return () if ($w==0 || ! &IsInt($w,-5,5));
4536 }
4537
4538 if (@d) {
4539 foreach $d (@d) {
4540 return () if ($d==0 || ! &IsInt($d,-7,7));
4541 $d += 8 if ($d < 0);
4542 }
4543 }
4544
4545 @date=();
4546 foreach $y (@y) {
4547 $m=shift(@m);
4548
4549 # Find 1st day of this month and next month
4550 $date0=&Date_Join($y,$m,1,0,0,0);
4551 $date1=&DateCalc_DateDelta($date0,"+0:1:0:0:0:0:0");
4552
4553 foreach $d (@d) {
4554 # Find 1st occurence of DOW (in both months)
4555 $d0=&Date_GetNext($date0,$d,1);
4556 $d1=&Date_GetNext($date1,$d,1);
4557
4558 @tmp=();
4559 while (&Date_Cmp($d0,$d1)<0) {
4560 push(@tmp,$d0);
4561 $d0=&DateCalc_DateDelta($d0,"+0:0:1:0:0:0:0");
4562 }
4563
4564 @tmp2=();
4565 foreach $w (@w) {
4566 if ($w>0) {
4567 next if ($w > $#tmp+1);
4568 push(@tmp2,$tmp[$w-1]);
4569 } else {
4570 next if (-$w > $#tmp+1);
4571 push(@tmp2,$tmp[$#tmp+1+$w]);
4572 }
4573 }
4574 @tmp2=sort { Date_Cmp($a,$b) } @tmp2;
4575 push(@date,@tmp2);
4576 }
4577 }
4578
4579 @date;
4580}
4581
4582# This returns a sorted list of dates formed by adding/subtracting
4583# $delta to $dateb in the range $date0<=$d<$dateb. The first date in
4584# the list is actually the first date<$date0 and the last date in the
4585# list is the first date>=$date1 (because sometimes the set part will
4586# move the date back into the range).
4587sub Date_Recur {
4588 my($date0,$date1,$dateb,$delta)=@_;
4589 my(@ret,$d)=();
4590
4591 while (&Date_Cmp($dateb,$date0)<0) {
4592 $dateb=&DateCalc_DateDelta($dateb,$delta);
4593 }
4594 while (&Date_Cmp($dateb,$date1)>=0) {
4595 $dateb=&DateCalc_DateDelta($dateb,"-$delta");
4596 }
4597
4598 # Add the dates $date0..$dateb
4599 $d=$dateb;
4600 while (&Date_Cmp($d,$date0)>=0) {
4601 unshift(@ret,$d);
4602 $d=&DateCalc_DateDelta($d,"-$delta");
4603 }
4604 # Add the first date earler than the range
4605 unshift(@ret,$d);
4606
4607 # Add the dates $dateb..$date1
4608 $d=&DateCalc_DateDelta($dateb,$delta);
4609 while (&Date_Cmp($d,$date1)<0) {
4610 push(@ret,$d);
4611 $d=&DateCalc_DateDelta($d,$delta);
4612 }
4613 # Add the first date later than the range
4614 push(@ret,$d);
4615
4616 @ret;
4617}
4618
4619# This sets the values in each date of a recurrence.
4620#
4621# $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1",
4622# they are not set (and none of the larger elements are set).
4623sub Date_RecurSetTime {
4624 my($date0,$date1,$dates,$h,$m,$s)=@_;
4625 my(@dates)=@$dates;
4626 my(@h,@m,@s,$date,@tmp)=();
4627
4628 $m="-1" if ($s eq "-1");
4629 $h="-1" if ($m eq "-1");
4630
4631 if ($h ne "-1") {
4632 @h=&ReturnList($h);
4633 return () if ! (@h);
4634 @h=sort { $a<=>$b } (@h);
4635
4636 @tmp=();
4637 foreach $date (@dates) {
4638 foreach $h (@h) {
4639 push(@tmp,&Date_SetDateField($date,"h",$h,1));
4640 }
4641 }
4642 @dates=@tmp;
4643 }
4644
4645 if ($m ne "-1") {
4646 @m=&ReturnList($m);
4647 return () if ! (@m);
4648 @m=sort { $a<=>$b } (@m);
4649
4650 @tmp=();
4651 foreach $date (@dates) {
4652 foreach $m (@m) {
4653 push(@tmp,&Date_SetDateField($date,"mn",$m,1));
4654 }
4655 }
4656 @dates=@tmp;
4657 }
4658
4659 if ($s ne "-1") {
4660 @s=&ReturnList($s);
4661 return () if ! (@s);
4662 @s=sort { $a<=>$b } (@s);
4663
4664 @tmp=();
4665 foreach $date (@dates) {
4666 foreach $s (@s) {
4667 push(@tmp,&Date_SetDateField($date,"s",$s,1));
4668 }
4669 }
4670 @dates=@tmp;
4671 }
4672
4673 @tmp=();
4674 foreach $date (@dates) {
4675 push(@tmp,$date) if (&Date_Cmp($date,$date0)>=0 &&
4676 &Date_Cmp($date,$date1)<0 &&
4677 &Date_Split($date));
4678 }
4679
4680 @tmp;
4681}
4682
4683sub DateCalc_DateDate {
4684 print "DEBUG: DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
4685 my($D1,$D2,$mode)=@_;
4686 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4687 $mode=0 if (! defined $mode);
4688
4689 # Exact mode
4690 if ($mode==0) {
4691 my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split($D1, 1);
4692 my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split($D2, 1);
4693 my($i,@delta,$d,$delta,$y)=();
4694
4695 # form the delta for hour/min/sec
4696 $delta[4]=$h2-$h1;
4697 $delta[5]=$mn2-$mn1;
4698 $delta[6]=$s2-$s1;
4699
4700 # form the delta for yr/mon/day
4701 $delta[0]=$delta[1]=0;
4702 $d=0;
4703 if ($y2>$y1) {
4704 $d=&Date_DaysInYear($y1) - &Date_DayOfYear($m1,$d1,$y1);
4705 $d+=&Date_DayOfYear($m2,$d2,$y2);
4706 for ($y=$y1+1; $y<$y2; $y++) {
4707 $d+= &Date_DaysInYear($y);
4708 }
4709 } elsif ($y2<$y1) {
4710 $d=&Date_DaysInYear($y2) - &Date_DayOfYear($m2,$d2,$y2);
4711 $d+=&Date_DayOfYear($m1,$d1,$y1);
4712 for ($y=$y2+1; $y<$y1; $y++) {
4713 $d+= &Date_DaysInYear($y);
4714 }
4715 $d *= -1;
4716 } else {
4717 $d=&Date_DayOfYear($m2,$d2,$y2) - &Date_DayOfYear($m1,$d1,$y1);
4718 }
4719 $delta[2]=0;
4720 $delta[3]=$d;
4721
4722 for ($i=0; $i<7; $i++) {
4723 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4724 }
4725
4726 $delta=join(":",@delta);
4727 $delta=&Delta_Normalize($delta,0);
4728 return $delta;
4729 }
4730
4731 my($date1,$date2)=($D1,$D2);
4732 my($tmp,$sign,$err,@tmp)=();
4733
4734 # make sure both are work days
4735 if ($mode==2 || $mode==3) {
4736 $date1=&Date_NextWorkDay($date1,0,1);
4737 $date2=&Date_NextWorkDay($date2,0,1);
4738 }
4739
4740 # make sure date1 comes before date2
4741 if (&Date_Cmp($date1,$date2)>0) {
4742 $sign="-";
4743 $tmp=$date1;
4744 $date1=$date2;
4745 $date2=$tmp;
4746 } else {
4747 $sign="+";
4748 }
4749 if (&Date_Cmp($date1,$date2)==0) {
4750 return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
4751 return "+0:0:0:0:0:0:0";
4752 }
4753
4754 my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split($date1, 1);
4755 my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split($date2, 1);
4756 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0);
4757
4758 if ($mode != 3) {
4759
4760 # Do years
4761 $dy=$y2-$y1;
4762 $dm=0;
4763 if ($dy>0) {
4764 $tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0);
4765 if (&Date_Cmp($tmp,$date2)>0) {
4766 $dy--;
4767 $tmp=$date1;
4768 $tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0)
4769 if ($dy>0);
4770 $dm=12;
4771 }
4772 $date1=$tmp;
4773 }
4774
4775 # Do months
4776 $dm+=$m2-$m1;
4777 if ($dm>0) {
4778 $tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0);
4779 if (&Date_Cmp($tmp,$date2)>0) {
4780 $dm--;
4781 $tmp=$date1;
4782 $tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0)
4783 if ($dm>0);
4784 }
4785 $date1=$tmp;
4786 }
4787
4788 # At this point, check to see that we're on a business day again so that
4789 # Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month
4790 if ($mode==2) {
4791 if (! &Date_IsWorkDay($date1,0)) {
4792 $date1=&Date_NextWorkDay($date1,0,1);
4793 }
4794 }
4795 }
4796
4797 # Do days
4798 if ($mode==2 || $mode==3) {
4799 $dd=0;
4800 while (1) {
4801 $tmp=&Date_NextWorkDay($date1,1,1);
4802 if (&Date_Cmp($tmp,$date2)<=0) {
4803 $dd++;
4804 $date1=$tmp;
4805 } else {
4806 last;
4807 }
4808 }
4809
4810 } else {
4811 ($y1,$m1,$d1)=( &Date_Split($date1, 1) )[0..2];
4812 $dd=0;
4813 # If we're jumping across months, set $d1 to the first of the next month
4814 # (or possibly the 0th of next month which is equivalent to the last day
4815 # of this month)
4816 if ($m1!=$m2) {
4817 $d_in_m[2]=29 if (&Date_LeapYear($y1));
4818 $dd=$d_in_m[$m1]-$d1+1;
4819 $d1=1;
4820 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4821 if (&Date_Cmp($tmp,$date2)>0) {
4822 $dd--;
4823 $d1--;
4824 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4825 }
4826 $date1=$tmp;
4827 }
4828
4829 $ddd=0;
4830 if ($d1<$d2) {
4831 $ddd=$d2-$d1;
4832 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4833 if (&Date_Cmp($tmp,$date2)>0) {
4834 $ddd--;
4835 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4836 }
4837 $date1=$tmp;
4838 }
4839 $dd+=$ddd;
4840 }
4841
4842 # in business mode, make sure h1 comes before h2 (if not find delta between
4843 # now and end of day and move to start of next business day)
4844 $d1=( &Date_Split($date1, 1) )[2];
4845 $dh=$dmn=$ds=0;
4846 if ($mode==2 || $mode==3 and $d1 != $d2) {
4847 $tmp=&Date_SetTime($date1,$Cnf{"WorkDayEnd"});
4848 $tmp=&DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0")
4849 if ($Cnf{"WorkDay24Hr"});
4850 $tmp=&DateCalc_DateDate($date1,$tmp,0);
4851 ($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=&Delta_Split($tmp);
4852 $date1=&Date_NextWorkDay($date1,1,0);
4853 $date1=&Date_SetTime($date1,$Cnf{"WorkDayBeg"});
4854 $d1=( &Date_Split($date1, 1) )[2];
4855 confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2);
4856 }
4857
4858 # Hours, minutes, seconds
4859 $tmp=&DateCalc_DateDate($date1,$date2,0);
4860 @tmp=&Delta_Split($tmp);
4861 $dh += $tmp[4];
4862 $dmn += $tmp[5];
4863 $ds += $tmp[6];
4864
4865 $tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds";
4866 &Delta_Normalize($tmp,$mode);
4867}
4868
4869sub DateCalc_DeltaDelta {
4870 print "DEBUG: DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/);
4871 my($D1,$D2,$mode)=@_;
4872 my(@delta1,@delta2,$i,$delta,@delta)=();
4873 $mode=0 if (! defined $mode);
4874
4875 @delta1=&Delta_Split($D1);
4876 @delta2=&Delta_Split($D2);
4877 for ($i=0; $i<7; $i++) {
4878 $delta[$i]=$delta1[$i]+$delta2[$i];
4879 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4880 }
4881
4882 $delta=join(":",@delta);
4883 $delta=&Delta_Normalize($delta,$mode);
4884 return $delta;
4885}
4886
4887sub DateCalc_DateDelta {
4888 print "DEBUG: DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
4889 my($D1,$D2,$errref,$mode)=@_;
4890 my($date)=();
4891 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4892 my($h1,$m1,$h2,$m2,$len,$hh,$mm)=();
4893 $mode=0 if (! defined $mode);
4894
4895 if ($mode==2 || $mode==3) {
4896 $h1=$Curr{"WDBh"};
4897 $m1=$Curr{"WDBm"};
4898 $h2=$Curr{"WDEh"};
4899 $m2=$Curr{"WDEm"};
4900 $hh=$h2-$h1;
4901 $mm=$m2-$m1;
4902 if ($mm<0) {
4903 $hh--;
4904 $mm+=60;
4905 }
4906 }
4907
4908 # Date, delta
4909 my($y,$m,$d,$h,$mn,$s)=&Date_Split($D1, 1);
4910 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=&Delta_Split($D2);
4911
4912 # do the month/year part
4913 $y+=$dy;
4914 while (length($y)<4) {
4915 $y = "0$y";
4916 }
4917 &ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11
4918 $d_in_m[2]=29 if (&Date_LeapYear($y));
4919
4920 # if we have gone past the last day of a month, move the date back to
4921 # the last day of the month
4922 if ($d>$d_in_m[$m]) {
4923 $d=$d_in_m[$m];
4924 }
4925
4926 # do the week part
4927 if ($mode==0 || $mode==1) {
4928 $dd += $dw*7;
4929 } else {
4930 $date=&DateCalc_DateDelta(&Date_Join($y,$m,$d,$h,$mn,$s),
4931 "+0:0:$dw:0:0:0:0",0);
4932 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
4933 }
4934
4935 # in business mode, set the day to a work day at this point so the h/mn/s
4936 # stuff will work out
4937 if ($mode==2 || $mode==3) {
4938 $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
4939 $date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),0,1);
4940 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
4941 }
4942
4943 # seconds, minutes, hours
4944 &ModuloAddition(60,$ds,\$s,\$mn);
4945 if ($mode==2 || $mode==3) {
4946 while (1) {
4947 &ModuloAddition(60,$dmn,\$mn,\$h);
4948 $h+= $dh;
4949
4950 if ($h>$h2 or $h==$h2 && $mn>$m2) {
4951 $dh=$h-$h2;
4952 $dmn=$mn-$m2;
4953 $h=$h1;
4954 $mn=$m1;
4955 $dd++;
4956
4957 } elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
4958 $dh=$h-$h1;
4959 $dmn=$m1-$mn;
4960 $h=$h2;
4961 $mn=$m2;
4962 $dd--;
4963
4964 } elsif ($h==$h2 && $mn==$m2) {
4965 $dd++;
4966 $dh=-$hh;
4967 $dmn=-$mm;
4968
4969 } else {
4970 last;
4971 }
4972 }
4973
4974 } else {
4975 &ModuloAddition(60,$dmn,\$mn,\$h);
4976 &ModuloAddition(24,$dh,\$h,\$d);
4977 }
4978
4979 # If we have just gone past the last day of the month, we need to make
4980 # up for this:
4981 if ($d>$d_in_m[$m]) {
4982 $dd+= $d-$d_in_m[$m];
4983 $d=$d_in_m[$m];
4984 }
4985
4986 # days
4987 if ($mode==2 || $mode==3) {
4988 if ($dd>=0) {
4989 $date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),$dd,1);
4990 } else {
4991 $date=&Date_PrevWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1);
4992 }
4993 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
4994
4995 } else {
4996 $d_in_m[2]=29 if (&Date_LeapYear($y));
4997 $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
4998 $d += $dd;
4999 while ($d<1) {
5000 $m--;
5001 if ($m==0) {
5002 $m=12;
5003 $y--;
5004 if (&Date_LeapYear($y)) {
5005 $d_in_m[2]=29;
5006 } else {
5007 $d_in_m[2]=28;
5008 }
5009 }
5010 $d += $d_in_m[$m];
5011 }
5012 while ($d>$d_in_m[$m]) {
5013 $d -= $d_in_m[$m];
5014 $m++;
5015 if ($m==13) {
5016 $m=1;
5017 $y++;
5018 if (&Date_LeapYear($y)) {
5019 $d_in_m[2]=29;
5020 } else {
5021 $d_in_m[2]=28;
5022 }
5023 }
5024 }
5025 }
5026
5027 if ($y<0 or $y>9999) {
5028 $$errref=3;
5029 return;
5030 }
5031 &Date_Join($y,$m,$d,$h,$mn,$s);
5032}
5033
5034sub Date_UpdateHolidays {
5035 print "DEBUG: Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
5036 my($year)=@_;
5037 $Holiday{"year"}=$year;
5038 $Holiday{"dates"}{$year}={};
5039
5040 my($date,$delta,$err)=();
5041 my($key,@tmp,$tmp);
5042
5043 foreach $key (keys %{ $Holiday{"desc"} }) {
5044 @tmp=&Recur_Split($key);
5045 if (@tmp) {
5046 $tmp=&ParseDateString("${year}010100:00:00");
5047 ($date)=&ParseRecur($key,$tmp,$tmp,($year+1)."-01-01");
5048 next if (! $date);
5049
5050 } elsif ($key =~ /^(.*)([+-].*)$/) {
5051 # Date +/- Delta
5052 ($date,$delta)=($1,$2);
5053 $tmp=&ParseDateString("$date $year");
5054 if ($tmp) {
5055 $date=$tmp;
5056 } else {
5057 $date=&ParseDateString($date);
5058 next if ($date !~ /^$year/);
5059 }
5060 $date=&DateCalc($date,$delta,\$err,0);
5061
5062 } else {
5063 # Date
5064 $date=$key;
5065 $tmp=&ParseDateString("$date $year");
5066 if ($tmp) {
5067 $date=$tmp;
5068 } else {
5069 $date=&ParseDateString($date);
5070 next if ($date !~ /^$year/);
5071 }
5072 }
5073 $Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key};
5074 }
5075}
5076
5077# This sets a Date::Manip config variable.
5078sub Date_SetConfigVariable {
5079 print "DEBUG: Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/);
5080 my($var,$val)=@_;
5081
5082 # These are most appropriate for command line options instead of in files.
5083 $Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i);
5084 $Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i);
5085 $Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i);
5086 &EraseHolidays(), return if ($var =~ /^EraseHolidays$/i);
5087 $Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i);
5088 $Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i);
5089
5090 $Curr{"InitLang"}=1,
5091 $Cnf{"Language"}=$val, return if ($var =~ /^Language$/i);
5092 $Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i);
5093 $Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i);
5094 $Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i);
5095 $Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i);
5096 $Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i);
5097 $Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i);
5098 $Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i);
5099 $Cnf{"WorkDayBeg"}=$val,
5100 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
5101 $Cnf{"WorkDayEnd"}=$val,
5102 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i);
5103 $Cnf{"WorkDay24Hr"}=$val,
5104 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i);
5105 $Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i);
5106 $Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i);
5107 $Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i);
5108 $Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i);
5109 $Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i);
5110 $Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i);
5111 $Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i);
5112 $Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i);
5113 $Cnf{"TodayIsMidnight"}=$val, return if ($var =~ /^TodayIsMidnight$/i);
5114
5115 confess "ERROR: Unknown configuration variable $var in Date::Manip.\n";
5116}
5117
5118sub EraseHolidays {
5119 print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
5120
5121 $Cnf{"EraseHolidays"}=0;
5122 delete $Holiday{"list"};
5123 $Holiday{"list"}={};
5124 delete $Holiday{"desc"};
5125 $Holiday{"desc"}={};
5126 $Holiday{"dates"}={};
5127}
5128
5129# This returns a pointer to a list of times and events in the format
5130# [ date [ events ], date, [ events ], ... ]
5131# where each list of events are events that are in effect at the date
5132# immediately preceding the list.
5133#
5134# This takes either one date or two dates as arguments.
5135sub Events_Calc {
5136 print "DEBUG: Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
5137
5138 my($date0,$date1)=@_;
5139
5140 my($tmp);
5141 $date0=&ParseDateString($date0);
5142 return undef if (! $date0);
5143 if ($date1) {
5144 $date1=&ParseDateString($date1);
5145 if (&Date_Cmp($date0,$date1)>0) {
5146 $tmp=$date1;
5147 $date1=$date0;
5148 $date0=$tmp;
5149 }
5150 } else {
5151 $date1=&DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1");
5152 }
5153
5154 #
5155 # [ d0,d1,del,name ] => [ d0, d1+del )
5156 # [ d0,0,del,name ] => [ d0, d0+del )
5157 #
5158 my(%ret,$d0,$d1,$del,$name,$c0,$c1);
5159 my(@tmp)=@{ $Events{"dates"} };
5160 DATE: while (@tmp) {
5161 ($d0,$d1,$del,$name)=splice(@tmp,0,4);
5162 $d0=&ParseDateString($d0);
5163 $d1=&ParseDateString($d1) if ($d1);
5164 $del=&ParseDateDelta($del) if ($del);
5165 if ($d1) {
5166 if ($del) {
5167 $d1=&DateCalc_DateDelta($d1,$del);
5168 }
5169 } else {
5170 $d1=&DateCalc_DateDelta($d0,$del);
5171 }
5172 if (&Date_Cmp($d0,$d1)>0) {
5173 $tmp=$d1;
5174 $d1=$d0;
5175 $d0=$tmp;
5176 }
5177 # [ date0,date1 )
5178 # [ d0,d1 ) OR [ d0,d1 )
5179 next DATE if (&Date_Cmp($d1,$date0)<=0 ||
5180 &Date_Cmp($d0,$date1)>=0);
5181 # [ date0,date1 )
5182 # [ d0,d1 )
5183 # [ d0, d1 )
5184 if (&Date_Cmp($d0,$date0)<=0) {
5185 push @{ $ret{$date0} },$name;
5186 push @{ $ret{$d1} },"!$name" if (&Date_Cmp($d1,$date1)<0);
5187 next DATE;
5188 }
5189 # [ date0,date1 )
5190 # [ d0,d1 )
5191 if (&Date_Cmp($d1,$date1)>=0) {
5192 push @{ $ret{$d0} },$name;
5193 next DATE;
5194 }
5195 # [ date0,date1 )
5196 # [ d0,d1 )
5197 push @{ $ret{$d0} },$name;
5198 push @{ $ret{$d1} },"!$name";
5199 }
5200
5201 #
5202 # [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
5203 #
5204 my($rec,$del0,$del1,@d);
5205 @tmp=@{ $Events{"recur"} };
5206 RECUR: while (@tmp) {
5207 ($rec,$del0,$del1,$name)=splice(@tmp,0,4);
5208 @d=();
5209
5210 }
5211
5212 # Sort them AND take into account the "!$name" entries.
5213 my(%tmp,$date,@tmp2,@ret);
5214 @d=sort { &Date_Cmp($a,$b) } keys %ret;
5215 foreach $date (@d) {
5216 @tmp=@{ $ret{$date} };
5217 @tmp2=();
5218 foreach $tmp (@tmp) {
5219 push(@tmp2,$tmp), next if ($tmp =~ /^!/);
5220 $tmp{$tmp}=1;
5221 }
5222 foreach $tmp (@tmp2) {
5223 $tmp =~ s/^!//;
5224 delete $tmp{$tmp};
5225 }
5226 push(@ret,$date,[ keys %tmp ]);
5227 }
5228
5229 %tmp = @ret;
5230 @ret = ();
5231 foreach my $d (sort { Date_Cmp($a,$b) } keys %tmp) {
5232 my $e = $tmp{$d};
5233 push @ret,($d,[ sort @$e ]);
5234 }
5235 return \@ret;
5236}
5237
5238# This parses the raw events list
5239sub Events_ParseRaw {
5240 print "DEBUG: Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
5241
5242 # Only need to be parsed once
5243 my($force)=@_;
5244 $Events{"parsed"}=0 if ($force);
5245 return if ($Events{"parsed"});
5246 $Events{"parsed"}=1;
5247
5248 my(@events)=@{ $Events{"raw"} };
5249 my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
5250 $recur);
5251 EVENT: while (@events) {
5252 ($event,$name)=splice(@events,0,2);
5253 @event=split(/\s*;\s*/,$event);
5254
5255 if ($#event == 0) {
5256
5257 if ($date0=&ParseDateString($event[0])) {
5258 #
5259 # date = event
5260 #
5261 $tmp=&ParseDateString("$event[0] 00:00:00");
5262 if ($tmp && $tmp eq $date0) {
5263 $delta="+0:0:0:1:0:0:0";
5264 } else {
5265 $delta="+0:0:0:0:1:0:0";
5266 }
5267 push @{ $Events{"dates"} },($date0,0,$delta,$name);
5268
5269 } elsif ($recur=&ParseRecur($event[0])) {
5270 #
5271 # recur = event
5272 #
5273 ($recur0,$recur1)=&Recur_Split($recur);
5274 if ($recur0) {
5275 if ($recur1) {
5276 $r="$recur0:$recur1";
5277 } else {
5278 $r=$recur0;
5279 }
5280 } else {
5281 $r=$recur1;
5282 }
5283 (@recur)=split(/:/,$r);
5284 if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
5285 $delta="+0:0:0:1:0:0:0";
5286 } else {
5287 $delta="+0:0:0:0:1:0:0";
5288 }
5289 push @{ $Events{"recur"} },($recur,0,$delta,$name);
5290
5291 } else {
5292 # ??? = event
5293 warn "WARNING: illegal event ignored [ @event ]\n";
5294 next EVENT;
5295 }
5296
5297 } elsif ($#event == 1) {
5298
5299 if ($date0=&ParseDateString($event[0])) {
5300
5301 if ($date1=&ParseDateString($event[1])) {
5302 #
5303 # date ; date = event
5304 #
5305 $tmp=&ParseDateString("$event[1] 00:00:00");
5306 if ($tmp && $tmp eq $date1) {
5307 $date1=&DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0");
5308 }
5309 push @{ $Events{"dates"} },($date0,$date1,0,$name);
5310
5311 } elsif ($delta=&ParseDateDelta($event[1])) {
5312 #
5313 # date ; delta = event
5314 #
5315 push @{ $Events{"dates"} },($date0,0,$delta,$name);
5316
5317 } else {
5318 # date ; ??? = event
5319 warn "WARNING: illegal event ignored [ @event ]\n";
5320 next EVENT;
5321 }
5322
5323 } elsif ($recur=&ParseRecur($event[0])) {
5324
5325 if ($delta=&ParseDateDelta($event[1])) {
5326 #
5327 # recur ; delta = event
5328 #
5329 push @{ $Events{"recur"} },($recur,0,$delta,$name);
5330
5331 } else {
5332 # recur ; ??? = event
5333 warn "WARNING: illegal event ignored [ @event ]\n";
5334 next EVENT;
5335 }
5336
5337 } else {
5338 # ??? ; ??? = event
5339 warn "WARNING: illegal event ignored [ @event ]\n";
5340 next EVENT;
5341 }
5342
5343 } else {
5344 # date ; delta0 ; delta1 = event
5345 # recur ; delta0 ; delta1 = event
5346 # ??? ; ??? ; ??? ... = event
5347 warn "WARNING: illegal event ignored [ @event ]\n";
5348 next EVENT;
5349 }
5350 }
5351}
5352
5353# This reads an init file.
5354sub Date_InitFile {
5355 print "DEBUG: Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
5356 my($file)=@_;
5357 my($in)=new IO::File;
5358 local($_)=();
5359 my($section)="vars";
5360 my($var,$val,$recur,$name)=();
5361
5362 $in->open($file) || return;
5363 while(defined ($_=<$in>)) {
5364 chomp;
5365 s/^\s+//;
5366 s/\s+$//;
5367 next if (! $_ or /^\#/);
5368
5369 if (/^\*holiday/i) {
5370 $section="holiday";
5371 &EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
5372 next;
5373 } elsif (/^\*events/i) {
5374 $section="events";
5375 next;
5376 }
5377
5378 if ($section =~ /var/i) {
5379 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5380 if (! /(.*\S)\s*=\s*(.*)$/);
5381 ($var,$val)=($1,$2);
5382 &Date_SetConfigVariable($var,$val);
5383
5384 } elsif ($section =~ /holiday/i) {
5385 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5386 if (! /(.*\S)\s*=\s*(.*)$/);
5387 ($recur,$name)=($1,$2);
5388 $name="" if (! defined $name);
5389 $Holiday{"desc"}{$recur}=$name;
5390
5391 } elsif ($section =~ /events/i) {
5392 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5393 if (! /(.*\S)\s*=\s*(.*)$/);
5394 ($val,$var)=($1,$2);
5395 push @{ $Events{"raw"} },($val,$var);
5396
5397 } else {
5398 # A section not currently used by Date::Manip (but may be
5399 # used by some extension to it).
5400 next;
5401 }
5402 }
5403 close($in);
5404}
5405
5406# $flag=&Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
5407# Returns 1 if any of the fields are bad. All fields are optional, and
5408# all possible checks are done on the data. If a field is not passed in,
5409# it is set to default values. If data is missing, appropriate defaults
5410# are supplied.
5411sub Date_TimeCheck {
5412 print "DEBUG: Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
5413 my($h,$mn,$s,$ampm)=@_;
5414 my($tmp1,$tmp2,$tmp3)=();
5415
5416 $$h="" if (! defined $$h);
5417 $$mn="" if (! defined $$mn);
5418 $$s="" if (! defined $$s);
5419 $$ampm="" if (! defined $$ampm);
5420 $$ampm=uc($$ampm) if ($$ampm);
5421
5422 # Check hour
5423 $tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
5424 $tmp2="";
5425 if ($$ampm =~ /^$tmp1$/i) {
5426 $tmp3=$Lang{$Cnf{"Language"}}{"AM"};
5427 $tmp2="AM" if ($$ampm =~ /^$tmp3$/i);
5428 $tmp3=$Lang{$Cnf{"Language"}}{"PM"};
5429 $tmp2="PM" if ($$ampm =~ /^$tmp3$/i);
5430 } elsif ($$ampm) {
5431 return 1;
5432 }
5433 if ($tmp2 eq "AM" || $tmp2 eq "PM") {
5434 $$h="0$$h" if (length($$h)==1);
5435 return 1 if ($$h<1 || $$h>12);
5436 $$h="00" if ($tmp2 eq "AM" and $$h==12);
5437 $$h += 12 if ($tmp2 eq "PM" and $$h!=12);
5438 } else {
5439 $$h="00" if ($$h eq "");
5440 $$h="0$$h" if (length($$h)==1);
5441 return 1 if (! &IsInt($$h,0,23));
5442 $tmp2="AM" if ($$h<12);
5443 $tmp2="PM" if ($$h>=12);
5444 }
5445 $$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
5446 $$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
5447
5448 # Check minutes
5449 $$mn="00" if ($$mn eq "");
5450 $$mn="0$$mn" if (length($$mn)==1);
5451 return 1 if (! &IsInt($$mn,0,59));
5452
5453 # Check seconds
5454 $$s="00" if ($$s eq "");
5455 $$s="0$$s" if (length($$s)==1);
5456 return 1 if (! &IsInt($$s,0,59));
5457
5458 return 0;
5459}
5460
5461# $flag=&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
5462# Returns 1 if any of the fields are bad. All fields are optional, and
5463# all possible checks are done on the data. If a field is not passed in,
5464# it is set to default values. If data is missing, appropriate defaults
5465# are supplied.
5466#
5467# If the flag UpdateHolidays is set, the year is set to
5468# CurrHolidayYear.
5469sub Date_DateCheck {
5470 print "DEBUG: Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/);
5471 my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_;
5472 my($tmp1,$tmp2,$tmp3)=();
5473
5474 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
5475 my($curr_y)=$Curr{"Y"};
5476 my($curr_m)=$Curr{"M"};
5477 my($curr_d)=$Curr{"D"};
5478 $$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d);
5479 $$y="" if (! defined $$y);
5480 $$m="" if (! defined $$m);
5481 $$d="" if (! defined $$d);
5482 $$wk="" if (! defined $$wk);
5483 $$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq "");
5484
5485 # Check year.
5486 $$y=$curr_y if ($$y eq "");
5487 $$y=&Date_FixYear($$y) if (length($$y)<4);
5488 return 1 if (! &IsInt($$y,0,9999));
5489 $d_in_m[2]=29 if (&Date_LeapYear($$y));
5490
5491 # Check month
5492 $$m=$curr_m if ($$m eq "");
5493 $$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}
5494 if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)});
5495 $$m="0$$m" if (length($$m)==1);
5496 return 1 if (! &IsInt($$m,1,12));
5497
5498 # Check day
5499 $$d="01" if ($$d eq "");
5500 $$d="0$$d" if (length($$d)==1);
5501 return 1 if (! &IsInt($$d,1,$d_in_m[$$m]));
5502 if ($$wk) {
5503 $tmp1=&Date_DayOfWeek($$m,$$d,$$y);
5504 $tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}
5505 if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)});
5506 return 1 if ($tmp1 != $tmp2);
5507 }
5508
5509 return &Date_TimeCheck($h,$mn,$s,$ampm);
5510}
5511
5512# Takes a year in 2 digit form and returns it in 4 digit form
5513sub Date_FixYear {
5514 print "DEBUG: Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
5515 my($y)=@_;
5516 my($curr_y)=$Curr{"Y"};
5517 $y=$curr_y if (! defined $y or ! $y);
5518 return $y if (length($y)==4);
5519 confess "ERROR: Invalid year ($y)\n" if (length($y)!=2);
5520 my($y1,$y2)=();
5521
5522 if (lc($Cnf{"YYtoYYYY"}) eq "c") {
5523 $y1=substring($y,0,2);
5524 $y="$y1$y";
5525
5526 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
5527 $y1=$1;
5528 $y="$y1$y";
5529
5530 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
5531 $y1="$1$2";
5532 $y ="$1$y";
5533 $y += 100 if ($y<$y1);
5534
5535 } else {
5536 $y1=$curr_y-$Cnf{"YYtoYYYY"};
5537 $y2=$y1+99;
5538 $y="19$y";
5539 while ($y<$y1) {
5540 $y+=100;
5541 }
5542 while ($y>$y2) {
5543 $y-=100;
5544 }
5545 }
5546 $y;
5547}
5548
5549# &Date_NthWeekOfYear($y,$n);
5550# Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
5551# year.
5552# &Date_NthWeekOfYear($y,$n,$dow,$flag);
5553# Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag
5554# is nil, the first DoW of the year may actually be in the previous
5555# year (since the 1st week may include days from the previous year).
5556# If flag is non-nil, the 1st DoW of the year refers to the 1st one
5557# actually in the year
5558sub Date_NthWeekOfYear {
5559 print "DEBUG: Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
5560 my($y,$n,$dow,$flag)=@_;
5561 my($m,$d,$err,$tmp,$date,%dow)=();
5562 $y=$Curr{"Y"} if (! defined $y or ! $y);
5563 $n=1 if (! defined $n or $n eq "");
5564 return () if ($n<0 || $n>53);
5565 if (defined $dow) {
5566 $dow=lc($dow);
5567 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
5568 $dow=$dow{$dow} if (exists $dow{$dow});
5569 return () if ($dow<1 || $dow>7);
5570 $flag="" if (! defined $flag);
5571 } else {
5572 $dow="";
5573 $flag="";
5574 }
5575
5576 $y=&Date_FixYear($y) if (length($y)<4);
5577 if ($Cnf{"Jan1Week1"}) {
5578 $date=&Date_Join($y,1,1,0,0,0);
5579 } else {
5580 $date=&Date_Join($y,1,4,0,0,0);
5581 }
5582 $date=&Date_GetPrev($date,$Cnf{"FirstDay"},1);
5583 $date=&Date_GetNext($date,$dow,1) if ($dow ne "");
5584
5585 if ($flag) {
5586 ($tmp)=&Date_Split($date, 1);
5587 $n++ if ($tmp != $y);
5588 }
5589
5590 if ($n>1) {
5591 $date=&DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0);
5592 } elsif ($n==0) {
5593 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0);
5594 }
5595 ($y,$m,$d)=&Date_Split($date, 1);
5596 ($y,$m,$d);
5597}
5598
5599########################################################################
5600# LANGUAGE INITIALIZATION
5601########################################################################
5602
5603# 8-bit international characters can be gotten by "\xXX". I don't know
5604# how to get 16-bit characters. I've got to read up on perllocale.
5605sub Char_8Bit {
5606 my($hash)=@_;
5607
5608 # grave `
5609 # A` 00c0 a` 00e0
5610 # E` 00c8 e` 00e8
5611 # I` 00cc i` 00ec
5612 # O` 00d2 o` 00f2
5613 # U` 00d9 u` 00f9
5614 # W` 1e80 w` 1e81
5615 # Y` 1ef2 y` 1ef3
5616
5617 $$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE
5618 $$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE
5619 $$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE
5620 $$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE
5621 $$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE
5622 $$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE
5623 $$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE
5624 $$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE
5625 $$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE
5626 $$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE
5627
5628 # acute '
5629 # A' 00c1 a' 00e1
5630 # C' 0106 c' 0107
5631 # E' 00c9 e' 00e9
5632 # I' 00cd i' 00ed
5633 # L' 0139 l' 013a
5634 # N' 0143 n' 0144
5635 # O' 00d3 o' 00f3
5636 # R' 0154 r' 0155
5637 # S' 015a s' 015b
5638 # U' 00da u' 00fa
5639 # W' 1e82 w' 1e83
5640 # Y' 00dd y' 00fd
5641 # Z' 0179 z' 017a
5642
5643 $$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE
5644 $$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE
5645 $$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE
5646 $$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE
5647 $$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE
5648 $$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE
5649 $$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE
5650 $$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE
5651 $$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE
5652 $$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE
5653 $$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE
5654 $$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE
5655
5656 # double acute " "
5657 # O" 0150 o" 0151
5658 # U" 0170 u" 0171
5659
5660 # circumflex ^
5661 # A^ 00c2 a^ 00e2
5662 # C^ 0108 c^ 0109
5663 # E^ 00ca e^ 00ea
5664 # G^ 011c g^ 011d
5665 # H^ 0124 h^ 0125
5666 # I^ 00ce i^ 00ee
5667 # J^ 0134 j^ 0135
5668 # O^ 00d4 o^ 00f4
5669 # S^ 015c s^ 015d
5670 # U^ 00db u^ 00fb
5671 # W^ 0174 w^ 0175
5672 # Y^ 0176 y^ 0177
5673
5674 $$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
5675 $$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
5676 $$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
5677 $$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
5678 $$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
5679 $$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX
5680 $$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX
5681 $$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX
5682 $$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX
5683 $$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX
5684
5685 # tilde ~
5686 # A~ 00c3 a~ 00e3
5687 # I~ 0128 i~ 0129
5688 # N~ 00d1 n~ 00f1
5689 # O~ 00d5 o~ 00f5
5690 # U~ 0168 u~ 0169
5691
5692 $$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE
5693 $$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE
5694 $$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE
5695 $$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE
5696 $$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE
5697 $$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE
5698
5699 # macron -
5700 # A- 0100 a- 0101
5701 # E- 0112 e- 0113
5702 # I- 012a i- 012b
5703 # O- 014c o- 014d
5704 # U- 016a u- 016b
5705
5706 # breve ( [half circle up]
5707 # A( 0102 a( 0103
5708 # G( 011e g( 011f
5709 # U( 016c u( 016d
5710
5711 # dot .
5712 # C. 010a c. 010b
5713 # E. 0116 e. 0117
5714 # G. 0120 g. 0121
5715 # I. 0130
5716 # Z. 017b z. 017c
5717
5718 # diaeresis : [side by side dots]
5719 # A: 00c4 a: 00e4
5720 # E: 00cb e: 00eb
5721 # I: 00cf i: 00ef
5722 # O: 00d6 o: 00f6
5723 # U: 00dc u: 00fc
5724 # W: 1e84 w: 1e85
5725 # Y: 0178 y: 00ff
5726
5727 $$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS
5728 $$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS
5729 $$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS
5730 $$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS
5731 $$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS
5732 $$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS
5733 $$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS
5734 $$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS
5735 $$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS
5736 $$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS
5737 $$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS
5738
5739 # ring o
5740 # U0 016e u0 016f
5741
5742 # cedilla , [squiggle down and left below the letter]
5743 # ,C 00c7 ,c 00e7
5744 # ,G 0122 ,g 0123
5745 # ,K 0136 ,k 0137
5746 # ,L 013b ,l 013c
5747 # ,N 0145 ,n 0146
5748 # ,R 0156 ,r 0157
5749 # ,S 015e ,s 015f
5750 # ,T 0162 ,t 0163
5751
5752 $$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA
5753 $$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA
5754
5755 # ogonek ; [squiggle down and right below the letter]
5756 # A; 0104 a; 0105
5757 # E; 0118 e; 0119
5758 # I; 012e i; 012f
5759 # U; 0172 u; 0173
5760
5761 # caron < [little v on top]
5762 # A< 01cd a< 01ce
5763 # C< 010c c< 010d
5764 # D< 010e d< 010f
5765 # E< 011a e< 011b
5766 # L< 013d l< 013e
5767 # N< 0147 n< 0148
5768 # R< 0158 r< 0159
5769 # S< 0160 s< 0161
5770 # T< 0164 t< 0165
5771 # Z< 017d z< 017e
5772
5773
5774 # Other characters
5775
5776 # First character is below, 2nd character is above
5777 $$hash{"||"} = "\xa6"; # BROKEN BAR
5778 $$hash{" :"} = "\xa8"; # DIAERESIS
5779 $$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR
5780 #$$hash{" -"}= "\xaf"; # MACRON (narrow bar)
5781 $$hash{" -"} = "\xad"; # HYPHEN (wide bar)
5782 $$hash{" o"} = "\xb0"; # DEGREE SIGN
5783 $$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN
5784 $$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE
5785 $$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO
5786 $$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE
5787 $$hash{" '"} = "\xb4"; # ACUTE ACCENT
5788 $$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR
5789 $$hash{" ."} = "\xb7"; # MIDDLE DOT
5790 $$hash{", "} = "\xb8"; # CEDILLA
5791 $$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE
5792 $$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE
5793 $$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH
5794
5795 # upside down characters
5796
5797 $$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
5798 $$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
5799
5800 # overlay characters
5801
5802 $$hash{"X o"} = "\xa4"; # CURRENCY SIGN
5803 $$hash{"Y ="} = "\xa5"; # YEN SIGN
5804 $$hash{"S o"} = "\xa7"; # SECTION SIGN
5805 $$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright
5806 $$hash{"O R"} = "\xae"; # REGISTERED SIGN
5807 $$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH
5808 $$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE
5809 $$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE
5810
5811 # special names
5812
5813 $$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER
5814 $$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF
5815 $$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS
5816 $$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK
5817 $$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK
5818 $$hash{"cent"}= "\xa2"; # CENT SIGN
5819 $$hash{"lb"} = "\xa3"; # POUND SIGN
5820 $$hash{"mu"} = "\xb5"; # MICRO SIGN
5821 $$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S
5822 $$hash{"para"}= "\xb6"; # PILCROW SIGN
5823 $$hash{"-|"} = "\xac"; # NOT SIGN
5824 $$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE
5825 $$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE
5826 $$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN
5827 $$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN
5828 $$hash{"/"} = "\xf7"; # DIVISION SIGN
5829 $$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN
5830}
5831
5832# $hashref = &Date_Init_LANGUAGE;
5833# This returns a hash containing all of the initialization for a
5834# specific language. The hash elements are:
5835#
5836# @ month_name full month names January February ...
5837# @ month_abb month abbreviations Jan Feb ...
5838# @ day_name day names Monday Tuesday ...
5839# @ day_abb day abbreviations Mon Tue ...
5840# @ day_char day character abbrevs M T ...
5841# @ am AM notations
5842# @ pm PM notations
5843#
5844# @ num_suff number with suffix 1st 2nd ...
5845# @ num_word numbers spelled out first second ...
5846#
5847# $ now words which mean now now ...
5848# $ today words which mean today today ...
5849# $ last words which mean last last final ...
5850# $ each words which mean each each every ...
5851# $ of of (as in a member of) in of ...
5852# ex. 4th day OF June
5853# $ at at 4:00 at
5854# $ on on Sunday on
5855# $ future in the future in
5856# $ past in the past ago
5857# $ next next item next
5858# $ prev previous item last previous
5859# $ later 2 hours later
5860#
5861# % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 }
5862# % times a hash of times { noon->12:00:00 ... }
5863#
5864# $ years words for year y yr year ...
5865# $ months words for month
5866# $ weeks words for week
5867# $ days words for day
5868# $ hours words for hour
5869# $ minutes words for minute
5870# $ seconds words for second
5871# % replace
5872# The replace element is quite important, but a bit tricky. In
5873# English (and probably other languages), one of the abbreviations
5874# for the word month that would be nice is "m". The problem is that
5875# "m" matches the "m" in "minute" which causes the string to be
5876# improperly matched in some cases. Hence, the list of abbreviations
5877# for month is given as:
5878# "mon month months"
5879# In order to allow you to enter "m", replacements can be done.
5880# $replace is a list of pairs of words which are matched and replaced
5881# AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that
5882# the entire word "m" will be replaced with "month". This allows the
5883# desired abbreviation to be used. Make sure that replace contains
5884# an even number of words (i.e. all must be pairs). Any time a
5885# desired abbreviation matches the start of any other, it has to go
5886# here.
5887#
5888# $ exact exact mode exactly
5889# $ approx approximate mode approximately
5890# $ business business mode business
5891#
5892# r sephm hour/minute separator (?::)
5893# r sepms minute/second separator (?::)
5894# r sepss second/fraction separator (?:[.:])
5895#
5896# Elements marked with an asterix (@) are returned as a set of lists.
5897# Each list contains the strings for each element. The first set is used
5898# when the 7-bit ASCII (US) character set is wanted. The 2nd set is used
5899# when an international character set is available. Both of the 1st two
5900# sets should be complete (but the 2nd list can be left empty to force the
5901# first set to be used always). The 3rd set and later can be partial sets
5902# if desired.
5903#
5904# Elements marked with a dollar ($) are returned as a simple list of words.
5905#
5906# Elements marked with a percent (%) are returned as a hash list.
5907#
5908# Elements marked with (r) are regular expression elements which must not
5909# create a back reference.
5910#
5911# ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in
5912# every language.
5913
5914sub Date_Init_English {
5915 print "DEBUG: Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
5916 my($d)=@_;
5917
5918 $$d{"month_name"}=
5919 [["January","February","March","April","May","June",
5920 "July","August","September","October","November","December"]];
5921
5922 $$d{"month_abb"}=
5923 [["Jan","Feb","Mar","Apr","May","Jun",
5924 "Jul","Aug","Sep","Oct","Nov","Dec"],
5925 [],
5926 ["","","","","","","","","Sept"]];
5927
5928 $$d{"day_name"}=
5929 [["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
5930 $$d{"day_abb"}=
5931 [["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
5932 ["", "Tues","", "Thur","", "", ""]];
5933 $$d{"day_char"}=
5934 [["M","T","W","Th","F","Sa","S"]];
5935
5936 $$d{"num_suff"}=
5937 [["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th",
5938 "11th","12th","13th","14th","15th","16th","17th","18th","19th","20th",
5939 "21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th",
5940 "31st"]];
5941 $$d{"num_word"}=
5942 [["first","second","third","fourth","fifth","sixth","seventh","eighth",
5943 "ninth","tenth","eleventh","twelfth","thirteenth","fourteenth",
5944 "fifteenth","sixteenth","seventeenth","eighteenth","nineteenth",
5945 "twentieth","twenty-first","twenty-second","twenty-third",
5946 "twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh",
5947 "twenty-eighth","twenty-ninth","thirtieth","thirty-first"]];
5948
5949 $$d{"now"} =["now"];
5950 $$d{"today"} =["today"];
5951 $$d{"last"} =["last","final"];
5952 $$d{"each"} =["each","every"];
5953 $$d{"of"} =["in","of"];
5954 $$d{"at"} =["at"];
5955 $$d{"on"} =["on"];
5956 $$d{"future"} =["in"];
5957 $$d{"past"} =["ago"];
5958 $$d{"next"} =["next"];
5959 $$d{"prev"} =["previous","last"];
5960 $$d{"later"} =["later"];
5961
5962 $$d{"exact"} =["exactly"];
5963 $$d{"approx"} =["approximately"];
5964 $$d{"business"}=["business"];
5965
5966 $$d{"offset"} =["yesterday","-0:0:0:1:0:0:0","tomorrow","+0:0:0:1:0:0:0","overmorrow","+0:0:0:2:0:0:0"];
5967 $$d{"times"} =["noon","12:00:00","midnight","00:00:00"];
5968
5969 $$d{"years"} =["y","yr","year","yrs","years"];
5970 $$d{"months"} =["mon","month","months"];
5971 $$d{"weeks"} =["w","wk","wks","week","weeks"];
5972 $$d{"days"} =["d","day","days"];
5973 $$d{"hours"} =["h","hr","hrs","hour","hours"];
5974 $$d{"minutes"} =["mn","min","minute","minutes"];
5975 $$d{"seconds"} =["s","sec","second","seconds"];
5976 $$d{"replace"} =["m","month"];
5977
5978 $$d{"sephm"} =':';
5979 $$d{"sepms"} =':';
5980 $$d{"sepss"} ='[.:]';
5981
5982 $$d{"am"} = ["AM","A.M."];
5983 $$d{"pm"} = ["PM","P.M."];
5984}
5985
5986sub Date_Init_Italian {
5987 print "DEBUG: Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
5988 my($d)=@_;
5989 my(%h)=();
5990 &Char_8Bit(\%h);
5991 my($i)=$h{"i`"};
5992
5993 $$d{"month_name"}=
5994 [[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
5995 Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
5996
5997 $$d{"month_abb"}=
5998 [[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
5999
6000 $$d{"day_name"}=
6001 [[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
6002 [qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
6003 $$d{"day_abb"}=
6004 [[qw(Lun Mar Mer Gio Ven Sab Dom)]];
6005 $$d{"day_char"}=
6006 [[qw(L Ma Me G V S D)]];
6007
6008 $$d{"num_suff"}=
6009 [[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo
6010 16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo
6011 29mo 3mo 31mo)]];
6012 $$d{"num_word"}=
6013 [[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo
6014 undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo
6015 sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo
6016 ventunesimo ventiduesimo ventitreesimo ventiquattresimo
6017 venticinquesimo ventiseiesimo ventisettesimo ventottesimo
6018 ventinovesimo trentesimo trentunesimo)]];
6019
6020 $$d{"now"} =[qw(adesso)];
6021 $$d{"today"} =[qw(oggi)];
6022 $$d{"last"} =[qw(ultimo)];
6023 $$d{"each"} =[qw(ogni)];
6024 $$d{"of"} =[qw(della del)];
6025 $$d{"at"} =[qw(alle)];
6026 $$d{"on"} =[qw(di)];
6027 $$d{"future"} =[qw(fra)];
6028 $$d{"past"} =[qw(fa)];
6029 $$d{"next"} =[qw(prossimo)];
6030 $$d{"prev"} =[qw(ultimo)];
6031 $$d{"later"} =[qw(dopo)];
6032
6033 $$d{"exact"} =[qw(esattamente)];
6034 $$d{"approx"} =[qw(circa)];
6035 $$d{"business"}=[qw(lavorativi lavorativo)];
6036
6037 $$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)];
6038 $$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)];
6039
6040 $$d{"years"} =[qw(anni anno a)];
6041 $$d{"months"} =[qw(mesi mese mes)];
6042 $$d{"weeks"} =[qw(settimane settimana sett)];
6043 $$d{"days"} =[qw(giorni giorno g)];
6044 $$d{"hours"} =[qw(ore ora h)];
6045 $$d{"minutes"} =[qw(minuti minuto min)];
6046 $$d{"seconds"} =[qw(secondi secondo sec)];
6047 $$d{"replace"} =[qw(s sec m mes)];
6048
6049 $$d{"sephm"} =':';
6050 $$d{"sepms"} =':';
6051 $$d{"sepss"} ='[.:]';
6052
6053 $$d{"am"} = [qw(AM)];
6054 $$d{"pm"} = [qw(PM)];
6055}
6056
6057sub Date_Init_French {
6058 print "DEBUG: Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
6059 my($d)=@_;
6060 my(%h)=();
6061 &Char_8Bit(\%h);
6062 my($e)=$h{"e'"};
6063 my($u)=$h{"u^"};
6064 my($a)=$h{"a'"};
6065
6066 $$d{"month_name"}=
6067 [["janvier","fevrier","mars","avril","mai","juin",
6068 "juillet","aout","septembre","octobre","novembre","decembre"],
6069 ["janvier","f${e}vrier","mars","avril","mai","juin",
6070 "juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]];
6071 $$d{"month_abb"}=
6072 [["jan","fev","mar","avr","mai","juin",
6073 "juil","aout","sept","oct","nov","dec"],
6074 ["jan","f${e}v","mar","avr","mai","juin",
6075 "juil","ao${u}t","sept","oct","nov","d${e}c"]];
6076
6077 $$d{"day_name"}=
6078 [["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
6079 $$d{"day_abb"}=
6080 [["lun","mar","mer","jeu","ven","sam","dim"]];
6081 $$d{"day_char"}=
6082 [["l","ma","me","j","v","s","d"]];
6083
6084 $$d{"num_suff"}=
6085 [["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e",
6086 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
6087 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
6088 "31e"]];
6089 $$d{"num_word"}=
6090 [["premier","deux","trois","quatre","cinq","six","sept","huit","neuf",
6091 "dix","onze","douze","treize","quatorze","quinze","seize","dix-sept",
6092 "dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois",
6093 "vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit",
6094 "vingt-neuf","trente","trente et un"],
6095 ["1re"]];
6096
6097 $$d{"now"} =["maintenant"];
6098 $$d{"today"} =["aujourd'hui"];
6099 $$d{"last"} =["dernier"];
6100 $$d{"each"} =["chaque","tous les","toutes les"];
6101 $$d{"of"} =["en","de"];
6102 $$d{"at"} =["a","${a}0"];
6103 $$d{"on"} =["sur"];
6104 $$d{"future"} =["en"];
6105 $$d{"past"} =["il y a"];
6106 $$d{"next"} =["suivant"];
6107 $$d{"prev"} =["precedent","pr${e}c${e}dent"];
6108 $$d{"later"} =["plus tard"];
6109
6110 $$d{"exact"} =["exactement"];
6111 $$d{"approx"} =["approximativement"];
6112 $$d{"business"}=["professionel"];
6113
6114 $$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"];
6115 $$d{"times"} =["midi","12:00:00","minuit","00:00:00"];
6116
6117 $$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"];
6118 $$d{"months"} =["mois"];
6119 $$d{"weeks"} =["sem","semaine"];
6120 $$d{"days"} =["j","jour","jours"];
6121 $$d{"hours"} =["h","heure","heures"];
6122 $$d{"minutes"} =["mn","min","minute","minutes"];
6123 $$d{"seconds"} =["s","sec","seconde","secondes"];
6124 $$d{"replace"} =["m","mois"];
6125
6126 $$d{"sephm"} ='[h:]';
6127 $$d{"sepms"} =':';
6128 $$d{"sepss"} ='[.:,]';
6129
6130 $$d{"am"} = ["du matin"];
6131 $$d{"pm"} = ["du soir"];
6132}
6133
6134sub Date_Init_Romanian {
6135 print "DEBUG: Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
6136 my($d)=@_;
6137 my(%h)=();
6138 &Char_8Bit(\%h);
6139 my($p)=$h{"p"};
6140 my($i)=$h{"i^"};
6141 my($a)=$h{"a~"};
6142 my($o)=$h{"-o"};
6143
6144 $$d{"month_name"}=
6145 [["ianuarie","februarie","martie","aprilie","mai","iunie",
6146 "iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
6147 $$d{"month_abb"}=
6148 [["ian","febr","mart","apr","mai","iun",
6149 "iul","aug","sept","oct","nov","dec"],
6150 ["","feb"]];
6151
6152 $$d{"day_name"}=
6153 [["luni","marti","miercuri","joi","vineri","simbata","duminica"],
6154 ["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
6155 "duminic${a}"]];
6156 $$d{"day_abb"}=
6157 [["lun","mar","mie","joi","vin","sim","dum"],
6158 ["lun","mar","mie","joi","vin","s${i}m","dum"]];
6159 $$d{"day_char"}=
6160 [["L","Ma","Mi","J","V","S","D"]];
6161
6162 $$d{"num_suff"}=
6163 [["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a",
6164 "a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a",
6165 "a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a",
6166 "a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a",
6167 "a 30-a","a 31-a"]];
6168
6169 $$d{"num_word"}=
6170 [["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea",
6171 "a opta","a noua","a zecea","a unsprezecea","a doisprezecea",
6172 "a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea",
6173 "a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea",
6174 "a douazecisiuna","a douazecisidoua","a douazecisitreia",
6175 "a douazecisipatra","a douazecisicincea","a douazecisisasea",
6176 "a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea",
6177 "a treizecisiuna"],
6178 ["prima","a doua","a treia","a patra","a cincea","a ${o}asea",
6179 "a ${o}aptea","a opta","a noua","a zecea","a unsprezecea",
6180 "a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea",
6181 "a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea",
6182 "a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna",
6183 "a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia",
6184 "a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea",
6185 "a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea",
6186 "a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea",
6187 "a treizeci${o}iuna"],
6188 ["intii", "doi", "trei", "patru", "cinci", "sase", "sapte",
6189 "opt","noua","zece","unsprezece","doisprezece",
6190 "treisprezece","patrusprezece","cincisprezece","saiprezece",
6191 "saptesprezece","optsprezece","nouasprezece","douazeci",
6192 "douazecisiunu","douazecisidoi","douazecisitrei",
6193 "douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte",
6194 "douazecisiopt","douazecisinoua","treizeci","treizecisiunu"],
6195 ["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte",
6196 "opt","nou${a}","zece","unsprezece","doisprezece",
6197 "treisprezece","patrusprezece","cincisprezece","${o}aiprezece",
6198 "${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci",
6199 "dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei",
6200 "dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase",
6201 "dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt",
6202 "dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]];
6203
6204 $$d{"now"} =["acum"];
6205 $$d{"today"} =["azi","astazi","ast${a}zi"];
6206 $$d{"last"} =["ultima"];
6207 $$d{"each"} =["fiecare"];
6208 $$d{"of"} =["din","in","n"];
6209 $$d{"at"} =["la"];
6210 $$d{"on"} =["on"];
6211 $$d{"future"} =["in","${i}n"];
6212 $$d{"past"} =["in urma", "${i}n urm${a}"];
6213 $$d{"next"} =["urmatoarea","urm${a}toarea"];
6214 $$d{"prev"} =["precedenta","ultima"];
6215 $$d{"later"} =["mai tirziu", "mai t${i}rziu"];
6216
6217 $$d{"exact"} =["exact"];
6218 $$d{"approx"} =["aproximativ"];
6219 $$d{"business"}=["de lucru","lucratoare","lucr${a}toare"];
6220
6221 $$d{"offset"} =["ieri","-0:0:0:1:0:0:0",
6222 "alaltaieri", "-0:0:0:2:0:0:0",
6223 "alalt${a}ieri","-0:0:0:2:0:0:0",
6224 "miine","+0:0:0:1:0:0:0",
6225 "m${i}ine","+0:0:0:1:0:0:0",
6226 "poimiine","+0:0:0:2:0:0:0",
6227 "poim${i}ine","+0:0:0:2:0:0:0"];
6228 $$d{"times"} =["amiaza","12:00:00",
6229 "amiaz${a}","12:00:00",
6230 "miezul noptii","00:00:00",
6231 "miezul nop${p}ii","00:00:00"];
6232
6233 $$d{"years"} =["ani","an","a"];
6234 $$d{"months"} =["luni","luna","lun${a}","l"];
6235 $$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina",
6236 "s${a}pt${a}m${i}na","sapt","s${a}pt"];
6237 $$d{"days"} =["zile","zi","z"];
6238 $$d{"hours"} =["ore", "ora", "or${a}", "h"];
6239 $$d{"minutes"} =["minute","min","m"];
6240 $$d{"seconds"} =["secunde","sec",];
6241 $$d{"replace"} =["s","secunde"];
6242
6243 $$d{"sephm"} =':';
6244 $$d{"sepms"} =':';
6245 $$d{"sepss"} ='[.:,]';
6246
6247 $$d{"am"} = ["AM","A.M."];
6248 $$d{"pm"} = ["PM","P.M."];
6249}
6250
6251sub Date_Init_Swedish {
6252 print "DEBUG: Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
6253 my($d)=@_;
6254 my(%h)=();
6255 &Char_8Bit(\%h);
6256 my($ao)=$h{"ao"};
6257 my($o) =$h{"o:"};
6258 my($a) =$h{"a:"};
6259
6260 $$d{"month_name"}=
6261 [["Januari","Februari","Mars","April","Maj","Juni",
6262 "Juli","Augusti","September","Oktober","November","December"]];
6263 $$d{"month_abb"}=
6264 [["Jan","Feb","Mar","Apr","Maj","Jun",
6265 "Jul","Aug","Sep","Okt","Nov","Dec"]];
6266
6267 $$d{"day_name"}=
6268 [["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
6269 ["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
6270 "S${o}ndag"]];
6271 $$d{"day_abb"}=
6272 [["Man","Tis","Ons","Tor","Fre","Lor","Son"],
6273 ["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
6274 $$d{"day_char"}=
6275 [["M","Ti","O","To","F","L","S"]];
6276
6277 $$d{"num_suff"}=
6278 [["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
6279 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
6280 "21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
6281 "31:a"]];
6282 $$d{"num_word"}=
6283 [["forsta","andra","tredje","fjarde","femte","sjatte","sjunde",
6284 "attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6285 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6286 "tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte",
6287 "tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde",
6288 "trettionde","trettioforsta"],
6289 ["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde",
6290 "${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6291 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6292 "tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte",
6293 "tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde",
6294 "trettionde","trettiof${o}rsta"]];
6295
6296 $$d{"now"} =["nu"];
6297 $$d{"today"} =["idag"];
6298 $$d{"last"} =["forra","f${o}rra","senaste"];
6299 $$d{"each"} =["varje"];
6300 $$d{"of"} =["om"];
6301 $$d{"at"} =["kl","kl.","klockan"];
6302 $$d{"on"} =["pa","p${ao}"];
6303 $$d{"future"} =["om"];
6304 $$d{"past"} =["sedan"];
6305 $$d{"next"} =["nasta","n${a}sta"];
6306 $$d{"prev"} =["forra","f${o}rra"];
6307 $$d{"later"} =["senare"];
6308
6309 $$d{"exact"} =["exakt"];
6310 $$d{"approx"} =["ungefar","ungef${a}r"];
6311 $$d{"business"}=["arbetsdag","arbetsdagar"];
6312
6313 $$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
6314 "imorgon","+0:0:0:1:0:0:0"];
6315 $$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00",
6316 "midnatt","00:00:00"];
6317
6318 $$d{"years"} =["ar","${ao}r"];
6319 $$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"];
6320 $$d{"weeks"} =["v","vecka","veckor"];
6321 $$d{"days"} =["d","dag","dagar"];
6322 $$d{"hours"} =["t","tim","timme","timmar"];
6323 $$d{"minutes"} =["min","minut","minuter"];
6324 $$d{"seconds"} =["s","sek","sekund","sekunder"];
6325 $$d{"replace"} =["m","minut"];
6326
6327 $$d{"sephm"} ='[.:]';
6328 $$d{"sepms"} =':';
6329 $$d{"sepss"} ='[.:]';
6330
6331 $$d{"am"} = ["FM"];
6332 $$d{"pm"} = ["EM"];
6333}
6334
6335sub Date_Init_German {
6336 print "DEBUG: Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
6337 my($d)=@_;
6338 my(%h)=();
6339 &Char_8Bit(\%h);
6340 my($a)=$h{"a:"};
6341 my($u)=$h{"u:"};
6342 my($o)=$h{"o:"};
6343 my($b)=$h{"beta"};
6344
6345 $$d{"month_name"}=
6346 [["Januar","Februar","Maerz","April","Mai","Juni",
6347 "Juli","August","September","Oktober","November","Dezember"],
6348 ["J${a}nner","Februar","M${a}rz","April","Mai","Juni",
6349 "Juli","August","September","Oktober","November","Dezember"]];
6350 $$d{"month_abb"}=
6351 [["Jan","Feb","Mar","Apr","Mai","Jun",
6352 "Jul","Aug","Sep","Okt","Nov","Dez"],
6353 ["J${a}n","Feb","M${a}r","Apr","Mai","Jun",
6354 "Jul","Aug","Sep","Okt","Nov","Dez"]];
6355
6356 $$d{"day_name"}=
6357 [["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
6358 "Sonntag"]];
6359 $$d{"day_abb"}=
6360 [["Mo","Di","Mi","Do","Fr","Sa","So"]];
6361 $$d{"day_char"}=
6362 [["M","Di","Mi","Do","F","Sa","So"]];
6363
6364 $$d{"num_suff"}=
6365 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6366 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6367 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6368 "31."]];
6369 $$d{"num_word"}=
6370 [
6371 ["erste","zweite","dritte","vierte","funfte","sechste","siebente",
6372 "achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte",
6373 "funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte",
6374 "zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste",
6375 "vierundzwanzigste","funfundzwanzigste","sechundzwanzigste",
6376 "siebundzwanzigste","achtundzwanzigste","neunundzwanzigste",
6377 "dreibigste","einunddreibigste"],
6378 ["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente",
6379 "achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte",
6380 "vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte",
6381 "neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste",
6382 "dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste",
6383 "sechundzwanzigste","siebundzwanzigste","achtundzwanzigste",
6384 "neunundzwanzigste","drei${b}igste","einunddrei${b}igste"],
6385 ["erster"]];
6386
6387 $$d{"now"} =["jetzt"];
6388 $$d{"today"} =["heute"];
6389 $$d{"last"} =["letzte","letzten"];
6390 $$d{"each"} =["jeden"];
6391 $$d{"of"} =["der","im","des"];
6392 $$d{"at"} =["um"];
6393 $$d{"on"} =["am"];
6394 $$d{"future"} =["in"];
6395 $$d{"past"} =["vor"];
6396 $$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
6397 $$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
6398 $$d{"later"} =["spater","sp${a}ter"];
6399
6400 $$d{"exact"} =["genau"];
6401 $$d{"approx"} =["ungefahr","ungef${a}hr"];
6402 $$d{"business"}=["Arbeitstag"];
6403
6404 $$d{"offset"} =["gestern","-0:0:0:1:0:0:0","morgen","+0:0:0:1:0:0:0","${u}bermorgen","+0:0:0:2:0:0:0"];
6405 $$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"];
6406
6407 $$d{"years"} =["j","Jahr","Jahre","Jahren"];
6408 $$d{"months"} =["Monat","Monate","Monaten"];
6409 $$d{"weeks"} =["w","Woche","Wochen"];
6410 $$d{"days"} =["t","Tag","Tage","Tagen"];
6411 $$d{"hours"} =["h","std","Stunde","Stunden"];
6412 $$d{"minutes"} =["min","Minute","Minuten"];
6413 $$d{"seconds"} =["s","sek","Sekunde","Sekunden"];
6414 $$d{"replace"} =["m","Monat"];
6415
6416 $$d{"sephm"} =':';
6417 $$d{"sepms"} ='[: ]';
6418 $$d{"sepss"} ='[.:]';
6419
6420 $$d{"am"} = ["FM"];
6421 $$d{"pm"} = ["EM"];
6422}
6423
6424sub Date_Init_Dutch {
6425 print "DEBUG: Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
6426 my($d)=@_;
6427 my(%h)=();
6428 &Char_8Bit(\%h);
6429
6430 $$d{"month_name"}=
6431 [["januari","februari","maart","april","mei","juni","juli","augustus",
6432 "september","october","november","december"],
6433 ["","","","","","","","","","oktober"]];
6434
6435 $$d{"month_abb"}=
6436 [["jan","feb","maa","apr","mei","jun","jul",
6437 "aug","sep","oct","nov","dec"],
6438 ["","","mrt","","","","","","","okt"]];
6439 $$d{"day_name"}=
6440 [["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
6441 "zondag"]];
6442 $$d{"day_abb"}=
6443 [["ma","di","wo","do","vr","zat","zon"],
6444 ["","","","","","za","zo"]];
6445 $$d{"day_char"}=
6446 [["M","D","W","D","V","Za","Zo"]];
6447
6448 $$d{"num_suff"}=
6449 [["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de",
6450 "11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste",
6451 "21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste",
6452 "30ste","31ste"]];
6453 $$d{"num_word"}=
6454 [["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
6455 "negende","tiende","elfde","twaalfde",
6456 map {"${_}tiende";} qw (der veer vijf zes zeven acht negen),
6457 "twintigste",
6458 map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht
6459 negen),
6460 "dertigste","eenendertigste"],
6461 ["","","","","","","","","","","","","","","","","","","","",
6462 map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht
6463 negen),
6464 "dertigste","een-en-dertigste"],
6465 ["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
6466 "elf","twaalf",
6467 map {"${_}tien"} qw (der veer vijf zes zeven acht negen),
6468 "twintig",
6469 map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen),
6470 "dertig","eenendertig"],
6471 ["","","","","","","","","","","","","","","","","","","","",
6472 map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht
6473 negen),
6474 "dertig","een-en-dertig"]];
6475
6476 $$d{"now"} =["nu","nou"];
6477 $$d{"today"} =["vandaag"];
6478 $$d{"last"} =["laatste"];
6479 $$d{"each"} =["elke","elk"];
6480 $$d{"of"} =["in","van"];
6481 $$d{"at"} =["om"];
6482 $$d{"on"} =["op"];
6483 $$d{"future"} =["over"];
6484 $$d{"past"} =["geleden","vroeger","eerder"];
6485 $$d{"next"} =["volgende","volgend"];
6486 $$d{"prev"} =["voorgaande","voorgaand"];
6487 $$d{"later"} =["later"];
6488
6489 $$d{"exact"} =["exact","precies","nauwkeurig"];
6490 $$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.'];
6491 $$d{"business"}=["werk","zakelijke","zakelijk"];
6492
6493 $$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0",
6494 "gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"];
6495 $$d{"times"} =["noen","12:00:00","middernacht","00:00:00"];
6496
6497 $$d{"years"} =["jaar","jaren","ja","j"];
6498 $$d{"months"} =["maand","maanden","mnd"];
6499 $$d{"weeks"} =["week","weken","w"];
6500 $$d{"days"} =["dag","dagen","d"];
6501 $$d{"hours"} =["uur","uren","u","h"];
6502 $$d{"minutes"} =["minuut","minuten","min"];
6503 $$d{"seconds"} =["seconde","seconden","sec","s"];
6504 $$d{"replace"} =["m","minuten"];
6505
6506 $$d{"sephm"} ='[:.uh]';
6507 $$d{"sepms"} ='[:.m]';
6508 $$d{"sepss"} ='[.:]';
6509
6510 $$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends",
6511 "ochtend","'s_nachts","nacht"];
6512 $$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag",
6513 "'s_avonds","avond"];
6514}
6515
6516sub Date_Init_Polish {
6517 print "DEBUG: Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
6518 my($d)=@_;
6519
6520 $$d{"month_name"}=
6521 [["stycznia","luty","marca","kwietnia","maja","czerwca",
6522 "lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"],
6523 ["stycznia","luty","marca","kwietnia","maja","czerwca","lipca",
6524 "sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]];
6525 $$d{"month_abb"}=
6526 [["sty.","lut.","mar.","kwi.","maj","cze.",
6527 "lip.","sie.","wrz.","paz.","lis.","gru."],
6528 ["sty.","lut.","mar.","kwi.","maj","cze.",
6529 "lip.","sie.","wrz.","pa\x9f.","lis.","gru."]];
6530
6531 $$d{"day_name"}=
6532 [["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
6533 "niedziela"],
6534 ["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
6535 "sobota","niedziela"]];
6536 $$d{"day_abb"}=
6537 [["po.","wt.","sr.","cz.","pi.","so.","ni."],
6538 ["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
6539 $$d{"day_char"}=
6540 [["p","w","e","c","p","s","n"],
6541 ["p","w","\x9c.","c","p","s","n"]];
6542
6543 $$d{"num_suff"}=
6544 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6545 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6546 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6547 "31."]];
6548 $$d{"num_word"}=
6549 [["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
6550 "siodmego","osmego","dziewiatego","dziesiatego",
6551 "jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
6552 "szestnastego","siedemnastego","osiemnastego","dziewietnastego",
6553 "dwudziestego",
6554 "dwudziestego pierwszego","dwudziestego drugiego",
6555 "dwudziestego trzeczego","dwudziestego czwartego",
6556 "dwudziestego piatego","dwudziestego szostego",
6557 "dwudziestego siodmego","dwudziestego osmego",
6558 "dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"],
6559 ["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego",
6560 "sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego",
6561 "dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego",
6562 "czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego",
6563 "osiemnastego","dziewietnastego","dwudziestego",
6564 "dwudziestego pierwszego","dwudziestego drugiego",
6565 "dwudziestego trzeczego","dwudziestego czwartego",
6566 "dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego",
6567 "dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego",
6568 "dwudziestego dziewi\x81\xb9tego","trzydziestego",
6569 "trzydziestego pierwszego"]];
6570
6571 $$d{"now"} =["teraz"];
6572 $$d{"today"} =["dzisaj"];
6573 $$d{"last"} =["ostatni","ostatna"];
6574 $$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"];
6575 $$d{"of"} =["w","z"];
6576 $$d{"at"} =["o","u"];
6577 $$d{"on"} =["na"];
6578 $$d{"future"} =["za"];
6579 $$d{"past"} =["temu"];
6580 $$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
6581 "przyszly","przysz\x81\xb3y","przyszlym",
6582 "przysz\x81\xb3ym"];
6583 $$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
6584 $$d{"later"} =["later"];
6585
6586 $$d{"exact"} =["doklandnie","dok\x81\xb3andnie"];
6587 $$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej",
6588 "mniej wi\x81\xeacej","okolo","oko\x81\xb3o"];
6589 $$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym",
6590 "s\x81\xb3u\x81\xbfbowym"];
6591
6592 $$d{"times"} =["po\x81\xb3udnie","12:00:00",
6593 "p\x81\xf3\x81\xb3noc","00:00:00",
6594 "poludnie","12:00:00","polnoc","00:00:00"];
6595 $$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"];
6596
6597 $$d{"years"} =["rok","lat","lata","latach"];
6598 $$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy",
6599 "miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"];
6600 $$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"];
6601 $$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"];
6602 $$d{"hours"} =["g.","godzina","godziny","godzinie"];
6603 $$d{"minutes"} =["mn.","min.","minut","minuty"];
6604 $$d{"seconds"} =["s.","sekund","sekundy"];
6605 $$d{"replace"} =["m.","miesiac"];
6606
6607 $$d{"sephm"} =':';
6608 $$d{"sepms"} =':';
6609 $$d{"sepss"} ='[.:]';
6610
6611 $$d{"am"} = ["AM","A.M."];
6612 $$d{"pm"} = ["PM","P.M."];
6613}
6614
6615sub Date_Init_Spanish {
6616 print "DEBUG: Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
6617 my($d)=@_;
6618 my(%h)=();
6619 &Char_8Bit(\%h);
6620
6621 $$d{"month_name"}=
6622 [["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
6623 "Septiembre","Octubre","Noviembre","Diciembre"]];
6624
6625 $$d{"month_abb"}=
6626 [["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
6627 "Nov","Dic"]];
6628
6629 $$d{"day_name"}=
6630 [["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
6631 $$d{"day_abb"}=
6632 [["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
6633 $$d{"day_char"}=
6634 [["L","Ma","Mi","J","V","S","D"]];
6635
6636 $$d{"num_suff"}=
6637 [["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o",
6638 "11o","12o","13o","14o","15o","16o","17o","18o","19o","20o",
6639 "21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"],
6640 ["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a",
6641 "11a","12a","13a","14a","15a","16a","17a","18a","19a","20a",
6642 "21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]];
6643 $$d{"num_word"}=
6644 [["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo",
6645 "Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo",
6646 "Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto",
6647 "Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo",
6648 "Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero",
6649 "Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto",
6650 "Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo",
6651 "Trigesimo Primero"],
6652 ["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima",
6653 "Octava","Novena","Decima","Decimo Primera","Decimo Segunda",
6654 "Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta",
6655 "Decimo Septima","Decimo Octava","Decimo Novena","Vigesima",
6656 "Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera",
6657 "Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta",
6658 "Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima",
6659 "Trigesimo Primera"]];
6660
6661 $$d{"now"} =["Ahora"];
6662 $$d{"today"} =["Hoy"];
6663 $$d{"last"} =["ultimo"];
6664 $$d{"each"} =["cada"];
6665 $$d{"of"} =["en","de"];
6666 $$d{"at"} =["a"];
6667 $$d{"on"} =["el"];
6668 $$d{"future"} =["en"];
6669 $$d{"past"} =["hace"];
6670 $$d{"next"} =["siguiente"];
6671 $$d{"prev"} =["anterior"];
6672 $$d{"later"} =["later"];
6673
6674 $$d{"exact"} =["exactamente"];
6675 $$d{"approx"} =["aproximadamente"];
6676 $$d{"business"}=["laborales"];
6677
6678 $$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"];
6679 $$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"];
6680
6681 $$d{"years"} =["a","ano","ano","anos","anos"];
6682 $$d{"months"} =["m","mes","mes","meses"];
6683 $$d{"weeks"} =["sem","semana","semana","semanas"];
6684 $$d{"days"} =["d","dia","dias"];
6685 $$d{"hours"} =["hr","hrs","hora","horas"];
6686 $$d{"minutes"} =["min","min","minuto","minutos"];
6687 $$d{"seconds"} =["s","seg","segundo","segundos"];
6688 $$d{"replace"} =["m","mes"];
6689
6690 $$d{"sephm"} =':';
6691 $$d{"sepms"} =':';
6692 $$d{"sepss"} ='[.:]';
6693
6694 $$d{"am"} = ["AM","A.M."];
6695 $$d{"pm"} = ["PM","P.M."];
6696}
6697
6698sub Date_Init_Portuguese {
6699 print "DEBUG: Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
6700 my($d)=@_;
6701 my(%h)=();
6702 &Char_8Bit(\%h);
6703 my($o) = $h{"-o"};
6704 my($c) = $h{",c"};
6705 my($a) = $h{"a'"};
6706 my($e) = $h{"e'"};
6707 my($u) = $h{"u'"};
6708 my($o2)= $h{"o'"};
6709 my($a2)= $h{"a`"};
6710 my($a3)= $h{"a~"};
6711 my($e2)= $h{"e^"};
6712
6713 $$d{"month_name"}=
6714 [["Janeiro","Fevereiro","Marco","Abril","Maio","Junho",
6715 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"],
6716 ["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho",
6717 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]];
6718
6719 $$d{"month_abb"}=
6720 [["Jan","Fev","Mar","Abr","Mai","Jun",
6721 "Jul","Ago","Set","Out","Nov","Dez"]];
6722
6723 $$d{"day_name"}=
6724 [["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
6725 ["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
6726 $$d{"day_abb"}=
6727 [["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
6728 ["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
6729 $$d{"day_char"}=
6730 [["Sg","T","Qa","Qi","Sx","Sb","D"]];
6731
6732 $$d{"num_suff"}=
6733 [["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}",
6734 "9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}",
6735 "16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}",
6736 "23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}",
6737 "30${o}","31${o}"]];
6738 $$d{"num_word"}=
6739 [["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo",
6740 "oitavo","nono","decimo","decimo primeiro","decimo segundo",
6741 "decimo terceiro","decimo quarto","decimo quinto","decimo sexto",
6742 "decimo setimo","decimo oitavo","decimo nono","vigesimo",
6743 "vigesimo primeiro","vigesimo segundo","vigesimo terceiro",
6744 "vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo",
6745 "vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"],
6746 ["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo",
6747 "oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo",
6748 "d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto",
6749 "d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo",
6750 "d${e}cimo nono","vig${e}simo","vig${e}simo primeiro",
6751 "vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto",
6752 "vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo",
6753 "vig${e}simo oitavo","vig${e}simo nono","trig${e}simo",
6754 "trig${e}simo primeiro"]];
6755
6756 $$d{"now"} =["agora"];
6757 $$d{"today"} =["hoje"];
6758 $$d{"last"} =["${u}ltimo","ultimo"];
6759 $$d{"each"} =["cada"];
6760 $$d{"of"} =["da","do"];
6761 $$d{"at"} =["as","${a2}s"];
6762 $$d{"on"} =["na","no"];
6763 $$d{"future"} =["em"];
6764 $$d{"past"} =["a","${a2}"];
6765 $$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"];
6766 $$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"];
6767 $$d{"later"} =["passadas","passados"];
6768
6769 $$d{"exact"} =["exactamente"];
6770 $$d{"approx"} =["aproximadamente"];
6771 $$d{"business"}=["util","uteis"];
6772
6773 $$d{"offset"} =["ontem","-0:0:0:1:0:0:0",
6774 "amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"];
6775 $$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"];
6776
6777 $$d{"years"} =["anos","ano","ans","an","a"];
6778 $$d{"months"} =["meses","m${e2}s","mes","m"];
6779 $$d{"weeks"} =["semanas","semana","sem","sems","s"];
6780 $$d{"days"} =["dias","dia","d"];
6781 $$d{"hours"} =["horas","hora","hr","hrs"];
6782 $$d{"minutes"} =["minutos","minuto","min","mn"];
6783 $$d{"seconds"} =["segundos","segundo","seg","sg"];
6784 $$d{"replace"} =["m","mes","s","sems"];
6785
6786 $$d{"sephm"} =':';
6787 $$d{"sepms"} =':';
6788 $$d{"sepss"} ='[,]';
6789
6790 $$d{"am"} = ["AM","A.M."];
6791 $$d{"pm"} = ["PM","P.M."];
6792}
6793
6794sub Date_Init_Russian {
6795 print "DEBUG: Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
6796 my($d)=@_;
6797 my(%h)=();
6798 &Char_8Bit(\%h);
6799 my($a) =$h{"a:"};
6800
6801 $$d{"month_name"}=
6802 [
6803 ["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1",
6804 "\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1",
6805 "\xc9\xc0\xce\xd1",
6806 "\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1",
6807 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1",
6808 "\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"],
6809 ["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8",
6810 "\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca",
6811 "\xc9\xc0\xce\xd8",
6812 "\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4",
6813 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8",
6814 "\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"]
6815 ];
6816
6817 $$d{"month_abb"}=
6818 [["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2",
6819 "\xcd\xc1\xca","\xc9\xc0\xce",
6820 "\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4",
6821 "\xce\xcf\xd1\xc2","\xc4\xc5\xcb"],
6822 ["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","",
6823 "","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]];
6824
6825 $$d{"day_name"}=
6826 [["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb",
6827 "\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1",
6828 "\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1",
6829 "\xd3\xd5\xc2\xc2\xcf\xd4\xc1",
6830 "\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]];
6831 $$d{"day_abb"}=
6832 [["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7",
6833 "\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"],
6834 ["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4",
6835 "\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]];
6836 $$d{"day_char"}=
6837 [["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
6838 "\xd7\xd3"]];
6839
6840 $$d{"num_suff"}=
6841 [["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ",
6842 "11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ",
6843 "21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ",
6844 "31 "]];
6845 $$d{"num_word"}=
6846 [["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca",
6847 "\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6848 "\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca",
6849 "\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca",
6850 "\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca",
6851 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6852 "\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca",
6853 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6854 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6855 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6856 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6857 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6858 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6859 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6860 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6861 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca",
6862 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca",
6863 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca",
6864 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6865 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca",
6866 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca",
6867 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca",
6868 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca",
6869 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca",
6870 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca",
6871 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"],
6872
6873 ["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5",
6874 "\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6875 "\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5",
6876 "\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6877 "\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5",
6878 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6879 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6880 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6881 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6882 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6883 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6884 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6885 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6886 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6887 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6888 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5",
6889 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6890 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5",
6891 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6892 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5",
6893 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5",
6894 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5",
6895 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6896 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5",
6897 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5",
6898 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"],
6899
6900 ["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf",
6901 "\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6902 "\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf",
6903 "\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6904 "\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6905 "\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf",
6906 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6907 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6908 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6909 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6910 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6911 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6912 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6913 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6914 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6915 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6916 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf",
6917 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6918 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6919 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf",
6920 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf",
6921 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf",
6922 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6923 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6924 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf",
6925 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6926 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]];
6927
6928 $$d{"now"} =["\xd3\xc5\xca\xde\xc1\xd3"];
6929 $$d{"today"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1"];
6930 $$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"];
6931 $$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"];
6932 $$d{"of"} =[" "];
6933 $$d{"at"} =["\xd7"];
6934 $$d{"on"} =["\xd7"];
6935 $$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"];
6936 $$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "];
6937 $$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"];
6938 $$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"];
6939 $$d{"later"} =["\xd0\xcf\xda\xd6\xc5"];
6940
6941 $$d{"exact"} =["\xd4\xcf\xde\xce\xcf"];
6942 $$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"];
6943 $$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"];
6944
6945 $$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0",
6946 "\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0",
6947 "\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0",
6948 "\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1",
6949 "+0:0:0:2:0:0:0"];
6950 $$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00",
6951 "\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"];
6952
6953 $$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4",
6954 "\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"];
6955 $$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3",
6956 "\xcd\xc5\xd3\xd1\xc3\xc5\xd7"];
6957 $$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8",
6958 "\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"];
6959 $$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca",
6960 "\xc4\xce\xd1"];
6961 $$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3",
6962 "\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"];
6963 $$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1",
6964 "\xcd\xc9\xce\xd5\xd4"];
6965 $$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
6966 "\xd3\xc5\xcb\xd5\xce\xc4"];
6967 $$d{"replace"} =[];
6968
6969 $$d{"sephm"} ="[:\xde]";
6970 $$d{"sepms"} ="[:\xcd]";
6971 $$d{"sepss"} ="[:.\xd3]";
6972
6973 $$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
6974 "\xd5\xd4\xd2\xc1",
6975 "\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"];
6976 $$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1",
6977 "\xd7\xc5\xde\xc5\xd2\xc1",
6978 "\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1",
6979 "\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"];
6980}
6981
6982sub Date_Init_Turkish {
6983 print "DEBUG: Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
6984 my($d)=@_;
6985
6986 $$d{"month_name"}=
6987 [
6988 ["ocak","subat","mart","nisan","mayis","haziran",
6989 "temmuz","agustos","eylul","ekim","kasim","aralik"],
6990 ["ocak","\xfeubat","mart","nisan","may\xfds","haziran",
6991 "temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"]
6992 ];
6993
6994 $$d{"month_abb"}=
6995 [
6996 ["oca","sub","mar","nis","may","haz",
6997 "tem","agu","eyl","eki","kas","ara"],
6998 ["oca","\xfeub","mar","nis","may","haz",
6999 "tem","a\xf0u","eyl","eki","kas","ara"]
7000 ];
7001
7002 $$d{"day_name"}=
7003 [
7004 ["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
7005 ["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
7006 "cumartesi","pazar"],
7007 ];
7008
7009 $$d{"day_abb"}=
7010 [
7011 ["pzt","sal","car","per","cum","cts","paz"],
7012 ["pzt","sal","\xe7ar","per","cum","cts","paz"],
7013 ];
7014
7015 $$d{"day_char"}=
7016 [["Pt","S","Cr","Pr","C","Ct","P"],
7017 ["Pt","S","\xc7","Pr","C","Ct","P"]];
7018
7019 $$d{"num_suff"}=
7020 [[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.",
7021 "11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.",
7022 "21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.",
7023 "31."]];
7024
7025 $$d{"num_word"}=
7026 [
7027 ["birinci","ikinci","ucuncu","dorduncu",
7028 "besinci","altinci","yedinci","sekizinci",
7029 "dokuzuncu","onuncu","onbirinci","onikinci",
7030 "onucuncu","ondordoncu",
7031 "onbesinci","onaltinci","onyedinci","onsekizinci",
7032 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
7033 "yirmiucuncu","yirmidorduncu",
7034 "yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci",
7035 "yirmidokuzuncu","otuzuncu","otuzbirinci"],
7036 ["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc",
7037 "be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci",
7038 "dokuzuncu","onuncu","onbirinci","onikinci",
7039 "on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc",
7040 "onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci",
7041 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
7042 "yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc",
7043 "yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci",
7044 "yirmidokuzuncu","otuzuncu","otuzbirinci"]
7045 ];
7046
7047 $$d{"now"} =["\xfeimdi", "simdi"];
7048 $$d{"today"} =["bugun", "bug\xfcn"];
7049 $$d{"last"} =["son", "sonuncu"];
7050 $$d{"each"} =["her"];
7051 $$d{"of"} =["of"];
7052 $$d{"at"} =["saat"];
7053 $$d{"on"} =["on"];
7054 $$d{"future"} =["gelecek"];
7055 $$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
7056 $$d{"next"} =["gelecek","sonraki"];
7057 $$d{"prev"} =["onceki","\xf6nceki"];
7058 $$d{"later"} =["sonra"];
7059
7060 $$d{"exact"} =["tam"];
7061 $$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"];
7062 $$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"];
7063
7064 $$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0",
7065 "dun", "-0:0:0:1:0:0:0",
7066 "yar\xfdn","+0:0:0:1:0:0:0",
7067 "yarin","+0:0:0:1:0:0:0"];
7068
7069 $$d{"times"} =["\xf6\xf0len","12:00:00",
7070 "oglen","12:00:00",
7071 "yarim","12:300:00",
7072 "yar\xfdm","12:30:00",
7073 "gece yar\xfds\xfd","00:00:00",
7074 "gece yarisi","00:00:00"];
7075
7076 $$d{"years"} =["yil","y"];
7077 $$d{"months"} =["ay","a"];
7078 $$d{"weeks"} =["hafta", "h"];
7079 $$d{"days"} =["gun","g"];
7080 $$d{"hours"} =["saat"];
7081 $$d{"minutes"} =["dakika","dak","d"];
7082 $$d{"seconds"} =["saniye","sn",];
7083 $$d{"replace"} =["s","saat"];
7084
7085 $$d{"sephm"} =':';
7086 $$d{"sepms"} =':';
7087 $$d{"sepss"} ='[.:,]';
7088
7089 $$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
7090 $$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
7091}
7092
7093sub Date_Init_Danish {
7094 print "DEBUG: Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
7095 my($d)=@_;
7096
7097 $$d{"month_name"}=
7098 [["Januar","Februar","Marts","April","Maj","Juni",
7099 "Juli","August","September","Oktober","November","December"]];
7100 $$d{"month_abb"}=
7101 [["Jan","Feb","Mar","Apr","Maj","Jun",
7102 "Jul","Aug","Sep","Okt","Nov","Dec"]];
7103
7104 $$d{"day_name"}=
7105 [["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
7106 ["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
7107
7108 $$d{"day_abb"}=
7109 [["Man","Tir","Ons","Tor","Fre","Lor","Son"],
7110 ["Man","Tir","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
7111 $$d{"day_char"}=
7112 [["M","Ti","O","To","F","L","S"]];
7113
7114 $$d{"num_suff"}=
7115 [["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
7116 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
7117 "21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
7118 "31:e"]];
7119 $$d{"num_word"}=
7120 [["forste","anden","tredie","fjerde","femte","sjette","syvende",
7121 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7122 "femtende","sekstende","syttende","attende","nittende","tyvende",
7123 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7124 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7125 "tredivte","enogtredivte"],
7126 ["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende",
7127 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7128 "femtende","sekstende","syttende","attende","nittende","tyvende",
7129 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7130 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7131 "tredivte","enogtredivte"]];
7132
7133 $$d{"now"} =["nu"];
7134 $$d{"today"} =["idag"];
7135 $$d{"last"} =["forrige","sidste","nyeste"];
7136 $$d{"each"} =["hver"];
7137 $$d{"of"} =["om"];
7138 $$d{"at"} =["kl","kl.","klokken"];
7139 $$d{"on"} =["pa","p\xe5"];
7140 $$d{"future"} =["om"];
7141 $$d{"past"} =["siden"];
7142 $$d{"next"} =["nasta","n\xe6ste"];
7143 $$d{"prev"} =["forrige"];
7144 $$d{"later"} =["senere"];
7145
7146 $$d{"exact"} =["pracist","pr\xe6cist"];
7147 $$d{"approx"} =["circa"];
7148 $$d{"business"}=["arbejdsdag","arbejdsdage"];
7149
7150 $$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
7151 "imorgen","+0:0:0:1:0:0:0"];
7152 $$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00",
7153 "midnat","00:00:00"];
7154
7155 $$d{"years"} =["ar","\xe5r"];
7156 $$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"];
7157 $$d{"weeks"} =["u","uge","uger"];
7158 $$d{"days"} =["d","dag","dage"];
7159 $$d{"hours"} =["t","tim","time","timer"];
7160 $$d{"minutes"} =["min","minut","minutter"];
7161 $$d{"seconds"} =["s","sek","sekund","sekunder"];
7162 $$d{"replace"} =["m","minut"];
7163
7164 $$d{"sephm"} ='[.:]';
7165 $$d{"sepms"} =':';
7166 $$d{"sepss"} ='[.:]';
7167
7168 $$d{"am"} = ["FM"];
7169 $$d{"pm"} = ["EM"];
7170}
7171
7172sub Date_Init_Catalan {
7173 print "DEBUG: Date_Init_Catalan\n" if ($Curr{"Debug"} =~ /trace/);
7174 my($d)=@_;
7175
7176 $$d{"month_name"}=
7177 [["Gener","Febrer","Marc","Abril","Maig","Juny",
7178 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7179 ["Gener","Febrer","Març","Abril","Maig","Juny",
7180 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7181 ["Gener","Febrer","Marc,","Abril","Maig","Juny",
7182 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"]];
7183
7184 $$d{"month_abb"}=
7185 [["Gen","Feb","Mar","Abr","Mai","Jun",
7186 "Jul","Ago","Set","Oct","Nov","Des"],
7187 [],
7188 ["","","","","","",
7189 "","","","","","Dec"] #common mistake
7190 ];
7191
7192 $$d{"day_name"}=
7193 [["Dilluns","Dimarts","Dimecres","Dijous","Divendres","Dissabte","Diumenge"]];
7194 $$d{"day_abb"}=
7195 [["Dll","Dmt","Dmc","Dij","Div","Dis","Diu"],
7196 ["","Dim","","","","",""],
7197 ["","","Dic","","","",""]
7198 ];
7199 $$d{"day_char"}=
7200 [["Dl","Dm","Dc","Dj","Dv","Ds","Du"] ,
7201 ["L","M","X","J","V","S","U"]];
7202
7203 $$d{"num_suff"}=
7204 [["1er","2n","3r","4t","5e","6e","7e","8e","9e","10e",
7205 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
7206 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
7207 "31e"],
7208 ["1er","2n","3r","4t","5è","6è","7è","8è","9è","10è",
7209 "11è","12è","13è","14è","15è","16è","17è","18è","19è","20è",
7210 "21è","22è","23è","24è","25è","26è","27è","28è","29è","30è",
7211 "31è"]];
7212 $$d{"num_word"}=
7213 [["primer","segon","tercer","quart","cinque","sise","sete","vuite",
7214 "nove","dese","onze","dotze","tretze","catorze",
7215 "quinze","setze","dissete","divuite","dinove",
7216 "vinte","vint-i-une","vint-i-dose","vint-i-trese",
7217 "vint-i-quatre","vint-i-cinque","vint-i-sise","vint-i-sete",
7218 "vint-i-vuite","vint-i-nove","trente","trenta-une"],
7219 ["primer","segon","tercer","quart","cinquè","sisè","setè","vuitè",
7220 "novè","desè","onzè","dotzè","tretzè","catorzè",
7221 "quinzè","setzè","dissetè","divuitè","dinovè",
7222 "vintè","vint-i-unè","vint-i-dosè","vint-i-tresè",
7223 "vint-i-quatrè","vint-i-cinquè","vint-i-sisè","vint-i-setè",
7224 "vint-i-vuitè","vint-i-novè","trentè","trenta-unè"]];
7225
7226 $$d{"now"} =["avui","ara"];
7227 $$d{"last"} =["darrer","últim","darrera","última"];
7228 $$d{"each"} =["cada","cadascun","cadascuna"];
7229 $$d{"of"} =["de","d'"];
7230 $$d{"at"} =["a les","a","al"];
7231 $$d{"on"} =["el"];
7232 $$d{"future"} =["d'aquí a"];
7233 $$d{"past"} =["fa"];
7234 $$d{"next"} =["proper"];
7235 $$d{"prev"} =["passat","proppassat","anterior"];
7236 $$d{"later"} =["més tard"];
7237
7238 $$d{"exact"} =["exactament"];
7239 $$d{"approx"} =["approximadament"];
7240 $$d{"business"}=["empresa"];
7241
7242 $$d{"offset"} =["ahir","-0:0:0:1:0:0:0","demà","+0:0:0:1:0:0:0","abans d'ahir","-0:0:0:2:0:0:0","demà passat","+0:0:0:2:0:0:0",];
7243 $$d{"times"} =["migdia","12:00:00","mitjanit","00:00:00"];
7244
7245 $$d{"years"} =["a","an","any","anys"];
7246 $$d{"months"} =["mes","me","ms"];
7247 $$d{"weeks"} =["se","set","setm","setmana","setmanes"];
7248 $$d{"days"} =["d","dia","dies"];
7249 $$d{"hours"} =["h","ho","hores","hora"];
7250 $$d{"minutes"} =["mn","min","minut","minuts"];
7251 $$d{"seconds"} =["s","seg","segon","segons"];
7252 $$d{"replace"} =["m","mes","s","setmana"];
7253
7254 $$d{"sephm"} =':';
7255 $$d{"sepms"} =':';
7256 $$d{"sepss"} ='[.:]';
7257
7258 $$d{"am"} = ["AM","A.M."];
7259 $$d{"pm"} = ["PM","P.M."];
7260}
7261
7262########################################################################
7263# FROM MY PERSONAL LIBRARIES
7264########################################################################
7265
7266no integer;
7267
7268# &ModuloAddition($N,$add,\$val,\$rem);
7269# This calculates $val=$val+$add and forces $val to be in a certain range.
7270# This is useful for adding numbers for which only a certain range is
7271# allowed (for example, minutes can be between 0 and 59 or months can be
7272# between 1 and 12). The absolute value of $N determines the range and
7273# the sign of $N determines whether the range is 0 to N-1 (if N>0) or
7274# 1 to N (N<0). The remainder (as modulo N) is added to $rem.
7275# Example:
7276# To add 2 hours together (with the excess returned in days) use:
7277# &ModuloAddition(60,$s1,\$s,\$day);
7278sub ModuloAddition {
7279 my($N,$add,$val,$rem)=@_;
7280 return if ($N==0);
7281 $$val+=$add;
7282 if ($N<0) {
7283 # 1 to N
7284 $N = -$N;
7285 if ($$val>$N) {
7286 $$rem+= int(($$val-1)/$N);
7287 $$val = ($$val-1)%$N +1;
7288 } elsif ($$val<1) {
7289 $$rem-= int(-$$val/$N)+1;
7290 $$val = $N-(-$$val % $N);
7291 }
7292
7293 } else {
7294 # 0 to N-1
7295 if ($$val>($N-1)) {
7296 $$rem+= int($$val/$N);
7297 $$val = $$val%$N;
7298 } elsif ($$val<0) {
7299 $$rem-= int(-($$val+1)/$N)+1;
7300 $$val = ($N-1)-(-($$val+1)%$N);
7301 }
7302 }
7303}
7304
7305# $Flag=&IsInt($String [,$low, $high]);
7306# Returns 1 if $String is a valid integer, 0 otherwise. If $low is
7307# entered, $String must be >= $low. If $high is entered, $String must
7308# be <= $high. It is valid to check only one of the bounds.
7309sub IsInt {
7310 my($N,$low,$high)=@_;
7311 return 0 if (! defined $N or
7312 $N !~ /^\s*[-+]?\d+\s*$/ or
7313 defined $low && $N<$low or
7314 defined $high && $N>$high);
7315 return 1;
7316}
7317
7318# $Pos=&SinLindex(\@List,$Str [,$offset [,$CaseInsensitive]]);
7319# Searches for an exact string in a list.
7320#
7321# This is similar to RinLindex except that it searches for elements
7322# which are exactly equal to $Str (possibly case insensitive).
7323sub SinLindex {
7324 my($listref,$Str,$offset,$Insensitive)=@_;
7325 my($i,$len,$tmp)=();
7326 $len=$#$listref;
7327 return -2 if ($len<0 or ! $Str);
7328 return -1 if (&Index_First(\$offset,$len));
7329 $Str=uc($Str) if ($Insensitive);
7330 for ($i=$offset; $i<=$len; $i++) {
7331 $tmp=$$listref[$i];
7332 $tmp=uc($tmp) if ($Insensitive);
7333 return $i if ($tmp eq $Str);
7334 }
7335 return -1;
7336}
7337
7338sub Index_First {
7339 my($offsetref,$max)=@_;
7340 $$offsetref=0 if (! $$offsetref);
7341 if ($$offsetref < 0) {
7342 $$offsetref += $max + 1;
7343 $$offsetref=0 if ($$offsetref < 0);
7344 }
7345 return -1 if ($$offsetref > $max);
7346 return 0;
7347}
7348
7349# $File=&CleanFile($file);
7350# This cleans up a path to remove the following things:
7351# double slash /a//b -> /a/b
7352# trailing dot /a/. -> /a
7353# leading dot ./a -> a
7354# trailing slash a/ -> a
7355sub CleanFile {
7356 my($file)=@_;
7357 $file =~ s/\s*$//;
7358 $file =~ s/^\s*//;
7359 $file =~ s|//+|/|g; # multiple slash
7360 $file =~ s|/\.$|/|; # trailing /. (leaves trailing slash)
7361 $file =~ s|^\./|| # leading ./
7362 if ($file ne "./");
7363 $file =~ s|/$|| # trailing slash
7364 if ($file ne "/");
7365 return $file;
7366}
7367
7368# $File=&ExpandTilde($file);
7369# This checks to see if a "~" appears as the first character in a path.
7370# If it does, the "~" expansion is interpreted (if possible) and the full
7371# path is returned. If a "~" expansion is used but cannot be
7372# interpreted, an empty string is returned.
7373#
7374# This is Windows/Mac friendly.
7375# This is efficient.
7376sub ExpandTilde {
7377 my($file)=shift;
7378 my($user,$home)=();
7379 # ~aaa/bbb= ~ aaa /bbb
7380 if ($file =~ s|^~([^/]*)||) {
7381 $user=$1;
7382 # Single user operating systems (Mac, MSWindows) don't have the getpwnam
7383 # and getpwuid routines defined. Try to catch various different ways
7384 # of knowing we are on one of these systems:
7385 return "" if ($OS eq "Windows" or
7386 $OS eq "Mac" or
7387 $OS eq "Netware" or
7388 $OS eq "MPE");
7389 $user="" if (! defined $user);
7390
7391 if ($user) {
7392 $home= (getpwnam($user))[7];
7393 } else {
7394 $home= (getpwuid($<))[7];
7395 }
7396 $home = VMS::Filespec::unixpath($home) if ($OS eq "VMS");
7397 return "" if (! $home);
7398 $file="$home/$file";
7399 }
7400 $file;
7401}
7402
7403# $File=&FullFilePath($file);
7404# Returns the full or relative path to $file (expanding "~" if necessary).
7405# Returns an empty string if a "~" expansion cannot be interpreted. The
7406# path does not need to exist. CleanFile is called.
7407sub FullFilePath {
7408 my($file)=shift;
7409 my($rootpat) = '^/'; #default pattern to match absolute path
7410 $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
7411 $file=&ExpandTilde($file);
7412 return "" if (! $file);
7413 return &CleanFile($file);
7414}
7415
7416# $Flag=&CheckFilePath($file [,$mode]);
7417# Checks to see if $file exists, to see what type it is, and whether
7418# the script can access it. If it exists and has the correct mode, 1
7419# is returned.
7420#
7421# $mode is a string which may contain any of the valid file test operator
7422# characters except t, M, A, C. The appropriate test is run for each
7423# character. For example, if $mode is "re" the -r and -e tests are both
7424# run.
7425#
7426# An empty string is returned if the file doesn't exist. A 0 is returned
7427# if the file exists but any test fails.
7428#
7429# All characters in $mode which do not correspond to valid tests are
7430# ignored.
7431sub CheckFilePath {
7432 my($file,$mode)=@_;
7433 my($test)=();
7434 $file=&FullFilePath($file);
7435 $mode = "" if (! defined $mode);
7436
7437 # Run tests
7438 return 0 if (! defined $file or ! $file);
7439 return 0 if (( ! -e $file) or
7440 ($mode =~ /r/ && ! -r $file) or
7441 ($mode =~ /w/ && ! -w $file) or
7442 ($mode =~ /x/ && ! -x $file) or
7443 ($mode =~ /R/ && ! -R $file) or
7444 ($mode =~ /W/ && ! -W $file) or
7445 ($mode =~ /X/ && ! -X $file) or
7446 ($mode =~ /o/ && ! -o $file) or
7447 ($mode =~ /O/ && ! -O $file) or
7448 ($mode =~ /z/ && ! -z $file) or
7449 ($mode =~ /s/ && ! -s $file) or
7450 ($mode =~ /f/ && ! -f $file) or
7451 ($mode =~ /d/ && ! -d $file) or
7452 ($mode =~ /l/ && ! -l $file) or
7453 ($mode =~ /s/ && ! -s $file) or
7454 ($mode =~ /p/ && ! -p $file) or
7455 ($mode =~ /b/ && ! -b $file) or
7456 ($mode =~ /c/ && ! -c $file) or
7457 ($mode =~ /u/ && ! -u $file) or
7458 ($mode =~ /g/ && ! -g $file) or
7459 ($mode =~ /k/ && ! -k $file) or
7460 ($mode =~ /T/ && ! -T $file) or
7461 ($mode =~ /B/ && ! -B $file));
7462 return 1;
7463}
7464#&&
7465
7466# $Path=&FixPath($path [,$full] [,$mode] [,$error]);
7467# Makes sure that every directory in $path (a colon separated list of
7468# directories) appears as a full path or relative path. All "~"
7469# expansions are removed. All trailing slashes are removed also. If
7470# $full is non-nil, relative paths are expanded to full paths as well.
7471#
7472# If $mode is given, it may be either "e", "r", or "w". In this case,
7473# additional checking is done to each directory. If $mode is "e", it
7474# need ony exist to pass the check. If $mode is "r", it must have have
7475# read and execute permission. If $mode is "w", it must have read,
7476# write, and execute permission.
7477#
7478# The value of $error determines what happens if the directory does not
7479# pass the test. If it is non-nil, if any directory does not pass the
7480# test, the subroutine returns the empty string. Otherwise, it is simply
7481# removed from $path.
7482#
7483# The corrected path is returned.
7484sub FixPath {
7485 my($path,$full,$mode,$err)=@_;
7486 local($_)="";
7487 my(@dir)=split(/$Cnf{"PathSep"}/,$path);
7488 $full=0 if (! defined $full);
7489 $mode="" if (! defined $mode);
7490 $err=0 if (! defined $err);
7491 $path="";
7492 if ($mode eq "e") {
7493 $mode="de";
7494 } elsif ($mode eq "r") {
7495 $mode="derx";
7496 } elsif ($mode eq "w") {
7497 $mode="derwx";
7498 }
7499
7500 foreach (@dir) {
7501
7502 # Expand path
7503 if ($full) {
7504 $_=&FullFilePath($_);
7505 } else {
7506 $_=&ExpandTilde($_);
7507 }
7508 if (! $_) {
7509 return "" if ($err);
7510 next;
7511 }
7512
7513 # Check mode
7514 if (! $mode or &CheckFilePath($_,$mode)) {
7515 $path .= $Cnf{"PathSep"} . $_;
7516 } else {
7517 return "" if ($err);
7518 }
7519 }
7520 $path =~ s/^$Cnf{"PathSep"}//;
7521 return $path;
7522}
7523#&&
7524
7525# $File=&SearchPath($file,$path [,$mode] [,@suffixes]);
7526# Searches through directories in $path for a file named $file. The
7527# full path is returned if one is found, or an empty string otherwise.
7528# The file may exist with one of the @suffixes. The mode is checked
7529# similar to &CheckFilePath.
7530#
7531# The first full path that matches the name and mode is returned. If none
7532# is found, an empty string is returned.
7533sub SearchPath {
7534 my($file,$path,$mode,@suff)=@_;
7535 my($f,$s,$d,@dir,$fs)=();
7536 $path=&FixPath($path,1,"r");
7537 @dir=split(/$Cnf{"PathSep"}/,$path);
7538 foreach $d (@dir) {
7539 $f="$d/$file";
7540 $f=~ s|//|/|g;
7541 return $f if (&CheckFilePath($f,$mode));
7542 foreach $s (@suff) {
7543 $fs="$f.$s";
7544 return $fs if (&CheckFilePath($fs,$mode));
7545 }
7546 }
7547 return "";
7548}
7549
7550# @list=&ReturnList($str);
7551# This takes a string which should be a comma separated list of integers
7552# or ranges (5-7). It returns a sorted list of all integers referred to
7553# by the string, or () if there is an invalid element.
7554#
7555# Negative integers are also handled. "-2--1" is equivalent to "-2,-1".
7556sub ReturnList {
7557 my($str)=@_;
7558 my(@ret,@str,$from,$to,$tmp)=();
7559 @str=split(/,/,$str);
7560 foreach $str (@str) {
7561 if ($str =~ /^[-+]?\d+$/) {
7562 push(@ret,$str);
7563 } elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {
7564 ($from,$to)=($1,$2);
7565 if ($from>$to) {
7566 $tmp=$from;
7567 $from=$to;
7568 $to=$tmp;
7569 }
7570 push(@ret,$from..$to);
7571 } else {
7572 return ();
7573 }
7574 }
7575 @ret;
7576}
7577
75781;
Note: See TracBrowser for help on using the repository browser.