source: releases/Pester/1.1b5/Source/Manip.pm

Last change on this file was 360, checked in by Nicholas Riley, 17 years ago

Pester.xcodeproj: Add Perl embedding bits; remove SoundFileManager.h.

DynaLoader.a: i386/ppc version from Tiger; Leopard's version causes
Tiger to crash.

Info-Pester.plist: Updated copyright date.

Read Me.rtfd: Remove .typeAttributes.dict, no longer used; update a
bit.

PSTimeDateEditor.m: Switch to NJRDateFormatters again.

NJRDateFormatter.[hm]: Removed old-style date formatter workarounds;
added code for using Date::Manip and trying multiple ICU-based date
formatters.

English.lproj/InfoPlist.strings: Updated copyright date.

English.lproj/MainMenu.nib: Modified date completion menu for items
Date::Manip can parse.

Manip.pm: Date::Manip 5.47, converted to UTF-8.
File size: 235.2 KB
Line 
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
570 "clst -0400 ". # Chile Standard
571 "bot -0400 ". # Bolivia
572 "amt -0400 ". # Brazil, Amazon
573 "acst -0400 ". # Brazil, Acre Daylight
574 "edt -0400 ". # Eastern Daylight
575 "ast -0400 ". # Atlantic Standard
576 #"nst -0330 ". # Newfoundland Standard nst=North Sumatra +0630
577 "nft -0330 ". # Newfoundland
578 #"gst -0300 ". # Greenland Standard gst=Guam Standard +1000
579 "cldt -0300 ". # Chile Daylight
580 #"bst -0300 ". # Brazil Standard bst=British Summer +0100
581 "brt -0300 ". # Brazil Standard (official time)
582 #"brst -0300 ". # Brazil Standard
583 "adt -0300 ". # Atlantic Daylight
584 "art -0300 ". # Argentina
585 "amst -0300 ". # Brazil, Amazon Daylight
586 "uyt -0300 ". # Uruguay
587 "ndt -0230 ". # Newfoundland Daylight
588 "brst -0200 ". # Brazil Daylight (official time)
589 "fnt -0200 ". # Brazil, Fernando de Noronha
590 "at -0200 ". # Azores
591 "yust -0200 ". # Uruguay
592 "wat -0100 ". # West Africa
593 "fnst -0100 ". # Brazil, Fernando de Noronha Daylight
594 "gmt +0000 ". # Greenwich Mean
595 "ut +0000 ". # Universal
596 "utc +0000 ". # Universal (Coordinated)
597 "wet +0000 ". # Western European
598 "cet +0100 ". # Central European
599 "fwt +0100 ". # French Winter
600 "met +0100 ". # Middle European
601 "mez +0100 ". # Middle European
602 "mewt +0100 ". # Middle European Winter
603 "swt +0100 ". # Swedish Winter
604 "bst +0100 ". # British Summer bst=Brazil standard -0300
605 "gb +0100 ". # GMT with daylight savings
606 "west +0100 ". # Western European Daylight
607 "eet +0200 ". # Eastern Europe, USSR Zone 1
608 "cest +0200 ". # Central European Summer
609 "fst +0200 ". # French Summer
610 "ist +0200 ". # Israel standard
611 "mest +0200 ". # Middle European Summer
612 "mesz +0200 ". # Middle European Summer
613 "metdst +0200 ". # An alias for mest used by HP-UX
614 "sast +0200 ". # South African Standard
615 "sst +0200 ". # Swedish Summer sst=South Sumatra +0700
616 "bt +0300 ". # Baghdad, USSR Zone 2
617 "eest +0300 ". # Eastern Europe Summer
618 "eetdst +0300 ". # An alias for eest used by HP-UX
619 "eetedt +0300 ". # Eastern Europe, USSR Zone 1
620 "idt +0300 ". # Israel Daylight
621 "msk +0300 ". # Moscow
622 "eat +0300 ". # East Africa
623 "it +0330 ". # Iran
624 "zp4 +0400 ". # USSR Zone 3
625 "msd +0400 ". # Moscow Daylight
626 "zp5 +0500 ". # USSR Zone 4
627 "ist +0530 ". # Indian Standard
628 "zp6 +0600 ". # USSR Zone 5
629 "novt +0600 ". # Novosibirsk winter time zone, Russia
630 "nst +0630 ". # North Sumatra nst=Newfoundland Std -0330
631 #"sst +0700 ". # South Sumatra, USSR Zone 6 sst=Swedish Summer +0200
632 "javt +0700 ". # Java
633 "ict +0700 ". # Indo China Time
634 "novst +0700 ". # Novosibirsk summer time zone, Russia
635 "krat +0700 ". # Krasnoyarsk, Russia
636 "myt +0800 ". # Malaysia
637 "hkt +0800 ". # Hong Kong
638 "sgt +0800 ". # Singapore
639 "cct +0800 ". # China Coast, USSR Zone 7
640 "krast +0800 ". # Krasnoyarsk, Russia Daylight
641 "awst +0800 ". # Australian Western Standard
642 "wst +0800 ". # West Australian Standard
643 "pht +0800 ". # Asia Manila
644 "kst +0900 ". # Republic of Korea
645 "jst +0900 ". # Japan Standard, USSR Zone 8
646 "rok +0900 ". # Republic of Korea
647 "acst +0930 ". # Australian Central Standard
648 "cast +0930 ". # Central Australian Standard
649 "aest +1000 ". # Australian Eastern Standard
650 "east +1000 ". # Eastern Australian Standard
651 "gst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
652 "chst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
653 "acdt +1030 ". # Australian Central Daylight
654 "cadt +1030 ". # Central Australian Daylight
655 "aedt +1100 ". # Australian Eastern Daylight
656 "eadt +1100 ". # Eastern Australian Daylight
657 "idle +1200 ". # International Date Line East
658 "nzst +1200 ". # New Zealand Standard
659 "nzt +1200 ". # New Zealand
660 "nzdt +1300 ". # New Zealand Daylight
661 "z +0000 ".
662 "a +0100 b +0200 c +0300 d +0400 e +0500 f +0600 g +0700 h +0800 ".
663 "i +0900 k +1000 l +1100 m +1200 ".
664 "n -0100 o -0200 p -0300 q -0400 r -0500 s -0600 t -0700 u -0800 ".
665 "v -0900 w -1000 x -1100 y -1200";
666
667 $Zone{"n2o"} = {};
668 ($Zone{"zones"},%{ $Zone{"n2o"} })=
669 &Date_Regexp($zonesrfc,"sort,lc,under,back",
670 "keys");
671
672 $tmp=
673 "US/Pacific PST8PDT ".
674 "US/Mountain MST7MDT ".
675 "US/Central CST6CDT ".
676 "US/Eastern EST5EDT ".
677 "Canada/Pacific PST8PDT ".
678 "Canada/Mountain MST7MDT ".
679 "Canada/Central CST6CDT ".
680 "Canada/Eastern EST5EDT";
681
682 $Zone{"tz2z"} = {};
683 ($Zone{"tzones"},%{ $Zone{"tz2z"} })=
684 &Date_Regexp($tmp,"lc,under,back","keys");
685 $Cnf{"TZ"}=&Date_TimeZone;
686
687 # misc. variables
688 # At = "(?:at)"
689 # Of = "(?:in|of)"
690 # On = "(?:on)"
691 # Future = "(?:in)"
692 # Later = "(?:later)"
693 # Past = "(?:ago)"
694 # Next = "(?:next)"
695 # Prev = "(?:last|previous)"
696
697 &Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort");
698 &Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort");
699 &Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort");
700 &Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort");
701 &Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort");
702 &Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort");
703 &Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort");
704 &Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort");
705
706 # calc mode variables
707 # Approx = "(?:approximately)"
708 # Exact = "(?:exactly)"
709 # Business = "(?:business)"
710
711 &Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort");
712 &Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort");
713 &Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort");
714
715 ############### END OF LANGUAGE INITIALIZATION
716 }
717
718 if ($Curr{"ResetWorkDay"}) {
719 my($h1,$m1,$h2,$m2)=();
720 if ($Cnf{"WorkDay24Hr"}) {
721 ($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
722 ($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
723 $Curr{"WDlen"}=24*60;
724 $Cnf{"WorkDayBeg"}="00:00";
725 $Cnf{"WorkDayEnd"}="23:59";
726
727 } else {
728 confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n"
729 if (! (($h1,$m1)=&CheckTime($Cnf{"WorkDayBeg"})));
730 $Cnf{"WorkDayBeg"}="$h1:$m1";
731 confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n"
732 if (! (($h2,$m2)=&CheckTime($Cnf{"WorkDayEnd"})));
733 $Cnf{"WorkDayEnd"}="$h2:$m2";
734
735 ($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
736 ($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
737
738 # Work day length = h1:m1 or 0:len (len minutes)
739 $h1=$h2-$h1;
740 $m1=$m2-$m1;
741 if ($m1<0) {
742 $h1--;
743 $m1+=60;
744 }
745 $Curr{"WDlen"}=$h1*60+$m1;
746 }
747 $Curr{"ResetWorkDay"}=0;
748 }
749
750 # current time
751 my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
752 if ($Cnf{"ForceDate"}=~
753 /^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
754 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
755 } else {
756 ($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
757 $y+=1900;
758 $m++;
759 }
760 &Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
761 $Curr{"Y"}=$y;
762 $Curr{"M"}=$m;
763 $Curr{"D"}=$d;
764 $Curr{"H"}=$h;
765 $Curr{"Mn"}=$mn;
766 $Curr{"S"}=$s;
767 $Curr{"AmPm"}=$ampm;
768 $Curr{"Now"}=&Date_Join($y,$m,$d,$h,$mn,$s);
769 if ($Cnf{"TodayIsMidnight"}) {
770 $Curr{"Today"}=&Date_Join($y,$m,$d,0,0,0);
771 } else {
772 $Curr{"Today"}=$Curr{"Now"};
773 }
774
775 $Curr{"Debug"}=$Curr{"DebugVal"};
776
777 # If we're in array context, let's return a list of config variables
778 # that could be passed to Date_Init to get the same state as we're
779 # currently in.
780 if (wantarray) {
781 # Some special variables that have to be in a specific order
782 my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
783 my(%tmp)=map { $_,1 } @special;
784 my(@tmp,$key,$val);
785 foreach $key (@special) {
786 $val=$Cnf{$key};
787 push(@tmp,"$key=$val");
788 }
789 foreach $key (keys %Cnf) {
790 next if (exists $tmp{$key});
791 $val=$Cnf{$key};
792 push(@tmp,"$key=$val");
793 }
794 return @tmp;
795 }
796 return ();
797}
798
799sub ParseDateString {
800 print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
801 local($_)=@_;
802 return "" if (! $_);
803
804 my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
805 my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
806
807 # We only need to reinitialize if we have to determine what NOW is.
808 &Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
809
810 my($L)=$Cnf{"Language"};
811 my($type)=$Cnf{"DateFormat"};
812
813 # Mode is set in DateCalc. ParseDate only overrides it if the string
814 # contains a mode.
815 if ($Lang{$L}{"Exact"} &&
816 s/$Lang{$L}{"Exact"}//) {
817 $Curr{"Mode"}=0;
818 } elsif ($Lang{$L}{"Approx"} &&
819 s/$Lang{$L}{"Approx"}//) {
820 $Curr{"Mode"}=1;
821 } elsif ($Lang{$L}{"Business"} &&
822 s/$Lang{$L}{"Business"}//) {
823 $Curr{"Mode"}=2;
824 } elsif (! exists $Curr{"Mode"}) {
825 $Curr{"Mode"}=0;
826 }
827
828 # Unfortunately, some deltas can be parsed as dates. An example is
829 # 1 second == 1 2nd == 1 2
830 # But, some dates can be parsed as deltas. The most important being:
831 # 1998010101:00:00
832 #
833 # We'll check to see if a "date" can be parsed as a delta. If so, we'll
834 # assume that it is a delta (since they are much simpler, it is much
835 # less likely that we'll mistake a delta for a date than vice versa)
836 # unless it is an ISO-8601 date.
837 #
838 # This is important because we are using DateCalc to test whether a
839 # string is a date or a delta. Dates are tested first, so we need to
840 # be able to pass a delta into this routine and have it correctly NOT
841 # interpreted as a date.
842 #
843 # We will insist that the string contain something other than digits and
844 # colons so that the following will get correctly interpreted as a date
845 # rather than a delta:
846 # 12:30
847 # 19980101
848
849 $delta="";
850 $delta=&ParseDateDelta($_) if (/[^:0-9]/);
851
852 # Put parse in a simple loop for an easy exit.
853 PARSE: {
854 my(@tmp)=&Date_Split($_);
855 if (@tmp) {
856 ($y,$m,$d,$h,$mn,$s)=@tmp;
857 last PARSE;
858 }
859
860 # Fundamental regular expressions
861
862 my($month)=$Lang{$L}{"Month"}; # (jan|january|...)
863 my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
864 my($week)=$Lang{$L}{"Week"}; # (mon|monday|...)
865 my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
866 my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last)
867 my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
868 my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st)
869 my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
870 my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm)
871 my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight)
872 my($now)=$Lang{$L}{"Now"}; # now
873 my($today)=$Lang{$L}{"Today"}; # today
874 my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow)
875 my($zone)=$Zone{"zones"}; # (edt|est|...)
876 my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days)
877 my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months)
878 my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks)
879 my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next)
880 my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous)
881 my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago)
882 my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in)
883 my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later)
884 my($at)=$Lang{$L}{"At"}; # (?:at)
885 my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of)
886 my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)';
887 # \s*(?:on)\s* or \s+
888 my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last)
889 my($hm)=$Lang{$L}{"SepHM"}; # :
890 my($ms)=$Lang{$L}{"SepMS"}; # :
891 my($ss)=$Lang{$L}{"SepSS"}; # .
892
893 # Other regular expressions
894
895 my($D4)='(\d{4})'; # 4 digits (yr)
896 my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr)
897 my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
898 my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
899 my($FS)="(?:$ss\\d+)?"; # fractional secs
900 my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
901 # absolute time zone +0700 (GMT)
902 my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23
903 my($mzone)='(?:[0-5][0-9])'; # 00 - 59
904 my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))".
905 # +0700 +07:00 -07
906 '(?:\s*\([^)]+\))?)'; # (GMT)
907
908 # A regular expression for the time EXCEPT for the hour part
909 my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
910
911 # A special regular expression for /YYYY:HH:MN:SS used by Apache
912 my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
913
914 my($time)="";
915 $ampm="";
916 $date="";
917
918 # Substitute all special time expressions.
919 if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
920 $tmp=$2;
921 $tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
922 s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
923 }
924
925 # Remove some punctuation
926 s/[,]/ /g;
927
928 # When we have a digit followed immediately by a timezone (7EST), we
929 # will put a space between the digit, EXCEPT in the case of a single
930 # character military timezone. If the single character is followed
931 # by anything, no space is added.
932 $tmp = "";
933 while ( s/^(.*?\d)$zone(\s|$|[0-9])/$3/i ) {
934 my($bef,$z,$aft) = ($1,$2,$3);
935 if (length($z) != 1 || length($aft) == 0) {
936 $tmp .= "$bef $z";
937 } else {
938 $tmp .= "$bef$z";
939 }
940 }
941 $_ = "$tmp$_";
942 $zone = '\s+' . $zone . '(?:\s+|$)';
943
944 # Remove the time
945 $iso=1;
946 $midnight=0;
947 $from="24${hm}00(?:${ms}00)?";
948 $falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
949 $to="00${hm}00${ms}00";
950 $midnight=1 if (!/$falsefrom/ && s/$from/$to/);
951
952 $h=$mn=$s=0;
953 if (/$D$mnsec/i || /$ampmexp/i) {
954 $iso=0;
955 $tmp=0;
956 $tmp=1 if (/$mnsec$zone2?\s*$/i or /$mnsec$zone\s*$/i);
957 $tmp=0 if (/$ampmexp/i);
958 if (s/$apachetime$zone()/$1 /i ||
959 s/$apachetime$zone2?/$1 /i ||
960 s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i ||
961 s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i ||
962 s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i ||
963 s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i ||
964 (s/(t)$D$mnsec$zone()/$1 /i and (($iso=$tmp) || 1)) ||
965 (s/(t)$D$mnsec$zone2?/$1 /i and (($iso=$tmp) || 1)) ||
966 (s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) ||
967 (s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) ||
968 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i ||
969 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i ||
970 0
971 ) {
972 ($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
973 if (defined ($z)) {
974 if ($z =~ /^[+-]\d{2}:\d{2}$/) {
975 $z=~ s/://;
976 } elsif ($z =~ /^[+-]\d{2}$/) {
977 $z .= "00";
978 }
979 }
980 $time=1;
981 &Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
982 $y=$m=$d="";
983 # We're going to be calling TimeCheck again below (when we check the
984 # final date), so get rid of $ampm so that we don't have an error
985 # due to "15:30:00 PM". It'll get reset below.
986 $ampm="";
987 if (/^\s*$/) {
988 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
989 last PARSE;
990 }
991 }
992 }
993 $time=0 if ($time ne "1");
994 s/\s+$//;
995 s/^\s+//;
996
997 # if a zone was found, get rid of the regexps
998 if ($z) {
999 $zone="";
1000 $zone2="";
1001 }
1002
1003 # dateTtime ISO 8601 formats
1004 my($orig)=$_;
1005
1006 # Parse ISO 8601 dates now (which may still have a zone stuck to it).
1007 if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) ||
1008 ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) ||
1009 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) ||
1010 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) ||
1011 ($iso && /^([0-9-]+)T$zone?$/i) ||
1012 ($iso && /^([0-9-]+)T$zone2?$/i) ||
1013 0) {
1014
1015 # If we already got a timezone, don't get another one.
1016 my(@z);
1017 if ($z) {
1018 @z=($z,$z2);
1019 $z="";
1020 }
1021 ($_,$z,$z2) = ($1,$2,$3);
1022 ($z,$z2)=@z if (@z);
1023
1024 s,([0-9])\s*-,$1 ,g; # Change all ISO8601 seps to spaces
1025 s/^\s+//;
1026 s/\s+$//;
1027
1028 if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
1029 /^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
1030 0
1031 ) {
1032 # ISO 8601 Dates with times
1033 # YYYYMMDDtHHMNSSFFFF...
1034 # YYYYMMDDtHHMNSS
1035 # YYYYMMDDtHHMN
1036 # YYYYMMDDtHH
1037 # YY MMDDtHHMNSSFFFF...
1038 # YY MMDDtHHMNSS
1039 # YY MMDDtHHMN
1040 # YY MMDDtHH
1041 # The t is an optional letter "t".
1042 ($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
1043 if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) {
1044 $h=0;
1045 $midnight=1;
1046 }
1047 $z = "" if (! defined $h);
1048 return "" if ($time && defined $h);
1049 last PARSE;
1050
1051 } elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
1052 /^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
1053 # ISO 8601 Dates
1054 # YYYYMMDD
1055 # YYYYMM
1056 # YYYY
1057 # YY MMDD
1058 # YY MM
1059 # YY
1060 ($y,$m,$d)=($1,$2,$3);
1061 last PARSE;
1062
1063 } elsif (/^$YY\s+$D\s+$D/) {
1064 # YY-M-D
1065 ($y,$m,$d)=($1,$2,$3);
1066 last PARSE;
1067
1068 } elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
1069 # YY-W##-D
1070 ($y,$wofm,$dofw)=($1,$2,$3);
1071 ($y,$m,$d)=&Date_NthWeekOfYear($y,$wofm,$dofw);
1072 last PARSE;
1073
1074 } elsif (/^$D4\s*(\d{3})$/ ||
1075 /^$DD\s*(\d{3})$/) {
1076 # YYDOY
1077 ($y,$which)=($1,$2);
1078 ($y,$m,$d)=&Date_NthDayOfYear($y,$which);
1079 last PARSE;
1080
1081 } elsif ($iso<0) {
1082 # We confused something like 1999/August12:00:00
1083 # with a dateTtime format
1084 $_=$orig;
1085
1086 } else {
1087 return "";
1088 }
1089 }
1090
1091 # All deltas that are not ISO-8601 dates are NOT dates.
1092 return "" if ($Curr{"InCalc"} && $delta);
1093 if ($delta) {
1094 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1095 return &DateCalc_DateDelta($Curr{"Now"},$delta);
1096 }
1097
1098 # Check for some special types of dates (next, prev)
1099 foreach $from (keys %{ $Lang{$L}{"Repl"} }) {
1100 $to=$Lang{$L}{"Repl"}{$from};
1101 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
1102 }
1103 if (/$wom/i || /$future/i || /$later/i || /$past/i ||
1104 /$next/i || /$prev/i || /^$week$/i || /$wkabb/i) {
1105 $tmp=0;
1106
1107 if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
1108 # last friday in October 95
1109 ($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
1110 # fix $m, $y
1111 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1112 $dofw=$week{lc($dofw)};
1113 $wofm=$wom{lc($wofm)};
1114 # Get the first day of the month
1115 $date=&Date_Join($y,$m,1,$h,$mn,$s);
1116 if ($wofm==-1) {
1117 $date=&DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0);
1118 $date=&Date_GetPrev($date,$dofw,0);
1119 } else {
1120 for ($i=0; $i<$wofm; $i++) {
1121 if ($i==0) {
1122 $date=&Date_GetNext($date,$dofw,1);
1123 } else {
1124 $date=&Date_GetNext($date,$dofw,0);
1125 }
1126 }
1127 }
1128 last PARSE;
1129
1130 } elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
1131 # last day in month
1132 ($m,$y)=($1,$2);
1133 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1134 $y=&Date_FixYear($y) if (! defined $y or length($y)<4);
1135 $m=$month{lc($m)};
1136 $d=&Date_DaysInMonth($m,$y);
1137 last PARSE;
1138
1139 } elsif (/^$week$/i) {
1140 # friday
1141 ($dofw)=($1);
1142 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1143 $date=&Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1);
1144 $date=&Date_GetNext($date,$dofw,1,$h,$mn,$s);
1145 last PARSE;
1146
1147 } elsif (/^$next\s*$week$/i) {
1148 # next friday
1149 ($dofw)=($1);
1150 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1151 $date=&Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s);
1152 last PARSE;
1153
1154 } elsif (/^$prev\s*$week$/i) {
1155 # last friday
1156 ($dofw)=($1);
1157 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1158 $date=&Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s);
1159 last PARSE;
1160
1161 } elsif (/^$next$wkabb$/i) {
1162 # next week
1163 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1164 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0);
1165 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1166 last PARSE;
1167 } elsif (/^$prev$wkabb$/i) {
1168 # last week
1169 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1170 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0);
1171 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1172 last PARSE;
1173
1174 } elsif (/^$next$mabb$/i) {
1175 # next month
1176 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1177 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0);
1178 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1179 last PARSE;
1180 } elsif (/^$prev$mabb$/i) {
1181 # last month
1182 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1183 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0);
1184 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1185 last PARSE;
1186
1187 } elsif (/^$future\s*(\d+)$day$/i ||
1188 /^(\d+)$day$later$/i) {
1189 # in 2 days
1190 # 2 days later
1191 ($num)=($1);
1192 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1193 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0",
1194 \$err,0);
1195 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1196 last PARSE;
1197 } elsif (/^(\d+)$day$past$/i) {
1198 # 2 days ago
1199 ($num)=($1);
1200 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1201 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0",
1202 \$err,0);
1203 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1204 last PARSE;
1205
1206 } elsif (/^$future\s*(\d+)$wkabb$/i ||
1207 /^(\d+)$wkabb$later$/i) {
1208 # in 2 weeks
1209 # 2 weeks later
1210 ($num)=($1);
1211 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1212 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0",
1213 \$err,0);
1214 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1215 last PARSE;
1216 } elsif (/^(\d+)$wkabb$past$/i) {
1217 # 2 weeks ago
1218 ($num)=($1);
1219 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1220 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0",
1221 \$err,0);
1222 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1223 last PARSE;
1224
1225 } elsif (/^$future\s*(\d+)$mabb$/i ||
1226 /^(\d+)$mabb$later$/i) {
1227 # in 2 months
1228 # 2 months later
1229 ($num)=($1);
1230 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1231 $date=&DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0",
1232 \$err,0);
1233 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1234 last PARSE;
1235 } elsif (/^(\d+)$mabb$past$/i) {
1236 # 2 months ago
1237 ($num)=($1);
1238 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1239 $date=&DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0",
1240 \$err,0);
1241 $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
1242 last PARSE;
1243
1244 } elsif (/^$week$future\s*(\d+)$wkabb$/i ||
1245 /^$week\s*(\d+)$wkabb$later$/i) {
1246 # friday in 2 weeks
1247 # friday 2 weeks later
1248 ($dofw,$num)=($1,$2);
1249 $tmp="+";
1250 } elsif (/^$week\s*(\d+)$wkabb$past$/i) {
1251 # friday 2 weeks ago
1252 ($dofw,$num)=($1,$2);
1253 $tmp="-";
1254 } elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
1255 /^(\d+)$wkabb$later$on$week$/i) {
1256 # in 2 weeks on friday
1257 # 2 weeks later on friday
1258 ($num,$dofw)=($1,$2);
1259 $tmp="+"
1260 } elsif (/^(\d+)$wkabb$past$on$week$/i) {
1261 # 2 weeks ago on friday
1262 ($num,$dofw)=($1,$2);
1263 $tmp="-";
1264 } elsif (/^$week\s*$wkabb$/i) {
1265 # monday week (British date: in 1 week on monday)
1266 $dofw=$1;
1267 $num=1;
1268 $tmp="+";
1269 } elsif ( (/^$now\s*$wkabb$/i && ($tmp="Now")) ||
1270 (/^$today\s*$wkabb$/i && ($tmp="Today")) ) {
1271 # now week (British date: 1 week from now)
1272 # today week (British date: 1 week from today)
1273 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1274 $date=&DateCalc_DateDelta($Curr{$tmp},"+0:0:1:0:0:0:0",\$err,0);
1275 $date=&Date_SetTime($date,$h,$mn,$s) if ($time);
1276 last PARSE;
1277 } elsif (/^$offset\s*$wkabb$/i) {
1278 # tomorrow week (British date: 1 week from tomorrow)
1279 ($offset)=($1);
1280 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1281 $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
1282 $date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1283 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0);
1284 if ($time) {
1285 return ""
1286 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1287 $date=&Date_SetTime($date,$h,$mn,$s);
1288 }
1289 last PARSE;
1290 }
1291
1292 if ($tmp) {
1293 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1294 $date=&DateCalc_DateDelta($Curr{"Now"},
1295 $tmp . "0:0:$num:0:0:0:0",\$err,0);
1296 $date=&Date_GetPrev($date,$Cnf{"FirstDay"},1);
1297 $date=&Date_GetNext($date,$dofw,1,$h,$mn,$s);
1298 last PARSE;
1299 }
1300 }
1301
1302 # Change (2nd, second) to 2
1303 $tmp=0;
1304 if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
1305 if (/^\s*$dom\s*$/) {
1306 ($d)=($1);
1307 $d=$dom{lc($d)};
1308 $m=$Curr{"M"};
1309 last PARSE;
1310 }
1311 my $from = $2;
1312 my $to = $dom{ lc($from) };
1313 s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
1314 s/^\s+//;
1315 s/\s+$//;
1316 }
1317
1318 # Another set of special dates (Nth week)
1319 if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
1320 # 22nd sunday in 1996
1321 ($which,$dofw,$y)=($1,$2,$3);
1322 $y=$Curr{"Y"} if (! $y);
1323 $y--; # previous year
1324 $tmp=&Date_GetNext("$y-12-31",$dofw,0);
1325 if ($which>1) {
1326 $tmp=&DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0);
1327 }
1328 ($y,$m,$d)=(&Date_Split($tmp, 1))[0..2];
1329 last PARSE;
1330 } elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
1331 /^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
1332 # sunday week 22 in 1996
1333 # sunday 22nd week in 1996
1334 ($dofw,$which,$y)=($1,$2,$3);
1335 ($y,$m,$d)=&Date_NthWeekOfYear($y,$which,$dofw);
1336 last PARSE;
1337 }
1338
1339 # Get rid of day of week
1340 if (/(^|[^a-z])$week($|[^a-z])/i) {
1341 $wk=$2;
1342 (s/(^|[^a-z])$week,/$1 /i) ||
1343 s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
1344 s/^\s+//;
1345 s/\s+$//;
1346 }
1347
1348 {
1349 # So that we can handle negative epoch times, let's convert
1350 # things like "epoch -" to "epochNEGATIVE " before we strip out
1351 # the $sep chars, which include '-'.
1352 s,epoch\s*-,epochNEGATIVE ,g;
1353
1354 # Non-ISO8601 dates
1355 s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces
1356 s,^\s*,,; # remove leading/trailing space
1357 s,\s*$,,;
1358
1359 if (/^$D\s+$D(?:\s+$YY)?$/) {
1360 # MM DD YY (DD MM YY non-US)
1361 ($m,$d,$y)=($1,$2,$3);
1362 ($m,$d)=($d,$m) if ($type ne "US");
1363 last PARSE;
1364
1365 } elsif (/^$D4\s*$D\s*$D$/) {
1366 # YYYY MM DD
1367 ($y,$m,$d)=($1,$2,$3);
1368 last PARSE;
1369
1370 } elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
1371 ($m)=($2);
1372
1373 if (/^\s*$D(?:\s+$YY)?\s*$/) {
1374 # mmm DD YY
1375 # DD mmm YY
1376 # DD YY mmm
1377 ($d,$y)=($1,$2);
1378 last PARSE;
1379
1380 } elsif (/^\s*$D$D4\s*$/) {
1381 # mmm DD YYYY
1382 # DD mmm YYYY
1383 # DD YYYY mmm
1384 ($d,$y)=($1,$2);
1385 last PARSE;
1386
1387 } elsif (/^\s*$D4\s*$D\s*$/) {
1388 # mmm YYYY DD
1389 # YYYY mmm DD
1390 # YYYY DD mmm
1391 ($y,$d)=($1,$2);
1392 last PARSE;
1393
1394 } elsif (/^\s*$D4\s*$/) {
1395 # mmm YYYY
1396 # YYYY mmm
1397 ($y,$d)=($1,1);
1398 last PARSE;
1399
1400 } else {
1401 return "";
1402 }
1403
1404 } elsif (/^epochNEGATIVE (\d+)$/) {
1405 $s=$1;
1406 $date=&DateCalc("1970-01-01 00:00 GMT","-0:0:$s");
1407 } elsif (/^epoch\s*(\d+)$/i) {
1408 $s=$1;
1409 $date=&DateCalc("1970-01-01 00:00 GMT","+0:0:$s");
1410
1411 } elsif ( (/^$now$/i && ($tmp="Now")) ||
1412 (/^$today$/i && ($tmp="Today")) ) {
1413 # now, today
1414 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1415 $date=$Curr{$tmp};
1416 if ($time) {
1417 return ""
1418 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1419 $date=&Date_SetTime($date,$h,$mn,$s);
1420 }
1421 last PARSE;
1422
1423 } elsif (/^$offset$/i) {
1424 # yesterday, tomorrow
1425 ($offset)=($1);
1426 &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1427 $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
1428 $date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1429 if ($time) {
1430 return ""
1431 if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1432 $date=&Date_SetTime($date,$h,$mn,$s);
1433 }
1434 last PARSE;
1435
1436 } else {
1437 return "";
1438 }
1439 }
1440 }
1441
1442 if (! $date) {
1443 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1444 $date=&Date_Join($y,$m,$d,$h,$mn,$s);
1445 }
1446 $date=&Date_ConvTZ($date,$z);
1447 if ($midnight) {
1448 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0");
1449 }
1450 return $date;
1451}
1452
1453sub ParseDate {
1454 print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
1455 &Date_Init() if (! $Curr{"InitDone"});
1456 my($args,@args,@a,$ref,$date)=();
1457 @a=@_;
1458
1459 # @a : is the list of args to ParseDate. Currently, only one argument
1460 # is allowed and it must be a scalar (or a reference to a scalar)
1461 # or a reference to an array.
1462
1463 if ($#a!=0) {
1464 print "ERROR: Invalid number of arguments to ParseDate.\n";
1465 return "";
1466 }
1467 $args=$a[0];
1468 $ref=ref $args;
1469 if (! $ref) {
1470 return $args if (&Date_Split($args));
1471 @args=($args);
1472 } elsif ($ref eq "ARRAY") {
1473 @args=@$args;
1474 } elsif ($ref eq "SCALAR") {
1475 return $$args if (&Date_Split($$args));
1476 @args=($$args);
1477 } else {
1478 print "ERROR: Invalid arguments to ParseDate.\n";
1479 return "";
1480 }
1481 @a=@args;
1482
1483 # @args : a list containing all the arguments (dereferenced if appropriate)
1484 # @a : a list containing all the arguments currently being examined
1485 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1486 # reference to a scalar, or a reference to an array was passed in
1487 # $args : the scalar or refererence passed in
1488
1489 PARSE: while($#a>=0) {
1490 $date=join(" ",@a);
1491 $date=&ParseDateString($date);
1492 last if ($date);
1493 pop(@a);
1494 } # PARSE
1495
1496 splice(@args,0,$#a + 1);
1497 @$args= @args if (defined $ref and $ref eq "ARRAY");
1498 $date;
1499}
1500
1501sub Date_Cmp {
1502 my($D1,$D2)=@_;
1503 my($date1)=&ParseDateString($D1);
1504 my($date2)=&ParseDateString($D2);
1505 return $date1 cmp $date2;
1506}
1507
1508# **NOTE**
1509# The calc routines all call parse routines, so it is never necessary to
1510# call Date_Init in the calc routines.
1511sub DateCalc {
1512 print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
1513 my($D1,$D2,@arg)=@_;
1514 my($ref,$err,$errref,$mode)=();
1515
1516 ($errref,$mode) = (@arg);
1517 $ref=0;
1518
1519 if (defined $errref) {
1520 if (ref $errref) {
1521 $ref=1;
1522 } elsif (! defined $mode) {
1523 $mode=$errref;
1524 $errref="";
1525 }
1526 }
1527
1528 my(@date,@delta,$ret,$tmp,$oldincalc,$oldmode)=();
1529
1530 if (exists $Curr{"Mode"}) {
1531 $oldmode = $Curr{"Mode"};
1532 } else {
1533 $oldmode = 0;
1534 }
1535
1536 if (defined $mode and $mode>=0 and $mode<=3) {
1537 $Curr{"Mode"}=$mode;
1538 } else {
1539 $Curr{"Mode"}=0;
1540 }
1541
1542 if (exists $Curr{"InCalc"}) {
1543 $oldincalc = $Curr{"InCalc"};
1544 } else {
1545 $oldincalc = 0;
1546 }
1547 $Curr{"InCalc"}=1;
1548
1549 if ($tmp=&ParseDateString($D1)) {
1550 # If we've already parsed the date, we don't want to do it a second
1551 # time (so we don't convert timezones twice).
1552 if (&Date_Split($D1)) {
1553 push(@date,$D1);
1554 } else {
1555 push(@date,$tmp);
1556 }
1557 } elsif ($tmp=&ParseDateDelta($D1)) {
1558 push(@delta,$tmp);
1559 } else {
1560 $$errref=1 if ($ref);
1561 $Curr{"InCalc"} = $oldincalc;
1562 $Curr{"Mode"} = $oldmode;
1563 return;
1564 }
1565
1566 if ($tmp=&ParseDateString($D2)) {
1567 if (&Date_Split($D2)) {
1568 push(@date,$D2);
1569 } else {
1570 push(@date,$tmp);
1571 }
1572 } elsif ($tmp=&ParseDateDelta($D2)) {
1573 push(@delta,$tmp);
1574 $mode = $Curr{"Mode"};
1575 } else {
1576 $$errref=2 if ($ref);
1577 $Curr{"InCalc"} = $oldincalc;
1578 $Curr{"Mode"} = $oldmode;
1579 return;
1580 }
1581
1582 $Curr{"InCalc"} = $oldincalc;
1583 $Curr{"Mode"} = $oldmode;
1584
1585 if ($#date==1) {
1586 $ret=&DateCalc_DateDate(@date,$mode);
1587 } elsif ($#date==0) {
1588 $ret=&DateCalc_DateDelta(@date,@delta,\$err,$mode);
1589 $$errref=$err if ($ref);
1590 } else {
1591 $ret=&DateCalc_DeltaDelta(@delta,$mode);
1592 }
1593 $ret;
1594}
1595
1596sub ParseDateDelta {
1597 print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
1598 my($args,@args,@a,$ref)=();
1599 local($_)=();
1600 @a=@_;
1601
1602 # @a : is the list of args to ParseDateDelta. Currently, only one argument
1603 # is allowed and it must be a scalar (or a reference to a scalar)
1604 # or a reference to an array.
1605
1606 if ($#a!=0) {
1607 print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
1608 return "";
1609 }
1610 $args=$a[0];
1611 $ref=ref $args;
1612 if (! $ref) {
1613 @args=($args);
1614 } elsif ($ref eq "ARRAY") {
1615 @args=@$args;
1616 } elsif ($ref eq "SCALAR") {
1617 @args=($$args);
1618 } else {
1619 print "ERROR: Invalid arguments to ParseDateDelta.\n";
1620 return "";
1621 }
1622 @a=@args;
1623
1624 # @args : a list containing all the arguments (dereferenced if appropriate)
1625 # @a : a list containing all the arguments currently being examined
1626 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1627 # reference to a scalar, or a reference to an array was passed in
1628 # $args : the scalar or refererence passed in
1629
1630 my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=();
1631 my($len,$tmp,$tmp2,$tmpl)=();
1632 my($from,$to)=();
1633 my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1;
1634
1635 &Date_Init() if (! $Curr{"InitDone"});
1636 # A sign can be a sequence of zero or more + and - signs, this
1637 # allows for deltas like '+ -2 days'.
1638 my($signexp)='((?:[+-]\s*)*)';
1639 my($numexp)='(\d+)';
1640 my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)";
1641 my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=();
1642 $yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()";
1643 $yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?";
1644 $mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?";
1645 $wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?";
1646 $dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?";
1647 $hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?";
1648 $mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?";
1649 $sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?";
1650 my($future)=$Lang{$Cnf{"Language"}}{"Future"};
1651 my($later)=$Lang{$Cnf{"Language"}}{"Later"};
1652 my($past)=$Lang{$Cnf{"Language"}}{"Past"};
1653
1654 $delta="";
1655 PARSE: while (@a) {
1656 $_ = join(" ", grep {defined;} @a);
1657 s/\s+$//;
1658 last if ($_ eq "");
1659
1660 # Mode is set in DateCalc. ParseDateDelta only overrides it if the
1661 # string contains a mode.
1662 if ($Lang{$Cnf{"Language"}}{"Exact"} &&
1663 s/$Lang{$Cnf{"Language"}}{"Exact"}//) {
1664 $Curr{"Mode"}=0;
1665 } elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
1666 s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
1667 $Curr{"Mode"}=1;
1668 } elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
1669 s/$Lang{$Cnf{"Language"}}{"Business"}//) {
1670 $Curr{"Mode"}=2;
1671 } elsif (! exists $Curr{"Mode"}) {
1672 $Curr{"Mode"}=0;
1673 }
1674 $workweek=7 if ($Curr{"Mode"} != 2);
1675
1676 foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) {
1677 $to=$Lang{$Cnf{"Language"}}{"Repl"}{$from};
1678 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
1679 }
1680
1681 # in or ago
1682 #
1683 # We need to make sure that $later, $future, and $past don't contain each
1684 # other... Romanian pointed this out where $past is "in urma" and $future
1685 # is "in". When they do, we have to take this into account.
1686 # $len length of best match (greatest wins)
1687 # $tmp string after best match
1688 # $dir direction (prior, after) of best match
1689 #
1690 # $tmp2 string before/after current match
1691 # $tmpl length of current match
1692
1693 $len=0;
1694 $tmp=$_;
1695 $dir=1;
1696
1697 $tmp2=$_;
1698 if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
1699 $tmpl=length($2);
1700 if ($tmpl>$len) {
1701 $tmp=$tmp2;
1702 $dir=1;
1703 $len=$tmpl;
1704 }
1705 }
1706
1707 $tmp2=$_;
1708 if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
1709 $tmpl=length($2);
1710 if ($tmpl>$len) {
1711 $tmp=$tmp2;
1712 $dir=1;
1713 $len=$tmpl;
1714 }
1715 }
1716
1717 $tmp2=$_;
1718 if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
1719 $tmpl=length($2);
1720 if ($tmpl>$len) {
1721 $tmp=$tmp2;
1722 $dir=-1;
1723 $len=$tmpl;
1724 }
1725 }
1726
1727 $_ = $tmp;
1728 s/\s*$//;
1729
1730 # the colon part of the delta
1731 $colon="";
1732 if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
1733 $colon=$1;
1734 s/\s+$//;
1735 }
1736 @colon=split(/:/,$colon);
1737
1738 # the non-colon part of the delta
1739 $sign="+";
1740 @delta=();
1741 $i=6;
1742 foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
1743 last if ($#colon>=$i--);
1744 $val=0;
1745 if (s/^$exp1//ix) {
1746 $val=$2 if ($2);
1747 $sign=$1 if ($1);
1748 }
1749
1750 # Collapse a sign like '+ -' into a single character like '-',
1751 # by counting the occurrences of '-'.
1752 #
1753 $sign =~ s/\s+//g;
1754 $sign =~ tr/+//d;
1755 my $count = ($sign =~ tr/-//d);
1756 die "bad characters in sign: $sign" if length $sign;
1757 $sign = $count % 2 ? '-' : '+';
1758
1759 push(@delta,"$sign$val");
1760 }
1761 if (! /^\s*$/) {
1762 pop(@a);
1763 next PARSE;
1764 }
1765
1766 # make sure that the colon part has a sign
1767 for ($i=0; $i<=$#colon; $i++) {
1768 $val=0;
1769 if ($colon[$i] =~ /^$signexp$numexp?/) {
1770 $val=$2 if ($2);
1771 $sign=$1 if ($1);
1772 }
1773 $colon[$i] = "$sign$val";
1774 }
1775
1776 # combine the two
1777 push(@delta,@colon);
1778 if ($dir<0) {
1779 for ($i=0; $i<=$#delta; $i++) {
1780 $delta[$i] =~ tr/-+/+-/;
1781 }
1782 }
1783
1784 # form the delta and shift off the valid part
1785 $delta=join(":",@delta);
1786 splice(@args,0,$#a+1);
1787 @$args=@args if (defined $ref and $ref eq "ARRAY");
1788 last PARSE;
1789 }
1790
1791 $delta=&Delta_Normalize($delta,$Curr{"Mode"});
1792 return $delta;
1793}
1794
1795sub UnixDate {
1796 print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
1797 my($date,@format)=@_;
1798 local($_)=();
1799 my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
1800 my($scalar)=();
1801 $date=&ParseDateString($date);
1802 return if (! $date);
1803
1804 my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
1805 &Date_Split($date, 1);
1806 $f{"y"}=substr $f{"Y"},2;
1807 &Date_Init() if (! $Curr{"InitDone"});
1808
1809 if (! wantarray) {
1810 $format=join(" ",@format);
1811 @format=($format);
1812 $scalar=1;
1813 }
1814
1815 # month, week
1816 $_=$m;
1817 s/^0//;
1818 $f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
1819 $f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
1820 $_=$m;
1821 s/^0/ /;
1822 $f{"f"}=$_;
1823 $f{"U"}=&Date_WeekOfYear($m,$d,$y,7);
1824 $f{"W"}=&Date_WeekOfYear($m,$d,$y,1);
1825
1826 # check week 52,53 and 0
1827 $f{"G"}=$f{"L"}=$y;
1828 if ($f{"W"}>=52 || $f{"U"}>=52) {
1829 my($dd,$mm,$yy)=($d,$m,$y);
1830 $dd+=7;
1831 if ($dd>31) {
1832 $dd-=31;
1833 $mm=1;
1834 $yy++;
1835 if (&Date_WeekOfYear($mm,$dd,$yy,1)==2) {
1836 $f{"G"}=$yy;
1837 $f{"W"}=1;
1838 }
1839 if (&Date_WeekOfYear($mm,$dd,$yy,7)==2) {
1840 $f{"L"}=$yy;
1841 $f{"U"}=1;
1842 }
1843 }
1844 }
1845 if ($f{"W"}==0) {
1846 my($dd,$mm,$yy)=($d,$m,$y);
1847 $dd-=7;
1848 $dd+=31 if ($dd<1);
1849 $yy = sprintf "%04d", $yy-1;
1850 $mm=12;
1851 $f{"G"}=$yy;
1852 $f{"W"}=&Date_WeekOfYear($mm,$dd,$yy,1)+1;
1853 }
1854 if ($f{"U"}==0) {
1855 my($dd,$mm,$yy)=($d,$m,$y);
1856 $dd-=7;
1857 $dd+=31 if ($dd<1);
1858 $yy = sprintf "%04d", $yy-1;
1859 $mm=12;
1860 $f{"L"}=$yy;
1861 $f{"U"}=&Date_WeekOfYear($mm,$dd,$yy,7)+1;
1862 }
1863
1864 $f{"U"}="0".$f{"U"} if (length $f{"U"} < 2);
1865 $f{"W"}="0".$f{"W"} if (length $f{"W"} < 2);
1866
1867 # day
1868 $f{"j"}=&Date_DayOfYear($m,$d,$y);
1869 $f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
1870 $_=$d;
1871 s/^0/ /;
1872 $f{"e"}=$_;
1873 $f{"w"}=&Date_DayOfWeek($m,$d,$y);
1874 $f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1];
1875 $f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2);
1876 $f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1];
1877 $f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1];
1878 $f{"E"}=&Date_DaySuffix($f{"e"});
1879
1880 # hour
1881 $_=$h;
1882 s/^0/ /;
1883 $f{"k"}=$_;
1884 $f{"i"}=$f{"k"}+1;
1885 $f{"i"}=$f{"k"};
1886 $f{"i"}=12 if ($f{"k"}==0);
1887 $f{"i"}=$f{"k"}-12 if ($f{"k"}>12);
1888 $f{"i"}=$f{"i"}-12 if ($f{"i"}>12);
1889 $f{"i"}=" ".$f{"i"} if (length($f{"i"})<2);
1890 $f{"I"}=$f{"i"};
1891 $f{"I"}=~ s/^ /0/;
1892 $f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"};
1893 $f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11);
1894
1895 # minute, second, timezone
1896 $f{"o"}=&Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
1897 $f{"s"}=&Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s);
1898 $f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ?
1899 $Cnf{"TZ"} : $Cnf{"ConvTZ"};
1900 $f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || "");
1901
1902 # date, time
1903 $f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
1904 $f{"C"}=$f{"u"}=
1905 qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|;
1906 $f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|;
1907 $f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|;
1908 $f{"x"}=qq|$d/$m/$f{"y"}| if ($Cnf{"DateFormat"} ne "US");
1909 $f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|;
1910 $f{"R"}=qq|$h:$mn|;
1911 $f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
1912 $f{"V"}=qq|$m$d$h$mn$f{"y"}|;
1913 $f{"Q"}="$y$m$d";
1914 $f{"q"}=qq|$y$m$d$h$mn$s|;
1915 $f{"P"}=qq|$y$m$d$h:$mn:$s|;
1916 $f{"O"}=qq|$y-$m-${d}T$h:$mn:$s|;
1917 $f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|;
1918 if ($f{"W"}==0) {
1919 $y--;
1920 $tmp=&Date_WeekOfYear(12,31,$y,1);
1921 $tmp="0$tmp" if (length($tmp) < 2);
1922 $f{"J"}=qq|$y-W$tmp-$f{"w"}|;
1923 } else {
1924 $f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|;
1925 }
1926 $f{"K"}=qq|$y-$f{"j"}|;
1927 # %l is a special case. Since it requires the use of the calculator
1928 # which requires this routine, an infinite recursion results. To get
1929 # around this, %l is NOT determined every time this is called so the
1930 # recursion breaks.
1931
1932 # other formats
1933 $f{"n"}="\n";
1934 $f{"t"}="\t";
1935 $f{"%"}="%";
1936 $f{"+"}="+";
1937
1938 foreach $format (@format) {
1939 $format=reverse($format);
1940 $out="";
1941 while ($format ne "") {
1942 $c=chop($format);
1943 if ($c eq "%") {
1944 $c=chop($format);
1945 if ($c eq "l") {
1946 &Date_Init();
1947 $date1=&DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0");
1948 $date2=&DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0");
1949 if (&Date_Cmp($date,$date1)>=0 && &Date_Cmp($date,$date2)<=0) {
1950 $f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|;
1951 } else {
1952 $f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
1953 }
1954 $out .= $f{"$c"};
1955 } elsif (exists $f{"$c"}) {
1956 $out .= $f{"$c"};
1957 } else {
1958 $out .= $c;
1959 }
1960 } else {
1961 $out .= $c;
1962 }
1963 }
1964 push(@out,$out);
1965 }
1966 if ($scalar) {
1967 return $out[0];
1968 } else {
1969 return (@out);
1970 }
1971}
1972
1973# Can't be in "use integer" because we're doing decimal arithmatic
1974no integer;
1975sub Delta_Format {
1976 print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
1977 my($delta,@arg)=@_;
1978 my($mode);
1979 if (lc($arg[0]) eq "approx") {
1980 $mode = "approx";
1981 shift(@arg);
1982 } else {
1983 $mode = "exact";
1984 }
1985 my($dec,@format) = @arg;
1986
1987 $delta=&ParseDateDelta($delta);
1988 return "" if (! $delta);
1989 my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
1990 local($_)=$delta;
1991 my($y,$M,$w,$d,$h,$m,$s)=&Delta_Split($delta);
1992 # Get rid of positive signs.
1993 ($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s);
1994
1995 if (defined $dec && $dec>0) {
1996 $dec="%." . ($dec*1) . "f";
1997 } else {
1998 $dec="%f";
1999 }
2000
2001 if (! wantarray) {
2002 $format=join(" ",@format);
2003 @format=($format);
2004 $scalar=1;
2005 }
2006
2007 # Length of each unit in seconds
2008 my($sl,$ml,$hl,$dl,$wl,$Ml,$yl)=();
2009 $sl = 1;
2010 $ml = $sl*60;
2011 $hl = $ml*60;
2012 $dl = $hl*24;
2013 $wl = $dl*7;
2014 $yl = $dl*365.25;
2015 $Ml = $yl/12;
2016
2017 # The decimal amount of each unit contained in all smaller units
2018 my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
2019 if ($mode eq "exact") {
2020 $yd = $M/12;
2021 $Md = 0;
2022 } else {
2023 $yd = ($M*$Ml + $w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
2024 $Md = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$Ml;
2025 }
2026
2027 $wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
2028 $dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
2029 $hd = ($m*$ml + $s*$sl)/$hl;
2030 $md = ($s*$sl)/$ml;
2031 $sd = 0;
2032
2033 # The amount of each unit contained in higher units.
2034 my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
2035 $yh = 0;
2036 $Mh = ($yh+$y)*12;
2037
2038 if ($mode eq "exact") {
2039 $wh = 0;
2040 $dh = ($wh+$w)*7;
2041 } else {
2042 $wh = ($yh+$y+$M/12)*365.25/7;
2043 $dh = ($wh+$w)*7;
2044 }
2045
2046 $hh = ($dh+$d)*24;
2047 $mh = ($hh+$h)*60;
2048 $sh = ($mh+$m)*60;
2049
2050 # Set up the formats
2051
2052 $f{"yv"} = $y;
2053 $f{"Mv"} = $M;
2054 $f{"wv"} = $w;
2055 $f{"dv"} = $d;
2056 $f{"hv"} = $h;
2057 $f{"mv"} = $m;
2058 $f{"sv"} = $s;
2059
2060 $f{"yh"} = $y+$yh;
2061 $f{"Mh"} = $M+$Mh;
2062 $f{"wh"} = $w+$wh;
2063 $f{"dh"} = $d+$dh;
2064 $f{"hh"} = $h+$hh;
2065 $f{"mh"} = $m+$mh;
2066 $f{"sh"} = $s+$sh;
2067
2068 $f{"yd"} = sprintf($dec,$y+$yd);
2069 $f{"Md"} = sprintf($dec,$M+$Md);
2070 $f{"wd"} = sprintf($dec,$w+$wd);
2071 $f{"dd"} = sprintf($dec,$d+$dd);
2072 $f{"hd"} = sprintf($dec,$h+$hd);
2073 $f{"md"} = sprintf($dec,$m+$md);
2074 $f{"sd"} = sprintf($dec,$s+$sd);
2075
2076 $f{"yt"} = sprintf($dec,$yh+$y+$yd);
2077 $f{"Mt"} = sprintf($dec,$Mh+$M+$Md);
2078 $f{"wt"} = sprintf($dec,$wh+$w+$wd);
2079 $f{"dt"} = sprintf($dec,$dh+$d+$dd);
2080 $f{"ht"} = sprintf($dec,$hh+$h+$hd);
2081 $f{"mt"} = sprintf($dec,$mh+$m+$md);
2082 $f{"st"} = sprintf($dec,$sh+$s+$sd);
2083
2084 $f{"%"} = "%";
2085
2086 foreach $format (@format) {
2087 $format=reverse($format);
2088 $out="";
2089 PARSE: while ($format) {
2090 $c1=chop($format);
2091 if ($c1 eq "%") {
2092 $c1=chop($format);
2093 if (exists($f{$c1})) {
2094 $out .= $f{$c1};
2095 next PARSE;
2096 }
2097 $c2=chop($format);
2098 if (exists($f{"$c1$c2"})) {
2099 $out .= $f{"$c1$c2"};
2100 next PARSE;
2101 }
2102 $out .= $c1;
2103 $format .= $c2;
2104 } else {
2105 $out .= $c1;
2106 }
2107 }
2108 push(@out,$out);
2109 }
2110 if ($scalar) {
2111 return $out[0];
2112 } else {
2113 return (@out);
2114 }
2115}
2116use integer;
2117
2118sub ParseRecur {
2119 print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
2120 &Date_Init() if (! $Curr{"InitDone"});
2121
2122 my($recur,$dateb,$date0,$date1,$flag)=@_;
2123 local($_)=$recur;
2124
2125 my($recur_0,$recur_1,@recur0,@recur1)=();
2126 my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=();
2127 my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=();
2128
2129 # $date0, $date1, $dateb, $flag : passed in (these are always the final say
2130 # in determining whether a date matches a
2131 # recurrence IF they are present.
2132 # $date_b, $date_0, $date_1 : if a value can be determined from the
2133 # $flag_t recurrence, they are stored here.
2134 #
2135 # If values can be determined from the recurrence AND are passed in, the
2136 # following are used:
2137 # max($date0,$date_0) i.e. the later of the two dates
2138 # min($date1,$date_1) i.e. the earlier of the two dates
2139 #
2140 # The base date that is used is the first one defined from
2141 # $dateb $date_b
2142 # The base date is only used if necessary (as determined by the recur).
2143 # For example, "every other friday" requires a base date, but "2nd
2144 # friday of every month" doesn't.
2145
2146 my($date_b,$date_0,$date_1,$flag_t);
2147
2148 #
2149 # Check the arguments passed in.
2150 #
2151
2152 $date0="" if (! defined $date0);
2153 $date1="" if (! defined $date1);
2154 $dateb="" if (! defined $dateb);
2155 $flag ="" if (! defined $flag);
2156
2157 if ($dateb) {
2158 $dateb=&ParseDateString($dateb);
2159 return "" if (! $dateb);
2160 }
2161 if ($date0) {
2162 $date0=&ParseDateString($date0);
2163 return "" if (! $date0);
2164 }
2165 if ($date1) {
2166 $date1=&ParseDateString($date1);
2167 return "" if (! $date1);
2168 }
2169
2170 #
2171 # Parse the recur. $date_b, $date_0, and $date_e are values obtained
2172 # from the recur.
2173 #
2174
2175 @tmp=&Recur_Split($_);
2176
2177 if (@tmp) {
2178 ($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp;
2179 $recur_0 = "" if (! defined $recur_0);
2180 $recur_1 = "" if (! defined $recur_1);
2181 $flag_t = "" if (! defined $flag_t);
2182 $date_b = "" if (! defined $date_b);
2183 $date_0 = "" if (! defined $date_0);
2184 $date_1 = "" if (! defined $date_1);
2185
2186 @recur0 = split(/:/,$recur_0);
2187 @recur1 = split(/:/,$recur_1);
2188 return "" if ($#recur0 + $#recur1 + 2 != 7);
2189
2190 if ($date_b) {
2191 $date_b=&ParseDateString($date_b);
2192 return "" if (! $date_b);
2193 }
2194 if ($date_0) {
2195 $date_0=&ParseDateString($date_0);
2196 return "" if (! $date_0);
2197 }
2198 if ($date_1) {
2199 $date_1=&ParseDateString($date_1);
2200 return "" if (! $date_1);
2201 }
2202
2203 } else {
2204
2205 my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...)
2206 my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... }
2207 my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...)
2208 my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... }
2209 my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days)
2210 my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months)
2211 my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks)
2212 my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st)
2213 my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} };
2214 # { 1st=>1,first=>1,...}
2215 my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of)
2216 my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last)
2217 my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every)
2218
2219 my($D)='\s*(\d+)';
2220 my($Y)='\s*(\d{4}|\d{2})';
2221
2222 # Change 1st to 1
2223 if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
2224 $tmp=lc($2);
2225 $tmp=$dayshash{"$tmp"};
2226 s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
2227 }
2228 s/\s*$//;
2229
2230 # Get rid of "each"
2231 if (/(^|[^a-z])$each($|[^a-z])/i) {
2232 s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
2233 $each=1;
2234 } else {
2235 $each=0;
2236 }
2237
2238 if ($each) {
2239
2240 if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
2241 /^$D?$day(?:$of$mmm())?$/i) {
2242 # every [2nd] day in [june] 1997
2243 # every [2nd] day [in june]
2244 ($num,$m,$y)=($1,$2,$3);
2245 $num=1 if (! defined $num);
2246 $m="" if (! defined $m);
2247 $y="" if (! defined $y);
2248
2249 $y=$Curr{"Y"} if (! $y);
2250 if ($m) {
2251 $m=$mmm{lc($m)};
2252 $date_0=&Date_Join($y,$m,1,0,0,0);
2253 $date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
2254 } else {
2255 $date_0=&Date_Join($y, 1,1,0,0,0);
2256 $date_1=&Date_Join($y+1,1,1,0,0,0);
2257 }
2258 $date_b=&DateCalc($date_0,"-0:0:0:1:0:0:0",0);
2259 @recur0=(0,0,0,$num,0,0,0);
2260 @recur1=();
2261
2262 } elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
2263 # 2nd [day] of every month [in 1997]
2264 ($num,$y)=($1,$2);
2265 $y=$Curr{"Y"} if (! $y);
2266
2267 $date_0=&Date_Join($y, 1,1,0,0,0);
2268 $date_1=&Date_Join($y+1,1,1,0,0,0);
2269 $date_b=$date_0;
2270
2271 @recur0=(0,1,0);
2272 @recur1=($num,0,0,0);
2273
2274 } elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ ||
2275 /^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) {
2276 # 2nd tuesday of every month [in 1997]
2277 # last tuesday of every month [in 1997]
2278 ($num,$d,$y)=($1,$2,$3);
2279 $y=$Curr{"Y"} if (! $y);
2280 $d=$week{lc($d)};
2281 $num=-1 if ($num !~ /^$D$/);
2282
2283 $date_0=&Date_Join($y,1,1,0,0,0);
2284 $date_1=&Date_Join($y+1,1,1,0,0,0);
2285 $date_b=$date_0;
2286
2287 @recur0=(0,1);
2288 @recur1=($num,$d,0,0,0);
2289
2290 } elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i ||
2291 /^$D?$wkexp(?:$of$mmm())?$/i) {
2292 # every tuesday in june 1997
2293 # every 2nd tuesday in june 1997
2294 ($num,$d,$m,$y)=($1,$2,$3,$4);
2295 $y=$Curr{"Y"} if (! $y);
2296 $num=1 if (! defined $num);
2297 $m="" if (! defined $m);
2298 $d=$week{lc($d)};
2299
2300 if ($m) {
2301 $m=$mmm{lc($m)};
2302 $date_0=&Date_Join($y,$m,1,0,0,0);
2303 $date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
2304 } else {
2305 $date_0=&Date_Join($y,1,1,0,0,0);
2306 $date_1=&Date_Join($y+1,1,1,0,0,0);
2307 }
2308 $date_b=&DateCalc($date_0,"-0:0:0:1:0:0:0",0);
2309
2310 @recur0=(0,0,$num);
2311 @recur1=($d,0,0,0);
2312
2313 } else {
2314 return "";
2315 }
2316
2317 $date_0="" if ($date0);
2318 $date_1="" if ($date1);
2319 } else {
2320 return "";
2321 }
2322 }
2323
2324 #
2325 # Override with any values passed in
2326 #
2327
2328 $date0 = $date_0 if (! $date0);
2329 $date1 = $date_1 if (! $date1);
2330 $dateb = $date_b if (! $dateb);
2331 if ($flag =~ s/^\+//) {
2332 $flag = "$flag_t,$flag" if ($flag_t);
2333 }
2334 $flag = $flag_t if (! $flag);
2335 $flag = "" if (! $flag);
2336
2337 if (! wantarray) {
2338 $tmp = join(":",@recur0);
2339 $tmp .= "*" . join(":",@recur1) if (@recur1);
2340 $tmp .= "*$flag*$dateb*$date0*$date1";
2341 return $tmp;
2342 }
2343 if (@recur0) {
2344 return () if (! $date0 || ! $date1); # dateb is NOT required in all case
2345 }
2346
2347 #
2348 # Some flags affect parsing.
2349 #
2350
2351 @flags = split(/,/,$flag);
2352 my($f);
2353 foreach $f (@flags) {
2354 if ($f =~ /^EASTER$/i) {
2355 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2356 # We want something that will return Jan 1 for the given years.
2357 if ($#recur0==-1) {
2358 @recur1=($y,1,0,1,$h,$mn,$s);
2359 } elsif ($#recur0<=3) {
2360 @recur0=($y,0,0,0);
2361 @recur1=($h,$mn,$s);
2362 } elsif ($#recur0==4) {
2363 @recur0=($y,0,0,0,0);
2364 @recur1=($mn,$s);
2365 } elsif ($#recur0==5) {
2366 @recur0=($y,0,0,0,0,0);
2367 @recur1=($s);
2368 } else {
2369 @recur0=($y,0,0,0,0,0,0);
2370 }
2371 }
2372 }
2373
2374 #
2375 # Determine the dates referenced by the recur. Also, fix the base date
2376 # as necessary for the recurrences which require it.
2377 #
2378
2379 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2380 @y=@m=@w=@d=();
2381 my(@time)=($h,$mn,$s);
2382
2383 RECUR: while (1) {
2384
2385 if ($#recur0==-1) {
2386 # * 0-M-W-D-H-MN-S => 0 * M-W-D-H-MN-S
2387
2388 if ($y eq "0") {
2389 push(@recur0,1);
2390 shift(@recur1);
2391 next RECUR;
2392 }
2393
2394 # Y-M-W-D-H-MN-S
2395
2396 @y=&ReturnList($y);
2397 foreach $y (@y) {
2398 $y=&Date_FixYear($y) if (length($y)==2);
2399 return () if (length($y)!=4 || ! &IsInt($y));
2400 }
2401
2402 $date0=&ParseDate("0000-01-01") if (! $date0);
2403 $date1=&ParseDate("9999-12-31 23:59:59") if (! $date1);
2404
2405 if ($m eq "0" and $w eq "0") {
2406
2407 # * Y-0-0-0-H-MN-S
2408 # * Y-0-0-DOY-H-MN-S
2409
2410 if ($d eq "0") {
2411 @d=(1);
2412 } else {
2413 @d=&ReturnList($d);
2414 return () if (! @d);
2415 foreach $d (@d) {
2416 return () if (! &IsInt($d,-366,366) || $d==0);
2417 }
2418 }
2419
2420 @date=();
2421 foreach $yy (@y) {
2422 my $diy = &Date_DaysInYear($yy);
2423 foreach $d (@d) {
2424 my $tmpd = $d;
2425 $tmpd += ($diy+1) if ($tmpd < 0);
2426 next if (! &IsInt($tmpd,1,$diy));
2427 ($y,$m,$dd)=&Date_NthDayOfYear($yy,$tmpd);
2428 push(@date, &Date_Join($y,$m,$dd,0,0,0));
2429 }
2430 }
2431 last RECUR;
2432
2433 } elsif ($w eq "0") {
2434
2435 # * Y-M-0-0-H-MN-S
2436 # * Y-M-0-DOM-H-MN-S
2437
2438 @m=&ReturnList($m);
2439 return () if (! @m);
2440 foreach $m (@m) {
2441 return () if (! &IsInt($m,1,12));
2442 }
2443
2444 if ($d eq "0") {
2445 @d=(1);
2446 } else {
2447 @d=&ReturnList($d);
2448 return () if (! @d);
2449 foreach $d (@d) {
2450 return () if (! &IsInt($d,-31,31) || $d==0);
2451 }
2452 }
2453
2454 @date=();
2455 foreach $y (@y) {
2456 foreach $m (@m) {
2457 my $dim = &Date_DaysInMonth($m,$y);
2458 foreach $d (@d) {
2459 my $tmpd = $d;
2460 $tmpd += ($dim+1) if ($d<0);
2461 next if (! &IsInt($tmpd,1,$dim));
2462 $date=&Date_Join($y,$m,$tmpd,0,0,0);
2463 push(@date,$date);
2464 }
2465 }
2466 }
2467 last RECUR;
2468
2469 } elsif ($m eq "0") {
2470
2471 # * Y-0-WOY-DOW-H-MN-S
2472 # * Y-0-WOY-0-H-MN-S
2473
2474 @w=&ReturnList($w);
2475 return () if (! @w);
2476 foreach $w (@w) {
2477 return () if (! &IsInt($w,-53,53) || $w==0);
2478 }
2479
2480 if ($d eq "0") {
2481 @d=(1);
2482 } else {
2483 @d=&ReturnList($d);
2484 return () if (! @d);
2485 foreach $d (@d) {
2486 $d += 8 if ($d<0);
2487 return () if (! &IsInt($d,1,7));
2488 }
2489 }
2490
2491 @date=();
2492 foreach $y (@y) {
2493 foreach $w (@w) {
2494 foreach $d (@d) {
2495 my($tmpw,$del);
2496 if ($w<0) {
2497 $date="$y-12-31-00:00:00";
2498 $tmpw = (-$w)-1;
2499 $del="-0:0:$tmpw:0:0:0:0";
2500 $date=Date_GetPrev($date,$d,1);
2501 } else {
2502 $date="$y-01-01-00:00:00";
2503 $tmpw = ($w)-1;
2504 $del="0:0:$tmpw:0:0:0:0";
2505 $date=Date_GetNext($date,$d,1);
2506 }
2507 $date=&DateCalc_DateDelta($date,$del);
2508 push(@date,$date) if ( (&Date_Split($date))[0] == $y);
2509 }
2510 }
2511 }
2512 last RECUR;
2513
2514 } else {
2515
2516 # * Y-M-WOM-DOW-H-MN-S
2517 # * Y-M-WOM-0-H-MN-S
2518
2519 @m=&ReturnList($m);
2520 return () if (! @m);
2521 @w=&ReturnList($w);
2522 return () if (! @w);
2523 if ($d eq "0") {
2524 @d=(1);
2525 } else {
2526 @d=&ReturnList($d);
2527 }
2528
2529 @date=&Date_Recur_WoM(\@y,\@m,\@w,\@d);
2530 last RECUR;
2531 }
2532 }
2533
2534 if ($#recur0==0) {
2535
2536 # Y * M-W-D-H-MN-S
2537 $n=$y;
2538 $n=1 if ($n==0);
2539
2540 if ($m eq "0") {
2541
2542 # Y * 0-W-D-H-MN-S => Y-0 * W-D-H-MN-S
2543 push(@recur0,0);
2544 shift(@recur1);
2545
2546 } elsif ($w eq "0") {
2547
2548 # Y * M-0-DOM-H-MN-S
2549 return () if (! $dateb && $y != 1);
2550
2551 @m=&ReturnList($m);
2552 return () if (! @m);
2553 foreach $m (@m) {
2554 return () if (! &IsInt($m,1,12));
2555 }
2556
2557 if ($d eq "0") {
2558 @d = (1);
2559 } else {
2560 @d=&ReturnList($d);
2561 return () if (! @d);
2562 foreach $d (@d) {
2563 return () if (! &IsInt($d,-31,31) || $d==0);
2564 }
2565 }
2566
2567 # We need to find years that are a multiple of $n from $y(base)
2568 ($y0)=( &Date_Split($date0, 1) )[0];
2569 ($y1)=( &Date_Split($date1, 1) )[0];
2570 if ($dateb) {
2571 ($yb)=( &Date_Split($dateb, 1) )[0];
2572 } else {
2573 # If $y=1, there is no base year
2574 $yb=0;
2575 }
2576
2577 @date=();
2578 for ($yy=$y0; $yy<=$y1; $yy++) {
2579 if (($yy-$yb)%$n == 0) {
2580 foreach $m (@m) {
2581 foreach $d (@d) {
2582 my $dim = &Date_DaysInMonth($m,$yy);
2583 my $tmpd = $d;
2584 if ($tmpd < 0) {
2585 $tmpd += ($dim+1);
2586 }
2587 next if (! &IsInt($tmpd,1,$dim));
2588 $date=&Date_Join($yy,$m,$tmpd,0,0,0);
2589 push(@date,$date);
2590 }
2591 }
2592 }
2593 }
2594 last RECUR;
2595
2596 } else {
2597
2598 # Y * M-WOM-DOW-H-MN-S
2599 # Y * M-WOM-0-H-MN-S
2600 return () if (! $dateb && $y != 1);
2601
2602 @m=&ReturnList($m);
2603 return () if (! @m);
2604 @w=&ReturnList($w);
2605 return () if (! @w);
2606
2607 if ($d eq "0") {
2608 @d=(1);
2609 } else {
2610 @d=&ReturnList($d);
2611 }
2612
2613 ($y0)=( &Date_Split($date0, 1) )[0];
2614 ($y1)=( &Date_Split($date1, 1) )[0];
2615 if ($dateb) {
2616 ($yb)=( &Date_Split($dateb, 1) )[0];
2617 } else {
2618 # If $y=1, there is no base year
2619 $yb=0;
2620 }
2621 @y=();
2622 for ($yy=$y0; $yy<=$y1; $yy++) {
2623 if (($yy-$yb)%$n == 0) {
2624 push(@y,$yy);
2625 }
2626 }
2627
2628 @date=&Date_Recur_WoM(\@y,\@m,\@w,\@d);
2629 last RECUR;
2630 }
2631 }
2632
2633 if ($#recur0==1) {
2634
2635 # Y-M * W-D-H-MN-S
2636
2637 if ($w eq "0") {
2638 # Y-M * 0-D-H-MN-S => Y-M-0 * D-H-MN-S
2639 push(@recur0,0);
2640 shift(@recur1);
2641
2642 } elsif ($m==0) {
2643
2644 # Y-0 * WOY-0-H-MN-S
2645 # Y-0 * WOY-DOW-H-MN-S
2646 return () if (! $dateb && $y != 1);
2647 $n=$y;
2648 $n=1 if ($n==0);
2649
2650 @w=&ReturnList($w);
2651 return () if (! @w);
2652 foreach $w (@w) {
2653 return () if ($w==0 || ! &IsInt($w,-53,53));
2654 }
2655
2656 if ($d eq "0") {
2657 @d=(1);
2658 } else {
2659 @d=&ReturnList($d);
2660 return () if (! @d);
2661 foreach $d (@d) {
2662 $d += 8 if ($d<0);
2663 return () if (! &IsInt($d,1,7));
2664 }
2665 }
2666
2667 # We need to find years that are a multiple of $n from $y(base)
2668 ($y0)=( &Date_Split($date0, 1) )[0];
2669 ($y1)=( &Date_Split($date1, 1) )[0];
2670 if ($dateb) {
2671 ($yb)=( &Date_Split($dateb, 1) )[0];
2672 } else {
2673 # If $y=1, there is no base year
2674 $yb=0;
2675 }
2676
2677 @date=();
2678 for ($yy=$y0; $yy<=$y1; $yy++) {
2679 if (($yy-$yb)%$n == 0) {
2680 foreach $w (@w) {
2681 foreach $d (@d) {
2682 my($tmpw,$del);
2683 if ($w<0) {
2684 $date="$yy-12-31-00:00:00";
2685 $tmpw = (-$w)-1;
2686 $del="-0:0:$tmpw:0:0:0:0";
2687 $date=Date_GetPrev($date,$d,1);
2688 } else {
2689 $date="$yy-01-01-00:00:00";
2690 $tmpw = ($w)-1;
2691 $del="0:0:$tmpw:0:0:0:0";
2692 $date=Date_GetNext($date,$d,1);
2693 }
2694 $date=&DateCalc($date,$del);
2695 next if ((&Date_Split($date))[0] != $yy);
2696 push(@date,$date);
2697 }
2698 }
2699 }
2700 }
2701 last RECUR;
2702
2703 } else {
2704
2705 # Y-M * WOM-0-H-MN-S
2706 # Y-M * WOM-DOW-H-MN-S
2707 return () if (! $dateb);
2708 @tmp=(@recur0);
2709 push(@tmp,0) while ($#tmp<6);
2710 $delta=join(":",@tmp);
2711 @tmp=&Date_Recur($date0,$date1,$dateb,$delta);
2712
2713 @w=&ReturnList($w);
2714 @m=();
2715 if ($d eq "0") {
2716 @d=(1);
2717 } else {
2718 @d=&ReturnList($d);
2719 }
2720
2721 @date=&Date_Recur_WoM(\@tmp,\@m,\@w,\@d);
2722 last RECUR;
2723 }
2724 }
2725
2726 if ($#recur0==2) {
2727 # Y-M-W * D-H-MN-S
2728
2729 if ($d eq "0") {
2730
2731 # Y-M-W * 0-H-MN-S
2732 return () if (! $dateb);
2733 $y=1 if ($y==0 && $m==0 && $w==0);
2734 $delta="$y:$m:$w:0:0:0:0";
2735 @date=&Date_Recur($date0,$date1,$dateb,$delta);
2736 last RECUR;
2737
2738 } elsif ($m==0 && $w==0) {
2739
2740 # Y-0-0 * DOY-H-MN-S
2741 $y=1 if ($y==0);
2742 $n=$y;
2743 return () if (! $dateb && $y!=1);
2744
2745 @d=&ReturnList($d);
2746 return () if (! @d);
2747 foreach $d (@d) {
2748 return () if (! &IsInt($d,-366,366) || $d==0);
2749 }
2750
2751 # We need to find years that are a multiple of $n from $y(base)
2752 ($y0)=( &Date_Split($date0, 1) )[0];
2753 ($y1)=( &Date_Split($date1, 1) )[0];
2754 if ($dateb) {
2755 ($yb)=( &Date_Split($dateb, 1) )[0];
2756 } else {
2757 # If $y=1, there is no base year
2758 $yb=0;
2759 }
2760 @date=();
2761 for ($yy=$y0; $yy<=$y1; $yy++) {
2762 my $diy = &Date_DaysInYear($yy);
2763 if (($yy-$yb)%$n == 0) {
2764 foreach $d (@d) {
2765 my $tmpd = $d;
2766 $tmpd += ($diy+1) if ($tmpd<0);
2767 next if (! &IsInt($tmpd,1,$diy));
2768 ($y,$m,$dd)=&Date_NthDayOfYear($yy,$tmpd);
2769 push(@date, &Date_Join($y,$m,$dd,0,0,0));
2770 }
2771 }
2772 }
2773 last RECUR;
2774
2775 } elsif ($w>0) {
2776
2777 # Y-M-W * DOW-H-MN-S
2778 return () if (! $dateb);
2779 @tmp=(@recur0);
2780 push(@tmp,0) while ($#tmp<6);
2781 $delta=join(":",@tmp);
2782
2783 @d=&ReturnList($d);
2784 return () if (! @d);
2785 foreach $d (@d) {
2786 $d += 8 if ($d<0);
2787 return () if (! &IsInt($d,1,7));
2788 }
2789
2790 # Find out what DofW the basedate is.
2791 @tmp2=&Date_Split($dateb, 1);
2792 $tmp=&Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]);
2793
2794 @date=();
2795 foreach $d (@d) {
2796 $date_b=$dateb;
2797 # Move basedate to DOW in the same week
2798 if ($d != $tmp) {
2799 if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
2800 ($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
2801 ($tmp<$d && $d<$Cnf{"FirstDay"})) {
2802 $date_b=&Date_GetNext($date_b,$d);
2803 } else {
2804 $date_b=&Date_GetPrev($date_b,$d);
2805 }
2806 }
2807 push(@date,&Date_Recur($date0,$date1,$date_b,$delta));
2808 }
2809 last RECUR;
2810
2811 } elsif ($m>0) {
2812
2813 # Y-M-0 * DOM-H-MN-S
2814 return () if (! $dateb);
2815 @tmp=(@recur0);
2816 push(@tmp,0) while ($#tmp<6);
2817 $delta=join(":",@tmp);
2818
2819 @d=&ReturnList($d);
2820 return () if (! @d);
2821 foreach $d (@d) {
2822 return () if ($d==0 || ! &IsInt($d,-31,31));
2823 }
2824
2825 @tmp2=&Date_Recur($date0,$date1,$dateb,$delta);
2826 @date=();
2827 foreach $date (@tmp2) {
2828 ($y,$m)=( &Date_Split($date, 1) )[0..1];
2829 my $dim=&Date_DaysInMonth($m,$y);
2830 foreach $d (@d) {
2831 my $tmpd = $d;
2832 $tmpd += ($dim+1) if ($tmpd<0);
2833 next if (! &IsInt($tmpd,1,$dim));
2834 push(@date,&Date_Join($y,$m,$tmpd,0,0,0));
2835 }
2836 }
2837 last RECUR;
2838
2839 } else {
2840 return ();
2841 }
2842 }
2843
2844 if ($#recur0>2) {
2845
2846 # Y-M-W-D * H-MN-S
2847 # Y-M-W-D-H * MN-S
2848 # Y-M-W-D-H-MN * S
2849 # Y-M-W-D-H-S
2850 return () if (! $dateb);
2851 @tmp=(@recur0);
2852 push(@tmp,0) while ($#tmp<6);
2853 $delta=join(":",@tmp);
2854 return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
2855 @date=&Date_Recur($date0,$date1,$dateb,$delta);
2856 if (@recur1) {
2857 unshift(@recur1,-1) while ($#recur1<2);
2858 @time=@recur1;
2859 } else {
2860 shift(@date);
2861 pop(@date);
2862 @time=();
2863 }
2864 }
2865
2866 last RECUR;
2867 }
2868 @date=&Date_RecurSetTime($date0,$date1,\@date,@time) if (@time);
2869
2870 #
2871 # We've got a list of dates. Operate on them with the flags.
2872 #
2873
2874 my($sign,$forw,$today,$df,$db,$work,$i);
2875 if (@flags) {
2876 FLAG: foreach $f (@flags) {
2877 $f = uc($f);
2878
2879 if ($f =~ /^(P|N)(D|T)([1-7])$/) {
2880 @tmp=($1,$2,$3);
2881 $forw =($tmp[0] eq "P" ? 0 : 1);
2882 $today=($tmp[1] eq "D" ? 0 : 1);
2883 $d=$tmp[2];
2884 @tmp=();
2885 foreach $date (@date) {
2886 if ($forw) {
2887 push(@tmp, &Date_GetNext($date,$d,$today));
2888 } else {
2889 push(@tmp, &Date_GetPrev($date,$d,$today));
2890 }
2891 }
2892 @date=@tmp;
2893 next FLAG;
2894 }
2895
2896 # We want to go forward exact amounts of time instead of
2897 # business mode calculations so that we don't change the time
2898 # (which may have been set in the recur).
2899 if ($f =~ /^(F|B)(D|W)(\d+)$/) {
2900 @tmp=($1,$2,$3);
2901 $sign="+";
2902 $sign="-" if ($tmp[0] eq "B");
2903 $work=0;
2904 $work=1 if ($tmp[1] eq "W");
2905 $n=$tmp[2];
2906 @tmp=();
2907 foreach $date (@date) {
2908 for ($i=1; $i<=$n; $i++) {
2909 while (1) {
2910 $date=&DateCalc($date,"${sign}0:0:0:1:0:0:0");
2911 last if (! $work || &Date_IsWorkDay($date,0));
2912 }
2913 }
2914 push(@tmp,$date);
2915 }
2916 @date=@tmp;
2917 next FLAG;
2918 }
2919
2920 if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
2921 $tmp=$1;
2922 my $noalt = $2 ? 1 : 0;
2923 if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
2924 $forw=1;
2925 } else {
2926 $forw=0;
2927 }
2928
2929 @tmp=();
2930 DATE: foreach $date (@date) {
2931 $df=$db=$date;
2932 if (&Date_IsWorkDay($date)) {
2933 push(@tmp,$date);
2934 next DATE;
2935 }
2936 while (1) {
2937 if ($forw) {
2938 $d=$df=&DateCalc($df,"+0:0:0:1:0:0:0");
2939 } else {
2940 $d=$db=&DateCalc($db,"-0:0:0:1:0:0:0");
2941 }
2942 if (&Date_IsWorkDay($d)) {
2943 push(@tmp,$d);
2944 next DATE;
2945 }
2946 $forw=1-$forw if (! $noalt);
2947 }
2948 }
2949 @date=@tmp;
2950 next FLAG;
2951 }
2952
2953 if ($f eq "EASTER") {
2954 @tmp=();
2955 foreach $date (@date) {
2956 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
2957 ($m,$d)=&Date_Easter($y);
2958 $date=&Date_Join($y,$m,$d,$h,$mn,$s);
2959 next if (&Date_Cmp($date,$date0)<0 ||
2960 &Date_Cmp($date,$date1)>0);
2961 push(@tmp,$date);
2962 }
2963 @date=@tmp;
2964 }
2965 }
2966 }
2967
2968 @date = sort { Date_Cmp($a,$b) } @date;
2969 return @date;
2970}
2971
2972sub Date_GetPrev {
2973 print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/);
2974 my($date,$dow,$today,$hr,$min,$sec)=@_;
2975 &Date_Init() if (! $Curr{"InitDone"});
2976 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
2977 $adjust,$curr)=();
2978 $hr="00" if (defined $hr && $hr eq "0");
2979 $min="00" if (defined $min && $min eq "0");
2980 $sec="00" if (defined $sec && $sec eq "0");
2981
2982 if (! &Date_Split($date)) {
2983 $date=&ParseDateString($date);
2984 return "" if (! $date);
2985 }
2986 $curr=$date;
2987 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
2988
2989 if ($dow) {
2990 $curr_dow=&Date_DayOfWeek($m,$d,$y);
2991 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
2992 if (&IsInt($dow)) {
2993 return "" if ($dow<1 || $dow>7);
2994 } else {
2995 return "" if (! exists $dow{lc($dow)});
2996 $dow=$dow{lc($dow)};
2997 }
2998 if ($dow == $curr_dow) {
2999 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today);
3000 $adjust=1 if ($today==2);
3001 } else {
3002 $dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
3003 $num = $curr_dow - $dow;
3004 $date=&DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0);
3005 }
3006 $date=&Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
3007 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0)
3008 if ($adjust && &Date_Cmp($date,$curr)>0);
3009
3010 } else {
3011 ($h,$mn,$s)=( &Date_Split($date, 1) )[3..5];
3012 ($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec);
3013 if ($hr) {
3014 ($hr,$min,$sec)=($th,$tm,$ts);
3015 $delta="-0:0:0:1:0:0:0";
3016 } elsif ($min) {
3017 ($hr,$min,$sec)=($h,$tm,$ts);
3018 $delta="-0:0:0:0:1:0:0";
3019 } elsif ($sec) {
3020 ($hr,$min,$sec)=($h,$mn,$ts);
3021 $delta="-0:0:0:0:0:1:0";
3022 } else {
3023 confess "ERROR: invalid arguments in Date_GetPrev.\n";
3024 }
3025
3026 $d=&Date_SetTime($date,$hr,$min,$sec);
3027 if ($today) {
3028 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>0);
3029 } else {
3030 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>=0);
3031 }
3032 $date=$d;
3033 }
3034 return $date;
3035}
3036
3037sub Date_GetNext {
3038 print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/);
3039 my($date,$dow,$today,$hr,$min,$sec)=@_;
3040 &Date_Init() if (! $Curr{"InitDone"});
3041 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
3042 $adjust,$curr)=();
3043 $hr="00" if (defined $hr && $hr eq "0");
3044 $min="00" if (defined $min && $min eq "0");
3045 $sec="00" if (defined $sec && $sec eq "0");
3046
3047 if (! &Date_Split($date)) {
3048 $date=&ParseDateString($date);
3049 return "" if (! $date);
3050 }
3051 $curr=$date;
3052 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
3053
3054 if ($dow) {
3055 $curr_dow=&Date_DayOfWeek($m,$d,$y);
3056 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
3057 if (&IsInt($dow)) {
3058 return "" if ($dow<1 || $dow>7);
3059 } else {
3060 return "" if (! exists $dow{lc($dow)});
3061 $dow=$dow{lc($dow)};
3062 }
3063 if ($dow == $curr_dow) {
3064 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today);
3065 $adjust=1 if ($today==2);
3066 } else {
3067 $curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
3068 $num = $dow - $curr_dow;
3069 $date=&DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0);
3070 }
3071 $date=&Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
3072 $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0)
3073 if ($adjust && &Date_Cmp($date,$curr)<0);
3074
3075 } else {
3076 ($h,$mn,$s)=( &Date_Split($date, 1) )[3..5];
3077 ($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec);
3078 if ($hr) {
3079 ($hr,$min,$sec)=($th,$tm,$ts);
3080 $delta="+0:0:0:1:0:0:0";
3081 } elsif ($min) {
3082 ($hr,$min,$sec)=($h,$tm,$ts);
3083 $delta="+0:0:0:0:1:0:0";
3084 } elsif ($sec) {
3085 ($hr,$min,$sec)=($h,$mn,$ts);
3086 $delta="+0:0:0:0:0:1:0";
3087 } else {
3088 confess "ERROR: invalid arguments in Date_GetNext.\n";
3089 }
3090
3091 $d=&Date_SetTime($date,$hr,$min,$sec);
3092 if ($today) {
3093 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<0);
3094 } else {
3095 $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<1);
3096 }
3097 $date=$d;
3098 }
3099
3100 return $date;
3101}
3102
3103sub Date_IsHoliday {
3104 print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
3105 my($date)=@_;
3106 &Date_Init() if (! $Curr{"InitDone"});
3107 $date=&ParseDateString($date);
3108 return undef if (! $date);
3109 $date=&Date_SetTime($date,0,0,0);
3110 my($y)=(&Date_Split($date, 1))[0];
3111 &Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y});
3112 return undef if (! exists $Holiday{"dates"}{$y}{$date});
3113 my($name)=$Holiday{"dates"}{$y}{$date};
3114 return "" if (! $name);
3115 $name;
3116}
3117
3118sub Events_List {
3119 print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
3120 my(@args)=@_;
3121 &Date_Init() if (! $Curr{"InitDone"});
3122 &Events_ParseRaw();
3123
3124 my($tmp,$date0,$date1,$flag);
3125 $date0=&ParseDateString($args[0]);
3126 warn "Invalid date $args[0]", return undef if (! $date0);
3127
3128 if ($#args == 0) {
3129 return &Events_Calc($date0);
3130 }
3131
3132 if ($args[1]) {
3133 $date1=&ParseDateString($args[1]);
3134 warn "Invalid date $args[1]\n", return undef if (! $date1);
3135 if (&Date_Cmp($date0,$date1)>0) {
3136 $tmp=$date1;
3137 $date1=$date0;
3138 $date0=$tmp;
3139 }
3140 } else {
3141 $date0=&Date_SetTime($date0,"00:00:00");
3142 $date1=&DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0");
3143 }
3144
3145 $tmp=&Events_Calc($date0,$date1);
3146
3147 $flag=$args[2];
3148 return $tmp if (! $flag);
3149
3150 my(@tmp,%ret,$delta)=();
3151 @tmp=@$tmp;
3152 push(@tmp,$date1);
3153
3154 if ($flag==1) {
3155 while ($#tmp>0) {
3156 ($date0,$tmp)=splice(@tmp,0,2);
3157 $date1=$tmp[0];
3158 $delta=&DateCalc_DateDate($date0,$date1);
3159 foreach $flag (@$tmp) {
3160 if (exists $ret{$flag}) {
3161 $ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta);
3162 } else {
3163 $ret{$flag}=$delta;
3164 }
3165 }
3166 }
3167 return \%ret;
3168
3169 } elsif ($flag==2) {
3170 while ($#tmp>0) {
3171 ($date0,$tmp)=splice(@tmp,0,2);
3172 $date1=$tmp[0];
3173 $delta=&DateCalc_DateDate($date0,$date1);
3174 $flag=join("+",sort { Date_Cmp($a,$b) } @$tmp);
3175 next if (! $flag);
3176 if (exists $ret{$flag}) {
3177 $ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta);
3178 } else {
3179 $ret{$flag}=$delta;
3180 }
3181 }
3182 return \%ret;
3183 }
3184
3185 warn "Invalid flag $flag\n";
3186 return undef;
3187}
3188
3189###
3190# NOTE: The following routines may be called in the routines below with very
3191# little time penalty.
3192###
3193sub Date_SetTime {
3194 print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
3195 my($date,$h,$mn,$s)=@_;
3196 &Date_Init() if (! $Curr{"InitDone"});
3197 my($y,$m,$d)=();
3198
3199 if (! &Date_Split($date)) {
3200 $date=&ParseDateString($date);
3201 return "" if (! $date);
3202 }
3203
3204 ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
3205 ($h,$mn,$s)=&Date_ParseTime($h,$mn,$s);
3206
3207 my($ampm,$wk);
3208 return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
3209 &Date_Join($y,$m,$d,$h,$mn,$s);
3210}
3211
3212sub Date_SetDateField {
3213 print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/);
3214 my($date,$field,$val,$nocheck)=@_;
3215 my($y,$m,$d,$h,$mn,$s)=();
3216 $nocheck=0 if (! defined $nocheck);
3217
3218 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date);
3219
3220 if (! $y) {
3221 $date=&ParseDateString($date);
3222 return "" if (! $date);
3223 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
3224 }
3225
3226 if (lc($field) eq "y") {
3227 $y=$val;
3228 } elsif (lc($field) eq "m") {
3229 $m=$val;
3230 } elsif (lc($field) eq "d") {
3231 $d=$val;
3232 } elsif (lc($field) eq "h") {
3233 $h=$val;
3234 } elsif (lc($field) eq "mn") {
3235 $mn=$val;
3236 } elsif (lc($field) eq "s") {
3237 $s=$val;
3238 } else {
3239 confess "ERROR: Date_SetDateField: invalid field: $field\n";
3240 }
3241
3242 $date=&Date_Join($y,$m,$d,$h,$mn,$s);
3243 return $date if ($nocheck || &Date_Split($date));
3244 return "";
3245}
3246
3247########################################################################
3248# OTHER SUBROUTINES
3249########################################################################
3250# NOTE: These routines should not call any of the routines above as
3251# there will be a severe time penalty (and the possibility of
3252# infinite recursion). The last couple routines above are
3253# exceptions.
3254# NOTE: Date_Init is a special case. It should be called (conditionally)
3255# in every routine that uses any variable from the Date::Manip
3256# namespace.
3257########################################################################
3258
3259sub Date_DaysInMonth {
3260 print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
3261 my($m,$y)=@_;
3262 $y=&Date_FixYear($y) if (length($y)!=4);
3263 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
3264 $d_in_m[2]=29 if (&Date_LeapYear($y));
3265 return $d_in_m[$m];
3266}
3267
3268sub Date_DayOfWeek {
3269 print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
3270 my($m,$d,$y)=@_;
3271 $y=&Date_FixYear($y) if (length($y)!=4);
3272 my($dayofweek,$dec31)=();
3273
3274 $dec31=5; # Dec 31, 1BC was Friday
3275 $dayofweek=(&Date_DaysSince1BC($m,$d,$y)+$dec31) % 7;
3276 $dayofweek=7 if ($dayofweek==0);
3277 return $dayofweek;
3278}
3279
3280# Can't be in "use integer" because the numbers are too big.
3281no integer;
3282sub Date_SecsSince1970 {
3283 print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
3284 my($m,$d,$y,$h,$mn,$s)=@_;
3285 $y=&Date_FixYear($y) if (length($y)!=4);
3286 my($sec_now,$sec_70)=();
3287 $sec_now=(&Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s;
3288# $sec_70 =(&Date_DaysSince1BC(1,1,1970)-1)*24*3600;
3289 $sec_70 =62167219200;
3290 return ($sec_now-$sec_70);
3291}
3292
3293sub Date_SecsSince1970GMT {
3294 print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/);
3295 my($m,$d,$y,$h,$mn,$s)=@_;
3296 &Date_Init() if (! $Curr{"InitDone"});
3297 $y=&Date_FixYear($y) if (length($y)!=4);
3298
3299 my($sec)=&Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
3300 return $sec if ($Cnf{"ConvTZ"} eq "IGNORE");
3301
3302 my($tz)=$Cnf{"ConvTZ"};
3303 $tz=$Cnf{"TZ"} if (! $tz);
3304 $tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
3305
3306 my($tzs)=1;
3307 $tzs=-1 if ($tz<0);
3308 $tz=~/.(..)(..)/;
3309 my($tzh,$tzm)=($1,$2);
3310 $sec - $tzs*($tzh*3600+$tzm*60);
3311}
3312use integer;
3313
3314sub Date_DaysSince1BC {
3315 print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
3316 my($m,$d,$y)=@_;
3317 $y=&Date_FixYear($y) if (length($y)!=4);
3318 my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
3319 my($cc,$yy)=();
3320
3321 $y=~ /(\d{2})(\d{2})/;
3322 ($cc,$yy)=($1,$2);
3323
3324 # Number of full years since Dec 31, 1BC (counting the year 0000).
3325 $Ny=$y;
3326
3327 # Number of full 4th years (incl. 0000) since Dec 31, 1BC
3328 $N4=($Ny-1)/4 + 1;
3329 $N4=0 if ($y==0);
3330
3331 # Number of full 100th years (incl. 0000)
3332 $N100=$cc + 1;
3333 $N100-- if ($yy==0);
3334 $N100=0 if ($y==0);
3335
3336 # Number of full 400th years (incl. 0000)
3337 $N400=($N100-1)/4 + 1;
3338 $N400=0 if ($y==0);
3339
3340 $dayofyear=&Date_DayOfYear($m,$d,$y);
3341 $days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
3342
3343 return $days;
3344}
3345
3346sub Date_DayOfYear {
3347 print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3348 my($m,$d,$y)=@_;
3349 $y=&Date_FixYear($y) if (length($y)!=4);
3350 # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
3351 my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
3352 my($ly)=0;
3353 $ly=1 if ($m>2 && &Date_LeapYear($y));
3354 return ($days[$m-1]+$d+$ly);
3355}
3356
3357sub Date_DaysInYear {
3358 print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
3359 my($y)=@_;
3360 $y=&Date_FixYear($y) if (length($y)!=4);
3361 return 366 if (&Date_LeapYear($y));
3362 return 365;
3363}
3364
3365sub Date_WeekOfYear {
3366 print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3367 my($m,$d,$y,$f)=@_;
3368 &Date_Init() if (! $Curr{"InitDone"});
3369 $y=&Date_FixYear($y) if (length($y)!=4);
3370
3371 my($day,$dow,$doy)=();
3372 $doy=&Date_DayOfYear($m,$d,$y);
3373
3374 # The current DayOfYear and DayOfWeek
3375 if ($Cnf{"Jan1Week1"}) {
3376 $day=1;
3377 } else {
3378 $day=4;
3379 }
3380 $dow=&Date_DayOfWeek(1,$day,$y);
3381
3382 # Move back to the first day of week 1.
3383 $f-=7 if ($f>$dow);
3384 $day-= ($dow-$f);
3385
3386 return 0 if ($day>$doy); # Day is in last week of previous year
3387 return (($doy-$day)/7 + 1);
3388}
3389
3390sub Date_LeapYear {
3391 print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
3392 my($y)=@_;
3393 $y=&Date_FixYear($y) if (length($y)!=4);
3394 return 0 unless $y % 4 == 0;
3395 return 1 unless $y % 100 == 0;
3396 return 0 unless $y % 400 == 0;
3397 return 1;
3398}
3399
3400sub Date_DaySuffix {
3401 print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
3402 my($d)=@_;
3403 &Date_Init() if (! $Curr{"InitDone"});
3404 return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
3405}
3406
3407sub Date_ConvTZ {
3408 print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
3409 my($date,$from,$to,$level)=@_;
3410 if (not Date_Split($date)) {
3411 my $err = "date passed in ('$date') is not a Date::Manip object";
3412 if (! $level) {
3413 croak $err;
3414 } elsif ($level==1) {
3415 carp $err;
3416 }
3417 return "";
3418 }
3419
3420 &Date_Init() if (! $Curr{"InitDone"});
3421 my($gmt)=();
3422
3423 if (! $from) {
3424
3425 if (! $to) {
3426 # TZ -> ConvTZ
3427 return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
3428 $from=$Cnf{"TZ"};
3429 $to=$Cnf{"ConvTZ"};
3430
3431 } else {
3432 # ConvTZ,TZ -> $to
3433 $from=$Cnf{"ConvTZ"};
3434 $from=$Cnf{"TZ"} if (! $from);
3435 }
3436
3437 } else {
3438
3439 if (! $to) {
3440 # $from -> ConvTZ,TZ
3441 return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
3442 $to=$Cnf{"ConvTZ"};
3443 $to=$Cnf{"TZ"} if (! $to);
3444
3445 } else {
3446 # $from -> $to
3447 }
3448 }
3449
3450 $to=$Zone{"n2o"}{lc($to)}
3451 if (exists $Zone{"n2o"}{lc($to)});
3452 $from=$Zone{"n2o"}{lc($from)}
3453 if (exists $Zone{"n2o"}{lc($from)});
3454 $gmt=$Zone{"n2o"}{"gmt"};
3455
3456 return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/);
3457 return $date if ($from eq $to);
3458
3459 my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=();
3460 # We're going to try to do the calculation without calling DateCalc.
3461 ($yr,$mon,$d,$h,$m,$sec)=&Date_Split($date, 1);
3462
3463 # Convert $date from $from to GMT
3464 $from=~/([+-])(\d{2})(\d{2})/;
3465 ($s1,$h1,$m1)=($1,$2,$3);
3466 $s1= ($s1 eq "-" ? "+" : "-"); # switch sign
3467 $sign=$s1 . "1"; # + or - 1
3468
3469 # and from GMT to $to
3470 $to=~/([+-])(\d{2})(\d{2})/;
3471 ($s2,$h2,$m2)=($1,$2,$3);
3472
3473 if ($s1 eq $s2) {
3474 # Both the same sign
3475 $m+= $sign*($m1+$m2);
3476 $h+= $sign*($h1+$h2);
3477 } else {
3478 $sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
3479 $m+= $sign*($m1-$m2);
3480 $h+= $sign*($h1-$h2);
3481 }
3482
3483 if ($m>59) {
3484 $h+= $m/60;
3485 $m-= ($m/60)*60;
3486 } elsif ($m<0) {
3487 $h+= ($m/60 - 1);
3488 $m-= ($m/60 - 1)*60;
3489 }
3490
3491 if ($h>23) {
3492 $delta=$h/24;
3493 $h -= $delta*24;
3494 if (($d + $delta) > 28) {
3495 $date=&Date_Join($yr,$mon,$d,$h,$m,$sec);
3496 return &DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0);
3497 }
3498 $d+= $delta;
3499 } elsif ($h<0) {
3500 $delta=-$h/24 + 1;
3501 $h += $delta*24;
3502 if (($d - $delta) < 1) {
3503 $date=&Date_Join($yr,$mon,$d,$h,$m,$sec);
3504 return &DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0);
3505 }
3506 $d-= $delta;
3507 }
3508 return &Date_Join($yr,$mon,$d,$h,$m,$sec);
3509}
3510
3511sub Date_TimeZone {
3512 print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/);
3513 my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=();
3514 &Date_Init() if (! $Curr{"InitDone"});
3515
3516 # Get timezones from all of the relevant places
3517
3518 push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var
3519 push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var
3520 push(@tz,$ENV{'SYS$TIMEZONE_RULE'})
3521 if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var
3522 push(@tz,$ENV{'SYS$TIMEZONE_NAME'})
3523 if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var
3524 push(@tz,$ENV{'UCX$TZ'})
3525 if defined $ENV{'UCX$TZ'}; # VMS TZ environ var
3526 push(@tz,$ENV{'TCPIP$TZ'})
3527 if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var
3528
3529 # The `date` command... if we're doing taint checking, we need to
3530 # always call it with a full path... otherwise, use the user's path.
3531 #
3532 # Microsoft operating systems don't have a date command built in. Try
3533 # to trap all the various ways of knowing we are on one of these systems.
3534 #
3535 # We'll try `date +%Z` first, and if that fails, we'll take just the
3536 # `date` program and assume the output is of the format:
3537 # Thu Aug 31 14:57:46 EDT 2000
3538
3539 unless (($^O ne 'cygwin' && $^X =~ /perl\.exe$/i) or
3540 ($OS eq "Windows") or
3541 ($OS eq "Netware") or
3542 ($OS eq "VMS")) {
3543 if ($Date::Manip::NoTaint) {
3544 if ($OS eq "VMS") {
3545 $tz=$ENV{'SYS$TIMEZONE_NAME'};
3546 if (! $tz) {
3547 $tz=$ENV{'MULTINET_TIMEZONE'};
3548 if (! $tz) {
3549 $tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
3550 }
3551 }
3552 } else {
3553 $tz=`date +%Z 2> /dev/null`;
3554 chomp($tz);
3555 if (! $tz) {
3556 $tz=`date 2> /dev/null`;
3557 chomp($tz);
3558 $tz=(split(/\s+/,$tz))[4];
3559 }
3560 }
3561 push(@tz,$tz);
3562 } else {
3563 # We need to satisfy taint checking, but also look in all the
3564 # directories in @DatePath.
3565 #
3566 local $ENV{PATH} = join(':', @Date::Manip::DatePath);
3567 local $ENV{BASH_ENV} = '';
3568 $tz=`date +%Z 2> /dev/null`;
3569 chomp($tz);
3570 if (! $tz) {
3571 $tz=`date 2> /dev/null`;
3572 chomp($tz);
3573 $tz=(split(/\s+/,$tz))[4];
3574 }
3575 push(@tz,$tz);
3576 }
3577 }
3578
3579 push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ
3580
3581 if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE
3582 $in=new IO::File;
3583 $in->open("/etc/TIMEZONE","r");
3584 while (! eof($in)) {
3585 $tmp=<$in>;
3586 if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
3587 push(@tz,$1);
3588 last;
3589 }
3590 }
3591 $in->close;
3592 }
3593
3594 if (-s "/etc/timezone") { # /etc/timezone
3595 $in=new IO::File;
3596 $in->open("/etc/timezone","r");
3597 while (! eof($in)) {
3598 $tmp=<$in>;
3599 next if ($tmp =~ /^\s*\043/);
3600 chomp($tmp);
3601 if ($tmp =~ /^\s*(.*?)\s*$/) {
3602 push(@tz,$1);
3603 last;
3604 }
3605 }
3606 $in->close;
3607 }
3608
3609 # Now parse each one to find the first valid one.
3610 foreach $tz (@tz) {
3611 $tz =~ s/\s*$//;
3612 $tz =~ s/^\s*//;
3613 $tz =~ s/^://;
3614 next if ($tz eq "");
3615
3616 return uc($tz)
3617 if (defined $Zone{"n2o"}{lc($tz)});
3618
3619 if ($tz =~ /^[+-]\d{4}$/) {
3620 return $tz;
3621 } elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
3622 my($h,$m)=($1,$2);
3623 $m="00" if (! $m);
3624 return "$h$m";
3625 }
3626
3627 # Handle US/Eastern format
3628 if ($tz =~ /^$Zone{"tzones"}$/i) {
3629 $tmp=lc $1;
3630 $tz=$Zone{"tz2z"}{$tmp};
3631 }
3632
3633 # Handle STD#DST# format (and STD-#DST-# formats)
3634 if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
3635 ($std,$dst)=($1,$2);
3636 next if (! defined $Zone{"n2o"}{lc($std)} or
3637 ! defined $Zone{"n2o"}{lc($dst)});
3638 $time = time();
3639 ($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
3640 localtime($time);
3641 return uc($dst) if ($isdst);
3642 return uc($std);
3643 }
3644 }
3645
3646 confess "ERROR: Date::Manip unable to determine Time Zone.\n";
3647}
3648
3649# Returns 1 if $date is a work day. If $time is non-zero, the time is
3650# also checked to see if it falls within work hours. Returns "" if
3651# an invalid date is passed in.
3652sub Date_IsWorkDay {
3653 print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3654 my($date,$time)=@_;
3655 &Date_Init() if (! $Curr{"InitDone"});
3656 $date=&ParseDateString($date);
3657 return "" if (! $date);
3658 my($d)=$date;
3659 $d=&Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time);
3660
3661 my($y,$mon,$day,$h,$m,$s,$dow)=();
3662 ($y,$mon,$day,$h,$m,$s)=&Date_Split($d, 1);
3663 $dow=&Date_DayOfWeek($mon,$day,$y);
3664
3665 return 0 if ($dow<$Cnf{"WorkWeekBeg"} or
3666 $dow>$Cnf{"WorkWeekEnd"} or
3667 "$h:$m" lt $Cnf{"WorkDayBeg"} or
3668 "$h:$m" ge $Cnf{"WorkDayEnd"});
3669
3670 if (! exists $Holiday{"dates"}{$y}) {
3671 # There will be recursion problems if we ever end up here twice.
3672 $Holiday{"dates"}{$y}={};
3673 &Date_UpdateHolidays($y)
3674 }
3675 $d=&Date_SetTime($date,"00:00:00");
3676 return 0 if (exists $Holiday{"dates"}{$y}{$d});
3677 1;
3678}
3679
3680# Finds the day $off work days from now. If $time is passed in, we must
3681# also take into account the time of day.
3682#
3683# If $time is not passed in, day 0 is today (if today is a workday) or the
3684# next work day if it isn't. In any case, the time of day is unaffected.
3685#
3686# If $time is passed in, day 0 is now (if now is part of a workday) or the
3687# start of the very next work day.
3688sub Date_NextWorkDay {
3689 print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3690 my($date,$off,$time)=@_;
3691 &Date_Init() if (! $Curr{"InitDone"});
3692 $date=&ParseDateString($date);
3693 my($err)=();
3694
3695 if (! &Date_IsWorkDay($date,$time)) {
3696 if ($time) {
3697 while (1) {
3698 $date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3699 last if (&Date_IsWorkDay($date,$time));
3700 }
3701 } else {
3702 while (1) {
3703 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3704 last if (&Date_IsWorkDay($date,$time));
3705 }
3706 }
3707 }
3708
3709 while ($off>0) {
3710 while (1) {
3711 $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3712 last if (&Date_IsWorkDay($date,$time));
3713 }
3714 $off--;
3715 }
3716
3717 return $date;
3718}
3719
3720# Finds the day $off work days before now. If $time is passed in, we must
3721# also take into account the time of day.
3722#
3723# If $time is not passed in, day 0 is today (if today is a workday) or the
3724# previous work day if it isn't. In any case, the time of day is unaffected.
3725#
3726# If $time is passed in, day 0 is now (if now is part of a workday) or the
3727# end of the previous work period. Note that since the end of a work day
3728# will automatically be turned into the start of the next one, this time
3729# may actually be treated as AFTER the current time.
3730sub Date_PrevWorkDay {
3731 print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3732 my($date,$off,$time)=@_;
3733 &Date_Init() if (! $Curr{"InitDone"});
3734 $date=&ParseDateString($date);
3735 my($err)=();
3736
3737 if (! &Date_IsWorkDay($date,$time)) {
3738 if ($time) {
3739 while (1) {
3740 $date=&Date_GetPrev($date,undef,0,$Cnf{"WorkDayEnd"});
3741 last if (&Date_IsWorkDay($date,$time));
3742 }
3743 while (1) {
3744 $date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3745 last if (&Date_IsWorkDay($date,$time));
3746 }
3747 } else {
3748 while (1) {
3749 $date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3750 last if (&Date_IsWorkDay($date,$time));
3751 }
3752 }
3753 }
3754
3755 while ($off>0) {
3756 while (1) {
3757 $date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3758 last if (&Date_IsWorkDay($date,$time));
3759 }
3760 $off--;
3761 }
3762
3763 return $date;
3764}
3765
3766# This finds the nearest workday to $date. If $date is a workday, it
3767# is returned.
3768sub Date_NearestWorkDay {
3769 print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3770 my($date,$tomorrow)=@_;
3771 &Date_Init() if (! $Curr{"InitDone"});
3772 $date=&ParseDateString($date);
3773 my($a,$b,$dela,$delb,$err)=();
3774 $tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow);
3775
3776 return $date if (&Date_IsWorkDay($date));
3777
3778 # Find the nearest one.
3779 if ($tomorrow) {
3780 $dela="+0:0:0:1:0:0:0";
3781 $delb="-0:0:0:1:0:0:0";
3782 } else {
3783 $dela="-0:0:0:1:0:0:0";
3784 $delb="+0:0:0:1:0:0:0";
3785 }
3786 $a=$b=$date;
3787
3788 while (1) {
3789 $a=&DateCalc_DateDelta($a,$dela,\$err);
3790 return $a if (&Date_IsWorkDay($a));
3791 $b=&DateCalc_DateDelta($b,$delb,\$err);
3792 return $b if (&Date_IsWorkDay($b));
3793 }
3794}
3795
3796# &Date_NthDayOfYear($y,$n);
3797# Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year.
3798sub Date_NthDayOfYear {
3799 no integer;
3800 print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3801 my($y,$n)=@_;
3802 $y=$Curr{"Y"} if (! $y);
3803 $n=1 if (! defined $n or $n eq "");
3804 $n+=0; # to turn 023 into 23
3805 $y=&Date_FixYear($y) if (length($y)<4);
3806 my $leap=&Date_LeapYear($y);
3807 return () if ($n<1);
3808 return () if ($n >= ($leap ? 367 : 366));
3809
3810 my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31);
3811 $d_in_m[1]=29 if ($leap);
3812
3813 # Calculate the hours, minutes, and seconds into the day.
3814 my $remain=($n - int($n))*24;
3815 my $h=int($remain);
3816 $remain=($remain - $h)*60;
3817 my $mn=int($remain);
3818 $remain=($remain - $mn)*60;
3819 my $s=$remain;
3820
3821 # Calculate the month and the day.
3822 my($m,$d)=(0,0);
3823 $n=int($n);
3824 while ($n>0) {
3825 $m++;
3826 if ($n<=$d_in_m[0]) {
3827 $d=int($n);
3828 $n=0;
3829 } else {
3830 $n-= $d_in_m[0];
3831 shift(@d_in_m);
3832 }
3833 }
3834
3835 ($y,$m,$d,$h,$mn,$s);
3836}
3837
3838########################################################################
3839# NOT FOR EXPORT
3840########################################################################
3841
3842# This is used in Date_Init to fill in a hash based on international
3843# data. It takes a list of keys and values and returns both a hash
3844# with these values and a regular expression of keys.
3845#
3846# IN:
3847# $data = [ key1 val1 key2 val2 ... ]
3848# $opts = lc : lowercase the keys in the regexp
3849# sort : sort (by length) the keys in the regexp
3850# back : create a regexp with a back reference
3851# escape : escape all strings in the regexp
3852#
3853# OUT:
3854# $regexp = '(?:key1|key2|...)'
3855# $hash = { key1=>val1 key2=>val2 ... }
3856
3857sub Date_InitHash {
3858 print "DEBUG: Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
3859 my($data,$regexp,$opts,$hash)=@_;
3860 my(@data)=@$data;
3861 my($key,$val,@list)=();
3862
3863 # Parse the options
3864 my($lc,$sort,$back,$escape)=(0,0,0,0);
3865 $lc=1 if ($opts =~ /lc/i);
3866 $sort=1 if ($opts =~ /sort/i);
3867 $back=1 if ($opts =~ /back/i);
3868 $escape=1 if ($opts =~ /escape/i);
3869
3870 # Create the hash
3871 while (@data) {
3872 ($key,$val,@data)=@data;
3873 $key=lc($key) if ($lc);
3874 $$hash{$key}=$val;
3875 }
3876
3877 # Create the regular expression
3878 if ($regexp) {
3879 @list=keys(%$hash);
3880 @list=sort sortByLength(@list) if ($sort);
3881 if ($escape) {
3882 foreach $val (@list) {
3883 $val="\Q$val\E";
3884 }
3885 }
3886 if ($back) {
3887 $$regexp="(" . join("|",@list) . ")";
3888 } else {
3889 $$regexp="(?:" . join("|",@list) . ")";
3890 }
3891 }
3892}
3893
3894# This is used in Date_Init to fill in regular expressions, lists, and
3895# hashes based on international data. It takes a list of lists which have
3896# to be stored as regular expressions (to find any element in the list),
3897# lists, and hashes (indicating the location in the lists).
3898#
3899# IN:
3900# $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ]
3901# [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ]
3902# ...
3903# [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ]
3904# $lists = [ \@listA \@listB ... \@listZ ]
3905# $opts = lc : lowercase the values in the regexp
3906# sort : sort (by length) the values in the regexp
3907# back : create a regexp with a back reference
3908# escape : escape all strings in the regexp
3909# $hash = [ \%hash, TYPE ]
3910# TYPE 0 : $hash{ valBn=>n-1 }
3911# TYPE 1 : $hash{ valBn=>n }
3912#
3913# OUT:
3914# $regexp = '(?:valA1|valA2|...|valB1|...)'
3915# $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
3916# [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
3917# $hash
3918
3919sub Date_InitLists {
3920 print "DEBUG: Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
3921 my($data,$regexp,$opts,$lists,$hash)=@_;
3922 my(@data)=@$data;
3923 my(@lists)=@$lists;
3924 my($i,@ele,$ele,@list,$j,$tmp)=();
3925
3926 # Parse the options
3927 my($lc,$sort,$back,$escape)=(0,0,0,0);
3928 $lc=1 if ($opts =~ /lc/i);
3929 $sort=1 if ($opts =~ /sort/i);
3930 $back=1 if ($opts =~ /back/i);
3931 $escape=1 if ($opts =~ /escape/i);
3932
3933 # Set each of the lists
3934 if (@lists) {
3935 confess "ERROR: Date_InitLists: lists must be 1 per data\n"
3936 if ($#lists != $#data);
3937 for ($i=0; $i<=$#data; $i++) {
3938 @ele=@{ $data[$i] };
3939 if ($Cnf{"IntCharSet"} && $#ele>0) {
3940 @{ $lists[$i] } = @{ $ele[1] };
3941 } else {
3942 @{ $lists[$i] } = @{ $ele[0] };
3943 }
3944 }
3945 }
3946
3947 # Create the hash
3948 my($hashtype,$hashsave,%hash)=();
3949 if (@$hash) {
3950 ($hash,$hashtype)=@$hash;
3951 $hashsave=1;
3952 } else {
3953 $hashtype=0;
3954 $hashsave=0;
3955 }
3956 for ($i=0; $i<=$#data; $i++) {
3957 @ele=@{ $data[$i] };
3958 foreach $ele (@ele) {
3959 @list = @{ $ele };
3960 for ($j=0; $j<=$#list; $j++) {
3961 $tmp=$list[$j];
3962 next if (! $tmp);
3963 $tmp=lc($tmp) if ($lc);
3964 $hash{$tmp}= $j+$hashtype;
3965 }
3966 }
3967 }
3968 %$hash = %hash if ($hashsave);
3969
3970 # Create the regular expression
3971 if ($regexp) {
3972 @list=keys(%hash);
3973 @list=sort sortByLength(@list) if ($sort);
3974 if ($escape) {
3975 foreach $ele (@list) {
3976 $ele="\Q$ele\E";
3977 }
3978 }
3979 if ($back) {
3980 $$regexp="(" . join("|",@list) . ")";
3981 } else {
3982 $$regexp="(?:" . join("|",@list) . ")";
3983 }
3984 }
3985}
3986
3987# This is used in Date_Init to fill in regular expressions and lists based
3988# on international data. This takes a list of strings and returns a regular
3989# expression (to find any one of them).
3990#
3991# IN:
3992# $data = [ string1 string2 ... ]
3993# $opts = lc : lowercase the values in the regexp
3994# sort : sort (by length) the values in the regexp
3995# back : create a regexp with a back reference
3996# escape : escape all strings in the regexp
3997#
3998# OUT:
3999# $regexp = '(string1|string2|...)'
4000
4001sub Date_InitStrings {
4002 print "DEBUG: Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
4003 my($data,$regexp,$opts)=@_;
4004 my(@list)=@{ $data };
4005
4006 # Parse the options
4007 my($lc,$sort,$back,$escape)=(0,0,0,0);
4008 $lc=1 if ($opts =~ /lc/i);
4009 $sort=1 if ($opts =~ /sort/i);
4010 $back=1 if ($opts =~ /back/i);
4011 $escape=1 if ($opts =~ /escape/i);
4012
4013 # Create the regular expression
4014 my($ele)=();
4015 @list=sort sortByLength(@list) if ($sort);
4016 if ($escape) {
4017 foreach $ele (@list) {
4018 $ele="\Q$ele\E";
4019 }
4020 }
4021 if ($back) {
4022 $$regexp="(" . join("|",@list) . ")";
4023 } else {
4024 $$regexp="(?:" . join("|",@list) . ")";
4025 }
4026 $$regexp=lc($$regexp) if ($lc);
4027}
4028
4029# items is passed in (either as a space separated string, or a reference to
4030# a list) and a regular expression which matches any one of the items is
4031# prepared. The regular expression will be of one of the forms:
4032# "(a|b)" @list not empty, back option included
4033# "(?:a|b)" @list not empty
4034# "()" @list empty, back option included
4035# "" @list empty
4036# $options is a string which contains any of the following strings:
4037# back : the regular expression has a backreference
4038# opt : the regular expression is optional and a "?" is appended in
4039# the first two forms
4040# optws : the regular expression is optional and may be replaced by
4041# whitespace
4042# optWs : the regular expression is optional, but if not present, must
4043# be replaced by whitespace
4044# sort : the items in the list are sorted by length (longest first)
4045# lc : the string is lowercased
4046# under : any underscores are converted to spaces
4047# pre : it may be preceded by whitespace
4048# Pre : it must be preceded by whitespace
4049# PRE : it must be preceded by whitespace or the start
4050# post : it may be followed by whitespace
4051# Post : it must be followed by whitespace
4052# POST : it must be followed by whitespace or the end
4053# Spaces due to pre/post options will not be included in the back reference.
4054#
4055# If $array is included, then the elements will also be returned as a list.
4056# $array is a string which may contain any of the following:
4057# keys : treat the list as a hash and only the keys go into the regexp
4058# key0 : treat the list as the values of a hash with keys 0 .. N-1
4059# key1 : treat the list as the values of a hash with keys 1 .. N
4060# val0 : treat the list as the keys of a hash with values 0 .. N-1
4061# val1 : treat the list as the keys of a hash with values 1 .. N
4062
4063# &Date_InitLists([$lang{"month_name"},$lang{"month_abb"}],
4064# [\$Month,"lc,sort,back"],
4065# [\@Month,\@Mon],
4066# [\%Month,1]);
4067
4068# This is used in Date_Init to prepare regular expressions. A list of
4069# items is passed in (either as a space separated string, or a reference to
4070# a list) and a regular expression which matches any one of the items is
4071# prepared. The regular expression will be of one of the forms:
4072# "(a|b)" @list not empty, back option included
4073# "(?:a|b)" @list not empty
4074# "()" @list empty, back option included
4075# "" @list empty
4076# $options is a string which contains any of the following strings:
4077# back : the regular expression has a backreference
4078# opt : the regular expression is optional and a "?" is appended in
4079# the first two forms
4080# optws : the regular expression is optional and may be replaced by
4081# whitespace
4082# optWs : the regular expression is optional, but if not present, must
4083# be replaced by whitespace
4084# sort : the items in the list are sorted by length (longest first)
4085# lc : the string is lowercased
4086# under : any underscores are converted to spaces
4087# pre : it may be preceded by whitespace
4088# Pre : it must be preceded by whitespace
4089# PRE : it must be preceded by whitespace or the start
4090# post : it may be followed by whitespace
4091# Post : it must be followed by whitespace
4092# POST : it must be followed by whitespace or the end
4093# Spaces due to pre/post options will not be included in the back reference.
4094#
4095# If $array is included, then the elements will also be returned as a list.
4096# $array is a string which may contain any of the following:
4097# keys : treat the list as a hash and only the keys go into the regexp
4098# key0 : treat the list as the values of a hash with keys 0 .. N-1
4099# key1 : treat the list as the values of a hash with keys 1 .. N
4100# val0 : treat the list as the keys of a hash with values 0 .. N-1
4101# val1 : treat the list as the keys of a hash with values 1 .. N
4102sub Date_Regexp {
4103 print "DEBUG: Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
4104 my($list,$options,$array)=@_;
4105 my(@list,$ret,%hash,$i)=();
4106 local($_)=();
4107 $options="" if (! defined $options);
4108 $array="" if (! defined $array);
4109
4110 my($sort,$lc,$under)=(0,0,0);
4111 $sort =1 if ($options =~ /sort/i);
4112 $lc =1 if ($options =~ /lc/i);
4113 $under=1 if ($options =~ /under/i);
4114 my($back,$opt,$pre,$post,$ws)=("?:","","","","");
4115 $back ="" if ($options =~ /back/i);
4116 $opt ="?" if ($options =~ /opt/i);
4117 $pre ='\s*' if ($options =~ /pre/);
4118 $pre ='\s+' if ($options =~ /Pre/);
4119 $pre ='(?:\s+|^)' if ($options =~ /PRE/);
4120 $post ='\s*' if ($options =~ /post/);
4121 $post ='\s+' if ($options =~ /Post/);
4122 $post ='(?:$|\s+)' if ($options =~ /POST/);
4123 $ws ='\s*' if ($options =~ /optws/);
4124 $ws ='\s+' if ($options =~ /optws/);
4125
4126 my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0);
4127 $keys =1 if ($array =~ /keys/i);
4128 $key0 =1 if ($array =~ /key0/i);
4129 $key1 =1 if ($array =~ /key1/i);
4130 $val0 =1 if ($array =~ /val0/i);
4131 $val1 =1 if ($array =~ /val1/i);
4132 $hash =1 if ($keys or $key0 or $key1 or $val0 or $val1);
4133
4134 my($ref)=ref $list;
4135 if (! $ref) {
4136 $list =~ s/\s*$//;
4137 $list =~ s/^\s*//;
4138 $list =~ s/\s+/&&&/g;
4139 } elsif ($ref eq "ARRAY") {
4140 $list = join("&&&",@$list);
4141 } else {
4142 confess "ERROR: Date_Regexp.\n";
4143 }
4144
4145 if (! $list) {
4146 if ($back eq "") {
4147 return "()";
4148 } else {
4149 return "";
4150 }
4151 }
4152
4153 $list=lc($list) if ($lc);
4154 $list=~ s/_/ /g if ($under);
4155 @list=split(/&&&/,$list);
4156 if ($keys) {
4157 %hash=@list;
4158 @list=keys %hash;
4159 } elsif ($key0 or $key1 or $val0 or $val1) {
4160 $i=0;
4161 $i=1 if ($key1 or $val1);
4162 if ($key0 or $key1) {
4163 %hash= map { $_,$i++ } @list;
4164 } else {
4165 %hash= map { $i++,$_ } @list;
4166 }
4167 }
4168 @list=sort sortByLength(@list) if ($sort);
4169
4170 $ret="($back" . join("|",@list) . ")";
4171 $ret="(?:$pre$ret$post)" if ($pre or $post);
4172 $ret.=$opt;
4173 $ret="(?:$ret|$ws)" if ($ws);
4174
4175 if ($array and $hash) {
4176 return ($ret,%hash);
4177 } elsif ($array) {
4178 return ($ret,@list);
4179 } else {
4180 return $ret;
4181 }
4182}
4183
4184# This will produce a delta with the correct number of signs. At most two
4185# signs will be in it normally (one before the year, and one in front of
4186# the day), but if appropriate, signs will be in front of all elements.
4187# Also, as many of the signs will be equivalent as possible.
4188sub Delta_Normalize {
4189 print "DEBUG: Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
4190 my($delta,$mode)=@_;
4191 return "" if (! $delta);
4192 return "+0:+0:+0:+0:+0:+0:+0"
4193 if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"});
4194 return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/);
4195
4196 my($tmp,$sign1,$sign2,$len)=();
4197
4198 # Calculate the length of the day in minutes
4199 $len=24*60;
4200 $len=$Curr{"WDlen"} if ($mode==2 || $mode==3);
4201
4202 # We have to get the sign of every component explicitely so that a "-0"
4203 # or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must
4204 # be a negative delta).
4205
4206 my($y,$mon,$w,$d,$h,$m,$s)=&Delta_Split($delta);
4207
4208 # We need to make sure that the signs of all parts of a delta are the
4209 # same. The easiest way to do this is to convert all of the large
4210 # components to the smallest ones, then convert the smaller components
4211 # back to the larger ones.
4212
4213 # Do the year/month part
4214
4215 $mon += $y*12; # convert y to m
4216 $sign1="+";
4217 if ($mon<0) {
4218 $mon *= -1;
4219 $sign1="-";
4220 }
4221
4222 $y = $mon/12; # convert m to y
4223 $mon -= $y*12;
4224
4225 $y=0 if ($y eq "-0"); # get around silly -0 problem
4226 $mon=0 if ($mon eq "-0");
4227
4228 # Do the wk/day/hour/min/sec part
4229
4230 {
4231 # Unfortunately, $s is overflowing for dates more than ~70 years
4232 # apart.
4233 no integer;
4234
4235 if ($mode==3 || $mode==2) {
4236 $s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
4237 } else {
4238 $s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
4239 }
4240 $sign2="+";
4241 if ($s<0) {
4242 $s*=-1;
4243 $sign2="-";
4244 }
4245
4246 $m = int($s/60); # convert s to m
4247 $s -= $m*60;
4248 $d = int($m/$len); # convert m to d
4249 $m -= $d*$len;
4250
4251 # The rest should be fine.
4252 }
4253 $h = $m/60; # convert m to h
4254 $m -= $h*60;
4255 if ($mode == 3 || $mode == 2) {
4256 $w = $w*1; # get around +0 problem
4257 } else {
4258 $w = $d/7; # convert d to w
4259 $d -= $w*7;
4260 }
4261
4262 $w=0 if ($w eq "-0"); # get around silly -0 problem
4263 $d=0 if ($d eq "-0");
4264 $h=0 if ($h eq "-0");
4265 $m=0 if ($m eq "-0");
4266 $s=0 if ($s eq "-0");
4267
4268 # Only include two signs if necessary
4269 $sign1=$sign2 if ($y==0 and $mon==0);
4270 $sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0);
4271 $sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"});
4272
4273 if ($Cnf{"DeltaSigns"}) {
4274 return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s";
4275 } else {
4276 return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s";
4277 }
4278}
4279
4280# This checks a delta to make sure it is valid. If it is, it splits
4281# it and returns the elements with a sign on each. The 2nd argument
4282# specifies the default sign. Blank elements are set to 0. If the
4283# third element is non-nil, exactly 7 elements must be included.
4284sub Delta_Split {
4285 print "DEBUG: Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
4286 my($delta,$sign,$exact)=@_;
4287 my(@delta)=split(/:/,$delta);
4288 return () if ($exact and $#delta != 6);
4289 my($i)=();
4290 $sign="+" if (! defined $sign);
4291 for ($i=0; $i<=$#delta; $i++) {
4292 $delta[$i]="0" if (! $delta[$i]);
4293 return () if ($delta[$i] !~ /^[+-]?\d+$/);
4294 $sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign);
4295 $delta[$i] = $sign.$delta[$i];
4296 }
4297 @delta;
4298}
4299
4300# Reads up to 3 arguments. $h may contain the time in any international
4301# format. Any empty elements are set to 0.
4302sub Date_ParseTime {
4303 print "DEBUG: Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
4304 my($h,$m,$s)=@_;
4305 my($t)=&CheckTime("one");
4306
4307 if (defined $h and $h =~ /$t/) {
4308 $h=$1;
4309 $m=$2;
4310 $s=$3 if (defined $3);
4311 }
4312 $h="00" if (! defined $h);
4313 $m="00" if (! defined $m);
4314 $s="00" if (! defined $s);
4315
4316 ($h,$m,$s);
4317}
4318
4319# Forms a date with the 6 elements passed in (all of which must be defined).
4320# No check as to validity is made.
4321sub Date_Join {
4322 print "DEBUG: Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
4323 foreach (0 .. $#_) {
4324 croak "undefined arg $_ to Date_Join()" if not defined $_[$_];
4325 }
4326 my($y,$m,$d,$h,$mn,$s)=@_;
4327 my($ym,$md,$dh,$hmn,$mns)=();
4328
4329 if ($Cnf{"Internal"} == 0) {
4330 $ym=$md=$dh="";
4331 $hmn=$mns=":";
4332
4333 } elsif ($Cnf{"Internal"} == 1) {
4334 $ym=$md=$dh=$hmn=$mns="";
4335
4336 } elsif ($Cnf{"Internal"} == 2) {
4337 $ym=$md="-";
4338 $dh=" ";
4339 $hmn=$mns=":";
4340
4341 } else {
4342 confess "ERROR: Invalid internal format in Date_Join.\n";
4343 }
4344 $m="0$m" if (length($m)==1);
4345 $d="0$d" if (length($d)==1);
4346 $h="0$h" if (length($h)==1);
4347 $mn="0$mn" if (length($mn)==1);
4348 $s="0$s" if (length($s)==1);
4349 "$y$ym$m$md$d$dh$h$hmn$mn$mns$s";
4350}
4351
4352# This checks a time. If it is valid, it splits it and returns 3 elements.
4353# If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is
4354# returned.
4355sub CheckTime {
4356 print "DEBUG: CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
4357 my($time)=@_;
4358 my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
4359 my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
4360 my($m)='[0-5][0-9]';
4361 my($s)=$m;
4362 my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)";
4363 my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)";
4364 my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"};
4365 my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4366 if ($time eq "one") {
4367 return $t;
4368 } elsif ($time eq "two") {
4369 $t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4370 return $t;
4371 }
4372
4373 if ($time =~ /$t/i) {
4374 ($h,$m,$s)=($1,$2,$3);
4375 $h="0$h" if (length($h)<2);
4376 $m="0$m" if (length($m)<2);
4377 $s="00" if (! defined $s);
4378 return ($h,$m,$s);
4379 } else {
4380 return ();
4381 }
4382}
4383
4384# This checks a recurrence. If it is valid, it splits it and returns the
4385# elements. Otherwise, it returns an empty list.
4386# ($recur0,$recur1,$flags,$dateb,$date0,$date1)=&Recur_Split($recur);
4387sub Recur_Split {
4388 print "DEBUG: Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
4389 my($recur)=@_;
4390 my(@ret,@tmp);
4391
4392 my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
4393 my($F) = '(?:\*([^*]*))';
4394 my($DB,$D0,$D1);
4395 $DB=$D0=$D1=$F;
4396
4397 if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
4398 @ret=($1,$2,$3,$4,$5);
4399 @tmp=split(/\*/,shift(@ret));
4400 return () if ($#tmp>1);
4401 return (@tmp,"",@ret) if ($#tmp==0);
4402 return (@tmp,@ret);
4403 }
4404 return ();
4405}
4406
4407# This checks a date. If it is valid, it splits it and returns the elements.
4408#
4409# The optional second argument says 'I really expect this to be a
4410# valid Date::Manip object, please throw an exception if it is not'.
4411# Otherwise, if the date passed in is undef or '', a regular
4412# expression for the date is returned; if the string is nonempty but
4413# still not valid, () is returned.
4414#
4415sub Date_Split {
4416 print "DEBUG: Date_Split\n" if ($Curr{"Debug"} =~ /trace/);
4417 my($date, $definitely_valid)=@_;
4418 $definitely_valid = 0 if not defined $definitely_valid;
4419 my($ym,$md,$dh,$hmn,$mns)=();
4420 my($y)='(\d{4})';
4421 my($m)='(0[1-9]|1[0-2])';
4422 my($d)='(0[1-9]|[1-2][0-9]|3[0-1])';
4423 my($h)='([0-1][0-9]|2[0-3])';
4424 my($mn)='([0-5][0-9])';
4425 my($s)=$mn;
4426
4427 if ($Cnf{"Internal"} == 0) {
4428 $ym=$md=$dh="";
4429 $hmn=$mns=":";
4430
4431 } elsif ($Cnf{"Internal"} == 1) {
4432 $ym=$md=$dh=$hmn=$mns="";
4433
4434 } elsif ($Cnf{"Internal"} == 2) {
4435 $ym=$md="-";
4436 $dh=" ";
4437 $hmn=$mns=":";
4438
4439 } else {
4440 confess "ERROR: Invalid internal format in Date_Split.\n";
4441 }
4442
4443 my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$";
4444
4445 if (not defined $date or $date eq '') {
4446 if ($definitely_valid) {
4447 die "bad date '$date'";
4448 } else {
4449 return $t;
4450 }
4451 }
4452
4453 if ($date =~ /$t/) {
4454 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
4455 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4456 $d_in_m[2]=29 if (&Date_LeapYear($y));
4457 if ($d>$d_in_m[$m]) {
4458 my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
4459 if ($definitely_valid) {
4460 die $msg;
4461 }
4462 else {
4463 warn $msg;
4464 return ();
4465 }
4466 }
4467 return ($y,$m,$d,$h,$mn,$s);
4468 }
4469
4470 if ($definitely_valid) {
4471 die "invalid date $date: doesn't match regexp $t";
4472 }
4473 return ();
4474}
4475
4476# This returns the date easter occurs on for a given year as ($month,$day).
4477# This is from the Calendar FAQ.
4478sub Date_Easter {
4479 my($y)=@_;
4480 $y=&Date_FixYear($y) if (length($y)==2);
4481
4482 my($c) = $y/100;
4483 my($g) = $y % 19;
4484 my($k) = ($c-17)/25;
4485 my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30;
4486 $i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11));
4487 my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7;
4488 my($l) = $i-$j;
4489 my($m) = 3 + ($l+40)/44;
4490 my($d) = $l + 28 - 31*($m/4);
4491 return ($m,$d);
4492}
4493
4494# This takes a list of years, months, WeekOfMonth's, and DayOfWeek's, and
4495# returns a list of dates. Optionally, a list of dates can be passed in as
4496# the 1st argument (with the 2nd argument the null list) and the year/month
4497# of these will be used.
4498sub Date_Recur_WoM {
4499 my($y,$m,$w,$d)=@_;
4500 my(@y)=@$y;
4501 my(@m)=@$m;
4502 my(@w)=@$w;
4503 my(@d)=@$d;
4504 my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
4505
4506 if (@m) {
4507 foreach $m (@m) {
4508 return () if (! &IsInt($m,1,12));
4509 }
4510
4511 @tmp=@tmp2=();
4512 foreach $y (@y) {
4513 foreach $m (@m) {
4514 push(@tmp,$y);
4515 push(@tmp2,$m);
4516 }
4517 }
4518
4519 @y=@tmp;
4520 @m=@tmp2;
4521
4522 } else {
4523 foreach $d0 (@y) {
4524 @tmp=&Date_Split($d0);
4525 return () if (! @tmp);
4526 push(@tmp2,$tmp[0]);
4527 push(@m,$tmp[1]);
4528 }
4529 @y=@tmp2;
4530 }
4531
4532 return () if (! @w);
4533 foreach $w (@w) {
4534 return () if ($w==0 || ! &IsInt($w,-5,5));
4535 }
4536
4537 if (@d) {
4538 foreach $d (@d) {
4539 return () if ($d==0 || ! &IsInt($d,-7,7));
4540 $d += 8 if ($d < 0);
4541 }
4542 }
4543
4544 @date=();
4545 foreach $y (@y) {
4546 $m=shift(@m);
4547
4548 # Find 1st day of this month and next month
4549 $date0=&Date_Join($y,$m,1,0,0,0);
4550 $date1=&DateCalc_DateDelta($date0,"+0:1:0:0:0:0:0");
4551
4552 foreach $d (@d) {
4553 # Find 1st occurence of DOW (in both months)
4554 $d0=&Date_GetNext($date0,$d,1);
4555 $d1=&Date_GetNext($date1,$d,1);
4556
4557 @tmp=();
4558 while (&Date_Cmp($d0,$d1)<0) {
4559 push(@tmp,$d0);
4560 $d0=&DateCalc_DateDelta($d0,"+0:0:1:0:0:0:0");
4561 }
4562
4563 @tmp2=();
4564 foreach $w (@w) {
4565 if ($w>0) {
4566 next if ($w > $#tmp+1);
4567 push(@tmp2,$tmp[$w-1]);
4568 } else {
4569 next if (-$w > $#tmp+1);
4570 push(@tmp2,$tmp[$#tmp+1+$w]);
4571 }
4572 }
4573 @tmp2=sort { Date_Cmp($a,$b) } @tmp2;
4574 push(@date,@tmp2);
4575 }
4576 }
4577
4578 @date;
4579}
4580
4581# This returns a sorted list of dates formed by adding/subtracting
4582# $delta to $dateb in the range $date0<=$d<$dateb. The first date in
4583# the list is actually the first date<$date0 and the last date in the
4584# list is the first date>=$date1 (because sometimes the set part will
4585# move the date back into the range).
4586sub Date_Recur {
4587 my($date0,$date1,$dateb,$delta)=@_;
4588 my(@ret,$d)=();
4589
4590 while (&Date_Cmp($dateb,$date0)<0) {
4591 $dateb=&DateCalc_DateDelta($dateb,$delta);
4592 }
4593 while (&Date_Cmp($dateb,$date1)>=0) {
4594 $dateb=&DateCalc_DateDelta($dateb,"-$delta");
4595 }
4596
4597 # Add the dates $date0..$dateb
4598 $d=$dateb;
4599 while (&Date_Cmp($d,$date0)>=0) {
4600 unshift(@ret,$d);
4601 $d=&DateCalc_DateDelta($d,"-$delta");
4602 }
4603 # Add the first date earler than the range
4604 unshift(@ret,$d);
4605
4606 # Add the dates $dateb..$date1
4607 $d=&DateCalc_DateDelta($dateb,$delta);
4608 while (&Date_Cmp($d,$date1)<0) {
4609 push(@ret,$d);
4610 $d=&DateCalc_DateDelta($d,$delta);
4611 }
4612 # Add the first date later than the range
4613 push(@ret,$d);
4614
4615 @ret;
4616}
4617
4618# This sets the values in each date of a recurrence.
4619#
4620# $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1",
4621# they are not set (and none of the larger elements are set).
4622sub Date_RecurSetTime {
4623 my($date0,$date1,$dates,$h,$m,$s)=@_;
4624 my(@dates)=@$dates;
4625 my(@h,@m,@s,$date,@tmp)=();
4626
4627 $m="-1" if ($s eq "-1");
4628 $h="-1" if ($m eq "-1");
4629
4630 if ($h ne "-1") {
4631 @h=&ReturnList($h);
4632 return () if ! (@h);
4633 @h=sort { $a<=>$b } (@h);
4634
4635 @tmp=();
4636 foreach $date (@dates) {
4637 foreach $h (@h) {
4638 push(@tmp,&Date_SetDateField($date,"h",$h,1));
4639 }
4640 }
4641 @dates=@tmp;
4642 }
4643
4644 if ($m ne "-1") {
4645 @m=&ReturnList($m);
4646 return () if ! (@m);
4647 @m=sort { $a<=>$b } (@m);
4648
4649 @tmp=();
4650 foreach $date (@dates) {
4651 foreach $m (@m) {
4652 push(@tmp,&Date_SetDateField($date,"mn",$m,1));
4653 }
4654 }
4655 @dates=@tmp;
4656 }
4657
4658 if ($s ne "-1") {
4659 @s=&ReturnList($s);
4660 return () if ! (@s);
4661 @s=sort { $a<=>$b } (@s);
4662
4663 @tmp=();
4664 foreach $date (@dates) {
4665 foreach $s (@s) {
4666 push(@tmp,&Date_SetDateField($date,"s",$s,1));
4667 }
4668 }
4669 @dates=@tmp;
4670 }
4671
4672 @tmp=();
4673 foreach $date (@dates) {
4674 push(@tmp,$date) if (&Date_Cmp($date,$date0)>=0 &&
4675 &Date_Cmp($date,$date1)<0 &&
4676 &Date_Split($date));
4677 }
4678
4679 @tmp;
4680}
4681
4682sub DateCalc_DateDate {
4683 print "DEBUG: DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
4684 my($D1,$D2,$mode)=@_;
4685 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4686 $mode=0 if (! defined $mode);
4687
4688 # Exact mode
4689 if ($mode==0) {
4690 my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split($D1, 1);
4691 my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split($D2, 1);
4692 my($i,@delta,$d,$delta,$y)=();
4693
4694 # form the delta for hour/min/sec
4695 $delta[4]=$h2-$h1;
4696 $delta[5]=$mn2-$mn1;
4697 $delta[6]=$s2-$s1;
4698
4699 # form the delta for yr/mon/day
4700 $delta[0]=$delta[1]=0;
4701 $d=0;
4702 if ($y2>$y1) {
4703 $d=&Date_DaysInYear($y1) - &Date_DayOfYear($m1,$d1,$y1);
4704 $d+=&Date_DayOfYear($m2,$d2,$y2);
4705 for ($y=$y1+1; $y<$y2; $y++) {
4706 $d+= &Date_DaysInYear($y);
4707 }
4708 } elsif ($y2<$y1) {
4709 $d=&Date_DaysInYear($y2) - &Date_DayOfYear($m2,$d2,$y2);
4710 $d+=&Date_DayOfYear($m1,$d1,$y1);
4711 for ($y=$y2+1; $y<$y1; $y++) {
4712 $d+= &Date_DaysInYear($y);
4713 }
4714 $d *= -1;
4715 } else {
4716 $d=&Date_DayOfYear($m2,$d2,$y2) - &Date_DayOfYear($m1,$d1,$y1);
4717 }
4718 $delta[2]=0;
4719 $delta[3]=$d;
4720
4721 for ($i=0; $i<7; $i++) {
4722 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4723 }
4724
4725 $delta=join(":",@delta);
4726 $delta=&Delta_Normalize($delta,0);
4727 return $delta;
4728 }
4729
4730 my($date1,$date2)=($D1,$D2);
4731 my($tmp,$sign,$err,@tmp)=();
4732
4733 # make sure both are work days
4734 if ($mode==2 || $mode==3) {
4735 $date1=&Date_NextWorkDay($date1,0,1);
4736 $date2=&Date_NextWorkDay($date2,0,1);
4737 }
4738
4739 # make sure date1 comes before date2
4740 if (&Date_Cmp($date1,$date2)>0) {
4741 $sign="-";
4742 $tmp=$date1;
4743 $date1=$date2;
4744 $date2=$tmp;
4745 } else {
4746 $sign="+";
4747 }
4748 if (&Date_Cmp($date1,$date2)==0) {
4749 return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
4750 return "+0:0:0:0:0:0:0";
4751 }
4752
4753 my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split($date1, 1);
4754 my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split($date2, 1);
4755 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0);
4756
4757 if ($mode != 3) {
4758
4759 # Do years
4760 $dy=$y2-$y1;
4761 $dm=0;
4762 if ($dy>0) {
4763 $tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0);
4764 if (&Date_Cmp($tmp,$date2)>0) {
4765 $dy--;
4766 $tmp=$date1;
4767 $tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0)
4768 if ($dy>0);
4769 $dm=12;
4770 }
4771 $date1=$tmp;
4772 }
4773
4774 # Do months
4775 $dm+=$m2-$m1;
4776 if ($dm>0) {
4777 $tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0);
4778 if (&Date_Cmp($tmp,$date2)>0) {
4779 $dm--;
4780 $tmp=$date1;
4781 $tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0)
4782 if ($dm>0);
4783 }
4784 $date1=$tmp;
4785 }
4786
4787 # At this point, check to see that we're on a business day again so that
4788 # Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month
4789 if ($mode==2) {
4790 if (! &Date_IsWorkDay($date1,0)) {
4791 $date1=&Date_NextWorkDay($date1,0,1);
4792 }
4793 }
4794 }
4795
4796 # Do days
4797 if ($mode==2 || $mode==3) {
4798 $dd=0;
4799 while (1) {
4800 $tmp=&Date_NextWorkDay($date1,1,1);
4801 if (&Date_Cmp($tmp,$date2)<=0) {
4802 $dd++;
4803 $date1=$tmp;
4804 } else {
4805 last;
4806 }
4807 }
4808
4809 } else {
4810 ($y1,$m1,$d1)=( &Date_Split($date1, 1) )[0..2];
4811 $dd=0;
4812 # If we're jumping across months, set $d1 to the first of the next month
4813 # (or possibly the 0th of next month which is equivalent to the last day
4814 # of this month)
4815 if ($m1!=$m2) {
4816 $d_in_m[2]=29 if (&Date_LeapYear($y1));
4817 $dd=$d_in_m[$m1]-$d1+1;
4818 $d1=1;
4819 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4820 if (&Date_Cmp($tmp,$date2)>0) {
4821 $dd--;
4822 $d1--;
4823 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4824 }
4825 $date1=$tmp;
4826 }
4827
4828 $ddd=0;
4829 if ($d1<$d2) {
4830 $ddd=$d2-$d1;
4831 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4832 if (&Date_Cmp($tmp,$date2)>0) {
4833 $ddd--;
4834 $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4835 }
4836 $date1=$tmp;
4837 }
4838 $dd+=$ddd;
4839 }
4840
4841 # in business mode, make sure h1 comes before h2 (if not find delta between
4842 # now and end of day and move to start of next business day)
4843 $d1=( &Date_Split($date1, 1) )[2];
4844 $dh=$dmn=$ds=0;
4845 if ($mode==2 || $mode==3 and $d1 != $d2) {
4846 $tmp=&Date_SetTime($date1,$Cnf{"WorkDayEnd"});
4847 $tmp=&DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0")
4848 if ($Cnf{"WorkDay24Hr"});
4849 $tmp=&DateCalc_DateDate($date1,$tmp,0);
4850 ($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=&Delta_Split($tmp);
4851 $date1=&Date_NextWorkDay($date1,1,0);
4852 $date1=&Date_SetTime($date1,$Cnf{"WorkDayBeg"});
4853 $d1=( &Date_Split($date1, 1) )[2];
4854 confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2);
4855 }
4856
4857 # Hours, minutes, seconds
4858 $tmp=&DateCalc_DateDate($date1,$date2,0);
4859 @tmp=&Delta_Split($tmp);
4860 $dh += $tmp[4];
4861 $dmn += $tmp[5];
4862 $ds += $tmp[6];
4863
4864 $tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds";
4865 &Delta_Normalize($tmp,$mode);
4866}
4867
4868sub DateCalc_DeltaDelta {
4869 print "DEBUG: DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/);
4870 my($D1,$D2,$mode)=@_;
4871 my(@delta1,@delta2,$i,$delta,@delta)=();
4872 $mode=0 if (! defined $mode);
4873
4874 @delta1=&Delta_Split($D1);
4875 @delta2=&Delta_Split($D2);
4876 for ($i=0; $i<7; $i++) {
4877 $delta[$i]=$delta1[$i]+$delta2[$i];
4878 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4879 }
4880
4881 $delta=join(":",@delta);
4882 $delta=&Delta_Normalize($delta,$mode);
4883 return $delta;
4884}
4885
4886sub DateCalc_DateDelta {
4887 print "DEBUG: DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
4888 my($D1,$D2,$errref,$mode)=@_;
4889 my($date)=();
4890 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4891 my($h1,$m1,$h2,$m2,$len,$hh,$mm)=();
4892 $mode=0 if (! defined $mode);
4893
4894 if ($mode==2 || $mode==3) {
4895 $h1=$Curr{"WDBh"};
4896 $m1=$Curr{"WDBm"};
4897 $h2=$Curr{"WDEh"};
4898 $m2=$Curr{"WDEm"};
4899 $hh=$h2-$h1;
4900 $mm=$m2-$m1;
4901 if ($mm<0) {
4902 $hh--;
4903 $mm+=60;
4904 }
4905 }
4906
4907 # Date, delta
4908 my($y,$m,$d,$h,$mn,$s)=&Date_Split($D1, 1);
4909 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=&Delta_Split($D2);
4910
4911 # do the month/year part
4912 $y+=$dy;
4913 while (length($y)<4) {
4914 $y = "0$y";
4915 }
4916 &ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11
4917 $d_in_m[2]=29 if (&Date_LeapYear($y));
4918
4919 # if we have gone past the last day of a month, move the date back to
4920 # the last day of the month
4921 if ($d>$d_in_m[$m]) {
4922 $d=$d_in_m[$m];
4923 }
4924
4925 # do the week part
4926 if ($mode==0 || $mode==1) {
4927 $dd += $dw*7;
4928 } else {
4929 $date=&DateCalc_DateDelta(&Date_Join($y,$m,$d,$h,$mn,$s),
4930 "+0:0:$dw:0:0:0:0",0);
4931 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
4932 }
4933
4934 # in business mode, set the day to a work day at this point so the h/mn/s
4935 # stuff will work out
4936 if ($mode==2 || $mode==3) {
4937 $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
4938 $date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),0,1);
4939 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
4940 }
4941
4942 # seconds, minutes, hours
4943 &ModuloAddition(60,$ds,\$s,\$mn);
4944 if ($mode==2 || $mode==3) {
4945 while (1) {
4946 &ModuloAddition(60,$dmn,\$mn,\$h);
4947 $h+= $dh;
4948
4949 if ($h>$h2 or $h==$h2 && $mn>$m2) {
4950 $dh=$h-$h2;
4951 $dmn=$mn-$m2;
4952 $h=$h1;
4953 $mn=$m1;
4954 $dd++;
4955
4956 } elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
4957 $dh=$h-$h1;
4958 $dmn=$m1-$mn;
4959 $h=$h2;
4960 $mn=$m2;
4961 $dd--;
4962
4963 } elsif ($h==$h2 && $mn==$m2) {
4964 $dd++;
4965 $dh=-$hh;
4966 $dmn=-$mm;
4967
4968 } else {
4969 last;
4970 }
4971 }
4972
4973 } else {
4974 &ModuloAddition(60,$dmn,\$mn,\$h);
4975 &ModuloAddition(24,$dh,\$h,\$d);
4976 }
4977
4978 # If we have just gone past the last day of the month, we need to make
4979 # up for this:
4980 if ($d>$d_in_m[$m]) {
4981 $dd+= $d-$d_in_m[$m];
4982 $d=$d_in_m[$m];
4983 }
4984
4985 # days
4986 if ($mode==2 || $mode==3) {
4987 if ($dd>=0) {
4988 $date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),$dd,1);
4989 } else {
4990 $date=&Date_PrevWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1);
4991 }
4992 ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
4993
4994 } else {
4995 $d_in_m[2]=29 if (&Date_LeapYear($y));
4996 $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
4997 $d += $dd;
4998 while ($d<1) {
4999 $m--;
5000 if ($m==0) {
5001 $m=12;
5002 $y--;
5003 if (&Date_LeapYear($y)) {
5004 $d_in_m[2]=29;
5005 } else {
5006 $d_in_m[2]=28;
5007 }
5008 }
5009 $d += $d_in_m[$m];
5010 }
5011 while ($d>$d_in_m[$m]) {
5012 $d -= $d_in_m[$m];
5013 $m++;
5014 if ($m==13) {
5015 $m=1;
5016 $y++;
5017 if (&Date_LeapYear($y)) {
5018 $d_in_m[2]=29;
5019 } else {
5020 $d_in_m[2]=28;
5021 }
5022 }
5023 }
5024 }
5025
5026 if ($y<0 or $y>9999) {
5027 $$errref=3;
5028 return;
5029 }
5030 &Date_Join($y,$m,$d,$h,$mn,$s);
5031}
5032
5033sub Date_UpdateHolidays {
5034 print "DEBUG: Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
5035 my($year)=@_;
5036 $Holiday{"year"}=$year;
5037 $Holiday{"dates"}{$year}={};
5038
5039 my($date,$delta,$err)=();
5040 my($key,@tmp,$tmp);
5041
5042 foreach $key (keys %{ $Holiday{"desc"} }) {
5043 @tmp=&Recur_Split($key);
5044 if (@tmp) {
5045 $tmp=&ParseDateString("${year}010100:00:00");
5046 ($date)=&ParseRecur($key,$tmp,$tmp,($year+1)."-01-01");
5047 next if (! $date);
5048
5049 } elsif ($key =~ /^(.*)([+-].*)$/) {
5050 # Date +/- Delta
5051 ($date,$delta)=($1,$2);
5052 $tmp=&ParseDateString("$date $year");
5053 if ($tmp) {
5054 $date=$tmp;
5055 } else {
5056 $date=&ParseDateString($date);
5057 next if ($date !~ /^$year/);
5058 }
5059 $date=&DateCalc($date,$delta,\$err,0);
5060
5061 } else {
5062 # Date
5063 $date=$key;
5064 $tmp=&ParseDateString("$date $year");
5065 if ($tmp) {
5066 $date=$tmp;
5067 } else {
5068 $date=&ParseDateString($date);
5069 next if ($date !~ /^$year/);
5070 }
5071 }
5072 $Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key};
5073 }
5074}
5075
5076# This sets a Date::Manip config variable.
5077sub Date_SetConfigVariable {
5078 print "DEBUG: Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/);
5079 my($var,$val)=@_;
5080
5081 # These are most appropriate for command line options instead of in files.
5082 $Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i);
5083 $Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i);
5084 $Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i);
5085 &EraseHolidays(), return if ($var =~ /^EraseHolidays$/i);
5086 $Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i);
5087 $Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i);
5088
5089 $Curr{"InitLang"}=1,
5090 $Cnf{"Language"}=$val, return if ($var =~ /^Language$/i);
5091 $Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i);
5092 $Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i);
5093 $Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i);
5094 $Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i);
5095 $Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i);
5096 $Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i);
5097 $Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i);
5098 $Cnf{"WorkDayBeg"}=$val,
5099 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
5100 $Cnf{"WorkDayEnd"}=$val,
5101 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i);
5102 $Cnf{"WorkDay24Hr"}=$val,
5103 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i);
5104 $Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i);
5105 $Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i);
5106 $Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i);
5107 $Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i);
5108 $Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i);
5109 $Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i);
5110 $Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i);
5111 $Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i);
5112 $Cnf{"TodayIsMidnight"}=$val, return if ($var =~ /^TodayIsMidnight$/i);
5113
5114 confess "ERROR: Unknown configuration variable $var in Date::Manip.\n";
5115}
5116
5117sub EraseHolidays {
5118 print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
5119
5120 $Cnf{"EraseHolidays"}=0;
5121 delete $Holiday{"list"};
5122 $Holiday{"list"}={};
5123 delete $Holiday{"desc"};
5124 $Holiday{"desc"}={};
5125 $Holiday{"dates"}={};
5126}
5127
5128# This returns a pointer to a list of times and events in the format
5129# [ date [ events ], date, [ events ], ... ]
5130# where each list of events are events that are in effect at the date
5131# immediately preceding the list.
5132#
5133# This takes either one date or two dates as arguments.
5134sub Events_Calc {
5135 print "DEBUG: Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
5136
5137 my($date0,$date1)=@_;
5138
5139 my($tmp);
5140 $date0=&ParseDateString($date0);
5141 return undef if (! $date0);
5142 if ($date1) {
5143 $date1=&ParseDateString($date1);
5144 if (&Date_Cmp($date0,$date1)>0) {
5145 $tmp=$date1;
5146 $date1=$date0;
5147 $date0=$tmp;
5148 }
5149 } else {
5150 $date1=&DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1");
5151 }
5152
5153 #
5154 # [ d0,d1,del,name ] => [ d0, d1+del )
5155 # [ d0,0,del,name ] => [ d0, d0+del )
5156 #
5157 my(%ret,$d0,$d1,$del,$name,$c0,$c1);
5158 my(@tmp)=@{ $Events{"dates"} };
5159 DATE: while (@tmp) {
5160 ($d0,$d1,$del,$name)=splice(@tmp,0,4);
5161 $d0=&ParseDateString($d0);
5162 $d1=&ParseDateString($d1) if ($d1);
5163 $del=&ParseDateDelta($del) if ($del);
5164 if ($d1) {
5165 if ($del) {
5166 $d1=&DateCalc_DateDelta($d1,$del);
5167 }
5168 } else {
5169 $d1=&DateCalc_DateDelta($d0,$del);
5170 }
5171 if (&Date_Cmp($d0,$d1)>0) {
5172 $tmp=$d1;
5173 $d1=$d0;
5174 $d0=$tmp;
5175 }
5176 # [ date0,date1 )
5177 # [ d0,d1 ) OR [ d0,d1 )
5178 next DATE if (&Date_Cmp($d1,$date0)<=0 ||
5179 &Date_Cmp($d0,$date1)>=0);
5180 # [ date0,date1 )
5181 # [ d0,d1 )
5182 # [ d0, d1 )
5183 if (&Date_Cmp($d0,$date0)<=0) {
5184 push @{ $ret{$date0} },$name;
5185 push @{ $ret{$d1} },"!$name" if (&Date_Cmp($d1,$date1)<0);
5186 next DATE;
5187 }
5188 # [ date0,date1 )
5189 # [ d0,d1 )
5190 if (&Date_Cmp($d1,$date1)>=0) {
5191 push @{ $ret{$d0} },$name;
5192 next DATE;
5193 }
5194 # [ date0,date1 )
5195 # [ d0,d1 )
5196 push @{ $ret{$d0} },$name;
5197 push @{ $ret{$d1} },"!$name";
5198 }
5199
5200 #
5201 # [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
5202 #
5203 my($rec,$del0,$del1,@d);
5204 @tmp=@{ $Events{"recur"} };
5205 RECUR: while (@tmp) {
5206 ($rec,$del0,$del1,$name)=splice(@tmp,0,4);
5207 @d=();
5208
5209 }
5210
5211 # Sort them AND take into account the "!$name" entries.
5212 my(%tmp,$date,@tmp2,@ret);
5213 @d=sort { &Date_Cmp($a,$b) } keys %ret;
5214 foreach $date (@d) {
5215 @tmp=@{ $ret{$date} };
5216 @tmp2=();
5217 foreach $tmp (@tmp) {
5218 push(@tmp2,$tmp), next if ($tmp =~ /^!/);
5219 $tmp{$tmp}=1;
5220 }
5221 foreach $tmp (@tmp2) {
5222 $tmp =~ s/^!//;
5223 delete $tmp{$tmp};
5224 }
5225 push(@ret,$date,[ keys %tmp ]);
5226 }
5227
5228 %tmp = @ret;
5229 @ret = ();
5230 foreach my $d (sort { Date_Cmp($a,$b) } keys %tmp) {
5231 my $e = $tmp{$d};
5232 push @ret,($d,[ sort @$e ]);
5233 }
5234 return \@ret;
5235}
5236
5237# This parses the raw events list
5238sub Events_ParseRaw {
5239 print "DEBUG: Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
5240
5241 # Only need to be parsed once
5242 my($force)=@_;
5243 $Events{"parsed"}=0 if ($force);
5244 return if ($Events{"parsed"});
5245 $Events{"parsed"}=1;
5246
5247 my(@events)=@{ $Events{"raw"} };
5248 my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
5249 $recur);
5250 EVENT: while (@events) {
5251 ($event,$name)=splice(@events,0,2);
5252 @event=split(/\s*;\s*/,$event);
5253
5254 if ($#event == 0) {
5255
5256 if ($date0=&ParseDateString($event[0])) {
5257 #
5258 # date = event
5259 #
5260 $tmp=&ParseDateString("$event[0] 00:00:00");
5261 if ($tmp && $tmp eq $date0) {
5262 $delta="+0:0:0:1:0:0:0";
5263 } else {
5264 $delta="+0:0:0:0:1:0:0";
5265 }
5266 push @{ $Events{"dates"} },($date0,0,$delta,$name);
5267
5268 } elsif ($recur=&ParseRecur($event[0])) {
5269 #
5270 # recur = event
5271 #
5272 ($recur0,$recur1)=&Recur_Split($recur);
5273 if ($recur0) {
5274 if ($recur1) {
5275 $r="$recur0:$recur1";
5276 } else {
5277 $r=$recur0;
5278 }
5279 } else {
5280 $r=$recur1;
5281 }
5282 (@recur)=split(/:/,$r);
5283 if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
5284 $delta="+0:0:0:1:0:0:0";
5285 } else {
5286 $delta="+0:0:0:0:1:0:0";
5287 }
5288 push @{ $Events{"recur"} },($recur,0,$delta,$name);
5289
5290 } else {
5291 # ??? = event
5292 warn "WARNING: illegal event ignored [ @event ]\n";
5293 next EVENT;
5294 }
5295
5296 } elsif ($#event == 1) {
5297
5298 if ($date0=&ParseDateString($event[0])) {
5299
5300 if ($date1=&ParseDateString($event[1])) {
5301 #
5302 # date ; date = event
5303 #
5304 $tmp=&ParseDateString("$event[1] 00:00:00");
5305 if ($tmp && $tmp eq $date1) {
5306 $date1=&DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0");
5307 }
5308 push @{ $Events{"dates"} },($date0,$date1,0,$name);
5309
5310 } elsif ($delta=&ParseDateDelta($event[1])) {
5311 #
5312 # date ; delta = event
5313 #
5314 push @{ $Events{"dates"} },($date0,0,$delta,$name);
5315
5316 } else {
5317 # date ; ??? = event
5318 warn "WARNING: illegal event ignored [ @event ]\n";
5319 next EVENT;
5320 }
5321
5322 } elsif ($recur=&ParseRecur($event[0])) {
5323
5324 if ($delta=&ParseDateDelta($event[1])) {
5325 #
5326 # recur ; delta = event
5327 #
5328 push @{ $Events{"recur"} },($recur,0,$delta,$name);
5329
5330 } else {
5331 # recur ; ??? = event
5332 warn "WARNING: illegal event ignored [ @event ]\n";
5333 next EVENT;
5334 }
5335
5336 } else {
5337 # ??? ; ??? = event
5338 warn "WARNING: illegal event ignored [ @event ]\n";
5339 next EVENT;
5340 }
5341
5342 } else {
5343 # date ; delta0 ; delta1 = event
5344 # recur ; delta0 ; delta1 = event
5345 # ??? ; ??? ; ??? ... = event
5346 warn "WARNING: illegal event ignored [ @event ]\n";
5347 next EVENT;
5348 }
5349 }
5350}
5351
5352# This reads an init file.
5353sub Date_InitFile {
5354 print "DEBUG: Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
5355 my($file)=@_;
5356 my($in)=new IO::File;
5357 local($_)=();
5358 my($section)="vars";
5359 my($var,$val,$recur,$name)=();
5360
5361 $in->open($file) || return;
5362 while(defined ($_=<$in>)) {
5363 chomp;
5364 s/^\s+//;
5365 s/\s+$//;
5366 next if (! $_ or /^\#/);
5367
5368 if (/^\*holiday/i) {
5369 $section="holiday";
5370 &EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
5371 next;
5372 } elsif (/^\*events/i) {
5373 $section="events";
5374 next;
5375 }
5376
5377 if ($section =~ /var/i) {
5378 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5379 if (! /(.*\S)\s*=\s*(.*)$/);
5380 ($var,$val)=($1,$2);
5381 &Date_SetConfigVariable($var,$val);
5382
5383 } elsif ($section =~ /holiday/i) {
5384 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5385 if (! /(.*\S)\s*=\s*(.*)$/);
5386 ($recur,$name)=($1,$2);
5387 $name="" if (! defined $name);
5388 $Holiday{"desc"}{$recur}=$name;
5389
5390 } elsif ($section =~ /events/i) {
5391 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5392 if (! /(.*\S)\s*=\s*(.*)$/);
5393 ($val,$var)=($1,$2);
5394 push @{ $Events{"raw"} },($val,$var);
5395
5396 } else {
5397 # A section not currently used by Date::Manip (but may be
5398 # used by some extension to it).
5399 next;
5400 }
5401 }
5402 close($in);
5403}
5404
5405# $flag=&Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
5406# Returns 1 if any of the fields are bad. All fields are optional, and
5407# all possible checks are done on the data. If a field is not passed in,
5408# it is set to default values. If data is missing, appropriate defaults
5409# are supplied.
5410sub Date_TimeCheck {
5411 print "DEBUG: Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
5412 my($h,$mn,$s,$ampm)=@_;
5413 my($tmp1,$tmp2,$tmp3)=();
5414
5415 $$h="" if (! defined $$h);
5416 $$mn="" if (! defined $$mn);
5417 $$s="" if (! defined $$s);
5418 $$ampm="" if (! defined $$ampm);
5419 $$ampm=uc($$ampm) if ($$ampm);
5420
5421 # Check hour
5422 $tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
5423 $tmp2="";
5424 if ($$ampm =~ /^$tmp1$/i) {
5425 $tmp3=$Lang{$Cnf{"Language"}}{"AM"};
5426 $tmp2="AM" if ($$ampm =~ /^$tmp3$/i);
5427 $tmp3=$Lang{$Cnf{"Language"}}{"PM"};
5428 $tmp2="PM" if ($$ampm =~ /^$tmp3$/i);
5429 } elsif ($$ampm) {
5430 return 1;
5431 }
5432 if ($tmp2 eq "AM" || $tmp2 eq "PM") {
5433 $$h="0$$h" if (length($$h)==1);
5434 return 1 if ($$h<1 || $$h>12);
5435 $$h="00" if ($tmp2 eq "AM" and $$h==12);
5436 $$h += 12 if ($tmp2 eq "PM" and $$h!=12);
5437 } else {
5438 $$h="00" if ($$h eq "");
5439 $$h="0$$h" if (length($$h)==1);
5440 return 1 if (! &IsInt($$h,0,23));
5441 $tmp2="AM" if ($$h<12);
5442 $tmp2="PM" if ($$h>=12);
5443 }
5444 $$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
5445 $$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
5446
5447 # Check minutes
5448 $$mn="00" if ($$mn eq "");
5449 $$mn="0$$mn" if (length($$mn)==1);
5450 return 1 if (! &IsInt($$mn,0,59));
5451
5452 # Check seconds
5453 $$s="00" if ($$s eq "");
5454 $$s="0$$s" if (length($$s)==1);
5455 return 1 if (! &IsInt($$s,0,59));
5456
5457 return 0;
5458}
5459
5460# $flag=&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
5461# Returns 1 if any of the fields are bad. All fields are optional, and
5462# all possible checks are done on the data. If a field is not passed in,
5463# it is set to default values. If data is missing, appropriate defaults
5464# are supplied.
5465#
5466# If the flag UpdateHolidays is set, the year is set to
5467# CurrHolidayYear.
5468sub Date_DateCheck {
5469 print "DEBUG: Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/);
5470 my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_;
5471 my($tmp1,$tmp2,$tmp3)=();
5472
5473 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
5474 my($curr_y)=$Curr{"Y"};
5475 my($curr_m)=$Curr{"M"};
5476 my($curr_d)=$Curr{"D"};
5477 $$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d);
5478 $$y="" if (! defined $$y);
5479 $$m="" if (! defined $$m);
5480 $$d="" if (! defined $$d);
5481 $$wk="" if (! defined $$wk);
5482 $$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq "");
5483
5484 # Check year.
5485 $$y=$curr_y if ($$y eq "");
5486 $$y=&Date_FixYear($$y) if (length($$y)<4);
5487 return 1 if (! &IsInt($$y,0,9999));
5488 $d_in_m[2]=29 if (&Date_LeapYear($$y));
5489
5490 # Check month
5491 $$m=$curr_m if ($$m eq "");
5492 $$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}
5493 if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)});
5494 $$m="0$$m" if (length($$m)==1);
5495 return 1 if (! &IsInt($$m,1,12));
5496
5497 # Check day
5498 $$d="01" if ($$d eq "");
5499 $$d="0$$d" if (length($$d)==1);
5500 return 1 if (! &IsInt($$d,1,$d_in_m[$$m]));
5501 if ($$wk) {
5502 $tmp1=&Date_DayOfWeek($$m,$$d,$$y);
5503 $tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}
5504 if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)});
5505 return 1 if ($tmp1 != $tmp2);
5506 }
5507
5508 return &Date_TimeCheck($h,$mn,$s,$ampm);
5509}
5510
5511# Takes a year in 2 digit form and returns it in 4 digit form
5512sub Date_FixYear {
5513 print "DEBUG: Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
5514 my($y)=@_;
5515 my($curr_y)=$Curr{"Y"};
5516 $y=$curr_y if (! defined $y or ! $y);
5517 return $y if (length($y)==4);
5518 confess "ERROR: Invalid year ($y)\n" if (length($y)!=2);
5519 my($y1,$y2)=();
5520
5521 if (lc($Cnf{"YYtoYYYY"}) eq "c") {
5522 $y1=substring($y,0,2);
5523 $y="$y1$y";
5524
5525 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
5526 $y1=$1;
5527 $y="$y1$y";
5528
5529 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
5530 $y1="$1$2";
5531 $y ="$1$y";
5532 $y += 100 if ($y<$y1);
5533
5534 } else {
5535 $y1=$curr_y-$Cnf{"YYtoYYYY"};
5536 $y2=$y1+99;
5537 $y="19$y";
5538 while ($y<$y1) {
5539 $y+=100;
5540 }
5541 while ($y>$y2) {
5542 $y-=100;
5543 }
5544 }
5545 $y;
5546}
5547
5548# &Date_NthWeekOfYear($y,$n);
5549# Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
5550# year.
5551# &Date_NthWeekOfYear($y,$n,$dow,$flag);
5552# Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag
5553# is nil, the first DoW of the year may actually be in the previous
5554# year (since the 1st week may include days from the previous year).
5555# If flag is non-nil, the 1st DoW of the year refers to the 1st one
5556# actually in the year
5557sub Date_NthWeekOfYear {
5558 print "DEBUG: Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
5559 my($y,$n,$dow,$flag)=@_;
5560 my($m,$d,$err,$tmp,$date,%dow)=();
5561 $y=$Curr{"Y"} if (! defined $y or ! $y);
5562 $n=1 if (! defined $n or $n eq "");
5563 return () if ($n<0 || $n>53);
5564 if (defined $dow) {
5565 $dow=lc($dow);
5566 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
5567 $dow=$dow{$dow} if (exists $dow{$dow});
5568 return () if ($dow<1 || $dow>7);
5569 $flag="" if (! defined $flag);
5570 } else {
5571 $dow="";
5572 $flag="";
5573 }
5574
5575 $y=&Date_FixYear($y) if (length($y)<4);
5576 if ($Cnf{"Jan1Week1"}) {
5577 $date=&Date_Join($y,1,1,0,0,0);
5578 } else {
5579 $date=&Date_Join($y,1,4,0,0,0);
5580 }
5581 $date=&Date_GetPrev($date,$Cnf{"FirstDay"},1);
5582 $date=&Date_GetNext($date,$dow,1) if ($dow ne "");
5583
5584 if ($flag) {
5585 ($tmp)=&Date_Split($date, 1);
5586 $n++ if ($tmp != $y);
5587 }
5588
5589 if ($n>1) {
5590 $date=&DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0);
5591 } elsif ($n==0) {
5592 $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0);
5593 }
5594 ($y,$m,$d)=&Date_Split($date, 1);
5595 ($y,$m,$d);
5596}
5597
5598########################################################################
5599# LANGUAGE INITIALIZATION
5600########################################################################
5601
5602# 8-bit international characters can be gotten by "\xXX". I don't know
5603# how to get 16-bit characters. I've got to read up on perllocale.
5604sub Char_8Bit {
5605 my($hash)=@_;
5606
5607 # grave `
5608 # A` 00c0 a` 00e0
5609 # E` 00c8 e` 00e8
5610 # I` 00cc i` 00ec
5611 # O` 00d2 o` 00f2
5612 # U` 00d9 u` 00f9
5613 # W` 1e80 w` 1e81
5614 # Y` 1ef2 y` 1ef3
5615
5616 $$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE
5617 $$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE
5618 $$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE
5619 $$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE
5620 $$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE
5621 $$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE
5622 $$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE
5623 $$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE
5624 $$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE
5625 $$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE
5626
5627 # acute '
5628 # A' 00c1 a' 00e1
5629 # C' 0106 c' 0107
5630 # E' 00c9 e' 00e9
5631 # I' 00cd i' 00ed
5632 # L' 0139 l' 013a
5633 # N' 0143 n' 0144
5634 # O' 00d3 o' 00f3
5635 # R' 0154 r' 0155
5636 # S' 015a s' 015b
5637 # U' 00da u' 00fa
5638 # W' 1e82 w' 1e83
5639 # Y' 00dd y' 00fd
5640 # Z' 0179 z' 017a
5641
5642 $$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE
5643 $$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE
5644 $$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE
5645 $$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE
5646 $$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE
5647 $$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE
5648 $$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE
5649 $$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE
5650 $$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE
5651 $$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE
5652 $$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE
5653 $$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE
5654
5655 # double acute " "
5656 # O" 0150 o" 0151
5657 # U" 0170 u" 0171
5658
5659 # circumflex ^
5660 # A^ 00c2 a^ 00e2
5661 # C^ 0108 c^ 0109
5662 # E^ 00ca e^ 00ea
5663 # G^ 011c g^ 011d
5664 # H^ 0124 h^ 0125
5665 # I^ 00ce i^ 00ee
5666 # J^ 0134 j^ 0135
5667 # O^ 00d4 o^ 00f4
5668 # S^ 015c s^ 015d
5669 # U^ 00db u^ 00fb
5670 # W^ 0174 w^ 0175
5671 # Y^ 0176 y^ 0177
5672
5673 $$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
5674 $$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
5675 $$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
5676 $$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
5677 $$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
5678 $$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX
5679 $$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX
5680 $$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX
5681 $$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX
5682 $$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX
5683
5684 # tilde ~
5685 # A~ 00c3 a~ 00e3
5686 # I~ 0128 i~ 0129
5687 # N~ 00d1 n~ 00f1
5688 # O~ 00d5 o~ 00f5
5689 # U~ 0168 u~ 0169
5690
5691 $$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE
5692 $$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE
5693 $$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE
5694 $$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE
5695 $$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE
5696 $$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE
5697
5698 # macron -
5699 # A- 0100 a- 0101
5700 # E- 0112 e- 0113
5701 # I- 012a i- 012b
5702 # O- 014c o- 014d
5703 # U- 016a u- 016b
5704
5705 # breve ( [half circle up]
5706 # A( 0102 a( 0103
5707 # G( 011e g( 011f
5708 # U( 016c u( 016d
5709
5710 # dot .
5711 # C. 010a c. 010b
5712 # E. 0116 e. 0117
5713 # G. 0120 g. 0121
5714 # I. 0130
5715 # Z. 017b z. 017c
5716
5717 # diaeresis : [side by side dots]
5718 # A: 00c4 a: 00e4
5719 # E: 00cb e: 00eb
5720 # I: 00cf i: 00ef
5721 # O: 00d6 o: 00f6
5722 # U: 00dc u: 00fc
5723 # W: 1e84 w: 1e85
5724 # Y: 0178 y: 00ff
5725
5726 $$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS
5727 $$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS
5728 $$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS
5729 $$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS
5730 $$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS
5731 $$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS
5732 $$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS
5733 $$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS
5734 $$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS
5735 $$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS
5736 $$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS
5737
5738 # ring o
5739 # U0 016e u0 016f
5740
5741 # cedilla , [squiggle down and left below the letter]
5742 # ,C 00c7 ,c 00e7
5743 # ,G 0122 ,g 0123
5744 # ,K 0136 ,k 0137
5745 # ,L 013b ,l 013c
5746 # ,N 0145 ,n 0146
5747 # ,R 0156 ,r 0157
5748 # ,S 015e ,s 015f
5749 # ,T 0162 ,t 0163
5750
5751 $$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA
5752 $$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA
5753
5754 # ogonek ; [squiggle down and right below the letter]
5755 # A; 0104 a; 0105
5756 # E; 0118 e; 0119
5757 # I; 012e i; 012f
5758 # U; 0172 u; 0173
5759
5760 # caron < [little v on top]
5761 # A< 01cd a< 01ce
5762 # C< 010c c< 010d
5763 # D< 010e d< 010f
5764 # E< 011a e< 011b
5765 # L< 013d l< 013e
5766 # N< 0147 n< 0148
5767 # R< 0158 r< 0159
5768 # S< 0160 s< 0161
5769 # T< 0164 t< 0165
5770 # Z< 017d z< 017e
5771
5772
5773 # Other characters
5774
5775 # First character is below, 2nd character is above
5776 $$hash{"||"} = "\xa6"; # BROKEN BAR
5777 $$hash{" :"} = "\xa8"; # DIAERESIS
5778 $$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR
5779 #$$hash{" -"}= "\xaf"; # MACRON (narrow bar)
5780 $$hash{" -"} = "\xad"; # HYPHEN (wide bar)
5781 $$hash{" o"} = "\xb0"; # DEGREE SIGN
5782 $$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN
5783 $$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE
5784 $$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO
5785 $$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE
5786 $$hash{" '"} = "\xb4"; # ACUTE ACCENT
5787 $$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR
5788 $$hash{" ."} = "\xb7"; # MIDDLE DOT
5789 $$hash{", "} = "\xb8"; # CEDILLA
5790 $$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE
5791 $$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE
5792 $$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH
5793
5794 # upside down characters
5795
5796 $$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
5797 $$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
5798
5799 # overlay characters
5800
5801 $$hash{"X o"} = "\xa4"; # CURRENCY SIGN
5802 $$hash{"Y ="} = "\xa5"; # YEN SIGN
5803 $$hash{"S o"} = "\xa7"; # SECTION SIGN
5804 $$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright
5805 $$hash{"O R"} = "\xae"; # REGISTERED SIGN
5806 $$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH
5807 $$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE
5808 $$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE
5809
5810 # special names
5811
5812 $$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER
5813 $$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF
5814 $$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS
5815 $$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK
5816 $$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK
5817 $$hash{"cent"}= "\xa2"; # CENT SIGN
5818 $$hash{"lb"} = "\xa3"; # POUND SIGN
5819 $$hash{"mu"} = "\xb5"; # MICRO SIGN
5820 $$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S
5821 $$hash{"para"}= "\xb6"; # PILCROW SIGN
5822 $$hash{"-|"} = "\xac"; # NOT SIGN
5823 $$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE
5824 $$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE
5825 $$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN
5826 $$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN
5827 $$hash{"/"} = "\xf7"; # DIVISION SIGN
5828 $$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN
5829}
5830
5831# $hashref = &Date_Init_LANGUAGE;
5832# This returns a hash containing all of the initialization for a
5833# specific language. The hash elements are:
5834#
5835# @ month_name full month names January February ...
5836# @ month_abb month abbreviations Jan Feb ...
5837# @ day_name day names Monday Tuesday ...
5838# @ day_abb day abbreviations Mon Tue ...
5839# @ day_char day character abbrevs M T ...
5840# @ am AM notations
5841# @ pm PM notations
5842#
5843# @ num_suff number with suffix 1st 2nd ...
5844# @ num_word numbers spelled out first second ...
5845#
5846# $ now words which mean now now ...
5847# $ today words which mean today today ...
5848# $ last words which mean last last final ...
5849# $ each words which mean each each every ...
5850# $ of of (as in a member of) in of ...
5851# ex. 4th day OF June
5852# $ at at 4:00 at
5853# $ on on Sunday on
5854# $ future in the future in
5855# $ past in the past ago
5856# $ next next item next
5857# $ prev previous item last previous
5858# $ later 2 hours later
5859#
5860# % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 }
5861# % times a hash of times { noon->12:00:00 ... }
5862#
5863# $ years words for year y yr year ...
5864# $ months words for month
5865# $ weeks words for week
5866# $ days words for day
5867# $ hours words for hour
5868# $ minutes words for minute
5869# $ seconds words for second
5870# % replace
5871# The replace element is quite important, but a bit tricky. In
5872# English (and probably other languages), one of the abbreviations
5873# for the word month that would be nice is "m". The problem is that
5874# "m" matches the "m" in "minute" which causes the string to be
5875# improperly matched in some cases. Hence, the list of abbreviations
5876# for month is given as:
5877# "mon month months"
5878# In order to allow you to enter "m", replacements can be done.
5879# $replace is a list of pairs of words which are matched and replaced
5880# AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that
5881# the entire word "m" will be replaced with "month". This allows the
5882# desired abbreviation to be used. Make sure that replace contains
5883# an even number of words (i.e. all must be pairs). Any time a
5884# desired abbreviation matches the start of any other, it has to go
5885# here.
5886#
5887# $ exact exact mode exactly
5888# $ approx approximate mode approximately
5889# $ business business mode business
5890#
5891# r sephm hour/minute separator (?::)
5892# r sepms minute/second separator (?::)
5893# r sepss second/fraction separator (?:[.:])
5894#
5895# Elements marked with an asterix (@) are returned as a set of lists.
5896# Each list contains the strings for each element. The first set is used
5897# when the 7-bit ASCII (US) character set is wanted. The 2nd set is used
5898# when an international character set is available. Both of the 1st two
5899# sets should be complete (but the 2nd list can be left empty to force the
5900# first set to be used always). The 3rd set and later can be partial sets
5901# if desired.
5902#
5903# Elements marked with a dollar ($) are returned as a simple list of words.
5904#
5905# Elements marked with a percent (%) are returned as a hash list.
5906#
5907# Elements marked with (r) are regular expression elements which must not
5908# create a back reference.
5909#
5910# ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in
5911# every language.
5912
5913sub Date_Init_English {
5914 print "DEBUG: Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
5915 my($d)=@_;
5916
5917 $$d{"month_name"}=
5918 [["January","February","March","April","May","June",
5919 "July","August","September","October","November","December"]];
5920
5921 $$d{"month_abb"}=
5922 [["Jan","Feb","Mar","Apr","May","Jun",
5923 "Jul","Aug","Sep","Oct","Nov","Dec"],
5924 [],
5925 ["","","","","","","","","Sept"]];
5926
5927 $$d{"day_name"}=
5928 [["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
5929 $$d{"day_abb"}=
5930 [["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
5931 ["", "Tues","", "Thur","", "", ""]];
5932 $$d{"day_char"}=
5933 [["M","T","W","Th","F","Sa","S"]];
5934
5935 $$d{"num_suff"}=
5936 [["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th",
5937 "11th","12th","13th","14th","15th","16th","17th","18th","19th","20th",
5938 "21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th",
5939 "31st"]];
5940 $$d{"num_word"}=
5941 [["first","second","third","fourth","fifth","sixth","seventh","eighth",
5942 "ninth","tenth","eleventh","twelfth","thirteenth","fourteenth",
5943 "fifteenth","sixteenth","seventeenth","eighteenth","nineteenth",
5944 "twentieth","twenty-first","twenty-second","twenty-third",
5945 "twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh",
5946 "twenty-eighth","twenty-ninth","thirtieth","thirty-first"]];
5947
5948 $$d{"now"} =["now"];
5949 $$d{"today"} =["today"];
5950 $$d{"last"} =["last","final"];
5951 $$d{"each"} =["each","every"];
5952 $$d{"of"} =["in","of"];
5953 $$d{"at"} =["at"];
5954 $$d{"on"} =["on"];
5955 $$d{"future"} =["in"];
5956 $$d{"past"} =["ago"];
5957 $$d{"next"} =["next"];
5958 $$d{"prev"} =["previous","last"];
5959 $$d{"later"} =["later"];
5960
5961 $$d{"exact"} =["exactly"];
5962 $$d{"approx"} =["approximately"];
5963 $$d{"business"}=["business"];
5964
5965 $$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"];
5966 $$d{"times"} =["noon","12:00:00","midnight","00:00:00"];
5967
5968 $$d{"years"} =["y","yr","year","yrs","years"];
5969 $$d{"months"} =["mon","month","months"];
5970 $$d{"weeks"} =["w","wk","wks","week","weeks"];
5971 $$d{"days"} =["d","day","days"];
5972 $$d{"hours"} =["h","hr","hrs","hour","hours"];
5973 $$d{"minutes"} =["mn","min","minute","minutes"];
5974 $$d{"seconds"} =["s","sec","second","seconds"];
5975 $$d{"replace"} =["m","month"];
5976
5977 $$d{"sephm"} =':';
5978 $$d{"sepms"} =':';
5979 $$d{"sepss"} ='[.:]';
5980
5981 $$d{"am"} = ["AM","A.M."];
5982 $$d{"pm"} = ["PM","P.M."];
5983}
5984
5985sub Date_Init_Italian {
5986 print "DEBUG: Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
5987 my($d)=@_;
5988 my(%h)=();
5989 &Char_8Bit(\%h);
5990 my($i)=$h{"i`"};
5991
5992 $$d{"month_name"}=
5993 [[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
5994 Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
5995
5996 $$d{"month_abb"}=
5997 [[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
5998
5999 $$d{"day_name"}=
6000 [[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
6001 [qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
6002 $$d{"day_abb"}=
6003 [[qw(Lun Mar Mer Gio Ven Sab Dom)]];
6004 $$d{"day_char"}=
6005 [[qw(L Ma Me G V S D)]];
6006
6007 $$d{"num_suff"}=
6008 [[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo
6009 16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo
6010 29mo 3mo 31mo)]];
6011 $$d{"num_word"}=
6012 [[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo
6013 undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo
6014 sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo
6015 ventunesimo ventiduesimo ventitreesimo ventiquattresimo
6016 venticinquesimo ventiseiesimo ventisettesimo ventottesimo
6017 ventinovesimo trentesimo trentunesimo)]];
6018
6019 $$d{"now"} =[qw(adesso)];
6020 $$d{"today"} =[qw(oggi)];
6021 $$d{"last"} =[qw(ultimo)];
6022 $$d{"each"} =[qw(ogni)];
6023 $$d{"of"} =[qw(della del)];
6024 $$d{"at"} =[qw(alle)];
6025 $$d{"on"} =[qw(di)];
6026 $$d{"future"} =[qw(fra)];
6027 $$d{"past"} =[qw(fa)];
6028 $$d{"next"} =[qw(prossimo)];
6029 $$d{"prev"} =[qw(ultimo)];
6030 $$d{"later"} =[qw(dopo)];
6031
6032 $$d{"exact"} =[qw(esattamente)];
6033 $$d{"approx"} =[qw(circa)];
6034 $$d{"business"}=[qw(lavorativi lavorativo)];
6035
6036 $$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)];
6037 $$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)];
6038
6039 $$d{"years"} =[qw(anni anno a)];
6040 $$d{"months"} =[qw(mesi mese mes)];
6041 $$d{"weeks"} =[qw(settimane settimana sett)];
6042 $$d{"days"} =[qw(giorni giorno g)];
6043 $$d{"hours"} =[qw(ore ora h)];
6044 $$d{"minutes"} =[qw(minuti minuto min)];
6045 $$d{"seconds"} =[qw(secondi secondo sec)];
6046 $$d{"replace"} =[qw(s sec m mes)];
6047
6048 $$d{"sephm"} =':';
6049 $$d{"sepms"} =':';
6050 $$d{"sepss"} ='[.:]';
6051
6052 $$d{"am"} = [qw(AM)];
6053 $$d{"pm"} = [qw(PM)];
6054}
6055
6056sub Date_Init_French {
6057 print "DEBUG: Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
6058 my($d)=@_;
6059 my(%h)=();
6060 &Char_8Bit(\%h);
6061 my($e)=$h{"e'"};
6062 my($u)=$h{"u^"};
6063 my($a)=$h{"a'"};
6064
6065 $$d{"month_name"}=
6066 [["janvier","fevrier","mars","avril","mai","juin",
6067 "juillet","aout","septembre","octobre","novembre","decembre"],
6068 ["janvier","f${e}vrier","mars","avril","mai","juin",
6069 "juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]];
6070 $$d{"month_abb"}=
6071 [["jan","fev","mar","avr","mai","juin",
6072 "juil","aout","sept","oct","nov","dec"],
6073 ["jan","f${e}v","mar","avr","mai","juin",
6074 "juil","ao${u}t","sept","oct","nov","d${e}c"]];
6075
6076 $$d{"day_name"}=
6077 [["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
6078 $$d{"day_abb"}=
6079 [["lun","mar","mer","jeu","ven","sam","dim"]];
6080 $$d{"day_char"}=
6081 [["l","ma","me","j","v","s","d"]];
6082
6083 $$d{"num_suff"}=
6084 [["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e",
6085 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
6086 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
6087 "31e"]];
6088 $$d{"num_word"}=
6089 [["premier","deux","trois","quatre","cinq","six","sept","huit","neuf",
6090 "dix","onze","douze","treize","quatorze","quinze","seize","dix-sept",
6091 "dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois",
6092 "vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit",
6093 "vingt-neuf","trente","trente et un"],
6094 ["1re"]];
6095
6096 $$d{"now"} =["maintenant"];
6097 $$d{"today"} =["aujourd'hui"];
6098 $$d{"last"} =["dernier"];
6099 $$d{"each"} =["chaque","tous les","toutes les"];
6100 $$d{"of"} =["en","de"];
6101 $$d{"at"} =["a","${a}0"];
6102 $$d{"on"} =["sur"];
6103 $$d{"future"} =["en"];
6104 $$d{"past"} =["il y a"];
6105 $$d{"next"} =["suivant"];
6106 $$d{"prev"} =["precedent","pr${e}c${e}dent"];
6107 $$d{"later"} =["plus tard"];
6108
6109 $$d{"exact"} =["exactement"];
6110 $$d{"approx"} =["approximativement"];
6111 $$d{"business"}=["professionel"];
6112
6113 $$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"];
6114 $$d{"times"} =["midi","12:00:00","minuit","00:00:00"];
6115
6116 $$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"];
6117 $$d{"months"} =["mois"];
6118 $$d{"weeks"} =["sem","semaine"];
6119 $$d{"days"} =["j","jour","jours"];
6120 $$d{"hours"} =["h","heure","heures"];
6121 $$d{"minutes"} =["mn","min","minute","minutes"];
6122 $$d{"seconds"} =["s","sec","seconde","secondes"];
6123 $$d{"replace"} =["m","mois"];
6124
6125 $$d{"sephm"} ='[h:]';
6126 $$d{"sepms"} =':';
6127 $$d{"sepss"} ='[.:,]';
6128
6129 $$d{"am"} = ["du matin"];
6130 $$d{"pm"} = ["du soir"];
6131}
6132
6133sub Date_Init_Romanian {
6134 print "DEBUG: Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
6135 my($d)=@_;
6136 my(%h)=();
6137 &Char_8Bit(\%h);
6138 my($p)=$h{"p"};
6139 my($i)=$h{"i^"};
6140 my($a)=$h{"a~"};
6141 my($o)=$h{"-o"};
6142
6143 $$d{"month_name"}=
6144 [["ianuarie","februarie","martie","aprilie","mai","iunie",
6145 "iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
6146 $$d{"month_abb"}=
6147 [["ian","febr","mart","apr","mai","iun",
6148 "iul","aug","sept","oct","nov","dec"],
6149 ["","feb"]];
6150
6151 $$d{"day_name"}=
6152 [["luni","marti","miercuri","joi","vineri","simbata","duminica"],
6153 ["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
6154 "duminic${a}"]];
6155 $$d{"day_abb"}=
6156 [["lun","mar","mie","joi","vin","sim","dum"],
6157 ["lun","mar","mie","joi","vin","s${i}m","dum"]];
6158 $$d{"day_char"}=
6159 [["L","Ma","Mi","J","V","S","D"]];
6160
6161 $$d{"num_suff"}=
6162 [["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a",
6163 "a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a",
6164 "a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a",
6165 "a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a",
6166 "a 30-a","a 31-a"]];
6167
6168 $$d{"num_word"}=
6169 [["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea",
6170 "a opta","a noua","a zecea","a unsprezecea","a doisprezecea",
6171 "a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea",
6172 "a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea",
6173 "a douazecisiuna","a douazecisidoua","a douazecisitreia",
6174 "a douazecisipatra","a douazecisicincea","a douazecisisasea",
6175 "a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea",
6176 "a treizecisiuna"],
6177 ["prima","a doua","a treia","a patra","a cincea","a ${o}asea",
6178 "a ${o}aptea","a opta","a noua","a zecea","a unsprezecea",
6179 "a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea",
6180 "a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea",
6181 "a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna",
6182 "a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia",
6183 "a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea",
6184 "a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea",
6185 "a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea",
6186 "a treizeci${o}iuna"],
6187 ["intii", "doi", "trei", "patru", "cinci", "sase", "sapte",
6188 "opt","noua","zece","unsprezece","doisprezece",
6189 "treisprezece","patrusprezece","cincisprezece","saiprezece",
6190 "saptesprezece","optsprezece","nouasprezece","douazeci",
6191 "douazecisiunu","douazecisidoi","douazecisitrei",
6192 "douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte",
6193 "douazecisiopt","douazecisinoua","treizeci","treizecisiunu"],
6194 ["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte",
6195 "opt","nou${a}","zece","unsprezece","doisprezece",
6196 "treisprezece","patrusprezece","cincisprezece","${o}aiprezece",
6197 "${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci",
6198 "dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei",
6199 "dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase",
6200 "dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt",
6201 "dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]];
6202
6203 $$d{"now"} =["acum"];
6204 $$d{"today"} =["azi","astazi","ast${a}zi"];
6205 $$d{"last"} =["ultima"];
6206 $$d{"each"} =["fiecare"];
6207 $$d{"of"} =["din","in","n"];
6208 $$d{"at"} =["la"];
6209 $$d{"on"} =["on"];
6210 $$d{"future"} =["in","${i}n"];
6211 $$d{"past"} =["in urma", "${i}n urm${a}"];
6212 $$d{"next"} =["urmatoarea","urm${a}toarea"];
6213 $$d{"prev"} =["precedenta","ultima"];
6214 $$d{"later"} =["mai tirziu", "mai t${i}rziu"];
6215
6216 $$d{"exact"} =["exact"];
6217 $$d{"approx"} =["aproximativ"];
6218 $$d{"business"}=["de lucru","lucratoare","lucr${a}toare"];
6219
6220 $$d{"offset"} =["ieri","-0:0:0:1:0:0:0",
6221 "alaltaieri", "-0:0:0:2:0:0:0",
6222 "alalt${a}ieri","-0:0:0:2:0:0:0",
6223 "miine","+0:0:0:1:0:0:0",
6224 "m${i}ine","+0:0:0:1:0:0:0",
6225 "poimiine","+0:0:0:2:0:0:0",
6226 "poim${i}ine","+0:0:0:2:0:0:0"];
6227 $$d{"times"} =["amiaza","12:00:00",
6228 "amiaz${a}","12:00:00",
6229 "miezul noptii","00:00:00",
6230 "miezul nop${p}ii","00:00:00"];
6231
6232 $$d{"years"} =["ani","an","a"];
6233 $$d{"months"} =["luni","luna","lun${a}","l"];
6234 $$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina",
6235 "s${a}pt${a}m${i}na","sapt","s${a}pt"];
6236 $$d{"days"} =["zile","zi","z"];
6237 $$d{"hours"} =["ore", "ora", "or${a}", "h"];
6238 $$d{"minutes"} =["minute","min","m"];
6239 $$d{"seconds"} =["secunde","sec",];
6240 $$d{"replace"} =["s","secunde"];
6241
6242 $$d{"sephm"} =':';
6243 $$d{"sepms"} =':';
6244 $$d{"sepss"} ='[.:,]';
6245
6246 $$d{"am"} = ["AM","A.M."];
6247 $$d{"pm"} = ["PM","P.M."];
6248}
6249
6250sub Date_Init_Swedish {
6251 print "DEBUG: Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
6252 my($d)=@_;
6253 my(%h)=();
6254 &Char_8Bit(\%h);
6255 my($ao)=$h{"ao"};
6256 my($o) =$h{"o:"};
6257 my($a) =$h{"a:"};
6258
6259 $$d{"month_name"}=
6260 [["Januari","Februari","Mars","April","Maj","Juni",
6261 "Juli","Augusti","September","Oktober","November","December"]];
6262 $$d{"month_abb"}=
6263 [["Jan","Feb","Mar","Apr","Maj","Jun",
6264 "Jul","Aug","Sep","Okt","Nov","Dec"]];
6265
6266 $$d{"day_name"}=
6267 [["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
6268 ["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
6269 "S${o}ndag"]];
6270 $$d{"day_abb"}=
6271 [["Man","Tis","Ons","Tor","Fre","Lor","Son"],
6272 ["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
6273 $$d{"day_char"}=
6274 [["M","Ti","O","To","F","L","S"]];
6275
6276 $$d{"num_suff"}=
6277 [["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
6278 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
6279 "21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
6280 "31:a"]];
6281 $$d{"num_word"}=
6282 [["forsta","andra","tredje","fjarde","femte","sjatte","sjunde",
6283 "attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6284 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6285 "tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte",
6286 "tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde",
6287 "trettionde","trettioforsta"],
6288 ["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde",
6289 "${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6290 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6291 "tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte",
6292 "tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde",
6293 "trettionde","trettiof${o}rsta"]];
6294
6295 $$d{"now"} =["nu"];
6296 $$d{"today"} =["idag"];
6297 $$d{"last"} =["forra","f${o}rra","senaste"];
6298 $$d{"each"} =["varje"];
6299 $$d{"of"} =["om"];
6300 $$d{"at"} =["kl","kl.","klockan"];
6301 $$d{"on"} =["pa","p${ao}"];
6302 $$d{"future"} =["om"];
6303 $$d{"past"} =["sedan"];
6304 $$d{"next"} =["nasta","n${a}sta"];
6305 $$d{"prev"} =["forra","f${o}rra"];
6306 $$d{"later"} =["senare"];
6307
6308 $$d{"exact"} =["exakt"];
6309 $$d{"approx"} =["ungefar","ungef${a}r"];
6310 $$d{"business"}=["arbetsdag","arbetsdagar"];
6311
6312 $$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
6313 "imorgon","+0:0:0:1:0:0:0"];
6314 $$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00",
6315 "midnatt","00:00:00"];
6316
6317 $$d{"years"} =["ar","${ao}r"];
6318 $$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"];
6319 $$d{"weeks"} =["v","vecka","veckor"];
6320 $$d{"days"} =["d","dag","dagar"];
6321 $$d{"hours"} =["t","tim","timme","timmar"];
6322 $$d{"minutes"} =["min","minut","minuter"];
6323 $$d{"seconds"} =["s","sek","sekund","sekunder"];
6324 $$d{"replace"} =["m","minut"];
6325
6326 $$d{"sephm"} ='[.:]';
6327 $$d{"sepms"} =':';
6328 $$d{"sepss"} ='[.:]';
6329
6330 $$d{"am"} = ["FM"];
6331 $$d{"pm"} = ["EM"];
6332}
6333
6334sub Date_Init_German {
6335 print "DEBUG: Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
6336 my($d)=@_;
6337 my(%h)=();
6338 &Char_8Bit(\%h);
6339 my($a)=$h{"a:"};
6340 my($u)=$h{"u:"};
6341 my($o)=$h{"o:"};
6342 my($b)=$h{"beta"};
6343
6344 $$d{"month_name"}=
6345 [["Januar","Februar","Maerz","April","Mai","Juni",
6346 "Juli","August","September","Oktober","November","Dezember"],
6347 ["J${a}nner","Februar","M${a}rz","April","Mai","Juni",
6348 "Juli","August","September","Oktober","November","Dezember"]];
6349 $$d{"month_abb"}=
6350 [["Jan","Feb","Mar","Apr","Mai","Jun",
6351 "Jul","Aug","Sep","Okt","Nov","Dez"],
6352 ["J${a}n","Feb","M${a}r","Apr","Mai","Jun",
6353 "Jul","Aug","Sep","Okt","Nov","Dez"]];
6354
6355 $$d{"day_name"}=
6356 [["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
6357 "Sonntag"]];
6358 $$d{"day_abb"}=
6359 [["Mo","Di","Mi","Do","Fr","Sa","So"]];
6360 $$d{"day_char"}=
6361 [["M","Di","Mi","Do","F","Sa","So"]];
6362
6363 $$d{"num_suff"}=
6364 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6365 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6366 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6367 "31."]];
6368 $$d{"num_word"}=
6369 [
6370 ["erste","zweite","dritte","vierte","funfte","sechste","siebente",
6371 "achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte",
6372 "funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte",
6373 "zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste",
6374 "vierundzwanzigste","funfundzwanzigste","sechundzwanzigste",
6375 "siebundzwanzigste","achtundzwanzigste","neunundzwanzigste",
6376 "dreibigste","einunddreibigste"],
6377 ["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente",
6378 "achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte",
6379 "vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte",
6380 "neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste",
6381 "dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste",
6382 "sechundzwanzigste","siebundzwanzigste","achtundzwanzigste",
6383 "neunundzwanzigste","drei${b}igste","einunddrei${b}igste"],
6384 ["erster"]];
6385
6386 $$d{"now"} =["jetzt"];
6387 $$d{"today"} =["heute"];
6388 $$d{"last"} =["letzte","letzten"];
6389 $$d{"each"} =["jeden"];
6390 $$d{"of"} =["der","im","des"];
6391 $$d{"at"} =["um"];
6392 $$d{"on"} =["am"];
6393 $$d{"future"} =["in"];
6394 $$d{"past"} =["vor"];
6395 $$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
6396 $$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
6397 $$d{"later"} =["spater","sp${a}ter"];
6398
6399 $$d{"exact"} =["genau"];
6400 $$d{"approx"} =["ungefahr","ungef${a}hr"];
6401 $$d{"business"}=["Arbeitstag"];
6402
6403 $$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"];
6404 $$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"];
6405
6406 $$d{"years"} =["j","Jahr","Jahre","Jahren"];
6407 $$d{"months"} =["Monat","Monate","Monaten"];
6408 $$d{"weeks"} =["w","Woche","Wochen"];
6409 $$d{"days"} =["t","Tag","Tage","Tagen"];
6410 $$d{"hours"} =["h","std","Stunde","Stunden"];
6411 $$d{"minutes"} =["min","Minute","Minuten"];
6412 $$d{"seconds"} =["s","sek","Sekunde","Sekunden"];
6413 $$d{"replace"} =["m","Monat"];
6414
6415 $$d{"sephm"} =':';
6416 $$d{"sepms"} ='[: ]';
6417 $$d{"sepss"} ='[.:]';
6418
6419 $$d{"am"} = ["FM"];
6420 $$d{"pm"} = ["EM"];
6421}
6422
6423sub Date_Init_Dutch {
6424 print "DEBUG: Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
6425 my($d)=@_;
6426 my(%h)=();
6427 &Char_8Bit(\%h);
6428
6429 $$d{"month_name"}=
6430 [["januari","februari","maart","april","mei","juni","juli","augustus",
6431 "september","october","november","december"],
6432 ["","","","","","","","","","oktober"]];
6433
6434 $$d{"month_abb"}=
6435 [["jan","feb","maa","apr","mei","jun","jul",
6436 "aug","sep","oct","nov","dec"],
6437 ["","","mrt","","","","","","","okt"]];
6438 $$d{"day_name"}=
6439 [["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
6440 "zondag"]];
6441 $$d{"day_abb"}=
6442 [["ma","di","wo","do","vr","zat","zon"],
6443 ["","","","","","za","zo"]];
6444 $$d{"day_char"}=
6445 [["M","D","W","D","V","Za","Zo"]];
6446
6447 $$d{"num_suff"}=
6448 [["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de",
6449 "11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste",
6450 "21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste",
6451 "30ste","31ste"]];
6452 $$d{"num_word"}=
6453 [["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
6454 "negende","tiende","elfde","twaalfde",
6455 map {"${_}tiende";} qw (der veer vijf zes zeven acht negen),
6456 "twintigste",
6457 map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht
6458 negen),
6459 "dertigste","eenendertigste"],
6460 ["","","","","","","","","","","","","","","","","","","","",
6461 map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht
6462 negen),
6463 "dertigste","een-en-dertigste"],
6464 ["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
6465 "elf","twaalf",
6466 map {"${_}tien"} qw (der veer vijf zes zeven acht negen),
6467 "twintig",
6468 map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen),
6469 "dertig","eenendertig"],
6470 ["","","","","","","","","","","","","","","","","","","","",
6471 map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht
6472 negen),
6473 "dertig","een-en-dertig"]];
6474
6475 $$d{"now"} =["nu","nou"];
6476 $$d{"today"} =["vandaag"];
6477 $$d{"last"} =["laatste"];
6478 $$d{"each"} =["elke","elk"];
6479 $$d{"of"} =["in","van"];
6480 $$d{"at"} =["om"];
6481 $$d{"on"} =["op"];
6482 $$d{"future"} =["over"];
6483 $$d{"past"} =["geleden","vroeger","eerder"];
6484 $$d{"next"} =["volgende","volgend"];
6485 $$d{"prev"} =["voorgaande","voorgaand"];
6486 $$d{"later"} =["later"];
6487
6488 $$d{"exact"} =["exact","precies","nauwkeurig"];
6489 $$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.'];
6490 $$d{"business"}=["werk","zakelijke","zakelijk"];
6491
6492 $$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0",
6493 "gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"];
6494 $$d{"times"} =["noen","12:00:00","middernacht","00:00:00"];
6495
6496 $$d{"years"} =["jaar","jaren","ja","j"];
6497 $$d{"months"} =["maand","maanden","mnd"];
6498 $$d{"weeks"} =["week","weken","w"];
6499 $$d{"days"} =["dag","dagen","d"];
6500 $$d{"hours"} =["uur","uren","u","h"];
6501 $$d{"minutes"} =["minuut","minuten","min"];
6502 $$d{"seconds"} =["seconde","seconden","sec","s"];
6503 $$d{"replace"} =["m","minuten"];
6504
6505 $$d{"sephm"} ='[:.uh]';
6506 $$d{"sepms"} ='[:.m]';
6507 $$d{"sepss"} ='[.:]';
6508
6509 $$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends",
6510 "ochtend","'s_nachts","nacht"];
6511 $$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag",
6512 "'s_avonds","avond"];
6513}
6514
6515sub Date_Init_Polish {
6516 print "DEBUG: Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
6517 my($d)=@_;
6518
6519 $$d{"month_name"}=
6520 [["stycznia","luty","marca","kwietnia","maja","czerwca",
6521 "lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"],
6522 ["stycznia","luty","marca","kwietnia","maja","czerwca","lipca",
6523 "sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]];
6524 $$d{"month_abb"}=
6525 [["sty.","lut.","mar.","kwi.","maj","cze.",
6526 "lip.","sie.","wrz.","paz.","lis.","gru."],
6527 ["sty.","lut.","mar.","kwi.","maj","cze.",
6528 "lip.","sie.","wrz.","pa\x9f.","lis.","gru."]];
6529
6530 $$d{"day_name"}=
6531 [["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
6532 "niedziela"],
6533 ["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
6534 "sobota","niedziela"]];
6535 $$d{"day_abb"}=
6536 [["po.","wt.","sr.","cz.","pi.","so.","ni."],
6537 ["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
6538 $$d{"day_char"}=
6539 [["p","w","e","c","p","s","n"],
6540 ["p","w","\x9c.","c","p","s","n"]];
6541
6542 $$d{"num_suff"}=
6543 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6544 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6545 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6546 "31."]];
6547 $$d{"num_word"}=
6548 [["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
6549 "siodmego","osmego","dziewiatego","dziesiatego",
6550 "jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
6551 "szestnastego","siedemnastego","osiemnastego","dziewietnastego",
6552 "dwudziestego",
6553 "dwudziestego pierwszego","dwudziestego drugiego",
6554 "dwudziestego trzeczego","dwudziestego czwartego",
6555 "dwudziestego piatego","dwudziestego szostego",
6556 "dwudziestego siodmego","dwudziestego osmego",
6557 "dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"],
6558 ["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego",
6559 "sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego",
6560 "dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego",
6561 "czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego",
6562 "osiemnastego","dziewietnastego","dwudziestego",
6563 "dwudziestego pierwszego","dwudziestego drugiego",
6564 "dwudziestego trzeczego","dwudziestego czwartego",
6565 "dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego",
6566 "dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego",
6567 "dwudziestego dziewi\x81\xb9tego","trzydziestego",
6568 "trzydziestego pierwszego"]];
6569
6570 $$d{"now"} =["teraz"];
6571 $$d{"today"} =["dzisaj"];
6572 $$d{"last"} =["ostatni","ostatna"];
6573 $$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"];
6574 $$d{"of"} =["w","z"];
6575 $$d{"at"} =["o","u"];
6576 $$d{"on"} =["na"];
6577 $$d{"future"} =["za"];
6578 $$d{"past"} =["temu"];
6579 $$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
6580 "przyszly","przysz\x81\xb3y","przyszlym",
6581 "przysz\x81\xb3ym"];
6582 $$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
6583 $$d{"later"} =["later"];
6584
6585 $$d{"exact"} =["doklandnie","dok\x81\xb3andnie"];
6586 $$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej",
6587 "mniej wi\x81\xeacej","okolo","oko\x81\xb3o"];
6588 $$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym",
6589 "s\x81\xb3u\x81\xbfbowym"];
6590
6591 $$d{"times"} =["po\x81\xb3udnie","12:00:00",
6592 "p\x81\xf3\x81\xb3noc","00:00:00",
6593 "poludnie","12:00:00","polnoc","00:00:00"];
6594 $$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"];
6595
6596 $$d{"years"} =["rok","lat","lata","latach"];
6597 $$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy",
6598 "miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"];
6599 $$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"];
6600 $$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"];
6601 $$d{"hours"} =["g.","godzina","godziny","godzinie"];
6602 $$d{"minutes"} =["mn.","min.","minut","minuty"];
6603 $$d{"seconds"} =["s.","sekund","sekundy"];
6604 $$d{"replace"} =["m.","miesiac"];
6605
6606 $$d{"sephm"} =':';
6607 $$d{"sepms"} =':';
6608 $$d{"sepss"} ='[.:]';
6609
6610 $$d{"am"} = ["AM","A.M."];
6611 $$d{"pm"} = ["PM","P.M."];
6612}
6613
6614sub Date_Init_Spanish {
6615 print "DEBUG: Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
6616 my($d)=@_;
6617 my(%h)=();
6618 &Char_8Bit(\%h);
6619
6620 $$d{"month_name"}=
6621 [["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
6622 "Septiembre","Octubre","Noviembre","Diciembre"]];
6623
6624 $$d{"month_abb"}=
6625 [["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
6626 "Nov","Dic"]];
6627
6628 $$d{"day_name"}=
6629 [["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
6630 $$d{"day_abb"}=
6631 [["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
6632 $$d{"day_char"}=
6633 [["L","Ma","Mi","J","V","S","D"]];
6634
6635 $$d{"num_suff"}=
6636 [["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o",
6637 "11o","12o","13o","14o","15o","16o","17o","18o","19o","20o",
6638 "21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"],
6639 ["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a",
6640 "11a","12a","13a","14a","15a","16a","17a","18a","19a","20a",
6641 "21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]];
6642 $$d{"num_word"}=
6643 [["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo",
6644 "Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo",
6645 "Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto",
6646 "Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo",
6647 "Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero",
6648 "Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto",
6649 "Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo",
6650 "Trigesimo Primero"],
6651 ["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima",
6652 "Octava","Novena","Decima","Decimo Primera","Decimo Segunda",
6653 "Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta",
6654 "Decimo Septima","Decimo Octava","Decimo Novena","Vigesima",
6655 "Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera",
6656 "Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta",
6657 "Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima",
6658 "Trigesimo Primera"]];
6659
6660 $$d{"now"} =["Ahora"];
6661 $$d{"today"} =["Hoy"];
6662 $$d{"last"} =["ultimo"];
6663 $$d{"each"} =["cada"];
6664 $$d{"of"} =["en","de"];
6665 $$d{"at"} =["a"];
6666 $$d{"on"} =["el"];
6667 $$d{"future"} =["en"];
6668 $$d{"past"} =["hace"];
6669 $$d{"next"} =["siguiente"];
6670 $$d{"prev"} =["anterior"];
6671 $$d{"later"} =["later"];
6672
6673 $$d{"exact"} =["exactamente"];
6674 $$d{"approx"} =["aproximadamente"];
6675 $$d{"business"}=["laborales"];
6676
6677 $$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"];
6678 $$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"];
6679
6680 $$d{"years"} =["a","ano","ano","anos","anos"];
6681 $$d{"months"} =["m","mes","mes","meses"];
6682 $$d{"weeks"} =["sem","semana","semana","semanas"];
6683 $$d{"days"} =["d","dia","dias"];
6684 $$d{"hours"} =["hr","hrs","hora","horas"];
6685 $$d{"minutes"} =["min","min","minuto","minutos"];
6686 $$d{"seconds"} =["s","seg","segundo","segundos"];
6687 $$d{"replace"} =["m","mes"];
6688
6689 $$d{"sephm"} =':';
6690 $$d{"sepms"} =':';
6691 $$d{"sepss"} ='[.:]';
6692
6693 $$d{"am"} = ["AM","A.M."];
6694 $$d{"pm"} = ["PM","P.M."];
6695}
6696
6697sub Date_Init_Portuguese {
6698 print "DEBUG: Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
6699 my($d)=@_;
6700 my(%h)=();
6701 &Char_8Bit(\%h);
6702 my($o) = $h{"-o"};
6703 my($c) = $h{",c"};
6704 my($a) = $h{"a'"};
6705 my($e) = $h{"e'"};
6706 my($u) = $h{"u'"};
6707 my($o2)= $h{"o'"};
6708 my($a2)= $h{"a`"};
6709 my($a3)= $h{"a~"};
6710 my($e2)= $h{"e^"};
6711
6712 $$d{"month_name"}=
6713 [["Janeiro","Fevereiro","Marco","Abril","Maio","Junho",
6714 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"],
6715 ["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho",
6716 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]];
6717
6718 $$d{"month_abb"}=
6719 [["Jan","Fev","Mar","Abr","Mai","Jun",
6720 "Jul","Ago","Set","Out","Nov","Dez"]];
6721
6722 $$d{"day_name"}=
6723 [["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
6724 ["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
6725 $$d{"day_abb"}=
6726 [["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
6727 ["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
6728 $$d{"day_char"}=
6729 [["Sg","T","Qa","Qi","Sx","Sb","D"]];
6730
6731 $$d{"num_suff"}=
6732 [["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}",
6733 "9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}",
6734 "16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}",
6735 "23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}",
6736 "30${o}","31${o}"]];
6737 $$d{"num_word"}=
6738 [["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo",
6739 "oitavo","nono","decimo","decimo primeiro","decimo segundo",
6740 "decimo terceiro","decimo quarto","decimo quinto","decimo sexto",
6741 "decimo setimo","decimo oitavo","decimo nono","vigesimo",
6742 "vigesimo primeiro","vigesimo segundo","vigesimo terceiro",
6743 "vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo",
6744 "vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"],
6745 ["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo",
6746 "oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo",
6747 "d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto",
6748 "d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo",
6749 "d${e}cimo nono","vig${e}simo","vig${e}simo primeiro",
6750 "vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto",
6751 "vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo",
6752 "vig${e}simo oitavo","vig${e}simo nono","trig${e}simo",
6753 "trig${e}simo primeiro"]];
6754
6755 $$d{"now"} =["agora"];
6756 $$d{"today"} =["hoje"];
6757 $$d{"last"} =["${u}ltimo","ultimo"];
6758 $$d{"each"} =["cada"];
6759 $$d{"of"} =["da","do"];
6760 $$d{"at"} =["as","${a2}s"];
6761 $$d{"on"} =["na","no"];
6762 $$d{"future"} =["em"];
6763 $$d{"past"} =["a","${a2}"];
6764 $$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"];
6765 $$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"];
6766 $$d{"later"} =["passadas","passados"];
6767
6768 $$d{"exact"} =["exactamente"];
6769 $$d{"approx"} =["aproximadamente"];
6770 $$d{"business"}=["util","uteis"];
6771
6772 $$d{"offset"} =["ontem","-0:0:0:1:0:0:0",
6773 "amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"];
6774 $$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"];
6775
6776 $$d{"years"} =["anos","ano","ans","an","a"];
6777 $$d{"months"} =["meses","m${e2}s","mes","m"];
6778 $$d{"weeks"} =["semanas","semana","sem","sems","s"];
6779 $$d{"days"} =["dias","dia","d"];
6780 $$d{"hours"} =["horas","hora","hr","hrs"];
6781 $$d{"minutes"} =["minutos","minuto","min","mn"];
6782 $$d{"seconds"} =["segundos","segundo","seg","sg"];
6783 $$d{"replace"} =["m","mes","s","sems"];
6784
6785 $$d{"sephm"} =':';
6786 $$d{"sepms"} =':';
6787 $$d{"sepss"} ='[,]';
6788
6789 $$d{"am"} = ["AM","A.M."];
6790 $$d{"pm"} = ["PM","P.M."];
6791}
6792
6793sub Date_Init_Russian {
6794 print "DEBUG: Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
6795 my($d)=@_;
6796 my(%h)=();
6797 &Char_8Bit(\%h);
6798 my($a) =$h{"a:"};
6799
6800 $$d{"month_name"}=
6801 [
6802 ["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1",
6803 "\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1",
6804 "\xc9\xc0\xce\xd1",
6805 "\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1",
6806 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1",
6807 "\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"],
6808 ["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8",
6809 "\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca",
6810 "\xc9\xc0\xce\xd8",
6811 "\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4",
6812 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8",
6813 "\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"]
6814 ];
6815
6816 $$d{"month_abb"}=
6817 [["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2",
6818 "\xcd\xc1\xca","\xc9\xc0\xce",
6819 "\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4",
6820 "\xce\xcf\xd1\xc2","\xc4\xc5\xcb"],
6821 ["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","",
6822 "","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]];
6823
6824 $$d{"day_name"}=
6825 [["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb",
6826 "\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1",
6827 "\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1",
6828 "\xd3\xd5\xc2\xc2\xcf\xd4\xc1",
6829 "\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]];
6830 $$d{"day_abb"}=
6831 [["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7",
6832 "\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"],
6833 ["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4",
6834 "\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]];
6835 $$d{"day_char"}=
6836 [["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
6837 "\xd7\xd3"]];
6838
6839 $$d{"num_suff"}=
6840 [["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ",
6841 "11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ",
6842 "21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ",
6843 "31 "]];
6844 $$d{"num_word"}=
6845 [["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca",
6846 "\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6847 "\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca",
6848 "\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca",
6849 "\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca",
6850 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6851 "\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca",
6852 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6853 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6854 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6855 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6856 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6857 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6858 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6859 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6860 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca",
6861 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca",
6862 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca",
6863 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6864 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca",
6865 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca",
6866 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca",
6867 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca",
6868 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca",
6869 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca",
6870 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"],
6871
6872 ["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5",
6873 "\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6874 "\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5",
6875 "\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6876 "\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5",
6877 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6878 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6879 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6880 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6881 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6882 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6883 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6884 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6885 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6886 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6887 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5",
6888 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6889 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5",
6890 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6891 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5",
6892 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5",
6893 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5",
6894 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6895 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5",
6896 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5",
6897 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"],
6898
6899 ["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf",
6900 "\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6901 "\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf",
6902 "\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6903 "\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6904 "\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf",
6905 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6906 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6907 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6908 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6909 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6910 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6911 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6912 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6913 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6914 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6915 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf",
6916 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6917 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6918 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf",
6919 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf",
6920 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf",
6921 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6922 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6923 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf",
6924 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6925 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]];
6926
6927 $$d{"now"} =["\xd3\xc5\xca\xde\xc1\xd3"];
6928 $$d{"today"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1"];
6929 $$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"];
6930 $$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"];
6931 $$d{"of"} =[" "];
6932 $$d{"at"} =["\xd7"];
6933 $$d{"on"} =["\xd7"];
6934 $$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"];
6935 $$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "];
6936 $$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"];
6937 $$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"];
6938 $$d{"later"} =["\xd0\xcf\xda\xd6\xc5"];
6939
6940 $$d{"exact"} =["\xd4\xcf\xde\xce\xcf"];
6941 $$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"];
6942 $$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"];
6943
6944 $$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0",
6945 "\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0",
6946 "\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0",
6947 "\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1",
6948 "+0:0:0:2:0:0:0"];
6949 $$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00",
6950 "\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"];
6951
6952 $$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4",
6953 "\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"];
6954 $$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3",
6955 "\xcd\xc5\xd3\xd1\xc3\xc5\xd7"];
6956 $$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8",
6957 "\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"];
6958 $$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca",
6959 "\xc4\xce\xd1"];
6960 $$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3",
6961 "\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"];
6962 $$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1",
6963 "\xcd\xc9\xce\xd5\xd4"];
6964 $$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
6965 "\xd3\xc5\xcb\xd5\xce\xc4"];
6966 $$d{"replace"} =[];
6967
6968 $$d{"sephm"} ="[:\xde]";
6969 $$d{"sepms"} ="[:\xcd]";
6970 $$d{"sepss"} ="[:.\xd3]";
6971
6972 $$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
6973 "\xd5\xd4\xd2\xc1",
6974 "\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"];
6975 $$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1",
6976 "\xd7\xc5\xde\xc5\xd2\xc1",
6977 "\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1",
6978 "\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"];
6979}
6980
6981sub Date_Init_Turkish {
6982 print "DEBUG: Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
6983 my($d)=@_;
6984
6985 $$d{"month_name"}=
6986 [
6987 ["ocak","subat","mart","nisan","mayis","haziran",
6988 "temmuz","agustos","eylul","ekim","kasim","aralik"],
6989 ["ocak","\xfeubat","mart","nisan","may\xfds","haziran",
6990 "temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"]
6991 ];
6992
6993 $$d{"month_abb"}=
6994 [
6995 ["oca","sub","mar","nis","may","haz",
6996 "tem","agu","eyl","eki","kas","ara"],
6997 ["oca","\xfeub","mar","nis","may","haz",
6998 "tem","a\xf0u","eyl","eki","kas","ara"]
6999 ];
7000
7001 $$d{"day_name"}=
7002 [
7003 ["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
7004 ["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
7005 "cumartesi","pazar"],
7006 ];
7007
7008 $$d{"day_abb"}=
7009 [
7010 ["pzt","sal","car","per","cum","cts","paz"],
7011 ["pzt","sal","\xe7ar","per","cum","cts","paz"],
7012 ];
7013
7014 $$d{"day_char"}=
7015 [["Pt","S","Cr","Pr","C","Ct","P"],
7016 ["Pt","S","\xc7","Pr","C","Ct","P"]];
7017
7018 $$d{"num_suff"}=
7019 [[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.",
7020 "11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.",
7021 "21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.",
7022 "31."]];
7023
7024 $$d{"num_word"}=
7025 [
7026 ["birinci","ikinci","ucuncu","dorduncu",
7027 "besinci","altinci","yedinci","sekizinci",
7028 "dokuzuncu","onuncu","onbirinci","onikinci",
7029 "onucuncu","ondordoncu",
7030 "onbesinci","onaltinci","onyedinci","onsekizinci",
7031 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
7032 "yirmiucuncu","yirmidorduncu",
7033 "yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci",
7034 "yirmidokuzuncu","otuzuncu","otuzbirinci"],
7035 ["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc",
7036 "be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci",
7037 "dokuzuncu","onuncu","onbirinci","onikinci",
7038 "on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc",
7039 "onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci",
7040 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
7041 "yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc",
7042 "yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci",
7043 "yirmidokuzuncu","otuzuncu","otuzbirinci"]
7044 ];
7045
7046 $$d{"now"} =["\xfeimdi", "simdi"];
7047 $$d{"today"} =["bugun", "bug\xfcn"];
7048 $$d{"last"} =["son", "sonuncu"];
7049 $$d{"each"} =["her"];
7050 $$d{"of"} =["of"];
7051 $$d{"at"} =["saat"];
7052 $$d{"on"} =["on"];
7053 $$d{"future"} =["gelecek"];
7054 $$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
7055 $$d{"next"} =["gelecek","sonraki"];
7056 $$d{"prev"} =["onceki","\xf6nceki"];
7057 $$d{"later"} =["sonra"];
7058
7059 $$d{"exact"} =["tam"];
7060 $$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"];
7061 $$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"];
7062
7063 $$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0",
7064 "dun", "-0:0:0:1:0:0:0",
7065 "yar\xfdn","+0:0:0:1:0:0:0",
7066 "yarin","+0:0:0:1:0:0:0"];
7067
7068 $$d{"times"} =["\xf6\xf0len","12:00:00",
7069 "oglen","12:00:00",
7070 "yarim","12:300:00",
7071 "yar\xfdm","12:30:00",
7072 "gece yar\xfds\xfd","00:00:00",
7073 "gece yarisi","00:00:00"];
7074
7075 $$d{"years"} =["yil","y"];
7076 $$d{"months"} =["ay","a"];
7077 $$d{"weeks"} =["hafta", "h"];
7078 $$d{"days"} =["gun","g"];
7079 $$d{"hours"} =["saat"];
7080 $$d{"minutes"} =["dakika","dak","d"];
7081 $$d{"seconds"} =["saniye","sn",];
7082 $$d{"replace"} =["s","saat"];
7083
7084 $$d{"sephm"} =':';
7085 $$d{"sepms"} =':';
7086 $$d{"sepss"} ='[.:,]';
7087
7088 $$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
7089 $$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
7090}
7091
7092sub Date_Init_Danish {
7093 print "DEBUG: Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
7094 my($d)=@_;
7095
7096 $$d{"month_name"}=
7097 [["Januar","Februar","Marts","April","Maj","Juni",
7098 "Juli","August","September","Oktober","November","December"]];
7099 $$d{"month_abb"}=
7100 [["Jan","Feb","Mar","Apr","Maj","Jun",
7101 "Jul","Aug","Sep","Okt","Nov","Dec"]];
7102
7103 $$d{"day_name"}=
7104 [["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
7105 ["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
7106
7107 $$d{"day_abb"}=
7108 [["Man","Tir","Ons","Tor","Fre","Lor","Son"],
7109 ["Man","Tir","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
7110 $$d{"day_char"}=
7111 [["M","Ti","O","To","F","L","S"]];
7112
7113 $$d{"num_suff"}=
7114 [["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
7115 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
7116 "21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
7117 "31:e"]];
7118 $$d{"num_word"}=
7119 [["forste","anden","tredie","fjerde","femte","sjette","syvende",
7120 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7121 "femtende","sekstende","syttende","attende","nittende","tyvende",
7122 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7123 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7124 "tredivte","enogtredivte"],
7125 ["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende",
7126 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7127 "femtende","sekstende","syttende","attende","nittende","tyvende",
7128 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7129 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7130 "tredivte","enogtredivte"]];
7131
7132 $$d{"now"} =["nu"];
7133 $$d{"today"} =["idag"];
7134 $$d{"last"} =["forrige","sidste","nyeste"];
7135 $$d{"each"} =["hver"];
7136 $$d{"of"} =["om"];
7137 $$d{"at"} =["kl","kl.","klokken"];
7138 $$d{"on"} =["pa","p\xe5"];
7139 $$d{"future"} =["om"];
7140 $$d{"past"} =["siden"];
7141 $$d{"next"} =["nasta","n\xe6ste"];
7142 $$d{"prev"} =["forrige"];
7143 $$d{"later"} =["senere"];
7144
7145 $$d{"exact"} =["pracist","pr\xe6cist"];
7146 $$d{"approx"} =["circa"];
7147 $$d{"business"}=["arbejdsdag","arbejdsdage"];
7148
7149 $$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
7150 "imorgen","+0:0:0:1:0:0:0"];
7151 $$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00",
7152 "midnat","00:00:00"];
7153
7154 $$d{"years"} =["ar","\xe5r"];
7155 $$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"];
7156 $$d{"weeks"} =["u","uge","uger"];
7157 $$d{"days"} =["d","dag","dage"];
7158 $$d{"hours"} =["t","tim","time","timer"];
7159 $$d{"minutes"} =["min","minut","minutter"];
7160 $$d{"seconds"} =["s","sek","sekund","sekunder"];
7161 $$d{"replace"} =["m","minut"];
7162
7163 $$d{"sephm"} ='[.:]';
7164 $$d{"sepms"} =':';
7165 $$d{"sepss"} ='[.:]';
7166
7167 $$d{"am"} = ["FM"];
7168 $$d{"pm"} = ["EM"];
7169}
7170
7171sub Date_Init_Catalan {
7172 print "DEBUG: Date_Init_Catalan\n" if ($Curr{"Debug"} =~ /trace/);
7173 my($d)=@_;
7174
7175 $$d{"month_name"}=
7176 [["Gener","Febrer","Marc","Abril","Maig","Juny",
7177 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7178 ["Gener","Febrer","Març","Abril","Maig","Juny",
7179 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7180 ["Gener","Febrer","Marc,","Abril","Maig","Juny",
7181 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"]];
7182
7183 $$d{"month_abb"}=
7184 [["Gen","Feb","Mar","Abr","Mai","Jun",
7185 "Jul","Ago","Set","Oct","Nov","Des"],
7186 [],
7187 ["","","","","","",
7188 "","","","","","Dec"] #common mistake
7189 ];
7190
7191 $$d{"day_name"}=
7192 [["Dilluns","Dimarts","Dimecres","Dijous","Divendres","Dissabte","Diumenge"]];
7193 $$d{"day_abb"}=
7194 [["Dll","Dmt","Dmc","Dij","Div","Dis","Diu"],
7195 ["","Dim","","","","",""],
7196 ["","","Dic","","","",""]
7197 ];
7198 $$d{"day_char"}=
7199 [["Dl","Dm","Dc","Dj","Dv","Ds","Du"] ,
7200 ["L","M","X","J","V","S","U"]];
7201
7202 $$d{"num_suff"}=
7203 [["1er","2n","3r","4t","5e","6e","7e","8e","9e","10e",
7204 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
7205 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
7206 "31e"],
7207 ["1er","2n","3r","4t","5è","6è","7è","8è","9è","10è",
7208 "11è","12è","13è","14è","15è","16è","17è","18è","19è","20è",
7209 "21è","22è","23è","24è","25è","26è","27è","28è","29è","30è",
7210 "31è"]];
7211 $$d{"num_word"}=
7212 [["primer","segon","tercer","quart","cinque","sise","sete","vuite",
7213 "nove","dese","onze","dotze","tretze","catorze",
7214 "quinze","setze","dissete","divuite","dinove",
7215 "vinte","vint-i-une","vint-i-dose","vint-i-trese",
7216 "vint-i-quatre","vint-i-cinque","vint-i-sise","vint-i-sete",
7217 "vint-i-vuite","vint-i-nove","trente","trenta-une"],
7218 ["primer","segon","tercer","quart","cinquè","sisè","setè","vuitè",
7219 "novè","desè","onzè","dotzè","tretzè","catorzè",
7220 "quinzè","setzè","dissetè","divuitè","dinovè",
7221 "vintè","vint-i-unè","vint-i-dosè","vint-i-tresè",
7222 "vint-i-quatrè","vint-i-cinquè","vint-i-sisè","vint-i-setè",
7223 "vint-i-vuitè","vint-i-novè","trentè","trenta-unè"]];
7224
7225 $$d{"now"} =["avui","ara"];
7226 $$d{"last"} =["darrer","últim","darrera","última"];
7227 $$d{"each"} =["cada","cadascun","cadascuna"];
7228 $$d{"of"} =["de","d'"];
7229 $$d{"at"} =["a les","a","al"];
7230 $$d{"on"} =["el"];
7231 $$d{"future"} =["d'aquí a"];
7232 $$d{"past"} =["fa"];
7233 $$d{"next"} =["proper"];
7234 $$d{"prev"} =["passat","proppassat","anterior"];
7235 $$d{"later"} =["més tard"];
7236
7237 $$d{"exact"} =["exactament"];
7238 $$d{"approx"} =["approximadament"];
7239 $$d{"business"}=["empresa"];
7240
7241 $$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",];
7242 $$d{"times"} =["migdia","12:00:00","mitjanit","00:00:00"];
7243
7244 $$d{"years"} =["a","an","any","anys"];
7245 $$d{"months"} =["mes","me","ms"];
7246 $$d{"weeks"} =["se","set","setm","setmana","setmanes"];
7247 $$d{"days"} =["d","dia","dies"];
7248 $$d{"hours"} =["h","ho","hores","hora"];
7249 $$d{"minutes"} =["mn","min","minut","minuts"];
7250 $$d{"seconds"} =["s","seg","segon","segons"];
7251 $$d{"replace"} =["m","mes","s","setmana"];
7252
7253 $$d{"sephm"} =':';
7254 $$d{"sepms"} =':';
7255 $$d{"sepss"} ='[.:]';
7256
7257 $$d{"am"} = ["AM","A.M."];
7258 $$d{"pm"} = ["PM","P.M."];
7259}
7260
7261########################################################################
7262# FROM MY PERSONAL LIBRARIES
7263########################################################################
7264
7265no integer;
7266
7267# &ModuloAddition($N,$add,\$val,\$rem);
7268# This calculates $val=$val+$add and forces $val to be in a certain range.
7269# This is useful for adding numbers for which only a certain range is
7270# allowed (for example, minutes can be between 0 and 59 or months can be
7271# between 1 and 12). The absolute value of $N determines the range and
7272# the sign of $N determines whether the range is 0 to N-1 (if N>0) or
7273# 1 to N (N<0). The remainder (as modulo N) is added to $rem.
7274# Example:
7275# To add 2 hours together (with the excess returned in days) use:
7276# &ModuloAddition(60,$s1,\$s,\$day);
7277sub ModuloAddition {
7278 my($N,$add,$val,$rem)=@_;
7279 return if ($N==0);
7280 $$val+=$add;
7281 if ($N<0) {
7282 # 1 to N
7283 $N = -$N;
7284 if ($$val>$N) {
7285 $$rem+= int(($$val-1)/$N);
7286 $$val = ($$val-1)%$N +1;
7287 } elsif ($$val<1) {
7288 $$rem-= int(-$$val/$N)+1;
7289 $$val = $N-(-$$val % $N);
7290 }
7291
7292 } else {
7293 # 0 to N-1
7294 if ($$val>($N-1)) {
7295 $$rem+= int($$val/$N);
7296 $$val = $$val%$N;
7297 } elsif ($$val<0) {
7298 $$rem-= int(-($$val+1)/$N)+1;
7299 $$val = ($N-1)-(-($$val+1)%$N);
7300 }
7301 }
7302}
7303
7304# $Flag=&IsInt($String [,$low, $high]);
7305# Returns 1 if $String is a valid integer, 0 otherwise. If $low is
7306# entered, $String must be >= $low. If $high is entered, $String must
7307# be <= $high. It is valid to check only one of the bounds.
7308sub IsInt {
7309 my($N,$low,$high)=@_;
7310 return 0 if (! defined $N or
7311 $N !~ /^\s*[-+]?\d+\s*$/ or
7312 defined $low && $N<$low or
7313 defined $high && $N>$high);
7314 return 1;
7315}
7316
7317# $Pos=&SinLindex(\@List,$Str [,$offset [,$CaseInsensitive]]);
7318# Searches for an exact string in a list.
7319#
7320# This is similar to RinLindex except that it searches for elements
7321# which are exactly equal to $Str (possibly case insensitive).
7322sub SinLindex {
7323 my($listref,$Str,$offset,$Insensitive)=@_;
7324 my($i,$len,$tmp)=();
7325 $len=$#$listref;
7326 return -2 if ($len<0 or ! $Str);
7327 return -1 if (&Index_First(\$offset,$len));
7328 $Str=uc($Str) if ($Insensitive);
7329 for ($i=$offset; $i<=$len; $i++) {
7330 $tmp=$$listref[$i];
7331 $tmp=uc($tmp) if ($Insensitive);
7332 return $i if ($tmp eq $Str);
7333 }
7334 return -1;
7335}
7336
7337sub Index_First {
7338 my($offsetref,$max)=@_;
7339 $$offsetref=0 if (! $$offsetref);
7340 if ($$offsetref < 0) {
7341 $$offsetref += $max + 1;
7342 $$offsetref=0 if ($$offsetref < 0);
7343 }
7344 return -1 if ($$offsetref > $max);
7345 return 0;
7346}
7347
7348# $File=&CleanFile($file);
7349# This cleans up a path to remove the following things:
7350# double slash /a//b -> /a/b
7351# trailing dot /a/. -> /a
7352# leading dot ./a -> a
7353# trailing slash a/ -> a
7354sub CleanFile {
7355 my($file)=@_;
7356 $file =~ s/\s*$//;
7357 $file =~ s/^\s*//;
7358 $file =~ s|//+|/|g; # multiple slash
7359 $file =~ s|/\.$|/|; # trailing /. (leaves trailing slash)
7360 $file =~ s|^\./|| # leading ./
7361 if ($file ne "./");
7362 $file =~ s|/$|| # trailing slash
7363 if ($file ne "/");
7364 return $file;
7365}
7366
7367# $File=&ExpandTilde($file);
7368# This checks to see if a "~" appears as the first character in a path.
7369# If it does, the "~" expansion is interpreted (if possible) and the full
7370# path is returned. If a "~" expansion is used but cannot be
7371# interpreted, an empty string is returned.
7372#
7373# This is Windows/Mac friendly.
7374# This is efficient.
7375sub ExpandTilde {
7376 my($file)=shift;
7377 my($user,$home)=();
7378 # ~aaa/bbb= ~ aaa /bbb
7379 if ($file =~ s|^~([^/]*)||) {
7380 $user=$1;
7381 # Single user operating systems (Mac, MSWindows) don't have the getpwnam
7382 # and getpwuid routines defined. Try to catch various different ways
7383 # of knowing we are on one of these systems:
7384 return "" if ($OS eq "Windows" or
7385 $OS eq "Mac" or
7386 $OS eq "Netware" or
7387 $OS eq "MPE");
7388 $user="" if (! defined $user);
7389
7390 if ($user) {
7391 $home= (getpwnam($user))[7];
7392 } else {
7393 $home= (getpwuid($<))[7];
7394 }
7395 $home = VMS::Filespec::unixpath($home) if ($OS eq "VMS");
7396 return "" if (! $home);
7397 $file="$home/$file";
7398 }
7399 $file;
7400}
7401
7402# $File=&FullFilePath($file);
7403# Returns the full or relative path to $file (expanding "~" if necessary).
7404# Returns an empty string if a "~" expansion cannot be interpreted. The
7405# path does not need to exist. CleanFile is called.
7406sub FullFilePath {
7407 my($file)=shift;
7408 my($rootpat) = '^/'; #default pattern to match absolute path
7409 $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
7410 $file=&ExpandTilde($file);
7411 return "" if (! $file);
7412 return &CleanFile($file);
7413}
7414
7415# $Flag=&CheckFilePath($file [,$mode]);
7416# Checks to see if $file exists, to see what type it is, and whether
7417# the script can access it. If it exists and has the correct mode, 1
7418# is returned.
7419#
7420# $mode is a string which may contain any of the valid file test operator
7421# characters except t, M, A, C. The appropriate test is run for each
7422# character. For example, if $mode is "re" the -r and -e tests are both
7423# run.
7424#
7425# An empty string is returned if the file doesn't exist. A 0 is returned
7426# if the file exists but any test fails.
7427#
7428# All characters in $mode which do not correspond to valid tests are
7429# ignored.
7430sub CheckFilePath {
7431 my($file,$mode)=@_;
7432 my($test)=();
7433 $file=&FullFilePath($file);
7434 $mode = "" if (! defined $mode);
7435
7436 # Run tests
7437 return 0 if (! defined $file or ! $file);
7438 return 0 if (( ! -e $file) or
7439 ($mode =~ /r/ && ! -r $file) or
7440 ($mode =~ /w/ && ! -w $file) or
7441 ($mode =~ /x/ && ! -x $file) or
7442 ($mode =~ /R/ && ! -R $file) or
7443 ($mode =~ /W/ && ! -W $file) or
7444 ($mode =~ /X/ && ! -X $file) or
7445 ($mode =~ /o/ && ! -o $file) or
7446 ($mode =~ /O/ && ! -O $file) or
7447 ($mode =~ /z/ && ! -z $file) or
7448 ($mode =~ /s/ && ! -s $file) or
7449 ($mode =~ /f/ && ! -f $file) or
7450 ($mode =~ /d/ && ! -d $file) or
7451 ($mode =~ /l/ && ! -l $file) or
7452 ($mode =~ /s/ && ! -s $file) or
7453 ($mode =~ /p/ && ! -p $file) or
7454 ($mode =~ /b/ && ! -b $file) or
7455 ($mode =~ /c/ && ! -c $file) or
7456 ($mode =~ /u/ && ! -u $file) or
7457 ($mode =~ /g/ && ! -g $file) or
7458 ($mode =~ /k/ && ! -k $file) or
7459 ($mode =~ /T/ && ! -T $file) or
7460 ($mode =~ /B/ && ! -B $file));
7461 return 1;
7462}
7463#&&
7464
7465# $Path=&FixPath($path [,$full] [,$mode] [,$error]);
7466# Makes sure that every directory in $path (a colon separated list of
7467# directories) appears as a full path or relative path. All "~"
7468# expansions are removed. All trailing slashes are removed also. If
7469# $full is non-nil, relative paths are expanded to full paths as well.
7470#
7471# If $mode is given, it may be either "e", "r", or "w". In this case,
7472# additional checking is done to each directory. If $mode is "e", it
7473# need ony exist to pass the check. If $mode is "r", it must have have
7474# read and execute permission. If $mode is "w", it must have read,
7475# write, and execute permission.
7476#
7477# The value of $error determines what happens if the directory does not
7478# pass the test. If it is non-nil, if any directory does not pass the
7479# test, the subroutine returns the empty string. Otherwise, it is simply
7480# removed from $path.
7481#
7482# The corrected path is returned.
7483sub FixPath {
7484 my($path,$full,$mode,$err)=@_;
7485 local($_)="";
7486 my(@dir)=split(/$Cnf{"PathSep"}/,$path);
7487 $full=0 if (! defined $full);
7488 $mode="" if (! defined $mode);
7489 $err=0 if (! defined $err);
7490 $path="";
7491 if ($mode eq "e") {
7492 $mode="de";
7493 } elsif ($mode eq "r") {
7494 $mode="derx";
7495 } elsif ($mode eq "w") {
7496 $mode="derwx";
7497 }
7498
7499 foreach (@dir) {
7500
7501 # Expand path
7502 if ($full) {
7503 $_=&FullFilePath($_);
7504 } else {
7505 $_=&ExpandTilde($_);
7506 }
7507 if (! $_) {
7508 return "" if ($err);
7509 next;
7510 }
7511
7512 # Check mode
7513 if (! $mode or &CheckFilePath($_,$mode)) {
7514 $path .= $Cnf{"PathSep"} . $_;
7515 } else {
7516 return "" if ($err);
7517 }
7518 }
7519 $path =~ s/^$Cnf{"PathSep"}//;
7520 return $path;
7521}
7522#&&
7523
7524# $File=&SearchPath($file,$path [,$mode] [,@suffixes]);
7525# Searches through directories in $path for a file named $file. The
7526# full path is returned if one is found, or an empty string otherwise.
7527# The file may exist with one of the @suffixes. The mode is checked
7528# similar to &CheckFilePath.
7529#
7530# The first full path that matches the name and mode is returned. If none
7531# is found, an empty string is returned.
7532sub SearchPath {
7533 my($file,$path,$mode,@suff)=@_;
7534 my($f,$s,$d,@dir,$fs)=();
7535 $path=&FixPath($path,1,"r");
7536 @dir=split(/$Cnf{"PathSep"}/,$path);
7537 foreach $d (@dir) {
7538 $f="$d/$file";
7539 $f=~ s|//|/|g;
7540 return $f if (&CheckFilePath($f,$mode));
7541 foreach $s (@suff) {
7542 $fs="$f.$s";
7543 return $fs if (&CheckFilePath($fs,$mode));
7544 }
7545 }
7546 return "";
7547}
7548
7549# @list=&ReturnList($str);
7550# This takes a string which should be a comma separated list of integers
7551# or ranges (5-7). It returns a sorted list of all integers referred to
7552# by the string, or () if there is an invalid element.
7553#
7554# Negative integers are also handled. "-2--1" is equivalent to "-2,-1".
7555sub ReturnList {
7556 my($str)=@_;
7557 my(@ret,@str,$from,$to,$tmp)=();
7558 @str=split(/,/,$str);
7559 foreach $str (@str) {
7560 if ($str =~ /^[-+]?\d+$/) {
7561 push(@ret,$str);
7562 } elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {
7563 ($from,$to)=($1,$2);
7564 if ($from>$to) {
7565 $tmp=$from;
7566 $from=$to;
7567 $to=$tmp;
7568 }
7569 push(@ret,$from..$to);
7570 } else {
7571 return ();
7572 }
7573 }
7574 @ret;
7575}
7576
75771;
Note: See TracBrowser for help on using the repository browser.