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

Last change on this file since 636 was 618, checked in by Nicholas Riley, 15 years ago

Update to Date::Manip 5.55 (with a fix to require Perl 5.8 rather than 5.10 in DM5abbrevs.pm).
File size: 229.8 KB
RevLine 
[360]1package Date::Manip;
[618]2# Copyright (c) 1995-2010 Sullivan Beck. All rights reserved.
[360]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
[618]9use warnings;
10
[360]11use vars qw($OS %Lang %Holiday %Events %Curr %Cnf %Zone $VERSION @ISA @EXPORT);
12
13# Determine the type of OS...
14$OS="Unix";
15$OS="Windows" if ((defined $^O and
16 $^O =~ /MSWin32/i ||
17 $^O =~ /Windows_95/i ||
18 $^O =~ /Windows_NT/i) ||
19 (defined $ENV{OS} and
20 $ENV{OS} =~ /MSWin32/i ||
21 $ENV{OS} =~ /Windows_95/i ||
22 $ENV{OS} =~ /Windows_NT/i));
23$OS="Unix" if (defined $^O and
24 $^O =~ /cygwin/i);
25$OS="Netware" if (defined $^O and
26 $^O =~ /NetWare/i);
27$OS="Mac" if ((defined $^O and
28 $^O =~ /MacOS/i) ||
29 (defined $ENV{OS} and
30 $ENV{OS} =~ /MacOS/i));
31$OS="MPE" if (defined $^O and
32 $^O =~ /MPE/i);
33$OS="OS2" if (defined $^O and
34 $^O =~ /os2/i);
35$OS="VMS" if (defined $^O and
36 $^O =~ /VMS/i);
37$OS="AIX" if (defined $^O and
38 $^O =~ /aix/i);
39
40# Determine if we're doing taint checking
[618]41#if ($] < 5.0080) {
42 $Date::Manip::NoTaint = eval { local $^W=0; eval("#" . substr($^X, 0, 0)); 1 };
43#} else {
44# $Date::Manip::NoTaint = (${^TAINT} == 0 ? 1 : 0);
45#}
[360]46
47###########################################################################
48# CUSTOMIZATION
49###########################################################################
50#
51# See the section of the POD documentation section CUSTOMIZING DATE::MANIP
52# below for a complete description of each of these variables.
53
54
55# Location of a the global config file. Tilde (~) expansions are allowed.
56# This should be set in Date_Init arguments.
57$Cnf{"GlobalCnf"}="";
58$Cnf{"IgnoreGlobalCnf"}="";
59
60# Name of a personal config file and the path to search for it. Tilde (~)
61# expansions are allowed. This should be set in Date_Init arguments or in
62# the global config file.
63
64@Date::Manip::DatePath=();
65if ($OS eq "Windows") {
66 $Cnf{"PathSep"} = ";";
67 $Cnf{"PersonalCnf"} = "Manip.cnf";
68 $Cnf{"PersonalCnfPath"} = ".";
69
70} elsif ($OS eq "Netware") {
71 $Cnf{"PathSep"} = ";";
72 $Cnf{"PersonalCnf"} = "Manip.cnf";
73 $Cnf{"PersonalCnfPath"} = ".";
74
75} elsif ($OS eq "MPE") {
76 $Cnf{"PathSep"} = ":";
77 $Cnf{"PersonalCnf"} = "Manip.cnf";
78 $Cnf{"PersonalCnfPath"} = ".";
79
80} elsif ($OS eq "OS2") {
81 $Cnf{"PathSep"} = ":";
82 $Cnf{"PersonalCnf"} = "Manip.cnf";
83 $Cnf{"PersonalCnfPath"} = ".";
84
85} elsif ($OS eq "Mac") {
86 $Cnf{"PathSep"} = ":";
87 $Cnf{"PersonalCnf"} = "Manip.cnf";
88 $Cnf{"PersonalCnfPath"} = ".";
89
90} elsif ($OS eq "VMS") {
91 # VMS doesn't like files starting with "."
92 $Cnf{"PathSep"} = ",";
93 $Cnf{"PersonalCnf"} = "Manip.cnf";
94 $Cnf{"PersonalCnfPath"} = "/sys\$login";
95
96} else {
97 # Unix
98 $Cnf{"PathSep"} = ":";
99 $Cnf{"PersonalCnf"} = ".DateManip.cnf";
100 $Cnf{"PersonalCnfPath"} = ".:~";
101 @Date::Manip::DatePath=qw(/bin /usr/bin /usr/local/bin);
102}
103
104### Date::Manip variables set in the global or personal config file
105
106# Which language to use when parsing dates.
107$Cnf{"Language"}="English";
108
109# 12/10 = Dec 10 (US) or Oct 12 (anything else)
110$Cnf{"DateFormat"}="US";
111
112# Local timezone
113$Cnf{"TZ"}="";
114
115# Timezone to work in (""=local, "IGNORE", or a timezone)
116$Cnf{"ConvTZ"}="";
117
118# Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
119$Cnf{"Internal"}=0;
120
121# First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
122$Cnf{"FirstDay"}=1;
123
124# First and last day of the work week (1=monday, 7=sunday)
125$Cnf{"WorkWeekBeg"}=1;
126$Cnf{"WorkWeekEnd"}=5;
127
128# If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
129# ignored)
130$Cnf{"WorkDay24Hr"}=0;
131
132# Start and end time of the work day (any time format allowed, seconds
133# ignored)
134$Cnf{"WorkDayBeg"}="08:00";
135$Cnf{"WorkDayEnd"}="17:00";
136
137# If "today" is a holiday, we look either to "tomorrow" or "yesterday" for
138# the nearest business day. By default, we'll always look "tomorrow"
139# first.
140$Cnf{"TomorrowFirst"}=1;
141
142# Erase the old holidays
143$Cnf{"EraseHolidays"}="";
144
145# Set this to non-zero to be produce completely backwards compatible deltas
146$Cnf{"DeltaSigns"}=0;
147
148# If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
149# make week 1 contain Jan 1.
150$Cnf{"Jan1Week1"}=0;
151
152# 2 digit years fall into the 100 year period given by [ CURR-N,
153# CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful
154# numbers might be 0 (forced to be this year or later) and 99 (forced to be
155# this year or earlier). It can also be set to "c" (current century) or
156# "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the
157# form cNNNN to give the 100 year period NNNN to NNNN+99.
158$Cnf{"YYtoYYYY"}=89;
159
160# Set this to 1 if you want a long-running script to always update the
161# timezone. This will slow Date::Manip down. Read the POD documentation.
162$Cnf{"UpdateCurrTZ"}=0;
163
164# Use an international character set.
165$Cnf{"IntCharSet"}=0;
166
167# Use this to force the current date to be set to this:
168$Cnf{"ForceDate"}="";
169
170# Use this to make "today" mean "today at midnight".
171$Cnf{"TodayIsMidnight"}=0;
172
173###########################################################################
174
175require 5.000;
176require Exporter;
177@ISA = qw(Exporter);
178@EXPORT = qw(
179 DateManipVersion
180 Date_Init
181 ParseDateString
182 ParseDate
183 ParseRecur
184 Date_Cmp
185 DateCalc
186 ParseDateDelta
187 UnixDate
188 Delta_Format
189 Date_GetPrev
190 Date_GetNext
191 Date_SetTime
192 Date_SetDateField
193 Date_IsHoliday
194 Events_List
195
196 Date_DaysInMonth
197 Date_DayOfWeek
198 Date_SecsSince1970
199 Date_SecsSince1970GMT
200 Date_DaysSince1BC
201 Date_DayOfYear
202 Date_DaysInYear
203 Date_WeekOfYear
204 Date_LeapYear
205 Date_DaySuffix
206 Date_ConvTZ
207 Date_TimeZone
208 Date_IsWorkDay
209 Date_NextWorkDay
210 Date_PrevWorkDay
211 Date_NearestWorkDay
212 Date_NthDayOfYear
213);
214use strict;
215use integer;
216use Carp;
217
218use IO::File;
219
[618]220use vars qw($Abbrevs);
221use Date::Manip::DM5abbrevs;
[360]222
[618]223$VERSION="5.55";
224
[360]225########################################################################
226########################################################################
227
228$Curr{"InitLang"} = 1; # Whether a language is being init'ed
229$Curr{"InitDone"} = 0; # Whether Init_Date has been called
230$Curr{"InitFilesRead"} = 0;
231$Curr{"ResetWorkDay"} = 1;
232$Curr{"Debug"} = "";
233$Curr{"DebugVal"} = "";
234
235$Holiday{"year"} = 0;
236$Holiday{"dates"} = {};
237$Holiday{"desc"} = {};
238
239$Events{"raw"} = [];
240$Events{"parsed"} = 0;
241$Events{"dates"} = [];
242$Events{"recur"} = [];
243
244########################################################################
245########################################################################
246# THESE ARE THE MAIN ROUTINES
247########################################################################
248########################################################################
249
250# Get rid of a problem with old versions of perl
251no strict "vars";
252# This sorts from longest to shortest element
[618]253sub _sortByLength {
[360]254 return (length $b <=> length $a);
255}
256use strict "vars";
257
258sub DateManipVersion {
259 print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
260 return $VERSION;
261}
262
263sub Date_Init {
264 print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
265 $Curr{"Debug"}="";
266
267 my(@args)=@_;
268 $Curr{"InitDone"}=1;
269 local($_)=();
270 my($internal,$firstday)=();
271 my($var,$val,$file,@tmp)=();
272
273 # InitFilesRead = 0 : no conf files read yet
274 # 1 : global read, no personal read
275 # 2 : personal read
276
277 $Cnf{"EraseHolidays"}=0;
278 foreach (@args) {
279 s/\s*$//;
280 s/^\s*//;
281 /^(\S+) \s* = \s* (.*)$/x;
282 ($var,$val)=($1,$2);
283 if ($var =~ /^GlobalCnf$/i) {
284 $Cnf{"GlobalCnf"}=$val;
285 if ($val) {
286 $Curr{"InitFilesRead"}=0;
[618]287 EraseHolidays();
[360]288 }
289 } elsif ($var =~ /^PathSep$/i) {
290 $Cnf{"PathSep"}=$val;
291 } elsif ($var =~ /^PersonalCnf$/i) {
292 $Cnf{"PersonalCnf"}=$val;
293 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
294 } elsif ($var =~ /^PersonalCnfPath$/i) {
295 $Cnf{"PersonalCnfPath"}=$val;
296 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
297 } elsif ($var =~ /^IgnoreGlobalCnf$/i) {
298 $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0);
299 $Cnf{"IgnoreGlobalCnf"}=1;
300 } elsif ($var =~ /^EraseHolidays$/i) {
[618]301 EraseHolidays();
[360]302 } else {
303 push(@tmp,$_);
304 }
305 }
306 @args=@tmp;
307
308 # Read global config file
309 if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
310 $Curr{"InitFilesRead"}=1;
311
312 if ($Cnf{"GlobalCnf"}) {
[618]313 $file=_ExpandTilde($Cnf{"GlobalCnf"});
314 _Date_InitFile($file) if ($file);
[360]315 }
316 }
317
318 # Read personal config file
319 if ($Curr{"InitFilesRead"}<2) {
320 $Curr{"InitFilesRead"}=2;
321
322 if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) {
[618]323 $file=_SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r");
324 _Date_InitFile($file) if ($file);
[360]325 }
326 }
327
328 foreach (@args) {
329 s/\s*$//;
330 s/^\s*//;
331 /^(\S+) \s* = \s* (.*)$/x;
332 ($var,$val)=($1,$2);
333 $val="" if (! defined $val);
[618]334 _Date_SetConfigVariable($var,$val);
[360]335 }
336
337 confess "ERROR: Unknown FirstDay in Date::Manip.\n"
[618]338 if (! _IsInt($Cnf{"FirstDay"},1,7));
[360]339 confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n"
[618]340 if (! _IsInt($Cnf{"WorkWeekBeg"},1,7));
[360]341 confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n"
[618]342 if (! _IsInt($Cnf{"WorkWeekEnd"},1,7));
[360]343 confess "ERROR: Invalid WorkWeek in Date::Manip.\n"
344 if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"});
345
346 my(%lang,
347 $tmp,%tmp,$tmp2,@tmp2,
348 $i,$j,@tmp3,
[618]349 @zones)=();
[360]350
351 my($L)=$Cnf{"Language"};
352
353 if ($Curr{"InitLang"}) {
354 $Curr{"InitLang"}=0;
355
356 if ($L eq "English") {
[618]357 _Date_Init_English(\%lang);
[360]358
359 } elsif ($L eq "French") {
[618]360 _Date_Init_French(\%lang);
[360]361
362 } elsif ($L eq "Swedish") {
[618]363 _Date_Init_Swedish(\%lang);
[360]364
365 } elsif ($L eq "German") {
[618]366 _Date_Init_German(\%lang);
[360]367
368 } elsif ($L eq "Polish") {
[618]369 _Date_Init_Polish(\%lang);
[360]370
371 } elsif ($L eq "Dutch" ||
372 $L eq "Nederlands") {
[618]373 _Date_Init_Dutch(\%lang);
[360]374
375 } elsif ($L eq "Spanish") {
[618]376 _Date_Init_Spanish(\%lang);
[360]377
378 } elsif ($L eq "Portuguese") {
[618]379 _Date_Init_Portuguese(\%lang);
[360]380
381 } elsif ($L eq "Romanian") {
[618]382 _Date_Init_Romanian(\%lang);
[360]383
384 } elsif ($L eq "Italian") {
[618]385 _Date_Init_Italian(\%lang);
[360]386
387 } elsif ($L eq "Russian") {
[618]388 _Date_Init_Russian(\%lang);
[360]389
390 } elsif ($L eq "Turkish") {
[618]391 _Date_Init_Turkish(\%lang);
[360]392
393 } elsif ($L eq "Danish") {
[618]394 _Date_Init_Danish(\%lang);
[360]395
396 } elsif ($L eq "Catalan") {
[618]397 _Date_Init_Catalan(\%lang);
[360]398
399 } else {
400 confess "ERROR: Unknown language in Date::Manip.\n";
401 }
402
403 # variables for months
404 # Month = "(jan|january|feb|february ... )"
405 # MonL = [ "Jan","Feb",... ]
406 # MonthL = [ "January","February", ... ]
407 # MonthH = { "january"=>1, "jan"=>1, ... }
408
409 $Lang{$L}{"MonthH"}={};
410 $Lang{$L}{"MonthL"}=[];
411 $Lang{$L}{"MonL"}=[];
[618]412 _Date_InitLists([$lang{"month_name"},
[360]413 $lang{"month_abb"}],
414 \$Lang{$L}{"Month"},"lc,sort,back",
415 [$Lang{$L}{"MonthL"},
416 $Lang{$L}{"MonL"}],
417 [$Lang{$L}{"MonthH"},1]);
418
419 # variables for day of week
420 # Week = "(mon|monday|tue|tuesday ... )"
421 # WL = [ "M","T",... ]
422 # WkL = [ "Mon","Tue",... ]
423 # WeekL = [ "Monday","Tudesday",... ]
424 # WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
425
426 $Lang{$L}{"WeekH"}={};
427 $Lang{$L}{"WeekL"}=[];
428 $Lang{$L}{"WkL"}=[];
429 $Lang{$L}{"WL"}=[];
[618]430 _Date_InitLists([$lang{"day_name"},
[360]431 $lang{"day_abb"}],
432 \$Lang{$L}{"Week"},"lc,sort,back",
433 [$Lang{$L}{"WeekL"},
434 $Lang{$L}{"WkL"}],
435 [$Lang{$L}{"WeekH"},1]);
[618]436 _Date_InitLists([$lang{"day_char"}],
[360]437 "","lc",
438 [$Lang{$L}{"WL"}],
439 [\%tmp,1]);
440 %{ $Lang{$L}{"WeekH"} } =
441 (%{ $Lang{$L}{"WeekH"} },%tmp);
442
443 # variables for last
444 # Last = "(last)"
445 # LastL = [ "last" ]
446 # Each = "(each)"
447 # EachL = [ "each" ]
448 # variables for day of month
449 # DoM = "(1st|first ... 31st)"
450 # DoML = [ "1st","2nd",... "31st" ]
451 # DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 }
452 # variables for week of month
453 # WoM = "(1st|first| ... 5th|last)"
454 # WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 }
455
456 $Lang{$L}{"LastL"}=$lang{"last"};
[618]457 _Date_InitStrings($lang{"last"},
[360]458 \$Lang{$L}{"Last"},"lc,sort");
459
460 $Lang{$L}{"EachL"}=$lang{"each"};
[618]461 _Date_InitStrings($lang{"each"},
[360]462 \$Lang{$L}{"Each"},"lc,sort");
463
464 $Lang{$L}{"DoMH"}={};
465 $Lang{$L}{"DoML"}=[];
[618]466 _Date_InitLists([$lang{"num_suff"},
[360]467 $lang{"num_word"}],
468 \$Lang{$L}{"DoM"},"lc,sort,back,escape",
469 [$Lang{$L}{"DoML"},
470 \@tmp],
471 [$Lang{$L}{"DoMH"},1]);
472
473 @tmp=();
474 foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
475 $tmp2=$Lang{$L}{"DoMH"}{$tmp};
476 if ($tmp2<6) {
477 $Lang{$L}{"WoMH"}{$tmp} = $tmp2;
478 push(@tmp,$tmp);
479 }
480 }
481 foreach $tmp (@{ $Lang{$L}{"LastL"} }) {
482 $Lang{$L}{"WoMH"}{$tmp} = -1;
483 push(@tmp,$tmp);
484 }
[618]485 _Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"},
[360]486 "lc,sort,back,escape");
487
488 # variables for AM or PM
489 # AM = "(am)"
490 # PM = "(pm)"
491 # AmPm = "(am|pm)"
492 # AMstr = "AM"
493 # PMstr = "PM"
494
[618]495 _Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape");
496 _Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape");
497 _Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"},
[360]498 "lc,back,sort,escape");
499 $Lang{$L}{"AMstr"}=$lang{"am"}[0];
500 $Lang{$L}{"PMstr"}=$lang{"pm"}[0];
501
502 # variables for expressions used in parsing deltas
503 # Yabb = "(?:y|yr|year|years)"
504 # Mabb = similar for months
505 # Wabb = similar for weeks
506 # Dabb = similar for days
507 # Habb = similar for hours
508 # MNabb = similar for minutes
509 # Sabb = similar for seconds
510 # Repl = { "abb"=>"replacement" }
511 # Whenever an abbreviation could potentially refer to two different
512 # strings (M standing for Minutes or Months), the abbreviation must
513 # be listed in Repl instead of in the appropriate Xabb values. This
514 # only applies to abbreviations which are substrings of other values
515 # (so there is no confusion between Mn and Month).
516
[618]517 _Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort");
518 _Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort");
519 _Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort");
520 _Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort");
521 _Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort");
522 _Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort");
523 _Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort");
[360]524 $Lang{$L}{"Repl"}={};
[618]525 _Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
[360]526
527 # variables for special dates that are offsets from now
528 # Now = "now"
529 # Today = "today"
530 # Offset = "(yesterday|tomorrow)"
531 # OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ]
532 # Times = "(noon|midnight)"
533 # TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" }
534 # SepHM = hour/minute separator
535 # SepMS = minute/second separator
536 # SepSS = second/fraction separator
537
538 $Lang{$L}{"TimesH"}={};
[618]539 _Date_InitHash($lang{"times"},
[360]540 \$Lang{$L}{"Times"},"lc,sort,back",
541 $Lang{$L}{"TimesH"});
[618]542 _Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort");
543 _Date_InitStrings($lang{"today"},\$Lang{$L}{"Today"},"lc,sort");
[360]544 $Lang{$L}{"OffsetH"}={};
[618]545 _Date_InitHash($lang{"offset"},
[360]546 \$Lang{$L}{"Offset"},"lc,sort,back",
547 $Lang{$L}{"OffsetH"});
548 $Lang{$L}{"SepHM"}=$lang{"sephm"};
549 $Lang{$L}{"SepMS"}=$lang{"sepms"};
550 $Lang{$L}{"SepSS"}=$lang{"sepss"};
551
552 # variables for time zones
553 # zones = regular expression with all zone names (EST)
554 # n2o = a hash of all parsable zone names with their offsets
555 # tzones = reguar expression with all tzdata timezones (US/Eastern)
556 # tz2z = hash of all tzdata timezones to full timezone (EST#EDT)
557
558 $Zone{"n2o"} = {};
559 ($Zone{"zones"},%{ $Zone{"n2o"} })=
[618]560 _Date_Regexp($Abbrevs,"sort,lc,under,back",
[360]561 "keys");
562
563 $tmp=
564 "US/Pacific PST8PDT ".
565 "US/Mountain MST7MDT ".
566 "US/Central CST6CDT ".
567 "US/Eastern EST5EDT ".
568 "Canada/Pacific PST8PDT ".
569 "Canada/Mountain MST7MDT ".
570 "Canada/Central CST6CDT ".
571 "Canada/Eastern EST5EDT";
572
573 $Zone{"tz2z"} = {};
574 ($Zone{"tzones"},%{ $Zone{"tz2z"} })=
[618]575 _Date_Regexp($tmp,"lc,under,back","keys");
576 $Cnf{"TZ"}=Date_TimeZone();
[360]577
578 # misc. variables
579 # At = "(?:at)"
580 # Of = "(?:in|of)"
581 # On = "(?:on)"
582 # Future = "(?:in)"
583 # Later = "(?:later)"
584 # Past = "(?:ago)"
585 # Next = "(?:next)"
586 # Prev = "(?:last|previous)"
587
[618]588 _Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort");
589 _Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort");
590 _Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort");
591 _Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort");
592 _Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort");
593 _Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort");
594 _Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort");
595 _Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort");
[360]596
597 # calc mode variables
598 # Approx = "(?:approximately)"
599 # Exact = "(?:exactly)"
600 # Business = "(?:business)"
601
[618]602 _Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort");
603 _Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort");
604 _Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort");
[360]605
606 ############### END OF LANGUAGE INITIALIZATION
607 }
608
609 if ($Curr{"ResetWorkDay"}) {
610 my($h1,$m1,$h2,$m2)=();
611 if ($Cnf{"WorkDay24Hr"}) {
612 ($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
613 ($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
614 $Curr{"WDlen"}=24*60;
615 $Cnf{"WorkDayBeg"}="00:00";
616 $Cnf{"WorkDayEnd"}="23:59";
617
618 } else {
619 confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n"
[618]620 if (! (($h1,$m1)=_CheckTime($Cnf{"WorkDayBeg"})));
[360]621 $Cnf{"WorkDayBeg"}="$h1:$m1";
622 confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n"
[618]623 if (! (($h2,$m2)=_CheckTime($Cnf{"WorkDayEnd"})));
[360]624 $Cnf{"WorkDayEnd"}="$h2:$m2";
625
626 ($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
627 ($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
628
629 # Work day length = h1:m1 or 0:len (len minutes)
630 $h1=$h2-$h1;
631 $m1=$m2-$m1;
632 if ($m1<0) {
633 $h1--;
634 $m1+=60;
635 }
636 $Curr{"WDlen"}=$h1*60+$m1;
637 }
638 $Curr{"ResetWorkDay"}=0;
639 }
640
641 # current time
642 my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
643 if ($Cnf{"ForceDate"}=~
644 /^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
645 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
646 } else {
647 ($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
648 $y+=1900;
649 $m++;
650 }
[618]651 _Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
[360]652 $Curr{"Y"}=$y;
653 $Curr{"M"}=$m;
654 $Curr{"D"}=$d;
655 $Curr{"H"}=$h;
656 $Curr{"Mn"}=$mn;
657 $Curr{"S"}=$s;
658 $Curr{"AmPm"}=$ampm;
[618]659 $Curr{"Now"}=_Date_Join($y,$m,$d,$h,$mn,$s);
[360]660 if ($Cnf{"TodayIsMidnight"}) {
[618]661 $Curr{"Today"}=_Date_Join($y,$m,$d,0,0,0);
[360]662 } else {
663 $Curr{"Today"}=$Curr{"Now"};
664 }
665
666 $Curr{"Debug"}=$Curr{"DebugVal"};
667
668 # If we're in array context, let's return a list of config variables
669 # that could be passed to Date_Init to get the same state as we're
670 # currently in.
671 if (wantarray) {
672 # Some special variables that have to be in a specific order
673 my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
674 my(%tmp)=map { $_,1 } @special;
675 my(@tmp,$key,$val);
676 foreach $key (@special) {
677 $val=$Cnf{$key};
678 push(@tmp,"$key=$val");
679 }
680 foreach $key (keys %Cnf) {
681 next if (exists $tmp{$key});
682 $val=$Cnf{$key};
683 push(@tmp,"$key=$val");
684 }
685 return @tmp;
686 }
687 return ();
688}
689
690sub ParseDateString {
691 print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
692 local($_)=@_;
693 return "" if (! $_);
694
695 my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
696 my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
697
698 # We only need to reinitialize if we have to determine what NOW is.
[618]699 Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
[360]700
701 my($L)=$Cnf{"Language"};
702 my($type)=$Cnf{"DateFormat"};
703
704 # Mode is set in DateCalc. ParseDate only overrides it if the string
705 # contains a mode.
706 if ($Lang{$L}{"Exact"} &&
707 s/$Lang{$L}{"Exact"}//) {
708 $Curr{"Mode"}=0;
709 } elsif ($Lang{$L}{"Approx"} &&
710 s/$Lang{$L}{"Approx"}//) {
711 $Curr{"Mode"}=1;
712 } elsif ($Lang{$L}{"Business"} &&
713 s/$Lang{$L}{"Business"}//) {
714 $Curr{"Mode"}=2;
715 } elsif (! exists $Curr{"Mode"}) {
716 $Curr{"Mode"}=0;
717 }
718
719 # Unfortunately, some deltas can be parsed as dates. An example is
720 # 1 second == 1 2nd == 1 2
721 # But, some dates can be parsed as deltas. The most important being:
722 # 1998010101:00:00
723 #
724 # We'll check to see if a "date" can be parsed as a delta. If so, we'll
725 # assume that it is a delta (since they are much simpler, it is much
726 # less likely that we'll mistake a delta for a date than vice versa)
727 # unless it is an ISO-8601 date.
728 #
729 # This is important because we are using DateCalc to test whether a
730 # string is a date or a delta. Dates are tested first, so we need to
731 # be able to pass a delta into this routine and have it correctly NOT
732 # interpreted as a date.
733 #
734 # We will insist that the string contain something other than digits and
735 # colons so that the following will get correctly interpreted as a date
736 # rather than a delta:
737 # 12:30
738 # 19980101
739
740 $delta="";
[618]741 $delta=ParseDateDelta($_) if (/[^:0-9]/);
[360]742
743 # Put parse in a simple loop for an easy exit.
744 PARSE: {
[618]745 my(@tmp)=_Date_Split($_);
[360]746 if (@tmp) {
747 ($y,$m,$d,$h,$mn,$s)=@tmp;
748 last PARSE;
749 }
750
751 # Fundamental regular expressions
752
753 my($month)=$Lang{$L}{"Month"}; # (jan|january|...)
754 my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
755 my($week)=$Lang{$L}{"Week"}; # (mon|monday|...)
756 my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
757 my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last)
758 my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
759 my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st)
760 my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
761 my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm)
762 my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight)
763 my($now)=$Lang{$L}{"Now"}; # now
764 my($today)=$Lang{$L}{"Today"}; # today
765 my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow)
766 my($zone)=$Zone{"zones"}; # (edt|est|...)
767 my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days)
768 my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months)
769 my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks)
770 my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next)
771 my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous)
772 my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago)
773 my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in)
774 my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later)
775 my($at)=$Lang{$L}{"At"}; # (?:at)
776 my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of)
777 my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)';
778 # \s*(?:on)\s* or \s+
779 my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last)
780 my($hm)=$Lang{$L}{"SepHM"}; # :
781 my($ms)=$Lang{$L}{"SepMS"}; # :
782 my($ss)=$Lang{$L}{"SepSS"}; # .
783
784 # Other regular expressions
785
[618]786 my($D4)='(\d{4})'; # 4 digits (yr)
787 my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr)
788 my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
789 my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
790 my($FS)="(?:$ss\\d+)?"; # fractional secs
791 my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
[360]792 # absolute time zone +0700 (GMT)
[618]793 my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23
794 my($mzone)='(?:[0-5][0-9])'; # 00 - 59
[360]795 my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))".
[618]796 # +0700 +07:00 -07
797 '(?:\s*\([^)]+\))?)'; # (GMT)
[360]798
799 # A regular expression for the time EXCEPT for the hour part
800 my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
801
802 # A special regular expression for /YYYY:HH:MN:SS used by Apache
803 my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
804
805 my($time)="";
806 $ampm="";
807 $date="";
808
809 # Substitute all special time expressions.
810 if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
811 $tmp=$2;
812 $tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
813 s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
814 }
815
816 # Remove some punctuation
817 s/[,]/ /g;
818
819 # When we have a digit followed immediately by a timezone (7EST), we
820 # will put a space between the digit, EXCEPT in the case of a single
821 # character military timezone. If the single character is followed
822 # by anything, no space is added.
823 $tmp = "";
824 while ( s/^(.*?\d)$zone(\s|$|[0-9])/$3/i ) {
825 my($bef,$z,$aft) = ($1,$2,$3);
826 if (length($z) != 1 || length($aft) == 0) {
827 $tmp .= "$bef $z";
828 } else {
829 $tmp .= "$bef$z";
830 }
831 }
832 $_ = "$tmp$_";
833 $zone = '\s+' . $zone . '(?:\s+|$)';
834
835 # Remove the time
836 $iso=1;
837 $midnight=0;
838 $from="24${hm}00(?:${ms}00)?";
839 $falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
840 $to="00${hm}00${ms}00";
841 $midnight=1 if (!/$falsefrom/ && s/$from/$to/);
842
843 $h=$mn=$s=0;
844 if (/$D$mnsec/i || /$ampmexp/i) {
845 $iso=0;
846 $tmp=0;
847 $tmp=1 if (/$mnsec$zone2?\s*$/i or /$mnsec$zone\s*$/i);
848 $tmp=0 if (/$ampmexp/i);
849 if (s/$apachetime$zone()/$1 /i ||
850 s/$apachetime$zone2?/$1 /i ||
851 s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i ||
852 s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i ||
853 s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i ||
854 s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i ||
855 (s/(t)$D$mnsec$zone()/$1 /i and (($iso=$tmp) || 1)) ||
856 (s/(t)$D$mnsec$zone2?/$1 /i and (($iso=$tmp) || 1)) ||
857 (s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) ||
858 (s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) ||
859 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i ||
860 s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i ||
861 0
862 ) {
863 ($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
864 if (defined ($z)) {
865 if ($z =~ /^[+-]\d{2}:\d{2}$/) {
866 $z=~ s/://;
867 } elsif ($z =~ /^[+-]\d{2}$/) {
868 $z .= "00";
869 }
870 }
871 $time=1;
[618]872 _Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
[360]873 $y=$m=$d="";
874 # We're going to be calling TimeCheck again below (when we check the
875 # final date), so get rid of $ampm so that we don't have an error
876 # due to "15:30:00 PM". It'll get reset below.
877 $ampm="";
878 if (/^\s*$/) {
[618]879 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
[360]880 last PARSE;
881 }
882 }
883 }
884 $time=0 if ($time ne "1");
885 s/\s+$//;
886 s/^\s+//;
887
888 # if a zone was found, get rid of the regexps
889 if ($z) {
890 $zone="";
891 $zone2="";
892 }
893
894 # dateTtime ISO 8601 formats
895 my($orig)=$_;
896
897 # Parse ISO 8601 dates now (which may still have a zone stuck to it).
898 if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) ||
899 ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) ||
900 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) ||
901 ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) ||
902 ($iso && /^([0-9-]+)T$zone?$/i) ||
903 ($iso && /^([0-9-]+)T$zone2?$/i) ||
904 0) {
905
906 # If we already got a timezone, don't get another one.
907 my(@z);
908 if ($z) {
909 @z=($z,$z2);
910 $z="";
911 }
912 ($_,$z,$z2) = ($1,$2,$3);
913 ($z,$z2)=@z if (@z);
914
915 s,([0-9])\s*-,$1 ,g; # Change all ISO8601 seps to spaces
916 s/^\s+//;
917 s/\s+$//;
918
919 if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
920 /^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
921 0
922 ) {
923 # ISO 8601 Dates with times
924 # YYYYMMDDtHHMNSSFFFF...
925 # YYYYMMDDtHHMNSS
926 # YYYYMMDDtHHMN
927 # YYYYMMDDtHH
928 # YY MMDDtHHMNSSFFFF...
929 # YY MMDDtHHMNSS
930 # YY MMDDtHHMN
931 # YY MMDDtHH
932 # The t is an optional letter "t".
933 ($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
934 if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) {
935 $h=0;
936 $midnight=1;
937 }
938 $z = "" if (! defined $h);
939 return "" if ($time && defined $h);
940 last PARSE;
941
942 } elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
943 /^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
944 # ISO 8601 Dates
945 # YYYYMMDD
946 # YYYYMM
947 # YYYY
948 # YY MMDD
949 # YY MM
950 # YY
951 ($y,$m,$d)=($1,$2,$3);
952 last PARSE;
953
954 } elsif (/^$YY\s+$D\s+$D/) {
955 # YY-M-D
956 ($y,$m,$d)=($1,$2,$3);
957 last PARSE;
958
959 } elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
960 # YY-W##-D
961 ($y,$wofm,$dofw)=($1,$2,$3);
[618]962 ($y,$m,$d)=_Date_NthWeekOfYear($y,$wofm,$dofw);
[360]963 last PARSE;
964
965 } elsif (/^$D4\s*(\d{3})$/ ||
966 /^$DD\s*(\d{3})$/) {
967 # YYDOY
968 ($y,$which)=($1,$2);
[618]969 ($y,$m,$d)=Date_NthDayOfYear($y,$which);
[360]970 last PARSE;
971
972 } elsif ($iso<0) {
973 # We confused something like 1999/August12:00:00
974 # with a dateTtime format
975 $_=$orig;
976
977 } else {
978 return "";
979 }
980 }
981
982 # All deltas that are not ISO-8601 dates are NOT dates.
983 return "" if ($Curr{"InCalc"} && $delta);
984 if ($delta) {
[618]985 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
986 return _DateCalc_DateDelta($Curr{"Now"},$delta);
[360]987 }
988
989 # Check for some special types of dates (next, prev)
990 foreach $from (keys %{ $Lang{$L}{"Repl"} }) {
991 $to=$Lang{$L}{"Repl"}{$from};
992 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
993 }
994 if (/$wom/i || /$future/i || /$later/i || /$past/i ||
995 /$next/i || /$prev/i || /^$week$/i || /$wkabb/i) {
996 $tmp=0;
997
998 if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
999 # last friday in October 95
1000 ($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
1001 # fix $m, $y
[618]1002 return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
[360]1003 $dofw=$week{lc($dofw)};
1004 $wofm=$wom{lc($wofm)};
1005 # Get the first day of the month
[618]1006 $date=_Date_Join($y,$m,1,$h,$mn,$s);
[360]1007 if ($wofm==-1) {
[618]1008 $date=_DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0);
1009 $date=Date_GetPrev($date,$dofw,0);
[360]1010 } else {
1011 for ($i=0; $i<$wofm; $i++) {
1012 if ($i==0) {
[618]1013 $date=Date_GetNext($date,$dofw,1);
[360]1014 } else {
[618]1015 $date=Date_GetNext($date,$dofw,0);
[360]1016 }
1017 }
1018 }
1019 last PARSE;
1020
1021 } elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
1022 # last day in month
1023 ($m,$y)=($1,$2);
[618]1024 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1025 $y=_Date_FixYear($y) if (! defined $y or length($y)<4);
[360]1026 $m=$month{lc($m)};
[618]1027 $d=Date_DaysInMonth($m,$y);
[360]1028 last PARSE;
1029
1030 } elsif (/^$week$/i) {
1031 # friday
1032 ($dofw)=($1);
[618]1033 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1034 $date=Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1);
1035 $date=Date_GetNext($date,$dofw,1,$h,$mn,$s);
[360]1036 last PARSE;
1037
1038 } elsif (/^$next\s*$week$/i) {
1039 # next friday
1040 ($dofw)=($1);
[618]1041 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1042 $date=Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s);
[360]1043 last PARSE;
1044
1045 } elsif (/^$prev\s*$week$/i) {
1046 # last friday
1047 ($dofw)=($1);
[618]1048 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1049 $date=Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s);
[360]1050 last PARSE;
1051
1052 } elsif (/^$next$wkabb$/i) {
1053 # next week
[618]1054 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1055 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0);
1056 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1057 last PARSE;
1058 } elsif (/^$prev$wkabb$/i) {
1059 # last week
[618]1060 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1061 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0);
1062 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1063 last PARSE;
1064
1065 } elsif (/^$next$mabb$/i) {
1066 # next month
[618]1067 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1068 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0);
1069 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1070 last PARSE;
1071 } elsif (/^$prev$mabb$/i) {
1072 # last month
[618]1073 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1074 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0);
1075 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1076 last PARSE;
1077
1078 } elsif (/^$future\s*(\d+)$day$/i ||
1079 /^(\d+)$day$later$/i) {
1080 # in 2 days
1081 # 2 days later
1082 ($num)=($1);
[618]1083 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1084 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0",
[360]1085 \$err,0);
[618]1086 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1087 last PARSE;
1088 } elsif (/^(\d+)$day$past$/i) {
1089 # 2 days ago
1090 ($num)=($1);
[618]1091 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1092 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0",
[360]1093 \$err,0);
[618]1094 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1095 last PARSE;
1096
1097 } elsif (/^$future\s*(\d+)$wkabb$/i ||
1098 /^(\d+)$wkabb$later$/i) {
1099 # in 2 weeks
1100 # 2 weeks later
1101 ($num)=($1);
[618]1102 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1103 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0",
[360]1104 \$err,0);
[618]1105 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1106 last PARSE;
1107 } elsif (/^(\d+)$wkabb$past$/i) {
1108 # 2 weeks ago
1109 ($num)=($1);
[618]1110 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1111 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0",
[360]1112 \$err,0);
[618]1113 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1114 last PARSE;
1115
1116 } elsif (/^$future\s*(\d+)$mabb$/i ||
1117 /^(\d+)$mabb$later$/i) {
1118 # in 2 months
1119 # 2 months later
1120 ($num)=($1);
[618]1121 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1122 $date=_DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0",
[360]1123 \$err,0);
[618]1124 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1125 last PARSE;
1126 } elsif (/^(\d+)$mabb$past$/i) {
1127 # 2 months ago
1128 ($num)=($1);
[618]1129 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1130 $date=_DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0",
[360]1131 \$err,0);
[618]1132 $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
[360]1133 last PARSE;
1134
1135 } elsif (/^$week$future\s*(\d+)$wkabb$/i ||
1136 /^$week\s*(\d+)$wkabb$later$/i) {
1137 # friday in 2 weeks
1138 # friday 2 weeks later
1139 ($dofw,$num)=($1,$2);
1140 $tmp="+";
1141 } elsif (/^$week\s*(\d+)$wkabb$past$/i) {
1142 # friday 2 weeks ago
1143 ($dofw,$num)=($1,$2);
1144 $tmp="-";
1145 } elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
1146 /^(\d+)$wkabb$later$on$week$/i) {
1147 # in 2 weeks on friday
1148 # 2 weeks later on friday
1149 ($num,$dofw)=($1,$2);
1150 $tmp="+"
1151 } elsif (/^(\d+)$wkabb$past$on$week$/i) {
1152 # 2 weeks ago on friday
1153 ($num,$dofw)=($1,$2);
1154 $tmp="-";
1155 } elsif (/^$week\s*$wkabb$/i) {
1156 # monday week (British date: in 1 week on monday)
1157 $dofw=$1;
1158 $num=1;
1159 $tmp="+";
1160 } elsif ( (/^$now\s*$wkabb$/i && ($tmp="Now")) ||
1161 (/^$today\s*$wkabb$/i && ($tmp="Today")) ) {
1162 # now week (British date: 1 week from now)
1163 # today week (British date: 1 week from today)
[618]1164 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1165 $date=_DateCalc_DateDelta($Curr{$tmp},"+0:0:1:0:0:0:0",\$err,0);
1166 $date=Date_SetTime($date,$h,$mn,$s) if ($time);
[360]1167 last PARSE;
1168 } elsif (/^$offset\s*$wkabb$/i) {
1169 # tomorrow week (British date: 1 week from tomorrow)
1170 ($offset)=($1);
[618]1171 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
[360]1172 $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
[618]1173 $date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1174 $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0);
[360]1175 if ($time) {
1176 return ""
[618]1177 if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1178 $date=Date_SetTime($date,$h,$mn,$s);
[360]1179 }
1180 last PARSE;
1181 }
1182
1183 if ($tmp) {
[618]1184 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1185 $date=_DateCalc_DateDelta($Curr{"Now"},
[360]1186 $tmp . "0:0:$num:0:0:0:0",\$err,0);
[618]1187 $date=Date_GetPrev($date,$Cnf{"FirstDay"},1);
1188 $date=Date_GetNext($date,$dofw,1,$h,$mn,$s);
[360]1189 last PARSE;
1190 }
1191 }
1192
1193 # Change (2nd, second) to 2
1194 $tmp=0;
1195 if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
1196 if (/^\s*$dom\s*$/) {
1197 ($d)=($1);
1198 $d=$dom{lc($d)};
1199 $m=$Curr{"M"};
1200 last PARSE;
1201 }
1202 my $from = $2;
1203 my $to = $dom{ lc($from) };
1204 s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
1205 s/^\s+//;
1206 s/\s+$//;
1207 }
1208
1209 # Another set of special dates (Nth week)
1210 if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
1211 # 22nd sunday in 1996
1212 ($which,$dofw,$y)=($1,$2,$3);
1213 $y=$Curr{"Y"} if (! $y);
1214 $y--; # previous year
[618]1215 $tmp=Date_GetNext("$y-12-31",$dofw,0);
[360]1216 if ($which>1) {
[618]1217 $tmp=_DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0);
[360]1218 }
[618]1219 ($y,$m,$d)=(_Date_Split($tmp, 1))[0..2];
[360]1220 last PARSE;
1221 } elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
1222 /^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
1223 # sunday week 22 in 1996
1224 # sunday 22nd week in 1996
1225 ($dofw,$which,$y)=($1,$2,$3);
[618]1226 ($y,$m,$d)=_Date_NthWeekOfYear($y,$which,$dofw);
[360]1227 last PARSE;
1228 }
1229
1230 # Get rid of day of week
1231 if (/(^|[^a-z])$week($|[^a-z])/i) {
1232 $wk=$2;
1233 (s/(^|[^a-z])$week,/$1 /i) ||
1234 s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
1235 s/^\s+//;
1236 s/\s+$//;
1237 }
1238
1239 {
1240 # So that we can handle negative epoch times, let's convert
1241 # things like "epoch -" to "epochNEGATIVE " before we strip out
1242 # the $sep chars, which include '-'.
1243 s,epoch\s*-,epochNEGATIVE ,g;
1244
1245 # Non-ISO8601 dates
1246 s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces
1247 s,^\s*,,; # remove leading/trailing space
1248 s,\s*$,,;
1249
1250 if (/^$D\s+$D(?:\s+$YY)?$/) {
1251 # MM DD YY (DD MM YY non-US)
1252 ($m,$d,$y)=($1,$2,$3);
1253 ($m,$d)=($d,$m) if ($type ne "US");
1254 last PARSE;
1255
1256 } elsif (/^$D4\s*$D\s*$D$/) {
1257 # YYYY MM DD
1258 ($y,$m,$d)=($1,$2,$3);
1259 last PARSE;
1260
1261 } elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
1262 ($m)=($2);
1263
1264 if (/^\s*$D(?:\s+$YY)?\s*$/) {
1265 # mmm DD YY
1266 # DD mmm YY
1267 # DD YY mmm
1268 ($d,$y)=($1,$2);
1269 last PARSE;
1270
1271 } elsif (/^\s*$D$D4\s*$/) {
1272 # mmm DD YYYY
1273 # DD mmm YYYY
1274 # DD YYYY mmm
1275 ($d,$y)=($1,$2);
1276 last PARSE;
1277
1278 } elsif (/^\s*$D4\s*$D\s*$/) {
1279 # mmm YYYY DD
1280 # YYYY mmm DD
1281 # YYYY DD mmm
1282 ($y,$d)=($1,$2);
1283 last PARSE;
1284
1285 } elsif (/^\s*$D4\s*$/) {
1286 # mmm YYYY
1287 # YYYY mmm
1288 ($y,$d)=($1,1);
1289 last PARSE;
1290
1291 } else {
1292 return "";
1293 }
1294
1295 } elsif (/^epochNEGATIVE (\d+)$/) {
1296 $s=$1;
[618]1297 $date=DateCalc("1970-01-01 00:00 GMT","-0:0:$s");
[360]1298 } elsif (/^epoch\s*(\d+)$/i) {
1299 $s=$1;
[618]1300 $date=DateCalc("1970-01-01 00:00 GMT","+0:0:$s");
[360]1301
1302 } elsif ( (/^$now$/i && ($tmp="Now")) ||
1303 (/^$today$/i && ($tmp="Today")) ) {
1304 # now, today
[618]1305 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
[360]1306 $date=$Curr{$tmp};
1307 if ($time) {
1308 return ""
[618]1309 if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1310 $date=Date_SetTime($date,$h,$mn,$s);
[360]1311 }
1312 last PARSE;
1313
1314 } elsif (/^$offset$/i) {
1315 # yesterday, tomorrow
1316 ($offset)=($1);
[618]1317 Date_Init() if (! $Cnf{"UpdateCurrTZ"});
[360]1318 $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
[618]1319 $date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
[360]1320 if ($time) {
1321 return ""
[618]1322 if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1323 $date=Date_SetTime($date,$h,$mn,$s);
[360]1324 }
1325 last PARSE;
1326
1327 } else {
1328 return "";
1329 }
1330 }
1331 }
1332
1333 if (! $date) {
[618]1334 return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1335 $date=_Date_Join($y,$m,$d,$h,$mn,$s);
[360]1336 }
[618]1337 $date=Date_ConvTZ($date,$z);
[360]1338 if ($midnight) {
[618]1339 $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0");
[360]1340 }
1341 return $date;
1342}
1343
1344sub ParseDate {
1345 print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
[618]1346 Date_Init() if (! $Curr{"InitDone"});
[360]1347 my($args,@args,@a,$ref,$date)=();
1348 @a=@_;
1349
1350 # @a : is the list of args to ParseDate. Currently, only one argument
1351 # is allowed and it must be a scalar (or a reference to a scalar)
1352 # or a reference to an array.
1353
1354 if ($#a!=0) {
1355 print "ERROR: Invalid number of arguments to ParseDate.\n";
1356 return "";
1357 }
1358 $args=$a[0];
1359 $ref=ref $args;
1360 if (! $ref) {
[618]1361 return $args if (_Date_Split($args));
[360]1362 @args=($args);
1363 } elsif ($ref eq "ARRAY") {
1364 @args=@$args;
1365 } elsif ($ref eq "SCALAR") {
[618]1366 return $$args if (_Date_Split($$args));
[360]1367 @args=($$args);
1368 } else {
1369 print "ERROR: Invalid arguments to ParseDate.\n";
1370 return "";
1371 }
1372 @a=@args;
1373
1374 # @args : a list containing all the arguments (dereferenced if appropriate)
1375 # @a : a list containing all the arguments currently being examined
1376 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1377 # reference to a scalar, or a reference to an array was passed in
1378 # $args : the scalar or refererence passed in
1379
1380 PARSE: while($#a>=0) {
1381 $date=join(" ",@a);
[618]1382 $date=ParseDateString($date);
[360]1383 last if ($date);
1384 pop(@a);
1385 } # PARSE
1386
1387 splice(@args,0,$#a + 1);
1388 @$args= @args if (defined $ref and $ref eq "ARRAY");
1389 $date;
1390}
1391
1392sub Date_Cmp {
1393 my($D1,$D2)=@_;
[618]1394 my($date1)=ParseDateString($D1);
1395 my($date2)=ParseDateString($D2);
[360]1396 return $date1 cmp $date2;
1397}
1398
1399# **NOTE**
1400# The calc routines all call parse routines, so it is never necessary to
1401# call Date_Init in the calc routines.
1402sub DateCalc {
1403 print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
1404 my($D1,$D2,@arg)=@_;
1405 my($ref,$err,$errref,$mode)=();
1406
1407 ($errref,$mode) = (@arg);
1408 $ref=0;
1409
1410 if (defined $errref) {
1411 if (ref $errref) {
1412 $ref=1;
1413 } elsif (! defined $mode) {
1414 $mode=$errref;
1415 $errref="";
1416 }
1417 }
1418
1419 my(@date,@delta,$ret,$tmp,$oldincalc,$oldmode)=();
1420
1421 if (exists $Curr{"Mode"}) {
1422 $oldmode = $Curr{"Mode"};
1423 } else {
1424 $oldmode = 0;
1425 }
1426
1427 if (defined $mode and $mode>=0 and $mode<=3) {
1428 $Curr{"Mode"}=$mode;
1429 } else {
1430 $Curr{"Mode"}=0;
1431 }
1432
1433 if (exists $Curr{"InCalc"}) {
1434 $oldincalc = $Curr{"InCalc"};
1435 } else {
1436 $oldincalc = 0;
1437 }
1438 $Curr{"InCalc"}=1;
1439
[618]1440 if ($tmp=ParseDateString($D1)) {
[360]1441 # If we've already parsed the date, we don't want to do it a second
1442 # time (so we don't convert timezones twice).
[618]1443 if (_Date_Split($D1)) {
[360]1444 push(@date,$D1);
1445 } else {
1446 push(@date,$tmp);
1447 }
[618]1448 } elsif ($tmp=ParseDateDelta($D1)) {
[360]1449 push(@delta,$tmp);
1450 } else {
1451 $$errref=1 if ($ref);
1452 $Curr{"InCalc"} = $oldincalc;
1453 $Curr{"Mode"} = $oldmode;
1454 return;
1455 }
1456
[618]1457 if ($tmp=ParseDateString($D2)) {
1458 if (_Date_Split($D2)) {
[360]1459 push(@date,$D2);
1460 } else {
1461 push(@date,$tmp);
1462 }
[618]1463 } elsif ($tmp=ParseDateDelta($D2)) {
[360]1464 push(@delta,$tmp);
1465 $mode = $Curr{"Mode"};
1466 } else {
1467 $$errref=2 if ($ref);
1468 $Curr{"InCalc"} = $oldincalc;
1469 $Curr{"Mode"} = $oldmode;
1470 return;
1471 }
1472
1473 $Curr{"InCalc"} = $oldincalc;
1474 $Curr{"Mode"} = $oldmode;
1475
1476 if ($#date==1) {
[618]1477 $ret=_DateCalc_DateDate(@date,$mode);
[360]1478 } elsif ($#date==0) {
[618]1479 $ret=_DateCalc_DateDelta(@date,@delta,\$err,$mode);
[360]1480 $$errref=$err if ($ref);
1481 } else {
[618]1482 $ret=_DateCalc_DeltaDelta(@delta,$mode);
[360]1483 }
1484 $ret;
1485}
1486
1487sub ParseDateDelta {
1488 print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
1489 my($args,@args,@a,$ref)=();
1490 local($_)=();
1491 @a=@_;
1492
1493 # @a : is the list of args to ParseDateDelta. Currently, only one argument
1494 # is allowed and it must be a scalar (or a reference to a scalar)
1495 # or a reference to an array.
1496
1497 if ($#a!=0) {
1498 print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
1499 return "";
1500 }
1501 $args=$a[0];
1502 $ref=ref $args;
1503 if (! $ref) {
1504 @args=($args);
1505 } elsif ($ref eq "ARRAY") {
1506 @args=@$args;
1507 } elsif ($ref eq "SCALAR") {
1508 @args=($$args);
1509 } else {
1510 print "ERROR: Invalid arguments to ParseDateDelta.\n";
1511 return "";
1512 }
1513 @a=@args;
1514
1515 # @args : a list containing all the arguments (dereferenced if appropriate)
1516 # @a : a list containing all the arguments currently being examined
1517 # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1518 # reference to a scalar, or a reference to an array was passed in
1519 # $args : the scalar or refererence passed in
1520
1521 my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=();
1522 my($len,$tmp,$tmp2,$tmpl)=();
1523 my($from,$to)=();
1524 my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1;
1525
[618]1526 Date_Init() if (! $Curr{"InitDone"});
[360]1527 # A sign can be a sequence of zero or more + and - signs, this
1528 # allows for deltas like '+ -2 days'.
1529 my($signexp)='((?:[+-]\s*)*)';
1530 my($numexp)='(\d+)';
1531 my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)";
1532 my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=();
1533 $yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()";
1534 $yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?";
1535 $mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?";
1536 $wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?";
1537 $dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?";
1538 $hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?";
1539 $mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?";
1540 $sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?";
1541 my($future)=$Lang{$Cnf{"Language"}}{"Future"};
1542 my($later)=$Lang{$Cnf{"Language"}}{"Later"};
1543 my($past)=$Lang{$Cnf{"Language"}}{"Past"};
1544
1545 $delta="";
1546 PARSE: while (@a) {
1547 $_ = join(" ", grep {defined;} @a);
1548 s/\s+$//;
1549 last if ($_ eq "");
1550
1551 # Mode is set in DateCalc. ParseDateDelta only overrides it if the
1552 # string contains a mode.
1553 if ($Lang{$Cnf{"Language"}}{"Exact"} &&
1554 s/$Lang{$Cnf{"Language"}}{"Exact"}//) {
1555 $Curr{"Mode"}=0;
1556 } elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
1557 s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
1558 $Curr{"Mode"}=1;
1559 } elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
1560 s/$Lang{$Cnf{"Language"}}{"Business"}//) {
1561 $Curr{"Mode"}=2;
1562 } elsif (! exists $Curr{"Mode"}) {
1563 $Curr{"Mode"}=0;
1564 }
1565 $workweek=7 if ($Curr{"Mode"} != 2);
1566
1567 foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) {
1568 $to=$Lang{$Cnf{"Language"}}{"Repl"}{$from};
1569 s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
1570 }
1571
1572 # in or ago
1573 #
1574 # We need to make sure that $later, $future, and $past don't contain each
1575 # other... Romanian pointed this out where $past is "in urma" and $future
1576 # is "in". When they do, we have to take this into account.
1577 # $len length of best match (greatest wins)
1578 # $tmp string after best match
1579 # $dir direction (prior, after) of best match
1580 #
1581 # $tmp2 string before/after current match
1582 # $tmpl length of current match
1583
1584 $len=0;
1585 $tmp=$_;
1586 $dir=1;
1587
1588 $tmp2=$_;
1589 if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
1590 $tmpl=length($2);
1591 if ($tmpl>$len) {
1592 $tmp=$tmp2;
1593 $dir=1;
1594 $len=$tmpl;
1595 }
1596 }
1597
1598 $tmp2=$_;
1599 if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
1600 $tmpl=length($2);
1601 if ($tmpl>$len) {
1602 $tmp=$tmp2;
1603 $dir=1;
1604 $len=$tmpl;
1605 }
1606 }
1607
1608 $tmp2=$_;
1609 if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
1610 $tmpl=length($2);
1611 if ($tmpl>$len) {
1612 $tmp=$tmp2;
1613 $dir=-1;
1614 $len=$tmpl;
1615 }
1616 }
1617
1618 $_ = $tmp;
1619 s/\s*$//;
1620
1621 # the colon part of the delta
1622 $colon="";
1623 if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
1624 $colon=$1;
1625 s/\s+$//;
1626 }
1627 @colon=split(/:/,$colon);
1628
1629 # the non-colon part of the delta
1630 $sign="+";
1631 @delta=();
1632 $i=6;
1633 foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
1634 last if ($#colon>=$i--);
1635 $val=0;
1636 if (s/^$exp1//ix) {
1637 $val=$2 if ($2);
1638 $sign=$1 if ($1);
1639 }
1640
1641 # Collapse a sign like '+ -' into a single character like '-',
1642 # by counting the occurrences of '-'.
1643 #
1644 $sign =~ s/\s+//g;
1645 $sign =~ tr/+//d;
1646 my $count = ($sign =~ tr/-//d);
1647 die "bad characters in sign: $sign" if length $sign;
1648 $sign = $count % 2 ? '-' : '+';
1649
1650 push(@delta,"$sign$val");
1651 }
1652 if (! /^\s*$/) {
1653 pop(@a);
1654 next PARSE;
1655 }
1656
1657 # make sure that the colon part has a sign
1658 for ($i=0; $i<=$#colon; $i++) {
1659 $val=0;
1660 if ($colon[$i] =~ /^$signexp$numexp?/) {
1661 $val=$2 if ($2);
1662 $sign=$1 if ($1);
1663 }
1664 $colon[$i] = "$sign$val";
1665 }
1666
1667 # combine the two
1668 push(@delta,@colon);
1669 if ($dir<0) {
1670 for ($i=0; $i<=$#delta; $i++) {
1671 $delta[$i] =~ tr/-+/+-/;
1672 }
1673 }
1674
1675 # form the delta and shift off the valid part
1676 $delta=join(":",@delta);
1677 splice(@args,0,$#a+1);
1678 @$args=@args if (defined $ref and $ref eq "ARRAY");
1679 last PARSE;
1680 }
1681
[618]1682 $delta=_Delta_Normalize($delta,$Curr{"Mode"});
[360]1683 return $delta;
1684}
1685
1686sub UnixDate {
1687 print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
1688 my($date,@format)=@_;
1689 local($_)=();
1690 my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
1691 my($scalar)=();
[618]1692 $date=ParseDateString($date);
[360]1693 return if (! $date);
1694
1695 my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
[618]1696 _Date_Split($date, 1);
[360]1697 $f{"y"}=substr $f{"Y"},2;
[618]1698 Date_Init() if (! $Curr{"InitDone"});
[360]1699
1700 if (! wantarray) {
1701 $format=join(" ",@format);
1702 @format=($format);
1703 $scalar=1;
1704 }
1705
1706 # month, week
1707 $_=$m;
1708 s/^0//;
1709 $f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
1710 $f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
1711 $_=$m;
1712 s/^0/ /;
1713 $f{"f"}=$_;
[618]1714 $f{"U"}=Date_WeekOfYear($m,$d,$y,7);
1715 $f{"W"}=Date_WeekOfYear($m,$d,$y,1);
[360]1716
1717 # check week 52,53 and 0
1718 $f{"G"}=$f{"L"}=$y;
1719 if ($f{"W"}>=52 || $f{"U"}>=52) {
1720 my($dd,$mm,$yy)=($d,$m,$y);
1721 $dd+=7;
1722 if ($dd>31) {
1723 $dd-=31;
1724 $mm=1;
1725 $yy++;
[618]1726 if (Date_WeekOfYear($mm,$dd,$yy,1)==2) {
[360]1727 $f{"G"}=$yy;
1728 $f{"W"}=1;
1729 }
[618]1730 if (Date_WeekOfYear($mm,$dd,$yy,7)==2) {
[360]1731 $f{"L"}=$yy;
1732 $f{"U"}=1;
1733 }
1734 }
1735 }
1736 if ($f{"W"}==0) {
1737 my($dd,$mm,$yy)=($d,$m,$y);
1738 $dd-=7;
1739 $dd+=31 if ($dd<1);
1740 $yy = sprintf "%04d", $yy-1;
1741 $mm=12;
1742 $f{"G"}=$yy;
[618]1743 $f{"W"}=Date_WeekOfYear($mm,$dd,$yy,1)+1;
[360]1744 }
1745 if ($f{"U"}==0) {
1746 my($dd,$mm,$yy)=($d,$m,$y);
1747 $dd-=7;
1748 $dd+=31 if ($dd<1);
1749 $yy = sprintf "%04d", $yy-1;
1750 $mm=12;
1751 $f{"L"}=$yy;
[618]1752 $f{"U"}=Date_WeekOfYear($mm,$dd,$yy,7)+1;
[360]1753 }
1754
1755 $f{"U"}="0".$f{"U"} if (length $f{"U"} < 2);
1756 $f{"W"}="0".$f{"W"} if (length $f{"W"} < 2);
1757
1758 # day
[618]1759 $f{"j"}=Date_DayOfYear($m,$d,$y);
[360]1760 $f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
1761 $_=$d;
1762 s/^0/ /;
1763 $f{"e"}=$_;
[618]1764 $f{"w"}=Date_DayOfWeek($m,$d,$y);
[360]1765 $f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1];
1766 $f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2);
1767 $f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1];
1768 $f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1];
[618]1769 $f{"E"}=Date_DaySuffix($f{"e"});
[360]1770
1771 # hour
1772 $_=$h;
1773 s/^0/ /;
1774 $f{"k"}=$_;
1775 $f{"i"}=$f{"k"}+1;
1776 $f{"i"}=$f{"k"};
1777 $f{"i"}=12 if ($f{"k"}==0);
1778 $f{"i"}=$f{"k"}-12 if ($f{"k"}>12);
1779 $f{"i"}=$f{"i"}-12 if ($f{"i"}>12);
1780 $f{"i"}=" ".$f{"i"} if (length($f{"i"})<2);
1781 $f{"I"}=$f{"i"};
1782 $f{"I"}=~ s/^ /0/;
1783 $f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"};
1784 $f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11);
1785
1786 # minute, second, timezone
[618]1787 $f{"o"}=Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
1788 $f{"s"}=Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s);
[360]1789 $f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ?
1790 $Cnf{"TZ"} : $Cnf{"ConvTZ"};
1791 $f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || "");
1792
1793 # date, time
1794 $f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
1795 $f{"C"}=$f{"u"}=
1796 qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|;
1797 $f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|;
1798 $f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|;
1799 $f{"x"}=qq|$d/$m/$f{"y"}| if ($Cnf{"DateFormat"} ne "US");
1800 $f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|;
1801 $f{"R"}=qq|$h:$mn|;
1802 $f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
1803 $f{"V"}=qq|$m$d$h$mn$f{"y"}|;
1804 $f{"Q"}="$y$m$d";
1805 $f{"q"}=qq|$y$m$d$h$mn$s|;
1806 $f{"P"}=qq|$y$m$d$h:$mn:$s|;
1807 $f{"O"}=qq|$y-$m-${d}T$h:$mn:$s|;
1808 $f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|;
1809 if ($f{"W"}==0) {
1810 $y--;
[618]1811 $tmp=Date_WeekOfYear(12,31,$y,1);
[360]1812 $tmp="0$tmp" if (length($tmp) < 2);
1813 $f{"J"}=qq|$y-W$tmp-$f{"w"}|;
1814 } else {
1815 $f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|;
1816 }
1817 $f{"K"}=qq|$y-$f{"j"}|;
1818 # %l is a special case. Since it requires the use of the calculator
1819 # which requires this routine, an infinite recursion results. To get
1820 # around this, %l is NOT determined every time this is called so the
1821 # recursion breaks.
1822
1823 # other formats
1824 $f{"n"}="\n";
1825 $f{"t"}="\t";
1826 $f{"%"}="%";
1827 $f{"+"}="+";
1828
1829 foreach $format (@format) {
1830 $format=reverse($format);
1831 $out="";
1832 while ($format ne "") {
1833 $c=chop($format);
1834 if ($c eq "%") {
1835 $c=chop($format);
1836 if ($c eq "l") {
[618]1837 Date_Init();
1838 $date1=_DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0");
1839 $date2=_DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0");
1840 if (Date_Cmp($date,$date1)>=0 && Date_Cmp($date,$date2)<=0) {
[360]1841 $f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|;
1842 } else {
1843 $f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
1844 }
1845 $out .= $f{"$c"};
1846 } elsif (exists $f{"$c"}) {
1847 $out .= $f{"$c"};
1848 } else {
1849 $out .= $c;
1850 }
1851 } else {
1852 $out .= $c;
1853 }
1854 }
1855 push(@out,$out);
1856 }
1857 if ($scalar) {
1858 return $out[0];
1859 } else {
1860 return (@out);
1861 }
1862}
1863
1864# Can't be in "use integer" because we're doing decimal arithmatic
1865no integer;
1866sub Delta_Format {
1867 print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
1868 my($delta,@arg)=@_;
1869 my($mode);
1870 if (lc($arg[0]) eq "approx") {
1871 $mode = "approx";
1872 shift(@arg);
1873 } else {
1874 $mode = "exact";
1875 }
1876 my($dec,@format) = @arg;
1877
[618]1878 $delta=ParseDateDelta($delta);
[360]1879 return "" if (! $delta);
1880 my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
1881 local($_)=$delta;
[618]1882 my($y,$M,$w,$d,$h,$m,$s)=_Delta_Split($delta);
[360]1883 # Get rid of positive signs.
1884 ($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s);
1885
1886 if (defined $dec && $dec>0) {
1887 $dec="%." . ($dec*1) . "f";
1888 } else {
1889 $dec="%f";
1890 }
1891
1892 if (! wantarray) {
1893 $format=join(" ",@format);
1894 @format=($format);
1895 $scalar=1;
1896 }
1897
1898 # Length of each unit in seconds
1899 my($sl,$ml,$hl,$dl,$wl,$Ml,$yl)=();
1900 $sl = 1;
1901 $ml = $sl*60;
1902 $hl = $ml*60;
1903 $dl = $hl*24;
1904 $wl = $dl*7;
1905 $yl = $dl*365.25;
1906 $Ml = $yl/12;
1907
1908 # The decimal amount of each unit contained in all smaller units
1909 my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
1910 if ($mode eq "exact") {
1911 $yd = $M/12;
1912 $Md = 0;
1913 } else {
1914 $yd = ($M*$Ml + $w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
1915 $Md = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$Ml;
1916 }
1917
1918 $wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
1919 $dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
1920 $hd = ($m*$ml + $s*$sl)/$hl;
1921 $md = ($s*$sl)/$ml;
1922 $sd = 0;
1923
1924 # The amount of each unit contained in higher units.
1925 my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
1926 $yh = 0;
1927 $Mh = ($yh+$y)*12;
1928
1929 if ($mode eq "exact") {
1930 $wh = 0;
1931 $dh = ($wh+$w)*7;
1932 } else {
1933 $wh = ($yh+$y+$M/12)*365.25/7;
1934 $dh = ($wh+$w)*7;
1935 }
1936
1937 $hh = ($dh+$d)*24;
1938 $mh = ($hh+$h)*60;
1939 $sh = ($mh+$m)*60;
1940
1941 # Set up the formats
1942
1943 $f{"yv"} = $y;
1944 $f{"Mv"} = $M;
1945 $f{"wv"} = $w;
1946 $f{"dv"} = $d;
1947 $f{"hv"} = $h;
1948 $f{"mv"} = $m;
1949 $f{"sv"} = $s;
1950
1951 $f{"yh"} = $y+$yh;
1952 $f{"Mh"} = $M+$Mh;
1953 $f{"wh"} = $w+$wh;
1954 $f{"dh"} = $d+$dh;
1955 $f{"hh"} = $h+$hh;
1956 $f{"mh"} = $m+$mh;
1957 $f{"sh"} = $s+$sh;
1958
1959 $f{"yd"} = sprintf($dec,$y+$yd);
1960 $f{"Md"} = sprintf($dec,$M+$Md);
1961 $f{"wd"} = sprintf($dec,$w+$wd);
1962 $f{"dd"} = sprintf($dec,$d+$dd);
1963 $f{"hd"} = sprintf($dec,$h+$hd);
1964 $f{"md"} = sprintf($dec,$m+$md);
1965 $f{"sd"} = sprintf($dec,$s+$sd);
1966
1967 $f{"yt"} = sprintf($dec,$yh+$y+$yd);
1968 $f{"Mt"} = sprintf($dec,$Mh+$M+$Md);
1969 $f{"wt"} = sprintf($dec,$wh+$w+$wd);
1970 $f{"dt"} = sprintf($dec,$dh+$d+$dd);
1971 $f{"ht"} = sprintf($dec,$hh+$h+$hd);
1972 $f{"mt"} = sprintf($dec,$mh+$m+$md);
1973 $f{"st"} = sprintf($dec,$sh+$s+$sd);
1974
1975 $f{"%"} = "%";
1976
1977 foreach $format (@format) {
1978 $format=reverse($format);
1979 $out="";
1980 PARSE: while ($format) {
1981 $c1=chop($format);
1982 if ($c1 eq "%") {
1983 $c1=chop($format);
1984 if (exists($f{$c1})) {
1985 $out .= $f{$c1};
1986 next PARSE;
1987 }
1988 $c2=chop($format);
1989 if (exists($f{"$c1$c2"})) {
1990 $out .= $f{"$c1$c2"};
1991 next PARSE;
1992 }
1993 $out .= $c1;
1994 $format .= $c2;
1995 } else {
1996 $out .= $c1;
1997 }
1998 }
1999 push(@out,$out);
2000 }
2001 if ($scalar) {
2002 return $out[0];
2003 } else {
2004 return (@out);
2005 }
2006}
2007use integer;
2008
2009sub ParseRecur {
2010 print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
[618]2011 Date_Init() if (! $Curr{"InitDone"});
[360]2012
2013 my($recur,$dateb,$date0,$date1,$flag)=@_;
2014 local($_)=$recur;
2015
2016 my($recur_0,$recur_1,@recur0,@recur1)=();
2017 my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=();
2018 my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=();
2019
2020 # $date0, $date1, $dateb, $flag : passed in (these are always the final say
2021 # in determining whether a date matches a
2022 # recurrence IF they are present.
2023 # $date_b, $date_0, $date_1 : if a value can be determined from the
2024 # $flag_t recurrence, they are stored here.
2025 #
2026 # If values can be determined from the recurrence AND are passed in, the
2027 # following are used:
2028 # max($date0,$date_0) i.e. the later of the two dates
2029 # min($date1,$date_1) i.e. the earlier of the two dates
2030 #
2031 # The base date that is used is the first one defined from
2032 # $dateb $date_b
2033 # The base date is only used if necessary (as determined by the recur).
2034 # For example, "every other friday" requires a base date, but "2nd
2035 # friday of every month" doesn't.
2036
2037 my($date_b,$date_0,$date_1,$flag_t);
2038
2039 #
2040 # Check the arguments passed in.
2041 #
2042
2043 $date0="" if (! defined $date0);
2044 $date1="" if (! defined $date1);
2045 $dateb="" if (! defined $dateb);
2046 $flag ="" if (! defined $flag);
2047
2048 if ($dateb) {
[618]2049 $dateb=ParseDateString($dateb);
[360]2050 return "" if (! $dateb);
2051 }
2052 if ($date0) {
[618]2053 $date0=ParseDateString($date0);
[360]2054 return "" if (! $date0);
2055 }
2056 if ($date1) {
[618]2057 $date1=ParseDateString($date1);
[360]2058 return "" if (! $date1);
2059 }
2060
2061 #
2062 # Parse the recur. $date_b, $date_0, and $date_e are values obtained
2063 # from the recur.
2064 #
2065
[618]2066 @tmp=_Recur_Split($_);
[360]2067
2068 if (@tmp) {
2069 ($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp;
2070 $recur_0 = "" if (! defined $recur_0);
2071 $recur_1 = "" if (! defined $recur_1);
2072 $flag_t = "" if (! defined $flag_t);
2073 $date_b = "" if (! defined $date_b);
2074 $date_0 = "" if (! defined $date_0);
2075 $date_1 = "" if (! defined $date_1);
2076
2077 @recur0 = split(/:/,$recur_0);
2078 @recur1 = split(/:/,$recur_1);
2079 return "" if ($#recur0 + $#recur1 + 2 != 7);
2080
2081 if ($date_b) {
[618]2082 $date_b=ParseDateString($date_b);
[360]2083 return "" if (! $date_b);
2084 }
2085 if ($date_0) {
[618]2086 $date_0=ParseDateString($date_0);
[360]2087 return "" if (! $date_0);
2088 }
2089 if ($date_1) {
[618]2090 $date_1=ParseDateString($date_1);
[360]2091 return "" if (! $date_1);
2092 }
2093
2094 } else {
2095
2096 my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...)
2097 my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... }
2098 my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...)
2099 my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... }
2100 my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days)
2101 my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months)
2102 my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks)
2103 my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st)
2104 my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} };
2105 # { 1st=>1,first=>1,...}
2106 my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of)
2107 my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last)
2108 my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every)
2109
2110 my($D)='\s*(\d+)';
2111 my($Y)='\s*(\d{4}|\d{2})';
2112
2113 # Change 1st to 1
2114 if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
2115 $tmp=lc($2);
2116 $tmp=$dayshash{"$tmp"};
2117 s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
2118 }
2119 s/\s*$//;
2120
2121 # Get rid of "each"
2122 if (/(^|[^a-z])$each($|[^a-z])/i) {
2123 s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
2124 $each=1;
2125 } else {
2126 $each=0;
2127 }
2128
2129 if ($each) {
2130
2131 if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
2132 /^$D?$day(?:$of$mmm())?$/i) {
2133 # every [2nd] day in [june] 1997
2134 # every [2nd] day [in june]
2135 ($num,$m,$y)=($1,$2,$3);
2136 $num=1 if (! defined $num);
2137 $m="" if (! defined $m);
2138 $y="" if (! defined $y);
2139
2140 $y=$Curr{"Y"} if (! $y);
2141 if ($m) {
2142 $m=$mmm{lc($m)};
[618]2143 $date_0=_Date_Join($y,$m,1,0,0,0);
2144 $date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
[360]2145 } else {
[618]2146 $date_0=_Date_Join($y, 1,1,0,0,0);
2147 $date_1=_Date_Join($y+1,1,1,0,0,0);
[360]2148 }
[618]2149 $date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0);
[360]2150 @recur0=(0,0,0,$num,0,0,0);
2151 @recur1=();
2152
2153 } elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
2154 # 2nd [day] of every month [in 1997]
2155 ($num,$y)=($1,$2);
2156 $y=$Curr{"Y"} if (! $y);
2157
[618]2158 $date_0=_Date_Join($y, 1,1,0,0,0);
2159 $date_1=_Date_Join($y+1,1,1,0,0,0);
[360]2160 $date_b=$date_0;
2161
2162 @recur0=(0,1,0);
2163 @recur1=($num,0,0,0);
2164
2165 } elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ ||
2166 /^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) {
2167 # 2nd tuesday of every month [in 1997]
2168 # last tuesday of every month [in 1997]
2169 ($num,$d,$y)=($1,$2,$3);
2170 $y=$Curr{"Y"} if (! $y);
2171 $d=$week{lc($d)};
2172 $num=-1 if ($num !~ /^$D$/);
2173
[618]2174 $date_0=_Date_Join($y,1,1,0,0,0);
2175 $date_1=_Date_Join($y+1,1,1,0,0,0);
[360]2176 $date_b=$date_0;
2177
2178 @recur0=(0,1);
2179 @recur1=($num,$d,0,0,0);
2180
2181 } elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i ||
2182 /^$D?$wkexp(?:$of$mmm())?$/i) {
2183 # every tuesday in june 1997
2184 # every 2nd tuesday in june 1997
2185 ($num,$d,$m,$y)=($1,$2,$3,$4);
2186 $y=$Curr{"Y"} if (! $y);
2187 $num=1 if (! defined $num);
2188 $m="" if (! defined $m);
2189 $d=$week{lc($d)};
2190
2191 if ($m) {
2192 $m=$mmm{lc($m)};
[618]2193 $date_0=_Date_Join($y,$m,1,0,0,0);
2194 $date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
[360]2195 } else {
[618]2196 $date_0=_Date_Join($y,1,1,0,0,0);
2197 $date_1=_Date_Join($y+1,1,1,0,0,0);
[360]2198 }
[618]2199 $date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0);
[360]2200
2201 @recur0=(0,0,$num);
2202 @recur1=($d,0,0,0);
2203
2204 } else {
2205 return "";
2206 }
2207
2208 $date_0="" if ($date0);
2209 $date_1="" if ($date1);
2210 } else {
2211 return "";
2212 }
2213 }
2214
2215 #
2216 # Override with any values passed in
2217 #
2218
2219 $date0 = $date_0 if (! $date0);
2220 $date1 = $date_1 if (! $date1);
2221 $dateb = $date_b if (! $dateb);
2222 if ($flag =~ s/^\+//) {
2223 $flag = "$flag_t,$flag" if ($flag_t);
2224 }
2225 $flag = $flag_t if (! $flag);
2226 $flag = "" if (! $flag);
2227
2228 if (! wantarray) {
2229 $tmp = join(":",@recur0);
2230 $tmp .= "*" . join(":",@recur1) if (@recur1);
2231 $tmp .= "*$flag*$dateb*$date0*$date1";
2232 return $tmp;
2233 }
2234 if (@recur0) {
2235 return () if (! $date0 || ! $date1); # dateb is NOT required in all case
2236 }
2237
2238 #
2239 # Some flags affect parsing.
2240 #
2241
2242 @flags = split(/,/,$flag);
2243 my($f);
2244 foreach $f (@flags) {
2245 if ($f =~ /^EASTER$/i) {
2246 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2247 # We want something that will return Jan 1 for the given years.
2248 if ($#recur0==-1) {
2249 @recur1=($y,1,0,1,$h,$mn,$s);
2250 } elsif ($#recur0<=3) {
2251 @recur0=($y,0,0,0);
2252 @recur1=($h,$mn,$s);
2253 } elsif ($#recur0==4) {
2254 @recur0=($y,0,0,0,0);
2255 @recur1=($mn,$s);
2256 } elsif ($#recur0==5) {
2257 @recur0=($y,0,0,0,0,0);
2258 @recur1=($s);
2259 } else {
2260 @recur0=($y,0,0,0,0,0,0);
2261 }
2262 }
2263 }
2264
2265 #
2266 # Determine the dates referenced by the recur. Also, fix the base date
2267 # as necessary for the recurrences which require it.
2268 #
2269
2270 ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2271 @y=@m=@w=@d=();
2272 my(@time)=($h,$mn,$s);
2273
2274 RECUR: while (1) {
2275
2276 if ($#recur0==-1) {
2277 # * 0-M-W-D-H-MN-S => 0 * M-W-D-H-MN-S
2278
2279 if ($y eq "0") {
2280 push(@recur0,1);
2281 shift(@recur1);
2282 next RECUR;
2283 }
2284
2285 # Y-M-W-D-H-MN-S
2286
[618]2287 @y=_ReturnList($y);
[360]2288 foreach $y (@y) {
[618]2289 $y=_Date_FixYear($y) if (length($y)==2);
2290 return () if (length($y)!=4 || ! _IsInt($y));
[360]2291 }
2292
[618]2293 $date0=ParseDate("0000-01-01") if (! $date0);
2294 $date1=ParseDate("9999-12-31 23:59:59") if (! $date1);
[360]2295
2296 if ($m eq "0" and $w eq "0") {
2297
2298 # * Y-0-0-0-H-MN-S
2299 # * Y-0-0-DOY-H-MN-S
2300
2301 if ($d eq "0") {
2302 @d=(1);
2303 } else {
[618]2304 @d=_ReturnList($d);
[360]2305 return () if (! @d);
2306 foreach $d (@d) {
[618]2307 return () if (! _IsInt($d,-366,366) || $d==0);
[360]2308 }
2309 }
2310
2311 @date=();
2312 foreach $yy (@y) {
[618]2313 my $diy = Date_DaysInYear($yy);
[360]2314 foreach $d (@d) {
2315 my $tmpd = $d;
2316 $tmpd += ($diy+1) if ($tmpd < 0);
[618]2317 next if (! _IsInt($tmpd,1,$diy));
2318 ($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd);
2319 push(@date, _Date_Join($y,$m,$dd,0,0,0));
[360]2320 }
2321 }
2322 last RECUR;
2323
2324 } elsif ($w eq "0") {
2325
2326 # * Y-M-0-0-H-MN-S
2327 # * Y-M-0-DOM-H-MN-S
2328
[618]2329 @m=_ReturnList($m);
[360]2330 return () if (! @m);
2331 foreach $m (@m) {
[618]2332 return () if (! _IsInt($m,1,12));
[360]2333 }
2334
2335 if ($d eq "0") {
2336 @d=(1);
2337 } else {
[618]2338 @d=_ReturnList($d);
[360]2339 return () if (! @d);
2340 foreach $d (@d) {
[618]2341 return () if (! _IsInt($d,-31,31) || $d==0);
[360]2342 }
2343 }
2344
2345 @date=();
2346 foreach $y (@y) {
2347 foreach $m (@m) {
[618]2348 my $dim = Date_DaysInMonth($m,$y);
[360]2349 foreach $d (@d) {
2350 my $tmpd = $d;
2351 $tmpd += ($dim+1) if ($d<0);
[618]2352 next if (! _IsInt($tmpd,1,$dim));
2353 $date=_Date_Join($y,$m,$tmpd,0,0,0);
[360]2354 push(@date,$date);
2355 }
2356 }
2357 }
2358 last RECUR;
2359
2360 } elsif ($m eq "0") {
2361
2362 # * Y-0-WOY-DOW-H-MN-S
2363 # * Y-0-WOY-0-H-MN-S
2364
[618]2365 @w=_ReturnList($w);
[360]2366 return () if (! @w);
2367 foreach $w (@w) {
[618]2368 return () if (! _IsInt($w,-53,53) || $w==0);
[360]2369 }
2370
2371 if ($d eq "0") {
2372 @d=(1);
2373 } else {
[618]2374 @d=_ReturnList($d);
[360]2375 return () if (! @d);
2376 foreach $d (@d) {
2377 $d += 8 if ($d<0);
[618]2378 return () if (! _IsInt($d,1,7));
[360]2379 }
2380 }
2381
2382 @date=();
2383 foreach $y (@y) {
2384 foreach $w (@w) {
2385 foreach $d (@d) {
2386 my($tmpw,$del);
2387 if ($w<0) {
2388 $date="$y-12-31-00:00:00";
2389 $tmpw = (-$w)-1;
2390 $del="-0:0:$tmpw:0:0:0:0";
2391 $date=Date_GetPrev($date,$d,1);
2392 } else {
2393 $date="$y-01-01-00:00:00";
2394 $tmpw = ($w)-1;
2395 $del="0:0:$tmpw:0:0:0:0";
2396 $date=Date_GetNext($date,$d,1);
2397 }
[618]2398 $date=_DateCalc_DateDelta($date,$del);
2399 push(@date,$date) if ( (_Date_Split($date))[0] == $y);
[360]2400 }
2401 }
2402 }
2403 last RECUR;
2404
2405 } else {
2406
2407 # * Y-M-WOM-DOW-H-MN-S
2408 # * Y-M-WOM-0-H-MN-S
2409
[618]2410 @m=_ReturnList($m);
[360]2411 return () if (! @m);
[618]2412 @w=_ReturnList($w);
[360]2413 return () if (! @w);
2414 if ($d eq "0") {
2415 @d=(1);
2416 } else {
[618]2417 @d=_ReturnList($d);
[360]2418 }
2419
[618]2420 @date=_Date_Recur_WoM(\@y,\@m,\@w,\@d);
[360]2421 last RECUR;
2422 }
2423 }
2424
2425 if ($#recur0==0) {
2426
2427 # Y * M-W-D-H-MN-S
2428 $n=$y;
2429 $n=1 if ($n==0);
2430
2431 if ($m eq "0") {
2432
2433 # Y * 0-W-D-H-MN-S => Y-0 * W-D-H-MN-S
2434 push(@recur0,0);
2435 shift(@recur1);
2436
2437 } elsif ($w eq "0") {
2438
2439 # Y * M-0-DOM-H-MN-S
2440 return () if (! $dateb && $y != 1);
2441
[618]2442 @m=_ReturnList($m);
[360]2443 return () if (! @m);
2444 foreach $m (@m) {
[618]2445 return () if (! _IsInt($m,1,12));
[360]2446 }
2447
2448 if ($d eq "0") {
2449 @d = (1);
2450 } else {
[618]2451 @d=_ReturnList($d);
[360]2452 return () if (! @d);
2453 foreach $d (@d) {
[618]2454 return () if (! _IsInt($d,-31,31) || $d==0);
[360]2455 }
2456 }
2457
2458 # We need to find years that are a multiple of $n from $y(base)
[618]2459 ($y0)=( _Date_Split($date0, 1) )[0];
2460 ($y1)=( _Date_Split($date1, 1) )[0];
[360]2461 if ($dateb) {
[618]2462 ($yb)=( _Date_Split($dateb, 1) )[0];
[360]2463 } else {
2464 # If $y=1, there is no base year
2465 $yb=0;
2466 }
2467
2468 @date=();
2469 for ($yy=$y0; $yy<=$y1; $yy++) {
2470 if (($yy-$yb)%$n == 0) {
2471 foreach $m (@m) {
2472 foreach $d (@d) {
[618]2473 my $dim = Date_DaysInMonth($m,$yy);
[360]2474 my $tmpd = $d;
2475 if ($tmpd < 0) {
2476 $tmpd += ($dim+1);
2477 }
[618]2478 next if (! _IsInt($tmpd,1,$dim));
2479 $date=_Date_Join($yy,$m,$tmpd,0,0,0);
[360]2480 push(@date,$date);
2481 }
2482 }
2483 }
2484 }
2485 last RECUR;
2486
2487 } else {
2488
2489 # Y * M-WOM-DOW-H-MN-S
2490 # Y * M-WOM-0-H-MN-S
2491 return () if (! $dateb && $y != 1);
2492
[618]2493 @m=_ReturnList($m);
[360]2494 return () if (! @m);
[618]2495 @w=_ReturnList($w);
[360]2496 return () if (! @w);
2497
2498 if ($d eq "0") {
2499 @d=(1);
2500 } else {
[618]2501 @d=_ReturnList($d);
[360]2502 }
2503
[618]2504 ($y0)=( _Date_Split($date0, 1) )[0];
2505 ($y1)=( _Date_Split($date1, 1) )[0];
[360]2506 if ($dateb) {
[618]2507 ($yb)=( _Date_Split($dateb, 1) )[0];
[360]2508 } else {
2509 # If $y=1, there is no base year
2510 $yb=0;
2511 }
2512 @y=();
2513 for ($yy=$y0; $yy<=$y1; $yy++) {
2514 if (($yy-$yb)%$n == 0) {
2515 push(@y,$yy);
2516 }
2517 }
2518
[618]2519 @date=_Date_Recur_WoM(\@y,\@m,\@w,\@d);
[360]2520 last RECUR;
2521 }
2522 }
2523
2524 if ($#recur0==1) {
2525
2526 # Y-M * W-D-H-MN-S
2527
2528 if ($w eq "0") {
2529 # Y-M * 0-D-H-MN-S => Y-M-0 * D-H-MN-S
2530 push(@recur0,0);
2531 shift(@recur1);
2532
2533 } elsif ($m==0) {
2534
2535 # Y-0 * WOY-0-H-MN-S
2536 # Y-0 * WOY-DOW-H-MN-S
2537 return () if (! $dateb && $y != 1);
2538 $n=$y;
2539 $n=1 if ($n==0);
2540
[618]2541 @w=_ReturnList($w);
[360]2542 return () if (! @w);
2543 foreach $w (@w) {
[618]2544 return () if ($w==0 || ! _IsInt($w,-53,53));
[360]2545 }
2546
2547 if ($d eq "0") {
2548 @d=(1);
2549 } else {
[618]2550 @d=_ReturnList($d);
[360]2551 return () if (! @d);
2552 foreach $d (@d) {
2553 $d += 8 if ($d<0);
[618]2554 return () if (! _IsInt($d,1,7));
[360]2555 }
2556 }
2557
2558 # We need to find years that are a multiple of $n from $y(base)
[618]2559 ($y0)=( _Date_Split($date0, 1) )[0];
2560 ($y1)=( _Date_Split($date1, 1) )[0];
[360]2561 if ($dateb) {
[618]2562 ($yb)=( _Date_Split($dateb, 1) )[0];
[360]2563 } else {
2564 # If $y=1, there is no base year
2565 $yb=0;
2566 }
2567
2568 @date=();
2569 for ($yy=$y0; $yy<=$y1; $yy++) {
2570 if (($yy-$yb)%$n == 0) {
2571 foreach $w (@w) {
2572 foreach $d (@d) {
2573 my($tmpw,$del);
2574 if ($w<0) {
2575 $date="$yy-12-31-00:00:00";
2576 $tmpw = (-$w)-1;
2577 $del="-0:0:$tmpw:0:0:0:0";
2578 $date=Date_GetPrev($date,$d,1);
2579 } else {
2580 $date="$yy-01-01-00:00:00";
2581 $tmpw = ($w)-1;
2582 $del="0:0:$tmpw:0:0:0:0";
2583 $date=Date_GetNext($date,$d,1);
2584 }
[618]2585 $date=DateCalc($date,$del);
2586 next if ((_Date_Split($date))[0] != $yy);
[360]2587 push(@date,$date);
2588 }
2589 }
2590 }
2591 }
2592 last RECUR;
2593
2594 } else {
2595
2596 # Y-M * WOM-0-H-MN-S
2597 # Y-M * WOM-DOW-H-MN-S
[618]2598 return () if (! $dateb && ($y != 0 || $m != 1));
[360]2599 @tmp=(@recur0);
2600 push(@tmp,0) while ($#tmp<6);
2601 $delta=join(":",@tmp);
[618]2602 $dateb=$date0 if (! $dateb);
2603 @tmp=_Date_Recur($date0,$date1,$dateb,$delta);
[360]2604
[618]2605 @w=_ReturnList($w);
[360]2606 @m=();
2607 if ($d eq "0") {
2608 @d=(1);
2609 } else {
[618]2610 @d=_ReturnList($d);
[360]2611 }
2612
[618]2613 @date=_Date_Recur_WoM(\@tmp,\@m,\@w,\@d);
[360]2614 last RECUR;
2615 }
2616 }
2617
2618 if ($#recur0==2) {
2619 # Y-M-W * D-H-MN-S
2620
2621 if ($d eq "0") {
2622
2623 # Y-M-W * 0-H-MN-S
2624 return () if (! $dateb);
2625 $y=1 if ($y==0 && $m==0 && $w==0);
2626 $delta="$y:$m:$w:0:0:0:0";
[618]2627 @date=_Date_Recur($date0,$date1,$dateb,$delta);
[360]2628 last RECUR;
2629
2630 } elsif ($m==0 && $w==0) {
2631
2632 # Y-0-0 * DOY-H-MN-S
2633 $y=1 if ($y==0);
2634 $n=$y;
2635 return () if (! $dateb && $y!=1);
2636
[618]2637 @d=_ReturnList($d);
[360]2638 return () if (! @d);
2639 foreach $d (@d) {
[618]2640 return () if (! _IsInt($d,-366,366) || $d==0);
[360]2641 }
2642
2643 # We need to find years that are a multiple of $n from $y(base)
[618]2644 ($y0)=( _Date_Split($date0, 1) )[0];
2645 ($y1)=( _Date_Split($date1, 1) )[0];
[360]2646 if ($dateb) {
[618]2647 ($yb)=( _Date_Split($dateb, 1) )[0];
[360]2648 } else {
2649 # If $y=1, there is no base year
2650 $yb=0;
2651 }
2652 @date=();
2653 for ($yy=$y0; $yy<=$y1; $yy++) {
[618]2654 my $diy = Date_DaysInYear($yy);
[360]2655 if (($yy-$yb)%$n == 0) {
2656 foreach $d (@d) {
2657 my $tmpd = $d;
2658 $tmpd += ($diy+1) if ($tmpd<0);
[618]2659 next if (! _IsInt($tmpd,1,$diy));
2660 ($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd);
2661 push(@date, _Date_Join($y,$m,$dd,0,0,0));
[360]2662 }
2663 }
2664 }
2665 last RECUR;
2666
2667 } elsif ($w>0) {
2668
2669 # Y-M-W * DOW-H-MN-S
[618]2670 return () if (! $dateb && ($y != 0 && $m != 0 && $w != 1));
[360]2671 @tmp=(@recur0);
2672 push(@tmp,0) while ($#tmp<6);
2673 $delta=join(":",@tmp);
2674
[618]2675 @d=_ReturnList($d);
[360]2676 return () if (! @d);
2677 foreach $d (@d) {
2678 $d += 8 if ($d<0);
[618]2679 return () if (! _IsInt($d,1,7));
[360]2680 }
2681
2682 # Find out what DofW the basedate is.
[618]2683 $dateb = $date0 if (! $dateb);
2684 @tmp2=_Date_Split($dateb, 1);
2685 $tmp=Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]);
[360]2686
2687 @date=();
2688 foreach $d (@d) {
2689 $date_b=$dateb;
2690 # Move basedate to DOW in the same week
2691 if ($d != $tmp) {
2692 if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
2693 ($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
2694 ($tmp<$d && $d<$Cnf{"FirstDay"})) {
[618]2695 $date_b=Date_GetNext($date_b,$d);
[360]2696 } else {
[618]2697 $date_b=Date_GetPrev($date_b,$d);
[360]2698 }
2699 }
[618]2700 push(@date,_Date_Recur($date0,$date1,$date_b,$delta));
[360]2701 }
2702 last RECUR;
2703
2704 } elsif ($m>0) {
2705
2706 # Y-M-0 * DOM-H-MN-S
[618]2707 return () if (! $dateb && ($y != 0 && $m != 1));
[360]2708 @tmp=(@recur0);
2709 push(@tmp,0) while ($#tmp<6);
2710 $delta=join(":",@tmp);
2711
[618]2712 @d=_ReturnList($d);
[360]2713 return () if (! @d);
2714 foreach $d (@d) {
[618]2715 return () if ($d==0 || ! _IsInt($d,-31,31));
[360]2716 }
[618]2717 $dateb = $date0 if (! $dateb);
[360]2718
[618]2719 @tmp2=_Date_Recur($date0,$date1,$dateb,$delta);
[360]2720 @date=();
2721 foreach $date (@tmp2) {
[618]2722 ($y,$m)=( _Date_Split($date, 1) )[0..1];
2723 my $dim=Date_DaysInMonth($m,$y);
[360]2724 foreach $d (@d) {
2725 my $tmpd = $d;
2726 $tmpd += ($dim+1) if ($tmpd<0);
[618]2727 next if (! _IsInt($tmpd,1,$dim));
2728 push(@date,_Date_Join($y,$m,$tmpd,0,0,0));
[360]2729 }
2730 }
2731 last RECUR;
2732
2733 } else {
2734 return ();
2735 }
2736 }
2737
2738 if ($#recur0>2) {
2739
2740 # Y-M-W-D * H-MN-S
2741 # Y-M-W-D-H * MN-S
2742 # Y-M-W-D-H-MN * S
2743 # Y-M-W-D-H-S
[618]2744 if (($#recur0 == 3 &&
2745 ($y == 0 && $m == 0 && $w == 0 && $d == 1)) ||
2746 ($#recur0 == 4 &&
2747 ($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 1)) ||
2748 ($#recur0 == 5 &&
2749 ($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 0 &&
2750 $mn == 1))) {
2751 $dateb = $date0;
2752 }
[360]2753 return () if (! $dateb);
2754 @tmp=(@recur0);
2755 push(@tmp,0) while ($#tmp<6);
2756 $delta=join(":",@tmp);
2757 return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
[618]2758 @date=_Date_Recur($date0,$date1,$dateb,$delta);
[360]2759 if (@recur1) {
2760 unshift(@recur1,-1) while ($#recur1<2);
2761 @time=@recur1;
2762 } else {
2763 shift(@date);
2764 pop(@date);
2765 @time=();
2766 }
2767 }
2768
2769 last RECUR;
2770 }
[618]2771 @date=_Date_RecurSetTime($date0,$date1,\@date,@time) if (@time);
[360]2772
2773 #
2774 # We've got a list of dates. Operate on them with the flags.
2775 #
2776
2777 my($sign,$forw,$today,$df,$db,$work,$i);
2778 if (@flags) {
2779 FLAG: foreach $f (@flags) {
2780 $f = uc($f);
2781
2782 if ($f =~ /^(P|N)(D|T)([1-7])$/) {
2783 @tmp=($1,$2,$3);
2784 $forw =($tmp[0] eq "P" ? 0 : 1);
2785 $today=($tmp[1] eq "D" ? 0 : 1);
2786 $d=$tmp[2];
2787 @tmp=();
2788 foreach $date (@date) {
2789 if ($forw) {
[618]2790 push(@tmp, Date_GetNext($date,$d,$today));
[360]2791 } else {
[618]2792 push(@tmp, Date_GetPrev($date,$d,$today));
[360]2793 }
2794 }
2795 @date=@tmp;
2796 next FLAG;
2797 }
2798
2799 # We want to go forward exact amounts of time instead of
2800 # business mode calculations so that we don't change the time
2801 # (which may have been set in the recur).
2802 if ($f =~ /^(F|B)(D|W)(\d+)$/) {
2803 @tmp=($1,$2,$3);
2804 $sign="+";
2805 $sign="-" if ($tmp[0] eq "B");
2806 $work=0;
2807 $work=1 if ($tmp[1] eq "W");
2808 $n=$tmp[2];
2809 @tmp=();
2810 foreach $date (@date) {
2811 for ($i=1; $i<=$n; $i++) {
2812 while (1) {
[618]2813 $date=DateCalc($date,"${sign}0:0:0:1:0:0:0");
2814 last if (! $work || Date_IsWorkDay($date,0));
[360]2815 }
2816 }
2817 push(@tmp,$date);
2818 }
2819 @date=@tmp;
2820 next FLAG;
2821 }
2822
2823 if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
2824 $tmp=$1;
2825 my $noalt = $2 ? 1 : 0;
2826 if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
2827 $forw=1;
2828 } else {
2829 $forw=0;
2830 }
2831
2832 @tmp=();
2833 DATE: foreach $date (@date) {
2834 $df=$db=$date;
[618]2835 if (Date_IsWorkDay($date)) {
[360]2836 push(@tmp,$date);
2837 next DATE;
2838 }
2839 while (1) {
2840 if ($forw) {
[618]2841 $d=$df=DateCalc($df,"+0:0:0:1:0:0:0");
[360]2842 } else {
[618]2843 $d=$db=DateCalc($db,"-0:0:0:1:0:0:0");
[360]2844 }
[618]2845 if (Date_IsWorkDay($d)) {
[360]2846 push(@tmp,$d);
2847 next DATE;
2848 }
2849 $forw=1-$forw if (! $noalt);
2850 }
2851 }
2852 @date=@tmp;
2853 next FLAG;
2854 }
2855
2856 if ($f eq "EASTER") {
2857 @tmp=();
2858 foreach $date (@date) {
[618]2859 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
2860 ($m,$d)=_Date_Easter($y);
2861 $date=_Date_Join($y,$m,$d,$h,$mn,$s);
2862 next if (Date_Cmp($date,$date0)<0 ||
2863 Date_Cmp($date,$date1)>0);
[360]2864 push(@tmp,$date);
2865 }
2866 @date=@tmp;
2867 }
2868 }
2869 }
2870
2871 @date = sort { Date_Cmp($a,$b) } @date;
2872 return @date;
2873}
2874
2875sub Date_GetPrev {
2876 print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/);
2877 my($date,$dow,$today,$hr,$min,$sec)=@_;
[618]2878 Date_Init() if (! $Curr{"InitDone"});
[360]2879 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
2880 $adjust,$curr)=();
2881 $hr="00" if (defined $hr && $hr eq "0");
2882 $min="00" if (defined $min && $min eq "0");
2883 $sec="00" if (defined $sec && $sec eq "0");
2884
[618]2885 if (! _Date_Split($date)) {
2886 $date=ParseDateString($date);
[360]2887 return "" if (! $date);
2888 }
2889 $curr=$date;
[618]2890 ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
[360]2891
2892 if ($dow) {
[618]2893 $curr_dow=Date_DayOfWeek($m,$d,$y);
[360]2894 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
[618]2895 if (_IsInt($dow)) {
[360]2896 return "" if ($dow<1 || $dow>7);
2897 } else {
2898 return "" if (! exists $dow{lc($dow)});
2899 $dow=$dow{lc($dow)};
2900 }
2901 if ($dow == $curr_dow) {
[618]2902 $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today);
[360]2903 $adjust=1 if ($today==2);
2904 } else {
2905 $dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
2906 $num = $curr_dow - $dow;
[618]2907 $date=_DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0);
[360]2908 }
[618]2909 $date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
2910 $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0)
2911 if ($adjust && Date_Cmp($date,$curr)>0);
[360]2912
2913 } else {
[618]2914 ($h,$mn,$s)=( _Date_Split($date, 1) )[3..5];
2915 ($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec);
[360]2916 if ($hr) {
2917 ($hr,$min,$sec)=($th,$tm,$ts);
2918 $delta="-0:0:0:1:0:0:0";
2919 } elsif ($min) {
2920 ($hr,$min,$sec)=($h,$tm,$ts);
2921 $delta="-0:0:0:0:1:0:0";
2922 } elsif ($sec) {
2923 ($hr,$min,$sec)=($h,$mn,$ts);
2924 $delta="-0:0:0:0:0:1:0";
2925 } else {
2926 confess "ERROR: invalid arguments in Date_GetPrev.\n";
2927 }
2928
[618]2929 $d=Date_SetTime($date,$hr,$min,$sec);
[360]2930 if ($today) {
[618]2931 $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>0);
[360]2932 } else {
[618]2933 $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>=0);
[360]2934 }
2935 $date=$d;
2936 }
2937 return $date;
2938}
2939
2940sub Date_GetNext {
2941 print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/);
2942 my($date,$dow,$today,$hr,$min,$sec)=@_;
[618]2943 Date_Init() if (! $Curr{"InitDone"});
[360]2944 my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
2945 $adjust,$curr)=();
2946 $hr="00" if (defined $hr && $hr eq "0");
2947 $min="00" if (defined $min && $min eq "0");
2948 $sec="00" if (defined $sec && $sec eq "0");
2949
[618]2950 if (! _Date_Split($date)) {
2951 $date=ParseDateString($date);
[360]2952 return "" if (! $date);
2953 }
2954 $curr=$date;
[618]2955 ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
[360]2956
2957 if ($dow) {
[618]2958 $curr_dow=Date_DayOfWeek($m,$d,$y);
[360]2959 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
[618]2960 if (_IsInt($dow)) {
[360]2961 return "" if ($dow<1 || $dow>7);
2962 } else {
2963 return "" if (! exists $dow{lc($dow)});
2964 $dow=$dow{lc($dow)};
2965 }
2966 if ($dow == $curr_dow) {
[618]2967 $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today);
[360]2968 $adjust=1 if ($today==2);
2969 } else {
2970 $curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
2971 $num = $dow - $curr_dow;
[618]2972 $date=_DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0);
[360]2973 }
[618]2974 $date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
2975 $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0)
2976 if ($adjust && Date_Cmp($date,$curr)<0);
[360]2977
2978 } else {
[618]2979 ($h,$mn,$s)=( _Date_Split($date, 1) )[3..5];
2980 ($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec);
[360]2981 if ($hr) {
2982 ($hr,$min,$sec)=($th,$tm,$ts);
2983 $delta="+0:0:0:1:0:0:0";
2984 } elsif ($min) {
2985 ($hr,$min,$sec)=($h,$tm,$ts);
2986 $delta="+0:0:0:0:1:0:0";
2987 } elsif ($sec) {
2988 ($hr,$min,$sec)=($h,$mn,$ts);
2989 $delta="+0:0:0:0:0:1:0";
2990 } else {
2991 confess "ERROR: invalid arguments in Date_GetNext.\n";
2992 }
2993
[618]2994 $d=Date_SetTime($date,$hr,$min,$sec);
[360]2995 if ($today) {
[618]2996 $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<0);
[360]2997 } else {
[618]2998 $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<1);
[360]2999 }
3000 $date=$d;
3001 }
3002
3003 return $date;
3004}
3005
3006sub Date_IsHoliday {
3007 print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
3008 my($date)=@_;
[618]3009 Date_Init() if (! $Curr{"InitDone"});
3010 $date=ParseDateString($date);
[360]3011 return undef if (! $date);
[618]3012 $date=Date_SetTime($date,0,0,0);
3013 my($y)=(_Date_Split($date, 1))[0];
3014 _Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y});
[360]3015 return undef if (! exists $Holiday{"dates"}{$y}{$date});
3016 my($name)=$Holiday{"dates"}{$y}{$date};
3017 return "" if (! $name);
3018 $name;
3019}
3020
3021sub Events_List {
3022 print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
3023 my(@args)=@_;
[618]3024 Date_Init() if (! $Curr{"InitDone"});
3025 _Events_ParseRaw();
[360]3026
3027 my($tmp,$date0,$date1,$flag);
[618]3028 $date0=ParseDateString($args[0]);
[360]3029 warn "Invalid date $args[0]", return undef if (! $date0);
3030
3031 if ($#args == 0) {
[618]3032 return _Events_Calc($date0);
[360]3033 }
3034
3035 if ($args[1]) {
[618]3036 $date1=ParseDateString($args[1]);
[360]3037 warn "Invalid date $args[1]\n", return undef if (! $date1);
[618]3038 if (Date_Cmp($date0,$date1)>0) {
[360]3039 $tmp=$date1;
3040 $date1=$date0;
3041 $date0=$tmp;
3042 }
3043 } else {
[618]3044 $date0=Date_SetTime($date0,"00:00:00");
3045 $date1=_DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0");
[360]3046 }
3047
[618]3048 $tmp=_Events_Calc($date0,$date1);
[360]3049
3050 $flag=$args[2];
3051 return $tmp if (! $flag);
3052
3053 my(@tmp,%ret,$delta)=();
3054 @tmp=@$tmp;
3055 push(@tmp,$date1);
3056
3057 if ($flag==1) {
3058 while ($#tmp>0) {
3059 ($date0,$tmp)=splice(@tmp,0,2);
3060 $date1=$tmp[0];
[618]3061 $delta=_DateCalc_DateDate($date0,$date1);
[360]3062 foreach $flag (@$tmp) {
3063 if (exists $ret{$flag}) {
[618]3064 $ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta);
[360]3065 } else {
3066 $ret{$flag}=$delta;
3067 }
3068 }
3069 }
3070 return \%ret;
3071
3072 } elsif ($flag==2) {
3073 while ($#tmp>0) {
3074 ($date0,$tmp)=splice(@tmp,0,2);
3075 $date1=$tmp[0];
[618]3076 $delta=_DateCalc_DateDate($date0,$date1);
[360]3077 $flag=join("+",sort { Date_Cmp($a,$b) } @$tmp);
3078 next if (! $flag);
3079 if (exists $ret{$flag}) {
[618]3080 $ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta);
[360]3081 } else {
3082 $ret{$flag}=$delta;
3083 }
3084 }
3085 return \%ret;
3086 }
3087
3088 warn "Invalid flag $flag\n";
3089 return undef;
3090}
3091
3092###
3093# NOTE: The following routines may be called in the routines below with very
3094# little time penalty.
3095###
3096sub Date_SetTime {
3097 print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
3098 my($date,$h,$mn,$s)=@_;
[618]3099 Date_Init() if (! $Curr{"InitDone"});
[360]3100 my($y,$m,$d)=();
3101
[618]3102 if (! _Date_Split($date)) {
3103 $date=ParseDateString($date);
[360]3104 return "" if (! $date);
3105 }
3106
[618]3107 ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
3108 ($h,$mn,$s)=_Date_ParseTime($h,$mn,$s);
[360]3109
3110 my($ampm,$wk);
[618]3111 return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
3112 _Date_Join($y,$m,$d,$h,$mn,$s);
[360]3113}
3114
3115sub Date_SetDateField {
3116 print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/);
3117 my($date,$field,$val,$nocheck)=@_;
3118 my($y,$m,$d,$h,$mn,$s)=();
3119 $nocheck=0 if (! defined $nocheck);
3120
[618]3121 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date);
[360]3122
3123 if (! $y) {
[618]3124 $date=ParseDateString($date);
[360]3125 return "" if (! $date);
[618]3126 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
[360]3127 }
3128
3129 if (lc($field) eq "y") {
3130 $y=$val;
3131 } elsif (lc($field) eq "m") {
3132 $m=$val;
3133 } elsif (lc($field) eq "d") {
3134 $d=$val;
3135 } elsif (lc($field) eq "h") {
3136 $h=$val;
3137 } elsif (lc($field) eq "mn") {
3138 $mn=$val;
3139 } elsif (lc($field) eq "s") {
3140 $s=$val;
3141 } else {
3142 confess "ERROR: Date_SetDateField: invalid field: $field\n";
3143 }
3144
[618]3145 $date=_Date_Join($y,$m,$d,$h,$mn,$s);
3146 return $date if ($nocheck || _Date_Split($date));
[360]3147 return "";
3148}
3149
3150########################################################################
3151# OTHER SUBROUTINES
3152########################################################################
3153# NOTE: These routines should not call any of the routines above as
3154# there will be a severe time penalty (and the possibility of
3155# infinite recursion). The last couple routines above are
3156# exceptions.
3157# NOTE: Date_Init is a special case. It should be called (conditionally)
3158# in every routine that uses any variable from the Date::Manip
3159# namespace.
3160########################################################################
3161
3162sub Date_DaysInMonth {
3163 print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
3164 my($m,$y)=@_;
[618]3165 $y=_Date_FixYear($y) if (length($y)!=4);
[360]3166 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
[618]3167 $d_in_m[2]=29 if (Date_LeapYear($y));
[360]3168 return $d_in_m[$m];
3169}
3170
3171sub Date_DayOfWeek {
3172 print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
3173 my($m,$d,$y)=@_;
[618]3174 $y=_Date_FixYear($y) if (length($y)!=4);
[360]3175 my($dayofweek,$dec31)=();
3176
3177 $dec31=5; # Dec 31, 1BC was Friday
[618]3178 $dayofweek=(Date_DaysSince1BC($m,$d,$y)+$dec31) % 7;
[360]3179 $dayofweek=7 if ($dayofweek==0);
3180 return $dayofweek;
3181}
3182
3183# Can't be in "use integer" because the numbers are too big.
3184no integer;
3185sub Date_SecsSince1970 {
3186 print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
3187 my($m,$d,$y,$h,$mn,$s)=@_;
[618]3188 $y=_Date_FixYear($y) if (length($y)!=4);
[360]3189 my($sec_now,$sec_70)=();
[618]3190 $sec_now=(Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s;
3191# $sec_70 =(Date_DaysSince1BC(1,1,1970)-1)*24*3600;
[360]3192 $sec_70 =62167219200;
3193 return ($sec_now-$sec_70);
3194}
3195
3196sub Date_SecsSince1970GMT {
3197 print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/);
3198 my($m,$d,$y,$h,$mn,$s)=@_;
[618]3199 Date_Init() if (! $Curr{"InitDone"});
3200 $y=_Date_FixYear($y) if (length($y)!=4);
[360]3201
[618]3202 my($sec)=Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
[360]3203 return $sec if ($Cnf{"ConvTZ"} eq "IGNORE");
3204
3205 my($tz)=$Cnf{"ConvTZ"};
3206 $tz=$Cnf{"TZ"} if (! $tz);
3207 $tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
3208
3209 my($tzs)=1;
3210 $tzs=-1 if ($tz<0);
3211 $tz=~/.(..)(..)/;
3212 my($tzh,$tzm)=($1,$2);
3213 $sec - $tzs*($tzh*3600+$tzm*60);
3214}
3215use integer;
3216
3217sub Date_DaysSince1BC {
3218 print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
3219 my($m,$d,$y)=@_;
[618]3220 $y=_Date_FixYear($y) if (length($y)!=4);
[360]3221 my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
3222 my($cc,$yy)=();
3223
3224 $y=~ /(\d{2})(\d{2})/;
3225 ($cc,$yy)=($1,$2);
3226
3227 # Number of full years since Dec 31, 1BC (counting the year 0000).
3228 $Ny=$y;
3229
3230 # Number of full 4th years (incl. 0000) since Dec 31, 1BC
3231 $N4=($Ny-1)/4 + 1;
3232 $N4=0 if ($y==0);
3233
3234 # Number of full 100th years (incl. 0000)
3235 $N100=$cc + 1;
3236 $N100-- if ($yy==0);
3237 $N100=0 if ($y==0);
3238
3239 # Number of full 400th years (incl. 0000)
3240 $N400=($N100-1)/4 + 1;
3241 $N400=0 if ($y==0);
3242
[618]3243 $dayofyear=Date_DayOfYear($m,$d,$y);
[360]3244 $days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
3245
3246 return $days;
3247}
3248
3249sub Date_DayOfYear {
3250 print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3251 my($m,$d,$y)=@_;
[618]3252 $y=_Date_FixYear($y) if (length($y)!=4);
[360]3253 # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
3254 my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
3255 my($ly)=0;
[618]3256 $ly=1 if ($m>2 && Date_LeapYear($y));
[360]3257 return ($days[$m-1]+$d+$ly);
3258}
3259
3260sub Date_DaysInYear {
3261 print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
3262 my($y)=@_;
[618]3263 $y=_Date_FixYear($y) if (length($y)!=4);
3264 return 366 if (Date_LeapYear($y));
[360]3265 return 365;
3266}
3267
3268sub Date_WeekOfYear {
3269 print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3270 my($m,$d,$y,$f)=@_;
[618]3271 Date_Init() if (! $Curr{"InitDone"});
3272 $y=_Date_FixYear($y) if (length($y)!=4);
[360]3273
3274 my($day,$dow,$doy)=();
[618]3275 $doy=Date_DayOfYear($m,$d,$y);
[360]3276
3277 # The current DayOfYear and DayOfWeek
3278 if ($Cnf{"Jan1Week1"}) {
3279 $day=1;
3280 } else {
3281 $day=4;
3282 }
[618]3283 $dow=Date_DayOfWeek(1,$day,$y);
[360]3284
3285 # Move back to the first day of week 1.
3286 $f-=7 if ($f>$dow);
3287 $day-= ($dow-$f);
3288
3289 return 0 if ($day>$doy); # Day is in last week of previous year
3290 return (($doy-$day)/7 + 1);
3291}
3292
3293sub Date_LeapYear {
3294 print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
3295 my($y)=@_;
[618]3296 $y=_Date_FixYear($y) if (length($y)!=4);
[360]3297 return 0 unless $y % 4 == 0;
3298 return 1 unless $y % 100 == 0;
3299 return 0 unless $y % 400 == 0;
3300 return 1;
3301}
3302
3303sub Date_DaySuffix {
3304 print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
3305 my($d)=@_;
[618]3306 Date_Init() if (! $Curr{"InitDone"});
[360]3307 return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
3308}
3309
3310sub Date_ConvTZ {
3311 print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
3312 my($date,$from,$to,$level)=@_;
[618]3313 if (not _Date_Split($date)) {
[360]3314 my $err = "date passed in ('$date') is not a Date::Manip object";
3315 if (! $level) {
3316 croak $err;
3317 } elsif ($level==1) {
3318 carp $err;
3319 }
3320 return "";
3321 }
3322
[618]3323 Date_Init() if (! $Curr{"InitDone"});
[360]3324 my($gmt)=();
3325
3326 if (! $from) {
3327
3328 if (! $to) {
3329 # TZ -> ConvTZ
3330 return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
3331 $from=$Cnf{"TZ"};
3332 $to=$Cnf{"ConvTZ"};
3333
3334 } else {
3335 # ConvTZ,TZ -> $to
3336 $from=$Cnf{"ConvTZ"};
3337 $from=$Cnf{"TZ"} if (! $from);
3338 }
3339
3340 } else {
3341
3342 if (! $to) {
3343 # $from -> ConvTZ,TZ
3344 return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
3345 $to=$Cnf{"ConvTZ"};
3346 $to=$Cnf{"TZ"} if (! $to);
3347
3348 } else {
3349 # $from -> $to
3350 }
3351 }
3352
3353 $to=$Zone{"n2o"}{lc($to)}
3354 if (exists $Zone{"n2o"}{lc($to)});
3355 $from=$Zone{"n2o"}{lc($from)}
3356 if (exists $Zone{"n2o"}{lc($from)});
3357 $gmt=$Zone{"n2o"}{"gmt"};
3358
3359 return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/);
3360 return $date if ($from eq $to);
3361
3362 my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=();
3363 # We're going to try to do the calculation without calling DateCalc.
[618]3364 ($yr,$mon,$d,$h,$m,$sec)=_Date_Split($date, 1);
[360]3365
3366 # Convert $date from $from to GMT
3367 $from=~/([+-])(\d{2})(\d{2})/;
3368 ($s1,$h1,$m1)=($1,$2,$3);
3369 $s1= ($s1 eq "-" ? "+" : "-"); # switch sign
3370 $sign=$s1 . "1"; # + or - 1
3371
3372 # and from GMT to $to
3373 $to=~/([+-])(\d{2})(\d{2})/;
3374 ($s2,$h2,$m2)=($1,$2,$3);
3375
3376 if ($s1 eq $s2) {
3377 # Both the same sign
3378 $m+= $sign*($m1+$m2);
3379 $h+= $sign*($h1+$h2);
3380 } else {
3381 $sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
3382 $m+= $sign*($m1-$m2);
3383 $h+= $sign*($h1-$h2);
3384 }
3385
3386 if ($m>59) {
3387 $h+= $m/60;
3388 $m-= ($m/60)*60;
3389 } elsif ($m<0) {
3390 $h+= ($m/60 - 1);
3391 $m-= ($m/60 - 1)*60;
3392 }
3393
3394 if ($h>23) {
3395 $delta=$h/24;
3396 $h -= $delta*24;
3397 if (($d + $delta) > 28) {
[618]3398 $date=_Date_Join($yr,$mon,$d,$h,$m,$sec);
3399 return _DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0);
[360]3400 }
3401 $d+= $delta;
3402 } elsif ($h<0) {
3403 $delta=-$h/24 + 1;
3404 $h += $delta*24;
3405 if (($d - $delta) < 1) {
[618]3406 $date=_Date_Join($yr,$mon,$d,$h,$m,$sec);
3407 return _DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0);
[360]3408 }
3409 $d-= $delta;
3410 }
[618]3411 return _Date_Join($yr,$mon,$d,$h,$m,$sec);
[360]3412}
3413
3414sub Date_TimeZone {
3415 print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/);
3416 my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=();
[618]3417 Date_Init() if (! $Curr{"InitDone"});
[360]3418
3419 # Get timezones from all of the relevant places
3420
3421 push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var
3422 push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var
3423 push(@tz,$ENV{'SYS$TIMEZONE_RULE'})
3424 if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var
3425 push(@tz,$ENV{'SYS$TIMEZONE_NAME'})
3426 if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var
3427 push(@tz,$ENV{'UCX$TZ'})
3428 if defined $ENV{'UCX$TZ'}; # VMS TZ environ var
3429 push(@tz,$ENV{'TCPIP$TZ'})
3430 if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var
3431
3432 # The `date` command... if we're doing taint checking, we need to
3433 # always call it with a full path... otherwise, use the user's path.
3434 #
3435 # Microsoft operating systems don't have a date command built in. Try
3436 # to trap all the various ways of knowing we are on one of these systems.
3437 #
3438 # We'll try `date +%Z` first, and if that fails, we'll take just the
3439 # `date` program and assume the output is of the format:
3440 # Thu Aug 31 14:57:46 EDT 2000
3441
3442 unless (($^O ne 'cygwin' && $^X =~ /perl\.exe$/i) or
3443 ($OS eq "Windows") or
3444 ($OS eq "Netware") or
3445 ($OS eq "VMS")) {
3446 if ($Date::Manip::NoTaint) {
3447 if ($OS eq "VMS") {
3448 $tz=$ENV{'SYS$TIMEZONE_NAME'};
3449 if (! $tz) {
3450 $tz=$ENV{'MULTINET_TIMEZONE'};
3451 if (! $tz) {
3452 $tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
3453 }
3454 }
3455 } else {
3456 $tz=`date +%Z 2> /dev/null`;
3457 chomp($tz);
3458 if (! $tz) {
3459 $tz=`date 2> /dev/null`;
3460 chomp($tz);
3461 $tz=(split(/\s+/,$tz))[4];
3462 }
3463 }
[618]3464 push(@tz,$tz) if (defined $tz);
[360]3465 } else {
3466 # We need to satisfy taint checking, but also look in all the
3467 # directories in @DatePath.
3468 #
3469 local $ENV{PATH} = join(':', @Date::Manip::DatePath);
3470 local $ENV{BASH_ENV} = '';
3471 $tz=`date +%Z 2> /dev/null`;
3472 chomp($tz);
3473 if (! $tz) {
3474 $tz=`date 2> /dev/null`;
3475 chomp($tz);
3476 $tz=(split(/\s+/,$tz))[4];
3477 }
[618]3478 push(@tz,$tz) if (defined $tz);
[360]3479 }
3480 }
3481
3482 push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ
3483
3484 if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE
3485 $in=new IO::File;
3486 $in->open("/etc/TIMEZONE","r");
3487 while (! eof($in)) {
3488 $tmp=<$in>;
3489 if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
3490 push(@tz,$1);
3491 last;
3492 }
3493 }
3494 $in->close;
3495 }
3496
3497 if (-s "/etc/timezone") { # /etc/timezone
3498 $in=new IO::File;
3499 $in->open("/etc/timezone","r");
3500 while (! eof($in)) {
3501 $tmp=<$in>;
3502 next if ($tmp =~ /^\s*\043/);
3503 chomp($tmp);
3504 if ($tmp =~ /^\s*(.*?)\s*$/) {
3505 push(@tz,$1);
3506 last;
3507 }
3508 }
3509 $in->close;
3510 }
[618]3511
3512 print STDERR "Found time zones: @tz\n";
[360]3513
3514 # Now parse each one to find the first valid one.
3515 foreach $tz (@tz) {
3516 $tz =~ s/\s*$//;
3517 $tz =~ s/^\s*//;
3518 $tz =~ s/^://;
3519 next if ($tz eq "");
3520
3521 return uc($tz)
3522 if (defined $Zone{"n2o"}{lc($tz)});
3523
3524 if ($tz =~ /^[+-]\d{4}$/) {
3525 return $tz;
3526 } elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
3527 my($h,$m)=($1,$2);
3528 $m="00" if (! $m);
3529 return "$h$m";
3530 }
3531
3532 # Handle US/Eastern format
3533 if ($tz =~ /^$Zone{"tzones"}$/i) {
3534 $tmp=lc $1;
3535 $tz=$Zone{"tz2z"}{$tmp};
3536 }
3537
3538 # Handle STD#DST# format (and STD-#DST-# formats)
3539 if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
3540 ($std,$dst)=($1,$2);
3541 next if (! defined $Zone{"n2o"}{lc($std)} or
3542 ! defined $Zone{"n2o"}{lc($dst)});
3543 $time = time();
3544 ($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
3545 localtime($time);
3546 return uc($dst) if ($isdst);
3547 return uc($std);
3548 }
3549 }
3550
[618]3551 confess "ERROR: Date::Manip unable to determine Time Zone.\n";
[360]3552}
3553
3554# Returns 1 if $date is a work day. If $time is non-zero, the time is
3555# also checked to see if it falls within work hours. Returns "" if
3556# an invalid date is passed in.
3557sub Date_IsWorkDay {
3558 print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3559 my($date,$time)=@_;
[618]3560 Date_Init() if (! $Curr{"InitDone"});
3561 $date=ParseDateString($date);
[360]3562 return "" if (! $date);
3563 my($d)=$date;
[618]3564 $d=Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time);
[360]3565
3566 my($y,$mon,$day,$h,$m,$s,$dow)=();
[618]3567 ($y,$mon,$day,$h,$m,$s)=_Date_Split($d, 1);
3568 $dow=Date_DayOfWeek($mon,$day,$y);
[360]3569
3570 return 0 if ($dow<$Cnf{"WorkWeekBeg"} or
3571 $dow>$Cnf{"WorkWeekEnd"} or
3572 "$h:$m" lt $Cnf{"WorkDayBeg"} or
3573 "$h:$m" ge $Cnf{"WorkDayEnd"});
3574
3575 if (! exists $Holiday{"dates"}{$y}) {
3576 # There will be recursion problems if we ever end up here twice.
3577 $Holiday{"dates"}{$y}={};
[618]3578 _Date_UpdateHolidays($y)
[360]3579 }
[618]3580 $d=Date_SetTime($date,"00:00:00");
[360]3581 return 0 if (exists $Holiday{"dates"}{$y}{$d});
3582 1;
3583}
3584
3585# Finds the day $off work days from now. If $time is passed in, we must
3586# also take into account the time of day.
3587#
3588# If $time is not passed in, day 0 is today (if today is a workday) or the
3589# next work day if it isn't. In any case, the time of day is unaffected.
3590#
3591# If $time is passed in, day 0 is now (if now is part of a workday) or the
3592# start of the very next work day.
3593sub Date_NextWorkDay {
3594 print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3595 my($date,$off,$time)=@_;
[618]3596 Date_Init() if (! $Curr{"InitDone"});
3597 $date=ParseDateString($date);
[360]3598 my($err)=();
3599
[618]3600 if (! Date_IsWorkDay($date,$time)) {
[360]3601 if ($time) {
3602 while (1) {
[618]3603 $date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3604 last if (Date_IsWorkDay($date,$time));
[360]3605 }
3606 } else {
3607 while (1) {
[618]3608 $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3609 last if (Date_IsWorkDay($date,$time));
[360]3610 }
3611 }
3612 }
3613
3614 while ($off>0) {
3615 while (1) {
[618]3616 $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3617 last if (Date_IsWorkDay($date,$time));
[360]3618 }
3619 $off--;
3620 }
3621
3622 return $date;
3623}
3624
3625# Finds the day $off work days before now. If $time is passed in, we must
3626# also take into account the time of day.
3627#
3628# If $time is not passed in, day 0 is today (if today is a workday) or the
3629# previous work day if it isn't. In any case, the time of day is unaffected.
3630#
3631# If $time is passed in, day 0 is now (if now is part of a workday) or the
3632# end of the previous work period. Note that since the end of a work day
3633# will automatically be turned into the start of the next one, this time
3634# may actually be treated as AFTER the current time.
3635sub Date_PrevWorkDay {
3636 print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3637 my($date,$off,$time)=@_;
[618]3638 Date_Init() if (! $Curr{"InitDone"});
3639 $date=ParseDateString($date);
[360]3640 my($err)=();
3641
[618]3642 if (! Date_IsWorkDay($date,$time)) {
[360]3643 if ($time) {
3644 while (1) {
[618]3645 $date=Date_GetPrev($date,undef,0,$Cnf{"WorkDayEnd"});
3646 last if (Date_IsWorkDay($date,$time));
[360]3647 }
3648 while (1) {
[618]3649 $date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3650 last if (Date_IsWorkDay($date,$time));
[360]3651 }
3652 } else {
3653 while (1) {
[618]3654 $date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3655 last if (Date_IsWorkDay($date,$time));
[360]3656 }
3657 }
3658 }
3659
3660 while ($off>0) {
3661 while (1) {
[618]3662 $date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3663 last if (Date_IsWorkDay($date,$time));
[360]3664 }
3665 $off--;
3666 }
3667
3668 return $date;
3669}
3670
3671# This finds the nearest workday to $date. If $date is a workday, it
3672# is returned.
3673sub Date_NearestWorkDay {
3674 print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3675 my($date,$tomorrow)=@_;
[618]3676 Date_Init() if (! $Curr{"InitDone"});
3677 $date=ParseDateString($date);
[360]3678 my($a,$b,$dela,$delb,$err)=();
3679 $tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow);
3680
[618]3681 return $date if (Date_IsWorkDay($date));
[360]3682
3683 # Find the nearest one.
3684 if ($tomorrow) {
3685 $dela="+0:0:0:1:0:0:0";
3686 $delb="-0:0:0:1:0:0:0";
3687 } else {
3688 $dela="-0:0:0:1:0:0:0";
3689 $delb="+0:0:0:1:0:0:0";
3690 }
3691 $a=$b=$date;
3692
3693 while (1) {
[618]3694 $a=_DateCalc_DateDelta($a,$dela,\$err);
3695 return $a if (Date_IsWorkDay($a));
3696 $b=_DateCalc_DateDelta($b,$delb,\$err);
3697 return $b if (Date_IsWorkDay($b));
[360]3698 }
3699}
3700
[618]3701# Date_NthDayOfYear($y,$n);
[360]3702# Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year.
3703sub Date_NthDayOfYear {
3704 no integer;
3705 print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3706 my($y,$n)=@_;
3707 $y=$Curr{"Y"} if (! $y);
3708 $n=1 if (! defined $n or $n eq "");
3709 $n+=0; # to turn 023 into 23
[618]3710 $y=_Date_FixYear($y) if (length($y)<4);
3711 my $leap=Date_LeapYear($y);
[360]3712 return () if ($n<1);
3713 return () if ($n >= ($leap ? 367 : 366));
3714
3715 my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31);
3716 $d_in_m[1]=29 if ($leap);
3717
3718 # Calculate the hours, minutes, and seconds into the day.
3719 my $remain=($n - int($n))*24;
3720 my $h=int($remain);
3721 $remain=($remain - $h)*60;
3722 my $mn=int($remain);
3723 $remain=($remain - $mn)*60;
3724 my $s=$remain;
3725
3726 # Calculate the month and the day.
3727 my($m,$d)=(0,0);
3728 $n=int($n);
3729 while ($n>0) {
3730 $m++;
3731 if ($n<=$d_in_m[0]) {
3732 $d=int($n);
3733 $n=0;
3734 } else {
3735 $n-= $d_in_m[0];
3736 shift(@d_in_m);
3737 }
3738 }
3739
3740 ($y,$m,$d,$h,$mn,$s);
3741}
3742
3743########################################################################
3744# NOT FOR EXPORT
3745########################################################################
3746
3747# This is used in Date_Init to fill in a hash based on international
3748# data. It takes a list of keys and values and returns both a hash
3749# with these values and a regular expression of keys.
3750#
3751# IN:
3752# $data = [ key1 val1 key2 val2 ... ]
3753# $opts = lc : lowercase the keys in the regexp
3754# sort : sort (by length) the keys in the regexp
3755# back : create a regexp with a back reference
3756# escape : escape all strings in the regexp
3757#
3758# OUT:
3759# $regexp = '(?:key1|key2|...)'
3760# $hash = { key1=>val1 key2=>val2 ... }
3761
[618]3762sub _Date_InitHash {
3763 print "DEBUG: _Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
[360]3764 my($data,$regexp,$opts,$hash)=@_;
3765 my(@data)=@$data;
3766 my($key,$val,@list)=();
3767
3768 # Parse the options
3769 my($lc,$sort,$back,$escape)=(0,0,0,0);
3770 $lc=1 if ($opts =~ /lc/i);
3771 $sort=1 if ($opts =~ /sort/i);
3772 $back=1 if ($opts =~ /back/i);
3773 $escape=1 if ($opts =~ /escape/i);
3774
3775 # Create the hash
3776 while (@data) {
3777 ($key,$val,@data)=@data;
3778 $key=lc($key) if ($lc);
3779 $$hash{$key}=$val;
3780 }
3781
3782 # Create the regular expression
3783 if ($regexp) {
3784 @list=keys(%$hash);
[618]3785 @list=sort _sortByLength(@list) if ($sort);
[360]3786 if ($escape) {
3787 foreach $val (@list) {
3788 $val="\Q$val\E";
3789 }
3790 }
3791 if ($back) {
3792 $$regexp="(" . join("|",@list) . ")";
3793 } else {
3794 $$regexp="(?:" . join("|",@list) . ")";
3795 }
3796 }
3797}
3798
3799# This is used in Date_Init to fill in regular expressions, lists, and
3800# hashes based on international data. It takes a list of lists which have
3801# to be stored as regular expressions (to find any element in the list),
3802# lists, and hashes (indicating the location in the lists).
3803#
3804# IN:
3805# $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ]
3806# [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ]
3807# ...
3808# [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ]
3809# $lists = [ \@listA \@listB ... \@listZ ]
3810# $opts = lc : lowercase the values in the regexp
3811# sort : sort (by length) the values in the regexp
3812# back : create a regexp with a back reference
3813# escape : escape all strings in the regexp
3814# $hash = [ \%hash, TYPE ]
3815# TYPE 0 : $hash{ valBn=>n-1 }
3816# TYPE 1 : $hash{ valBn=>n }
3817#
3818# OUT:
3819# $regexp = '(?:valA1|valA2|...|valB1|...)'
3820# $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
3821# [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
3822# $hash
3823
[618]3824sub _Date_InitLists {
3825 print "DEBUG: _Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
[360]3826 my($data,$regexp,$opts,$lists,$hash)=@_;
3827 my(@data)=@$data;
3828 my(@lists)=@$lists;
3829 my($i,@ele,$ele,@list,$j,$tmp)=();
3830
3831 # Parse the options
3832 my($lc,$sort,$back,$escape)=(0,0,0,0);
3833 $lc=1 if ($opts =~ /lc/i);
3834 $sort=1 if ($opts =~ /sort/i);
3835 $back=1 if ($opts =~ /back/i);
3836 $escape=1 if ($opts =~ /escape/i);
3837
3838 # Set each of the lists
3839 if (@lists) {
[618]3840 confess "ERROR: _Date_InitLists: lists must be 1 per data\n"
[360]3841 if ($#lists != $#data);
3842 for ($i=0; $i<=$#data; $i++) {
3843 @ele=@{ $data[$i] };
3844 if ($Cnf{"IntCharSet"} && $#ele>0) {
3845 @{ $lists[$i] } = @{ $ele[1] };
3846 } else {
3847 @{ $lists[$i] } = @{ $ele[0] };
3848 }
3849 }
3850 }
3851
3852 # Create the hash
3853 my($hashtype,$hashsave,%hash)=();
3854 if (@$hash) {
3855 ($hash,$hashtype)=@$hash;
3856 $hashsave=1;
3857 } else {
3858 $hashtype=0;
3859 $hashsave=0;
3860 }
3861 for ($i=0; $i<=$#data; $i++) {
3862 @ele=@{ $data[$i] };
3863 foreach $ele (@ele) {
3864 @list = @{ $ele };
3865 for ($j=0; $j<=$#list; $j++) {
3866 $tmp=$list[$j];
3867 next if (! $tmp);
3868 $tmp=lc($tmp) if ($lc);
3869 $hash{$tmp}= $j+$hashtype;
3870 }
3871 }
3872 }
3873 %$hash = %hash if ($hashsave);
3874
3875 # Create the regular expression
3876 if ($regexp) {
3877 @list=keys(%hash);
[618]3878 @list=sort _sortByLength(@list) if ($sort);
[360]3879 if ($escape) {
3880 foreach $ele (@list) {
3881 $ele="\Q$ele\E";
3882 }
3883 }
3884 if ($back) {
3885 $$regexp="(" . join("|",@list) . ")";
3886 } else {
3887 $$regexp="(?:" . join("|",@list) . ")";
3888 }
3889 }
3890}
3891
3892# This is used in Date_Init to fill in regular expressions and lists based
3893# on international data. This takes a list of strings and returns a regular
3894# expression (to find any one of them).
3895#
3896# IN:
3897# $data = [ string1 string2 ... ]
3898# $opts = lc : lowercase the values in the regexp
3899# sort : sort (by length) the values in the regexp
3900# back : create a regexp with a back reference
3901# escape : escape all strings in the regexp
3902#
3903# OUT:
3904# $regexp = '(string1|string2|...)'
3905
[618]3906sub _Date_InitStrings {
3907 print "DEBUG: _Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
[360]3908 my($data,$regexp,$opts)=@_;
3909 my(@list)=@{ $data };
3910
3911 # Parse the options
3912 my($lc,$sort,$back,$escape)=(0,0,0,0);
3913 $lc=1 if ($opts =~ /lc/i);
3914 $sort=1 if ($opts =~ /sort/i);
3915 $back=1 if ($opts =~ /back/i);
3916 $escape=1 if ($opts =~ /escape/i);
3917
3918 # Create the regular expression
3919 my($ele)=();
[618]3920 @list=sort _sortByLength(@list) if ($sort);
[360]3921 if ($escape) {
3922 foreach $ele (@list) {
3923 $ele="\Q$ele\E";
3924 }
3925 }
3926 if ($back) {
3927 $$regexp="(" . join("|",@list) . ")";
3928 } else {
3929 $$regexp="(?:" . join("|",@list) . ")";
3930 }
3931 $$regexp=lc($$regexp) if ($lc);
3932}
3933
3934# items is passed in (either as a space separated string, or a reference to
3935# a list) and a regular expression which matches any one of the items is
3936# prepared. The regular expression will be of one of the forms:
3937# "(a|b)" @list not empty, back option included
3938# "(?:a|b)" @list not empty
3939# "()" @list empty, back option included
3940# "" @list empty
3941# $options is a string which contains any of the following strings:
3942# back : the regular expression has a backreference
3943# opt : the regular expression is optional and a "?" is appended in
3944# the first two forms
3945# optws : the regular expression is optional and may be replaced by
3946# whitespace
3947# optWs : the regular expression is optional, but if not present, must
3948# be replaced by whitespace
3949# sort : the items in the list are sorted by length (longest first)
3950# lc : the string is lowercased
3951# under : any underscores are converted to spaces
3952# pre : it may be preceded by whitespace
3953# Pre : it must be preceded by whitespace
3954# PRE : it must be preceded by whitespace or the start
3955# post : it may be followed by whitespace
3956# Post : it must be followed by whitespace
3957# POST : it must be followed by whitespace or the end
3958# Spaces due to pre/post options will not be included in the back reference.
3959#
3960# If $array is included, then the elements will also be returned as a list.
3961# $array is a string which may contain any of the following:
3962# keys : treat the list as a hash and only the keys go into the regexp
3963# key0 : treat the list as the values of a hash with keys 0 .. N-1
3964# key1 : treat the list as the values of a hash with keys 1 .. N
3965# val0 : treat the list as the keys of a hash with values 0 .. N-1
3966# val1 : treat the list as the keys of a hash with values 1 .. N
3967
[618]3968# _Date_InitLists([$lang{"month_name"},$lang{"month_abb"}],
[360]3969# [\$Month,"lc,sort,back"],
3970# [\@Month,\@Mon],
3971# [\%Month,1]);
3972
3973# This is used in Date_Init to prepare regular expressions. A list of
3974# items is passed in (either as a space separated string, or a reference to
3975# a list) and a regular expression which matches any one of the items is
3976# prepared. The regular expression will be of one of the forms:
3977# "(a|b)" @list not empty, back option included
3978# "(?:a|b)" @list not empty
3979# "()" @list empty, back option included
3980# "" @list empty
3981# $options is a string which contains any of the following strings:
3982# back : the regular expression has a backreference
3983# opt : the regular expression is optional and a "?" is appended in
3984# the first two forms
3985# optws : the regular expression is optional and may be replaced by
3986# whitespace
3987# optWs : the regular expression is optional, but if not present, must
3988# be replaced by whitespace
3989# sort : the items in the list are sorted by length (longest first)
3990# lc : the string is lowercased
3991# under : any underscores are converted to spaces
3992# pre : it may be preceded by whitespace
3993# Pre : it must be preceded by whitespace
3994# PRE : it must be preceded by whitespace or the start
3995# post : it may be followed by whitespace
3996# Post : it must be followed by whitespace
3997# POST : it must be followed by whitespace or the end
3998# Spaces due to pre/post options will not be included in the back reference.
3999#
4000# If $array is included, then the elements will also be returned as a list.
4001# $array is a string which may contain any of the following:
4002# keys : treat the list as a hash and only the keys go into the regexp
4003# key0 : treat the list as the values of a hash with keys 0 .. N-1
4004# key1 : treat the list as the values of a hash with keys 1 .. N
4005# val0 : treat the list as the keys of a hash with values 0 .. N-1
4006# val1 : treat the list as the keys of a hash with values 1 .. N
[618]4007sub _Date_Regexp {
4008 print "DEBUG: _Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
[360]4009 my($list,$options,$array)=@_;
4010 my(@list,$ret,%hash,$i)=();
4011 local($_)=();
4012 $options="" if (! defined $options);
4013 $array="" if (! defined $array);
4014
4015 my($sort,$lc,$under)=(0,0,0);
4016 $sort =1 if ($options =~ /sort/i);
4017 $lc =1 if ($options =~ /lc/i);
4018 $under=1 if ($options =~ /under/i);
4019 my($back,$opt,$pre,$post,$ws)=("?:","","","","");
4020 $back ="" if ($options =~ /back/i);
4021 $opt ="?" if ($options =~ /opt/i);
4022 $pre ='\s*' if ($options =~ /pre/);
4023 $pre ='\s+' if ($options =~ /Pre/);
4024 $pre ='(?:\s+|^)' if ($options =~ /PRE/);
4025 $post ='\s*' if ($options =~ /post/);
4026 $post ='\s+' if ($options =~ /Post/);
4027 $post ='(?:$|\s+)' if ($options =~ /POST/);
4028 $ws ='\s*' if ($options =~ /optws/);
4029 $ws ='\s+' if ($options =~ /optws/);
4030
4031 my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0);
4032 $keys =1 if ($array =~ /keys/i);
4033 $key0 =1 if ($array =~ /key0/i);
4034 $key1 =1 if ($array =~ /key1/i);
4035 $val0 =1 if ($array =~ /val0/i);
4036 $val1 =1 if ($array =~ /val1/i);
4037 $hash =1 if ($keys or $key0 or $key1 or $val0 or $val1);
4038
4039 my($ref)=ref $list;
4040 if (! $ref) {
4041 $list =~ s/\s*$//;
4042 $list =~ s/^\s*//;
4043 $list =~ s/\s+/&&&/g;
4044 } elsif ($ref eq "ARRAY") {
4045 $list = join("&&&",@$list);
4046 } else {
[618]4047 confess "ERROR: _Date_Regexp.\n";
[360]4048 }
4049
4050 if (! $list) {
4051 if ($back eq "") {
4052 return "()";
4053 } else {
4054 return "";
4055 }
4056 }
4057
4058 $list=lc($list) if ($lc);
4059 $list=~ s/_/ /g if ($under);
4060 @list=split(/&&&/,$list);
4061 if ($keys) {
4062 %hash=@list;
4063 @list=keys %hash;
4064 } elsif ($key0 or $key1 or $val0 or $val1) {
4065 $i=0;
4066 $i=1 if ($key1 or $val1);
4067 if ($key0 or $key1) {
4068 %hash= map { $_,$i++ } @list;
4069 } else {
4070 %hash= map { $i++,$_ } @list;
4071 }
4072 }
[618]4073 @list=sort _sortByLength(@list) if ($sort);
[360]4074
4075 $ret="($back" . join("|",@list) . ")";
4076 $ret="(?:$pre$ret$post)" if ($pre or $post);
4077 $ret.=$opt;
4078 $ret="(?:$ret|$ws)" if ($ws);
4079
4080 if ($array and $hash) {
4081 return ($ret,%hash);
4082 } elsif ($array) {
4083 return ($ret,@list);
4084 } else {
4085 return $ret;
4086 }
4087}
4088
4089# This will produce a delta with the correct number of signs. At most two
4090# signs will be in it normally (one before the year, and one in front of
4091# the day), but if appropriate, signs will be in front of all elements.
4092# Also, as many of the signs will be equivalent as possible.
[618]4093sub _Delta_Normalize {
4094 print "DEBUG: _Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
[360]4095 my($delta,$mode)=@_;
4096 return "" if (! $delta);
4097 return "+0:+0:+0:+0:+0:+0:+0"
4098 if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"});
4099 return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/);
4100
4101 my($tmp,$sign1,$sign2,$len)=();
4102
4103 # Calculate the length of the day in minutes
4104 $len=24*60;
4105 $len=$Curr{"WDlen"} if ($mode==2 || $mode==3);
4106
4107 # We have to get the sign of every component explicitely so that a "-0"
4108 # or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must
4109 # be a negative delta).
4110
[618]4111 my($y,$mon,$w,$d,$h,$m,$s)=_Delta_Split($delta);
[360]4112
4113 # We need to make sure that the signs of all parts of a delta are the
4114 # same. The easiest way to do this is to convert all of the large
4115 # components to the smallest ones, then convert the smaller components
4116 # back to the larger ones.
4117
4118 # Do the year/month part
4119
4120 $mon += $y*12; # convert y to m
4121 $sign1="+";
4122 if ($mon<0) {
4123 $mon *= -1;
4124 $sign1="-";
4125 }
4126
4127 $y = $mon/12; # convert m to y
4128 $mon -= $y*12;
4129
4130 $y=0 if ($y eq "-0"); # get around silly -0 problem
4131 $mon=0 if ($mon eq "-0");
4132
4133 # Do the wk/day/hour/min/sec part
4134
4135 {
4136 # Unfortunately, $s is overflowing for dates more than ~70 years
4137 # apart.
4138 no integer;
4139
4140 if ($mode==3 || $mode==2) {
4141 $s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
4142 } else {
4143 $s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
4144 }
4145 $sign2="+";
4146 if ($s<0) {
4147 $s*=-1;
4148 $sign2="-";
4149 }
4150
4151 $m = int($s/60); # convert s to m
4152 $s -= $m*60;
4153 $d = int($m/$len); # convert m to d
4154 $m -= $d*$len;
4155
4156 # The rest should be fine.
4157 }
4158 $h = $m/60; # convert m to h
4159 $m -= $h*60;
4160 if ($mode == 3 || $mode == 2) {
4161 $w = $w*1; # get around +0 problem
4162 } else {
4163 $w = $d/7; # convert d to w
4164 $d -= $w*7;
4165 }
4166
4167 $w=0 if ($w eq "-0"); # get around silly -0 problem
4168 $d=0 if ($d eq "-0");
4169 $h=0 if ($h eq "-0");
4170 $m=0 if ($m eq "-0");
4171 $s=0 if ($s eq "-0");
4172
4173 # Only include two signs if necessary
4174 $sign1=$sign2 if ($y==0 and $mon==0);
4175 $sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0);
4176 $sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"});
4177
4178 if ($Cnf{"DeltaSigns"}) {
4179 return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s";
4180 } else {
4181 return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s";
4182 }
4183}
4184
4185# This checks a delta to make sure it is valid. If it is, it splits
4186# it and returns the elements with a sign on each. The 2nd argument
4187# specifies the default sign. Blank elements are set to 0. If the
4188# third element is non-nil, exactly 7 elements must be included.
[618]4189sub _Delta_Split {
4190 print "DEBUG: _Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
[360]4191 my($delta,$sign,$exact)=@_;
4192 my(@delta)=split(/:/,$delta);
4193 return () if ($exact and $#delta != 6);
4194 my($i)=();
4195 $sign="+" if (! defined $sign);
4196 for ($i=0; $i<=$#delta; $i++) {
4197 $delta[$i]="0" if (! $delta[$i]);
4198 return () if ($delta[$i] !~ /^[+-]?\d+$/);
4199 $sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign);
4200 $delta[$i] = $sign.$delta[$i];
4201 }
4202 @delta;
4203}
4204
4205# Reads up to 3 arguments. $h may contain the time in any international
4206# format. Any empty elements are set to 0.
[618]4207sub _Date_ParseTime {
4208 print "DEBUG: _Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
[360]4209 my($h,$m,$s)=@_;
[618]4210 my($t)=_CheckTime("one");
[360]4211
4212 if (defined $h and $h =~ /$t/) {
4213 $h=$1;
4214 $m=$2;
4215 $s=$3 if (defined $3);
4216 }
4217 $h="00" if (! defined $h);
4218 $m="00" if (! defined $m);
4219 $s="00" if (! defined $s);
4220
4221 ($h,$m,$s);
4222}
4223
4224# Forms a date with the 6 elements passed in (all of which must be defined).
4225# No check as to validity is made.
[618]4226sub _Date_Join {
4227 print "DEBUG: _Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
[360]4228 foreach (0 .. $#_) {
[618]4229 croak "undefined arg $_ to _Date_Join()" if not defined $_[$_];
[360]4230 }
4231 my($y,$m,$d,$h,$mn,$s)=@_;
4232 my($ym,$md,$dh,$hmn,$mns)=();
4233
4234 if ($Cnf{"Internal"} == 0) {
4235 $ym=$md=$dh="";
4236 $hmn=$mns=":";
4237
4238 } elsif ($Cnf{"Internal"} == 1) {
4239 $ym=$md=$dh=$hmn=$mns="";
4240
4241 } elsif ($Cnf{"Internal"} == 2) {
4242 $ym=$md="-";
4243 $dh=" ";
4244 $hmn=$mns=":";
4245
4246 } else {
[618]4247 confess "ERROR: Invalid internal format in _Date_Join.\n";
[360]4248 }
4249 $m="0$m" if (length($m)==1);
4250 $d="0$d" if (length($d)==1);
4251 $h="0$h" if (length($h)==1);
4252 $mn="0$mn" if (length($mn)==1);
4253 $s="0$s" if (length($s)==1);
4254 "$y$ym$m$md$d$dh$h$hmn$mn$mns$s";
4255}
4256
4257# This checks a time. If it is valid, it splits it and returns 3 elements.
4258# If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is
4259# returned.
[618]4260sub _CheckTime {
4261 print "DEBUG: _CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
[360]4262 my($time)=@_;
4263 my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
4264 my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
4265 my($m)='[0-5][0-9]';
4266 my($s)=$m;
4267 my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)";
4268 my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)";
4269 my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"};
4270 my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4271 if ($time eq "one") {
4272 return $t;
4273 } elsif ($time eq "two") {
4274 $t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4275 return $t;
4276 }
4277
4278 if ($time =~ /$t/i) {
4279 ($h,$m,$s)=($1,$2,$3);
4280 $h="0$h" if (length($h)<2);
4281 $m="0$m" if (length($m)<2);
4282 $s="00" if (! defined $s);
4283 return ($h,$m,$s);
4284 } else {
4285 return ();
4286 }
4287}
4288
4289# This checks a recurrence. If it is valid, it splits it and returns the
4290# elements. Otherwise, it returns an empty list.
[618]4291# ($recur0,$recur1,$flags,$dateb,$date0,$date1)=_Recur_Split($recur);
4292sub _Recur_Split {
4293 print "DEBUG: _Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
[360]4294 my($recur)=@_;
4295 my(@ret,@tmp);
4296
4297 my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
4298 my($F) = '(?:\*([^*]*))';
4299 my($DB,$D0,$D1);
4300 $DB=$D0=$D1=$F;
4301
4302 if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
4303 @ret=($1,$2,$3,$4,$5);
4304 @tmp=split(/\*/,shift(@ret));
4305 return () if ($#tmp>1);
4306 return (@tmp,"",@ret) if ($#tmp==0);
4307 return (@tmp,@ret);
4308 }
4309 return ();
4310}
4311
4312# This checks a date. If it is valid, it splits it and returns the elements.
4313#
4314# The optional second argument says 'I really expect this to be a
4315# valid Date::Manip object, please throw an exception if it is not'.
4316# Otherwise, if the date passed in is undef or '', a regular
4317# expression for the date is returned; if the string is nonempty but
4318# still not valid, () is returned.
4319#
[618]4320sub _Date_Split {
4321 print "DEBUG: _Date_Split\n" if ($Curr{"Debug"} =~ /trace/);
[360]4322 my($date, $definitely_valid)=@_;
4323 $definitely_valid = 0 if not defined $definitely_valid;
4324 my($ym,$md,$dh,$hmn,$mns)=();
4325 my($y)='(\d{4})';
4326 my($m)='(0[1-9]|1[0-2])';
4327 my($d)='(0[1-9]|[1-2][0-9]|3[0-1])';
4328 my($h)='([0-1][0-9]|2[0-3])';
4329 my($mn)='([0-5][0-9])';
4330 my($s)=$mn;
4331
4332 if ($Cnf{"Internal"} == 0) {
4333 $ym=$md=$dh="";
4334 $hmn=$mns=":";
4335
4336 } elsif ($Cnf{"Internal"} == 1) {
4337 $ym=$md=$dh=$hmn=$mns="";
4338
4339 } elsif ($Cnf{"Internal"} == 2) {
4340 $ym=$md="-";
4341 $dh=" ";
4342 $hmn=$mns=":";
4343
4344 } else {
[618]4345 confess "ERROR: Invalid internal format in _Date_Split.\n";
[360]4346 }
4347
4348 my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$";
4349
4350 if (not defined $date or $date eq '') {
4351 if ($definitely_valid) {
4352 die "bad date '$date'";
4353 } else {
4354 return $t;
4355 }
4356 }
4357
4358 if ($date =~ /$t/) {
4359 ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
4360 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
[618]4361 $d_in_m[2]=29 if (Date_LeapYear($y));
[360]4362 if ($d>$d_in_m[$m]) {
4363 my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
4364 if ($definitely_valid) {
4365 die $msg;
4366 }
4367 else {
4368 warn $msg;
4369 return ();
4370 }
4371 }
4372 return ($y,$m,$d,$h,$mn,$s);
4373 }
4374
4375 if ($definitely_valid) {
4376 die "invalid date $date: doesn't match regexp $t";
4377 }
4378 return ();
4379}
4380
4381# This returns the date easter occurs on for a given year as ($month,$day).
4382# This is from the Calendar FAQ.
[618]4383sub _Date_Easter {
[360]4384 my($y)=@_;
[618]4385 $y=_Date_FixYear($y) if (length($y)==2);
[360]4386
4387 my($c) = $y/100;
4388 my($g) = $y % 19;
4389 my($k) = ($c-17)/25;
4390 my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30;
4391 $i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11));
4392 my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7;
4393 my($l) = $i-$j;
4394 my($m) = 3 + ($l+40)/44;
4395 my($d) = $l + 28 - 31*($m/4);
4396 return ($m,$d);
4397}
4398
4399# This takes a list of years, months, WeekOfMonth's, and DayOfWeek's, and
4400# returns a list of dates. Optionally, a list of dates can be passed in as
4401# the 1st argument (with the 2nd argument the null list) and the year/month
4402# of these will be used.
[618]4403sub _Date_Recur_WoM {
[360]4404 my($y,$m,$w,$d)=@_;
4405 my(@y)=@$y;
4406 my(@m)=@$m;
4407 my(@w)=@$w;
4408 my(@d)=@$d;
4409 my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
4410
4411 if (@m) {
4412 foreach $m (@m) {
[618]4413 return () if (! _IsInt($m,1,12));
[360]4414 }
4415
4416 @tmp=@tmp2=();
4417 foreach $y (@y) {
4418 foreach $m (@m) {
4419 push(@tmp,$y);
4420 push(@tmp2,$m);
4421 }
4422 }
4423
4424 @y=@tmp;
4425 @m=@tmp2;
4426
4427 } else {
4428 foreach $d0 (@y) {
[618]4429 @tmp=_Date_Split($d0);
[360]4430 return () if (! @tmp);
4431 push(@tmp2,$tmp[0]);
4432 push(@m,$tmp[1]);
4433 }
4434 @y=@tmp2;
4435 }
4436
4437 return () if (! @w);
4438 foreach $w (@w) {
[618]4439 return () if ($w==0 || ! _IsInt($w,-5,5));
[360]4440 }
4441
4442 if (@d) {
4443 foreach $d (@d) {
[618]4444 return () if ($d==0 || ! _IsInt($d,-7,7));
[360]4445 $d += 8 if ($d < 0);
4446 }
4447 }
4448
4449 @date=();
4450 foreach $y (@y) {
4451 $m=shift(@m);
4452
4453 # Find 1st day of this month and next month
[618]4454 $date0=_Date_Join($y,$m,1,0,0,0);
4455 $date1=_DateCalc_DateDelta($date0,"+0:1:0:0:0:0:0");
[360]4456
4457 foreach $d (@d) {
4458 # Find 1st occurence of DOW (in both months)
[618]4459 $d0=Date_GetNext($date0,$d,1);
4460 $d1=Date_GetNext($date1,$d,1);
[360]4461
4462 @tmp=();
[618]4463 while (Date_Cmp($d0,$d1)<0) {
[360]4464 push(@tmp,$d0);
[618]4465 $d0=_DateCalc_DateDelta($d0,"+0:0:1:0:0:0:0");
[360]4466 }
4467
4468 @tmp2=();
4469 foreach $w (@w) {
4470 if ($w>0) {
4471 next if ($w > $#tmp+1);
4472 push(@tmp2,$tmp[$w-1]);
4473 } else {
4474 next if (-$w > $#tmp+1);
4475 push(@tmp2,$tmp[$#tmp+1+$w]);
4476 }
4477 }
4478 @tmp2=sort { Date_Cmp($a,$b) } @tmp2;
4479 push(@date,@tmp2);
4480 }
4481 }
4482
4483 @date;
4484}
4485
4486# This returns a sorted list of dates formed by adding/subtracting
4487# $delta to $dateb in the range $date0<=$d<$dateb. The first date in
4488# the list is actually the first date<$date0 and the last date in the
4489# list is the first date>=$date1 (because sometimes the set part will
4490# move the date back into the range).
[618]4491sub _Date_Recur {
[360]4492 my($date0,$date1,$dateb,$delta)=@_;
4493 my(@ret,$d)=();
4494
[618]4495 while (Date_Cmp($dateb,$date0)<0) {
4496 $dateb=_DateCalc_DateDelta($dateb,$delta);
[360]4497 }
[618]4498 while (Date_Cmp($dateb,$date1)>=0) {
4499 $dateb=_DateCalc_DateDelta($dateb,"-$delta");
[360]4500 }
4501
4502 # Add the dates $date0..$dateb
4503 $d=$dateb;
[618]4504 while (Date_Cmp($d,$date0)>=0) {
[360]4505 unshift(@ret,$d);
[618]4506 $d=_DateCalc_DateDelta($d,"-$delta");
[360]4507 }
4508 # Add the first date earler than the range
4509 unshift(@ret,$d);
4510
4511 # Add the dates $dateb..$date1
[618]4512 $d=_DateCalc_DateDelta($dateb,$delta);
4513 while (Date_Cmp($d,$date1)<0) {
[360]4514 push(@ret,$d);
[618]4515 $d=_DateCalc_DateDelta($d,$delta);
[360]4516 }
4517 # Add the first date later than the range
4518 push(@ret,$d);
4519
4520 @ret;
4521}
4522
4523# This sets the values in each date of a recurrence.
4524#
4525# $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1",
4526# they are not set (and none of the larger elements are set).
[618]4527sub _Date_RecurSetTime {
[360]4528 my($date0,$date1,$dates,$h,$m,$s)=@_;
4529 my(@dates)=@$dates;
4530 my(@h,@m,@s,$date,@tmp)=();
4531
4532 $m="-1" if ($s eq "-1");
4533 $h="-1" if ($m eq "-1");
4534
4535 if ($h ne "-1") {
[618]4536 @h=_ReturnList($h);
[360]4537 return () if ! (@h);
4538 @h=sort { $a<=>$b } (@h);
4539
4540 @tmp=();
4541 foreach $date (@dates) {
4542 foreach $h (@h) {
[618]4543 push(@tmp,Date_SetDateField($date,"h",$h,1));
[360]4544 }
4545 }
4546 @dates=@tmp;
4547 }
4548
4549 if ($m ne "-1") {
[618]4550 @m=_ReturnList($m);
[360]4551 return () if ! (@m);
4552 @m=sort { $a<=>$b } (@m);
4553
4554 @tmp=();
4555 foreach $date (@dates) {
4556 foreach $m (@m) {
[618]4557 push(@tmp,Date_SetDateField($date,"mn",$m,1));
[360]4558 }
4559 }
4560 @dates=@tmp;
4561 }
4562
4563 if ($s ne "-1") {
[618]4564 @s=_ReturnList($s);
[360]4565 return () if ! (@s);
4566 @s=sort { $a<=>$b } (@s);
4567
4568 @tmp=();
4569 foreach $date (@dates) {
4570 foreach $s (@s) {
[618]4571 push(@tmp,Date_SetDateField($date,"s",$s,1));
[360]4572 }
4573 }
4574 @dates=@tmp;
4575 }
4576
4577 @tmp=();
4578 foreach $date (@dates) {
[618]4579 push(@tmp,$date) if (Date_Cmp($date,$date0)>=0 &&
4580 Date_Cmp($date,$date1)<0 &&
4581 _Date_Split($date));
[360]4582 }
4583
4584 @tmp;
4585}
4586
[618]4587sub _DateCalc_DateDate {
4588 print "DEBUG: _DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
[360]4589 my($D1,$D2,$mode)=@_;
4590 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4591 $mode=0 if (! defined $mode);
4592
4593 # Exact mode
4594 if ($mode==0) {
[618]4595 my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($D1, 1);
4596 my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($D2, 1);
[360]4597 my($i,@delta,$d,$delta,$y)=();
4598
4599 # form the delta for hour/min/sec
4600 $delta[4]=$h2-$h1;
4601 $delta[5]=$mn2-$mn1;
4602 $delta[6]=$s2-$s1;
4603
4604 # form the delta for yr/mon/day
4605 $delta[0]=$delta[1]=0;
4606 $d=0;
4607 if ($y2>$y1) {
[618]4608 $d=Date_DaysInYear($y1) - Date_DayOfYear($m1,$d1,$y1);
4609 $d+=Date_DayOfYear($m2,$d2,$y2);
[360]4610 for ($y=$y1+1; $y<$y2; $y++) {
[618]4611 $d+= Date_DaysInYear($y);
[360]4612 }
4613 } elsif ($y2<$y1) {
[618]4614 $d=Date_DaysInYear($y2) - Date_DayOfYear($m2,$d2,$y2);
4615 $d+=Date_DayOfYear($m1,$d1,$y1);
[360]4616 for ($y=$y2+1; $y<$y1; $y++) {
[618]4617 $d+= Date_DaysInYear($y);
[360]4618 }
4619 $d *= -1;
4620 } else {
[618]4621 $d=Date_DayOfYear($m2,$d2,$y2) - Date_DayOfYear($m1,$d1,$y1);
[360]4622 }
4623 $delta[2]=0;
4624 $delta[3]=$d;
4625
4626 for ($i=0; $i<7; $i++) {
4627 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4628 }
4629
4630 $delta=join(":",@delta);
[618]4631 $delta=_Delta_Normalize($delta,0);
[360]4632 return $delta;
4633 }
4634
4635 my($date1,$date2)=($D1,$D2);
4636 my($tmp,$sign,$err,@tmp)=();
4637
4638 # make sure both are work days
4639 if ($mode==2 || $mode==3) {
[618]4640 $date1=Date_NextWorkDay($date1,0,1);
4641 $date2=Date_NextWorkDay($date2,0,1);
[360]4642 }
4643
4644 # make sure date1 comes before date2
[618]4645 if (Date_Cmp($date1,$date2)>0) {
[360]4646 $sign="-";
4647 $tmp=$date1;
4648 $date1=$date2;
4649 $date2=$tmp;
4650 } else {
4651 $sign="+";
4652 }
[618]4653 if (Date_Cmp($date1,$date2)==0) {
[360]4654 return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
4655 return "+0:0:0:0:0:0:0";
4656 }
4657
[618]4658 my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($date1, 1);
4659 my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($date2, 1);
[360]4660 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0);
4661
4662 if ($mode != 3) {
4663
4664 # Do years
4665 $dy=$y2-$y1;
4666 $dm=0;
4667 if ($dy>0) {
[618]4668 $tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0);
4669 if (Date_Cmp($tmp,$date2)>0) {
[360]4670 $dy--;
4671 $tmp=$date1;
[618]4672 $tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0)
[360]4673 if ($dy>0);
4674 $dm=12;
4675 }
4676 $date1=$tmp;
4677 }
4678
4679 # Do months
4680 $dm+=$m2-$m1;
4681 if ($dm>0) {
[618]4682 $tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0);
4683 if (Date_Cmp($tmp,$date2)>0) {
[360]4684 $dm--;
4685 $tmp=$date1;
[618]4686 $tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0)
[360]4687 if ($dm>0);
4688 }
4689 $date1=$tmp;
4690 }
4691
4692 # At this point, check to see that we're on a business day again so that
4693 # Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month
4694 if ($mode==2) {
[618]4695 if (! Date_IsWorkDay($date1,0)) {
4696 $date1=Date_NextWorkDay($date1,0,1);
[360]4697 }
4698 }
4699 }
4700
4701 # Do days
4702 if ($mode==2 || $mode==3) {
4703 $dd=0;
4704 while (1) {
[618]4705 $tmp=Date_NextWorkDay($date1,1,1);
4706 if (Date_Cmp($tmp,$date2)<=0) {
[360]4707 $dd++;
4708 $date1=$tmp;
4709 } else {
4710 last;
4711 }
4712 }
4713
4714 } else {
[618]4715 ($y1,$m1,$d1)=( _Date_Split($date1, 1) )[0..2];
[360]4716 $dd=0;
4717 # If we're jumping across months, set $d1 to the first of the next month
4718 # (or possibly the 0th of next month which is equivalent to the last day
4719 # of this month)
4720 if ($m1!=$m2) {
[618]4721 $d_in_m[2]=29 if (Date_LeapYear($y1));
[360]4722 $dd=$d_in_m[$m1]-$d1+1;
4723 $d1=1;
[618]4724 $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4725 if (Date_Cmp($tmp,$date2)>0) {
[360]4726 $dd--;
4727 $d1--;
[618]4728 $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
[360]4729 }
4730 $date1=$tmp;
4731 }
4732
4733 $ddd=0;
4734 if ($d1<$d2) {
4735 $ddd=$d2-$d1;
[618]4736 $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4737 if (Date_Cmp($tmp,$date2)>0) {
[360]4738 $ddd--;
[618]4739 $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
[360]4740 }
4741 $date1=$tmp;
4742 }
4743 $dd+=$ddd;
4744 }
4745
4746 # in business mode, make sure h1 comes before h2 (if not find delta between
4747 # now and end of day and move to start of next business day)
[618]4748 $d1=( _Date_Split($date1, 1) )[2];
[360]4749 $dh=$dmn=$ds=0;
4750 if ($mode==2 || $mode==3 and $d1 != $d2) {
[618]4751 $tmp=Date_SetTime($date1,$Cnf{"WorkDayEnd"});
4752 $tmp=_DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0")
[360]4753 if ($Cnf{"WorkDay24Hr"});
[618]4754 $tmp=_DateCalc_DateDate($date1,$tmp,0);
4755 ($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=_Delta_Split($tmp);
4756 $date1=Date_NextWorkDay($date1,1,0);
4757 $date1=Date_SetTime($date1,$Cnf{"WorkDayBeg"});
4758 $d1=( _Date_Split($date1, 1) )[2];
[360]4759 confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2);
4760 }
4761
4762 # Hours, minutes, seconds
[618]4763 $tmp=_DateCalc_DateDate($date1,$date2,0);
4764 @tmp=_Delta_Split($tmp);
[360]4765 $dh += $tmp[4];
4766 $dmn += $tmp[5];
4767 $ds += $tmp[6];
4768
4769 $tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds";
[618]4770 _Delta_Normalize($tmp,$mode);
[360]4771}
4772
[618]4773sub _DateCalc_DeltaDelta {
4774 print "DEBUG: _DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/);
[360]4775 my($D1,$D2,$mode)=@_;
4776 my(@delta1,@delta2,$i,$delta,@delta)=();
4777 $mode=0 if (! defined $mode);
4778
[618]4779 @delta1=_Delta_Split($D1);
4780 @delta2=_Delta_Split($D2);
[360]4781 for ($i=0; $i<7; $i++) {
4782 $delta[$i]=$delta1[$i]+$delta2[$i];
4783 $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4784 }
4785
4786 $delta=join(":",@delta);
[618]4787 $delta=_Delta_Normalize($delta,$mode);
[360]4788 return $delta;
4789}
4790
[618]4791sub _DateCalc_DateDelta {
4792 print "DEBUG: _DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
[360]4793 my($D1,$D2,$errref,$mode)=@_;
4794 my($date)=();
4795 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4796 my($h1,$m1,$h2,$m2,$len,$hh,$mm)=();
4797 $mode=0 if (! defined $mode);
4798
4799 if ($mode==2 || $mode==3) {
4800 $h1=$Curr{"WDBh"};
4801 $m1=$Curr{"WDBm"};
4802 $h2=$Curr{"WDEh"};
4803 $m2=$Curr{"WDEm"};
4804 $hh=$h2-$h1;
4805 $mm=$m2-$m1;
4806 if ($mm<0) {
4807 $hh--;
4808 $mm+=60;
4809 }
4810 }
4811
4812 # Date, delta
[618]4813 my($y,$m,$d,$h,$mn,$s)=_Date_Split($D1, 1);
4814 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=_Delta_Split($D2);
[360]4815
4816 # do the month/year part
4817 $y+=$dy;
4818 while (length($y)<4) {
4819 $y = "0$y";
4820 }
[618]4821 _ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11
4822 $d_in_m[2]=29 if (Date_LeapYear($y));
[360]4823
4824 # if we have gone past the last day of a month, move the date back to
4825 # the last day of the month
4826 if ($d>$d_in_m[$m]) {
4827 $d=$d_in_m[$m];
4828 }
4829
4830 # do the week part
4831 if ($mode==0 || $mode==1) {
4832 $dd += $dw*7;
4833 } else {
[618]4834 $date=_DateCalc_DateDelta(_Date_Join($y,$m,$d,$h,$mn,$s),
[360]4835 "+0:0:$dw:0:0:0:0",0);
[618]4836 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
[360]4837 }
4838
4839 # in business mode, set the day to a work day at this point so the h/mn/s
4840 # stuff will work out
4841 if ($mode==2 || $mode==3) {
4842 $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
[618]4843 $date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),0,1);
4844 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
[360]4845 }
4846
4847 # seconds, minutes, hours
[618]4848 _ModuloAddition(60,$ds,\$s,\$mn);
[360]4849 if ($mode==2 || $mode==3) {
4850 while (1) {
[618]4851 _ModuloAddition(60,$dmn,\$mn,\$h);
[360]4852 $h+= $dh;
4853
4854 if ($h>$h2 or $h==$h2 && $mn>$m2) {
4855 $dh=$h-$h2;
4856 $dmn=$mn-$m2;
4857 $h=$h1;
4858 $mn=$m1;
4859 $dd++;
4860
4861 } elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
4862 $dh=$h-$h1;
4863 $dmn=$m1-$mn;
4864 $h=$h2;
4865 $mn=$m2;
4866 $dd--;
4867
4868 } elsif ($h==$h2 && $mn==$m2) {
4869 $dd++;
4870 $dh=-$hh;
4871 $dmn=-$mm;
4872
4873 } else {
4874 last;
4875 }
4876 }
4877
4878 } else {
[618]4879 _ModuloAddition(60,$dmn,\$mn,\$h);
4880 _ModuloAddition(24,$dh,\$h,\$d);
[360]4881 }
4882
4883 # If we have just gone past the last day of the month, we need to make
4884 # up for this:
4885 if ($d>$d_in_m[$m]) {
4886 $dd+= $d-$d_in_m[$m];
4887 $d=$d_in_m[$m];
4888 }
4889
4890 # days
4891 if ($mode==2 || $mode==3) {
4892 if ($dd>=0) {
[618]4893 $date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),$dd,1);
[360]4894 } else {
[618]4895 $date=Date_PrevWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1);
[360]4896 }
[618]4897 ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
[360]4898
4899 } else {
[618]4900 $d_in_m[2]=29 if (Date_LeapYear($y));
[360]4901 $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
4902 $d += $dd;
4903 while ($d<1) {
4904 $m--;
4905 if ($m==0) {
4906 $m=12;
4907 $y--;
[618]4908 if (Date_LeapYear($y)) {
[360]4909 $d_in_m[2]=29;
4910 } else {
4911 $d_in_m[2]=28;
4912 }
4913 }
4914 $d += $d_in_m[$m];
4915 }
4916 while ($d>$d_in_m[$m]) {
4917 $d -= $d_in_m[$m];
4918 $m++;
4919 if ($m==13) {
4920 $m=1;
4921 $y++;
[618]4922 if (Date_LeapYear($y)) {
[360]4923 $d_in_m[2]=29;
4924 } else {
4925 $d_in_m[2]=28;
4926 }
4927 }
4928 }
4929 }
4930
4931 if ($y<0 or $y>9999) {
4932 $$errref=3;
4933 return;
4934 }
[618]4935 _Date_Join($y,$m,$d,$h,$mn,$s);
[360]4936}
4937
[618]4938sub _Date_UpdateHolidays {
4939 print "DEBUG: _Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
[360]4940 my($year)=@_;
4941 $Holiday{"year"}=$year;
4942 $Holiday{"dates"}{$year}={};
4943
4944 my($date,$delta,$err)=();
4945 my($key,@tmp,$tmp);
4946
4947 foreach $key (keys %{ $Holiday{"desc"} }) {
[618]4948 @tmp=_Recur_Split($key);
[360]4949 if (@tmp) {
[618]4950 $tmp=ParseDateString("${year}010100:00:00");
4951 ($date)=ParseRecur($key,$tmp,$tmp,($year+1)."-01-01");
[360]4952 next if (! $date);
4953
4954 } elsif ($key =~ /^(.*)([+-].*)$/) {
4955 # Date +/- Delta
4956 ($date,$delta)=($1,$2);
[618]4957 $tmp=ParseDateString("$date $year");
[360]4958 if ($tmp) {
4959 $date=$tmp;
4960 } else {
[618]4961 $date=ParseDateString($date);
[360]4962 next if ($date !~ /^$year/);
4963 }
[618]4964 $date=DateCalc($date,$delta,\$err,0);
[360]4965
4966 } else {
4967 # Date
4968 $date=$key;
[618]4969 $tmp=ParseDateString("$date $year");
[360]4970 if ($tmp) {
4971 $date=$tmp;
4972 } else {
[618]4973 $date=ParseDateString($date);
[360]4974 next if ($date !~ /^$year/);
4975 }
4976 }
4977 $Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key};
4978 }
4979}
4980
4981# This sets a Date::Manip config variable.
[618]4982sub _Date_SetConfigVariable {
4983 print "DEBUG: _Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/);
[360]4984 my($var,$val)=@_;
4985
4986 # These are most appropriate for command line options instead of in files.
4987 $Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i);
4988 $Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i);
4989 $Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i);
[618]4990 EraseHolidays(), return if ($var =~ /^EraseHolidays$/i);
[360]4991 $Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i);
4992 $Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i);
4993
4994 $Curr{"InitLang"}=1,
4995 $Cnf{"Language"}=$val, return if ($var =~ /^Language$/i);
4996 $Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i);
4997 $Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i);
4998 $Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i);
4999 $Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i);
5000 $Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i);
5001 $Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i);
5002 $Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i);
5003 $Cnf{"WorkDayBeg"}=$val,
5004 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
5005 $Cnf{"WorkDayEnd"}=$val,
5006 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i);
5007 $Cnf{"WorkDay24Hr"}=$val,
5008 $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i);
5009 $Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i);
5010 $Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i);
5011 $Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i);
5012 $Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i);
5013 $Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i);
5014 $Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i);
5015 $Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i);
5016 $Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i);
5017 $Cnf{"TodayIsMidnight"}=$val, return if ($var =~ /^TodayIsMidnight$/i);
5018
5019 confess "ERROR: Unknown configuration variable $var in Date::Manip.\n";
5020}
5021
5022sub EraseHolidays {
5023 print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
5024
5025 $Cnf{"EraseHolidays"}=0;
5026 delete $Holiday{"list"};
5027 $Holiday{"list"}={};
5028 delete $Holiday{"desc"};
5029 $Holiday{"desc"}={};
5030 $Holiday{"dates"}={};
5031}
5032
5033# This returns a pointer to a list of times and events in the format
5034# [ date [ events ], date, [ events ], ... ]
5035# where each list of events are events that are in effect at the date
5036# immediately preceding the list.
5037#
5038# This takes either one date or two dates as arguments.
[618]5039sub _Events_Calc {
5040 print "DEBUG: _Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
[360]5041
5042 my($date0,$date1)=@_;
5043
5044 my($tmp);
[618]5045 $date0=ParseDateString($date0);
[360]5046 return undef if (! $date0);
5047 if ($date1) {
[618]5048 $date1=ParseDateString($date1);
5049 if (Date_Cmp($date0,$date1)>0) {
[360]5050 $tmp=$date1;
5051 $date1=$date0;
5052 $date0=$tmp;
5053 }
5054 } else {
[618]5055 $date1=_DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1");
[360]5056 }
5057
5058 #
5059 # [ d0,d1,del,name ] => [ d0, d1+del )
5060 # [ d0,0,del,name ] => [ d0, d0+del )
5061 #
5062 my(%ret,$d0,$d1,$del,$name,$c0,$c1);
5063 my(@tmp)=@{ $Events{"dates"} };
5064 DATE: while (@tmp) {
5065 ($d0,$d1,$del,$name)=splice(@tmp,0,4);
[618]5066 $d0=ParseDateString($d0);
5067 $d1=ParseDateString($d1) if ($d1);
5068 $del=ParseDateDelta($del) if ($del);
[360]5069 if ($d1) {
5070 if ($del) {
[618]5071 $d1=_DateCalc_DateDelta($d1,$del);
[360]5072 }
5073 } else {
[618]5074 $d1=_DateCalc_DateDelta($d0,$del);
[360]5075 }
[618]5076 if (Date_Cmp($d0,$d1)>0) {
[360]5077 $tmp=$d1;
5078 $d1=$d0;
5079 $d0=$tmp;
5080 }
5081 # [ date0,date1 )
5082 # [ d0,d1 ) OR [ d0,d1 )
[618]5083 next DATE if (Date_Cmp($d1,$date0)<=0 ||
5084 Date_Cmp($d0,$date1)>=0);
[360]5085 # [ date0,date1 )
5086 # [ d0,d1 )
5087 # [ d0, d1 )
[618]5088 if (Date_Cmp($d0,$date0)<=0) {
[360]5089 push @{ $ret{$date0} },$name;
[618]5090 push @{ $ret{$d1} },"!$name" if (Date_Cmp($d1,$date1)<0);
[360]5091 next DATE;
5092 }
5093 # [ date0,date1 )
5094 # [ d0,d1 )
[618]5095 if (Date_Cmp($d1,$date1)>=0) {
[360]5096 push @{ $ret{$d0} },$name;
5097 next DATE;
5098 }
5099 # [ date0,date1 )
5100 # [ d0,d1 )
5101 push @{ $ret{$d0} },$name;
5102 push @{ $ret{$d1} },"!$name";
5103 }
5104
5105 #
5106 # [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
5107 #
5108 my($rec,$del0,$del1,@d);
5109 @tmp=@{ $Events{"recur"} };
5110 RECUR: while (@tmp) {
5111 ($rec,$del0,$del1,$name)=splice(@tmp,0,4);
5112 @d=();
5113
5114 }
5115
5116 # Sort them AND take into account the "!$name" entries.
5117 my(%tmp,$date,@tmp2,@ret);
[618]5118 @d=sort { Date_Cmp($a,$b) } keys %ret;
[360]5119 foreach $date (@d) {
5120 @tmp=@{ $ret{$date} };
5121 @tmp2=();
5122 foreach $tmp (@tmp) {
5123 push(@tmp2,$tmp), next if ($tmp =~ /^!/);
5124 $tmp{$tmp}=1;
5125 }
5126 foreach $tmp (@tmp2) {
5127 $tmp =~ s/^!//;
5128 delete $tmp{$tmp};
5129 }
5130 push(@ret,$date,[ keys %tmp ]);
5131 }
5132
5133 %tmp = @ret;
5134 @ret = ();
5135 foreach my $d (sort { Date_Cmp($a,$b) } keys %tmp) {
5136 my $e = $tmp{$d};
5137 push @ret,($d,[ sort @$e ]);
5138 }
5139 return \@ret;
5140}
5141
5142# This parses the raw events list
[618]5143sub _Events_ParseRaw {
5144 print "DEBUG: _Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
[360]5145
5146 # Only need to be parsed once
5147 my($force)=@_;
5148 $Events{"parsed"}=0 if ($force);
5149 return if ($Events{"parsed"});
5150 $Events{"parsed"}=1;
5151
5152 my(@events)=@{ $Events{"raw"} };
5153 my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
5154 $recur);
5155 EVENT: while (@events) {
5156 ($event,$name)=splice(@events,0,2);
5157 @event=split(/\s*;\s*/,$event);
5158
5159 if ($#event == 0) {
5160
[618]5161 if ($date0=ParseDateString($event[0])) {
[360]5162 #
5163 # date = event
5164 #
[618]5165 $tmp=ParseDateString("$event[0] 00:00:00");
[360]5166 if ($tmp && $tmp eq $date0) {
5167 $delta="+0:0:0:1:0:0:0";
5168 } else {
5169 $delta="+0:0:0:0:1:0:0";
5170 }
5171 push @{ $Events{"dates"} },($date0,0,$delta,$name);
5172
[618]5173 } elsif ($recur=ParseRecur($event[0])) {
[360]5174 #
5175 # recur = event
5176 #
[618]5177 ($recur0,$recur1)=_Recur_Split($recur);
[360]5178 if ($recur0) {
5179 if ($recur1) {
5180 $r="$recur0:$recur1";
5181 } else {
5182 $r=$recur0;
5183 }
5184 } else {
5185 $r=$recur1;
5186 }
5187 (@recur)=split(/:/,$r);
5188 if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
5189 $delta="+0:0:0:1:0:0:0";
5190 } else {
5191 $delta="+0:0:0:0:1:0:0";
5192 }
5193 push @{ $Events{"recur"} },($recur,0,$delta,$name);
5194
5195 } else {
5196 # ??? = event
5197 warn "WARNING: illegal event ignored [ @event ]\n";
5198 next EVENT;
5199 }
5200
5201 } elsif ($#event == 1) {
5202
[618]5203 if ($date0=ParseDateString($event[0])) {
[360]5204
[618]5205 if ($date1=ParseDateString($event[1])) {
[360]5206 #
5207 # date ; date = event
5208 #
[618]5209 $tmp=ParseDateString("$event[1] 00:00:00");
[360]5210 if ($tmp && $tmp eq $date1) {
[618]5211 $date1=_DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0");
[360]5212 }
5213 push @{ $Events{"dates"} },($date0,$date1,0,$name);
5214
[618]5215 } elsif ($delta=ParseDateDelta($event[1])) {
[360]5216 #
5217 # date ; delta = event
5218 #
5219 push @{ $Events{"dates"} },($date0,0,$delta,$name);
5220
5221 } else {
5222 # date ; ??? = event
5223 warn "WARNING: illegal event ignored [ @event ]\n";
5224 next EVENT;
5225 }
5226
[618]5227 } elsif ($recur=ParseRecur($event[0])) {
[360]5228
[618]5229 if ($delta=ParseDateDelta($event[1])) {
[360]5230 #
5231 # recur ; delta = event
5232 #
5233 push @{ $Events{"recur"} },($recur,0,$delta,$name);
5234
5235 } else {
5236 # recur ; ??? = event
5237 warn "WARNING: illegal event ignored [ @event ]\n";
5238 next EVENT;
5239 }
5240
5241 } else {
5242 # ??? ; ??? = event
5243 warn "WARNING: illegal event ignored [ @event ]\n";
5244 next EVENT;
5245 }
5246
5247 } else {
5248 # date ; delta0 ; delta1 = event
5249 # recur ; delta0 ; delta1 = event
5250 # ??? ; ??? ; ??? ... = event
5251 warn "WARNING: illegal event ignored [ @event ]\n";
5252 next EVENT;
5253 }
5254 }
5255}
5256
5257# This reads an init file.
[618]5258sub _Date_InitFile {
5259 print "DEBUG: _Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
[360]5260 my($file)=@_;
5261 my($in)=new IO::File;
5262 local($_)=();
5263 my($section)="vars";
5264 my($var,$val,$recur,$name)=();
5265
5266 $in->open($file) || return;
5267 while(defined ($_=<$in>)) {
5268 chomp;
5269 s/^\s+//;
5270 s/\s+$//;
5271 next if (! $_ or /^\#/);
5272
5273 if (/^\*holiday/i) {
5274 $section="holiday";
[618]5275 EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
[360]5276 next;
5277 } elsif (/^\*events/i) {
5278 $section="events";
5279 next;
5280 }
5281
5282 if ($section =~ /var/i) {
5283 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5284 if (! /(.*\S)\s*=\s*(.*)$/);
5285 ($var,$val)=($1,$2);
[618]5286 _Date_SetConfigVariable($var,$val);
[360]5287
5288 } elsif ($section =~ /holiday/i) {
5289 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5290 if (! /(.*\S)\s*=\s*(.*)$/);
5291 ($recur,$name)=($1,$2);
5292 $name="" if (! defined $name);
5293 $Holiday{"desc"}{$recur}=$name;
5294
5295 } elsif ($section =~ /events/i) {
5296 confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5297 if (! /(.*\S)\s*=\s*(.*)$/);
5298 ($val,$var)=($1,$2);
5299 push @{ $Events{"raw"} },($val,$var);
5300
5301 } else {
5302 # A section not currently used by Date::Manip (but may be
5303 # used by some extension to it).
5304 next;
5305 }
5306 }
5307 close($in);
5308}
5309
[618]5310# $flag=_Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
[360]5311# Returns 1 if any of the fields are bad. All fields are optional, and
5312# all possible checks are done on the data. If a field is not passed in,
5313# it is set to default values. If data is missing, appropriate defaults
5314# are supplied.
[618]5315sub _Date_TimeCheck {
5316 print "DEBUG: _Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
[360]5317 my($h,$mn,$s,$ampm)=@_;
5318 my($tmp1,$tmp2,$tmp3)=();
5319
5320 $$h="" if (! defined $$h);
5321 $$mn="" if (! defined $$mn);
5322 $$s="" if (! defined $$s);
5323 $$ampm="" if (! defined $$ampm);
5324 $$ampm=uc($$ampm) if ($$ampm);
5325
5326 # Check hour
5327 $tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
5328 $tmp2="";
5329 if ($$ampm =~ /^$tmp1$/i) {
5330 $tmp3=$Lang{$Cnf{"Language"}}{"AM"};
5331 $tmp2="AM" if ($$ampm =~ /^$tmp3$/i);
5332 $tmp3=$Lang{$Cnf{"Language"}}{"PM"};
5333 $tmp2="PM" if ($$ampm =~ /^$tmp3$/i);
5334 } elsif ($$ampm) {
5335 return 1;
5336 }
5337 if ($tmp2 eq "AM" || $tmp2 eq "PM") {
5338 $$h="0$$h" if (length($$h)==1);
5339 return 1 if ($$h<1 || $$h>12);
5340 $$h="00" if ($tmp2 eq "AM" and $$h==12);
5341 $$h += 12 if ($tmp2 eq "PM" and $$h!=12);
5342 } else {
5343 $$h="00" if ($$h eq "");
5344 $$h="0$$h" if (length($$h)==1);
[618]5345 return 1 if (! _IsInt($$h,0,23));
[360]5346 $tmp2="AM" if ($$h<12);
5347 $tmp2="PM" if ($$h>=12);
5348 }
5349 $$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
5350 $$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
5351
5352 # Check minutes
5353 $$mn="00" if ($$mn eq "");
5354 $$mn="0$$mn" if (length($$mn)==1);
[618]5355 return 1 if (! _IsInt($$mn,0,59));
[360]5356
5357 # Check seconds
5358 $$s="00" if ($$s eq "");
5359 $$s="0$$s" if (length($$s)==1);
[618]5360 return 1 if (! _IsInt($$s,0,59));
[360]5361
5362 return 0;
5363}
5364
[618]5365# $flag=_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
[360]5366# Returns 1 if any of the fields are bad. All fields are optional, and
5367# all possible checks are done on the data. If a field is not passed in,
5368# it is set to default values. If data is missing, appropriate defaults
5369# are supplied.
5370#
5371# If the flag UpdateHolidays is set, the year is set to
5372# CurrHolidayYear.
[618]5373sub _Date_DateCheck {
5374 print "DEBUG: _Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/);
[360]5375 my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_;
5376 my($tmp1,$tmp2,$tmp3)=();
5377
5378 my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
5379 my($curr_y)=$Curr{"Y"};
5380 my($curr_m)=$Curr{"M"};
5381 my($curr_d)=$Curr{"D"};
5382 $$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d);
5383 $$y="" if (! defined $$y);
5384 $$m="" if (! defined $$m);
5385 $$d="" if (! defined $$d);
5386 $$wk="" if (! defined $$wk);
5387 $$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq "");
5388
5389 # Check year.
5390 $$y=$curr_y if ($$y eq "");
[618]5391 $$y=_Date_FixYear($$y) if (length($$y)<4);
5392 return 1 if (! _IsInt($$y,0,9999));
5393 $d_in_m[2]=29 if (Date_LeapYear($$y));
[360]5394
5395 # Check month
5396 $$m=$curr_m if ($$m eq "");
5397 $$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}
5398 if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)});
5399 $$m="0$$m" if (length($$m)==1);
[618]5400 return 1 if (! _IsInt($$m,1,12));
[360]5401
5402 # Check day
5403 $$d="01" if ($$d eq "");
5404 $$d="0$$d" if (length($$d)==1);
[618]5405 return 1 if (! _IsInt($$d,1,$d_in_m[$$m]));
[360]5406 if ($$wk) {
[618]5407 $tmp1=Date_DayOfWeek($$m,$$d,$$y);
[360]5408 $tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}
5409 if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)});
5410 return 1 if ($tmp1 != $tmp2);
5411 }
5412
[618]5413 return _Date_TimeCheck($h,$mn,$s,$ampm);
[360]5414}
5415
5416# Takes a year in 2 digit form and returns it in 4 digit form
[618]5417sub _Date_FixYear {
5418 print "DEBUG: _Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
[360]5419 my($y)=@_;
5420 my($curr_y)=$Curr{"Y"};
5421 $y=$curr_y if (! defined $y or ! $y);
5422 return $y if (length($y)==4);
5423 confess "ERROR: Invalid year ($y)\n" if (length($y)!=2);
5424 my($y1,$y2)=();
5425
5426 if (lc($Cnf{"YYtoYYYY"}) eq "c") {
[618]5427 $y1=substr($y,0,2);
[360]5428 $y="$y1$y";
5429
5430 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
5431 $y1=$1;
5432 $y="$y1$y";
5433
5434 } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
5435 $y1="$1$2";
5436 $y ="$1$y";
5437 $y += 100 if ($y<$y1);
5438
5439 } else {
5440 $y1=$curr_y-$Cnf{"YYtoYYYY"};
5441 $y2=$y1+99;
5442 $y="19$y";
5443 while ($y<$y1) {
5444 $y+=100;
5445 }
5446 while ($y>$y2) {
5447 $y-=100;
5448 }
5449 }
5450 $y;
5451}
5452
[618]5453# _Date_NthWeekOfYear($y,$n);
[360]5454# Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
5455# year.
[618]5456# _Date_NthWeekOfYear($y,$n,$dow,$flag);
[360]5457# Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag
5458# is nil, the first DoW of the year may actually be in the previous
5459# year (since the 1st week may include days from the previous year).
5460# If flag is non-nil, the 1st DoW of the year refers to the 1st one
5461# actually in the year
[618]5462sub _Date_NthWeekOfYear {
5463 print "DEBUG: _Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
[360]5464 my($y,$n,$dow,$flag)=@_;
5465 my($m,$d,$err,$tmp,$date,%dow)=();
5466 $y=$Curr{"Y"} if (! defined $y or ! $y);
5467 $n=1 if (! defined $n or $n eq "");
5468 return () if ($n<0 || $n>53);
5469 if (defined $dow) {
5470 $dow=lc($dow);
5471 %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
5472 $dow=$dow{$dow} if (exists $dow{$dow});
5473 return () if ($dow<1 || $dow>7);
5474 $flag="" if (! defined $flag);
5475 } else {
5476 $dow="";
5477 $flag="";
5478 }
5479
[618]5480 $y=_Date_FixYear($y) if (length($y)<4);
[360]5481 if ($Cnf{"Jan1Week1"}) {
[618]5482 $date=_Date_Join($y,1,1,0,0,0);
[360]5483 } else {
[618]5484 $date=_Date_Join($y,1,4,0,0,0);
[360]5485 }
[618]5486 $date=Date_GetPrev($date,$Cnf{"FirstDay"},1);
5487 $date=Date_GetNext($date,$dow,1) if ($dow ne "");
[360]5488
5489 if ($flag) {
[618]5490 ($tmp)=_Date_Split($date, 1);
[360]5491 $n++ if ($tmp != $y);
5492 }
5493
5494 if ($n>1) {
[618]5495 $date=_DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0);
[360]5496 } elsif ($n==0) {
[618]5497 $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0);
[360]5498 }
[618]5499 ($y,$m,$d)=_Date_Split($date, 1);
[360]5500 ($y,$m,$d);
5501}
5502
5503########################################################################
5504# LANGUAGE INITIALIZATION
5505########################################################################
5506
5507# 8-bit international characters can be gotten by "\xXX". I don't know
5508# how to get 16-bit characters. I've got to read up on perllocale.
[618]5509sub _Char_8Bit {
[360]5510 my($hash)=@_;
5511
5512 # grave `
5513 # A` 00c0 a` 00e0
5514 # E` 00c8 e` 00e8
5515 # I` 00cc i` 00ec
5516 # O` 00d2 o` 00f2
5517 # U` 00d9 u` 00f9
5518 # W` 1e80 w` 1e81
5519 # Y` 1ef2 y` 1ef3
5520
5521 $$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE
5522 $$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE
5523 $$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE
5524 $$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE
5525 $$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE
5526 $$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE
5527 $$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE
5528 $$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE
5529 $$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE
5530 $$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE
5531
5532 # acute '
5533 # A' 00c1 a' 00e1
5534 # C' 0106 c' 0107
5535 # E' 00c9 e' 00e9
5536 # I' 00cd i' 00ed
5537 # L' 0139 l' 013a
5538 # N' 0143 n' 0144
5539 # O' 00d3 o' 00f3
5540 # R' 0154 r' 0155
5541 # S' 015a s' 015b
5542 # U' 00da u' 00fa
5543 # W' 1e82 w' 1e83
5544 # Y' 00dd y' 00fd
5545 # Z' 0179 z' 017a
5546
5547 $$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE
5548 $$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE
5549 $$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE
5550 $$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE
5551 $$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE
5552 $$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE
5553 $$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE
5554 $$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE
5555 $$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE
5556 $$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE
5557 $$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE
5558 $$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE
5559
5560 # double acute " "
5561 # O" 0150 o" 0151
5562 # U" 0170 u" 0171
5563
5564 # circumflex ^
5565 # A^ 00c2 a^ 00e2
5566 # C^ 0108 c^ 0109
5567 # E^ 00ca e^ 00ea
5568 # G^ 011c g^ 011d
5569 # H^ 0124 h^ 0125
5570 # I^ 00ce i^ 00ee
5571 # J^ 0134 j^ 0135
5572 # O^ 00d4 o^ 00f4
5573 # S^ 015c s^ 015d
5574 # U^ 00db u^ 00fb
5575 # W^ 0174 w^ 0175
5576 # Y^ 0176 y^ 0177
5577
5578 $$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
5579 $$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
5580 $$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
5581 $$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
5582 $$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
5583 $$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX
5584 $$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX
5585 $$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX
5586 $$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX
5587 $$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX
5588
5589 # tilde ~
5590 # A~ 00c3 a~ 00e3
5591 # I~ 0128 i~ 0129
5592 # N~ 00d1 n~ 00f1
5593 # O~ 00d5 o~ 00f5
5594 # U~ 0168 u~ 0169
5595
5596 $$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE
5597 $$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE
5598 $$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE
5599 $$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE
5600 $$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE
5601 $$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE
5602
5603 # macron -
5604 # A- 0100 a- 0101
5605 # E- 0112 e- 0113
5606 # I- 012a i- 012b
5607 # O- 014c o- 014d
5608 # U- 016a u- 016b
5609
5610 # breve ( [half circle up]
5611 # A( 0102 a( 0103
5612 # G( 011e g( 011f
5613 # U( 016c u( 016d
5614
5615 # dot .
5616 # C. 010a c. 010b
5617 # E. 0116 e. 0117
5618 # G. 0120 g. 0121
5619 # I. 0130
5620 # Z. 017b z. 017c
5621
5622 # diaeresis : [side by side dots]
5623 # A: 00c4 a: 00e4
5624 # E: 00cb e: 00eb
5625 # I: 00cf i: 00ef
5626 # O: 00d6 o: 00f6
5627 # U: 00dc u: 00fc
5628 # W: 1e84 w: 1e85
5629 # Y: 0178 y: 00ff
5630
5631 $$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS
5632 $$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS
5633 $$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS
5634 $$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS
5635 $$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS
5636 $$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS
5637 $$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS
5638 $$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS
5639 $$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS
5640 $$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS
5641 $$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS
5642
5643 # ring o
5644 # U0 016e u0 016f
5645
5646 # cedilla , [squiggle down and left below the letter]
5647 # ,C 00c7 ,c 00e7
5648 # ,G 0122 ,g 0123
5649 # ,K 0136 ,k 0137
5650 # ,L 013b ,l 013c
5651 # ,N 0145 ,n 0146
5652 # ,R 0156 ,r 0157
5653 # ,S 015e ,s 015f
5654 # ,T 0162 ,t 0163
5655
5656 $$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA
5657 $$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA
5658
5659 # ogonek ; [squiggle down and right below the letter]
5660 # A; 0104 a; 0105
5661 # E; 0118 e; 0119
5662 # I; 012e i; 012f
5663 # U; 0172 u; 0173
5664
5665 # caron < [little v on top]
5666 # A< 01cd a< 01ce
5667 # C< 010c c< 010d
5668 # D< 010e d< 010f
5669 # E< 011a e< 011b
5670 # L< 013d l< 013e
5671 # N< 0147 n< 0148
5672 # R< 0158 r< 0159
5673 # S< 0160 s< 0161
5674 # T< 0164 t< 0165
5675 # Z< 017d z< 017e
5676
5677
5678 # Other characters
5679
5680 # First character is below, 2nd character is above
5681 $$hash{"||"} = "\xa6"; # BROKEN BAR
5682 $$hash{" :"} = "\xa8"; # DIAERESIS
5683 $$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR
5684 #$$hash{" -"}= "\xaf"; # MACRON (narrow bar)
5685 $$hash{" -"} = "\xad"; # HYPHEN (wide bar)
5686 $$hash{" o"} = "\xb0"; # DEGREE SIGN
5687 $$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN
5688 $$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE
5689 $$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO
5690 $$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE
5691 $$hash{" '"} = "\xb4"; # ACUTE ACCENT
5692 $$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR
5693 $$hash{" ."} = "\xb7"; # MIDDLE DOT
5694 $$hash{", "} = "\xb8"; # CEDILLA
5695 $$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE
5696 $$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE
5697 $$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH
5698
5699 # upside down characters
5700
5701 $$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
5702 $$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
5703
5704 # overlay characters
5705
5706 $$hash{"X o"} = "\xa4"; # CURRENCY SIGN
5707 $$hash{"Y ="} = "\xa5"; # YEN SIGN
5708 $$hash{"S o"} = "\xa7"; # SECTION SIGN
5709 $$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright
5710 $$hash{"O R"} = "\xae"; # REGISTERED SIGN
5711 $$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH
5712 $$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE
5713 $$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE
5714
5715 # special names
5716
5717 $$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER
5718 $$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF
5719 $$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS
5720 $$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK
5721 $$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK
5722 $$hash{"cent"}= "\xa2"; # CENT SIGN
5723 $$hash{"lb"} = "\xa3"; # POUND SIGN
5724 $$hash{"mu"} = "\xb5"; # MICRO SIGN
5725 $$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S
5726 $$hash{"para"}= "\xb6"; # PILCROW SIGN
5727 $$hash{"-|"} = "\xac"; # NOT SIGN
5728 $$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE
5729 $$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE
5730 $$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN
5731 $$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN
5732 $$hash{"/"} = "\xf7"; # DIVISION SIGN
5733 $$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN
5734}
5735
[618]5736# $hashref = _Date_Init_LANGUAGE;
[360]5737# This returns a hash containing all of the initialization for a
5738# specific language. The hash elements are:
5739#
5740# @ month_name full month names January February ...
5741# @ month_abb month abbreviations Jan Feb ...
5742# @ day_name day names Monday Tuesday ...
5743# @ day_abb day abbreviations Mon Tue ...
5744# @ day_char day character abbrevs M T ...
5745# @ am AM notations
5746# @ pm PM notations
5747#
5748# @ num_suff number with suffix 1st 2nd ...
5749# @ num_word numbers spelled out first second ...
5750#
5751# $ now words which mean now now ...
5752# $ today words which mean today today ...
5753# $ last words which mean last last final ...
5754# $ each words which mean each each every ...
5755# $ of of (as in a member of) in of ...
5756# ex. 4th day OF June
5757# $ at at 4:00 at
5758# $ on on Sunday on
5759# $ future in the future in
5760# $ past in the past ago
5761# $ next next item next
5762# $ prev previous item last previous
5763# $ later 2 hours later
5764#
5765# % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 }
5766# % times a hash of times { noon->12:00:00 ... }
5767#
5768# $ years words for year y yr year ...
5769# $ months words for month
5770# $ weeks words for week
5771# $ days words for day
5772# $ hours words for hour
5773# $ minutes words for minute
5774# $ seconds words for second
5775# % replace
5776# The replace element is quite important, but a bit tricky. In
5777# English (and probably other languages), one of the abbreviations
5778# for the word month that would be nice is "m". The problem is that
5779# "m" matches the "m" in "minute" which causes the string to be
5780# improperly matched in some cases. Hence, the list of abbreviations
5781# for month is given as:
5782# "mon month months"
5783# In order to allow you to enter "m", replacements can be done.
5784# $replace is a list of pairs of words which are matched and replaced
5785# AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that
5786# the entire word "m" will be replaced with "month". This allows the
5787# desired abbreviation to be used. Make sure that replace contains
5788# an even number of words (i.e. all must be pairs). Any time a
5789# desired abbreviation matches the start of any other, it has to go
5790# here.
5791#
5792# $ exact exact mode exactly
5793# $ approx approximate mode approximately
5794# $ business business mode business
5795#
5796# r sephm hour/minute separator (?::)
5797# r sepms minute/second separator (?::)
5798# r sepss second/fraction separator (?:[.:])
5799#
5800# Elements marked with an asterix (@) are returned as a set of lists.
5801# Each list contains the strings for each element. The first set is used
5802# when the 7-bit ASCII (US) character set is wanted. The 2nd set is used
5803# when an international character set is available. Both of the 1st two
5804# sets should be complete (but the 2nd list can be left empty to force the
5805# first set to be used always). The 3rd set and later can be partial sets
5806# if desired.
5807#
5808# Elements marked with a dollar ($) are returned as a simple list of words.
5809#
5810# Elements marked with a percent (%) are returned as a hash list.
5811#
5812# Elements marked with (r) are regular expression elements which must not
5813# create a back reference.
5814#
5815# ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in
5816# every language.
5817
[618]5818sub _Date_Init_English {
5819 print "DEBUG: _Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
[360]5820 my($d)=@_;
5821
5822 $$d{"month_name"}=
5823 [["January","February","March","April","May","June",
5824 "July","August","September","October","November","December"]];
5825
5826 $$d{"month_abb"}=
5827 [["Jan","Feb","Mar","Apr","May","Jun",
5828 "Jul","Aug","Sep","Oct","Nov","Dec"],
5829 [],
5830 ["","","","","","","","","Sept"]];
5831
5832 $$d{"day_name"}=
5833 [["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
5834 $$d{"day_abb"}=
5835 [["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
5836 ["", "Tues","", "Thur","", "", ""]];
5837 $$d{"day_char"}=
5838 [["M","T","W","Th","F","Sa","S"]];
5839
5840 $$d{"num_suff"}=
5841 [["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th",
5842 "11th","12th","13th","14th","15th","16th","17th","18th","19th","20th",
5843 "21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th",
5844 "31st"]];
5845 $$d{"num_word"}=
5846 [["first","second","third","fourth","fifth","sixth","seventh","eighth",
5847 "ninth","tenth","eleventh","twelfth","thirteenth","fourteenth",
5848 "fifteenth","sixteenth","seventeenth","eighteenth","nineteenth",
5849 "twentieth","twenty-first","twenty-second","twenty-third",
5850 "twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh",
5851 "twenty-eighth","twenty-ninth","thirtieth","thirty-first"]];
5852
5853 $$d{"now"} =["now"];
5854 $$d{"today"} =["today"];
5855 $$d{"last"} =["last","final"];
5856 $$d{"each"} =["each","every"];
5857 $$d{"of"} =["in","of"];
5858 $$d{"at"} =["at"];
5859 $$d{"on"} =["on"];
5860 $$d{"future"} =["in"];
5861 $$d{"past"} =["ago"];
5862 $$d{"next"} =["next"];
5863 $$d{"prev"} =["previous","last"];
5864 $$d{"later"} =["later"];
5865
5866 $$d{"exact"} =["exactly"];
5867 $$d{"approx"} =["approximately"];
5868 $$d{"business"}=["business"];
5869
[618]5870 $$d{"offset"} =["yesterday","-0:0:0:1:0:0:0","tomorrow","+0:0:0:1:0:0:0","overmorrow","+0:0:0:2:0:0:0","ereyesterday","-0:0:0:2:0:0:0"];
[360]5871 $$d{"times"} =["noon","12:00:00","midnight","00:00:00"];
5872
5873 $$d{"years"} =["y","yr","year","yrs","years"];
5874 $$d{"months"} =["mon","month","months"];
5875 $$d{"weeks"} =["w","wk","wks","week","weeks"];
5876 $$d{"days"} =["d","day","days"];
5877 $$d{"hours"} =["h","hr","hrs","hour","hours"];
5878 $$d{"minutes"} =["mn","min","minute","minutes"];
5879 $$d{"seconds"} =["s","sec","second","seconds"];
5880 $$d{"replace"} =["m","month"];
5881
5882 $$d{"sephm"} =':';
5883 $$d{"sepms"} =':';
5884 $$d{"sepss"} ='[.:]';
5885
5886 $$d{"am"} = ["AM","A.M."];
5887 $$d{"pm"} = ["PM","P.M."];
5888}
5889
[618]5890sub _Date_Init_Italian {
5891 print "DEBUG: _Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
[360]5892 my($d)=@_;
5893 my(%h)=();
[618]5894 _Char_8Bit(\%h);
[360]5895 my($i)=$h{"i`"};
5896
5897 $$d{"month_name"}=
5898 [[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
5899 Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
5900
5901 $$d{"month_abb"}=
5902 [[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
5903
5904 $$d{"day_name"}=
5905 [[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
5906 [qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
5907 $$d{"day_abb"}=
5908 [[qw(Lun Mar Mer Gio Ven Sab Dom)]];
5909 $$d{"day_char"}=
5910 [[qw(L Ma Me G V S D)]];
5911
5912 $$d{"num_suff"}=
5913 [[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo
5914 16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo
5915 29mo 3mo 31mo)]];
5916 $$d{"num_word"}=
5917 [[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo
5918 undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo
5919 sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo
5920 ventunesimo ventiduesimo ventitreesimo ventiquattresimo
5921 venticinquesimo ventiseiesimo ventisettesimo ventottesimo
5922 ventinovesimo trentesimo trentunesimo)]];
5923
5924 $$d{"now"} =[qw(adesso)];
5925 $$d{"today"} =[qw(oggi)];
5926 $$d{"last"} =[qw(ultimo)];
5927 $$d{"each"} =[qw(ogni)];
5928 $$d{"of"} =[qw(della del)];
5929 $$d{"at"} =[qw(alle)];
5930 $$d{"on"} =[qw(di)];
5931 $$d{"future"} =[qw(fra)];
5932 $$d{"past"} =[qw(fa)];
5933 $$d{"next"} =[qw(prossimo)];
5934 $$d{"prev"} =[qw(ultimo)];
5935 $$d{"later"} =[qw(dopo)];
5936
5937 $$d{"exact"} =[qw(esattamente)];
5938 $$d{"approx"} =[qw(circa)];
5939 $$d{"business"}=[qw(lavorativi lavorativo)];
5940
5941 $$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)];
5942 $$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)];
5943
5944 $$d{"years"} =[qw(anni anno a)];
5945 $$d{"months"} =[qw(mesi mese mes)];
5946 $$d{"weeks"} =[qw(settimane settimana sett)];
5947 $$d{"days"} =[qw(giorni giorno g)];
5948 $$d{"hours"} =[qw(ore ora h)];
5949 $$d{"minutes"} =[qw(minuti minuto min)];
5950 $$d{"seconds"} =[qw(secondi secondo sec)];
5951 $$d{"replace"} =[qw(s sec m mes)];
5952
5953 $$d{"sephm"} =':';
5954 $$d{"sepms"} =':';
5955 $$d{"sepss"} ='[.:]';
5956
5957 $$d{"am"} = [qw(AM)];
5958 $$d{"pm"} = [qw(PM)];
5959}
5960
[618]5961sub _Date_Init_French {
5962 print "DEBUG: _Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
[360]5963 my($d)=@_;
5964 my(%h)=();
[618]5965 _Char_8Bit(\%h);
[360]5966 my($e)=$h{"e'"};
5967 my($u)=$h{"u^"};
5968 my($a)=$h{"a'"};
5969
5970 $$d{"month_name"}=
5971 [["janvier","fevrier","mars","avril","mai","juin",
5972 "juillet","aout","septembre","octobre","novembre","decembre"],
5973 ["janvier","f${e}vrier","mars","avril","mai","juin",
5974 "juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]];
5975 $$d{"month_abb"}=
5976 [["jan","fev","mar","avr","mai","juin",
5977 "juil","aout","sept","oct","nov","dec"],
5978 ["jan","f${e}v","mar","avr","mai","juin",
5979 "juil","ao${u}t","sept","oct","nov","d${e}c"]];
5980
5981 $$d{"day_name"}=
5982 [["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
5983 $$d{"day_abb"}=
5984 [["lun","mar","mer","jeu","ven","sam","dim"]];
5985 $$d{"day_char"}=
5986 [["l","ma","me","j","v","s","d"]];
5987
5988 $$d{"num_suff"}=
5989 [["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e",
5990 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
5991 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
5992 "31e"]];
5993 $$d{"num_word"}=
5994 [["premier","deux","trois","quatre","cinq","six","sept","huit","neuf",
5995 "dix","onze","douze","treize","quatorze","quinze","seize","dix-sept",
5996 "dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois",
5997 "vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit",
5998 "vingt-neuf","trente","trente et un"],
5999 ["1re"]];
6000
6001 $$d{"now"} =["maintenant"];
6002 $$d{"today"} =["aujourd'hui"];
6003 $$d{"last"} =["dernier"];
6004 $$d{"each"} =["chaque","tous les","toutes les"];
6005 $$d{"of"} =["en","de"];
6006 $$d{"at"} =["a","${a}0"];
6007 $$d{"on"} =["sur"];
6008 $$d{"future"} =["en"];
6009 $$d{"past"} =["il y a"];
6010 $$d{"next"} =["suivant"];
6011 $$d{"prev"} =["precedent","pr${e}c${e}dent"];
6012 $$d{"later"} =["plus tard"];
6013
6014 $$d{"exact"} =["exactement"];
6015 $$d{"approx"} =["approximativement"];
6016 $$d{"business"}=["professionel"];
6017
6018 $$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"];
6019 $$d{"times"} =["midi","12:00:00","minuit","00:00:00"];
6020
6021 $$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"];
6022 $$d{"months"} =["mois"];
6023 $$d{"weeks"} =["sem","semaine"];
6024 $$d{"days"} =["j","jour","jours"];
6025 $$d{"hours"} =["h","heure","heures"];
6026 $$d{"minutes"} =["mn","min","minute","minutes"];
6027 $$d{"seconds"} =["s","sec","seconde","secondes"];
6028 $$d{"replace"} =["m","mois"];
6029
6030 $$d{"sephm"} ='[h:]';
6031 $$d{"sepms"} =':';
6032 $$d{"sepss"} ='[.:,]';
6033
6034 $$d{"am"} = ["du matin"];
6035 $$d{"pm"} = ["du soir"];
6036}
6037
[618]6038sub _Date_Init_Romanian {
6039 print "DEBUG: _Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
[360]6040 my($d)=@_;
6041 my(%h)=();
[618]6042 _Char_8Bit(\%h);
[360]6043 my($p)=$h{"p"};
6044 my($i)=$h{"i^"};
6045 my($a)=$h{"a~"};
6046 my($o)=$h{"-o"};
6047
6048 $$d{"month_name"}=
6049 [["ianuarie","februarie","martie","aprilie","mai","iunie",
6050 "iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
6051 $$d{"month_abb"}=
6052 [["ian","febr","mart","apr","mai","iun",
6053 "iul","aug","sept","oct","nov","dec"],
6054 ["","feb"]];
6055
6056 $$d{"day_name"}=
6057 [["luni","marti","miercuri","joi","vineri","simbata","duminica"],
6058 ["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
6059 "duminic${a}"]];
6060 $$d{"day_abb"}=
6061 [["lun","mar","mie","joi","vin","sim","dum"],
6062 ["lun","mar","mie","joi","vin","s${i}m","dum"]];
6063 $$d{"day_char"}=
6064 [["L","Ma","Mi","J","V","S","D"]];
6065
6066 $$d{"num_suff"}=
6067 [["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a",
6068 "a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a",
6069 "a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a",
6070 "a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a",
6071 "a 30-a","a 31-a"]];
6072
6073 $$d{"num_word"}=
6074 [["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea",
6075 "a opta","a noua","a zecea","a unsprezecea","a doisprezecea",
6076 "a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea",
6077 "a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea",
6078 "a douazecisiuna","a douazecisidoua","a douazecisitreia",
6079 "a douazecisipatra","a douazecisicincea","a douazecisisasea",
6080 "a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea",
6081 "a treizecisiuna"],
6082 ["prima","a doua","a treia","a patra","a cincea","a ${o}asea",
6083 "a ${o}aptea","a opta","a noua","a zecea","a unsprezecea",
6084 "a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea",
6085 "a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea",
6086 "a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna",
6087 "a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia",
6088 "a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea",
6089 "a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea",
6090 "a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea",
6091 "a treizeci${o}iuna"],
6092 ["intii", "doi", "trei", "patru", "cinci", "sase", "sapte",
6093 "opt","noua","zece","unsprezece","doisprezece",
6094 "treisprezece","patrusprezece","cincisprezece","saiprezece",
6095 "saptesprezece","optsprezece","nouasprezece","douazeci",
6096 "douazecisiunu","douazecisidoi","douazecisitrei",
6097 "douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte",
6098 "douazecisiopt","douazecisinoua","treizeci","treizecisiunu"],
6099 ["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte",
6100 "opt","nou${a}","zece","unsprezece","doisprezece",
6101 "treisprezece","patrusprezece","cincisprezece","${o}aiprezece",
6102 "${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci",
6103 "dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei",
6104 "dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase",
6105 "dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt",
6106 "dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]];
6107
6108 $$d{"now"} =["acum"];
6109 $$d{"today"} =["azi","astazi","ast${a}zi"];
6110 $$d{"last"} =["ultima"];
6111 $$d{"each"} =["fiecare"];
6112 $$d{"of"} =["din","in","n"];
6113 $$d{"at"} =["la"];
6114 $$d{"on"} =["on"];
6115 $$d{"future"} =["in","${i}n"];
6116 $$d{"past"} =["in urma", "${i}n urm${a}"];
6117 $$d{"next"} =["urmatoarea","urm${a}toarea"];
6118 $$d{"prev"} =["precedenta","ultima"];
6119 $$d{"later"} =["mai tirziu", "mai t${i}rziu"];
6120
6121 $$d{"exact"} =["exact"];
6122 $$d{"approx"} =["aproximativ"];
6123 $$d{"business"}=["de lucru","lucratoare","lucr${a}toare"];
6124
6125 $$d{"offset"} =["ieri","-0:0:0:1:0:0:0",
6126 "alaltaieri", "-0:0:0:2:0:0:0",
6127 "alalt${a}ieri","-0:0:0:2:0:0:0",
6128 "miine","+0:0:0:1:0:0:0",
6129 "m${i}ine","+0:0:0:1:0:0:0",
6130 "poimiine","+0:0:0:2:0:0:0",
6131 "poim${i}ine","+0:0:0:2:0:0:0"];
6132 $$d{"times"} =["amiaza","12:00:00",
6133 "amiaz${a}","12:00:00",
6134 "miezul noptii","00:00:00",
6135 "miezul nop${p}ii","00:00:00"];
6136
6137 $$d{"years"} =["ani","an","a"];
6138 $$d{"months"} =["luni","luna","lun${a}","l"];
6139 $$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina",
6140 "s${a}pt${a}m${i}na","sapt","s${a}pt"];
6141 $$d{"days"} =["zile","zi","z"];
6142 $$d{"hours"} =["ore", "ora", "or${a}", "h"];
6143 $$d{"minutes"} =["minute","min","m"];
6144 $$d{"seconds"} =["secunde","sec",];
6145 $$d{"replace"} =["s","secunde"];
6146
6147 $$d{"sephm"} =':';
6148 $$d{"sepms"} =':';
6149 $$d{"sepss"} ='[.:,]';
6150
6151 $$d{"am"} = ["AM","A.M."];
6152 $$d{"pm"} = ["PM","P.M."];
6153}
6154
[618]6155sub _Date_Init_Swedish {
6156 print "DEBUG: _Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
[360]6157 my($d)=@_;
6158 my(%h)=();
[618]6159 _Char_8Bit(\%h);
[360]6160 my($ao)=$h{"ao"};
6161 my($o) =$h{"o:"};
6162 my($a) =$h{"a:"};
6163
6164 $$d{"month_name"}=
6165 [["Januari","Februari","Mars","April","Maj","Juni",
6166 "Juli","Augusti","September","Oktober","November","December"]];
6167 $$d{"month_abb"}=
6168 [["Jan","Feb","Mar","Apr","Maj","Jun",
6169 "Jul","Aug","Sep","Okt","Nov","Dec"]];
6170
6171 $$d{"day_name"}=
6172 [["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
6173 ["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
6174 "S${o}ndag"]];
6175 $$d{"day_abb"}=
6176 [["Man","Tis","Ons","Tor","Fre","Lor","Son"],
6177 ["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
6178 $$d{"day_char"}=
6179 [["M","Ti","O","To","F","L","S"]];
6180
6181 $$d{"num_suff"}=
6182 [["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
6183 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
6184 "21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
6185 "31:a"]];
6186 $$d{"num_word"}=
6187 [["forsta","andra","tredje","fjarde","femte","sjatte","sjunde",
6188 "attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6189 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6190 "tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte",
6191 "tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde",
6192 "trettionde","trettioforsta"],
6193 ["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde",
6194 "${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6195 "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6196 "tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte",
6197 "tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde",
6198 "trettionde","trettiof${o}rsta"]];
6199
6200 $$d{"now"} =["nu"];
6201 $$d{"today"} =["idag"];
6202 $$d{"last"} =["forra","f${o}rra","senaste"];
6203 $$d{"each"} =["varje"];
6204 $$d{"of"} =["om"];
6205 $$d{"at"} =["kl","kl.","klockan"];
6206 $$d{"on"} =["pa","p${ao}"];
6207 $$d{"future"} =["om"];
6208 $$d{"past"} =["sedan"];
6209 $$d{"next"} =["nasta","n${a}sta"];
6210 $$d{"prev"} =["forra","f${o}rra"];
6211 $$d{"later"} =["senare"];
6212
6213 $$d{"exact"} =["exakt"];
6214 $$d{"approx"} =["ungefar","ungef${a}r"];
6215 $$d{"business"}=["arbetsdag","arbetsdagar"];
6216
6217 $$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
6218 "imorgon","+0:0:0:1:0:0:0"];
6219 $$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00",
6220 "midnatt","00:00:00"];
6221
6222 $$d{"years"} =["ar","${ao}r"];
6223 $$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"];
6224 $$d{"weeks"} =["v","vecka","veckor"];
6225 $$d{"days"} =["d","dag","dagar"];
6226 $$d{"hours"} =["t","tim","timme","timmar"];
6227 $$d{"minutes"} =["min","minut","minuter"];
6228 $$d{"seconds"} =["s","sek","sekund","sekunder"];
6229 $$d{"replace"} =["m","minut"];
6230
6231 $$d{"sephm"} ='[.:]';
6232 $$d{"sepms"} =':';
6233 $$d{"sepss"} ='[.:]';
6234
6235 $$d{"am"} = ["FM"];
6236 $$d{"pm"} = ["EM"];
6237}
6238
[618]6239sub _Date_Init_German {
6240 print "DEBUG: _Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
[360]6241 my($d)=@_;
6242 my(%h)=();
[618]6243 _Char_8Bit(\%h);
[360]6244 my($a)=$h{"a:"};
6245 my($u)=$h{"u:"};
6246 my($o)=$h{"o:"};
6247 my($b)=$h{"beta"};
6248
6249 $$d{"month_name"}=
6250 [["Januar","Februar","Maerz","April","Mai","Juni",
6251 "Juli","August","September","Oktober","November","Dezember"],
6252 ["J${a}nner","Februar","M${a}rz","April","Mai","Juni",
6253 "Juli","August","September","Oktober","November","Dezember"]];
6254 $$d{"month_abb"}=
6255 [["Jan","Feb","Mar","Apr","Mai","Jun",
6256 "Jul","Aug","Sep","Okt","Nov","Dez"],
6257 ["J${a}n","Feb","M${a}r","Apr","Mai","Jun",
6258 "Jul","Aug","Sep","Okt","Nov","Dez"]];
6259
6260 $$d{"day_name"}=
6261 [["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
6262 "Sonntag"]];
6263 $$d{"day_abb"}=
6264 [["Mo","Di","Mi","Do","Fr","Sa","So"]];
6265 $$d{"day_char"}=
6266 [["M","Di","Mi","Do","F","Sa","So"]];
6267
6268 $$d{"num_suff"}=
6269 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6270 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6271 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6272 "31."]];
6273 $$d{"num_word"}=
6274 [
6275 ["erste","zweite","dritte","vierte","funfte","sechste","siebente",
6276 "achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte",
6277 "funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte",
6278 "zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste",
6279 "vierundzwanzigste","funfundzwanzigste","sechundzwanzigste",
6280 "siebundzwanzigste","achtundzwanzigste","neunundzwanzigste",
6281 "dreibigste","einunddreibigste"],
6282 ["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente",
6283 "achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte",
6284 "vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte",
6285 "neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste",
6286 "dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste",
6287 "sechundzwanzigste","siebundzwanzigste","achtundzwanzigste",
6288 "neunundzwanzigste","drei${b}igste","einunddrei${b}igste"],
6289 ["erster"]];
6290
6291 $$d{"now"} =["jetzt"];
6292 $$d{"today"} =["heute"];
6293 $$d{"last"} =["letzte","letzten"];
6294 $$d{"each"} =["jeden"];
6295 $$d{"of"} =["der","im","des"];
6296 $$d{"at"} =["um"];
6297 $$d{"on"} =["am"];
6298 $$d{"future"} =["in"];
6299 $$d{"past"} =["vor"];
6300 $$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
6301 $$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
6302 $$d{"later"} =["spater","sp${a}ter"];
6303
6304 $$d{"exact"} =["genau"];
6305 $$d{"approx"} =["ungefahr","ungef${a}hr"];
6306 $$d{"business"}=["Arbeitstag"];
6307
6308 $$d{"offset"} =["gestern","-0:0:0:1:0:0:0","morgen","+0:0:0:1:0:0:0","${u}bermorgen","+0:0:0:2:0:0:0"];
6309 $$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"];
6310
6311 $$d{"years"} =["j","Jahr","Jahre","Jahren"];
6312 $$d{"months"} =["Monat","Monate","Monaten"];
6313 $$d{"weeks"} =["w","Woche","Wochen"];
6314 $$d{"days"} =["t","Tag","Tage","Tagen"];
6315 $$d{"hours"} =["h","std","Stunde","Stunden"];
6316 $$d{"minutes"} =["min","Minute","Minuten"];
6317 $$d{"seconds"} =["s","sek","Sekunde","Sekunden"];
6318 $$d{"replace"} =["m","Monat"];
6319
6320 $$d{"sephm"} =':';
6321 $$d{"sepms"} ='[: ]';
6322 $$d{"sepss"} ='[.:]';
6323
6324 $$d{"am"} = ["FM"];
6325 $$d{"pm"} = ["EM"];
6326}
6327
[618]6328sub _Date_Init_Dutch {
6329 print "DEBUG: _Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
[360]6330 my($d)=@_;
6331 my(%h)=();
[618]6332 _Char_8Bit(\%h);
[360]6333
6334 $$d{"month_name"}=
6335 [["januari","februari","maart","april","mei","juni","juli","augustus",
6336 "september","october","november","december"],
6337 ["","","","","","","","","","oktober"]];
6338
6339 $$d{"month_abb"}=
6340 [["jan","feb","maa","apr","mei","jun","jul",
6341 "aug","sep","oct","nov","dec"],
6342 ["","","mrt","","","","","","","okt"]];
6343 $$d{"day_name"}=
6344 [["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
6345 "zondag"]];
6346 $$d{"day_abb"}=
6347 [["ma","di","wo","do","vr","zat","zon"],
6348 ["","","","","","za","zo"]];
6349 $$d{"day_char"}=
6350 [["M","D","W","D","V","Za","Zo"]];
6351
6352 $$d{"num_suff"}=
6353 [["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de",
6354 "11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste",
6355 "21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste",
6356 "30ste","31ste"]];
6357 $$d{"num_word"}=
6358 [["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
6359 "negende","tiende","elfde","twaalfde",
6360 map {"${_}tiende";} qw (der veer vijf zes zeven acht negen),
6361 "twintigste",
6362 map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht
6363 negen),
6364 "dertigste","eenendertigste"],
6365 ["","","","","","","","","","","","","","","","","","","","",
6366 map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht
6367 negen),
6368 "dertigste","een-en-dertigste"],
6369 ["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
6370 "elf","twaalf",
6371 map {"${_}tien"} qw (der veer vijf zes zeven acht negen),
6372 "twintig",
6373 map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen),
6374 "dertig","eenendertig"],
6375 ["","","","","","","","","","","","","","","","","","","","",
6376 map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht
6377 negen),
6378 "dertig","een-en-dertig"]];
6379
6380 $$d{"now"} =["nu","nou"];
6381 $$d{"today"} =["vandaag"];
6382 $$d{"last"} =["laatste"];
6383 $$d{"each"} =["elke","elk"];
6384 $$d{"of"} =["in","van"];
6385 $$d{"at"} =["om"];
6386 $$d{"on"} =["op"];
6387 $$d{"future"} =["over"];
6388 $$d{"past"} =["geleden","vroeger","eerder"];
6389 $$d{"next"} =["volgende","volgend"];
6390 $$d{"prev"} =["voorgaande","voorgaand"];
6391 $$d{"later"} =["later"];
6392
6393 $$d{"exact"} =["exact","precies","nauwkeurig"];
6394 $$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.'];
6395 $$d{"business"}=["werk","zakelijke","zakelijk"];
6396
6397 $$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0",
6398 "gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"];
6399 $$d{"times"} =["noen","12:00:00","middernacht","00:00:00"];
6400
6401 $$d{"years"} =["jaar","jaren","ja","j"];
6402 $$d{"months"} =["maand","maanden","mnd"];
6403 $$d{"weeks"} =["week","weken","w"];
6404 $$d{"days"} =["dag","dagen","d"];
6405 $$d{"hours"} =["uur","uren","u","h"];
6406 $$d{"minutes"} =["minuut","minuten","min"];
6407 $$d{"seconds"} =["seconde","seconden","sec","s"];
6408 $$d{"replace"} =["m","minuten"];
6409
6410 $$d{"sephm"} ='[:.uh]';
6411 $$d{"sepms"} ='[:.m]';
6412 $$d{"sepss"} ='[.:]';
6413
6414 $$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends",
6415 "ochtend","'s_nachts","nacht"];
6416 $$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag",
6417 "'s_avonds","avond"];
6418}
6419
[618]6420sub _Date_Init_Polish {
6421 print "DEBUG: _Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
[360]6422 my($d)=@_;
6423
6424 $$d{"month_name"}=
6425 [["stycznia","luty","marca","kwietnia","maja","czerwca",
6426 "lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"],
6427 ["stycznia","luty","marca","kwietnia","maja","czerwca","lipca",
6428 "sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]];
6429 $$d{"month_abb"}=
6430 [["sty.","lut.","mar.","kwi.","maj","cze.",
6431 "lip.","sie.","wrz.","paz.","lis.","gru."],
6432 ["sty.","lut.","mar.","kwi.","maj","cze.",
6433 "lip.","sie.","wrz.","pa\x9f.","lis.","gru."]];
6434
6435 $$d{"day_name"}=
6436 [["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
6437 "niedziela"],
6438 ["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
6439 "sobota","niedziela"]];
6440 $$d{"day_abb"}=
6441 [["po.","wt.","sr.","cz.","pi.","so.","ni."],
6442 ["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
6443 $$d{"day_char"}=
6444 [["p","w","e","c","p","s","n"],
6445 ["p","w","\x9c.","c","p","s","n"]];
6446
6447 $$d{"num_suff"}=
6448 [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6449 "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6450 "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6451 "31."]];
6452 $$d{"num_word"}=
6453 [["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
6454 "siodmego","osmego","dziewiatego","dziesiatego",
6455 "jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
6456 "szestnastego","siedemnastego","osiemnastego","dziewietnastego",
6457 "dwudziestego",
6458 "dwudziestego pierwszego","dwudziestego drugiego",
6459 "dwudziestego trzeczego","dwudziestego czwartego",
6460 "dwudziestego piatego","dwudziestego szostego",
6461 "dwudziestego siodmego","dwudziestego osmego",
6462 "dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"],
6463 ["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego",
6464 "sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego",
6465 "dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego",
6466 "czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego",
6467 "osiemnastego","dziewietnastego","dwudziestego",
6468 "dwudziestego pierwszego","dwudziestego drugiego",
6469 "dwudziestego trzeczego","dwudziestego czwartego",
6470 "dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego",
6471 "dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego",
6472 "dwudziestego dziewi\x81\xb9tego","trzydziestego",
6473 "trzydziestego pierwszego"]];
6474
6475 $$d{"now"} =["teraz"];
6476 $$d{"today"} =["dzisaj"];
6477 $$d{"last"} =["ostatni","ostatna"];
6478 $$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"];
6479 $$d{"of"} =["w","z"];
6480 $$d{"at"} =["o","u"];
6481 $$d{"on"} =["na"];
6482 $$d{"future"} =["za"];
6483 $$d{"past"} =["temu"];
6484 $$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
6485 "przyszly","przysz\x81\xb3y","przyszlym",
6486 "przysz\x81\xb3ym"];
6487 $$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
6488 $$d{"later"} =["later"];
6489
6490 $$d{"exact"} =["doklandnie","dok\x81\xb3andnie"];
6491 $$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej",
6492 "mniej wi\x81\xeacej","okolo","oko\x81\xb3o"];
6493 $$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym",
6494 "s\x81\xb3u\x81\xbfbowym"];
6495
6496 $$d{"times"} =["po\x81\xb3udnie","12:00:00",
6497 "p\x81\xf3\x81\xb3noc","00:00:00",
6498 "poludnie","12:00:00","polnoc","00:00:00"];
6499 $$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"];
6500
6501 $$d{"years"} =["rok","lat","lata","latach"];
6502 $$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy",
6503 "miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"];
6504 $$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"];
6505 $$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"];
6506 $$d{"hours"} =["g.","godzina","godziny","godzinie"];
6507 $$d{"minutes"} =["mn.","min.","minut","minuty"];
6508 $$d{"seconds"} =["s.","sekund","sekundy"];
6509 $$d{"replace"} =["m.","miesiac"];
6510
6511 $$d{"sephm"} =':';
6512 $$d{"sepms"} =':';
6513 $$d{"sepss"} ='[.:]';
6514
6515 $$d{"am"} = ["AM","A.M."];
6516 $$d{"pm"} = ["PM","P.M."];
6517}
6518
[618]6519sub _Date_Init_Spanish {
6520 print "DEBUG: _Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
[360]6521 my($d)=@_;
6522 my(%h)=();
[618]6523 _Char_8Bit(\%h);
[360]6524
6525 $$d{"month_name"}=
6526 [["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
6527 "Septiembre","Octubre","Noviembre","Diciembre"]];
6528
6529 $$d{"month_abb"}=
6530 [["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
6531 "Nov","Dic"]];
6532
6533 $$d{"day_name"}=
6534 [["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
6535 $$d{"day_abb"}=
6536 [["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
6537 $$d{"day_char"}=
6538 [["L","Ma","Mi","J","V","S","D"]];
6539
6540 $$d{"num_suff"}=
6541 [["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o",
6542 "11o","12o","13o","14o","15o","16o","17o","18o","19o","20o",
6543 "21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"],
6544 ["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a",
6545 "11a","12a","13a","14a","15a","16a","17a","18a","19a","20a",
6546 "21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]];
6547 $$d{"num_word"}=
6548 [["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo",
6549 "Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo",
6550 "Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto",
6551 "Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo",
6552 "Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero",
6553 "Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto",
6554 "Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo",
6555 "Trigesimo Primero"],
6556 ["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima",
6557 "Octava","Novena","Decima","Decimo Primera","Decimo Segunda",
6558 "Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta",
6559 "Decimo Septima","Decimo Octava","Decimo Novena","Vigesima",
6560 "Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera",
6561 "Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta",
6562 "Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima",
6563 "Trigesimo Primera"]];
6564
6565 $$d{"now"} =["Ahora"];
6566 $$d{"today"} =["Hoy"];
6567 $$d{"last"} =["ultimo"];
6568 $$d{"each"} =["cada"];
6569 $$d{"of"} =["en","de"];
6570 $$d{"at"} =["a"];
6571 $$d{"on"} =["el"];
6572 $$d{"future"} =["en"];
6573 $$d{"past"} =["hace"];
6574 $$d{"next"} =["siguiente"];
6575 $$d{"prev"} =["anterior"];
6576 $$d{"later"} =["later"];
6577
6578 $$d{"exact"} =["exactamente"];
6579 $$d{"approx"} =["aproximadamente"];
6580 $$d{"business"}=["laborales"];
6581
6582 $$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"];
6583 $$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"];
6584
6585 $$d{"years"} =["a","ano","ano","anos","anos"];
6586 $$d{"months"} =["m","mes","mes","meses"];
6587 $$d{"weeks"} =["sem","semana","semana","semanas"];
6588 $$d{"days"} =["d","dia","dias"];
6589 $$d{"hours"} =["hr","hrs","hora","horas"];
6590 $$d{"minutes"} =["min","min","minuto","minutos"];
6591 $$d{"seconds"} =["s","seg","segundo","segundos"];
6592 $$d{"replace"} =["m","mes"];
6593
6594 $$d{"sephm"} =':';
6595 $$d{"sepms"} =':';
6596 $$d{"sepss"} ='[.:]';
6597
6598 $$d{"am"} = ["AM","A.M."];
6599 $$d{"pm"} = ["PM","P.M."];
6600}
6601
[618]6602sub _Date_Init_Portuguese {
6603 print "DEBUG: _Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
[360]6604 my($d)=@_;
6605 my(%h)=();
[618]6606 _Char_8Bit(\%h);
[360]6607 my($o) = $h{"-o"};
6608 my($c) = $h{",c"};
6609 my($a) = $h{"a'"};
6610 my($e) = $h{"e'"};
6611 my($u) = $h{"u'"};
6612 my($o2)= $h{"o'"};
6613 my($a2)= $h{"a`"};
6614 my($a3)= $h{"a~"};
6615 my($e2)= $h{"e^"};
6616
6617 $$d{"month_name"}=
6618 [["Janeiro","Fevereiro","Marco","Abril","Maio","Junho",
6619 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"],
6620 ["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho",
6621 "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]];
6622
6623 $$d{"month_abb"}=
6624 [["Jan","Fev","Mar","Abr","Mai","Jun",
6625 "Jul","Ago","Set","Out","Nov","Dez"]];
6626
6627 $$d{"day_name"}=
6628 [["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
6629 ["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
6630 $$d{"day_abb"}=
6631 [["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
6632 ["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
6633 $$d{"day_char"}=
6634 [["Sg","T","Qa","Qi","Sx","Sb","D"]];
6635
6636 $$d{"num_suff"}=
6637 [["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}",
6638 "9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}",
6639 "16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}",
6640 "23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}",
6641 "30${o}","31${o}"]];
6642 $$d{"num_word"}=
6643 [["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo",
6644 "oitavo","nono","decimo","decimo primeiro","decimo segundo",
6645 "decimo terceiro","decimo quarto","decimo quinto","decimo sexto",
6646 "decimo setimo","decimo oitavo","decimo nono","vigesimo",
6647 "vigesimo primeiro","vigesimo segundo","vigesimo terceiro",
6648 "vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo",
6649 "vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"],
6650 ["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo",
6651 "oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo",
6652 "d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto",
6653 "d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo",
6654 "d${e}cimo nono","vig${e}simo","vig${e}simo primeiro",
6655 "vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto",
6656 "vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo",
6657 "vig${e}simo oitavo","vig${e}simo nono","trig${e}simo",
6658 "trig${e}simo primeiro"]];
6659
6660 $$d{"now"} =["agora"];
6661 $$d{"today"} =["hoje"];
6662 $$d{"last"} =["${u}ltimo","ultimo"];
6663 $$d{"each"} =["cada"];
6664 $$d{"of"} =["da","do"];
6665 $$d{"at"} =["as","${a2}s"];
6666 $$d{"on"} =["na","no"];
6667 $$d{"future"} =["em"];
6668 $$d{"past"} =["a","${a2}"];
6669 $$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"];
6670 $$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"];
6671 $$d{"later"} =["passadas","passados"];
6672
6673 $$d{"exact"} =["exactamente"];
6674 $$d{"approx"} =["aproximadamente"];
6675 $$d{"business"}=["util","uteis"];
6676
6677 $$d{"offset"} =["ontem","-0:0:0:1:0:0:0",
6678 "amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"];
6679 $$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"];
6680
6681 $$d{"years"} =["anos","ano","ans","an","a"];
6682 $$d{"months"} =["meses","m${e2}s","mes","m"];
6683 $$d{"weeks"} =["semanas","semana","sem","sems","s"];
6684 $$d{"days"} =["dias","dia","d"];
6685 $$d{"hours"} =["horas","hora","hr","hrs"];
6686 $$d{"minutes"} =["minutos","minuto","min","mn"];
6687 $$d{"seconds"} =["segundos","segundo","seg","sg"];
6688 $$d{"replace"} =["m","mes","s","sems"];
6689
6690 $$d{"sephm"} =':';
6691 $$d{"sepms"} =':';
6692 $$d{"sepss"} ='[,]';
6693
6694 $$d{"am"} = ["AM","A.M."];
6695 $$d{"pm"} = ["PM","P.M."];
6696}
6697
[618]6698sub _Date_Init_Russian {
6699 print "DEBUG: _Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
[360]6700 my($d)=@_;
6701 my(%h)=();
[618]6702 _Char_8Bit(\%h);
[360]6703 my($a) =$h{"a:"};
6704
6705 $$d{"month_name"}=
6706 [
6707 ["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1",
6708 "\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1",
6709 "\xc9\xc0\xce\xd1",
6710 "\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1",
6711 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1",
6712 "\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"],
6713 ["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8",
6714 "\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca",
6715 "\xc9\xc0\xce\xd8",
6716 "\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4",
6717 "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8",
6718 "\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"]
6719 ];
6720
6721 $$d{"month_abb"}=
6722 [["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2",
6723 "\xcd\xc1\xca","\xc9\xc0\xce",
6724 "\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4",
6725 "\xce\xcf\xd1\xc2","\xc4\xc5\xcb"],
6726 ["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","",
6727 "","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]];
6728
6729 $$d{"day_name"}=
6730 [["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb",
6731 "\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1",
6732 "\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1",
6733 "\xd3\xd5\xc2\xc2\xcf\xd4\xc1",
6734 "\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]];
6735 $$d{"day_abb"}=
6736 [["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7",
6737 "\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"],
6738 ["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4",
6739 "\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]];
6740 $$d{"day_char"}=
6741 [["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
6742 "\xd7\xd3"]];
6743
6744 $$d{"num_suff"}=
6745 [["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ",
6746 "11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ",
6747 "21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ",
6748 "31 "]];
6749 $$d{"num_word"}=
6750 [["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca",
6751 "\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6752 "\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca",
6753 "\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca",
6754 "\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca",
6755 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6756 "\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca",
6757 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6758 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6759 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6760 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6761 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6762 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6763 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6764 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6765 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca",
6766 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca",
6767 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca",
6768 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6769 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca",
6770 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca",
6771 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca",
6772 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca",
6773 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca",
6774 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca",
6775 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"],
6776
6777 ["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5",
6778 "\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6779 "\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5",
6780 "\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6781 "\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5",
6782 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6783 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6784 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6785 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6786 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6787 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6788 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6789 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6790 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6791 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6792 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5",
6793 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6794 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5",
6795 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6796 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5",
6797 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5",
6798 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5",
6799 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6800 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5",
6801 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5",
6802 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"],
6803
6804 ["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf",
6805 "\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6806 "\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf",
6807 "\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6808 "\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6809 "\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf",
6810 "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6811 "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6812 "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6813 "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6814 "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6815 "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6816 "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6817 "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6818 "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6819 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6820 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf",
6821 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6822 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6823 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf",
6824 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf",
6825 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf",
6826 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6827 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6828 "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf",
6829 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6830 "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]];
6831
6832 $$d{"now"} =["\xd3\xc5\xca\xde\xc1\xd3"];
6833 $$d{"today"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1"];
6834 $$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"];
6835 $$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"];
6836 $$d{"of"} =[" "];
6837 $$d{"at"} =["\xd7"];
6838 $$d{"on"} =["\xd7"];
6839 $$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"];
6840 $$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "];
6841 $$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"];
6842 $$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"];
6843 $$d{"later"} =["\xd0\xcf\xda\xd6\xc5"];
6844
6845 $$d{"exact"} =["\xd4\xcf\xde\xce\xcf"];
6846 $$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"];
6847 $$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"];
6848
6849 $$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0",
6850 "\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0",
6851 "\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0",
6852 "\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1",
6853 "+0:0:0:2:0:0:0"];
6854 $$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00",
6855 "\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"];
6856
6857 $$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4",
6858 "\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"];
6859 $$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3",
6860 "\xcd\xc5\xd3\xd1\xc3\xc5\xd7"];
6861 $$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8",
6862 "\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"];
6863 $$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca",
6864 "\xc4\xce\xd1"];
6865 $$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3",
6866 "\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"];
6867 $$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1",
6868 "\xcd\xc9\xce\xd5\xd4"];
6869 $$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
6870 "\xd3\xc5\xcb\xd5\xce\xc4"];
6871 $$d{"replace"} =[];
6872
6873 $$d{"sephm"} ="[:\xde]";
6874 $$d{"sepms"} ="[:\xcd]";
6875 $$d{"sepss"} ="[:.\xd3]";
6876
6877 $$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
6878 "\xd5\xd4\xd2\xc1",
6879 "\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"];
6880 $$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1",
6881 "\xd7\xc5\xde\xc5\xd2\xc1",
6882 "\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1",
6883 "\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"];
6884}
6885
[618]6886sub _Date_Init_Turkish {
6887 print "DEBUG: _Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
[360]6888 my($d)=@_;
6889
6890 $$d{"month_name"}=
6891 [
6892 ["ocak","subat","mart","nisan","mayis","haziran",
6893 "temmuz","agustos","eylul","ekim","kasim","aralik"],
6894 ["ocak","\xfeubat","mart","nisan","may\xfds","haziran",
6895 "temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"]
6896 ];
6897
6898 $$d{"month_abb"}=
6899 [
6900 ["oca","sub","mar","nis","may","haz",
6901 "tem","agu","eyl","eki","kas","ara"],
6902 ["oca","\xfeub","mar","nis","may","haz",
6903 "tem","a\xf0u","eyl","eki","kas","ara"]
6904 ];
6905
6906 $$d{"day_name"}=
6907 [
6908 ["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
6909 ["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
6910 "cumartesi","pazar"],
6911 ];
6912
6913 $$d{"day_abb"}=
6914 [
6915 ["pzt","sal","car","per","cum","cts","paz"],
6916 ["pzt","sal","\xe7ar","per","cum","cts","paz"],
6917 ];
6918
6919 $$d{"day_char"}=
6920 [["Pt","S","Cr","Pr","C","Ct","P"],
6921 ["Pt","S","\xc7","Pr","C","Ct","P"]];
6922
6923 $$d{"num_suff"}=
6924 [[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.",
6925 "11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.",
6926 "21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.",
6927 "31."]];
6928
6929 $$d{"num_word"}=
6930 [
6931 ["birinci","ikinci","ucuncu","dorduncu",
6932 "besinci","altinci","yedinci","sekizinci",
6933 "dokuzuncu","onuncu","onbirinci","onikinci",
6934 "onucuncu","ondordoncu",
6935 "onbesinci","onaltinci","onyedinci","onsekizinci",
6936 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
6937 "yirmiucuncu","yirmidorduncu",
6938 "yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci",
6939 "yirmidokuzuncu","otuzuncu","otuzbirinci"],
6940 ["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc",
6941 "be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci",
6942 "dokuzuncu","onuncu","onbirinci","onikinci",
6943 "on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc",
6944 "onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci",
6945 "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
6946 "yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc",
6947 "yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci",
6948 "yirmidokuzuncu","otuzuncu","otuzbirinci"]
6949 ];
6950
6951 $$d{"now"} =["\xfeimdi", "simdi"];
6952 $$d{"today"} =["bugun", "bug\xfcn"];
6953 $$d{"last"} =["son", "sonuncu"];
6954 $$d{"each"} =["her"];
6955 $$d{"of"} =["of"];
6956 $$d{"at"} =["saat"];
6957 $$d{"on"} =["on"];
6958 $$d{"future"} =["gelecek"];
6959 $$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
6960 $$d{"next"} =["gelecek","sonraki"];
6961 $$d{"prev"} =["onceki","\xf6nceki"];
6962 $$d{"later"} =["sonra"];
6963
6964 $$d{"exact"} =["tam"];
6965 $$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"];
6966 $$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"];
6967
6968 $$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0",
6969 "dun", "-0:0:0:1:0:0:0",
6970 "yar\xfdn","+0:0:0:1:0:0:0",
6971 "yarin","+0:0:0:1:0:0:0"];
6972
6973 $$d{"times"} =["\xf6\xf0len","12:00:00",
6974 "oglen","12:00:00",
6975 "yarim","12:300:00",
6976 "yar\xfdm","12:30:00",
6977 "gece yar\xfds\xfd","00:00:00",
6978 "gece yarisi","00:00:00"];
6979
6980 $$d{"years"} =["yil","y"];
6981 $$d{"months"} =["ay","a"];
6982 $$d{"weeks"} =["hafta", "h"];
6983 $$d{"days"} =["gun","g"];
6984 $$d{"hours"} =["saat"];
6985 $$d{"minutes"} =["dakika","dak","d"];
6986 $$d{"seconds"} =["saniye","sn",];
6987 $$d{"replace"} =["s","saat"];
6988
6989 $$d{"sephm"} =':';
6990 $$d{"sepms"} =':';
6991 $$d{"sepss"} ='[.:,]';
6992
6993 $$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
6994 $$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
6995}
6996
[618]6997sub _Date_Init_Danish {
6998 print "DEBUG: _Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
[360]6999 my($d)=@_;
7000
7001 $$d{"month_name"}=
7002 [["Januar","Februar","Marts","April","Maj","Juni",
7003 "Juli","August","September","Oktober","November","December"]];
7004 $$d{"month_abb"}=
7005 [["Jan","Feb","Mar","Apr","Maj","Jun",
7006 "Jul","Aug","Sep","Okt","Nov","Dec"]];
7007
7008 $$d{"day_name"}=
7009 [["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
7010 ["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
7011
7012 $$d{"day_abb"}=
7013 [["Man","Tir","Ons","Tor","Fre","Lor","Son"],
7014 ["Man","Tir","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
7015 $$d{"day_char"}=
7016 [["M","Ti","O","To","F","L","S"]];
7017
7018 $$d{"num_suff"}=
7019 [["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
7020 "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
7021 "21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
7022 "31:e"]];
7023 $$d{"num_word"}=
7024 [["forste","anden","tredie","fjerde","femte","sjette","syvende",
7025 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7026 "femtende","sekstende","syttende","attende","nittende","tyvende",
7027 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7028 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7029 "tredivte","enogtredivte"],
7030 ["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende",
7031 "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7032 "femtende","sekstende","syttende","attende","nittende","tyvende",
7033 "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7034 "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7035 "tredivte","enogtredivte"]];
7036
7037 $$d{"now"} =["nu"];
7038 $$d{"today"} =["idag"];
7039 $$d{"last"} =["forrige","sidste","nyeste"];
7040 $$d{"each"} =["hver"];
7041 $$d{"of"} =["om"];
7042 $$d{"at"} =["kl","kl.","klokken"];
7043 $$d{"on"} =["pa","p\xe5"];
7044 $$d{"future"} =["om"];
7045 $$d{"past"} =["siden"];
7046 $$d{"next"} =["nasta","n\xe6ste"];
7047 $$d{"prev"} =["forrige"];
7048 $$d{"later"} =["senere"];
7049
7050 $$d{"exact"} =["pracist","pr\xe6cist"];
7051 $$d{"approx"} =["circa"];
7052 $$d{"business"}=["arbejdsdag","arbejdsdage"];
7053
7054 $$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
7055 "imorgen","+0:0:0:1:0:0:0"];
7056 $$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00",
7057 "midnat","00:00:00"];
7058
7059 $$d{"years"} =["ar","\xe5r"];
7060 $$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"];
7061 $$d{"weeks"} =["u","uge","uger"];
7062 $$d{"days"} =["d","dag","dage"];
7063 $$d{"hours"} =["t","tim","time","timer"];
7064 $$d{"minutes"} =["min","minut","minutter"];
7065 $$d{"seconds"} =["s","sek","sekund","sekunder"];
7066 $$d{"replace"} =["m","minut"];
7067
7068 $$d{"sephm"} ='[.:]';
7069 $$d{"sepms"} =':';
7070 $$d{"sepss"} ='[.:]';
7071
7072 $$d{"am"} = ["FM"];
7073 $$d{"pm"} = ["EM"];
7074}
7075
[618]7076sub _Date_Init_Catalan {
7077 print "DEBUG: _Date_Init_Catalan\n" if ($Curr{"Debug"} =~ /trace/);
[360]7078 my($d)=@_;
7079
7080 $$d{"month_name"}=
7081 [["Gener","Febrer","Marc","Abril","Maig","Juny",
7082 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7083 ["Gener","Febrer","Març","Abril","Maig","Juny",
7084 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7085 ["Gener","Febrer","Marc,","Abril","Maig","Juny",
7086 "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"]];
7087
7088 $$d{"month_abb"}=
7089 [["Gen","Feb","Mar","Abr","Mai","Jun",
7090 "Jul","Ago","Set","Oct","Nov","Des"],
7091 [],
7092 ["","","","","","",
7093 "","","","","","Dec"] #common mistake
7094 ];
7095
7096 $$d{"day_name"}=
7097 [["Dilluns","Dimarts","Dimecres","Dijous","Divendres","Dissabte","Diumenge"]];
7098 $$d{"day_abb"}=
7099 [["Dll","Dmt","Dmc","Dij","Div","Dis","Diu"],
7100 ["","Dim","","","","",""],
7101 ["","","Dic","","","",""]
7102 ];
7103 $$d{"day_char"}=
7104 [["Dl","Dm","Dc","Dj","Dv","Ds","Du"] ,
7105 ["L","M","X","J","V","S","U"]];
7106
7107 $$d{"num_suff"}=
7108 [["1er","2n","3r","4t","5e","6e","7e","8e","9e","10e",
7109 "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
7110 "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
7111 "31e"],
7112 ["1er","2n","3r","4t","5è","6è","7è","8è","9è","10è",
7113 "11è","12è","13è","14è","15è","16è","17è","18è","19è","20è",
7114 "21è","22è","23è","24è","25è","26è","27è","28è","29è","30è",
7115 "31è"]];
7116 $$d{"num_word"}=
7117 [["primer","segon","tercer","quart","cinque","sise","sete","vuite",
7118 "nove","dese","onze","dotze","tretze","catorze",
7119 "quinze","setze","dissete","divuite","dinove",
7120 "vinte","vint-i-une","vint-i-dose","vint-i-trese",
7121 "vint-i-quatre","vint-i-cinque","vint-i-sise","vint-i-sete",
7122 "vint-i-vuite","vint-i-nove","trente","trenta-une"],
7123 ["primer","segon","tercer","quart","cinquè","sisè","setè","vuitè",
7124 "novè","desè","onzè","dotzè","tretzè","catorzè",
7125 "quinzè","setzè","dissetè","divuitè","dinovè",
7126 "vintè","vint-i-unè","vint-i-dosè","vint-i-tresè",
7127 "vint-i-quatrè","vint-i-cinquè","vint-i-sisè","vint-i-setè",
7128 "vint-i-vuitè","vint-i-novè","trentè","trenta-unè"]];
7129
7130 $$d{"now"} =["avui","ara"];
7131 $$d{"last"} =["darrer","últim","darrera","última"];
7132 $$d{"each"} =["cada","cadascun","cadascuna"];
7133 $$d{"of"} =["de","d'"];
7134 $$d{"at"} =["a les","a","al"];
7135 $$d{"on"} =["el"];
7136 $$d{"future"} =["d'aquí a"];
7137 $$d{"past"} =["fa"];
7138 $$d{"next"} =["proper"];
7139 $$d{"prev"} =["passat","proppassat","anterior"];
7140 $$d{"later"} =["més tard"];
7141
7142 $$d{"exact"} =["exactament"];
7143 $$d{"approx"} =["approximadament"];
7144 $$d{"business"}=["empresa"];
7145
7146 $$d{"offset"} =["ahir","-0:0:0:1:0:0:0","demà","+0:0:0:1:0:0:0","abans d'ahir","-0:0:0:2:0:0:0","demà passat","+0:0:0:2:0:0:0",];
7147 $$d{"times"} =["migdia","12:00:00","mitjanit","00:00:00"];
7148
7149 $$d{"years"} =["a","an","any","anys"];
7150 $$d{"months"} =["mes","me","ms"];
7151 $$d{"weeks"} =["se","set","setm","setmana","setmanes"];
7152 $$d{"days"} =["d","dia","dies"];
7153 $$d{"hours"} =["h","ho","hores","hora"];
7154 $$d{"minutes"} =["mn","min","minut","minuts"];
7155 $$d{"seconds"} =["s","seg","segon","segons"];
7156 $$d{"replace"} =["m","mes","s","setmana"];
7157
7158 $$d{"sephm"} =':';
7159 $$d{"sepms"} =':';
7160 $$d{"sepss"} ='[.:]';
7161
7162 $$d{"am"} = ["AM","A.M."];
7163 $$d{"pm"} = ["PM","P.M."];
7164}
7165
7166########################################################################
7167# FROM MY PERSONAL LIBRARIES
7168########################################################################
7169
7170no integer;
7171
[618]7172# _ModuloAddition($N,$add,\$val,\$rem);
[360]7173# This calculates $val=$val+$add and forces $val to be in a certain range.
7174# This is useful for adding numbers for which only a certain range is
7175# allowed (for example, minutes can be between 0 and 59 or months can be
7176# between 1 and 12). The absolute value of $N determines the range and
7177# the sign of $N determines whether the range is 0 to N-1 (if N>0) or
7178# 1 to N (N<0). The remainder (as modulo N) is added to $rem.
7179# Example:
7180# To add 2 hours together (with the excess returned in days) use:
[618]7181# _ModuloAddition(60,$s1,\$s,\$day);
7182sub _ModuloAddition {
[360]7183 my($N,$add,$val,$rem)=@_;
7184 return if ($N==0);
7185 $$val+=$add;
7186 if ($N<0) {
7187 # 1 to N
7188 $N = -$N;
7189 if ($$val>$N) {
7190 $$rem+= int(($$val-1)/$N);
7191 $$val = ($$val-1)%$N +1;
7192 } elsif ($$val<1) {
7193 $$rem-= int(-$$val/$N)+1;
7194 $$val = $N-(-$$val % $N);
7195 }
7196
7197 } else {
7198 # 0 to N-1
7199 if ($$val>($N-1)) {
7200 $$rem+= int($$val/$N);
7201 $$val = $$val%$N;
7202 } elsif ($$val<0) {
7203 $$rem-= int(-($$val+1)/$N)+1;
7204 $$val = ($N-1)-(-($$val+1)%$N);
7205 }
7206 }
7207}
7208
[618]7209# $Flag=_IsInt($String [,$low, $high]);
[360]7210# Returns 1 if $String is a valid integer, 0 otherwise. If $low is
7211# entered, $String must be >= $low. If $high is entered, $String must
7212# be <= $high. It is valid to check only one of the bounds.
[618]7213sub _IsInt {
[360]7214 my($N,$low,$high)=@_;
7215 return 0 if (! defined $N or
7216 $N !~ /^\s*[-+]?\d+\s*$/ or
7217 defined $low && $N<$low or
7218 defined $high && $N>$high);
7219 return 1;
7220}
7221
[618]7222# $File=_CleanFile($file);
[360]7223# This cleans up a path to remove the following things:
7224# double slash /a//b -> /a/b
7225# trailing dot /a/. -> /a
7226# leading dot ./a -> a
7227# trailing slash a/ -> a
[618]7228sub _CleanFile {
[360]7229 my($file)=@_;
7230 $file =~ s/\s*$//;
7231 $file =~ s/^\s*//;
7232 $file =~ s|//+|/|g; # multiple slash
7233 $file =~ s|/\.$|/|; # trailing /. (leaves trailing slash)
7234 $file =~ s|^\./|| # leading ./
7235 if ($file ne "./");
7236 $file =~ s|/$|| # trailing slash
7237 if ($file ne "/");
7238 return $file;
7239}
7240
[618]7241# $File=_ExpandTilde($file);
[360]7242# This checks to see if a "~" appears as the first character in a path.
7243# If it does, the "~" expansion is interpreted (if possible) and the full
7244# path is returned. If a "~" expansion is used but cannot be
7245# interpreted, an empty string is returned.
7246#
7247# This is Windows/Mac friendly.
7248# This is efficient.
[618]7249sub _ExpandTilde {
[360]7250 my($file)=shift;
7251 my($user,$home)=();
7252 # ~aaa/bbb= ~ aaa /bbb
7253 if ($file =~ s|^~([^/]*)||) {
7254 $user=$1;
7255 # Single user operating systems (Mac, MSWindows) don't have the getpwnam
7256 # and getpwuid routines defined. Try to catch various different ways
7257 # of knowing we are on one of these systems:
7258 return "" if ($OS eq "Windows" or
7259 $OS eq "Mac" or
7260 $OS eq "Netware" or
7261 $OS eq "MPE");
7262 $user="" if (! defined $user);
7263
7264 if ($user) {
7265 $home= (getpwnam($user))[7];
7266 } else {
7267 $home= (getpwuid($<))[7];
7268 }
7269 $home = VMS::Filespec::unixpath($home) if ($OS eq "VMS");
7270 return "" if (! $home);
7271 $file="$home/$file";
7272 }
7273 $file;
7274}
7275
[618]7276# $File=_FullFilePath($file);
[360]7277# Returns the full or relative path to $file (expanding "~" if necessary).
7278# Returns an empty string if a "~" expansion cannot be interpreted. The
[618]7279# path does not need to exist. _CleanFile is called.
7280sub _FullFilePath {
[360]7281 my($file)=shift;
7282 my($rootpat) = '^/'; #default pattern to match absolute path
7283 $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
[618]7284 $file=_ExpandTilde($file);
[360]7285 return "" if (! $file);
[618]7286 return _CleanFile($file);
[360]7287}
7288
[618]7289# $Flag=_CheckFilePath($file [,$mode]);
[360]7290# Checks to see if $file exists, to see what type it is, and whether
7291# the script can access it. If it exists and has the correct mode, 1
7292# is returned.
7293#
7294# $mode is a string which may contain any of the valid file test operator
7295# characters except t, M, A, C. The appropriate test is run for each
7296# character. For example, if $mode is "re" the -r and -e tests are both
7297# run.
7298#
7299# An empty string is returned if the file doesn't exist. A 0 is returned
7300# if the file exists but any test fails.
7301#
7302# All characters in $mode which do not correspond to valid tests are
7303# ignored.
[618]7304sub _CheckFilePath {
[360]7305 my($file,$mode)=@_;
7306 my($test)=();
[618]7307 $file=_FullFilePath($file);
[360]7308 $mode = "" if (! defined $mode);
7309
7310 # Run tests
7311 return 0 if (! defined $file or ! $file);
7312 return 0 if (( ! -e $file) or
7313 ($mode =~ /r/ && ! -r $file) or
7314 ($mode =~ /w/ && ! -w $file) or
7315 ($mode =~ /x/ && ! -x $file) or
7316 ($mode =~ /R/ && ! -R $file) or
7317 ($mode =~ /W/ && ! -W $file) or
7318 ($mode =~ /X/ && ! -X $file) or
7319 ($mode =~ /o/ && ! -o $file) or
7320 ($mode =~ /O/ && ! -O $file) or
7321 ($mode =~ /z/ && ! -z $file) or
7322 ($mode =~ /s/ && ! -s $file) or
7323 ($mode =~ /f/ && ! -f $file) or
7324 ($mode =~ /d/ && ! -d $file) or
7325 ($mode =~ /l/ && ! -l $file) or
7326 ($mode =~ /s/ && ! -s $file) or
7327 ($mode =~ /p/ && ! -p $file) or
7328 ($mode =~ /b/ && ! -b $file) or
7329 ($mode =~ /c/ && ! -c $file) or
7330 ($mode =~ /u/ && ! -u $file) or
7331 ($mode =~ /g/ && ! -g $file) or
7332 ($mode =~ /k/ && ! -k $file) or
7333 ($mode =~ /T/ && ! -T $file) or
7334 ($mode =~ /B/ && ! -B $file));
7335 return 1;
7336}
7337#&&
7338
[618]7339# $Path=_FixPath($path [,$full] [,$mode] [,$error]);
[360]7340# Makes sure that every directory in $path (a colon separated list of
7341# directories) appears as a full path or relative path. All "~"
7342# expansions are removed. All trailing slashes are removed also. If
7343# $full is non-nil, relative paths are expanded to full paths as well.
7344#
7345# If $mode is given, it may be either "e", "r", or "w". In this case,
7346# additional checking is done to each directory. If $mode is "e", it
7347# need ony exist to pass the check. If $mode is "r", it must have have
7348# read and execute permission. If $mode is "w", it must have read,
7349# write, and execute permission.
7350#
7351# The value of $error determines what happens if the directory does not
7352# pass the test. If it is non-nil, if any directory does not pass the
7353# test, the subroutine returns the empty string. Otherwise, it is simply
7354# removed from $path.
7355#
7356# The corrected path is returned.
[618]7357sub _FixPath {
[360]7358 my($path,$full,$mode,$err)=@_;
7359 local($_)="";
7360 my(@dir)=split(/$Cnf{"PathSep"}/,$path);
7361 $full=0 if (! defined $full);
7362 $mode="" if (! defined $mode);
7363 $err=0 if (! defined $err);
7364 $path="";
7365 if ($mode eq "e") {
7366 $mode="de";
7367 } elsif ($mode eq "r") {
7368 $mode="derx";
7369 } elsif ($mode eq "w") {
7370 $mode="derwx";
7371 }
7372
7373 foreach (@dir) {
7374
7375 # Expand path
7376 if ($full) {
[618]7377 $_=_FullFilePath($_);
[360]7378 } else {
[618]7379 $_=_ExpandTilde($_);
[360]7380 }
7381 if (! $_) {
7382 return "" if ($err);
7383 next;
7384 }
7385
7386 # Check mode
[618]7387 if (! $mode or _CheckFilePath($_,$mode)) {
[360]7388 $path .= $Cnf{"PathSep"} . $_;
7389 } else {
7390 return "" if ($err);
7391 }
7392 }
7393 $path =~ s/^$Cnf{"PathSep"}//;
7394 return $path;
7395}
7396#&&
7397
[618]7398# $File=_SearchPath($file,$path [,$mode] [,@suffixes]);
[360]7399# Searches through directories in $path for a file named $file. The
7400# full path is returned if one is found, or an empty string otherwise.
7401# The file may exist with one of the @suffixes. The mode is checked
[618]7402# similar to _CheckFilePath.
[360]7403#
7404# The first full path that matches the name and mode is returned. If none
7405# is found, an empty string is returned.
[618]7406sub _SearchPath {
[360]7407 my($file,$path,$mode,@suff)=@_;
7408 my($f,$s,$d,@dir,$fs)=();
[618]7409 $path=_FixPath($path,1,"r");
[360]7410 @dir=split(/$Cnf{"PathSep"}/,$path);
7411 foreach $d (@dir) {
7412 $f="$d/$file";
7413 $f=~ s|//|/|g;
[618]7414 return $f if (_CheckFilePath($f,$mode));
[360]7415 foreach $s (@suff) {
7416 $fs="$f.$s";
[618]7417 return $fs if (_CheckFilePath($fs,$mode));
[360]7418 }
7419 }
7420 return "";
7421}
7422
[618]7423# @list=_ReturnList($str);
[360]7424# This takes a string which should be a comma separated list of integers
7425# or ranges (5-7). It returns a sorted list of all integers referred to
7426# by the string, or () if there is an invalid element.
7427#
7428# Negative integers are also handled. "-2--1" is equivalent to "-2,-1".
[618]7429sub _ReturnList {
[360]7430 my($str)=@_;
7431 my(@ret,@str,$from,$to,$tmp)=();
7432 @str=split(/,/,$str);
7433 foreach $str (@str) {
7434 if ($str =~ /^[-+]?\d+$/) {
7435 push(@ret,$str);
7436 } elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {
7437 ($from,$to)=($1,$2);
7438 if ($from>$to) {
7439 $tmp=$from;
7440 $from=$to;
7441 $to=$tmp;
7442 }
7443 push(@ret,$from..$to);
7444 } else {
7445 return ();
7446 }
7447 }
7448 @ret;
7449}
7450
74511;
[618]7452# Local Variables:
7453# mode: cperl
7454# indent-tabs-mode: nil
7455# cperl-indent-level: 3
7456# cperl-continued-statement-offset: 2
7457# cperl-continued-brace-offset: 0
7458# cperl-brace-offset: 0
7459# cperl-brace-imaginary-offset: 0
7460# cperl-label-offset: -2
7461# End:
Note: See TracBrowser for help on using the repository browser.