File Coverage

lib/Date/Manip/DM5.pm
Criterion Covered Total %
statement 45 3805 1.1
branch 0 2196 0.0
condition 0 852 0.0
subroutine 15 101 14.8
pod 34 34 100.0
total 94 6988 1.3


line stmt bran cond sub pod time code
1             package Date::Manip::DM5;
2             # Copyright (c) 1995-2023 Sullivan Beck. All rights reserved.
3             # This program is free software; you can redistribute it and/or modify it
4             # under the same terms as Perl itself.
5              
6             ###########################################################################
7             ###########################################################################
8              
9 36     36   204 use warnings;
  36         64  
  36         20891  
10             warnings::warnif('deprecated', 'Date::Manip::DM5 is deprecated and will be removed from the Date::Manip package starting in version 7.00');
11              
12             our($OS,%Lang,%Holiday,%Events,%Curr,%Cnf,%Zone,$VERSION,@ISA,@EXPORT);
13              
14             # Determine the type of OS...
15             $OS="Unix";
16             $OS="Windows" if ((defined $^O and
17             $^O =~ /MSWin32/i ||
18             $^O =~ /Windows_95/i ||
19             $^O =~ /Windows_NT/i) ||
20             (defined $ENV{OS} and
21             $ENV{OS} =~ /MSWin32/i ||
22             $ENV{OS} =~ /Windows_95/i ||
23             $ENV{OS} =~ /Windows_NT/i));
24             $OS="Unix" if (defined $^O and
25             $^O =~ /cygwin/i);
26             $OS="Netware" if (defined $^O and
27             $^O =~ /NetWare/i);
28             $OS="Mac" if ((defined $^O and
29             $^O =~ /MacOS/i) ||
30             (defined $ENV{OS} and
31             $ENV{OS} =~ /MacOS/i));
32             $OS="MPE" if (defined $^O and
33             $^O =~ /MPE/i);
34             $OS="OS2" if (defined $^O and
35             $^O =~ /os2/i);
36             $OS="VMS" if (defined $^O and
37             $^O =~ /VMS/i);
38             $OS="AIX" if (defined $^O and
39             $^O =~ /aix/i);
40              
41             # Determine if we're doing taint checking
42             #if ($] < 5.0080) {
43             $Date::Manip::DM5::NoTaint = eval { local $^W=0; eval("#" . substr($^X, 0, 0)); 1 };
44             #} else {
45             # $Date::Manip::DM5::NoTaint = (${^TAINT} == 0 ? 1 : 0);
46             #}
47              
48             ###########################################################################
49             # CUSTOMIZATION
50             ###########################################################################
51             #
52             # See the section of the POD documentation section CUSTOMIZING DATE::MANIP
53             # below for a complete description of each of these variables.
54              
55              
56             # Location of a the global config file. Tilde (~) expansions are allowed.
57             # This should be set in Date_Init arguments.
58             $Cnf{"GlobalCnf"}="";
59             $Cnf{"IgnoreGlobalCnf"}="";
60              
61             # Name of a personal config file and the path to search for it. Tilde (~)
62             # expansions are allowed. This should be set in Date_Init arguments or in
63             # the global config file.
64              
65             @Date::Manip::DM5::DatePath=();
66             if ($OS eq "Windows") {
67             $Cnf{"PathSep"} = ";";
68             $Cnf{"PersonalCnf"} = "Manip.cnf";
69             $Cnf{"PersonalCnfPath"} = ".";
70              
71             } elsif ($OS eq "Netware") {
72             $Cnf{"PathSep"} = ";";
73             $Cnf{"PersonalCnf"} = "Manip.cnf";
74             $Cnf{"PersonalCnfPath"} = ".";
75              
76             } elsif ($OS eq "MPE") {
77             $Cnf{"PathSep"} = ":";
78             $Cnf{"PersonalCnf"} = "Manip.cnf";
79             $Cnf{"PersonalCnfPath"} = ".";
80              
81             } elsif ($OS eq "OS2") {
82             $Cnf{"PathSep"} = ":";
83             $Cnf{"PersonalCnf"} = "Manip.cnf";
84             $Cnf{"PersonalCnfPath"} = ".";
85              
86             } elsif ($OS eq "Mac") {
87             $Cnf{"PathSep"} = ":";
88             $Cnf{"PersonalCnf"} = "Manip.cnf";
89             $Cnf{"PersonalCnfPath"} = ".";
90              
91             } elsif ($OS eq "VMS") {
92             # VMS doesn't like files starting with "."
93             $Cnf{"PathSep"} = ",";
94             $Cnf{"PersonalCnf"} = "Manip.cnf";
95             $Cnf{"PersonalCnfPath"} = "/sys\$login";
96              
97             } else {
98             # Unix
99             $Cnf{"PathSep"} = ":";
100             $Cnf{"PersonalCnf"} = ".DateManip.cnf";
101             $Cnf{"PersonalCnfPath"} = ".:~";
102             @Date::Manip::DM5::DatePath=qw(/bin /usr/bin /usr/local/bin);
103             }
104              
105             ### Date::Manip variables set in the global or personal config file
106              
107             # Which language to use when parsing dates.
108             $Cnf{"Language"}="English";
109              
110             # 12/10 = Dec 10 (US) or Oct 12 (anything else)
111             $Cnf{"DateFormat"}="US";
112              
113             # Local timezone
114             $Cnf{"TZ"}="";
115              
116             # Timezone to work in (""=local, "IGNORE", or a timezone)
117             $Cnf{"ConvTZ"}="";
118              
119             # Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
120             $Cnf{"Internal"}=0;
121              
122             # First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
123             $Cnf{"FirstDay"}=1;
124              
125             # First and last day of the work week (1=monday, 7=sunday)
126             $Cnf{"WorkWeekBeg"}=1;
127             $Cnf{"WorkWeekEnd"}=5;
128              
129             # If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
130             # ignored)
131             $Cnf{"WorkDay24Hr"}=0;
132              
133             # Start and end time of the work day (any time format allowed, seconds
134             # ignored)
135             $Cnf{"WorkDayBeg"}="08:00";
136             $Cnf{"WorkDayEnd"}="17:00";
137              
138             # If "today" is a holiday, we look either to "tomorrow" or "yesterday" for
139             # the nearest business day. By default, we'll always look "tomorrow"
140             # first.
141             $Cnf{"TomorrowFirst"}=1;
142              
143             # Erase the old holidays
144             $Cnf{"EraseHolidays"}="";
145              
146             # Set this to non-zero to be produce completely backwards compatible deltas
147             $Cnf{"DeltaSigns"}=0;
148              
149             # If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
150             # make week 1 contain Jan 1.
151             $Cnf{"Jan1Week1"}=0;
152              
153             # 2 digit years fall into the 100 year period given by [ CURR-N,
154             # CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful
155             # numbers might be 0 (forced to be this year or later) and 99 (forced to be
156             # this year or earlier). It can also be set to "c" (current century) or
157             # "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the
158             # form cNNNN to give the 100 year period NNNN to NNNN+99.
159             $Cnf{"YYtoYYYY"}=89;
160              
161             # Set this to 1 if you want a long-running script to always update the
162             # timezone. This will slow Date::Manip down. Read the POD documentation.
163             $Cnf{"UpdateCurrTZ"}=0;
164              
165             # Use an international character set.
166             $Cnf{"IntCharSet"}=0;
167              
168             # Use this to force the current date to be set to this:
169             $Cnf{"ForceDate"}="";
170              
171             # Use this to make "today" mean "today at midnight".
172             $Cnf{"TodayIsMidnight"}=0;
173              
174             ###########################################################################
175              
176             require 5.000;
177             require Exporter;
178             @ISA = qw(Exporter);
179             @EXPORT = qw(
180             DateManipVersion
181             Date_Init
182             ParseDateString
183             ParseDate
184             ParseRecur
185             Date_Cmp
186             DateCalc
187             ParseDateDelta
188             UnixDate
189             Delta_Format
190             Date_GetPrev
191             Date_GetNext
192             Date_SetTime
193             Date_SetDateField
194             Date_IsHoliday
195             Events_List
196              
197             Date_DaysInMonth
198             Date_DayOfWeek
199             Date_SecsSince1970
200             Date_SecsSince1970GMT
201             Date_DaysSince1BC
202             Date_DayOfYear
203             Date_DaysInYear
204             Date_WeekOfYear
205             Date_LeapYear
206             Date_DaySuffix
207             Date_ConvTZ
208             Date_TimeZone
209             Date_IsWorkDay
210             Date_NextWorkDay
211             Date_PrevWorkDay
212             Date_NearestWorkDay
213             Date_NthDayOfYear
214             );
215 36     36   210 use strict;
  36         59  
  36         4854  
216 36     36   14277 use integer;
  36         462  
  36         163  
217 36     36   1002 use Carp;
  36         51  
  36         1966  
218              
219 36     36   170 use IO::File;
  36         56  
  36         4383  
220              
221             our($Abbrevs);
222 36     36   12567 use Date::Manip::DM5abbrevs;
  36         74  
  36         4516  
223              
224             $VERSION='6.92';
225             our $DM5_VERSION = '5.66';
226              
227             ########################################################################
228             ########################################################################
229              
230             $Curr{"InitLang"} = 1; # Whether a language is being init'ed
231             $Curr{"InitDone"} = 0; # Whether Init_Date has been called
232             $Curr{"InitFilesRead"} = 0;
233             $Curr{"ResetWorkDay"} = 1;
234             $Curr{"Debug"} = "";
235             $Curr{"DebugVal"} = "";
236              
237             $Holiday{"year"} = 0;
238             $Holiday{"dates"} = {};
239             $Holiday{"desc"} = {};
240              
241             $Events{"raw"} = [];
242             $Events{"parsed"} = 0;
243             $Events{"dates"} = [];
244             $Events{"recur"} = [];
245              
246             ########################################################################
247             ########################################################################
248             # THESE ARE THE MAIN ROUTINES
249             ########################################################################
250             ########################################################################
251              
252             # Get rid of a problem with old versions of perl
253 36     36   197 no strict "vars";
  36         50  
  36         1814  
254             # This sorts from longest to shortest element
255             sub _sortByLength {
256 0     0     return (length $b <=> length $a);
257             }
258 36     36   161 use strict "vars";
  36         45  
  36         370734  
259              
260             sub DateManipVersion {
261 0 0   0 1   print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
262 0           return $DM5_VERSION;
263             }
264              
265             sub Date_Init {
266 0 0   0 1   print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
267 0           $Curr{"Debug"}="";
268              
269 0           my(@args)=@_;
270 0           $Curr{"InitDone"}=1;
271 0           local($_)=();
272 0           my($internal,$firstday)=();
273 0           my($var,$val,$file,@tmp)=();
274              
275             # InitFilesRead = 0 : no conf files read yet
276             # 1 : global read, no personal read
277             # 2 : personal read
278              
279 0           $Cnf{"EraseHolidays"}=0;
280 0           foreach (@args) {
281 0           s/\s*$//;
282 0           s/^\s*//;
283 0           /^(\S+) \s* = \s* (.*)$/x;
284 0           ($var,$val)=($1,$2);
285 0 0         if ($var =~ /^GlobalCnf$/i) {
    0          
    0          
    0          
    0          
    0          
286 0           $Cnf{"GlobalCnf"}=$val;
287 0 0         if ($val) {
288 0           $Curr{"InitFilesRead"}=0;
289 0           EraseHolidays();
290             }
291             } elsif ($var =~ /^PathSep$/i) {
292 0           $Cnf{"PathSep"}=$val;
293             } elsif ($var =~ /^PersonalCnf$/i) {
294 0           $Cnf{"PersonalCnf"}=$val;
295 0 0         $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
296             } elsif ($var =~ /^PersonalCnfPath$/i) {
297 0           $Cnf{"PersonalCnfPath"}=$val;
298 0 0         $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
299             } elsif ($var =~ /^IgnoreGlobalCnf$/i) {
300 0 0         $Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0);
301 0           $Cnf{"IgnoreGlobalCnf"}=1;
302             } elsif ($var =~ /^EraseHolidays$/i) {
303 0           EraseHolidays();
304             } else {
305 0           push(@tmp,$_);
306             }
307             }
308 0           @args=@tmp;
309              
310             # Read global config file
311 0 0 0       if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
312 0           $Curr{"InitFilesRead"}=1;
313              
314 0 0         if ($Cnf{"GlobalCnf"}) {
315 0           $file=_ExpandTilde($Cnf{"GlobalCnf"});
316 0 0         _Date_InitFile($file) if ($file);
317             }
318             }
319              
320             # Read personal config file
321 0 0         if ($Curr{"InitFilesRead"}<2) {
322 0           $Curr{"InitFilesRead"}=2;
323              
324 0 0 0       if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) {
325 0           $file=_SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r");
326 0 0         _Date_InitFile($file) if ($file);
327             }
328             }
329              
330 0           foreach (@args) {
331 0           s/\s*$//;
332 0           s/^\s*//;
333 0           /^(\S+) \s* = \s* (.*)$/x;
334 0           ($var,$val)=($1,$2);
335 0 0         $val="" if (! defined $val);
336 0           _Date_SetConfigVariable($var,$val);
337             }
338              
339             confess "ERROR: Unknown FirstDay in Date::Manip.\n"
340 0 0         if (! _IsInt($Cnf{"FirstDay"},1,7));
341             confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n"
342 0 0         if (! _IsInt($Cnf{"WorkWeekBeg"},1,7));
343             confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n"
344 0 0         if (! _IsInt($Cnf{"WorkWeekEnd"},1,7));
345             confess "ERROR: Invalid WorkWeek in Date::Manip.\n"
346 0 0         if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"});
347              
348 0           my(%lang,
349             $tmp,%tmp,$tmp2,@tmp2,
350             $i,$j,@tmp3,
351             @zones)=();
352              
353 0           my($L)=$Cnf{"Language"};
354              
355 0 0         if ($Curr{"InitLang"}) {
356 0           $Curr{"InitLang"}=0;
357              
358 0 0 0       if ($L eq "English") {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
359 0           _Date_Init_English(\%lang);
360              
361             } elsif ($L eq "French") {
362 0           _Date_Init_French(\%lang);
363              
364             } elsif ($L eq "Swedish") {
365 0           _Date_Init_Swedish(\%lang);
366              
367             } elsif ($L eq "German") {
368 0           _Date_Init_German(\%lang);
369              
370             } elsif ($L eq "Polish") {
371 0           _Date_Init_Polish(\%lang);
372              
373             } elsif ($L eq "Dutch" ||
374             $L eq "Nederlands") {
375 0           _Date_Init_Dutch(\%lang);
376              
377             } elsif ($L eq "Spanish") {
378 0           _Date_Init_Spanish(\%lang);
379              
380             } elsif ($L eq "Portuguese") {
381 0           _Date_Init_Portuguese(\%lang);
382              
383             } elsif ($L eq "Romanian") {
384 0           _Date_Init_Romanian(\%lang);
385              
386             } elsif ($L eq "Italian") {
387 0           _Date_Init_Italian(\%lang);
388              
389             } elsif ($L eq "Russian") {
390 0           _Date_Init_Russian(\%lang);
391              
392             } elsif ($L eq "Turkish") {
393 0           _Date_Init_Turkish(\%lang);
394              
395             } elsif ($L eq "Danish") {
396 0           _Date_Init_Danish(\%lang);
397              
398             } elsif ($L eq "Catalan") {
399 0           _Date_Init_Catalan(\%lang);
400              
401             } else {
402 0           confess "ERROR: Unknown language in Date::Manip.\n";
403             }
404              
405             # variables for months
406             # Month = "(jan|january|feb|february ... )"
407             # MonL = [ "Jan","Feb",... ]
408             # MonthL = [ "January","February", ... ]
409             # MonthH = { "january"=>1, "jan"=>1, ... }
410              
411 0           $Lang{$L}{"MonthH"}={};
412 0           $Lang{$L}{"MonthL"}=[];
413 0           $Lang{$L}{"MonL"}=[];
414             _Date_InitLists([$lang{"month_name"},
415             $lang{"month_abb"}],
416             \$Lang{$L}{"Month"},"lc,sort,back",
417             [$Lang{$L}{"MonthL"},
418             $Lang{$L}{"MonL"}],
419 0           [$Lang{$L}{"MonthH"},1]);
420              
421             # variables for day of week
422             # Week = "(mon|monday|tue|tuesday ... )"
423             # WL = [ "M","T",... ]
424             # WkL = [ "Mon","Tue",... ]
425             # WeekL = [ "Monday","Tudesday",... ]
426             # WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
427              
428 0           $Lang{$L}{"WeekH"}={};
429 0           $Lang{$L}{"WeekL"}=[];
430 0           $Lang{$L}{"WkL"}=[];
431 0           $Lang{$L}{"WL"}=[];
432             _Date_InitLists([$lang{"day_name"},
433             $lang{"day_abb"}],
434             \$Lang{$L}{"Week"},"lc,sort,back",
435             [$Lang{$L}{"WeekL"},
436             $Lang{$L}{"WkL"}],
437 0           [$Lang{$L}{"WeekH"},1]);
438             _Date_InitLists([$lang{"day_char"}],
439             "","lc",
440 0           [$Lang{$L}{"WL"}],
441             [\%tmp,1]);
442 0           %{ $Lang{$L}{"WeekH"} } =
443 0           (%{ $Lang{$L}{"WeekH"} },%tmp);
  0            
444              
445             # variables for last
446             # Last = "(last)"
447             # LastL = [ "last" ]
448             # Each = "(each)"
449             # EachL = [ "each" ]
450             # variables for day of month
451             # DoM = "(1st|first ... 31st)"
452             # DoML = [ "1st","2nd",... "31st" ]
453             # DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 }
454             # variables for week of month
455             # WoM = "(1st|first| ... 5th|last)"
456             # WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 }
457              
458 0           $Lang{$L}{"LastL"}=$lang{"last"};
459             _Date_InitStrings($lang{"last"},
460 0           \$Lang{$L}{"Last"},"lc,sort");
461              
462 0           $Lang{$L}{"EachL"}=$lang{"each"};
463             _Date_InitStrings($lang{"each"},
464 0           \$Lang{$L}{"Each"},"lc,sort");
465              
466 0           $Lang{$L}{"DoMH"}={};
467 0           $Lang{$L}{"DoML"}=[];
468             _Date_InitLists([$lang{"num_suff"},
469             $lang{"num_word"}],
470             \$Lang{$L}{"DoM"},"lc,sort,back,escape",
471             [$Lang{$L}{"DoML"},
472             \@tmp],
473 0           [$Lang{$L}{"DoMH"},1]);
474              
475 0           @tmp=();
476 0           foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
  0            
477 0           $tmp2=$Lang{$L}{"DoMH"}{$tmp};
478 0 0         if ($tmp2<6) {
479 0           $Lang{$L}{"WoMH"}{$tmp} = $tmp2;
480 0           push(@tmp,$tmp);
481             }
482             }
483 0           foreach $tmp (@{ $Lang{$L}{"LastL"} }) {
  0            
484 0           $Lang{$L}{"WoMH"}{$tmp} = -1;
485 0           push(@tmp,$tmp);
486             }
487 0           _Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"},
488             "lc,sort,back,escape");
489              
490             # variables for AM or PM
491             # AM = "(am)"
492             # PM = "(pm)"
493             # AmPm = "(am|pm)"
494             # AMstr = "AM"
495             # PMstr = "PM"
496              
497 0           _Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape");
498 0           _Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape");
499 0           _Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"},
  0            
  0            
500             "lc,back,sort,escape");
501 0           $Lang{$L}{"AMstr"}=$lang{"am"}[0];
502 0           $Lang{$L}{"PMstr"}=$lang{"pm"}[0];
503              
504             # variables for expressions used in parsing deltas
505             # Yabb = "(?:y|yr|year|years)"
506             # Mabb = similar for months
507             # Wabb = similar for weeks
508             # Dabb = similar for days
509             # Habb = similar for hours
510             # MNabb = similar for minutes
511             # Sabb = similar for seconds
512             # Repl = { "abb"=>"replacement" }
513             # Whenever an abbreviation could potentially refer to two different
514             # strings (M standing for Minutes or Months), the abbreviation must
515             # be listed in Repl instead of in the appropriate Xabb values. This
516             # only applies to abbreviations which are substrings of other values
517             # (so there is no confusion between Mn and Month).
518              
519 0           _Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort");
520 0           _Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort");
521 0           _Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort");
522 0           _Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort");
523 0           _Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort");
524 0           _Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort");
525 0           _Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort");
526 0           $Lang{$L}{"Repl"}={};
527 0           _Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
528              
529             # variables for special dates that are offsets from now
530             # Now = "now"
531             # Today = "today"
532             # Offset = "(yesterday|tomorrow)"
533             # OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ]
534             # Times = "(noon|midnight)"
535             # TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" }
536             # SepHM = hour/minute separator
537             # SepMS = minute/second separator
538             # SepSS = second/fraction separator
539              
540 0           $Lang{$L}{"TimesH"}={};
541             _Date_InitHash($lang{"times"},
542             \$Lang{$L}{"Times"},"lc,sort,back",
543 0           $Lang{$L}{"TimesH"});
544 0           _Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort");
545 0           _Date_InitStrings($lang{"today"},\$Lang{$L}{"Today"},"lc,sort");
546 0           $Lang{$L}{"OffsetH"}={};
547             _Date_InitHash($lang{"offset"},
548             \$Lang{$L}{"Offset"},"lc,sort,back",
549 0           $Lang{$L}{"OffsetH"});
550 0           $Lang{$L}{"SepHM"}=$lang{"sephm"};
551 0           $Lang{$L}{"SepMS"}=$lang{"sepms"};
552 0           $Lang{$L}{"SepSS"}=$lang{"sepss"};
553              
554             # variables for time zones
555             # zones = regular expression with all zone names (EST)
556             # n2o = a hash of all parsable zone names with their offsets
557             # tzones = reguar expression with all tzdata timezones (US/Eastern)
558             # tz2z = hash of all tzdata timezones to full timezone (EST#EDT)
559              
560 0           $Zone{"n2o"} = {};
561 0           ($Zone{"zones"},%{ $Zone{"n2o"} })=
  0            
562             _Date_Regexp($Abbrevs,"sort,lc,under,back",
563             "keys");
564              
565 0           $tmp=
566             "US/Pacific PST8PDT ".
567             "US/Mountain MST7MDT ".
568             "US/Central CST6CDT ".
569             "US/Eastern EST5EDT ".
570             "Canada/Pacific PST8PDT ".
571             "Canada/Mountain MST7MDT ".
572             "Canada/Central CST6CDT ".
573             "Canada/Eastern EST5EDT";
574              
575 0           $Zone{"tz2z"} = {};
576 0           ($Zone{"tzones"},%{ $Zone{"tz2z"} })=
  0            
577             _Date_Regexp($tmp,"lc,under,back","keys");
578 0           $Cnf{"TZ"}=Date_TimeZone();
579              
580             # misc. variables
581             # At = "(?:at)"
582             # Of = "(?:in|of)"
583             # On = "(?:on)"
584             # Future = "(?:in)"
585             # Later = "(?:later)"
586             # Past = "(?:ago)"
587             # Next = "(?:next)"
588             # Prev = "(?:last|previous)"
589              
590 0           _Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort");
591 0           _Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort");
592 0           _Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort");
593 0           _Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort");
594 0           _Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort");
595 0           _Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort");
596 0           _Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort");
597 0           _Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort");
598              
599             # calc mode variables
600             # Approx = "(?:approximately)"
601             # Exact = "(?:exactly)"
602             # Business = "(?:business)"
603              
604 0           _Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort");
605 0           _Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort");
606 0           _Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort");
607              
608             ############### END OF LANGUAGE INITIALIZATION
609             }
610              
611 0 0         if ($Curr{"ResetWorkDay"}) {
612 0           my($h1,$m1,$h2,$m2)=();
613 0 0         if ($Cnf{"WorkDay24Hr"}) {
614 0           ($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
615 0           ($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
616 0           $Curr{"WDlen"}=24*60;
617 0           $Cnf{"WorkDayBeg"}="00:00";
618 0           $Cnf{"WorkDayEnd"}="23:59";
619              
620             } else {
621             confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n"
622 0 0         if (! (($h1,$m1)=_CheckTime($Cnf{"WorkDayBeg"})));
623 0           $Cnf{"WorkDayBeg"}="$h1:$m1";
624             confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n"
625 0 0         if (! (($h2,$m2)=_CheckTime($Cnf{"WorkDayEnd"})));
626 0           $Cnf{"WorkDayEnd"}="$h2:$m2";
627              
628 0           ($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
629 0           ($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
630              
631             # Work day length = h1:m1 or 0:len (len minutes)
632 0           $h1=$h2-$h1;
633 0           $m1=$m2-$m1;
634 0 0         if ($m1<0) {
635 0           $h1--;
636 0           $m1+=60;
637             }
638 0           $Curr{"WDlen"}=$h1*60+$m1;
639             }
640 0           $Curr{"ResetWorkDay"}=0;
641             }
642              
643             # current time
644 0           my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
645 0 0         if ($Cnf{"ForceDate"}=~
646             /^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
647 0           ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
648             } else {
649 0           ($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
650 0           $y+=1900;
651 0           $m++;
652             }
653 0           _Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
654 0           $Curr{"Y"}=$y;
655 0           $Curr{"M"}=$m;
656 0           $Curr{"D"}=$d;
657 0           $Curr{"H"}=$h;
658 0           $Curr{"Mn"}=$mn;
659 0           $Curr{"S"}=$s;
660 0           $Curr{"AmPm"}=$ampm;
661 0           $Curr{"Now"}=_Date_Join($y,$m,$d,$h,$mn,$s);
662 0 0         if ($Cnf{"TodayIsMidnight"}) {
663 0           $Curr{"Today"}=_Date_Join($y,$m,$d,0,0,0);
664             } else {
665 0           $Curr{"Today"}=$Curr{"Now"};
666             }
667              
668 0           $Curr{"Debug"}=$Curr{"DebugVal"};
669              
670             # If we're in array context, let's return a list of config variables
671             # that could be passed to Date_Init to get the same state as we're
672             # currently in.
673 0 0         if (wantarray) {
674             # Some special variables that have to be in a specific order
675 0           my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
676 0           my(%tmp)=map { $_,1 } @special;
  0            
677 0           my(@tmp,$key,$val);
678 0           foreach $key (@special) {
679 0           $val=$Cnf{$key};
680 0           push(@tmp,"$key=$val");
681             }
682 0           foreach $key (keys %Cnf) {
683 0 0         next if (exists $tmp{$key});
684 0           $val=$Cnf{$key};
685 0           push(@tmp,"$key=$val");
686             }
687 0           return @tmp;
688             }
689 0           return ();
690             }
691              
692             sub ParseDateString {
693 0 0   0 1   print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
694 0           local($_)=@_;
695 0 0         return "" if (! $_);
696              
697 0           my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
698 0           my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
699              
700             # We only need to reinitialize if we have to determine what NOW is.
701 0 0 0       Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
702              
703 0           my($L)=$Cnf{"Language"};
704 0           my($type)=$Cnf{"DateFormat"};
705              
706             # Mode is set in DateCalc. ParseDate only overrides it if the string
707             # contains a mode.
708 0 0 0       if ($Lang{$L}{"Exact"} &&
    0 0        
    0 0        
    0          
709             s/$Lang{$L}{"Exact"}//) {
710 0           $Curr{"Mode"}=0;
711             } elsif ($Lang{$L}{"Approx"} &&
712             s/$Lang{$L}{"Approx"}//) {
713 0           $Curr{"Mode"}=1;
714             } elsif ($Lang{$L}{"Business"} &&
715             s/$Lang{$L}{"Business"}//) {
716 0           $Curr{"Mode"}=2;
717             } elsif (! exists $Curr{"Mode"}) {
718 0           $Curr{"Mode"}=0;
719             }
720              
721             # Unfortunately, some deltas can be parsed as dates. An example is
722             # 1 second == 1 2nd == 1 2
723             # But, some dates can be parsed as deltas. The most important being:
724             # 1998010101:00:00
725             #
726             # We'll check to see if a "date" can be parsed as a delta. If so, we'll
727             # assume that it is a delta (since they are much simpler, it is much
728             # less likely that we'll mistake a delta for a date than vice versa)
729             # unless it is an ISO-8601 date.
730             #
731             # This is important because we are using DateCalc to test whether a
732             # string is a date or a delta. Dates are tested first, so we need to
733             # be able to pass a delta into this routine and have it correctly NOT
734             # interpreted as a date.
735             #
736             # We will insist that the string contain something other than digits and
737             # colons so that the following will get correctly interpreted as a date
738             # rather than a delta:
739             # 12:30
740             # 19980101
741              
742 0           $delta="";
743 0 0         $delta=ParseDateDelta($_) if (/[^:0-9]/);
744              
745             # Put parse in a simple loop for an easy exit.
746             PARSE: {
747 0           my(@tmp)=_Date_Split($_);
  0            
748 0 0         if (@tmp) {
749 0           ($y,$m,$d,$h,$mn,$s)=@tmp;
750 0           last PARSE;
751             }
752              
753             # Fundamental regular expressions
754              
755 0           my($month)=$Lang{$L}{"Month"}; # (jan|january|...)
756 0           my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
  0            
757 0           my($week)=$Lang{$L}{"Week"}; # (mon|monday|...)
758 0           my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
  0            
759 0           my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last)
760 0           my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
  0            
761 0           my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st)
762 0           my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
  0            
763 0           my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm)
764 0           my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight)
765 0           my($now)=$Lang{$L}{"Now"}; # now
766 0           my($today)=$Lang{$L}{"Today"}; # today
767 0           my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow)
768 0           my($zone)=$Zone{"zones"}; # (edt|est|...)
769 0           my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days)
770 0           my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months)
771 0           my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks)
772 0           my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next)
773 0           my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous)
774 0           my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago)
775 0           my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in)
776 0           my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later)
777 0           my($at)=$Lang{$L}{"At"}; # (?:at)
778 0           my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of)
779 0           my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)';
780             # \s*(?:on)\s* or \s+
781 0           my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last)
782 0           my($hm)=$Lang{$L}{"SepHM"}; # :
783 0           my($ms)=$Lang{$L}{"SepMS"}; # :
784 0           my($ss)=$Lang{$L}{"SepSS"}; # .
785              
786             # Other regular expressions
787              
788 0           my($D4)='(\d{4})'; # 4 digits (yr)
789 0           my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr)
790 0           my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
791 0           my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
792 0           my($FS)="(?:$ss\\d+)?"; # fractional secs
793 0           my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
794             # absolute time zone +0700 (GMT)
795 0           my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23
796 0           my($mzone)='(?:[0-5][0-9])'; # 00 - 59
797 0           my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))".
798             # +0700 +07:00 -07
799             '(?:\s*\([^)]+\))?)'; # (GMT)
800              
801             # A regular expression for the time EXCEPT for the hour part
802 0           my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
803              
804             # A special regular expression for /YYYY:HH:MN:SS used by Apache
805 0           my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
806              
807 0           my($time)="";
808 0           $ampm="";
809 0           $date="";
810              
811             # Substitute all special time expressions.
812 0 0         if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
813 0           $tmp=$2;
814 0           $tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
815 0           s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
816             }
817              
818             # Remove some punctuation
819 0           s/[,]/ /g;
820              
821             # When we have a digit followed immediately by a timezone (7EST), we
822             # will put a space between the digit, EXCEPT in the case of a single
823             # character military timezone. If the single character is followed
824             # by anything, no space is added.
825 0           $tmp = "";
826 0           while ( s/^(.*?\d)$zone(\s|$|[0-9])/$3/i ) {
827 0           my($bef,$z,$aft) = ($1,$2,$3);
828 0 0 0       if (length($z) != 1 || length($aft) == 0) {
829 0           $tmp .= "$bef $z";
830             } else {
831 0           $tmp .= "$bef$z";
832             }
833             }
834 0           $_ = "$tmp$_";
835 0           $zone = '\s+' . $zone . '(?:\s+|$)';
836              
837             # Remove the time
838 0           $iso=1;
839 0           $midnight=0;
840 0           $from="24${hm}00(?:${ms}00)?";
841 0           $falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
842 0           $to="00${hm}00${ms}00";
843 0 0 0       $midnight=1 if (!/$falsefrom/ && s/$from/$to/);
844              
845 0           $h=$mn=$s=0;
846 0 0 0       if (/$D$mnsec/i || /$ampmexp/i) {
847 0           $iso=0;
848 0           $tmp=0;
849 0 0 0       $tmp=1 if (/$mnsec$zone2?\s*$/i or /$mnsec$zone\s*$/i);
850 0 0         $tmp=0 if (/$ampmexp/i);
851 0 0 0       if (s/$apachetime$zone()/$1 /i ||
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
852             s/$apachetime$zone2?/$1 /i ||
853             s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i ||
854             s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i ||
855             s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i ||
856             s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i ||
857             (s/(t)$D$mnsec$zone()/$1 /i and (($iso=$tmp) || 1)) ||
858             (s/(t)$D$mnsec$zone2?/$1 /i and (($iso=$tmp) || 1)) ||
859             (s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) ||
860             (s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) ||
861             s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i ||
862             s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i ||
863             0
864             ) {
865 0           ($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
866 0 0         if (defined ($z)) {
867 0 0         if ($z =~ /^[+-]\d{2}:\d{2}$/) {
    0          
868 0           $z=~ s/://;
869             } elsif ($z =~ /^[+-]\d{2}$/) {
870 0           $z .= "00";
871             }
872             }
873 0           $time=1;
874 0           _Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
875 0           $y=$m=$d="";
876             # We're going to be calling TimeCheck again below (when we check the
877             # final date), so get rid of $ampm so that we don't have an error
878             # due to "15:30:00 PM". It'll get reset below.
879 0           $ampm="";
880 0 0         if (/^\s*$/) {
881 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
882 0           last PARSE;
883             }
884             }
885             }
886 0 0         $time=0 if ($time ne "1");
887 0           s/\s+$//;
888 0           s/^\s+//;
889              
890             # if a zone was found, get rid of the regexps
891 0 0         if ($z) {
892 0           $zone="";
893 0           $zone2="";
894             }
895              
896             # dateTtime ISO 8601 formats
897 0           my($orig)=$_;
898              
899             # Parse ISO 8601 dates now (which may still have a zone stuck to it).
900 0 0 0       if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) ||
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
901             ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) ||
902             ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) ||
903             ($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) ||
904             ($iso && /^([0-9-]+)T$zone?$/i) ||
905             ($iso && /^([0-9-]+)T$zone2?$/i) ||
906             0) {
907              
908             # If we already got a timezone, don't get another one.
909 0           my(@z);
910 0 0         if ($z) {
911 0           @z=($z,$z2);
912 0           $z="";
913             }
914 0           ($_,$z,$z2) = ($1,$2,$3);
915 0 0         ($z,$z2)=@z if (@z);
916              
917 0           s,([0-9])\s*-,$1 ,g; # Change all ISO8601 seps to spaces
918 0           s/^\s+//;
919 0           s/\s+$//;
920              
921 0 0 0       if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
    0 0        
    0 0        
    0 0        
    0          
    0          
922             /^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
923             0
924             ) {
925             # ISO 8601 Dates with times
926             # YYYYMMDDtHHMNSSFFFF...
927             # YYYYMMDDtHHMNSS
928             # YYYYMMDDtHHMN
929             # YYYYMMDDtHH
930             # YY MMDDtHHMNSSFFFF...
931             # YY MMDDtHHMNSS
932             # YY MMDDtHHMN
933             # YY MMDDtHH
934             # The t is an optional letter "t".
935 0           ($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
936 0 0 0       if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) {
      0        
      0        
      0        
937 0           $h=0;
938 0           $midnight=1;
939             }
940 0 0         $z = "" if (! defined $h);
941 0 0 0       return "" if ($time && defined $h);
942 0           last PARSE;
943              
944             } elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
945             /^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
946             # ISO 8601 Dates
947             # YYYYMMDD
948             # YYYYMM
949             # YYYY
950             # YY MMDD
951             # YY MM
952             # YY
953 0           ($y,$m,$d)=($1,$2,$3);
954 0           last PARSE;
955              
956             } elsif (/^$YY\s+$D\s+$D/) {
957             # YY-M-D
958 0           ($y,$m,$d)=($1,$2,$3);
959 0           last PARSE;
960              
961             } elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
962             # YY-W##-D
963 0           ($y,$wofm,$dofw)=($1,$2,$3);
964 0           ($y,$m,$d)=_Date_NthWeekOfYear($y,$wofm,$dofw);
965 0           last PARSE;
966              
967             } elsif (/^$D4\s*(\d{3})$/ ||
968             /^$DD\s*(\d{3})$/) {
969             # YYDOY
970 0           ($y,$which)=($1,$2);
971 0           ($y,$m,$d)=Date_NthDayOfYear($y,$which);
972 0           last PARSE;
973              
974             } elsif ($iso<0) {
975             # We confused something like 1999/August12:00:00
976             # with a dateTtime format
977 0           $_=$orig;
978              
979             } else {
980 0           return "";
981             }
982             }
983              
984             # All deltas that are not ISO-8601 dates are NOT dates.
985 0 0 0       return "" if ($Curr{"InCalc"} && $delta);
986 0 0         if ($delta) {
987 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
988 0           return _DateCalc_DateDelta($Curr{"Now"},$delta);
989             }
990              
991             # Check for some special types of dates (next, prev)
992 0           foreach $from (keys %{ $Lang{$L}{"Repl"} }) {
  0            
993 0           $to=$Lang{$L}{"Repl"}{$from};
994 0           s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
995             }
996 0 0 0       if (/$wom/i || /$future/i || /$later/i || /$past/i ||
      0        
      0        
      0        
      0        
      0        
      0        
997             /$next/i || /$prev/i || /^$week$/i || /$wkabb/i) {
998 0           $tmp=0;
999              
1000 0 0 0       if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1001             # last friday in October 95
1002 0           ($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
1003             # fix $m, $y
1004 0 0         return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1005 0           $dofw=$week{lc($dofw)};
1006 0           $wofm=$wom{lc($wofm)};
1007             # Get the first day of the month
1008 0           $date=_Date_Join($y,$m,1,$h,$mn,$s);
1009 0 0         if ($wofm==-1) {
1010 0           $date=_DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0);
1011 0           $date=Date_GetPrev($date,$dofw,0);
1012             } else {
1013 0           for ($i=0; $i<$wofm; $i++) {
1014 0 0         if ($i==0) {
1015 0           $date=Date_GetNext($date,$dofw,1);
1016             } else {
1017 0           $date=Date_GetNext($date,$dofw,0);
1018             }
1019             }
1020             }
1021 0           last PARSE;
1022              
1023             } elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
1024             # last day in month
1025 0           ($m,$y)=($1,$2);
1026 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1027 0 0 0       $y=_Date_FixYear($y) if (! defined $y or length($y)<4);
1028 0           $m=$month{lc($m)};
1029 0           $d=Date_DaysInMonth($m,$y);
1030 0           last PARSE;
1031              
1032             } elsif (/^$week$/i) {
1033             # friday
1034 0           ($dofw)=($1);
1035 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1036 0           $date=Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1);
1037 0           $date=Date_GetNext($date,$dofw,1,$h,$mn,$s);
1038 0           last PARSE;
1039              
1040             } elsif (/^$next\s*$week$/i) {
1041             # next friday
1042 0           ($dofw)=($1);
1043 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1044 0           $date=Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s);
1045 0           last PARSE;
1046              
1047             } elsif (/^$prev\s*$week$/i) {
1048             # last friday
1049 0           ($dofw)=($1);
1050 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1051 0           $date=Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s);
1052 0           last PARSE;
1053              
1054             } elsif (/^$next$wkabb$/i) {
1055             # next week
1056 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1057 0           $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0);
1058 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1059 0           last PARSE;
1060             } elsif (/^$prev$wkabb$/i) {
1061             # last week
1062 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1063 0           $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0);
1064 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1065 0           last PARSE;
1066              
1067             } elsif (/^$next$mabb$/i) {
1068             # next month
1069 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1070 0           $date=_DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0);
1071 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1072 0           last PARSE;
1073             } elsif (/^$prev$mabb$/i) {
1074             # last month
1075 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1076 0           $date=_DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0);
1077 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1078 0           last PARSE;
1079              
1080             } elsif (/^$future\s*(\d+)$day$/i ||
1081             /^(\d+)$day$later$/i) {
1082             # in 2 days
1083             # 2 days later
1084 0           ($num)=($1);
1085 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1086 0           $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0",
1087             \$err,0);
1088 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1089 0           last PARSE;
1090             } elsif (/^(\d+)$day$past$/i) {
1091             # 2 days ago
1092 0           ($num)=($1);
1093 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1094 0           $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0",
1095             \$err,0);
1096 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1097 0           last PARSE;
1098              
1099             } elsif (/^$future\s*(\d+)$wkabb$/i ||
1100             /^(\d+)$wkabb$later$/i) {
1101             # in 2 weeks
1102             # 2 weeks later
1103 0           ($num)=($1);
1104 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1105 0           $date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0",
1106             \$err,0);
1107 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1108 0           last PARSE;
1109             } elsif (/^(\d+)$wkabb$past$/i) {
1110             # 2 weeks ago
1111 0           ($num)=($1);
1112 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1113 0           $date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0",
1114             \$err,0);
1115 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1116 0           last PARSE;
1117              
1118             } elsif (/^$future\s*(\d+)$mabb$/i ||
1119             /^(\d+)$mabb$later$/i) {
1120             # in 2 months
1121             # 2 months later
1122 0           ($num)=($1);
1123 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1124 0           $date=_DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0",
1125             \$err,0);
1126 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1127 0           last PARSE;
1128             } elsif (/^(\d+)$mabb$past$/i) {
1129             # 2 months ago
1130 0           ($num)=($1);
1131 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1132 0           $date=_DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0",
1133             \$err,0);
1134 0 0         $date=Date_SetTime($date,$h,$mn,$s) if (defined $h);
1135 0           last PARSE;
1136              
1137             } elsif (/^$week$future\s*(\d+)$wkabb$/i ||
1138             /^$week\s*(\d+)$wkabb$later$/i) {
1139             # friday in 2 weeks
1140             # friday 2 weeks later
1141 0           ($dofw,$num)=($1,$2);
1142 0           $tmp="+";
1143             } elsif (/^$week\s*(\d+)$wkabb$past$/i) {
1144             # friday 2 weeks ago
1145 0           ($dofw,$num)=($1,$2);
1146 0           $tmp="-";
1147             } elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
1148             /^(\d+)$wkabb$later$on$week$/i) {
1149             # in 2 weeks on friday
1150             # 2 weeks later on friday
1151 0           ($num,$dofw)=($1,$2);
1152 0           $tmp="+"
1153             } elsif (/^(\d+)$wkabb$past$on$week$/i) {
1154             # 2 weeks ago on friday
1155 0           ($num,$dofw)=($1,$2);
1156 0           $tmp="-";
1157             } elsif (/^$week\s*$wkabb$/i) {
1158             # monday week (British date: in 1 week on monday)
1159 0           $dofw=$1;
1160 0           $num=1;
1161 0           $tmp="+";
1162             } elsif ( (/^$now\s*$wkabb$/i && ($tmp="Now")) ||
1163             (/^$today\s*$wkabb$/i && ($tmp="Today")) ) {
1164             # now week (British date: 1 week from now)
1165             # today week (British date: 1 week from today)
1166 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1167 0           $date=_DateCalc_DateDelta($Curr{$tmp},"+0:0:1:0:0:0:0",\$err,0);
1168 0 0         $date=Date_SetTime($date,$h,$mn,$s) if ($time);
1169 0           last PARSE;
1170             } elsif (/^$offset\s*$wkabb$/i) {
1171             # tomorrow week (British date: 1 week from tomorrow)
1172 0           ($offset)=($1);
1173 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1174 0           $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
1175 0           $date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1176 0           $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0);
1177 0 0         if ($time) {
1178 0 0         return ""
1179             if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1180 0           $date=Date_SetTime($date,$h,$mn,$s);
1181             }
1182 0           last PARSE;
1183             }
1184              
1185 0 0         if ($tmp) {
1186 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1187 0           $date=_DateCalc_DateDelta($Curr{"Now"},
1188             $tmp . "0:0:$num:0:0:0:0",\$err,0);
1189 0           $date=Date_GetPrev($date,$Cnf{"FirstDay"},1);
1190 0           $date=Date_GetNext($date,$dofw,1,$h,$mn,$s);
1191 0           last PARSE;
1192             }
1193             }
1194              
1195             # Change (2nd, second) to 2
1196 0           $tmp=0;
1197 0 0         if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
1198 0 0         if (/^\s*$dom\s*$/) {
1199 0           ($d)=($1);
1200 0           $d=$dom{lc($d)};
1201 0           $m=$Curr{"M"};
1202 0           last PARSE;
1203             }
1204 0           my $from = $2;
1205 0           my $to = $dom{ lc($from) };
1206 0           s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
1207 0           s/^\s+//;
1208 0           s/\s+$//;
1209             }
1210              
1211             # Another set of special dates (Nth week)
1212 0 0 0       if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
    0          
1213             # 22nd sunday in 1996
1214 0           ($which,$dofw,$y)=($1,$2,$3);
1215 0 0         $y=$Curr{"Y"} if (! $y);
1216 0           $y--; # previous year
1217 0           $tmp=Date_GetNext("$y-12-31",$dofw,0);
1218 0 0         if ($which>1) {
1219 0           $tmp=_DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0);
1220             }
1221 0           ($y,$m,$d)=(_Date_Split($tmp, 1))[0..2];
1222 0           last PARSE;
1223             } elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
1224             /^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
1225             # sunday week 22 in 1996
1226             # sunday 22nd week in 1996
1227 0           ($dofw,$which,$y)=($1,$2,$3);
1228 0           ($y,$m,$d)=_Date_NthWeekOfYear($y,$which,$dofw);
1229 0           last PARSE;
1230             }
1231              
1232             # Get rid of day of week
1233 0 0         if (/(^|[^a-z])$week($|[^a-z])/i) {
1234 0           $wk=$2;
1235 0 0         (s/(^|[^a-z])$week,/$1 /i) ||
1236             s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
1237 0           s/^\s+//;
1238 0           s/\s+$//;
1239             }
1240              
1241             {
1242             # So that we can handle negative epoch times, let's convert
1243             # things like "epoch -" to "epochNEGATIVE " before we strip out
1244             # the $sep chars, which include '-'.
1245 0           s,epoch\s*-,epochNEGATIVE ,g;
  0            
1246              
1247             # Non-ISO8601 dates
1248 0           s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces
1249 0           s,^\s*,,; # remove leading/trailing space
1250 0           s,\s*$,,;
1251              
1252 0 0 0       if (/^$D\s+$D(?:\s+$YY)?$/) {
    0 0        
    0 0        
    0          
    0          
    0          
    0          
1253             # MM DD YY (DD MM YY non-US)
1254 0           ($m,$d,$y)=($1,$2,$3);
1255 0 0         ($m,$d)=($d,$m) if ($type ne "US");
1256 0           last PARSE;
1257              
1258             } elsif (/^$D4\s*$D\s*$D$/) {
1259             # YYYY MM DD
1260 0           ($y,$m,$d)=($1,$2,$3);
1261 0           last PARSE;
1262              
1263             } elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
1264 0           ($m)=($2);
1265              
1266 0 0         if (/^\s*$D(?:\s+$YY)?\s*$/) {
    0          
    0          
    0          
1267             # mmm DD YY
1268             # DD mmm YY
1269             # DD YY mmm
1270 0           ($d,$y)=($1,$2);
1271 0           last PARSE;
1272              
1273             } elsif (/^\s*$D$D4\s*$/) {
1274             # mmm DD YYYY
1275             # DD mmm YYYY
1276             # DD YYYY mmm
1277 0           ($d,$y)=($1,$2);
1278 0           last PARSE;
1279              
1280             } elsif (/^\s*$D4\s*$D\s*$/) {
1281             # mmm YYYY DD
1282             # YYYY mmm DD
1283             # YYYY DD mmm
1284 0           ($y,$d)=($1,$2);
1285 0           last PARSE;
1286              
1287             } elsif (/^\s*$D4\s*$/) {
1288             # mmm YYYY
1289             # YYYY mmm
1290 0           ($y,$d)=($1,1);
1291 0           last PARSE;
1292              
1293             } else {
1294 0           return "";
1295             }
1296              
1297             } elsif (/^epochNEGATIVE (\d+)$/) {
1298 0           $s=$1;
1299 0           $date=DateCalc("1970-01-01 00:00 GMT","-0:0:$s");
1300             } elsif (/^epoch\s*(\d+)$/i) {
1301 0           $s=$1;
1302 0           $date=DateCalc("1970-01-01 00:00 GMT","+0:0:$s");
1303              
1304             } elsif ( (/^$now$/i && ($tmp="Now")) ||
1305             (/^$today$/i && ($tmp="Today")) ) {
1306             # now, today
1307 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1308 0           $date=$Curr{$tmp};
1309 0 0         if ($time) {
1310 0 0         return ""
1311             if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1312 0           $date=Date_SetTime($date,$h,$mn,$s);
1313             }
1314 0           last PARSE;
1315              
1316             } elsif (/^$offset$/i) {
1317             # yesterday, tomorrow
1318 0           ($offset)=($1);
1319 0 0         Date_Init() if (! $Cnf{"UpdateCurrTZ"});
1320 0           $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
1321 0           $date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
1322 0 0         if ($time) {
1323 0 0         return ""
1324             if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1325 0           $date=Date_SetTime($date,$h,$mn,$s);
1326             }
1327 0           last PARSE;
1328              
1329             } else {
1330 0           return "";
1331             }
1332             }
1333             }
1334              
1335 0 0         if (! $date) {
1336 0 0         return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
1337 0           $date=_Date_Join($y,$m,$d,$h,$mn,$s);
1338             }
1339 0           $date=Date_ConvTZ($date,$z);
1340 0 0         if ($midnight) {
1341 0           $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0");
1342             }
1343 0           return $date;
1344             }
1345              
1346             sub ParseDate {
1347 0 0   0 1   print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
1348 0 0         Date_Init() if (! $Curr{"InitDone"});
1349 0           my($args,@args,@a,$ref,$date)=();
1350 0           @a=@_;
1351              
1352             # @a : is the list of args to ParseDate. Currently, only one argument
1353             # is allowed and it must be a scalar (or a reference to a scalar)
1354             # or a reference to an array.
1355              
1356 0 0         if ($#a!=0) {
1357 0           print "ERROR: Invalid number of arguments to ParseDate.\n";
1358 0           return "";
1359             }
1360 0           $args=$a[0];
1361 0           $ref=ref $args;
1362 0 0         if (! $ref) {
    0          
    0          
1363 0 0         return $args if (_Date_Split($args));
1364 0           @args=($args);
1365             } elsif ($ref eq "ARRAY") {
1366 0           @args=@$args;
1367             } elsif ($ref eq "SCALAR") {
1368 0 0         return $$args if (_Date_Split($$args));
1369 0           @args=($$args);
1370             } else {
1371 0           print "ERROR: Invalid arguments to ParseDate.\n";
1372 0           return "";
1373             }
1374 0           @a=@args;
1375              
1376             # @args : a list containing all the arguments (dereferenced if appropriate)
1377             # @a : a list containing all the arguments currently being examined
1378             # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1379             # reference to a scalar, or a reference to an array was passed in
1380             # $args : the scalar or refererence passed in
1381              
1382 0           PARSE: while($#a>=0) {
1383 0           $date=join(" ",@a);
1384 0           $date=ParseDateString($date);
1385 0 0         last if ($date);
1386 0           pop(@a);
1387             } # PARSE
1388              
1389 0           splice(@args,0,$#a + 1);
1390 0 0 0       @$args= @args if (defined $ref and $ref eq "ARRAY");
1391 0           $date;
1392             }
1393              
1394             sub Date_Cmp {
1395 0     0 1   my($D1,$D2)=@_;
1396 0           my($date1)=ParseDateString($D1);
1397 0           my($date2)=ParseDateString($D2);
1398 0           return $date1 cmp $date2;
1399             }
1400              
1401             # **NOTE**
1402             # The calc routines all call parse routines, so it is never necessary to
1403             # call Date_Init in the calc routines.
1404             sub DateCalc {
1405 0 0   0 1   print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
1406 0           my($D1,$D2,@arg)=@_;
1407 0           my($ref,$err,$errref,$mode)=();
1408              
1409 0           ($errref,$mode) = (@arg);
1410 0           $ref=0;
1411              
1412 0 0         if (defined $errref) {
1413 0 0         if (ref $errref) {
    0          
1414 0           $ref=1;
1415             } elsif (! defined $mode) {
1416 0           $mode=$errref;
1417 0           $errref="";
1418             }
1419             }
1420              
1421 0           my(@date,@delta,$ret,$tmp,$oldincalc,$oldmode)=();
1422              
1423 0 0         if (exists $Curr{"Mode"}) {
1424 0           $oldmode = $Curr{"Mode"};
1425             } else {
1426 0           $oldmode = 0;
1427             }
1428              
1429 0 0 0       if (defined $mode and $mode>=0 and $mode<=3) {
      0        
1430 0           $Curr{"Mode"}=$mode;
1431             } else {
1432 0           $Curr{"Mode"}=0;
1433             }
1434              
1435 0 0         if (exists $Curr{"InCalc"}) {
1436 0           $oldincalc = $Curr{"InCalc"};
1437             } else {
1438 0           $oldincalc = 0;
1439             }
1440 0           $Curr{"InCalc"}=1;
1441              
1442 0 0         if ($tmp=ParseDateString($D1)) {
    0          
1443             # If we've already parsed the date, we don't want to do it a second
1444             # time (so we don't convert timezones twice).
1445 0 0         if (_Date_Split($D1)) {
1446 0           push(@date,$D1);
1447             } else {
1448 0           push(@date,$tmp);
1449             }
1450             } elsif ($tmp=ParseDateDelta($D1)) {
1451 0           push(@delta,$tmp);
1452             } else {
1453 0 0         $$errref=1 if ($ref);
1454 0           $Curr{"InCalc"} = $oldincalc;
1455 0           $Curr{"Mode"} = $oldmode;
1456 0           return;
1457             }
1458              
1459 0 0         if ($tmp=ParseDateString($D2)) {
    0          
1460 0 0         if (_Date_Split($D2)) {
1461 0           push(@date,$D2);
1462             } else {
1463 0           push(@date,$tmp);
1464             }
1465             } elsif ($tmp=ParseDateDelta($D2)) {
1466 0           push(@delta,$tmp);
1467 0           $mode = $Curr{"Mode"};
1468             } else {
1469 0 0         $$errref=2 if ($ref);
1470 0           $Curr{"InCalc"} = $oldincalc;
1471 0           $Curr{"Mode"} = $oldmode;
1472 0           return;
1473             }
1474              
1475 0           $Curr{"InCalc"} = $oldincalc;
1476 0           $Curr{"Mode"} = $oldmode;
1477              
1478 0 0         if ($#date==1) {
    0          
1479 0           $ret=_DateCalc_DateDate(@date,$mode);
1480             } elsif ($#date==0) {
1481 0           $ret=_DateCalc_DateDelta(@date,@delta,\$err,$mode);
1482 0 0         $$errref=$err if ($ref);
1483             } else {
1484 0           $ret=_DateCalc_DeltaDelta(@delta,$mode);
1485             }
1486 0           $ret;
1487             }
1488              
1489             sub ParseDateDelta {
1490 0 0   0 1   print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
1491 0           my($args,@args,@a,$ref)=();
1492 0           local($_)=();
1493 0           @a=@_;
1494              
1495             # @a : is the list of args to ParseDateDelta. Currently, only one argument
1496             # is allowed and it must be a scalar (or a reference to a scalar)
1497             # or a reference to an array.
1498              
1499 0 0         if ($#a!=0) {
1500 0           print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
1501 0           return "";
1502             }
1503 0           $args=$a[0];
1504 0           $ref=ref $args;
1505 0 0         if (! $ref) {
    0          
    0          
1506 0           @args=($args);
1507             } elsif ($ref eq "ARRAY") {
1508 0           @args=@$args;
1509             } elsif ($ref eq "SCALAR") {
1510 0           @args=($$args);
1511             } else {
1512 0           print "ERROR: Invalid arguments to ParseDateDelta.\n";
1513 0           return "";
1514             }
1515 0           @a=@args;
1516              
1517             # @args : a list containing all the arguments (dereferenced if appropriate)
1518             # @a : a list containing all the arguments currently being examined
1519             # $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
1520             # reference to a scalar, or a reference to an array was passed in
1521             # $args : the scalar or refererence passed in
1522              
1523 0           my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=();
1524 0           my($len,$tmp,$tmp2,$tmpl)=();
1525 0           my($from,$to)=();
1526 0           my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1;
1527              
1528 0 0         Date_Init() if (! $Curr{"InitDone"});
1529             # A sign can be a sequence of zero or more + and - signs, this
1530             # allows for deltas like '+ -2 days'.
1531 0           my($signexp)='((?:[+-]\s*)*)';
1532 0           my($numexp)='(\d+)';
1533 0           my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)";
1534 0           my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=();
1535 0           $yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()";
1536 0           $yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?";
1537 0           $mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?";
1538 0           $wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?";
1539 0           $dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?";
1540 0           $hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?";
1541 0           $mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?";
1542 0           $sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?";
1543 0           my($future)=$Lang{$Cnf{"Language"}}{"Future"};
1544 0           my($later)=$Lang{$Cnf{"Language"}}{"Later"};
1545 0           my($past)=$Lang{$Cnf{"Language"}}{"Past"};
1546              
1547 0           $delta="";
1548 0           PARSE: while (@a) {
1549 0           $_ = join(" ", grep {defined;} @a);
  0            
1550 0           s/\s+$//;
1551 0 0         last if ($_ eq "");
1552              
1553             # Mode is set in DateCalc. ParseDateDelta only overrides it if the
1554             # string contains a mode.
1555 0 0 0       if ($Lang{$Cnf{"Language"}}{"Exact"} &&
    0 0        
    0 0        
    0          
1556             s/$Lang{$Cnf{"Language"}}{"Exact"}//) {
1557 0           $Curr{"Mode"}=0;
1558             } elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
1559             s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
1560 0           $Curr{"Mode"}=1;
1561             } elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
1562             s/$Lang{$Cnf{"Language"}}{"Business"}//) {
1563 0           $Curr{"Mode"}=2;
1564             } elsif (! exists $Curr{"Mode"}) {
1565 0           $Curr{"Mode"}=0;
1566             }
1567 0 0         $workweek=7 if ($Curr{"Mode"} != 2);
1568              
1569 0           foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) {
  0            
1570 0           $to=$Lang{$Cnf{"Language"}}{"Repl"}{$from};
1571 0           s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
1572             }
1573              
1574             # in or ago
1575             #
1576             # We need to make sure that $later, $future, and $past don't contain each
1577             # other... Romanian pointed this out where $past is "in urma" and $future
1578             # is "in". When they do, we have to take this into account.
1579             # $len length of best match (greatest wins)
1580             # $tmp string after best match
1581             # $dir direction (prior, after) of best match
1582             #
1583             # $tmp2 string before/after current match
1584             # $tmpl length of current match
1585              
1586 0           $len=0;
1587 0           $tmp=$_;
1588 0           $dir=1;
1589              
1590 0           $tmp2=$_;
1591 0 0         if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
1592 0           $tmpl=length($2);
1593 0 0         if ($tmpl>$len) {
1594 0           $tmp=$tmp2;
1595 0           $dir=1;
1596 0           $len=$tmpl;
1597             }
1598             }
1599              
1600 0           $tmp2=$_;
1601 0 0         if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
1602 0           $tmpl=length($2);
1603 0 0         if ($tmpl>$len) {
1604 0           $tmp=$tmp2;
1605 0           $dir=1;
1606 0           $len=$tmpl;
1607             }
1608             }
1609              
1610 0           $tmp2=$_;
1611 0 0         if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
1612 0           $tmpl=length($2);
1613 0 0         if ($tmpl>$len) {
1614 0           $tmp=$tmp2;
1615 0           $dir=-1;
1616 0           $len=$tmpl;
1617             }
1618             }
1619              
1620 0           $_ = $tmp;
1621 0           s/\s*$//;
1622              
1623             # the colon part of the delta
1624 0           $colon="";
1625 0 0         if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
1626 0           $colon=$1;
1627 0           s/\s+$//;
1628             }
1629 0           @colon=split(/:/,$colon);
1630              
1631             # the non-colon part of the delta
1632 0           $sign="+";
1633 0           @delta=();
1634 0           $i=6;
1635 0           foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
1636 0 0         last if ($#colon>=$i--);
1637 0           $val=0;
1638 0 0         if (s/^$exp1//ix) {
1639 0 0         $val=$2 if ($2);
1640 0 0         $sign=$1 if ($1);
1641             }
1642              
1643             # Collapse a sign like '+ -' into a single character like '-',
1644             # by counting the occurrences of '-'.
1645             #
1646 0           $sign =~ s/\s+//g;
1647 0           $sign =~ tr/+//d;
1648 0           my $count = ($sign =~ tr/-//d);
1649 0 0         die "bad characters in sign: $sign" if length $sign;
1650 0 0         $sign = $count % 2 ? '-' : '+';
1651              
1652 0           push(@delta,"$sign$val");
1653             }
1654 0 0         if (! /^\s*$/) {
1655 0           pop(@a);
1656 0           next PARSE;
1657             }
1658              
1659             # make sure that the colon part has a sign
1660 0           for ($i=0; $i<=$#colon; $i++) {
1661 0           $val=0;
1662 0 0         if ($colon[$i] =~ /^$signexp$numexp?/) {
1663 0 0         $val=$2 if ($2);
1664 0 0         $sign=$1 if ($1);
1665             }
1666 0           $colon[$i] = "$sign$val";
1667             }
1668              
1669             # combine the two
1670 0           push(@delta,@colon);
1671 0 0         if ($dir<0) {
1672 0           for ($i=0; $i<=$#delta; $i++) {
1673 0           $delta[$i] =~ tr/-+/+-/;
1674             }
1675             }
1676              
1677             # form the delta and shift off the valid part
1678 0           $delta=join(":",@delta);
1679 0           splice(@args,0,$#a+1);
1680 0 0 0       @$args=@args if (defined $ref and $ref eq "ARRAY");
1681 0           last PARSE;
1682             }
1683              
1684 0           $delta=_Delta_Normalize($delta,$Curr{"Mode"});
1685 0           return $delta;
1686             }
1687              
1688             sub UnixDate {
1689 0 0   0 1   print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
1690 0           my($date,@format)=@_;
1691 0           local($_)=();
1692 0           my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
1693 0           my($scalar)=();
1694 0           $date=ParseDateString($date);
1695 0 0         return if (! $date);
1696              
1697 0           my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
1698             _Date_Split($date, 1);
1699 0           $f{"y"}=substr $f{"Y"},2;
1700 0 0         Date_Init() if (! $Curr{"InitDone"});
1701              
1702 0 0         if (! wantarray) {
1703 0           $format=join(" ",@format);
1704 0           @format=($format);
1705 0           $scalar=1;
1706             }
1707              
1708             # month, week
1709 0           $_=$m;
1710 0           s/^0//;
1711 0           $f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
1712 0           $f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
1713 0           $_=$m;
1714 0           s/^0/ /;
1715 0           $f{"f"}=$_;
1716 0           $f{"U"}=Date_WeekOfYear($m,$d,$y,7);
1717 0           $f{"W"}=Date_WeekOfYear($m,$d,$y,1);
1718              
1719             # check week 52,53 and 0
1720 0           $f{"G"}=$f{"L"}=$y;
1721 0 0 0       if ($f{"W"}>=52 || $f{"U"}>=52) {
1722 0           my($dd,$mm,$yy)=($d,$m,$y);
1723 0           $dd+=7;
1724 0 0         if ($dd>31) {
1725 0           $dd-=31;
1726 0           $mm=1;
1727 0           $yy++;
1728 0 0         if (Date_WeekOfYear($mm,$dd,$yy,1)==2) {
1729 0           $f{"G"}=$yy;
1730 0           $f{"W"}=1;
1731             }
1732 0 0         if (Date_WeekOfYear($mm,$dd,$yy,7)==2) {
1733 0           $f{"L"}=$yy;
1734 0           $f{"U"}=1;
1735             }
1736             }
1737             }
1738 0 0         if ($f{"W"}==0) {
1739 0           my($dd,$mm,$yy)=($d,$m,$y);
1740 0           $dd-=7;
1741 0 0         $dd+=31 if ($dd<1);
1742 0           $yy = sprintf "%04d", $yy-1;
1743 0           $mm=12;
1744 0           $f{"G"}=$yy;
1745 0           $f{"W"}=Date_WeekOfYear($mm,$dd,$yy,1)+1;
1746             }
1747 0 0         if ($f{"U"}==0) {
1748 0           my($dd,$mm,$yy)=($d,$m,$y);
1749 0           $dd-=7;
1750 0 0         $dd+=31 if ($dd<1);
1751 0           $yy = sprintf "%04d", $yy-1;
1752 0           $mm=12;
1753 0           $f{"L"}=$yy;
1754 0           $f{"U"}=Date_WeekOfYear($mm,$dd,$yy,7)+1;
1755             }
1756              
1757 0 0         $f{"U"}="0".$f{"U"} if (length $f{"U"} < 2);
1758 0 0         $f{"W"}="0".$f{"W"} if (length $f{"W"} < 2);
1759              
1760             # day
1761 0           $f{"j"}=Date_DayOfYear($m,$d,$y);
1762 0           $f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
1763 0           $_=$d;
1764 0           s/^0/ /;
1765 0           $f{"e"}=$_;
1766 0           $f{"w"}=Date_DayOfWeek($m,$d,$y);
1767 0           $f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1];
1768 0 0         $f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2);
1769 0           $f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1];
1770 0           $f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1];
1771 0           $f{"E"}=Date_DaySuffix($f{"e"});
1772              
1773             # hour
1774 0           $_=$h;
1775 0           s/^0/ /;
1776 0           $f{"k"}=$_;
1777 0           $f{"i"}=$f{"k"}+1;
1778 0           $f{"i"}=$f{"k"};
1779 0 0         $f{"i"}=12 if ($f{"k"}==0);
1780 0 0         $f{"i"}=$f{"k"}-12 if ($f{"k"}>12);
1781 0 0         $f{"i"}=$f{"i"}-12 if ($f{"i"}>12);
1782 0 0         $f{"i"}=" ".$f{"i"} if (length($f{"i"})<2);
1783 0           $f{"I"}=$f{"i"};
1784 0           $f{"I"}=~ s/^ /0/;
1785 0           $f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"};
1786 0 0         $f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11);
1787              
1788             # minute, second, timezone
1789 0           $f{"o"}=Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
1790 0           $f{"s"}=Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s);
1791             $f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ?
1792 0 0 0       $Cnf{"TZ"} : $Cnf{"ConvTZ"};
1793 0 0 0       $f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || "");
1794              
1795             # date, time
1796 0           $f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
1797 0           $f{"C"}=$f{"u"}=
1798             qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|;
1799 0           $f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|;
1800 0           $f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|;
1801 0 0         $f{"x"}=qq|$d/$m/$f{"y"}| if ($Cnf{"DateFormat"} ne "US");
1802 0           $f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|;
1803 0           $f{"R"}=qq|$h:$mn|;
1804 0           $f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
1805 0           $f{"V"}=qq|$m$d$h$mn$f{"y"}|;
1806 0           $f{"Q"}="$y$m$d";
1807 0           $f{"q"}=qq|$y$m$d$h$mn$s|;
1808 0           $f{"P"}=qq|$y$m$d$h:$mn:$s|;
1809 0           $f{"O"}=qq|$y-$m-${d}T$h:$mn:$s|;
1810 0           $f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|;
1811 0 0         if ($f{"W"}==0) {
1812 0           $y--;
1813 0           $tmp=Date_WeekOfYear(12,31,$y,1);
1814 0 0         $tmp="0$tmp" if (length($tmp) < 2);
1815 0           $f{"J"}=qq|$y-W$tmp-$f{"w"}|;
1816             } else {
1817 0           $f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|;
1818             }
1819 0           $f{"K"}=qq|$y-$f{"j"}|;
1820             # %l is a special case. Since it requires the use of the calculator
1821             # which requires this routine, an infinite recursion results. To get
1822             # around this, %l is NOT determined every time this is called so the
1823             # recursion breaks.
1824              
1825             # other formats
1826 0           $f{"n"}="\n";
1827 0           $f{"t"}="\t";
1828 0           $f{"%"}="%";
1829 0           $f{"+"}="+";
1830              
1831 0           foreach $format (@format) {
1832 0           $format=reverse($format);
1833 0           $out="";
1834 0           while ($format ne "") {
1835 0           $c=chop($format);
1836 0 0         if ($c eq "%") {
1837 0           $c=chop($format);
1838 0 0         if ($c eq "l") {
    0          
1839 0           Date_Init();
1840 0           $date1=_DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0");
1841 0           $date2=_DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0");
1842 0 0 0       if (Date_Cmp($date,$date1)>=0 && Date_Cmp($date,$date2)<=0) {
1843 0           $f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|;
1844             } else {
1845 0           $f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
1846             }
1847 0           $out .= $f{"$c"};
1848             } elsif (exists $f{"$c"}) {
1849 0           $out .= $f{"$c"};
1850             } else {
1851 0           $out .= $c;
1852             }
1853             } else {
1854 0           $out .= $c;
1855             }
1856             }
1857 0           push(@out,$out);
1858             }
1859 0 0         if ($scalar) {
1860 0           return $out[0];
1861             } else {
1862 0           return (@out);
1863             }
1864             }
1865              
1866             # Can't be in "use integer" because we're doing decimal arithmatic
1867 36     36   326 no integer;
  36         86  
  36         234  
1868             sub Delta_Format {
1869 0 0   0 1   print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
1870 0           my($delta,@arg)=@_;
1871 0           my($mode);
1872 0 0         if (lc($arg[0]) eq "approx") {
1873 0           $mode = "approx";
1874 0           shift(@arg);
1875             } else {
1876 0           $mode = "exact";
1877             }
1878 0           my($dec,@format) = @arg;
1879              
1880 0           $delta=ParseDateDelta($delta);
1881 0 0         return "" if (! $delta);
1882 0           my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
1883 0           local($_)=$delta;
1884 0           my($y,$M,$w,$d,$h,$m,$s)=_Delta_Split($delta);
1885             # Get rid of positive signs.
1886 0           ($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s);
  0            
1887              
1888 0 0 0       if (defined $dec && $dec>0) {
1889 0           $dec="%." . ($dec*1) . "f";
1890             } else {
1891 0           $dec="%f";
1892             }
1893              
1894 0 0         if (! wantarray) {
1895 0           $format=join(" ",@format);
1896 0           @format=($format);
1897 0           $scalar=1;
1898             }
1899              
1900             # Length of each unit in seconds
1901 0           my($sl,$ml,$hl,$dl,$wl,$Ml,$yl)=();
1902 0           $sl = 1;
1903 0           $ml = $sl*60;
1904 0           $hl = $ml*60;
1905 0           $dl = $hl*24;
1906 0           $wl = $dl*7;
1907 0           $yl = $dl*365.25;
1908 0           $Ml = $yl/12;
1909              
1910             # The decimal amount of each unit contained in all smaller units
1911 0           my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
1912 0 0         if ($mode eq "exact") {
1913 0           $yd = $M/12;
1914 0           $Md = 0;
1915             } else {
1916 0           $yd = ($M*$Ml + $w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
1917 0           $Md = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$Ml;
1918             }
1919              
1920 0           $wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
1921 0           $dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
1922 0           $hd = ($m*$ml + $s*$sl)/$hl;
1923 0           $md = ($s*$sl)/$ml;
1924 0           $sd = 0;
1925              
1926             # The amount of each unit contained in higher units.
1927 0           my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
1928 0           $yh = 0;
1929 0           $Mh = ($yh+$y)*12;
1930              
1931 0 0         if ($mode eq "exact") {
1932 0           $wh = 0;
1933 0           $dh = ($wh+$w)*7;
1934             } else {
1935 0           $wh = ($yh+$y+$M/12)*365.25/7;
1936 0           $dh = ($wh+$w)*7;
1937             }
1938              
1939 0           $hh = ($dh+$d)*24;
1940 0           $mh = ($hh+$h)*60;
1941 0           $sh = ($mh+$m)*60;
1942              
1943             # Set up the formats
1944              
1945 0           $f{"yv"} = $y;
1946 0           $f{"Mv"} = $M;
1947 0           $f{"wv"} = $w;
1948 0           $f{"dv"} = $d;
1949 0           $f{"hv"} = $h;
1950 0           $f{"mv"} = $m;
1951 0           $f{"sv"} = $s;
1952              
1953 0           $f{"yh"} = $y+$yh;
1954 0           $f{"Mh"} = $M+$Mh;
1955 0           $f{"wh"} = $w+$wh;
1956 0           $f{"dh"} = $d+$dh;
1957 0           $f{"hh"} = $h+$hh;
1958 0           $f{"mh"} = $m+$mh;
1959 0           $f{"sh"} = $s+$sh;
1960              
1961 0           $f{"yd"} = sprintf($dec,$y+$yd);
1962 0           $f{"Md"} = sprintf($dec,$M+$Md);
1963 0           $f{"wd"} = sprintf($dec,$w+$wd);
1964 0           $f{"dd"} = sprintf($dec,$d+$dd);
1965 0           $f{"hd"} = sprintf($dec,$h+$hd);
1966 0           $f{"md"} = sprintf($dec,$m+$md);
1967 0           $f{"sd"} = sprintf($dec,$s+$sd);
1968              
1969 0           $f{"yt"} = sprintf($dec,$yh+$y+$yd);
1970 0           $f{"Mt"} = sprintf($dec,$Mh+$M+$Md);
1971 0           $f{"wt"} = sprintf($dec,$wh+$w+$wd);
1972 0           $f{"dt"} = sprintf($dec,$dh+$d+$dd);
1973 0           $f{"ht"} = sprintf($dec,$hh+$h+$hd);
1974 0           $f{"mt"} = sprintf($dec,$mh+$m+$md);
1975 0           $f{"st"} = sprintf($dec,$sh+$s+$sd);
1976              
1977 0           $f{"%"} = "%";
1978              
1979 0           foreach $format (@format) {
1980 0           $format=reverse($format);
1981 0           $out="";
1982 0           PARSE: while ($format) {
1983 0           $c1=chop($format);
1984 0 0         if ($c1 eq "%") {
1985 0           $c1=chop($format);
1986 0 0         if (exists($f{$c1})) {
1987 0           $out .= $f{$c1};
1988 0           next PARSE;
1989             }
1990 0           $c2=chop($format);
1991 0 0         if (exists($f{"$c1$c2"})) {
1992 0           $out .= $f{"$c1$c2"};
1993 0           next PARSE;
1994             }
1995 0           $out .= $c1;
1996 0           $format .= $c2;
1997             } else {
1998 0           $out .= $c1;
1999             }
2000             }
2001 0           push(@out,$out);
2002             }
2003 0 0         if ($scalar) {
2004 0           return $out[0];
2005             } else {
2006 0           return (@out);
2007             }
2008             }
2009 36     36   27395 use integer;
  36         69  
  36         133  
2010              
2011             sub ParseRecur {
2012 0 0   0 1   print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
2013 0 0         Date_Init() if (! $Curr{"InitDone"});
2014              
2015 0           my($recur,$dateb,$date0,$date1,$flag)=@_;
2016 0           local($_)=$recur;
2017              
2018 0           my($recur_0,$recur_1,@recur0,@recur1)=();
2019 0           my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=();
2020 0           my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=();
2021              
2022             # $date0, $date1, $dateb, $flag : passed in (these are always the final say
2023             # in determining whether a date matches a
2024             # recurrence IF they are present.
2025             # $date_b, $date_0, $date_1 : if a value can be determined from the
2026             # $flag_t recurrence, they are stored here.
2027             #
2028             # If values can be determined from the recurrence AND are passed in, the
2029             # following are used:
2030             # max($date0,$date_0) i.e. the later of the two dates
2031             # min($date1,$date_1) i.e. the earlier of the two dates
2032             #
2033             # The base date that is used is the first one defined from
2034             # $dateb $date_b
2035             # The base date is only used if necessary (as determined by the recur).
2036             # For example, "every other friday" requires a base date, but "2nd
2037             # friday of every month" doesn't.
2038              
2039 0           my($date_b,$date_0,$date_1,$flag_t);
2040              
2041             #
2042             # Check the arguments passed in.
2043             #
2044              
2045 0 0         $date0="" if (! defined $date0);
2046 0 0         $date1="" if (! defined $date1);
2047 0 0         $dateb="" if (! defined $dateb);
2048 0 0         $flag ="" if (! defined $flag);
2049              
2050 0 0         if ($dateb) {
2051 0           $dateb=ParseDateString($dateb);
2052 0 0         return "" if (! $dateb);
2053             }
2054 0 0         if ($date0) {
2055 0           $date0=ParseDateString($date0);
2056 0 0         return "" if (! $date0);
2057             }
2058 0 0         if ($date1) {
2059 0           $date1=ParseDateString($date1);
2060 0 0         return "" if (! $date1);
2061             }
2062              
2063             #
2064             # Parse the recur. $date_b, $date_0, and $date_e are values obtained
2065             # from the recur.
2066             #
2067              
2068 0           @tmp=_Recur_Split($_);
2069              
2070 0 0         if (@tmp) {
2071 0           ($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp;
2072 0 0         $recur_0 = "" if (! defined $recur_0);
2073 0 0         $recur_1 = "" if (! defined $recur_1);
2074 0 0         $flag_t = "" if (! defined $flag_t);
2075 0 0         $date_b = "" if (! defined $date_b);
2076 0 0         $date_0 = "" if (! defined $date_0);
2077 0 0         $date_1 = "" if (! defined $date_1);
2078              
2079 0           @recur0 = split(/:/,$recur_0);
2080 0           @recur1 = split(/:/,$recur_1);
2081 0 0         return "" if ($#recur0 + $#recur1 + 2 != 7);
2082              
2083 0 0         if ($date_b) {
2084 0           $date_b=ParseDateString($date_b);
2085 0 0         return "" if (! $date_b);
2086             }
2087 0 0         if ($date_0) {
2088 0           $date_0=ParseDateString($date_0);
2089 0 0         return "" if (! $date_0);
2090             }
2091 0 0         if ($date_1) {
2092 0           $date_1=ParseDateString($date_1);
2093 0 0         return "" if (! $date_1);
2094             }
2095              
2096             } else {
2097              
2098 0           my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...)
2099 0           my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... }
  0            
2100 0           my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...)
2101 0           my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... }
  0            
2102 0           my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days)
2103 0           my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months)
2104 0           my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks)
2105 0           my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st)
2106 0           my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} };
  0            
2107             # { 1st=>1,first=>1,...}
2108 0           my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of)
2109 0           my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last)
2110 0           my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every)
2111              
2112 0           my($D)='\s*(\d+)';
2113 0           my($Y)='\s*(\d{4}|\d{2})';
2114              
2115             # Change 1st to 1
2116 0 0         if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
2117 0           $tmp=lc($2);
2118 0           $tmp=$dayshash{"$tmp"};
2119 0           s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
2120             }
2121 0           s/\s*$//;
2122              
2123             # Get rid of "each"
2124 0 0         if (/(^|[^a-z])$each($|[^a-z])/i) {
2125 0           s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
2126 0           $each=1;
2127             } else {
2128 0           $each=0;
2129             }
2130              
2131 0 0         if ($each) {
2132              
2133 0 0 0       if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
    0 0        
    0 0        
    0          
2134             /^$D?$day(?:$of$mmm())?$/i) {
2135             # every [2nd] day in [june] 1997
2136             # every [2nd] day [in june]
2137 0           ($num,$m,$y)=($1,$2,$3);
2138 0 0         $num=1 if (! defined $num);
2139 0 0         $m="" if (! defined $m);
2140 0 0         $y="" if (! defined $y);
2141              
2142 0 0         $y=$Curr{"Y"} if (! $y);
2143 0 0         if ($m) {
2144 0           $m=$mmm{lc($m)};
2145 0           $date_0=_Date_Join($y,$m,1,0,0,0);
2146 0           $date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
2147             } else {
2148 0           $date_0=_Date_Join($y, 1,1,0,0,0);
2149 0           $date_1=_Date_Join($y+1,1,1,0,0,0);
2150             }
2151 0           $date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0);
2152 0           @recur0=(0,0,0,$num,0,0,0);
2153 0           @recur1=();
2154              
2155             } elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
2156             # 2nd [day] of every month [in 1997]
2157 0           ($num,$y)=($1,$2);
2158 0 0         $y=$Curr{"Y"} if (! $y);
2159              
2160 0           $date_0=_Date_Join($y, 1,1,0,0,0);
2161 0           $date_1=_Date_Join($y+1,1,1,0,0,0);
2162 0           $date_b=$date_0;
2163              
2164 0           @recur0=(0,1,0);
2165 0           @recur1=($num,0,0,0);
2166              
2167             } elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ ||
2168             /^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) {
2169             # 2nd tuesday of every month [in 1997]
2170             # last tuesday of every month [in 1997]
2171 0           ($num,$d,$y)=($1,$2,$3);
2172 0 0         $y=$Curr{"Y"} if (! $y);
2173 0           $d=$week{lc($d)};
2174 0 0         $num=-1 if ($num !~ /^$D$/);
2175              
2176 0           $date_0=_Date_Join($y,1,1,0,0,0);
2177 0           $date_1=_Date_Join($y+1,1,1,0,0,0);
2178 0           $date_b=$date_0;
2179              
2180 0           @recur0=(0,1);
2181 0           @recur1=($num,$d,0,0,0);
2182              
2183             } elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i ||
2184             /^$D?$wkexp(?:$of$mmm())?$/i) {
2185             # every tuesday in june 1997
2186             # every 2nd tuesday in june 1997
2187 0           ($num,$d,$m,$y)=($1,$2,$3,$4);
2188 0 0         $y=$Curr{"Y"} if (! $y);
2189 0 0         $num=1 if (! defined $num);
2190 0 0         $m="" if (! defined $m);
2191 0           $d=$week{lc($d)};
2192              
2193 0 0         if ($m) {
2194 0           $m=$mmm{lc($m)};
2195 0           $date_0=_Date_Join($y,$m,1,0,0,0);
2196 0           $date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
2197             } else {
2198 0           $date_0=_Date_Join($y,1,1,0,0,0);
2199 0           $date_1=_Date_Join($y+1,1,1,0,0,0);
2200             }
2201 0           $date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0);
2202              
2203 0           @recur0=(0,0,$num);
2204 0           @recur1=($d,0,0,0);
2205              
2206             } else {
2207 0           return "";
2208             }
2209              
2210 0 0         $date_0="" if ($date0);
2211 0 0         $date_1="" if ($date1);
2212             } else {
2213 0           return "";
2214             }
2215             }
2216              
2217             #
2218             # Override with any values passed in
2219             #
2220              
2221 0 0         $date0 = $date_0 if (! $date0);
2222 0 0         $date1 = $date_1 if (! $date1);
2223 0 0         $dateb = $date_b if (! $dateb);
2224 0 0         if ($flag =~ s/^\+//) {
2225 0 0         $flag = "$flag_t,$flag" if ($flag_t);
2226             }
2227 0 0         $flag = $flag_t if (! $flag);
2228 0 0         $flag = "" if (! $flag);
2229              
2230 0 0         if (! wantarray) {
2231 0           $tmp = join(":",@recur0);
2232 0 0         $tmp .= "*" . join(":",@recur1) if (@recur1);
2233 0           $tmp .= "*$flag*$dateb*$date0*$date1";
2234 0           return $tmp;
2235             }
2236 0 0         if (@recur0) {
2237 0 0 0       return () if (! $date0 || ! $date1); # dateb is NOT required in all case
2238             }
2239              
2240             #
2241             # Some flags affect parsing.
2242             #
2243              
2244 0           @flags = split(/,/,$flag);
2245 0           my($f);
2246 0           foreach $f (@flags) {
2247 0 0         if ($f =~ /^EASTER$/i) {
2248 0           ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2249             # We want something that will return Jan 1 for the given years.
2250 0 0         if ($#recur0==-1) {
    0          
    0          
    0          
2251 0           @recur1=($y,1,0,1,$h,$mn,$s);
2252             } elsif ($#recur0<=3) {
2253 0           @recur0=($y,0,0,0);
2254 0           @recur1=($h,$mn,$s);
2255             } elsif ($#recur0==4) {
2256 0           @recur0=($y,0,0,0,0);
2257 0           @recur1=($mn,$s);
2258             } elsif ($#recur0==5) {
2259 0           @recur0=($y,0,0,0,0,0);
2260 0           @recur1=($s);
2261             } else {
2262 0           @recur0=($y,0,0,0,0,0,0);
2263             }
2264             }
2265             }
2266              
2267             #
2268             # Determine the dates referenced by the recur. Also, fix the base date
2269             # as necessary for the recurrences which require it.
2270             #
2271              
2272 0           ($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
2273 0           @y=@m=@w=@d=();
2274 0           my(@time)=($h,$mn,$s);
2275              
2276 0           RECUR: while (1) {
2277              
2278 0 0         if ($#recur0==-1) {
2279             # * 0-M-W-D-H-MN-S => 0 * M-W-D-H-MN-S
2280              
2281 0 0         if ($y eq "0") {
2282 0           push(@recur0,1);
2283 0           shift(@recur1);
2284 0           next RECUR;
2285             }
2286              
2287             # Y-M-W-D-H-MN-S
2288              
2289 0           @y=_ReturnList($y);
2290 0           foreach $y (@y) {
2291 0 0         $y=_Date_FixYear($y) if (length($y)==2);
2292 0 0 0       return () if (length($y)!=4 || ! _IsInt($y));
2293             }
2294              
2295 0 0         $date0=ParseDate("0000-01-01") if (! $date0);
2296 0 0         $date1=ParseDate("9999-12-31 23:59:59") if (! $date1);
2297              
2298 0 0 0       if ($m eq "0" and $w eq "0") {
    0          
    0          
2299              
2300             # * Y-0-0-0-H-MN-S
2301             # * Y-0-0-DOY-H-MN-S
2302              
2303 0 0         if ($d eq "0") {
2304 0           @d=(1);
2305             } else {
2306 0           @d=_ReturnList($d);
2307 0 0         return () if (! @d);
2308 0           foreach $d (@d) {
2309 0 0 0       return () if (! _IsInt($d,-366,366) || $d==0);
2310             }
2311             }
2312              
2313 0           @date=();
2314 0           foreach $yy (@y) {
2315 0           my $diy = Date_DaysInYear($yy);
2316 0           foreach $d (@d) {
2317 0           my $tmpd = $d;
2318 0 0         $tmpd += ($diy+1) if ($tmpd < 0);
2319 0 0         next if (! _IsInt($tmpd,1,$diy));
2320 0           ($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd);
2321 0           push(@date, _Date_Join($y,$m,$dd,0,0,0));
2322             }
2323             }
2324 0           last RECUR;
2325              
2326             } elsif ($w eq "0") {
2327              
2328             # * Y-M-0-0-H-MN-S
2329             # * Y-M-0-DOM-H-MN-S
2330              
2331 0           @m=_ReturnList($m);
2332 0 0         return () if (! @m);
2333 0           foreach $m (@m) {
2334 0 0         return () if (! _IsInt($m,1,12));
2335             }
2336              
2337 0 0         if ($d eq "0") {
2338 0           @d=(1);
2339             } else {
2340 0           @d=_ReturnList($d);
2341 0 0         return () if (! @d);
2342 0           foreach $d (@d) {
2343 0 0 0       return () if (! _IsInt($d,-31,31) || $d==0);
2344             }
2345             }
2346              
2347 0           @date=();
2348 0           foreach $y (@y) {
2349 0           foreach $m (@m) {
2350 0           my $dim = Date_DaysInMonth($m,$y);
2351 0           foreach $d (@d) {
2352 0           my $tmpd = $d;
2353 0 0         $tmpd += ($dim+1) if ($d<0);
2354 0 0         next if (! _IsInt($tmpd,1,$dim));
2355 0           $date=_Date_Join($y,$m,$tmpd,0,0,0);
2356 0           push(@date,$date);
2357             }
2358             }
2359             }
2360 0           last RECUR;
2361              
2362             } elsif ($m eq "0") {
2363              
2364             # * Y-0-WOY-DOW-H-MN-S
2365             # * Y-0-WOY-0-H-MN-S
2366              
2367 0           @w=_ReturnList($w);
2368 0 0         return () if (! @w);
2369 0           foreach $w (@w) {
2370 0 0 0       return () if (! _IsInt($w,-53,53) || $w==0);
2371             }
2372              
2373 0 0         if ($d eq "0") {
2374 0           @d=(1);
2375             } else {
2376 0           @d=_ReturnList($d);
2377 0 0         return () if (! @d);
2378 0           foreach $d (@d) {
2379 0 0         $d += 8 if ($d<0);
2380 0 0         return () if (! _IsInt($d,1,7));
2381             }
2382             }
2383              
2384 0           @date=();
2385 0           foreach $y (@y) {
2386 0           foreach $w (@w) {
2387 0           foreach $d (@d) {
2388 0           my($tmpw,$del);
2389 0 0         if ($w<0) {
2390 0           $date="$y-12-31-00:00:00";
2391 0           $tmpw = (-$w)-1;
2392 0           $del="-0:0:$tmpw:0:0:0:0";
2393 0           $date=Date_GetPrev($date,$d,1);
2394             } else {
2395 0           $date="$y-01-01-00:00:00";
2396 0           $tmpw = ($w)-1;
2397 0           $del="0:0:$tmpw:0:0:0:0";
2398 0           $date=Date_GetNext($date,$d,1);
2399             }
2400 0           $date=_DateCalc_DateDelta($date,$del);
2401 0 0         push(@date,$date) if ( (_Date_Split($date))[0] == $y);
2402             }
2403             }
2404             }
2405 0           last RECUR;
2406              
2407             } else {
2408              
2409             # * Y-M-WOM-DOW-H-MN-S
2410             # * Y-M-WOM-0-H-MN-S
2411              
2412 0           @m=_ReturnList($m);
2413 0 0         return () if (! @m);
2414 0           @w=_ReturnList($w);
2415 0 0         return () if (! @w);
2416 0 0         if ($d eq "0") {
2417 0           @d=(1);
2418             } else {
2419 0           @d=_ReturnList($d);
2420             }
2421              
2422 0           @date=_Date_Recur_WoM(\@y,\@m,\@w,\@d);
2423 0           last RECUR;
2424             }
2425             }
2426              
2427 0 0         if ($#recur0==0) {
2428              
2429             # Y * M-W-D-H-MN-S
2430 0           $n=$y;
2431 0 0         $n=1 if ($n==0);
2432              
2433 0 0         if ($m eq "0") {
    0          
2434              
2435             # Y * 0-W-D-H-MN-S => Y-0 * W-D-H-MN-S
2436 0           push(@recur0,0);
2437 0           shift(@recur1);
2438              
2439             } elsif ($w eq "0") {
2440              
2441             # Y * M-0-DOM-H-MN-S
2442 0 0 0       return () if (! $dateb && $y != 1);
2443              
2444 0           @m=_ReturnList($m);
2445 0 0         return () if (! @m);
2446 0           foreach $m (@m) {
2447 0 0         return () if (! _IsInt($m,1,12));
2448             }
2449              
2450 0 0         if ($d eq "0") {
2451 0           @d = (1);
2452             } else {
2453 0           @d=_ReturnList($d);
2454 0 0         return () if (! @d);
2455 0           foreach $d (@d) {
2456 0 0 0       return () if (! _IsInt($d,-31,31) || $d==0);
2457             }
2458             }
2459              
2460             # We need to find years that are a multiple of $n from $y(base)
2461 0           ($y0)=( _Date_Split($date0, 1) )[0];
2462 0           ($y1)=( _Date_Split($date1, 1) )[0];
2463 0 0         if ($dateb) {
2464 0           ($yb)=( _Date_Split($dateb, 1) )[0];
2465             } else {
2466             # If $y=1, there is no base year
2467 0           $yb=0;
2468             }
2469              
2470 0           @date=();
2471 0           for ($yy=$y0; $yy<=$y1; $yy++) {
2472 0 0         if (($yy-$yb)%$n == 0) {
2473 0           foreach $m (@m) {
2474 0           foreach $d (@d) {
2475 0           my $dim = Date_DaysInMonth($m,$yy);
2476 0           my $tmpd = $d;
2477 0 0         if ($tmpd < 0) {
2478 0           $tmpd += ($dim+1);
2479             }
2480 0 0         next if (! _IsInt($tmpd,1,$dim));
2481 0           $date=_Date_Join($yy,$m,$tmpd,0,0,0);
2482 0           push(@date,$date);
2483             }
2484             }
2485             }
2486             }
2487 0           last RECUR;
2488              
2489             } else {
2490              
2491             # Y * M-WOM-DOW-H-MN-S
2492             # Y * M-WOM-0-H-MN-S
2493 0 0 0       return () if (! $dateb && $y != 1);
2494              
2495 0           @m=_ReturnList($m);
2496 0 0         return () if (! @m);
2497 0           @w=_ReturnList($w);
2498 0 0         return () if (! @w);
2499              
2500 0 0         if ($d eq "0") {
2501 0           @d=(1);
2502             } else {
2503 0           @d=_ReturnList($d);
2504             }
2505              
2506 0           ($y0)=( _Date_Split($date0, 1) )[0];
2507 0           ($y1)=( _Date_Split($date1, 1) )[0];
2508 0 0         if ($dateb) {
2509 0           ($yb)=( _Date_Split($dateb, 1) )[0];
2510             } else {
2511             # If $y=1, there is no base year
2512 0           $yb=0;
2513             }
2514 0           @y=();
2515 0           for ($yy=$y0; $yy<=$y1; $yy++) {
2516 0 0         if (($yy-$yb)%$n == 0) {
2517 0           push(@y,$yy);
2518             }
2519             }
2520              
2521 0           @date=_Date_Recur_WoM(\@y,\@m,\@w,\@d);
2522 0           last RECUR;
2523             }
2524             }
2525              
2526 0 0         if ($#recur0==1) {
2527              
2528             # Y-M * W-D-H-MN-S
2529              
2530 0 0         if ($w eq "0") {
    0          
2531             # Y-M * 0-D-H-MN-S => Y-M-0 * D-H-MN-S
2532 0           push(@recur0,0);
2533 0           shift(@recur1);
2534              
2535             } elsif ($m==0) {
2536              
2537             # Y-0 * WOY-0-H-MN-S
2538             # Y-0 * WOY-DOW-H-MN-S
2539 0 0 0       return () if (! $dateb && $y != 1);
2540 0           $n=$y;
2541 0 0         $n=1 if ($n==0);
2542              
2543 0           @w=_ReturnList($w);
2544 0 0         return () if (! @w);
2545 0           foreach $w (@w) {
2546 0 0 0       return () if ($w==0 || ! _IsInt($w,-53,53));
2547             }
2548              
2549 0 0         if ($d eq "0") {
2550 0           @d=(1);
2551             } else {
2552 0           @d=_ReturnList($d);
2553 0 0         return () if (! @d);
2554 0           foreach $d (@d) {
2555 0 0         $d += 8 if ($d<0);
2556 0 0         return () if (! _IsInt($d,1,7));
2557             }
2558             }
2559              
2560             # We need to find years that are a multiple of $n from $y(base)
2561 0           ($y0)=( _Date_Split($date0, 1) )[0];
2562 0           ($y1)=( _Date_Split($date1, 1) )[0];
2563 0 0         if ($dateb) {
2564 0           ($yb)=( _Date_Split($dateb, 1) )[0];
2565             } else {
2566             # If $y=1, there is no base year
2567 0           $yb=0;
2568             }
2569              
2570 0           @date=();
2571 0           for ($yy=$y0; $yy<=$y1; $yy++) {
2572 0 0         if (($yy-$yb)%$n == 0) {
2573 0           foreach $w (@w) {
2574 0           foreach $d (@d) {
2575 0           my($tmpw,$del);
2576 0 0         if ($w<0) {
2577 0           $date="$yy-12-31-00:00:00";
2578 0           $tmpw = (-$w)-1;
2579 0           $del="-0:0:$tmpw:0:0:0:0";
2580 0           $date=Date_GetPrev($date,$d,1);
2581             } else {
2582 0           $date="$yy-01-01-00:00:00";
2583 0           $tmpw = ($w)-1;
2584 0           $del="0:0:$tmpw:0:0:0:0";
2585 0           $date=Date_GetNext($date,$d,1);
2586             }
2587 0           $date=DateCalc($date,$del);
2588 0 0         next if ((_Date_Split($date))[0] != $yy);
2589 0           push(@date,$date);
2590             }
2591             }
2592             }
2593             }
2594 0           last RECUR;
2595              
2596             } else {
2597              
2598             # Y-M * WOM-0-H-MN-S
2599             # Y-M * WOM-DOW-H-MN-S
2600 0 0 0       return () if (! $dateb && ($y != 0 || $m != 1));
      0        
2601 0           @tmp=(@recur0);
2602 0           push(@tmp,0) while ($#tmp<6);
2603 0           $delta=join(":",@tmp);
2604 0 0         $dateb=$date0 if (! $dateb);
2605 0           @tmp=_Date_Recur($date0,$date1,$dateb,$delta);
2606              
2607 0           @w=_ReturnList($w);
2608 0           @m=();
2609 0 0         if ($d eq "0") {
2610 0           @d=(1);
2611             } else {
2612 0           @d=_ReturnList($d);
2613             }
2614              
2615 0           @date=_Date_Recur_WoM(\@tmp,\@m,\@w,\@d);
2616 0           last RECUR;
2617             }
2618             }
2619              
2620 0 0         if ($#recur0==2) {
2621             # Y-M-W * D-H-MN-S
2622              
2623 0 0 0       if ($d eq "0") {
    0          
    0          
    0          
2624              
2625             # Y-M-W * 0-H-MN-S
2626 0 0         return () if (! $dateb);
2627 0 0 0       $y=1 if ($y==0 && $m==0 && $w==0);
      0        
2628 0           $delta="$y:$m:$w:0:0:0:0";
2629 0           @date=_Date_Recur($date0,$date1,$dateb,$delta);
2630 0           last RECUR;
2631              
2632             } elsif ($m==0 && $w==0) {
2633              
2634             # Y-0-0 * DOY-H-MN-S
2635 0 0         $y=1 if ($y==0);
2636 0           $n=$y;
2637 0 0 0       return () if (! $dateb && $y!=1);
2638              
2639 0           @d=_ReturnList($d);
2640 0 0         return () if (! @d);
2641 0           foreach $d (@d) {
2642 0 0 0       return () if (! _IsInt($d,-366,366) || $d==0);
2643             }
2644              
2645             # We need to find years that are a multiple of $n from $y(base)
2646 0           ($y0)=( _Date_Split($date0, 1) )[0];
2647 0           ($y1)=( _Date_Split($date1, 1) )[0];
2648 0 0         if ($dateb) {
2649 0           ($yb)=( _Date_Split($dateb, 1) )[0];
2650             } else {
2651             # If $y=1, there is no base year
2652 0           $yb=0;
2653             }
2654 0           @date=();
2655 0           for ($yy=$y0; $yy<=$y1; $yy++) {
2656 0           my $diy = Date_DaysInYear($yy);
2657 0 0         if (($yy-$yb)%$n == 0) {
2658 0           foreach $d (@d) {
2659 0           my $tmpd = $d;
2660 0 0         $tmpd += ($diy+1) if ($tmpd<0);
2661 0 0         next if (! _IsInt($tmpd,1,$diy));
2662 0           ($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd);
2663 0           push(@date, _Date_Join($y,$m,$dd,0,0,0));
2664             }
2665             }
2666             }
2667 0           last RECUR;
2668              
2669             } elsif ($w>0) {
2670              
2671             # Y-M-W * DOW-H-MN-S
2672 0 0 0       return () if (! $dateb && ($y != 0 && $m != 0 && $w != 1));
      0        
      0        
2673 0           @tmp=(@recur0);
2674 0           push(@tmp,0) while ($#tmp<6);
2675 0           $delta=join(":",@tmp);
2676              
2677 0           @d=_ReturnList($d);
2678 0 0         return () if (! @d);
2679 0           foreach $d (@d) {
2680 0 0         $d += 8 if ($d<0);
2681 0 0         return () if (! _IsInt($d,1,7));
2682             }
2683              
2684             # Find out what DofW the basedate is.
2685 0 0         $dateb = $date0 if (! $dateb);
2686 0           @tmp2=_Date_Split($dateb, 1);
2687 0           $tmp=Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]);
2688              
2689 0           @date=();
2690 0           foreach $d (@d) {
2691 0           $date_b=$dateb;
2692             # Move basedate to DOW in the same week
2693 0 0         if ($d != $tmp) {
2694 0 0 0       if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
      0        
      0        
      0        
      0        
2695             ($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
2696             ($tmp<$d && $d<$Cnf{"FirstDay"})) {
2697 0           $date_b=Date_GetNext($date_b,$d);
2698             } else {
2699 0           $date_b=Date_GetPrev($date_b,$d);
2700             }
2701             }
2702 0           push(@date,_Date_Recur($date0,$date1,$date_b,$delta));
2703             }
2704 0           last RECUR;
2705              
2706             } elsif ($m>0) {
2707              
2708             # Y-M-0 * DOM-H-MN-S
2709 0 0 0       return () if (! $dateb && ($y != 0 && $m != 1));
      0        
2710 0           @tmp=(@recur0);
2711 0           push(@tmp,0) while ($#tmp<6);
2712 0           $delta=join(":",@tmp);
2713              
2714 0           @d=_ReturnList($d);
2715 0 0         return () if (! @d);
2716 0           foreach $d (@d) {
2717 0 0 0       return () if ($d==0 || ! _IsInt($d,-31,31));
2718             }
2719 0 0         $dateb = $date0 if (! $dateb);
2720              
2721 0           @tmp2=_Date_Recur($date0,$date1,$dateb,$delta);
2722 0           @date=();
2723 0           foreach $date (@tmp2) {
2724 0           ($y,$m)=( _Date_Split($date, 1) )[0..1];
2725 0           my $dim=Date_DaysInMonth($m,$y);
2726 0           foreach $d (@d) {
2727 0           my $tmpd = $d;
2728 0 0         $tmpd += ($dim+1) if ($tmpd<0);
2729 0 0         next if (! _IsInt($tmpd,1,$dim));
2730 0           push(@date,_Date_Join($y,$m,$tmpd,0,0,0));
2731             }
2732             }
2733 0           last RECUR;
2734              
2735             } else {
2736 0           return ();
2737             }
2738             }
2739              
2740 0 0         if ($#recur0>2) {
2741              
2742             # Y-M-W-D * H-MN-S
2743             # Y-M-W-D-H * MN-S
2744             # Y-M-W-D-H-MN * S
2745             # Y-M-W-D-H-S
2746 0 0 0       if (($#recur0 == 3 &&
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
2747             ($y == 0 && $m == 0 && $w == 0 && $d == 1)) ||
2748             ($#recur0 == 4 &&
2749             ($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 1)) ||
2750             ($#recur0 == 5 &&
2751             ($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 0 &&
2752             $mn == 1))) {
2753 0           $dateb = $date0;
2754             }
2755 0 0         return () if (! $dateb);
2756 0           @tmp=(@recur0);
2757 0           push(@tmp,0) while ($#tmp<6);
2758 0           $delta=join(":",@tmp);
2759 0 0         return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
2760 0           @date=_Date_Recur($date0,$date1,$dateb,$delta);
2761 0 0         if (@recur1) {
2762 0           unshift(@recur1,-1) while ($#recur1<2);
2763 0           @time=@recur1;
2764             } else {
2765 0           shift(@date);
2766 0           pop(@date);
2767 0           @time=();
2768             }
2769             }
2770              
2771 0           last RECUR;
2772             }
2773 0 0         @date=_Date_RecurSetTime($date0,$date1,\@date,@time) if (@time);
2774              
2775             #
2776             # We've got a list of dates. Operate on them with the flags.
2777             #
2778              
2779 0           my($sign,$forw,$today,$df,$db,$work,$i);
2780 0 0         if (@flags) {
2781 0           FLAG: foreach $f (@flags) {
2782 0           $f = uc($f);
2783              
2784 0 0         if ($f =~ /^(P|N)(D|T)([1-7])$/) {
2785 0           @tmp=($1,$2,$3);
2786 0 0         $forw =($tmp[0] eq "P" ? 0 : 1);
2787 0 0         $today=($tmp[1] eq "D" ? 0 : 1);
2788 0           $d=$tmp[2];
2789 0           @tmp=();
2790 0           foreach $date (@date) {
2791 0 0         if ($forw) {
2792 0           push(@tmp, Date_GetNext($date,$d,$today));
2793             } else {
2794 0           push(@tmp, Date_GetPrev($date,$d,$today));
2795             }
2796             }
2797 0           @date=@tmp;
2798 0           next FLAG;
2799             }
2800              
2801             # We want to go forward exact amounts of time instead of
2802             # business mode calculations so that we don't change the time
2803             # (which may have been set in the recur).
2804 0 0         if ($f =~ /^(F|B)(D|W)(\d+)$/) {
2805 0           @tmp=($1,$2,$3);
2806 0           $sign="+";
2807 0 0         $sign="-" if ($tmp[0] eq "B");
2808 0           $work=0;
2809 0 0         $work=1 if ($tmp[1] eq "W");
2810 0           $n=$tmp[2];
2811 0           @tmp=();
2812 0           foreach $date (@date) {
2813 0           for ($i=1; $i<=$n; $i++) {
2814 0           while (1) {
2815 0           $date=DateCalc($date,"${sign}0:0:0:1:0:0:0");
2816 0 0 0       last if (! $work || Date_IsWorkDay($date,0));
2817             }
2818             }
2819 0           push(@tmp,$date);
2820             }
2821 0           @date=@tmp;
2822 0           next FLAG;
2823             }
2824              
2825 0 0 0       if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
2826 0           $tmp=$1;
2827 0 0         my $noalt = $2 ? 1 : 0;
2828 0 0 0       if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
      0        
2829 0           $forw=1;
2830             } else {
2831 0           $forw=0;
2832             }
2833              
2834 0           @tmp=();
2835 0           DATE: foreach $date (@date) {
2836 0           $df=$db=$date;
2837 0 0         if (Date_IsWorkDay($date)) {
2838 0           push(@tmp,$date);
2839 0           next DATE;
2840             }
2841 0           while (1) {
2842 0 0         if ($forw) {
2843 0           $d=$df=DateCalc($df,"+0:0:0:1:0:0:0");
2844             } else {
2845 0           $d=$db=DateCalc($db,"-0:0:0:1:0:0:0");
2846             }
2847 0 0         if (Date_IsWorkDay($d)) {
2848 0           push(@tmp,$d);
2849 0           next DATE;
2850             }
2851 0 0         $forw=1-$forw if (! $noalt);
2852             }
2853             }
2854 0           @date=@tmp;
2855 0           next FLAG;
2856             }
2857              
2858 0 0         if ($f eq "EASTER") {
2859 0           @tmp=();
2860 0           foreach $date (@date) {
2861 0           ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
2862 0           ($m,$d)=_Date_Easter($y);
2863 0           $date=_Date_Join($y,$m,$d,$h,$mn,$s);
2864 0 0 0       next if (Date_Cmp($date,$date0)<0 ||
2865             Date_Cmp($date,$date1)>0);
2866 0           push(@tmp,$date);
2867             }
2868 0           @date=@tmp;
2869             }
2870             }
2871             }
2872              
2873 0           @date = sort { Date_Cmp($a,$b) } @date;
  0            
2874 0           return @date;
2875             }
2876              
2877             sub Date_GetPrev {
2878 0 0   0 1   print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/);
2879 0           my($date,$dow,$today,$hr,$min,$sec)=@_;
2880 0 0         Date_Init() if (! $Curr{"InitDone"});
2881 0           my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
2882             $adjust,$curr)=();
2883 0 0 0       $hr="00" if (defined $hr && $hr eq "0");
2884 0 0 0       $min="00" if (defined $min && $min eq "0");
2885 0 0 0       $sec="00" if (defined $sec && $sec eq "0");
2886              
2887 0 0         if (! _Date_Split($date)) {
2888 0           $date=ParseDateString($date);
2889 0 0         return "" if (! $date);
2890             }
2891 0           $curr=$date;
2892 0           ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
2893              
2894 0 0         if ($dow) {
2895 0           $curr_dow=Date_DayOfWeek($m,$d,$y);
2896 0           %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
  0            
2897 0 0         if (_IsInt($dow)) {
2898 0 0 0       return "" if ($dow<1 || $dow>7);
2899             } else {
2900 0 0         return "" if (! exists $dow{lc($dow)});
2901 0           $dow=$dow{lc($dow)};
2902             }
2903 0 0         if ($dow == $curr_dow) {
2904 0 0         $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today);
2905 0 0         $adjust=1 if ($today==2);
2906             } else {
2907 0 0         $dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
2908 0           $num = $curr_dow - $dow;
2909 0           $date=_DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0);
2910             }
2911 0 0         $date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
2912 0 0 0       $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0)
2913             if ($adjust && Date_Cmp($date,$curr)>0);
2914              
2915             } else {
2916 0           ($h,$mn,$s)=( _Date_Split($date, 1) )[3..5];
2917 0           ($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec);
2918 0 0         if ($hr) {
    0          
    0          
2919 0           ($hr,$min,$sec)=($th,$tm,$ts);
2920 0           $delta="-0:0:0:1:0:0:0";
2921             } elsif ($min) {
2922 0           ($hr,$min,$sec)=($h,$tm,$ts);
2923 0           $delta="-0:0:0:0:1:0:0";
2924             } elsif ($sec) {
2925 0           ($hr,$min,$sec)=($h,$mn,$ts);
2926 0           $delta="-0:0:0:0:0:1:0";
2927             } else {
2928 0           confess "ERROR: invalid arguments in Date_GetPrev.\n";
2929             }
2930              
2931 0           $d=Date_SetTime($date,$hr,$min,$sec);
2932 0 0         if ($today) {
2933 0 0         $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>0);
2934             } else {
2935 0 0         $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>=0);
2936             }
2937 0           $date=$d;
2938             }
2939 0           return $date;
2940             }
2941              
2942             sub Date_GetNext {
2943 0 0   0 1   print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/);
2944 0           my($date,$dow,$today,$hr,$min,$sec)=@_;
2945 0 0         Date_Init() if (! $Curr{"InitDone"});
2946 0           my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
2947             $adjust,$curr)=();
2948 0 0 0       $hr="00" if (defined $hr && $hr eq "0");
2949 0 0 0       $min="00" if (defined $min && $min eq "0");
2950 0 0 0       $sec="00" if (defined $sec && $sec eq "0");
2951              
2952 0 0         if (! _Date_Split($date)) {
2953 0           $date=ParseDateString($date);
2954 0 0         return "" if (! $date);
2955             }
2956 0           $curr=$date;
2957 0           ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
2958              
2959 0 0         if ($dow) {
2960 0           $curr_dow=Date_DayOfWeek($m,$d,$y);
2961 0           %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
  0            
2962 0 0         if (_IsInt($dow)) {
2963 0 0 0       return "" if ($dow<1 || $dow>7);
2964             } else {
2965 0 0         return "" if (! exists $dow{lc($dow)});
2966 0           $dow=$dow{lc($dow)};
2967             }
2968 0 0         if ($dow == $curr_dow) {
2969 0 0         $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today);
2970 0 0         $adjust=1 if ($today==2);
2971             } else {
2972 0 0         $curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
2973 0           $num = $dow - $curr_dow;
2974 0           $date=_DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0);
2975             }
2976 0 0         $date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
2977 0 0 0       $date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0)
2978             if ($adjust && Date_Cmp($date,$curr)<0);
2979              
2980             } else {
2981 0           ($h,$mn,$s)=( _Date_Split($date, 1) )[3..5];
2982 0           ($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec);
2983 0 0         if ($hr) {
    0          
    0          
2984 0           ($hr,$min,$sec)=($th,$tm,$ts);
2985 0           $delta="+0:0:0:1:0:0:0";
2986             } elsif ($min) {
2987 0           ($hr,$min,$sec)=($h,$tm,$ts);
2988 0           $delta="+0:0:0:0:1:0:0";
2989             } elsif ($sec) {
2990 0           ($hr,$min,$sec)=($h,$mn,$ts);
2991 0           $delta="+0:0:0:0:0:1:0";
2992             } else {
2993 0           confess "ERROR: invalid arguments in Date_GetNext.\n";
2994             }
2995              
2996 0           $d=Date_SetTime($date,$hr,$min,$sec);
2997 0 0         if ($today) {
2998 0 0         $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<0);
2999             } else {
3000 0 0         $d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<1);
3001             }
3002 0           $date=$d;
3003             }
3004              
3005 0           return $date;
3006             }
3007              
3008             sub Date_IsHoliday {
3009 0 0   0 1   print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
3010 0           my($date)=@_;
3011 0 0         Date_Init() if (! $Curr{"InitDone"});
3012 0           $date=ParseDateString($date);
3013 0 0         return undef if (! $date);
3014 0           $date=Date_SetTime($date,0,0,0);
3015 0           my($y)=(_Date_Split($date, 1))[0];
3016              
3017 0 0         _Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y});
3018              
3019 0 0         return undef if (! exists $Holiday{"dates"}{$y}{$date});
3020 0           my($name)=$Holiday{"dates"}{$y}{$date};
3021 0 0         return "" if (! $name);
3022 0           $name;
3023             }
3024              
3025             sub Events_List {
3026 0 0   0 1   print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
3027 0           my(@args)=@_;
3028 0 0         Date_Init() if (! $Curr{"InitDone"});
3029 0           _Events_ParseRaw();
3030              
3031 0           my($tmp,$date0,$date1,$flag);
3032 0           $date0=ParseDateString($args[0]);
3033 0 0         warn "Invalid date $args[0]", return undef if (! $date0);
3034              
3035 0 0         if ($#args == 0) {
3036 0           return _Events_Calc($date0);
3037             }
3038              
3039 0 0         if ($args[1]) {
3040 0           $date1=ParseDateString($args[1]);
3041 0 0         warn "Invalid date $args[1]\n", return undef if (! $date1);
3042 0 0         if (Date_Cmp($date0,$date1)>0) {
3043 0           $tmp=$date1;
3044 0           $date1=$date0;
3045 0           $date0=$tmp;
3046             }
3047             } else {
3048 0           $date0=Date_SetTime($date0,"00:00:00");
3049 0           $date1=_DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0");
3050             }
3051              
3052 0           $tmp=_Events_Calc($date0,$date1);
3053              
3054 0           $flag=$args[2];
3055 0 0         return $tmp if (! $flag);
3056              
3057 0           my(@tmp,%ret,$delta)=();
3058 0           @tmp=@$tmp;
3059 0           push(@tmp,$date1);
3060              
3061 0 0         if ($flag==1) {
    0          
3062 0           while ($#tmp>0) {
3063 0           ($date0,$tmp)=splice(@tmp,0,2);
3064 0           $date1=$tmp[0];
3065 0           $delta=_DateCalc_DateDate($date0,$date1);
3066 0           foreach $flag (@$tmp) {
3067 0 0         if (exists $ret{$flag}) {
3068 0           $ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta);
3069             } else {
3070 0           $ret{$flag}=$delta;
3071             }
3072             }
3073             }
3074 0           return \%ret;
3075              
3076             } elsif ($flag==2) {
3077 0           while ($#tmp>0) {
3078 0           ($date0,$tmp)=splice(@tmp,0,2);
3079 0           $date1=$tmp[0];
3080 0           $delta=_DateCalc_DateDate($date0,$date1);
3081 0           $flag=join("+",sort { Date_Cmp($a,$b) } @$tmp);
  0            
3082 0 0         next if (! $flag);
3083 0 0         if (exists $ret{$flag}) {
3084 0           $ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta);
3085             } else {
3086 0           $ret{$flag}=$delta;
3087             }
3088             }
3089 0           return \%ret;
3090             }
3091              
3092 0           warn "Invalid flag $flag\n";
3093 0           return undef;
3094             }
3095              
3096             ###
3097             # NOTE: The following routines may be called in the routines below with very
3098             # little time penalty.
3099             ###
3100             sub Date_SetTime {
3101 0 0   0 1   print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
3102 0           my($date,$h,$mn,$s)=@_;
3103 0 0         Date_Init() if (! $Curr{"InitDone"});
3104 0           my($y,$m,$d)=();
3105              
3106 0 0         if (! _Date_Split($date)) {
3107 0           $date=ParseDateString($date);
3108 0 0         return "" if (! $date);
3109             }
3110              
3111 0           ($y,$m,$d)=( _Date_Split($date, 1) )[0..2];
3112 0           ($h,$mn,$s)=_Date_ParseTime($h,$mn,$s);
3113              
3114 0           my($ampm,$wk);
3115 0 0         return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
3116 0           _Date_Join($y,$m,$d,$h,$mn,$s);
3117             }
3118              
3119             sub Date_SetDateField {
3120 0 0   0 1   print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/);
3121 0           my($date,$field,$val,$nocheck)=@_;
3122 0           my($y,$m,$d,$h,$mn,$s)=();
3123 0 0         $nocheck=0 if (! defined $nocheck);
3124              
3125 0           ($y,$m,$d,$h,$mn,$s)=_Date_Split($date);
3126              
3127 0 0         if (! $y) {
3128 0           $date=ParseDateString($date);
3129 0 0         return "" if (! $date);
3130 0           ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
3131             }
3132              
3133 0 0         if (lc($field) eq "y") {
    0          
    0          
    0          
    0          
    0          
3134 0           $y=$val;
3135             } elsif (lc($field) eq "m") {
3136 0           $m=$val;
3137             } elsif (lc($field) eq "d") {
3138 0           $d=$val;
3139             } elsif (lc($field) eq "h") {
3140 0           $h=$val;
3141             } elsif (lc($field) eq "mn") {
3142 0           $mn=$val;
3143             } elsif (lc($field) eq "s") {
3144 0           $s=$val;
3145             } else {
3146 0           confess "ERROR: Date_SetDateField: invalid field: $field\n";
3147             }
3148              
3149 0           $date=_Date_Join($y,$m,$d,$h,$mn,$s);
3150 0 0 0       return $date if ($nocheck || _Date_Split($date));
3151 0           return "";
3152             }
3153              
3154             ########################################################################
3155             # OTHER SUBROUTINES
3156             ########################################################################
3157             # NOTE: These routines should not call any of the routines above as
3158             # there will be a severe time penalty (and the possibility of
3159             # infinite recursion). The last couple routines above are
3160             # exceptions.
3161             # NOTE: Date_Init is a special case. It should be called (conditionally)
3162             # in every routine that uses any variable from the Date::Manip
3163             # namespace.
3164             ########################################################################
3165              
3166             sub Date_DaysInMonth {
3167 0 0   0 1   print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
3168 0           my($m,$y)=@_;
3169 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3170 0           my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
3171 0 0         $d_in_m[2]=29 if (Date_LeapYear($y));
3172 0           return $d_in_m[$m];
3173             }
3174              
3175             sub Date_DayOfWeek {
3176 0 0   0 1   print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
3177 0           my($m,$d,$y)=@_;
3178 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3179 0           my($dayofweek,$dec31)=();
3180              
3181 0           $dec31=5; # Dec 31, 1BC was Friday
3182 0           $dayofweek=(Date_DaysSince1BC($m,$d,$y)+$dec31) % 7;
3183 0 0         $dayofweek=7 if ($dayofweek==0);
3184 0           return $dayofweek;
3185             }
3186              
3187             # Can't be in "use integer" because the numbers are too big.
3188 36     36   237248 no integer;
  36         94  
  36         169  
3189             sub Date_SecsSince1970 {
3190 0 0   0 1   print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
3191 0           my($m,$d,$y,$h,$mn,$s)=@_;
3192 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3193 0           my($sec_now,$sec_70)=();
3194 0           $sec_now=(Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s;
3195             # $sec_70 =(Date_DaysSince1BC(1,1,1970)-1)*24*3600;
3196 0           $sec_70 =62167219200;
3197 0           return ($sec_now-$sec_70);
3198             }
3199              
3200             sub Date_SecsSince1970GMT {
3201 0 0   0 1   print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/);
3202 0           my($m,$d,$y,$h,$mn,$s)=@_;
3203 0 0         Date_Init() if (! $Curr{"InitDone"});
3204 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3205              
3206 0           my($sec)=Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
3207 0 0         return $sec if ($Cnf{"ConvTZ"} eq "IGNORE");
3208              
3209 0           my($tz)=$Cnf{"ConvTZ"};
3210 0 0 0       $tz=$Cnf{"TZ"} if (not defined $tz or $tz eq "");
3211 0 0         $tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
3212              
3213 0           my($tzs)=1;
3214 0 0         $tzs=-1 if ($tz<0);
3215 0           $tz=~/.(..)(..)/;
3216 0           my($tzh,$tzm)=($1,$2);
3217 0           $sec - $tzs*($tzh*3600+$tzm*60);
3218             }
3219 36     36   12810 use integer;
  36         72  
  36         146  
3220              
3221             sub Date_DaysSince1BC {
3222 0 0   0 1   print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
3223 0           my($m,$d,$y)=@_;
3224 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3225 0           my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
3226 0           my($cc,$yy)=();
3227              
3228 0           $y=~ /(\d{2})(\d{2})/;
3229 0           ($cc,$yy)=($1,$2);
3230              
3231             # Number of full years since Dec 31, 1BC (counting the year 0000).
3232 0           $Ny=$y;
3233              
3234             # Number of full 4th years (incl. 0000) since Dec 31, 1BC
3235 0           $N4=($Ny-1)/4 + 1;
3236 0 0         $N4=0 if ($y==0);
3237              
3238             # Number of full 100th years (incl. 0000)
3239 0           $N100=$cc + 1;
3240 0 0         $N100-- if ($yy==0);
3241 0 0         $N100=0 if ($y==0);
3242              
3243             # Number of full 400th years (incl. 0000)
3244 0           $N400=($N100-1)/4 + 1;
3245 0 0         $N400=0 if ($y==0);
3246              
3247 0           $dayofyear=Date_DayOfYear($m,$d,$y);
3248 0           $days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
3249              
3250 0           return $days;
3251             }
3252              
3253             sub Date_DayOfYear {
3254 0 0   0 1   print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3255 0           my($m,$d,$y)=@_;
3256 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3257             # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
3258 0           my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
3259 0           my($ly)=0;
3260 0 0 0       $ly=1 if ($m>2 && Date_LeapYear($y));
3261 0           return ($days[$m-1]+$d+$ly);
3262             }
3263              
3264             sub Date_DaysInYear {
3265 0 0   0 1   print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
3266 0           my($y)=@_;
3267 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3268 0 0         return 366 if (Date_LeapYear($y));
3269 0           return 365;
3270             }
3271              
3272             sub Date_WeekOfYear {
3273 0 0   0 1   print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3274 0           my($m,$d,$y,$f)=@_;
3275 0 0         Date_Init() if (! $Curr{"InitDone"});
3276 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3277              
3278 0           my($day,$dow,$doy)=();
3279 0           $doy=Date_DayOfYear($m,$d,$y);
3280              
3281             # The current DayOfYear and DayOfWeek
3282 0 0         if ($Cnf{"Jan1Week1"}) {
3283 0           $day=1;
3284             } else {
3285 0           $day=4;
3286             }
3287 0           $dow=Date_DayOfWeek(1,$day,$y);
3288              
3289             # Move back to the first day of week 1.
3290 0 0         $f-=7 if ($f>$dow);
3291 0           $day-= ($dow-$f);
3292              
3293 0 0         return 0 if ($day>$doy); # Day is in last week of previous year
3294 0           return (($doy-$day)/7 + 1);
3295             }
3296              
3297             sub Date_LeapYear {
3298 0 0   0 1   print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
3299 0           my($y)=@_;
3300 0 0         $y=_Date_FixYear($y) if (length($y)!=4);
3301 0 0         return 0 unless $y % 4 == 0;
3302 0 0         return 1 unless $y % 100 == 0;
3303 0 0         return 0 unless $y % 400 == 0;
3304 0           return 1;
3305             }
3306              
3307             sub Date_DaySuffix {
3308 0 0   0 1   print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
3309 0           my($d)=@_;
3310 0 0         Date_Init() if (! $Curr{"InitDone"});
3311 0           return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
3312             }
3313              
3314             sub Date_ConvTZ {
3315 0 0   0 1   print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
3316 0           my($date,$from,$to,$level)=@_;
3317 0 0         if (not _Date_Split($date)) {
3318 0           my $err = "date passed in ('$date') is not a Date::Manip object";
3319 0 0         if (! $level) {
    0          
3320 0           croak $err;
3321             } elsif ($level==1) {
3322 0           carp $err;
3323             }
3324 0           return "";
3325             }
3326              
3327 0 0         Date_Init() if (! $Curr{"InitDone"});
3328 0           my($gmt)=();
3329              
3330 0 0 0       if ((! defined $from) or ($from eq '')) {
3331              
3332 0 0 0       if ((! defined $to) or ($to eq '')) {
3333             # TZ -> ConvTZ
3334 0 0 0       return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
3335 0           $from=$Cnf{"TZ"};
3336 0           $to=$Cnf{"ConvTZ"};
3337              
3338             } else {
3339             # ConvTZ,TZ -> $to
3340 0           $from=$Cnf{"ConvTZ"};
3341 0 0 0       $from=$Cnf{"TZ"} if ((! defined $from) or ($from eq ''));
3342             }
3343              
3344             } else {
3345              
3346 0 0 0       if ((! defined $to) or ($to eq '')) {
3347             # $from -> ConvTZ,TZ
3348 0 0         return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
3349 0           $to=$Cnf{"ConvTZ"};
3350 0 0 0       $to=$Cnf{"TZ"} if ((! defined $to) or ($to eq ''));
3351              
3352             } else {
3353             # $from -> $to
3354             }
3355             }
3356              
3357             $to=$Zone{"n2o"}{lc($to)}
3358 0 0         if (exists $Zone{"n2o"}{lc($to)});
3359             $from=$Zone{"n2o"}{lc($from)}
3360 0 0         if (exists $Zone{"n2o"}{lc($from)});
3361 0           $gmt=$Zone{"n2o"}{"gmt"};
3362              
3363 0 0 0       return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/);
3364 0 0         return $date if ($from eq $to);
3365              
3366 0           my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=();
3367             # We're going to try to do the calculation without calling DateCalc.
3368 0           ($yr,$mon,$d,$h,$m,$sec)=_Date_Split($date, 1);
3369              
3370             # Convert $date from $from to GMT
3371 0           $from=~/([+-])(\d{2})(\d{2})/;
3372 0           ($s1,$h1,$m1)=($1,$2,$3);
3373 0 0         $s1= ($s1 eq "-" ? "+" : "-"); # switch sign
3374 0           $sign=$s1 . "1"; # + or - 1
3375              
3376             # and from GMT to $to
3377 0           $to=~/([+-])(\d{2})(\d{2})/;
3378 0           ($s2,$h2,$m2)=($1,$2,$3);
3379              
3380 0 0         if ($s1 eq $s2) {
3381             # Both the same sign
3382 0           $m+= $sign*($m1+$m2);
3383 0           $h+= $sign*($h1+$h2);
3384             } else {
3385 0 0 0       $sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
    0 0        
3386 0           $m+= $sign*($m1-$m2);
3387 0           $h+= $sign*($h1-$h2);
3388             }
3389              
3390 0 0         if ($m>59) {
    0          
3391 0           $h+= $m/60;
3392 0           $m-= ($m/60)*60;
3393             } elsif ($m<0) {
3394 0           $h+= ($m/60 - 1);
3395 0           $m-= ($m/60 - 1)*60;
3396             }
3397              
3398 0 0         if ($h>23) {
    0          
3399 0           $delta=$h/24;
3400 0           $h -= $delta*24;
3401 0 0         if (($d + $delta) > 28) {
3402 0           $date=_Date_Join($yr,$mon,$d,$h,$m,$sec);
3403 0           return _DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0);
3404             }
3405 0           $d+= $delta;
3406             } elsif ($h<0) {
3407 0           $delta=-$h/24 + 1;
3408 0           $h += $delta*24;
3409 0 0         if (($d - $delta) < 1) {
3410 0           $date=_Date_Join($yr,$mon,$d,$h,$m,$sec);
3411 0           return _DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0);
3412             }
3413 0           $d-= $delta;
3414             }
3415 0           return _Date_Join($yr,$mon,$d,$h,$m,$sec);
3416             }
3417              
3418             sub Date_TimeZone {
3419 0 0   0 1   print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/);
3420 0           my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=();
3421 0 0         Date_Init() if (! $Curr{"InitDone"});
3422              
3423             # Get timezones from all of the relevant places
3424              
3425 0 0         push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var
3426 0 0         push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var
3427             push(@tz,$ENV{'SYS$TIMEZONE_RULE'})
3428 0 0         if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var
3429             push(@tz,$ENV{'SYS$TIMEZONE_NAME'})
3430 0 0         if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var
3431             push(@tz,$ENV{'UCX$TZ'})
3432 0 0         if defined $ENV{'UCX$TZ'}; # VMS TZ environ var
3433             push(@tz,$ENV{'TCPIP$TZ'})
3434 0 0         if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var
3435              
3436             # The `date` command... if we're doing taint checking, we need to
3437             # always call it with a full path... otherwise, use the user's path.
3438             #
3439             # Microsoft operating systems don't have a date command built in. Try
3440             # to trap all the various ways of knowing we are on one of these systems.
3441             #
3442             # We'll try `date +%Z` first, and if that fails, we'll take just the
3443             # `date` program and assume the output is of the format:
3444             # Thu Aug 31 14:57:46 EDT 2000
3445              
3446 0 0 0       unless (($^O ne 'cygwin' && $^X =~ /perl\.exe$/i) or
      0        
      0        
      0        
3447             ($OS eq "Windows") or
3448             ($OS eq "Netware") or
3449             ($OS eq "VMS")) {
3450 0 0         if ($Date::Manip::DM5::NoTaint) {
3451 0 0         if ($OS eq "VMS") {
3452 0           $tz=$ENV{'SYS$TIMEZONE_NAME'};
3453 0 0         if (! defined $tz) {
3454 0           $tz=$ENV{'MULTINET_TIMEZONE'};
3455 0 0         if (! defined $tz) {
3456 0           $tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
3457             }
3458             }
3459 0 0         push(@tz,$tz) if (defined $tz);
3460              
3461             } else {
3462 0           $tz=`date +%Z 2> /dev/null`;
3463 0           chomp($tz);
3464 0 0         if (! defined $tz) {
3465 0           $tz=`date 2> /dev/null`;
3466 0           chomp($tz);
3467 0           $tz=(split(/\s+/,$tz))[4];
3468             }
3469 0 0         push(@tz,$tz) if (defined $tz);
3470              
3471             # for international timezones
3472 0           $tz=`date +%z 2> /dev/null`;
3473 0           chomp($tz);
3474 0 0         push(@tz,$tz) if (defined $tz);
3475             }
3476             } else {
3477             # We need to satisfy taint checking, but also look in all the
3478             # directories in @DatePath.
3479             #
3480 0           local $ENV{PATH} = join(':', @Date::Manip::DM5::DatePath);
3481 0           local $ENV{BASH_ENV} = '';
3482 0           $tz=`date +%Z 2> /dev/null`;
3483 0           chomp($tz);
3484 0 0         if (! defined $tz) {
3485 0           $tz=`date 2> /dev/null`;
3486 0           chomp($tz);
3487 0           $tz=(split(/\s+/,$tz))[4];
3488             }
3489 0 0         push(@tz,$tz) if (defined $tz);
3490              
3491             # for international timezones
3492 0           $tz=`date +%z 2> /dev/null`;
3493 0           chomp($tz);
3494 0 0         push(@tz,$tz) if (defined $tz);
3495             }
3496             }
3497              
3498 0 0         push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ
3499              
3500 0 0         if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE
3501 0           $in=new IO::File;
3502 0           $in->open("/etc/TIMEZONE","r");
3503 0           while (! eof($in)) {
3504 0           $tmp=<$in>;
3505 0 0         if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
3506 0           push(@tz,$1);
3507 0           last;
3508             }
3509             }
3510 0           $in->close;
3511             }
3512              
3513 0 0         if (-s "/etc/timezone") { # /etc/timezone
3514 0           $in=new IO::File;
3515 0           $in->open("/etc/timezone","r");
3516 0           while (! eof($in)) {
3517 0           $tmp=<$in>;
3518 0 0         next if ($tmp =~ /^\s*\043/);
3519 0           chomp($tmp);
3520 0 0         if ($tmp =~ /^\s*(.*?)\s*$/) {
3521 0           push(@tz,$1);
3522 0           last;
3523             }
3524             }
3525 0           $in->close;
3526             }
3527              
3528             # Now parse each one to find the first valid one.
3529 0           foreach $tz (@tz) {
3530 0           $tz =~ s/\s*$//;
3531 0           $tz =~ s/^\s*//;
3532 0           $tz =~ s/^://;
3533 0 0         next if ($tz eq "");
3534              
3535             return uc($tz)
3536 0 0         if (defined $Zone{"n2o"}{lc($tz)});
3537              
3538 0 0         if ($tz =~ /^[+-]\d{4}$/) {
    0          
3539 0           return $tz;
3540             } elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
3541 0           my($h,$m)=($1,$2);
3542 0 0         $m="00" if (! $m);
3543 0           return "$h$m";
3544             }
3545              
3546             # Handle US/Eastern format
3547 0 0         if ($tz =~ /^$Zone{"tzones"}$/i) {
3548 0           $tmp=lc $1;
3549 0           $tz=$Zone{"tz2z"}{$tmp};
3550             }
3551              
3552             # Handle STD#DST# format (and STD-#DST-# formats)
3553 0 0         if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
3554 0           ($std,$dst)=($1,$2);
3555             next if (! defined $Zone{"n2o"}{lc($std)} or
3556 0 0 0       ! defined $Zone{"n2o"}{lc($dst)});
3557 0           $time = time();
3558 0           ($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
3559             localtime($time);
3560 0 0         return uc($dst) if ($isdst);
3561 0           return uc($std);
3562             }
3563             }
3564              
3565 0           confess "ERROR: Date::Manip unable to determine Time Zone.\n";
3566             }
3567              
3568             # Returns 1 if $date is a work day. If $time is non-zero, the time is
3569             # also checked to see if it falls within work hours. Returns "" if
3570             # an invalid date is passed in.
3571             sub Date_IsWorkDay {
3572 0 0   0 1   print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3573 0           my($date,$time)=@_;
3574 0 0         Date_Init() if (! $Curr{"InitDone"});
3575 0           $date=ParseDateString($date);
3576 0 0         return "" if (! $date);
3577 0           my($d)=$date;
3578 0 0         $d=Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time);
3579              
3580 0           my($y,$mon,$day,$h,$m,$s,$dow)=();
3581 0           ($y,$mon,$day,$h,$m,$s)=_Date_Split($d, 1);
3582 0           $dow=Date_DayOfWeek($mon,$day,$y);
3583              
3584             return 0 if ($dow<$Cnf{"WorkWeekBeg"} or
3585             $dow>$Cnf{"WorkWeekEnd"} or
3586             "$h:$m" lt $Cnf{"WorkDayBeg"} or
3587 0 0 0       "$h:$m" ge $Cnf{"WorkDayEnd"});
      0        
      0        
3588              
3589 0 0         if (! exists $Holiday{"dates"}{$y}) {
3590             # There will be recursion problems if we ever end up here twice.
3591 0           $Holiday{"dates"}{$y}={};
3592 0           _Date_UpdateHolidays($y)
3593             }
3594 0           $d=Date_SetTime($date,"00:00:00");
3595 0 0         return 0 if (exists $Holiday{"dates"}{$y}{$d});
3596 0           1;
3597             }
3598              
3599             # Finds the day $off work days from now. If $time is passed in, we must
3600             # also take into account the time of day.
3601             #
3602             # If $time is not passed in, day 0 is today (if today is a workday) or the
3603             # next work day if it isn't. In any case, the time of day is unaffected.
3604             #
3605             # If $time is passed in, day 0 is now (if now is part of a workday) or the
3606             # start of the very next work day.
3607             sub Date_NextWorkDay {
3608 0 0   0 1   print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3609 0           my($date,$off,$time)=@_;
3610 0 0         Date_Init() if (! $Curr{"InitDone"});
3611 0           $date=ParseDateString($date);
3612 0           my($err)=();
3613              
3614 0 0         if (! Date_IsWorkDay($date,$time)) {
3615 0 0         if ($time) {
3616 0           while (1) {
3617 0           $date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3618 0 0         last if (Date_IsWorkDay($date,$time));
3619             }
3620             } else {
3621 0           while (1) {
3622 0           $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3623 0 0         last if (Date_IsWorkDay($date,$time));
3624             }
3625             }
3626             }
3627              
3628 0           while ($off>0) {
3629 0           while (1) {
3630 0           $date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
3631 0 0         last if (Date_IsWorkDay($date,$time));
3632             }
3633 0           $off--;
3634             }
3635              
3636 0           return $date;
3637             }
3638              
3639             # Finds the day $off work days before now. If $time is passed in, we must
3640             # also take into account the time of day.
3641             #
3642             # If $time is not passed in, day 0 is today (if today is a workday) or the
3643             # previous work day if it isn't. In any case, the time of day is unaffected.
3644             #
3645             # If $time is passed in, day 0 is now (if now is part of a workday) or the
3646             # end of the previous work period. Note that since the end of a work day
3647             # will automatically be turned into the start of the next one, this time
3648             # may actually be treated as AFTER the current time.
3649             sub Date_PrevWorkDay {
3650 0 0   0 1   print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3651 0           my($date,$off,$time)=@_;
3652 0 0         Date_Init() if (! $Curr{"InitDone"});
3653 0           $date=ParseDateString($date);
3654 0           my($err)=();
3655              
3656 0 0         if (! Date_IsWorkDay($date,$time)) {
3657 0 0         if ($time) {
3658 0           while (1) {
3659 0           $date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
3660 0 0         last if (Date_IsWorkDay($date,$time));
3661             }
3662             } else {
3663 0           while (1) {
3664 0           $date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3665 0 0         last if (Date_IsWorkDay($date,$time));
3666             }
3667             }
3668             }
3669              
3670 0           while ($off>0) {
3671 0           while (1) {
3672 0           $date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
3673 0 0         last if (Date_IsWorkDay($date,$time));
3674             }
3675 0           $off--;
3676             }
3677              
3678 0           return $date;
3679             }
3680              
3681             # This finds the nearest workday to $date. If $date is a workday, it
3682             # is returned.
3683             sub Date_NearestWorkDay {
3684 0 0   0 1   print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
3685 0           my($date,$tomorrow)=@_;
3686 0 0         Date_Init() if (! $Curr{"InitDone"});
3687 0           $date=ParseDateString($date);
3688 0           my($a,$b,$dela,$delb,$err)=();
3689 0 0         $tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow);
3690              
3691 0 0         return $date if (Date_IsWorkDay($date));
3692              
3693             # Find the nearest one.
3694 0 0         if ($tomorrow) {
3695 0           $dela="+0:0:0:1:0:0:0";
3696 0           $delb="-0:0:0:1:0:0:0";
3697             } else {
3698 0           $dela="-0:0:0:1:0:0:0";
3699 0           $delb="+0:0:0:1:0:0:0";
3700             }
3701 0           $a=$b=$date;
3702              
3703 0           while (1) {
3704 0           $a=_DateCalc_DateDelta($a,$dela,\$err);
3705 0 0         return $a if (Date_IsWorkDay($a));
3706 0           $b=_DateCalc_DateDelta($b,$delb,\$err);
3707 0 0         return $b if (Date_IsWorkDay($b));
3708             }
3709             }
3710              
3711             # Date_NthDayOfYear($y,$n);
3712             # Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year.
3713             sub Date_NthDayOfYear {
3714 36     36   109955 no integer;
  36         80  
  36         160  
3715 0 0   0 1   print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
3716 0           my($y,$n)=@_;
3717 0 0         $y=$Curr{"Y"} if (! $y);
3718 0 0 0       $n=1 if (! defined $n or $n eq "");
3719 0           $n+=0; # to turn 023 into 23
3720 0 0         $y=_Date_FixYear($y) if (length($y)<4);
3721 0           my $leap=Date_LeapYear($y);
3722 0 0         return () if ($n<1);
3723 0 0         return () if ($n >= ($leap ? 367 : 366));
    0          
3724              
3725 0           my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31);
3726 0 0         $d_in_m[1]=29 if ($leap);
3727              
3728             # Calculate the hours, minutes, and seconds into the day.
3729 0           my $remain=($n - int($n))*24;
3730 0           my $h=int($remain);
3731 0           $remain=($remain - $h)*60;
3732 0           my $mn=int($remain);
3733 0           $remain=($remain - $mn)*60;
3734 0           my $s=$remain;
3735              
3736             # Calculate the month and the day.
3737 0           my($m,$d)=(0,0);
3738 0           $n=int($n);
3739 0           while ($n>0) {
3740 0           $m++;
3741 0 0         if ($n<=$d_in_m[0]) {
3742 0           $d=int($n);
3743 0           $n=0;
3744             } else {
3745 0           $n-= $d_in_m[0];
3746 0           shift(@d_in_m);
3747             }
3748             }
3749              
3750 0           ($y,$m,$d,$h,$mn,$s);
3751             }
3752              
3753             ########################################################################
3754             # NOT FOR EXPORT
3755             ########################################################################
3756              
3757             # This is used in Date_Init to fill in a hash based on international
3758             # data. It takes a list of keys and values and returns both a hash
3759             # with these values and a regular expression of keys.
3760             #
3761             # IN:
3762             # $data = [ key1 val1 key2 val2 ... ]
3763             # $opts = lc : lowercase the keys in the regexp
3764             # sort : sort (by length) the keys in the regexp
3765             # back : create a regexp with a back reference
3766             # escape : escape all strings in the regexp
3767             #
3768             # OUT:
3769             # $regexp = '(?:key1|key2|...)'
3770             # $hash = { key1=>val1 key2=>val2 ... }
3771              
3772             sub _Date_InitHash {
3773 0 0   0     print "DEBUG: _Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
3774 0           my($data,$regexp,$opts,$hash)=@_;
3775 0           my(@data)=@$data;
3776 0           my($key,$val,@list)=();
3777              
3778             # Parse the options
3779 0           my($lc,$sort,$back,$escape)=(0,0,0,0);
3780 0 0         $lc=1 if ($opts =~ /lc/i);
3781 0 0         $sort=1 if ($opts =~ /sort/i);
3782 0 0         $back=1 if ($opts =~ /back/i);
3783 0 0         $escape=1 if ($opts =~ /escape/i);
3784              
3785             # Create the hash
3786 0           while (@data) {
3787 0           ($key,$val,@data)=@data;
3788 0 0         $key=lc($key) if ($lc);
3789 0           $$hash{$key}=$val;
3790             }
3791              
3792             # Create the regular expression
3793 0 0         if ($regexp) {
3794 0           @list=keys(%$hash);
3795 0 0         @list=sort _sortByLength(@list) if ($sort);
3796 0 0         if ($escape) {
3797 0           foreach $val (@list) {
3798 0           $val="\Q$val\E";
3799             }
3800             }
3801 0 0         if ($back) {
3802 0           $$regexp="(" . join("|",@list) . ")";
3803             } else {
3804 0           $$regexp="(?:" . join("|",@list) . ")";
3805             }
3806             }
3807             }
3808              
3809             # This is used in Date_Init to fill in regular expressions, lists, and
3810             # hashes based on international data. It takes a list of lists which have
3811             # to be stored as regular expressions (to find any element in the list),
3812             # lists, and hashes (indicating the location in the lists).
3813             #
3814             # IN:
3815             # $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ]
3816             # [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ]
3817             # ...
3818             # [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ]
3819             # $lists = [ \@listA \@listB ... \@listZ ]
3820             # $opts = lc : lowercase the values in the regexp
3821             # sort : sort (by length) the values in the regexp
3822             # back : create a regexp with a back reference
3823             # escape : escape all strings in the regexp
3824             # $hash = [ \%hash, TYPE ]
3825             # TYPE 0 : $hash{ valBn=>n-1 }
3826             # TYPE 1 : $hash{ valBn=>n }
3827             #
3828             # OUT:
3829             # $regexp = '(?:valA1|valA2|...|valB1|...)'
3830             # $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
3831             # [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
3832             # $hash
3833              
3834             sub _Date_InitLists {
3835 0 0   0     print "DEBUG: _Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
3836 0           my($data,$regexp,$opts,$lists,$hash)=@_;
3837 0           my(@data)=@$data;
3838 0           my(@lists)=@$lists;
3839 0           my($i,@ele,$ele,@list,$j,$tmp)=();
3840              
3841             # Parse the options
3842 0           my($lc,$sort,$back,$escape)=(0,0,0,0);
3843 0 0         $lc=1 if ($opts =~ /lc/i);
3844 0 0         $sort=1 if ($opts =~ /sort/i);
3845 0 0         $back=1 if ($opts =~ /back/i);
3846 0 0         $escape=1 if ($opts =~ /escape/i);
3847              
3848             # Set each of the lists
3849 0 0         if (@lists) {
3850 0 0         confess "ERROR: _Date_InitLists: lists must be 1 per data\n"
3851             if ($#lists != $#data);
3852 0           for ($i=0; $i<=$#data; $i++) {
3853 0           @ele=@{ $data[$i] };
  0            
3854 0 0 0       if ($Cnf{"IntCharSet"} && $#ele>0) {
3855 0           @{ $lists[$i] } = @{ $ele[1] };
  0            
  0            
3856             } else {
3857 0           @{ $lists[$i] } = @{ $ele[0] };
  0            
  0            
3858             }
3859             }
3860             }
3861              
3862             # Create the hash
3863 0           my($hashtype,$hashsave,%hash)=();
3864 0 0         if (@$hash) {
3865 0           ($hash,$hashtype)=@$hash;
3866 0           $hashsave=1;
3867             } else {
3868 0           $hashtype=0;
3869 0           $hashsave=0;
3870             }
3871 0           for ($i=0; $i<=$#data; $i++) {
3872 0           @ele=@{ $data[$i] };
  0            
3873 0           foreach $ele (@ele) {
3874 0           @list = @{ $ele };
  0            
3875 0           for ($j=0; $j<=$#list; $j++) {
3876 0           $tmp=$list[$j];
3877 0 0         next if (! $tmp);
3878 0 0         $tmp=lc($tmp) if ($lc);
3879 0           $hash{$tmp}= $j+$hashtype;
3880             }
3881             }
3882             }
3883 0 0         %$hash = %hash if ($hashsave);
3884              
3885             # Create the regular expression
3886 0 0         if ($regexp) {
3887 0           @list=keys(%hash);
3888 0 0         @list=sort _sortByLength(@list) if ($sort);
3889 0 0         if ($escape) {
3890 0           foreach $ele (@list) {
3891 0           $ele="\Q$ele\E";
3892             }
3893             }
3894 0 0         if ($back) {
3895 0           $$regexp="(" . join("|",@list) . ")";
3896             } else {
3897 0           $$regexp="(?:" . join("|",@list) . ")";
3898             }
3899             }
3900             }
3901              
3902             # This is used in Date_Init to fill in regular expressions and lists based
3903             # on international data. This takes a list of strings and returns a regular
3904             # expression (to find any one of them).
3905             #
3906             # IN:
3907             # $data = [ string1 string2 ... ]
3908             # $opts = lc : lowercase the values in the regexp
3909             # sort : sort (by length) the values in the regexp
3910             # back : create a regexp with a back reference
3911             # escape : escape all strings in the regexp
3912             #
3913             # OUT:
3914             # $regexp = '(string1|string2|...)'
3915              
3916             sub _Date_InitStrings {
3917 0 0   0     print "DEBUG: _Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
3918 0           my($data,$regexp,$opts)=@_;
3919 0           my(@list)=@{ $data };
  0            
3920              
3921             # Parse the options
3922 0           my($lc,$sort,$back,$escape)=(0,0,0,0);
3923 0 0         $lc=1 if ($opts =~ /lc/i);
3924 0 0         $sort=1 if ($opts =~ /sort/i);
3925 0 0         $back=1 if ($opts =~ /back/i);
3926 0 0         $escape=1 if ($opts =~ /escape/i);
3927              
3928             # Create the regular expression
3929 0           my($ele)=();
3930 0 0         @list=sort _sortByLength(@list) if ($sort);
3931 0 0         if ($escape) {
3932 0           foreach $ele (@list) {
3933 0           $ele="\Q$ele\E";
3934             }
3935             }
3936 0 0         if ($back) {
3937 0           $$regexp="(" . join("|",@list) . ")";
3938             } else {
3939 0           $$regexp="(?:" . join("|",@list) . ")";
3940             }
3941 0 0         $$regexp=lc($$regexp) if ($lc);
3942             }
3943              
3944             # items is passed in (either as a space separated string, or a reference to
3945             # a list) and a regular expression which matches any one of the items is
3946             # prepared. The regular expression will be of one of the forms:
3947             # "(a|b)" @list not empty, back option included
3948             # "(?:a|b)" @list not empty
3949             # "()" @list empty, back option included
3950             # "" @list empty
3951             # $options is a string which contains any of the following strings:
3952             # back : the regular expression has a backreference
3953             # opt : the regular expression is optional and a "?" is appended in
3954             # the first two forms
3955             # optws : the regular expression is optional and may be replaced by
3956             # whitespace
3957             # optWs : the regular expression is optional, but if not present, must
3958             # be replaced by whitespace
3959             # sort : the items in the list are sorted by length (longest first)
3960             # lc : the string is lowercased
3961             # under : any underscores are converted to spaces
3962             # pre : it may be preceded by whitespace
3963             # Pre : it must be preceded by whitespace
3964             # PRE : it must be preceded by whitespace or the start
3965             # post : it may be followed by whitespace
3966             # Post : it must be followed by whitespace
3967             # POST : it must be followed by whitespace or the end
3968             # Spaces due to pre/post options will not be included in the back reference.
3969             #
3970             # If $array is included, then the elements will also be returned as a list.
3971             # $array is a string which may contain any of the following:
3972             # keys : treat the list as a hash and only the keys go into the regexp
3973             # key0 : treat the list as the values of a hash with keys 0 .. N-1
3974             # key1 : treat the list as the values of a hash with keys 1 .. N
3975             # val0 : treat the list as the keys of a hash with values 0 .. N-1
3976             # val1 : treat the list as the keys of a hash with values 1 .. N
3977              
3978             # _Date_InitLists([$lang{"month_name"},$lang{"month_abb"}],
3979             # [\$Month,"lc,sort,back"],
3980             # [\@Month,\@Mon],
3981             # [\%Month,1]);
3982              
3983             # This is used in Date_Init to prepare regular expressions. A list of
3984             # items is passed in (either as a space separated string, or a reference to
3985             # a list) and a regular expression which matches any one of the items is
3986             # prepared. The regular expression will be of one of the forms:
3987             # "(a|b)" @list not empty, back option included
3988             # "(?:a|b)" @list not empty
3989             # "()" @list empty, back option included
3990             # "" @list empty
3991             # $options is a string which contains any of the following strings:
3992             # back : the regular expression has a backreference
3993             # opt : the regular expression is optional and a "?" is appended in
3994             # the first two forms
3995             # optws : the regular expression is optional and may be replaced by
3996             # whitespace
3997             # optWs : the regular expression is optional, but if not present, must
3998             # be replaced by whitespace
3999             # sort : the items in the list are sorted by length (longest first)
4000             # lc : the string is lowercased
4001             # under : any underscores are converted to spaces
4002             # pre : it may be preceded by whitespace
4003             # Pre : it must be preceded by whitespace
4004             # PRE : it must be preceded by whitespace or the start
4005             # post : it may be followed by whitespace
4006             # Post : it must be followed by whitespace
4007             # POST : it must be followed by whitespace or the end
4008             # Spaces due to pre/post options will not be included in the back reference.
4009             #
4010             # If $array is included, then the elements will also be returned as a list.
4011             # $array is a string which may contain any of the following:
4012             # keys : treat the list as a hash and only the keys go into the regexp
4013             # key0 : treat the list as the values of a hash with keys 0 .. N-1
4014             # key1 : treat the list as the values of a hash with keys 1 .. N
4015             # val0 : treat the list as the keys of a hash with values 0 .. N-1
4016             # val1 : treat the list as the keys of a hash with values 1 .. N
4017             sub _Date_Regexp {
4018 0 0   0     print "DEBUG: _Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
4019 0           my($list,$options,$array)=@_;
4020 0           my(@list,$ret,%hash,$i)=();
4021 0           local($_)=();
4022 0 0         $options="" if (! defined $options);
4023 0 0         $array="" if (! defined $array);
4024              
4025 0           my($sort,$lc,$under)=(0,0,0);
4026 0 0         $sort =1 if ($options =~ /sort/i);
4027 0 0         $lc =1 if ($options =~ /lc/i);
4028 0 0         $under=1 if ($options =~ /under/i);
4029 0           my($back,$opt,$pre,$post,$ws)=("?:","","","","");
4030 0 0         $back ="" if ($options =~ /back/i);
4031 0 0         $opt ="?" if ($options =~ /opt/i);
4032 0 0         $pre ='\s*' if ($options =~ /pre/);
4033 0 0         $pre ='\s+' if ($options =~ /Pre/);
4034 0 0         $pre ='(?:\s+|^)' if ($options =~ /PRE/);
4035 0 0         $post ='\s*' if ($options =~ /post/);
4036 0 0         $post ='\s+' if ($options =~ /Post/);
4037 0 0         $post ='(?:$|\s+)' if ($options =~ /POST/);
4038 0 0         $ws ='\s*' if ($options =~ /optws/);
4039 0 0         $ws ='\s+' if ($options =~ /optws/);
4040              
4041 0           my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0);
4042 0 0         $keys =1 if ($array =~ /keys/i);
4043 0 0         $key0 =1 if ($array =~ /key0/i);
4044 0 0         $key1 =1 if ($array =~ /key1/i);
4045 0 0         $val0 =1 if ($array =~ /val0/i);
4046 0 0         $val1 =1 if ($array =~ /val1/i);
4047 0 0 0       $hash =1 if ($keys or $key0 or $key1 or $val0 or $val1);
      0        
      0        
      0        
4048              
4049 0           my($ref)=ref $list;
4050 0 0         if (! $ref) {
    0          
4051 0           $list =~ s/\s*$//;
4052 0           $list =~ s/^\s*//;
4053 0           $list =~ s/\s+/&&&/g;
4054             } elsif ($ref eq "ARRAY") {
4055 0           $list = join("&&&",@$list);
4056             } else {
4057 0           confess "ERROR: _Date_Regexp.\n";
4058             }
4059              
4060 0 0         if (! $list) {
4061 0 0         if ($back eq "") {
4062 0           return "()";
4063             } else {
4064 0           return "";
4065             }
4066             }
4067              
4068 0 0         $list=lc($list) if ($lc);
4069 0 0         $list=~ s/_/ /g if ($under);
4070 0           @list=split(/&&&/,$list);
4071 0 0 0       if ($keys) {
    0 0        
      0        
4072 0           %hash=@list;
4073 0           @list=keys %hash;
4074             } elsif ($key0 or $key1 or $val0 or $val1) {
4075 0           $i=0;
4076 0 0 0       $i=1 if ($key1 or $val1);
4077 0 0 0       if ($key0 or $key1) {
4078 0           %hash= map { $_,$i++ } @list;
  0            
4079             } else {
4080 0           %hash= map { $i++,$_ } @list;
  0            
4081             }
4082             }
4083 0 0         @list=sort _sortByLength(@list) if ($sort);
4084              
4085 0           $ret="($back" . join("|",@list) . ")";
4086 0 0 0       $ret="(?:$pre$ret$post)" if ($pre or $post);
4087 0           $ret.=$opt;
4088 0 0         $ret="(?:$ret|$ws)" if ($ws);
4089              
4090 0 0 0       if ($array and $hash) {
    0          
4091 0           return ($ret,%hash);
4092             } elsif ($array) {
4093 0           return ($ret,@list);
4094             } else {
4095 0           return $ret;
4096             }
4097             }
4098              
4099             # This will produce a delta with the correct number of signs. At most two
4100             # signs will be in it normally (one before the year, and one in front of
4101             # the day), but if appropriate, signs will be in front of all elements.
4102             # Also, as many of the signs will be equivalent as possible.
4103             sub _Delta_Normalize {
4104 0 0   0     print "DEBUG: _Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
4105 0           my($delta,$mode)=@_;
4106 0 0         return "" if (! $delta);
4107             return "+0:+0:+0:+0:+0:+0:+0"
4108 0 0 0       if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"});
4109 0 0         return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/);
4110              
4111 0           my($tmp,$sign1,$sign2,$len)=();
4112              
4113             # Calculate the length of the day in minutes
4114 0           $len=24*60;
4115 0 0 0       $len=$Curr{"WDlen"} if ($mode==2 || $mode==3);
4116              
4117             # We have to get the sign of every component explicitely so that a "-0"
4118             # or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must
4119             # be a negative delta).
4120              
4121 0           my($y,$mon,$w,$d,$h,$m,$s)=_Delta_Split($delta);
4122              
4123 0 0         $y = 0 if (! $y);
4124 0 0         $mon = 0 if (! $mon);
4125 0 0         $w = 0 if (! $w);
4126 0 0         $d = 0 if (! $d);
4127 0 0         $h = 0 if (! $h);
4128 0 0         $m = 0 if (! $m);
4129 0 0         $s = 0 if (! $s);
4130              
4131             # We need to make sure that the signs of all parts of a delta are the
4132             # same. The easiest way to do this is to convert all of the large
4133             # components to the smallest ones, then convert the smaller components
4134             # back to the larger ones.
4135              
4136             # Do the year/month part
4137              
4138 0           $mon += $y*12; # convert y to m
4139 0           $sign1="+";
4140 0 0         if ($mon<0) {
4141 0           $mon *= -1;
4142 0           $sign1="-";
4143             }
4144              
4145 0           $y = $mon/12; # convert m to y
4146 0           $mon -= $y*12;
4147              
4148 0 0         $y=0 if ($y eq "-0"); # get around silly -0 problem
4149 0 0         $mon=0 if ($mon eq "-0");
4150              
4151             # Do the wk/day/hour/min/sec part
4152              
4153             {
4154             # Unfortunately, $s is overflowing for dates more than ~70 years
4155             # apart.
4156 36     36   69572 no integer;
  36         75  
  36         154  
  0            
4157              
4158 0 0 0       if ($mode==3 || $mode==2) {
4159 0           $s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
4160             } else {
4161 0           $s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
4162             }
4163 0           $sign2="+";
4164 0 0         if ($s<0) {
4165 0           $s*=-1;
4166 0           $sign2="-";
4167             }
4168              
4169 0           $m = int($s/60); # convert s to m
4170 0           $s -= $m*60;
4171 0           $d = int($m/$len); # convert m to d
4172 0           $m -= $d*$len;
4173              
4174             # The rest should be fine.
4175             }
4176 0           $h = $m/60; # convert m to h
4177 0           $m -= $h*60;
4178 0 0 0       if ($mode == 3 || $mode == 2) {
4179 0           $w = $w*1; # get around +0 problem
4180             } else {
4181 0           $w = $d/7; # convert d to w
4182 0           $d -= $w*7;
4183             }
4184              
4185 0 0         $w=0 if ($w eq "-0"); # get around silly -0 problem
4186 0 0         $d=0 if ($d eq "-0");
4187 0 0         $h=0 if ($h eq "-0");
4188 0 0         $m=0 if ($m eq "-0");
4189 0 0         $s=0 if ($s eq "-0");
4190              
4191             # Only include two signs if necessary
4192 0 0 0       $sign1=$sign2 if ($y==0 and $mon==0);
4193 0 0 0       $sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0);
      0        
      0        
      0        
4194 0 0 0       $sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"});
4195              
4196 0 0         if ($Cnf{"DeltaSigns"}) {
4197 0           return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s";
4198             } else {
4199 0           return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s";
4200             }
4201             }
4202              
4203             # This checks a delta to make sure it is valid. If it is, it splits
4204             # it and returns the elements with a sign on each. The 2nd argument
4205             # specifies the default sign. Blank elements are set to 0. If the
4206             # third element is non-nil, exactly 7 elements must be included.
4207             sub _Delta_Split {
4208 0 0   0     print "DEBUG: _Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
4209 0           my($delta,$sign,$exact)=@_;
4210 0           my(@delta)=split(/:/,$delta);
4211 0 0 0       return () if ($exact and $#delta != 6);
4212 0           my($i)=();
4213 0 0         $sign="+" if (! defined $sign);
4214 0           for ($i=0; $i<=$#delta; $i++) {
4215 0 0         $delta[$i]="0" if (! $delta[$i]);
4216 0 0         return () if ($delta[$i] !~ /^[+-]?\d+$/);
4217 0 0         $sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign);
4218 0           $delta[$i] = $sign.$delta[$i];
4219             }
4220 0           @delta;
4221             }
4222              
4223             # Reads up to 3 arguments. $h may contain the time in any international
4224             # format. Any empty elements are set to 0.
4225             sub _Date_ParseTime {
4226 0 0   0     print "DEBUG: _Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
4227 0           my($h,$m,$s)=@_;
4228 0           my($t)=_CheckTime("one");
4229              
4230 0 0 0       if (defined $h and $h =~ /$t/) {
4231 0           $h=$1;
4232 0           $m=$2;
4233 0 0         $s=$3 if (defined $3);
4234             }
4235 0 0         $h="00" if (! defined $h);
4236 0 0         $m="00" if (! defined $m);
4237 0 0         $s="00" if (! defined $s);
4238              
4239 0           ($h,$m,$s);
4240             }
4241              
4242             # Forms a date with the 6 elements passed in (all of which must be defined).
4243             # No check as to validity is made.
4244             sub _Date_Join {
4245 0 0   0     print "DEBUG: _Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
4246 0           foreach (0 .. $#_) {
4247 0 0         croak "undefined arg $_ to _Date_Join()" if not defined $_[$_];
4248             }
4249 0           my($y,$m,$d,$h,$mn,$s)=@_;
4250 0           my($ym,$md,$dh,$hmn,$mns)=();
4251              
4252 0 0         if ($Cnf{"Internal"} == 0) {
    0          
    0          
4253 0           $ym=$md=$dh="";
4254 0           $hmn=$mns=":";
4255              
4256             } elsif ($Cnf{"Internal"} == 1) {
4257 0           $ym=$md=$dh=$hmn=$mns="";
4258              
4259             } elsif ($Cnf{"Internal"} == 2) {
4260 0           $ym=$md="-";
4261 0           $dh=" ";
4262 0           $hmn=$mns=":";
4263              
4264             } else {
4265 0           confess "ERROR: Invalid internal format in _Date_Join.\n";
4266             }
4267 0 0         $m="0$m" if (length($m)==1);
4268 0 0         $d="0$d" if (length($d)==1);
4269 0 0         $h="0$h" if (length($h)==1);
4270 0 0         $mn="0$mn" if (length($mn)==1);
4271 0 0         $s="0$s" if (length($s)==1);
4272 0           "$y$ym$m$md$d$dh$h$hmn$mn$mns$s";
4273             }
4274              
4275             # This checks a time. If it is valid, it splits it and returns 3 elements.
4276             # If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is
4277             # returned.
4278             sub _CheckTime {
4279 0 0   0     print "DEBUG: _CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
4280 0           my($time)=@_;
4281 0           my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
4282 0           my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
4283 0           my($m)='[0-5][0-9]';
4284 0           my($s)=$m;
4285 0           my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)";
4286 0           my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)";
4287 0           my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"};
4288 0           my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4289 0 0         if ($time eq "one") {
    0          
4290 0           return $t;
4291             } elsif ($time eq "two") {
4292 0           $t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
4293 0           return $t;
4294             }
4295              
4296 0 0         if ($time =~ /$t/i) {
4297 0           ($h,$m,$s)=($1,$2,$3);
4298 0 0         $h="0$h" if (length($h)<2);
4299 0 0         $m="0$m" if (length($m)<2);
4300 0 0         $s="00" if (! defined $s);
4301 0           return ($h,$m,$s);
4302             } else {
4303 0           return ();
4304             }
4305             }
4306              
4307             # This checks a recurrence. If it is valid, it splits it and returns the
4308             # elements. Otherwise, it returns an empty list.
4309             # ($recur0,$recur1,$flags,$dateb,$date0,$date1)=_Recur_Split($recur);
4310             sub _Recur_Split {
4311 0 0   0     print "DEBUG: _Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
4312 0           my($recur)=@_;
4313 0           my(@ret,@tmp);
4314              
4315 0           my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
4316 0           my($F) = '(?:\*([^*]*))';
4317 0           my($DB,$D0,$D1);
4318 0           $DB=$D0=$D1=$F;
4319              
4320 0 0         if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
4321 0           @ret=($1,$2,$3,$4,$5);
4322 0           @tmp=split(/\*/,shift(@ret));
4323 0 0         return () if ($#tmp>1);
4324 0 0         return (@tmp,"",@ret) if ($#tmp==0);
4325 0           return (@tmp,@ret);
4326             }
4327 0           return ();
4328             }
4329              
4330             # This checks a date. If it is valid, it splits it and returns the elements.
4331             #
4332             # The optional second argument says 'I really expect this to be a
4333             # valid Date::Manip object, please throw an exception if it is not'.
4334             # Otherwise, if the date passed in is undef or '', a regular
4335             # expression for the date is returned; if the string is nonempty but
4336             # still not valid, () is returned.
4337             #
4338             sub _Date_Split {
4339 0 0   0     print "DEBUG: _Date_Split\n" if ($Curr{"Debug"} =~ /trace/);
4340 0           my($date, $definitely_valid)=@_;
4341 0 0         $definitely_valid = 0 if not defined $definitely_valid;
4342 0           my($ym,$md,$dh,$hmn,$mns)=();
4343 0           my($y)='(\d{4})';
4344 0           my($m)='(0[1-9]|1[0-2])';
4345 0           my($d)='(0[1-9]|[1-2][0-9]|3[0-1])';
4346 0           my($h)='([0-1][0-9]|2[0-3])';
4347 0           my($mn)='([0-5][0-9])';
4348 0           my($s)=$mn;
4349              
4350 0 0         if ($Cnf{"Internal"} == 0) {
    0          
    0          
4351 0           $ym=$md=$dh="";
4352 0           $hmn=$mns=":";
4353              
4354             } elsif ($Cnf{"Internal"} == 1) {
4355 0           $ym=$md=$dh=$hmn=$mns="";
4356              
4357             } elsif ($Cnf{"Internal"} == 2) {
4358 0           $ym=$md="-";
4359 0           $dh=" ";
4360 0           $hmn=$mns=":";
4361              
4362             } else {
4363 0           confess "ERROR: Invalid internal format in _Date_Split.\n";
4364             }
4365              
4366 0           my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$";
4367              
4368 0 0 0       if (not defined $date or $date eq '') {
4369 0 0         if ($definitely_valid) {
4370 0           die "bad date '$date'";
4371             } else {
4372 0           return $t;
4373             }
4374             }
4375              
4376 0 0         if ($date =~ /$t/) {
4377 0           ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
4378 0           my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4379 0 0         $d_in_m[2]=29 if (Date_LeapYear($y));
4380 0 0         if ($d>$d_in_m[$m]) {
4381 0           my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
4382 0 0         if ($definitely_valid) {
4383 0           die $msg;
4384             }
4385             else {
4386 0           warn $msg;
4387 0           return ();
4388             }
4389             }
4390 0           return ($y,$m,$d,$h,$mn,$s);
4391             }
4392              
4393 0 0         if ($definitely_valid) {
4394 0           die "invalid date $date: doesn't match regexp $t";
4395             }
4396 0           return ();
4397             }
4398              
4399             # This returns the date easter occurs on for a given year as ($month,$day).
4400             # This is from the Calendar FAQ.
4401             sub _Date_Easter {
4402 0     0     my($y)=@_;
4403 0 0         $y=_Date_FixYear($y) if (length($y)==2);
4404              
4405 0           my($c) = $y/100;
4406 0           my($g) = $y % 19;
4407 0           my($k) = ($c-17)/25;
4408 0           my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30;
4409 0           $i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11));
4410 0           my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7;
4411 0           my($l) = $i-$j;
4412 0           my($m) = 3 + ($l+40)/44;
4413 0           my($d) = $l + 28 - 31*($m/4);
4414 0           return ($m,$d);
4415             }
4416              
4417             # This takes a list of years, months, WeekOfMonth's, and DayOfWeek's, and
4418             # returns a list of dates. Optionally, a list of dates can be passed in as
4419             # the 1st argument (with the 2nd argument the null list) and the year/month
4420             # of these will be used.
4421             sub _Date_Recur_WoM {
4422 0     0     my($y,$m,$w,$d)=@_;
4423 0           my(@y)=@$y;
4424 0           my(@m)=@$m;
4425 0           my(@w)=@$w;
4426 0           my(@d)=@$d;
4427 0           my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
4428              
4429 0 0         if (@m) {
4430 0           foreach $m (@m) {
4431 0 0         return () if (! _IsInt($m,1,12));
4432             }
4433              
4434 0           @tmp=@tmp2=();
4435 0           foreach $y (@y) {
4436 0           foreach $m (@m) {
4437 0           push(@tmp,$y);
4438 0           push(@tmp2,$m);
4439             }
4440             }
4441              
4442 0           @y=@tmp;
4443 0           @m=@tmp2;
4444              
4445             } else {
4446 0           foreach $d0 (@y) {
4447 0           @tmp=_Date_Split($d0);
4448 0 0         return () if (! @tmp);
4449 0           push(@tmp2,$tmp[0]);
4450 0           push(@m,$tmp[1]);
4451             }
4452 0           @y=@tmp2;
4453             }
4454              
4455 0 0         return () if (! @w);
4456 0           foreach $w (@w) {
4457 0 0 0       return () if ($w==0 || ! _IsInt($w,-5,5));
4458             }
4459              
4460 0 0         if (@d) {
4461 0           foreach $d (@d) {
4462 0 0 0       return () if ($d==0 || ! _IsInt($d,-7,7));
4463 0 0         $d += 8 if ($d < 0);
4464             }
4465             }
4466              
4467 0           @date=();
4468 0           foreach $y (@y) {
4469 0           $m=shift(@m);
4470              
4471             # Find 1st day of this month and next month
4472 0           $date0=_Date_Join($y,$m,1,0,0,0);
4473 0           $date1=_DateCalc_DateDelta($date0,"+0:1:0:0:0:0:0");
4474              
4475 0           foreach $d (@d) {
4476             # Find 1st occurrence of DOW (in both months)
4477 0           $d0=Date_GetNext($date0,$d,1);
4478 0           $d1=Date_GetNext($date1,$d,1);
4479              
4480 0           @tmp=();
4481 0           while (Date_Cmp($d0,$d1)<0) {
4482 0           push(@tmp,$d0);
4483 0           $d0=_DateCalc_DateDelta($d0,"+0:0:1:0:0:0:0");
4484             }
4485              
4486 0           @tmp2=();
4487 0           foreach $w (@w) {
4488 0 0         if ($w>0) {
4489 0 0         next if ($w > $#tmp+1);
4490 0           push(@tmp2,$tmp[$w-1]);
4491             } else {
4492 0 0         next if (-$w > $#tmp+1);
4493 0           push(@tmp2,$tmp[$#tmp+1+$w]);
4494             }
4495             }
4496 0           @tmp2=sort { Date_Cmp($a,$b) } @tmp2;
  0            
4497 0           push(@date,@tmp2);
4498             }
4499             }
4500              
4501 0           @date;
4502             }
4503              
4504             # This returns a sorted list of dates formed by adding/subtracting
4505             # $delta to $dateb in the range $date0<=$d<$dateb. The first date in
4506             # the list is actually the first date<$date0 and the last date in the
4507             # list is the first date>=$date1 (because sometimes the set part will
4508             # move the date back into the range).
4509             sub _Date_Recur {
4510 0     0     my($date0,$date1,$dateb,$delta)=@_;
4511 0           my(@ret,$d)=();
4512              
4513 0           while (Date_Cmp($dateb,$date0)<0) {
4514 0           $dateb=_DateCalc_DateDelta($dateb,$delta);
4515             }
4516 0           while (Date_Cmp($dateb,$date1)>=0) {
4517 0           $dateb=_DateCalc_DateDelta($dateb,"-$delta");
4518             }
4519              
4520             # Add the dates $date0..$dateb
4521 0           $d=$dateb;
4522 0           while (Date_Cmp($d,$date0)>=0) {
4523 0           unshift(@ret,$d);
4524 0           $d=_DateCalc_DateDelta($d,"-$delta");
4525             }
4526             # Add the first date earler than the range
4527 0           unshift(@ret,$d);
4528              
4529             # Add the dates $dateb..$date1
4530 0           $d=_DateCalc_DateDelta($dateb,$delta);
4531 0           while (Date_Cmp($d,$date1)<0) {
4532 0           push(@ret,$d);
4533 0           $d=_DateCalc_DateDelta($d,$delta);
4534             }
4535             # Add the first date later than the range
4536 0           push(@ret,$d);
4537              
4538 0           @ret;
4539             }
4540              
4541             # This sets the values in each date of a recurrence.
4542             #
4543             # $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1",
4544             # they are not set (and none of the larger elements are set).
4545             sub _Date_RecurSetTime {
4546 0     0     my($date0,$date1,$dates,$h,$m,$s)=@_;
4547 0           my(@dates)=@$dates;
4548 0           my(@h,@m,@s,$date,@tmp)=();
4549              
4550 0 0         $m="-1" if ($s eq "-1");
4551 0 0         $h="-1" if ($m eq "-1");
4552              
4553 0 0         if ($h ne "-1") {
4554 0           @h=_ReturnList($h);
4555 0 0         return () if ! (@h);
4556 0           @h=sort { $a<=>$b } (@h);
  0            
4557              
4558 0           @tmp=();
4559 0           foreach $date (@dates) {
4560 0           foreach $h (@h) {
4561 0           push(@tmp,Date_SetDateField($date,"h",$h,1));
4562             }
4563             }
4564 0           @dates=@tmp;
4565             }
4566              
4567 0 0         if ($m ne "-1") {
4568 0           @m=_ReturnList($m);
4569 0 0         return () if ! (@m);
4570 0           @m=sort { $a<=>$b } (@m);
  0            
4571              
4572 0           @tmp=();
4573 0           foreach $date (@dates) {
4574 0           foreach $m (@m) {
4575 0           push(@tmp,Date_SetDateField($date,"mn",$m,1));
4576             }
4577             }
4578 0           @dates=@tmp;
4579             }
4580              
4581 0 0         if ($s ne "-1") {
4582 0           @s=_ReturnList($s);
4583 0 0         return () if ! (@s);
4584 0           @s=sort { $a<=>$b } (@s);
  0            
4585              
4586 0           @tmp=();
4587 0           foreach $date (@dates) {
4588 0           foreach $s (@s) {
4589 0           push(@tmp,Date_SetDateField($date,"s",$s,1));
4590             }
4591             }
4592 0           @dates=@tmp;
4593             }
4594              
4595 0           @tmp=();
4596 0           foreach $date (@dates) {
4597 0 0 0       push(@tmp,$date) if (Date_Cmp($date,$date0)>=0 &&
      0        
4598             Date_Cmp($date,$date1)<0 &&
4599             _Date_Split($date));
4600             }
4601              
4602 0           @tmp;
4603             }
4604              
4605             sub _DateCalc_DateDate {
4606 0 0   0     print "DEBUG: _DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
4607 0           my($D1,$D2,$mode)=@_;
4608 0           my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4609 0 0         $mode=0 if (! defined $mode);
4610              
4611             # Exact mode
4612 0 0         if ($mode==0) {
4613 0           my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($D1, 1);
4614 0           my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($D2, 1);
4615 0           my($i,@delta,$d,$delta,$y)=();
4616              
4617             # form the delta for hour/min/sec
4618 0           $delta[4]=$h2-$h1;
4619 0           $delta[5]=$mn2-$mn1;
4620 0           $delta[6]=$s2-$s1;
4621              
4622             # form the delta for yr/mon/day
4623 0           $delta[0]=$delta[1]=0;
4624 0           $d=0;
4625 0 0         if ($y2>$y1) {
    0          
4626 0           $d=Date_DaysInYear($y1) - Date_DayOfYear($m1,$d1,$y1);
4627 0           $d+=Date_DayOfYear($m2,$d2,$y2);
4628 0           for ($y=$y1+1; $y<$y2; $y++) {
4629 0           $d+= Date_DaysInYear($y);
4630             }
4631             } elsif ($y2<$y1) {
4632 0           $d=Date_DaysInYear($y2) - Date_DayOfYear($m2,$d2,$y2);
4633 0           $d+=Date_DayOfYear($m1,$d1,$y1);
4634 0           for ($y=$y2+1; $y<$y1; $y++) {
4635 0           $d+= Date_DaysInYear($y);
4636             }
4637 0           $d *= -1;
4638             } else {
4639 0           $d=Date_DayOfYear($m2,$d2,$y2) - Date_DayOfYear($m1,$d1,$y1);
4640             }
4641 0           $delta[2]=0;
4642 0           $delta[3]=$d;
4643              
4644 0           for ($i=0; $i<7; $i++) {
4645 0 0         $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4646             }
4647              
4648 0           $delta=join(":",@delta);
4649 0           $delta=_Delta_Normalize($delta,0);
4650 0           return $delta;
4651             }
4652              
4653 0           my($date1,$date2)=($D1,$D2);
4654 0           my($tmp,$sign,$err,@tmp)=();
4655              
4656             # make sure both are work days
4657 0 0 0       if ($mode==2 || $mode==3) {
4658 0           $date1=Date_NextWorkDay($date1,0,1);
4659 0           $date2=Date_NextWorkDay($date2,0,1);
4660             }
4661              
4662             # make sure date1 comes before date2
4663 0 0         if (Date_Cmp($date1,$date2)>0) {
4664 0           $sign="-";
4665 0           $tmp=$date1;
4666 0           $date1=$date2;
4667 0           $date2=$tmp;
4668             } else {
4669 0           $sign="+";
4670             }
4671 0 0         if (Date_Cmp($date1,$date2)==0) {
4672 0 0         return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
4673 0           return "+0:0:0:0:0:0:0";
4674             }
4675              
4676 0           my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($date1, 1);
4677 0           my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($date2, 1);
4678 0           my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0);
4679              
4680 0 0         if ($mode != 3) {
4681              
4682             # Do years
4683 0           $dy=$y2-$y1;
4684 0           $dm=0;
4685 0 0         if ($dy>0) {
4686 0           $tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0);
4687 0 0         if (Date_Cmp($tmp,$date2)>0) {
4688 0           $dy--;
4689 0           $tmp=$date1;
4690 0 0         $tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0)
4691             if ($dy>0);
4692 0           $dm=12;
4693             }
4694 0           $date1=$tmp;
4695             }
4696              
4697             # Do months
4698 0           $dm+=$m2-$m1;
4699 0 0         if ($dm>0) {
4700 0           $tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0);
4701 0 0         if (Date_Cmp($tmp,$date2)>0) {
4702 0           $dm--;
4703 0           $tmp=$date1;
4704 0 0         $tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0)
4705             if ($dm>0);
4706             }
4707 0           $date1=$tmp;
4708             }
4709              
4710             # At this point, check to see that we're on a business day again so that
4711             # Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month
4712 0 0         if ($mode==2) {
4713 0 0         if (! Date_IsWorkDay($date1,0)) {
4714 0           $date1=Date_NextWorkDay($date1,0,1);
4715             }
4716             }
4717             }
4718              
4719             # Do days
4720 0 0 0       if ($mode==2 || $mode==3) {
4721 0           $dd=0;
4722 0           while (1) {
4723 0           $tmp=Date_NextWorkDay($date1,1,1);
4724 0 0         if (Date_Cmp($tmp,$date2)<=0) {
4725 0           $dd++;
4726 0           $date1=$tmp;
4727             } else {
4728 0           last;
4729             }
4730             }
4731              
4732             } else {
4733 0           ($y1,$m1,$d1)=( _Date_Split($date1, 1) )[0..2];
4734 0           $dd=0;
4735             # If we're jumping across months, set $d1 to the first of the next month
4736             # (or possibly the 0th of next month which is equivalent to the last day
4737             # of this month)
4738 0 0         if ($m1!=$m2) {
4739 0 0         $d_in_m[2]=29 if (Date_LeapYear($y1));
4740 0           $dd=$d_in_m[$m1]-$d1+1;
4741 0           $d1=1;
4742 0           $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4743 0 0         if (Date_Cmp($tmp,$date2)>0) {
4744 0           $dd--;
4745 0           $d1--;
4746 0           $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
4747             }
4748 0           $date1=$tmp;
4749             }
4750              
4751 0           $ddd=0;
4752 0 0         if ($d1<$d2) {
4753 0           $ddd=$d2-$d1;
4754 0           $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4755 0 0         if (Date_Cmp($tmp,$date2)>0) {
4756 0           $ddd--;
4757 0           $tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
4758             }
4759 0           $date1=$tmp;
4760             }
4761 0           $dd+=$ddd;
4762             }
4763              
4764             # in business mode, make sure h1 comes before h2 (if not find delta between
4765             # now and end of day and move to start of next business day)
4766 0           $d1=( _Date_Split($date1, 1) )[2];
4767 0           $dh=$dmn=$ds=0;
4768 0 0 0       if ($mode==2 || $mode==3 and $d1 != $d2) {
      0        
4769 0           $tmp=Date_SetTime($date1,$Cnf{"WorkDayEnd"});
4770             $tmp=_DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0")
4771 0 0         if ($Cnf{"WorkDay24Hr"});
4772 0           $tmp=_DateCalc_DateDate($date1,$tmp,0);
4773 0           ($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=_Delta_Split($tmp);
4774 0           $date1=Date_NextWorkDay($date1,1,0);
4775 0           $date1=Date_SetTime($date1,$Cnf{"WorkDayBeg"});
4776 0           $d1=( _Date_Split($date1, 1) )[2];
4777 0 0         confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2);
4778             }
4779              
4780             # Hours, minutes, seconds
4781 0           $tmp=_DateCalc_DateDate($date1,$date2,0);
4782 0           @tmp=_Delta_Split($tmp);
4783 0           $dh += $tmp[4];
4784 0           $dmn += $tmp[5];
4785 0           $ds += $tmp[6];
4786              
4787 0           $tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds";
4788 0           _Delta_Normalize($tmp,$mode);
4789             }
4790              
4791             sub _DateCalc_DeltaDelta {
4792 0 0   0     print "DEBUG: _DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/);
4793 0           my($D1,$D2,$mode)=@_;
4794 0           my(@delta1,@delta2,$i,$delta,@delta)=();
4795 0 0         $mode=0 if (! defined $mode);
4796              
4797 0           @delta1=_Delta_Split($D1);
4798 0           @delta2=_Delta_Split($D2);
4799 0           for ($i=0; $i<7; $i++) {
4800 0           $delta[$i]=$delta1[$i]+$delta2[$i];
4801 0 0         $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
4802             }
4803              
4804 0           $delta=join(":",@delta);
4805 0           $delta=_Delta_Normalize($delta,$mode);
4806 0           return $delta;
4807             }
4808              
4809             sub _DateCalc_DateDelta {
4810 0 0   0     print "DEBUG: _DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
4811 0           my($D1,$D2,$errref,$mode)=@_;
4812 0           my($date)=();
4813 0           my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
4814 0           my($h1,$m1,$h2,$m2,$len,$hh,$mm)=();
4815 0 0         $mode=0 if (! defined $mode);
4816              
4817 0 0 0       if ($mode==2 || $mode==3) {
4818 0           $h1=$Curr{"WDBh"};
4819 0           $m1=$Curr{"WDBm"};
4820 0           $h2=$Curr{"WDEh"};
4821 0           $m2=$Curr{"WDEm"};
4822 0           $hh=$h2-$h1;
4823 0           $mm=$m2-$m1;
4824 0 0         if ($mm<0) {
4825 0           $hh--;
4826 0           $mm+=60;
4827             }
4828             }
4829              
4830             # Date, delta
4831 0           my($y,$m,$d,$h,$mn,$s)=_Date_Split($D1, 1);
4832 0           my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=_Delta_Split($D2);
4833              
4834             # do the month/year part
4835 0           $y+=$dy;
4836 0           while (length($y)<4) {
4837 0           $y = "0$y";
4838             }
4839 0           _ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11
4840 0 0         $d_in_m[2]=29 if (Date_LeapYear($y));
4841              
4842             # if we have gone past the last day of a month, move the date back to
4843             # the last day of the month
4844 0 0         if ($d>$d_in_m[$m]) {
4845 0           $d=$d_in_m[$m];
4846             }
4847              
4848             # do the week part
4849 0 0 0       if ($mode==0 || $mode==1) {
4850 0           $dd += $dw*7;
4851             } else {
4852 0           $date=_DateCalc_DateDelta(_Date_Join($y,$m,$d,$h,$mn,$s),
4853             "+0:0:$dw:0:0:0:0",0);
4854 0           ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
4855             }
4856              
4857             # in business mode, set the day to a work day at this point so the h/mn/s
4858             # stuff will work out
4859 0 0 0       if ($mode==2 || $mode==3) {
4860 0 0         $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
4861 0           $date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),0,1);
4862 0           ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
4863             }
4864              
4865             # seconds, minutes, hours
4866 0           _ModuloAddition(60,$ds,\$s,\$mn);
4867 0 0 0       if ($mode==2 || $mode==3) {
4868 0           while (1) {
4869 0           _ModuloAddition(60,$dmn,\$mn,\$h);
4870 0           $dmn=0;
4871 0           $h+= $dh;
4872              
4873 0 0 0       if ($h>$h2 or $h==$h2 && $mn>$m2) {
    0 0        
    0 0        
      0        
      0        
4874 0           $dh=$h-$h2;
4875 0           $dmn=$mn-$m2;
4876 0           $h=$h1;
4877 0           $mn=$m1;
4878 0           $dd++;
4879              
4880             } elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
4881 0           $dh=$h-$h1;
4882             #$dmn=$m1-$mn;
4883 0           $h=$h2;
4884             #$mn=$m2;
4885 0           $dd--;
4886              
4887             } elsif ($h==$h2 && $mn==$m2) {
4888 0           $dd++;
4889 0           $dh=-$hh;
4890 0           $dmn=-$mm;
4891              
4892             } else {
4893 0           last;
4894             }
4895             }
4896              
4897             } else {
4898 0           _ModuloAddition(60,$dmn,\$mn,\$h);
4899 0           _ModuloAddition(24,$dh,\$h,\$d);
4900             }
4901              
4902             # If we have just gone past the last day of the month, we need to make
4903             # up for this:
4904 0 0         if ($d>$d_in_m[$m]) {
4905 0           $dd+= $d-$d_in_m[$m];
4906 0           $d=$d_in_m[$m];
4907             }
4908              
4909             # days
4910 0 0 0       if ($mode==2 || $mode==3) {
4911 0 0         if ($dd>=0) {
4912 0           $date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),$dd,1);
4913             } else {
4914 0           $date=Date_PrevWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1);
4915             }
4916 0           ($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1);
4917              
4918             } else {
4919 0 0         $d_in_m[2]=29 if (Date_LeapYear($y));
4920 0 0         $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
4921 0           $d += $dd;
4922 0           while ($d<1) {
4923 0           $m--;
4924 0 0         if ($m==0) {
4925 0           $m=12;
4926 0           $y--;
4927 0           while (length($y)<4) {
4928 0           $y="0$y"
4929             }
4930 0 0         if (Date_LeapYear($y)) {
4931 0           $d_in_m[2]=29;
4932             } else {
4933 0           $d_in_m[2]=28;
4934             }
4935             }
4936 0           $d += $d_in_m[$m];
4937             }
4938 0           while ($d>$d_in_m[$m]) {
4939 0           $d -= $d_in_m[$m];
4940 0           $m++;
4941 0 0         if ($m==13) {
4942 0           $m=1;
4943 0           $y++;
4944 0           while (length($y)<4) {
4945 0           $y="0$y"
4946             }
4947 0 0         if (Date_LeapYear($y)) {
4948 0           $d_in_m[2]=29;
4949             } else {
4950 0           $d_in_m[2]=28;
4951             }
4952             }
4953             }
4954             }
4955              
4956 0 0 0       if ($y<0 or $y>9999) {
4957 0           $$errref=3;
4958 0           return;
4959             }
4960 0           _Date_Join($y,$m,$d,$h,$mn,$s);
4961             }
4962              
4963             sub _Date_UpdateHolidays {
4964 0 0   0     print "DEBUG: _Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
4965 0           my($year)=@_;
4966 0           $Holiday{"year"}=$year;
4967 0           $Holiday{"dates"}{$year}={};
4968              
4969 0           my($date,$delta,$err)=();
4970 0           my($key,@tmp,$tmp);
4971              
4972 0           foreach $key (keys %{ $Holiday{"desc"} }) {
  0            
4973 0           @tmp=_Recur_Split($key);
4974 0 0         if (@tmp) {
    0          
4975 0           $tmp=ParseDateString("${year}010100:00:00");
4976 0           ($date)=ParseRecur($key,$tmp,$tmp,($year+1)."-01-01");
4977 0 0         next if (! $date);
4978              
4979             } elsif ($key =~ /^(.*)([+-].*)$/) {
4980             # Date +/- Delta
4981 0           ($date,$delta)=($1,$2);
4982 0           $tmp=ParseDateString("$date $year");
4983 0 0         if ($tmp) {
4984 0           $date=$tmp;
4985             } else {
4986 0           $date=ParseDateString($date);
4987 0 0         next if ($date !~ /^$year/);
4988             }
4989 0           $date=DateCalc($date,$delta,\$err,0);
4990              
4991             } else {
4992             # Date
4993 0           $date=$key;
4994 0           $tmp=ParseDateString("$date $year");
4995 0 0         if ($tmp) {
4996 0           $date=$tmp;
4997             } else {
4998 0           $date=ParseDateString($date);
4999 0 0         next if ($date !~ /^$year/);
5000             }
5001             }
5002 0           $Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key};
5003             }
5004             }
5005              
5006             # This sets a Date::Manip config variable.
5007             sub _Date_SetConfigVariable {
5008 0 0   0     print "DEBUG: _Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/);
5009 0           my($var,$val)=@_;
5010              
5011             # These are most appropriate for command line options instead of in files.
5012 0 0         $Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i);
5013 0 0         $Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i);
5014 0 0         $Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i);
5015 0 0         EraseHolidays(), return if ($var =~ /^EraseHolidays$/i);
5016 0 0         $Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i);
5017 0 0         $Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i);
5018              
5019             $Curr{"InitLang"}=1,
5020 0 0         $Cnf{"Language"}=$val, return if ($var =~ /^Language$/i);
5021 0 0         $Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i);
5022 0 0         $Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i);
5023 0 0         $Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i);
5024 0 0         $Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i);
5025 0 0         $Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i);
5026 0 0         $Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i);
5027 0 0         $Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i);
5028             $Cnf{"WorkDayBeg"}=$val,
5029 0 0         $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
5030             $Cnf{"WorkDayEnd"}=$val,
5031 0 0         $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i);
5032             $Cnf{"WorkDay24Hr"}=$val,
5033 0 0         $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i);
5034 0 0         $Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i);
5035 0 0         $Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i);
5036 0 0         $Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i);
5037 0 0         $Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i);
5038 0 0         $Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i);
5039 0 0         $Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i);
5040 0 0         $Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i);
5041 0 0         $Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i);
5042 0 0         $Cnf{"TodayIsMidnight"}=$val, return if ($var =~ /^TodayIsMidnight$/i);
5043              
5044 0           confess "ERROR: Unknown configuration variable $var in Date::Manip.\n";
5045             }
5046              
5047             sub EraseHolidays {
5048 0 0   0 1   print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
5049              
5050 0           $Cnf{"EraseHolidays"}=0;
5051 0           delete $Holiday{"list"};
5052 0           $Holiday{"list"}={};
5053 0           delete $Holiday{"desc"};
5054 0           $Holiday{"desc"}={};
5055 0           $Holiday{"dates"}={};
5056             }
5057              
5058             # This returns a pointer to a list of times and events in the format
5059             # [ date [ events ], date, [ events ], ... ]
5060             # where each list of events are events that are in effect at the date
5061             # immediately preceding the list.
5062             #
5063             # This takes either one date or two dates as arguments.
5064             sub _Events_Calc {
5065 0 0   0     print "DEBUG: _Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
5066              
5067 0           my($date0,$date1)=@_;
5068              
5069 0           my($tmp);
5070 0           $date0=ParseDateString($date0);
5071 0 0         return undef if (! $date0);
5072 0 0         if ($date1) {
5073 0           $date1=ParseDateString($date1);
5074 0 0         if (Date_Cmp($date0,$date1)>0) {
5075 0           $tmp=$date1;
5076 0           $date1=$date0;
5077 0           $date0=$tmp;
5078             }
5079             } else {
5080 0           $date1=_DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1");
5081             }
5082              
5083             #
5084             # [ d0,d1,del,name ] => [ d0, d1+del )
5085             # [ d0,0,del,name ] => [ d0, d0+del )
5086             #
5087 0           my(%ret,$d0,$d1,$del,$name,$c0,$c1);
5088 0           my(@tmp)=@{ $Events{"dates"} };
  0            
5089 0           DATE: while (@tmp) {
5090 0           ($d0,$d1,$del,$name)=splice(@tmp,0,4);
5091 0           $d0=ParseDateString($d0);
5092 0 0         $d1=ParseDateString($d1) if ($d1);
5093 0 0         $del=ParseDateDelta($del) if ($del);
5094 0 0         if ($d1) {
5095 0 0         if ($del) {
5096 0           $d1=_DateCalc_DateDelta($d1,$del);
5097             }
5098             } else {
5099 0           $d1=_DateCalc_DateDelta($d0,$del);
5100             }
5101 0 0         if (Date_Cmp($d0,$d1)>0) {
5102 0           $tmp=$d1;
5103 0           $d1=$d0;
5104 0           $d0=$tmp;
5105             }
5106             # [ date0,date1 )
5107             # [ d0,d1 ) OR [ d0,d1 )
5108 0 0 0       next DATE if (Date_Cmp($d1,$date0)<=0 ||
5109             Date_Cmp($d0,$date1)>=0);
5110             # [ date0,date1 )
5111             # [ d0,d1 )
5112             # [ d0, d1 )
5113 0 0         if (Date_Cmp($d0,$date0)<=0) {
5114 0           push @{ $ret{$date0} },$name;
  0            
5115 0 0         push @{ $ret{$d1} },"!$name" if (Date_Cmp($d1,$date1)<0);
  0            
5116 0           next DATE;
5117             }
5118             # [ date0,date1 )
5119             # [ d0,d1 )
5120 0 0         if (Date_Cmp($d1,$date1)>=0) {
5121 0           push @{ $ret{$d0} },$name;
  0            
5122 0           next DATE;
5123             }
5124             # [ date0,date1 )
5125             # [ d0,d1 )
5126 0           push @{ $ret{$d0} },$name;
  0            
5127 0           push @{ $ret{$d1} },"!$name";
  0            
5128             }
5129              
5130             #
5131             # [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
5132             #
5133 0           my($rec,$del0,$del1,@d);
5134 0           @tmp=@{ $Events{"recur"} };
  0            
5135 0           RECUR: while (@tmp) {
5136 0           ($rec,$del0,$del1,$name)=splice(@tmp,0,4);
5137 0           @d=();
5138              
5139             }
5140              
5141             # Sort them AND take into account the "!$name" entries.
5142 0           my(%tmp,$date,@tmp2,@ret);
5143 0           @d=sort { Date_Cmp($a,$b) } keys %ret;
  0            
5144 0           foreach $date (@d) {
5145 0           @tmp=@{ $ret{$date} };
  0            
5146 0           @tmp2=();
5147 0           foreach $tmp (@tmp) {
5148 0 0         push(@tmp2,$tmp), next if ($tmp =~ /^!/);
5149 0           $tmp{$tmp}=1;
5150             }
5151 0           foreach $tmp (@tmp2) {
5152 0           $tmp =~ s/^!//;
5153 0           delete $tmp{$tmp};
5154             }
5155 0           push(@ret,$date,[ keys %tmp ]);
5156             }
5157              
5158 0           %tmp = @ret;
5159 0           @ret = ();
5160 0           foreach my $d (sort { Date_Cmp($a,$b) } keys %tmp) {
  0            
5161 0           my $e = $tmp{$d};
5162 0           push @ret,($d,[ sort @$e ]);
5163             }
5164 0           return \@ret;
5165             }
5166              
5167             # This parses the raw events list
5168             sub _Events_ParseRaw {
5169 0 0   0     print "DEBUG: _Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
5170              
5171             # Only need to be parsed once
5172 0           my($force)=@_;
5173 0 0         $Events{"parsed"}=0 if ($force);
5174 0 0         return if ($Events{"parsed"});
5175 0           $Events{"parsed"}=1;
5176              
5177 0           my(@events)=@{ $Events{"raw"} };
  0            
5178 0           my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
5179             $recur);
5180 0           EVENT: while (@events) {
5181 0           ($event,$name)=splice(@events,0,2);
5182 0           @event=split(/\s*;\s*/,$event);
5183              
5184 0 0         if ($#event == 0) {
    0          
5185              
5186 0 0         if ($date0=ParseDateString($event[0])) {
    0          
5187             #
5188             # date = event
5189             #
5190 0           $tmp=ParseDateString("$event[0] 00:00:00");
5191 0 0 0       if ($tmp && $tmp eq $date0) {
5192 0           $delta="+0:0:0:1:0:0:0";
5193             } else {
5194 0           $delta="+0:0:0:0:1:0:0";
5195             }
5196 0           push @{ $Events{"dates"} },($date0,0,$delta,$name);
  0            
5197              
5198             } elsif ($recur=ParseRecur($event[0])) {
5199             #
5200             # recur = event
5201             #
5202 0           ($recur0,$recur1)=_Recur_Split($recur);
5203 0 0         if ($recur0) {
5204 0 0         if ($recur1) {
5205 0           $r="$recur0:$recur1";
5206             } else {
5207 0           $r=$recur0;
5208             }
5209             } else {
5210 0           $r=$recur1;
5211             }
5212 0           (@recur)=split(/:/,$r);
5213 0 0 0       if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
      0        
5214 0           $delta="+0:0:0:1:0:0:0";
5215             } else {
5216 0           $delta="+0:0:0:0:1:0:0";
5217             }
5218 0           push @{ $Events{"recur"} },($recur,0,$delta,$name);
  0            
5219              
5220             } else {
5221             # ??? = event
5222 0           warn "WARNING: illegal event ignored [ @event ]\n";
5223 0           next EVENT;
5224             }
5225              
5226             } elsif ($#event == 1) {
5227              
5228 0 0         if ($date0=ParseDateString($event[0])) {
    0          
5229              
5230 0 0         if ($date1=ParseDateString($event[1])) {
    0          
5231             #
5232             # date ; date = event
5233             #
5234 0           $tmp=ParseDateString("$event[1] 00:00:00");
5235 0 0 0       if ($tmp && $tmp eq $date1) {
5236 0           $date1=_DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0");
5237             }
5238 0           push @{ $Events{"dates"} },($date0,$date1,0,$name);
  0            
5239              
5240             } elsif ($delta=ParseDateDelta($event[1])) {
5241             #
5242             # date ; delta = event
5243             #
5244 0           push @{ $Events{"dates"} },($date0,0,$delta,$name);
  0            
5245              
5246             } else {
5247             # date ; ??? = event
5248 0           warn "WARNING: illegal event ignored [ @event ]\n";
5249 0           next EVENT;
5250             }
5251              
5252             } elsif ($recur=ParseRecur($event[0])) {
5253              
5254 0 0         if ($delta=ParseDateDelta($event[1])) {
5255             #
5256             # recur ; delta = event
5257             #
5258 0           push @{ $Events{"recur"} },($recur,0,$delta,$name);
  0            
5259              
5260             } else {
5261             # recur ; ??? = event
5262 0           warn "WARNING: illegal event ignored [ @event ]\n";
5263 0           next EVENT;
5264             }
5265              
5266             } else {
5267             # ??? ; ??? = event
5268 0           warn "WARNING: illegal event ignored [ @event ]\n";
5269 0           next EVENT;
5270             }
5271              
5272             } else {
5273             # date ; delta0 ; delta1 = event
5274             # recur ; delta0 ; delta1 = event
5275             # ??? ; ??? ; ??? ... = event
5276 0           warn "WARNING: illegal event ignored [ @event ]\n";
5277 0           next EVENT;
5278             }
5279             }
5280             }
5281              
5282             # This reads an init file.
5283             sub _Date_InitFile {
5284 0 0   0     print "DEBUG: _Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
5285 0           my($file)=@_;
5286 0           my($in)=new IO::File;
5287 0           local($_)=();
5288 0           my($section)="vars";
5289 0           my($var,$val,$recur,$name)=();
5290              
5291 0 0         $in->open($file) || return;
5292 0           while(defined ($_=<$in>)) {
5293 0           chomp;
5294 0           s/^\s+//;
5295 0           s/\s+$//;
5296 0 0 0       next if ($_ eq '' or /^\#/);
5297              
5298 0 0         if (/^\*holiday/i) {
    0          
5299 0           $section="holiday";
5300 0 0 0       EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
5301 0           next;
5302             } elsif (/^\*events/i) {
5303 0           $section="events";
5304 0           next;
5305             }
5306              
5307 0 0         if ($section =~ /var/i) {
    0          
    0          
5308 0 0         confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5309             if (! /(.*\S)\s*=\s*(.*)$/);
5310 0           ($var,$val)=($1,$2);
5311 0           _Date_SetConfigVariable($var,$val);
5312              
5313             } elsif ($section =~ /holiday/i) {
5314 0 0         confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5315             if (! /(.*\S)\s*=\s*(.*)$/);
5316 0           ($recur,$name)=($1,$2);
5317 0 0         $name="" if (! defined $name);
5318 0           $Holiday{"desc"}{$recur}=$name;
5319              
5320             } elsif ($section =~ /events/i) {
5321 0 0         confess "ERROR: invalid Date::Manip config file line.\n $_\n"
5322             if (! /(.*\S)\s*=\s*(.*)$/);
5323 0           ($val,$var)=($1,$2);
5324 0           push @{ $Events{"raw"} },($val,$var);
  0            
5325              
5326             } else {
5327             # A section not currently used by Date::Manip (but may be
5328             # used by some extension to it).
5329 0           next;
5330             }
5331             }
5332 0           close($in);
5333             }
5334              
5335             # $flag=_Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
5336             # Returns 1 if any of the fields are bad. All fields are optional, and
5337             # all possible checks are done on the data. If a field is not passed in,
5338             # it is set to default values. If data is missing, appropriate defaults
5339             # are supplied.
5340             sub _Date_TimeCheck {
5341 0 0   0     print "DEBUG: _Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
5342 0           my($h,$mn,$s,$ampm)=@_;
5343 0           my($tmp1,$tmp2,$tmp3)=();
5344              
5345 0 0         $$h="" if (! defined $$h);
5346 0 0         $$mn="" if (! defined $$mn);
5347 0 0         $$s="" if (! defined $$s);
5348 0 0         $$ampm="" if (! defined $$ampm);
5349 0 0         $$ampm=uc($$ampm) if ($$ampm);
5350              
5351             # Check hour
5352 0           $tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
5353 0           $tmp2="";
5354 0 0         if ($$ampm =~ /^$tmp1$/i) {
    0          
5355 0           $tmp3=$Lang{$Cnf{"Language"}}{"AM"};
5356 0 0         $tmp2="AM" if ($$ampm =~ /^$tmp3$/i);
5357 0           $tmp3=$Lang{$Cnf{"Language"}}{"PM"};
5358 0 0         $tmp2="PM" if ($$ampm =~ /^$tmp3$/i);
5359             } elsif ($$ampm) {
5360 0           return 1;
5361             }
5362 0 0 0       if ($tmp2 eq "AM" || $tmp2 eq "PM") {
5363 0 0         $$h="0$$h" if (length($$h)==1);
5364 0 0 0       return 1 if ($$h<1 || $$h>12);
5365 0 0 0       $$h="00" if ($tmp2 eq "AM" and $$h==12);
5366 0 0 0       $$h += 12 if ($tmp2 eq "PM" and $$h!=12);
5367             } else {
5368 0 0         $$h="00" if ($$h eq "");
5369 0 0         $$h="0$$h" if (length($$h)==1);
5370 0 0         return 1 if (! _IsInt($$h,0,23));
5371 0 0         $tmp2="AM" if ($$h<12);
5372 0 0         $tmp2="PM" if ($$h>=12);
5373             }
5374 0           $$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
5375 0 0         $$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
5376              
5377             # Check minutes
5378 0 0         $$mn="00" if ($$mn eq "");
5379 0 0         $$mn="0$$mn" if (length($$mn)==1);
5380 0 0         return 1 if (! _IsInt($$mn,0,59));
5381              
5382             # Check seconds
5383 0 0         $$s="00" if ($$s eq "");
5384 0 0         $$s="0$$s" if (length($$s)==1);
5385 0 0         return 1 if (! _IsInt($$s,0,59));
5386              
5387 0           return 0;
5388             }
5389              
5390             # $flag=_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
5391             # Returns 1 if any of the fields are bad. All fields are optional, and
5392             # all possible checks are done on the data. If a field is not passed in,
5393             # it is set to default values. If data is missing, appropriate defaults
5394             # are supplied.
5395             #
5396             # If the flag UpdateHolidays is set, the year is set to
5397             # CurrHolidayYear.
5398             sub _Date_DateCheck {
5399 0 0   0     print "DEBUG: _Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/);
5400 0           my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_;
5401 0           my($tmp1,$tmp2,$tmp3)=();
5402              
5403 0           my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
5404 0           my($curr_y)=$Curr{"Y"};
5405 0           my($curr_m)=$Curr{"M"};
5406 0           my($curr_d)=$Curr{"D"};
5407 0 0 0       $$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d);
      0        
5408 0 0         $$y="" if (! defined $$y);
5409 0 0         $$m="" if (! defined $$m);
5410 0 0         $$d="" if (! defined $$d);
5411 0 0         $$wk="" if (! defined $$wk);
5412 0 0 0       $$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq "");
      0        
5413              
5414             # Check year.
5415 0 0         $$y=$curr_y if ($$y eq "");
5416 0 0         $$y=_Date_FixYear($$y) if (length($$y)<4);
5417 0 0         return 1 if (! _IsInt($$y,0,9999));
5418 0 0         $d_in_m[2]=29 if (Date_LeapYear($$y));
5419              
5420             # Check month
5421 0 0         $$m=$curr_m if ($$m eq "");
5422             $$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}
5423 0 0         if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)});
5424 0 0         $$m="0$$m" if (length($$m)==1);
5425 0 0         return 1 if (! _IsInt($$m,1,12));
5426              
5427             # Check day
5428 0 0         $$d="01" if ($$d eq "");
5429 0 0         $$d="0$$d" if (length($$d)==1);
5430 0 0         return 1 if (! _IsInt($$d,1,$d_in_m[$$m]));
5431 0 0         if ($$wk) {
5432 0           $tmp1=Date_DayOfWeek($$m,$$d,$$y);
5433             $tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}
5434 0 0         if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)});
5435 0 0         return 1 if ($tmp1 != $tmp2);
5436             }
5437              
5438 0           return _Date_TimeCheck($h,$mn,$s,$ampm);
5439             }
5440              
5441             # Takes a year in 2 digit form and returns it in 4 digit form
5442             sub _Date_FixYear {
5443 0 0   0     print "DEBUG: _Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
5444 0           my($y)=@_;
5445 0           my($curr_y)=$Curr{"Y"};
5446 0 0 0       $y=$curr_y if (! defined $y or ! $y);
5447 0 0         return $y if (length($y)==4);
5448 0 0         confess "ERROR: Invalid year ($y)\n" if (length($y)!=2);
5449 0           my($y1,$y2)=();
5450              
5451 0 0         if (lc($Cnf{"YYtoYYYY"}) eq "c") {
    0          
    0          
5452 0           $y1=substr($y,0,2);
5453 0           $y="$y1$y";
5454              
5455             } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
5456 0           $y1=$1;
5457 0           $y="$y1$y";
5458              
5459             } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
5460 0           $y1="$1$2";
5461 0           $y ="$1$y";
5462 0 0         $y += 100 if ($y<$y1);
5463              
5464             } else {
5465 0           $y1=$curr_y-$Cnf{"YYtoYYYY"};
5466 0           $y2=$y1+99;
5467 0           $y="19$y";
5468 0           while ($y<$y1) {
5469 0           $y+=100;
5470             }
5471 0           while ($y>$y2) {
5472 0           $y-=100;
5473             }
5474             }
5475 0           $y;
5476             }
5477              
5478             # _Date_NthWeekOfYear($y,$n);
5479             # Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
5480             # year.
5481             # _Date_NthWeekOfYear($y,$n,$dow,$flag);
5482             # Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag
5483             # is nil, the first DoW of the year may actually be in the previous
5484             # year (since the 1st week may include days from the previous year).
5485             # If flag is non-nil, the 1st DoW of the year refers to the 1st one
5486             # actually in the year
5487             sub _Date_NthWeekOfYear {
5488 0 0   0     print "DEBUG: _Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
5489 0           my($y,$n,$dow,$flag)=@_;
5490 0           my($m,$d,$err,$tmp,$date,%dow)=();
5491 0 0 0       $y=$Curr{"Y"} if (! defined $y or ! $y);
5492 0 0 0       $n=1 if (! defined $n or $n eq "");
5493 0 0 0       return () if ($n<0 || $n>53);
5494 0 0         if (defined $dow) {
5495 0           $dow=lc($dow);
5496 0           %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
  0            
5497 0 0         $dow=$dow{$dow} if (exists $dow{$dow});
5498 0 0 0       return () if ($dow<1 || $dow>7);
5499 0 0         $flag="" if (! defined $flag);
5500             } else {
5501 0           $dow="";
5502 0           $flag="";
5503             }
5504              
5505 0 0         $y=_Date_FixYear($y) if (length($y)<4);
5506 0 0         if ($Cnf{"Jan1Week1"}) {
5507 0           $date=_Date_Join($y,1,1,0,0,0);
5508             } else {
5509 0           $date=_Date_Join($y,1,4,0,0,0);
5510             }
5511 0           $date=Date_GetPrev($date,$Cnf{"FirstDay"},1);
5512 0 0         $date=Date_GetNext($date,$dow,1) if ($dow ne "");
5513              
5514 0 0         if ($flag) {
5515 0           ($tmp)=_Date_Split($date, 1);
5516 0 0         $n++ if ($tmp != $y);
5517             }
5518              
5519 0 0         if ($n>1) {
    0          
5520 0           $date=_DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0);
5521             } elsif ($n==0) {
5522 0           $date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0);
5523             }
5524 0           ($y,$m,$d)=_Date_Split($date, 1);
5525 0           ($y,$m,$d);
5526             }
5527              
5528             ########################################################################
5529             # LANGUAGE INITIALIZATION
5530             ########################################################################
5531              
5532             # 8-bit international characters can be gotten by "\xXX". I don't know
5533             # how to get 16-bit characters. I've got to read up on perllocale.
5534             sub _Char_8Bit {
5535 0     0     my($hash)=@_;
5536              
5537             # grave `
5538             # A` 00c0 a` 00e0
5539             # E` 00c8 e` 00e8
5540             # I` 00cc i` 00ec
5541             # O` 00d2 o` 00f2
5542             # U` 00d9 u` 00f9
5543             # W` 1e80 w` 1e81
5544             # Y` 1ef2 y` 1ef3
5545              
5546 0           $$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE
5547 0           $$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE
5548 0           $$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE
5549 0           $$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE
5550 0           $$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE
5551 0           $$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE
5552 0           $$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE
5553 0           $$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE
5554 0           $$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE
5555 0           $$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE
5556              
5557             # acute '
5558             # A' 00c1 a' 00e1
5559             # C' 0106 c' 0107
5560             # E' 00c9 e' 00e9
5561             # I' 00cd i' 00ed
5562             # L' 0139 l' 013a
5563             # N' 0143 n' 0144
5564             # O' 00d3 o' 00f3
5565             # R' 0154 r' 0155
5566             # S' 015a s' 015b
5567             # U' 00da u' 00fa
5568             # W' 1e82 w' 1e83
5569             # Y' 00dd y' 00fd
5570             # Z' 0179 z' 017a
5571              
5572 0           $$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE
5573 0           $$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE
5574 0           $$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE
5575 0           $$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE
5576 0           $$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE
5577 0           $$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE
5578 0           $$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE
5579 0           $$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE
5580 0           $$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE
5581 0           $$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE
5582 0           $$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE
5583 0           $$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE
5584              
5585             # double acute " "
5586             # O" 0150 o" 0151
5587             # U" 0170 u" 0171
5588              
5589             # circumflex ^
5590             # A^ 00c2 a^ 00e2
5591             # C^ 0108 c^ 0109
5592             # E^ 00ca e^ 00ea
5593             # G^ 011c g^ 011d
5594             # H^ 0124 h^ 0125
5595             # I^ 00ce i^ 00ee
5596             # J^ 0134 j^ 0135
5597             # O^ 00d4 o^ 00f4
5598             # S^ 015c s^ 015d
5599             # U^ 00db u^ 00fb
5600             # W^ 0174 w^ 0175
5601             # Y^ 0176 y^ 0177
5602              
5603 0           $$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
5604 0           $$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
5605 0           $$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
5606 0           $$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
5607 0           $$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
5608 0           $$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX
5609 0           $$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX
5610 0           $$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX
5611 0           $$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX
5612 0           $$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX
5613              
5614             # tilde ~
5615             # A~ 00c3 a~ 00e3
5616             # I~ 0128 i~ 0129
5617             # N~ 00d1 n~ 00f1
5618             # O~ 00d5 o~ 00f5
5619             # U~ 0168 u~ 0169
5620              
5621 0           $$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE
5622 0           $$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE
5623 0           $$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE
5624 0           $$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE
5625 0           $$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE
5626 0           $$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE
5627              
5628             # macron -
5629             # A- 0100 a- 0101
5630             # E- 0112 e- 0113
5631             # I- 012a i- 012b
5632             # O- 014c o- 014d
5633             # U- 016a u- 016b
5634              
5635             # breve ( [half circle up]
5636             # A( 0102 a( 0103
5637             # G( 011e g( 011f
5638             # U( 016c u( 016d
5639              
5640             # dot .
5641             # C. 010a c. 010b
5642             # E. 0116 e. 0117
5643             # G. 0120 g. 0121
5644             # I. 0130
5645             # Z. 017b z. 017c
5646              
5647             # diaeresis : [side by side dots]
5648             # A: 00c4 a: 00e4
5649             # E: 00cb e: 00eb
5650             # I: 00cf i: 00ef
5651             # O: 00d6 o: 00f6
5652             # U: 00dc u: 00fc
5653             # W: 1e84 w: 1e85
5654             # Y: 0178 y: 00ff
5655              
5656 0           $$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS
5657 0           $$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS
5658 0           $$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS
5659 0           $$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS
5660 0           $$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS
5661 0           $$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS
5662 0           $$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS
5663 0           $$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS
5664 0           $$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS
5665 0           $$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS
5666 0           $$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS
5667              
5668             # ring o
5669             # U0 016e u0 016f
5670              
5671             # cedilla , [squiggle down and left below the letter]
5672             # ,C 00c7 ,c 00e7
5673             # ,G 0122 ,g 0123
5674             # ,K 0136 ,k 0137
5675             # ,L 013b ,l 013c
5676             # ,N 0145 ,n 0146
5677             # ,R 0156 ,r 0157
5678             # ,S 015e ,s 015f
5679             # ,T 0162 ,t 0163
5680              
5681 0           $$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA
5682 0           $$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA
5683              
5684             # ogonek ; [squiggle down and right below the letter]
5685             # A; 0104 a; 0105
5686             # E; 0118 e; 0119
5687             # I; 012e i; 012f
5688             # U; 0172 u; 0173
5689              
5690             # caron < [little v on top]
5691             # A< 01cd a< 01ce
5692             # C< 010c c< 010d
5693             # D< 010e d< 010f
5694             # E< 011a e< 011b
5695             # L< 013d l< 013e
5696             # N< 0147 n< 0148
5697             # R< 0158 r< 0159
5698             # S< 0160 s< 0161
5699             # T< 0164 t< 0165
5700             # Z< 017d z< 017e
5701              
5702              
5703             # Other characters
5704              
5705             # First character is below, 2nd character is above
5706 0           $$hash{"||"} = "\xa6"; # BROKEN BAR
5707 0           $$hash{" :"} = "\xa8"; # DIAERESIS
5708 0           $$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR
5709             #$$hash{" -"}= "\xaf"; # MACRON (narrow bar)
5710 0           $$hash{" -"} = "\xad"; # HYPHEN (wide bar)
5711 0           $$hash{" o"} = "\xb0"; # DEGREE SIGN
5712 0           $$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN
5713 0           $$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE
5714 0           $$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO
5715 0           $$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE
5716 0           $$hash{" '"} = "\xb4"; # ACUTE ACCENT
5717 0           $$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR
5718 0           $$hash{" ."} = "\xb7"; # MIDDLE DOT
5719 0           $$hash{", "} = "\xb8"; # CEDILLA
5720 0           $$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE
5721 0           $$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE
5722 0           $$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH
5723              
5724             # upside down characters
5725              
5726 0           $$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
5727 0           $$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
5728              
5729             # overlay characters
5730              
5731 0           $$hash{"X o"} = "\xa4"; # CURRENCY SIGN
5732 0           $$hash{"Y ="} = "\xa5"; # YEN SIGN
5733 0           $$hash{"S o"} = "\xa7"; # SECTION SIGN
5734 0           $$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright
5735 0           $$hash{"O R"} = "\xae"; # REGISTERED SIGN
5736 0           $$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH
5737 0           $$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE
5738 0           $$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE
5739              
5740             # special names
5741              
5742 0           $$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER
5743 0           $$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF
5744 0           $$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS
5745 0           $$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK
5746 0           $$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK
5747 0           $$hash{"cent"}= "\xa2"; # CENT SIGN
5748 0           $$hash{"lb"} = "\xa3"; # POUND SIGN
5749 0           $$hash{"mu"} = "\xb5"; # MICRO SIGN
5750 0           $$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S
5751 0           $$hash{"para"}= "\xb6"; # PILCROW SIGN
5752 0           $$hash{"-|"} = "\xac"; # NOT SIGN
5753 0           $$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE
5754 0           $$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE
5755 0           $$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN
5756 0           $$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN
5757 0           $$hash{"/"} = "\xf7"; # DIVISION SIGN
5758 0           $$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN
5759             }
5760              
5761             # $hashref = _Date_Init_LANGUAGE;
5762             # This returns a hash containing all of the initialization for a
5763             # specific language. The hash elements are:
5764             #
5765             # @ month_name full month names January February ...
5766             # @ month_abb month abbreviations Jan Feb ...
5767             # @ day_name day names Monday Tuesday ...
5768             # @ day_abb day abbreviations Mon Tue ...
5769             # @ day_char day character abbrevs M T ...
5770             # @ am AM notations
5771             # @ pm PM notations
5772             #
5773             # @ num_suff number with suffix 1st 2nd ...
5774             # @ num_word numbers spelled out first second ...
5775             #
5776             # $ now words which mean now now ...
5777             # $ today words which mean today today ...
5778             # $ last words which mean last last final ...
5779             # $ each words which mean each each every ...
5780             # $ of of (as in a member of) in of ...
5781             # ex. 4th day OF June
5782             # $ at at 4:00 at
5783             # $ on on Sunday on
5784             # $ future in the future in
5785             # $ past in the past ago
5786             # $ next next item next
5787             # $ prev previous item last previous
5788             # $ later 2 hours later
5789             #
5790             # % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 }
5791             # % times a hash of times { noon->12:00:00 ... }
5792             #
5793             # $ years words for year y yr year ...
5794             # $ months words for month
5795             # $ weeks words for week
5796             # $ days words for day
5797             # $ hours words for hour
5798             # $ minutes words for minute
5799             # $ seconds words for second
5800             # % replace
5801             # The replace element is quite important, but a bit tricky. In
5802             # English (and probably other languages), one of the abbreviations
5803             # for the word month that would be nice is "m". The problem is that
5804             # "m" matches the "m" in "minute" which causes the string to be
5805             # improperly matched in some cases. Hence, the list of abbreviations
5806             # for month is given as:
5807             # "mon month months"
5808             # In order to allow you to enter "m", replacements can be done.
5809             # $replace is a list of pairs of words which are matched and replaced
5810             # AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that
5811             # the entire word "m" will be replaced with "month". This allows the
5812             # desired abbreviation to be used. Make sure that replace contains
5813             # an even number of words (i.e. all must be pairs). Any time a
5814             # desired abbreviation matches the start of any other, it has to go
5815             # here.
5816             #
5817             # $ exact exact mode exactly
5818             # $ approx approximate mode approximately
5819             # $ business business mode business
5820             #
5821             # r sephm hour/minute separator (?::)
5822             # r sepms minute/second separator (?::)
5823             # r sepss second/fraction separator (?:[.:])
5824             #
5825             # Elements marked with an asterix (@) are returned as a set of lists.
5826             # Each list contains the strings for each element. The first set is used
5827             # when the 7-bit ASCII (US) character set is wanted. The 2nd set is used
5828             # when an international character set is available. Both of the 1st two
5829             # sets should be complete (but the 2nd list can be left empty to force the
5830             # first set to be used always). The 3rd set and later can be partial sets
5831             # if desired.
5832             #
5833             # Elements marked with a dollar ($) are returned as a simple list of words.
5834             #
5835             # Elements marked with a percent (%) are returned as a hash list.
5836             #
5837             # Elements marked with (r) are regular expression elements which must not
5838             # create a back reference.
5839             #
5840             # ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in
5841             # every language.
5842              
5843             sub _Date_Init_English {
5844 0 0   0     print "DEBUG: _Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
5845 0           my($d)=@_;
5846              
5847 0           $$d{"month_name"}=
5848             [["January","February","March","April","May","June",
5849             "July","August","September","October","November","December"]];
5850              
5851 0           $$d{"month_abb"}=
5852             [["Jan","Feb","Mar","Apr","May","Jun",
5853             "Jul","Aug","Sep","Oct","Nov","Dec"],
5854             [],
5855             ["","","","","","","","","Sept"]];
5856              
5857 0           $$d{"day_name"}=
5858             [["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
5859 0           $$d{"day_abb"}=
5860             [["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
5861             ["", "Tues","", "Thur","", "", ""]];
5862 0           $$d{"day_char"}=
5863             [["M","T","W","Th","F","Sa","S"]];
5864              
5865 0           $$d{"num_suff"}=
5866             [["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th",
5867             "11th","12th","13th","14th","15th","16th","17th","18th","19th","20th",
5868             "21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th",
5869             "31st"]];
5870 0           $$d{"num_word"}=
5871             [["first","second","third","fourth","fifth","sixth","seventh","eighth",
5872             "ninth","tenth","eleventh","twelfth","thirteenth","fourteenth",
5873             "fifteenth","sixteenth","seventeenth","eighteenth","nineteenth",
5874             "twentieth","twenty-first","twenty-second","twenty-third",
5875             "twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh",
5876             "twenty-eighth","twenty-ninth","thirtieth","thirty-first"]];
5877              
5878 0           $$d{"now"} =["now"];
5879 0           $$d{"today"} =["today"];
5880 0           $$d{"last"} =["last","final"];
5881 0           $$d{"each"} =["each","every"];
5882 0           $$d{"of"} =["in","of"];
5883 0           $$d{"at"} =["at"];
5884 0           $$d{"on"} =["on"];
5885 0           $$d{"future"} =["in"];
5886 0           $$d{"past"} =["ago"];
5887 0           $$d{"next"} =["next"];
5888 0           $$d{"prev"} =["previous","last"];
5889 0           $$d{"later"} =["later"];
5890              
5891 0           $$d{"exact"} =["exactly"];
5892 0           $$d{"approx"} =["approximately"];
5893 0           $$d{"business"}=["business"];
5894              
5895 0           $$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"];
5896 0           $$d{"times"} =["noon","12:00:00","midnight","00:00:00"];
5897              
5898 0           $$d{"years"} =["y","yr","year","yrs","years"];
5899 0           $$d{"months"} =["mon","month","months"];
5900 0           $$d{"weeks"} =["w","wk","wks","week","weeks"];
5901 0           $$d{"days"} =["d","day","days"];
5902 0           $$d{"hours"} =["h","hr","hrs","hour","hours"];
5903 0           $$d{"minutes"} =["mn","min","minute","minutes"];
5904 0           $$d{"seconds"} =["s","sec","second","seconds"];
5905 0           $$d{"replace"} =["m","month"];
5906              
5907 0           $$d{"sephm"} =':';
5908 0           $$d{"sepms"} =':';
5909 0           $$d{"sepss"} ='[.:]';
5910              
5911 0           $$d{"am"} = ["AM","A.M."];
5912 0           $$d{"pm"} = ["PM","P.M."];
5913             }
5914              
5915             sub _Date_Init_Italian {
5916 0 0   0     print "DEBUG: _Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
5917 0           my($d)=@_;
5918 0           my(%h)=();
5919 0           _Char_8Bit(\%h);
5920 0           my($i)=$h{"i`"};
5921              
5922 0           $$d{"month_name"}=
5923             [[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
5924             Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
5925              
5926 0           $$d{"month_abb"}=
5927             [[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
5928              
5929 0           $$d{"day_name"}=
5930             [[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
5931             [qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
5932 0           $$d{"day_abb"}=
5933             [[qw(Lun Mar Mer Gio Ven Sab Dom)]];
5934 0           $$d{"day_char"}=
5935             [[qw(L Ma Me G V S D)]];
5936              
5937 0           $$d{"num_suff"}=
5938             [[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo
5939             16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo
5940             29mo 3mo 31mo)]];
5941 0           $$d{"num_word"}=
5942             [[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo
5943             undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo
5944             sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo
5945             ventunesimo ventiduesimo ventitreesimo ventiquattresimo
5946             venticinquesimo ventiseiesimo ventisettesimo ventottesimo
5947             ventinovesimo trentesimo trentunesimo)]];
5948              
5949 0           $$d{"now"} =[qw(adesso)];
5950 0           $$d{"today"} =[qw(oggi)];
5951 0           $$d{"last"} =[qw(ultimo)];
5952 0           $$d{"each"} =[qw(ogni)];
5953 0           $$d{"of"} =[qw(della del)];
5954 0           $$d{"at"} =[qw(alle)];
5955 0           $$d{"on"} =[qw(di)];
5956 0           $$d{"future"} =[qw(fra)];
5957 0           $$d{"past"} =[qw(fa)];
5958 0           $$d{"next"} =[qw(prossimo)];
5959 0           $$d{"prev"} =[qw(ultimo)];
5960 0           $$d{"later"} =[qw(dopo)];
5961              
5962 0           $$d{"exact"} =[qw(esattamente)];
5963 0           $$d{"approx"} =[qw(circa)];
5964 0           $$d{"business"}=[qw(lavorativi lavorativo)];
5965              
5966 0           $$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)];
5967 0           $$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)];
5968              
5969 0           $$d{"years"} =[qw(anni anno a)];
5970 0           $$d{"months"} =[qw(mesi mese mes)];
5971 0           $$d{"weeks"} =[qw(settimane settimana sett)];
5972 0           $$d{"days"} =[qw(giorni giorno g)];
5973 0           $$d{"hours"} =[qw(ore ora h)];
5974 0           $$d{"minutes"} =[qw(minuti minuto min)];
5975 0           $$d{"seconds"} =[qw(secondi secondo sec)];
5976 0           $$d{"replace"} =[qw(s sec m mes)];
5977              
5978 0           $$d{"sephm"} =':';
5979 0           $$d{"sepms"} =':';
5980 0           $$d{"sepss"} ='[.:]';
5981              
5982 0           $$d{"am"} = [qw(AM)];
5983 0           $$d{"pm"} = [qw(PM)];
5984             }
5985              
5986             sub _Date_Init_French {
5987 0 0   0     print "DEBUG: _Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
5988 0           my($d)=@_;
5989 0           my(%h)=();
5990 0           _Char_8Bit(\%h);
5991 0           my($e)=$h{"e'"};
5992 0           my($u)=$h{"u^"};
5993 0           my($a)=$h{"a'"};
5994              
5995 0           $$d{"month_name"}=
5996             [["janvier","fevrier","mars","avril","mai","juin",
5997             "juillet","aout","septembre","octobre","novembre","decembre"],
5998             ["janvier","f${e}vrier","mars","avril","mai","juin",
5999             "juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]];
6000 0           $$d{"month_abb"}=
6001             [["jan","fev","mar","avr","mai","juin",
6002             "juil","aout","sept","oct","nov","dec"],
6003             ["jan","f${e}v","mar","avr","mai","juin",
6004             "juil","ao${u}t","sept","oct","nov","d${e}c"]];
6005              
6006 0           $$d{"day_name"}=
6007             [["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
6008 0           $$d{"day_abb"}=
6009             [["lun","mar","mer","jeu","ven","sam","dim"]];
6010 0           $$d{"day_char"}=
6011             [["l","ma","me","j","v","s","d"]];
6012              
6013 0           $$d{"num_suff"}=
6014             [["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e",
6015             "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
6016             "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
6017             "31e"]];
6018 0           $$d{"num_word"}=
6019             [["premier","deux","trois","quatre","cinq","six","sept","huit","neuf",
6020             "dix","onze","douze","treize","quatorze","quinze","seize","dix-sept",
6021             "dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois",
6022             "vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit",
6023             "vingt-neuf","trente","trente et un"],
6024             ["1re"]];
6025              
6026 0           $$d{"now"} =["maintenant"];
6027 0           $$d{"today"} =["aujourd'hui"];
6028 0           $$d{"last"} =["dernier"];
6029 0           $$d{"each"} =["chaque","tous les","toutes les"];
6030 0           $$d{"of"} =["en","de"];
6031 0           $$d{"at"} =["a","${a}0"];
6032 0           $$d{"on"} =["sur"];
6033 0           $$d{"future"} =["en"];
6034 0           $$d{"past"} =["il y a"];
6035 0           $$d{"next"} =["suivant"];
6036 0           $$d{"prev"} =["precedent","pr${e}c${e}dent"];
6037 0           $$d{"later"} =["plus tard"];
6038              
6039 0           $$d{"exact"} =["exactement"];
6040 0           $$d{"approx"} =["approximativement"];
6041 0           $$d{"business"}=["professionel"];
6042              
6043 0           $$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"];
6044 0           $$d{"times"} =["midi","12:00:00","minuit","00:00:00"];
6045              
6046 0           $$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"];
6047 0           $$d{"months"} =["mois"];
6048 0           $$d{"weeks"} =["sem","semaine"];
6049 0           $$d{"days"} =["j","jour","jours"];
6050 0           $$d{"hours"} =["h","heure","heures"];
6051 0           $$d{"minutes"} =["mn","min","minute","minutes"];
6052 0           $$d{"seconds"} =["s","sec","seconde","secondes"];
6053 0           $$d{"replace"} =["m","mois"];
6054              
6055 0           $$d{"sephm"} ='[h:]';
6056 0           $$d{"sepms"} =':';
6057 0           $$d{"sepss"} ='[.:,]';
6058              
6059 0           $$d{"am"} = ["du matin"];
6060 0           $$d{"pm"} = ["du soir"];
6061             }
6062              
6063             sub _Date_Init_Romanian {
6064 0 0   0     print "DEBUG: _Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
6065 0           my($d)=@_;
6066 0           my(%h)=();
6067 0           _Char_8Bit(\%h);
6068 0           my($p)=$h{"p"};
6069 0           my($i)=$h{"i^"};
6070 0           my($a)=$h{"a~"};
6071 0           my($o)=$h{"-o"};
6072              
6073 0           $$d{"month_name"}=
6074             [["ianuarie","februarie","martie","aprilie","mai","iunie",
6075             "iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
6076 0           $$d{"month_abb"}=
6077             [["ian","febr","mart","apr","mai","iun",
6078             "iul","aug","sept","oct","nov","dec"],
6079             ["","feb"]];
6080              
6081 0           $$d{"day_name"}=
6082             [["luni","marti","miercuri","joi","vineri","simbata","duminica"],
6083             ["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
6084             "duminic${a}"]];
6085 0           $$d{"day_abb"}=
6086             [["lun","mar","mie","joi","vin","sim","dum"],
6087             ["lun","mar","mie","joi","vin","s${i}m","dum"]];
6088 0           $$d{"day_char"}=
6089             [["L","Ma","Mi","J","V","S","D"]];
6090              
6091 0           $$d{"num_suff"}=
6092             [["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a",
6093             "a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a",
6094             "a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a",
6095             "a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a",
6096             "a 30-a","a 31-a"]];
6097              
6098 0           $$d{"num_word"}=
6099             [["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea",
6100             "a opta","a noua","a zecea","a unsprezecea","a doisprezecea",
6101             "a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea",
6102             "a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea",
6103             "a douazecisiuna","a douazecisidoua","a douazecisitreia",
6104             "a douazecisipatra","a douazecisicincea","a douazecisisasea",
6105             "a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea",
6106             "a treizecisiuna"],
6107             ["prima","a doua","a treia","a patra","a cincea","a ${o}asea",
6108             "a ${o}aptea","a opta","a noua","a zecea","a unsprezecea",
6109             "a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea",
6110             "a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea",
6111             "a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna",
6112             "a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia",
6113             "a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea",
6114             "a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea",
6115             "a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea",
6116             "a treizeci${o}iuna"],
6117             ["intii", "doi", "trei", "patru", "cinci", "sase", "sapte",
6118             "opt","noua","zece","unsprezece","doisprezece",
6119             "treisprezece","patrusprezece","cincisprezece","saiprezece",
6120             "saptesprezece","optsprezece","nouasprezece","douazeci",
6121             "douazecisiunu","douazecisidoi","douazecisitrei",
6122             "douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte",
6123             "douazecisiopt","douazecisinoua","treizeci","treizecisiunu"],
6124             ["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte",
6125             "opt","nou${a}","zece","unsprezece","doisprezece",
6126             "treisprezece","patrusprezece","cincisprezece","${o}aiprezece",
6127             "${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci",
6128             "dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei",
6129             "dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase",
6130             "dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt",
6131             "dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]];
6132              
6133 0           $$d{"now"} =["acum"];
6134 0           $$d{"today"} =["azi","astazi","ast${a}zi"];
6135 0           $$d{"last"} =["ultima"];
6136 0           $$d{"each"} =["fiecare"];
6137 0           $$d{"of"} =["din","in","n"];
6138 0           $$d{"at"} =["la"];
6139 0           $$d{"on"} =["on"];
6140 0           $$d{"future"} =["in","${i}n"];
6141 0           $$d{"past"} =["in urma", "${i}n urm${a}"];
6142 0           $$d{"next"} =["urmatoarea","urm${a}toarea"];
6143 0           $$d{"prev"} =["precedenta","ultima"];
6144 0           $$d{"later"} =["mai tirziu", "mai t${i}rziu"];
6145              
6146 0           $$d{"exact"} =["exact"];
6147 0           $$d{"approx"} =["aproximativ"];
6148 0           $$d{"business"}=["de lucru","lucratoare","lucr${a}toare"];
6149              
6150 0           $$d{"offset"} =["ieri","-0:0:0:1:0:0:0",
6151             "alaltaieri", "-0:0:0:2:0:0:0",
6152             "alalt${a}ieri","-0:0:0:2:0:0:0",
6153             "miine","+0:0:0:1:0:0:0",
6154             "m${i}ine","+0:0:0:1:0:0:0",
6155             "poimiine","+0:0:0:2:0:0:0",
6156             "poim${i}ine","+0:0:0:2:0:0:0"];
6157 0           $$d{"times"} =["amiaza","12:00:00",
6158             "amiaz${a}","12:00:00",
6159             "miezul noptii","00:00:00",
6160             "miezul nop${p}ii","00:00:00"];
6161              
6162 0           $$d{"years"} =["ani","an","a"];
6163 0           $$d{"months"} =["luni","luna","lun${a}","l"];
6164 0           $$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina",
6165             "s${a}pt${a}m${i}na","sapt","s${a}pt"];
6166 0           $$d{"days"} =["zile","zi","z"];
6167 0           $$d{"hours"} =["ore", "ora", "or${a}", "h"];
6168 0           $$d{"minutes"} =["minute","min","m"];
6169 0           $$d{"seconds"} =["secunde","sec",];
6170 0           $$d{"replace"} =["s","secunde"];
6171              
6172 0           $$d{"sephm"} =':';
6173 0           $$d{"sepms"} =':';
6174 0           $$d{"sepss"} ='[.:,]';
6175              
6176 0           $$d{"am"} = ["AM","A.M."];
6177 0           $$d{"pm"} = ["PM","P.M."];
6178             }
6179              
6180             sub _Date_Init_Swedish {
6181 0 0   0     print "DEBUG: _Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
6182 0           my($d)=@_;
6183 0           my(%h)=();
6184 0           _Char_8Bit(\%h);
6185 0           my($ao)=$h{"ao"};
6186 0           my($o) =$h{"o:"};
6187 0           my($a) =$h{"a:"};
6188              
6189 0           $$d{"month_name"}=
6190             [["Januari","Februari","Mars","April","Maj","Juni",
6191             "Juli","Augusti","September","Oktober","November","December"]];
6192 0           $$d{"month_abb"}=
6193             [["Jan","Feb","Mar","Apr","Maj","Jun",
6194             "Jul","Aug","Sep","Okt","Nov","Dec"]];
6195              
6196 0           $$d{"day_name"}=
6197             [["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
6198             ["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
6199             "S${o}ndag"]];
6200 0           $$d{"day_abb"}=
6201             [["Man","Tis","Ons","Tor","Fre","Lor","Son"],
6202             ["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
6203 0           $$d{"day_char"}=
6204             [["M","Ti","O","To","F","L","S"]];
6205              
6206 0           $$d{"num_suff"}=
6207             [["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
6208             "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
6209             "21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
6210             "31:a"]];
6211 0           $$d{"num_word"}=
6212             [["forsta","andra","tredje","fjarde","femte","sjatte","sjunde",
6213             "attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6214             "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6215             "tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte",
6216             "tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde",
6217             "trettionde","trettioforsta"],
6218             ["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde",
6219             "${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
6220             "femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
6221             "tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte",
6222             "tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde",
6223             "trettionde","trettiof${o}rsta"]];
6224              
6225 0           $$d{"now"} =["nu"];
6226 0           $$d{"today"} =["idag"];
6227 0           $$d{"last"} =["forra","f${o}rra","senaste"];
6228 0           $$d{"each"} =["varje"];
6229 0           $$d{"of"} =["om"];
6230 0           $$d{"at"} =["kl","kl.","klockan"];
6231 0           $$d{"on"} =["pa","p${ao}"];
6232 0           $$d{"future"} =["om"];
6233 0           $$d{"past"} =["sedan"];
6234 0           $$d{"next"} =["nasta","n${a}sta"];
6235 0           $$d{"prev"} =["forra","f${o}rra"];
6236 0           $$d{"later"} =["senare"];
6237              
6238 0           $$d{"exact"} =["exakt"];
6239 0           $$d{"approx"} =["ungefar","ungef${a}r"];
6240 0           $$d{"business"}=["arbetsdag","arbetsdagar"];
6241              
6242 0           $$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
6243             "imorgon","+0:0:0:1:0:0:0"];
6244 0           $$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00",
6245             "midnatt","00:00:00"];
6246              
6247 0           $$d{"years"} =["ar","${ao}r"];
6248 0           $$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"];
6249 0           $$d{"weeks"} =["v","vecka","veckor"];
6250 0           $$d{"days"} =["d","dag","dagar"];
6251 0           $$d{"hours"} =["t","tim","timme","timmar"];
6252 0           $$d{"minutes"} =["min","minut","minuter"];
6253 0           $$d{"seconds"} =["s","sek","sekund","sekunder"];
6254 0           $$d{"replace"} =["m","minut"];
6255              
6256 0           $$d{"sephm"} ='[.:]';
6257 0           $$d{"sepms"} =':';
6258 0           $$d{"sepss"} ='[.:]';
6259              
6260 0           $$d{"am"} = ["FM"];
6261 0           $$d{"pm"} = ["EM"];
6262             }
6263              
6264             sub _Date_Init_German {
6265 0 0   0     print "DEBUG: _Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
6266 0           my($d)=@_;
6267 0           my(%h)=();
6268 0           _Char_8Bit(\%h);
6269 0           my($a)=$h{"a:"};
6270 0           my($u)=$h{"u:"};
6271 0           my($o)=$h{"o:"};
6272 0           my($b)=$h{"beta"};
6273              
6274 0           $$d{"month_name"}=
6275             [["Januar","Februar","Maerz","April","Mai","Juni",
6276             "Juli","August","September","Oktober","November","Dezember"],
6277             ["J${a}nner","Februar","M${a}rz","April","Mai","Juni",
6278             "Juli","August","September","Oktober","November","Dezember"]];
6279 0           $$d{"month_abb"}=
6280             [["Jan","Feb","Mar","Apr","Mai","Jun",
6281             "Jul","Aug","Sep","Okt","Nov","Dez"],
6282             ["J${a}n","Feb","M${a}r","Apr","Mai","Jun",
6283             "Jul","Aug","Sep","Okt","Nov","Dez"]];
6284              
6285 0           $$d{"day_name"}=
6286             [["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
6287             "Sonntag"]];
6288 0           $$d{"day_abb"}=
6289             [["Mo","Di","Mi","Do","Fr","Sa","So"]];
6290 0           $$d{"day_char"}=
6291             [["M","Di","Mi","Do","F","Sa","So"]];
6292              
6293 0           $$d{"num_suff"}=
6294             [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6295             "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6296             "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6297             "31."]];
6298 0           $$d{"num_word"}=
6299             [
6300             ["erste","zweite","dritte","vierte","funfte","sechste","siebente",
6301             "achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte",
6302             "funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte",
6303             "zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste",
6304             "vierundzwanzigste","funfundzwanzigste","sechundzwanzigste",
6305             "siebundzwanzigste","achtundzwanzigste","neunundzwanzigste",
6306             "dreibigste","einunddreibigste"],
6307             ["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente",
6308             "achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte",
6309             "vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte",
6310             "neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste",
6311             "dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste",
6312             "sechundzwanzigste","siebundzwanzigste","achtundzwanzigste",
6313             "neunundzwanzigste","drei${b}igste","einunddrei${b}igste"],
6314             ["erster"]];
6315              
6316 0           $$d{"now"} =["jetzt"];
6317 0           $$d{"today"} =["heute"];
6318 0           $$d{"last"} =["letzte","letzten"];
6319 0           $$d{"each"} =["jeden"];
6320 0           $$d{"of"} =["der","im","des"];
6321 0           $$d{"at"} =["um"];
6322 0           $$d{"on"} =["am"];
6323 0           $$d{"future"} =["in"];
6324 0           $$d{"past"} =["vor"];
6325 0           $$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
6326 0           $$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
6327 0           $$d{"later"} =["spater","sp${a}ter"];
6328              
6329 0           $$d{"exact"} =["genau"];
6330 0           $$d{"approx"} =["ungefahr","ungef${a}hr"];
6331 0           $$d{"business"}=["Arbeitstag"];
6332              
6333 0           $$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"];
6334 0           $$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"];
6335              
6336 0           $$d{"years"} =["j","Jahr","Jahre","Jahren"];
6337 0           $$d{"months"} =["Monat","Monate","Monaten"];
6338 0           $$d{"weeks"} =["w","Woche","Wochen"];
6339 0           $$d{"days"} =["t","Tag","Tage","Tagen"];
6340 0           $$d{"hours"} =["h","std","Stunde","Stunden"];
6341 0           $$d{"minutes"} =["min","Minute","Minuten"];
6342 0           $$d{"seconds"} =["s","sek","Sekunde","Sekunden"];
6343 0           $$d{"replace"} =["m","Monat"];
6344              
6345 0           $$d{"sephm"} =':';
6346 0           $$d{"sepms"} ='[: ]';
6347 0           $$d{"sepss"} ='[.:]';
6348              
6349 0           $$d{"am"} = ["FM"];
6350 0           $$d{"pm"} = ["EM"];
6351             }
6352              
6353             sub _Date_Init_Dutch {
6354 0 0   0     print "DEBUG: _Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
6355 0           my($d)=@_;
6356 0           my(%h)=();
6357 0           _Char_8Bit(\%h);
6358              
6359 0           $$d{"month_name"}=
6360             [["januari","februari","maart","april","mei","juni","juli","augustus",
6361             "september","october","november","december"],
6362             ["","","","","","","","","","oktober"]];
6363              
6364 0           $$d{"month_abb"}=
6365             [["jan","feb","maa","apr","mei","jun","jul",
6366             "aug","sep","oct","nov","dec"],
6367             ["","","mrt","","","","","","","okt"]];
6368 0           $$d{"day_name"}=
6369             [["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
6370             "zondag"]];
6371 0           $$d{"day_abb"}=
6372             [["ma","di","wo","do","vr","zat","zon"],
6373             ["","","","","","za","zo"]];
6374 0           $$d{"day_char"}=
6375             [["M","D","W","D","V","Za","Zo"]];
6376              
6377 0           $$d{"num_suff"}=
6378             [["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de",
6379             "11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste",
6380             "21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste",
6381             "30ste","31ste"]];
6382             $$d{"num_word"}=
6383             [["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
6384             "negende","tiende","elfde","twaalfde",
6385 0           map {"${_}tiende";} qw (der veer vijf zes zeven acht negen),
6386             "twintigste",
6387 0           map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht
6388             negen),
6389             "dertigste","eenendertigste"],
6390             ["","","","","","","","","","","","","","","","","","","","",
6391 0           map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht
6392             negen),
6393             "dertigste","een-en-dertigste"],
6394             ["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
6395             "elf","twaalf",
6396 0           map {"${_}tien"} qw (der veer vijf zes zeven acht negen),
6397             "twintig",
6398 0           map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen),
6399             "dertig","eenendertig"],
6400             ["","","","","","","","","","","","","","","","","","","","",
6401 0           map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht
  0            
6402             negen),
6403             "dertig","een-en-dertig"]];
6404              
6405 0           $$d{"now"} =["nu","nou"];
6406 0           $$d{"today"} =["vandaag"];
6407 0           $$d{"last"} =["laatste"];
6408 0           $$d{"each"} =["elke","elk"];
6409 0           $$d{"of"} =["in","van"];
6410 0           $$d{"at"} =["om"];
6411 0           $$d{"on"} =["op"];
6412 0           $$d{"future"} =["over"];
6413 0           $$d{"past"} =["geleden","vroeger","eerder"];
6414 0           $$d{"next"} =["volgende","volgend"];
6415 0           $$d{"prev"} =["voorgaande","voorgaand"];
6416 0           $$d{"later"} =["later"];
6417              
6418 0           $$d{"exact"} =["exact","precies","nauwkeurig"];
6419 0           $$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.'];
6420 0           $$d{"business"}=["werk","zakelijke","zakelijk"];
6421              
6422 0           $$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0",
6423             "gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"];
6424 0           $$d{"times"} =["noen","12:00:00","middernacht","00:00:00"];
6425              
6426 0           $$d{"years"} =["jaar","jaren","ja","j"];
6427 0           $$d{"months"} =["maand","maanden","mnd"];
6428 0           $$d{"weeks"} =["week","weken","w"];
6429 0           $$d{"days"} =["dag","dagen","d"];
6430 0           $$d{"hours"} =["uur","uren","u","h"];
6431 0           $$d{"minutes"} =["minuut","minuten","min"];
6432 0           $$d{"seconds"} =["seconde","seconden","sec","s"];
6433 0           $$d{"replace"} =["m","minuten"];
6434              
6435 0           $$d{"sephm"} ='[:.uh]';
6436 0           $$d{"sepms"} ='[:.m]';
6437 0           $$d{"sepss"} ='[.:]';
6438              
6439 0           $$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends",
6440             "ochtend","'s_nachts","nacht"];
6441 0           $$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag",
6442             "'s_avonds","avond"];
6443             }
6444              
6445             sub _Date_Init_Polish {
6446 0 0   0     print "DEBUG: _Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
6447 0           my($d)=@_;
6448              
6449 0           $$d{"month_name"}=
6450             [["stycznia","luty","marca","kwietnia","maja","czerwca",
6451             "lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"],
6452             ["stycznia","luty","marca","kwietnia","maja","czerwca","lipca",
6453             "sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]];
6454 0           $$d{"month_abb"}=
6455             [["sty.","lut.","mar.","kwi.","maj","cze.",
6456             "lip.","sie.","wrz.","paz.","lis.","gru."],
6457             ["sty.","lut.","mar.","kwi.","maj","cze.",
6458             "lip.","sie.","wrz.","pa\x9f.","lis.","gru."]];
6459              
6460 0           $$d{"day_name"}=
6461             [["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
6462             "niedziela"],
6463             ["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
6464             "sobota","niedziela"]];
6465 0           $$d{"day_abb"}=
6466             [["po.","wt.","sr.","cz.","pi.","so.","ni."],
6467             ["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
6468 0           $$d{"day_char"}=
6469             [["p","w","e","c","p","s","n"],
6470             ["p","w","\x9c.","c","p","s","n"]];
6471              
6472 0           $$d{"num_suff"}=
6473             [["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
6474             "11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
6475             "21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
6476             "31."]];
6477 0           $$d{"num_word"}=
6478             [["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
6479             "siodmego","osmego","dziewiatego","dziesiatego",
6480             "jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
6481             "szestnastego","siedemnastego","osiemnastego","dziewietnastego",
6482             "dwudziestego",
6483             "dwudziestego pierwszego","dwudziestego drugiego",
6484             "dwudziestego trzeczego","dwudziestego czwartego",
6485             "dwudziestego piatego","dwudziestego szostego",
6486             "dwudziestego siodmego","dwudziestego osmego",
6487             "dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"],
6488             ["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego",
6489             "sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego",
6490             "dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego",
6491             "czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego",
6492             "osiemnastego","dziewietnastego","dwudziestego",
6493             "dwudziestego pierwszego","dwudziestego drugiego",
6494             "dwudziestego trzeczego","dwudziestego czwartego",
6495             "dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego",
6496             "dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego",
6497             "dwudziestego dziewi\x81\xb9tego","trzydziestego",
6498             "trzydziestego pierwszego"]];
6499              
6500 0           $$d{"now"} =["teraz"];
6501 0           $$d{"today"} =["dzisaj"];
6502 0           $$d{"last"} =["ostatni","ostatna"];
6503 0           $$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"];
6504 0           $$d{"of"} =["w","z"];
6505 0           $$d{"at"} =["o","u"];
6506 0           $$d{"on"} =["na"];
6507 0           $$d{"future"} =["za"];
6508 0           $$d{"past"} =["temu"];
6509 0           $$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
6510             "przyszly","przysz\x81\xb3y","przyszlym",
6511             "przysz\x81\xb3ym"];
6512 0           $$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
6513 0           $$d{"later"} =["later"];
6514              
6515 0           $$d{"exact"} =["doklandnie","dok\x81\xb3andnie"];
6516 0           $$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej",
6517             "mniej wi\x81\xeacej","okolo","oko\x81\xb3o"];
6518 0           $$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym",
6519             "s\x81\xb3u\x81\xbfbowym"];
6520              
6521 0           $$d{"times"} =["po\x81\xb3udnie","12:00:00",
6522             "p\x81\xf3\x81\xb3noc","00:00:00",
6523             "poludnie","12:00:00","polnoc","00:00:00"];
6524 0           $$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"];
6525              
6526 0           $$d{"years"} =["rok","lat","lata","latach"];
6527 0           $$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy",
6528             "miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"];
6529 0           $$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"];
6530 0           $$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"];
6531 0           $$d{"hours"} =["g.","godzina","godziny","godzinie"];
6532 0           $$d{"minutes"} =["mn.","min.","minut","minuty"];
6533 0           $$d{"seconds"} =["s.","sekund","sekundy"];
6534 0           $$d{"replace"} =["m.","miesiac"];
6535              
6536 0           $$d{"sephm"} =':';
6537 0           $$d{"sepms"} =':';
6538 0           $$d{"sepss"} ='[.:]';
6539              
6540 0           $$d{"am"} = ["AM","A.M."];
6541 0           $$d{"pm"} = ["PM","P.M."];
6542             }
6543              
6544             sub _Date_Init_Spanish {
6545 0 0   0     print "DEBUG: _Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
6546 0           my($d)=@_;
6547 0           my(%h)=();
6548 0           _Char_8Bit(\%h);
6549              
6550 0           $$d{"month_name"}=
6551             [["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
6552             "Septiembre","Octubre","Noviembre","Diciembre"]];
6553              
6554 0           $$d{"month_abb"}=
6555             [["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
6556             "Nov","Dic"]];
6557              
6558 0           $$d{"day_name"}=
6559             [["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
6560 0           $$d{"day_abb"}=
6561             [["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
6562 0           $$d{"day_char"}=
6563             [["L","Ma","Mi","J","V","S","D"]];
6564              
6565 0           $$d{"num_suff"}=
6566             [["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o",
6567             "11o","12o","13o","14o","15o","16o","17o","18o","19o","20o",
6568             "21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"],
6569             ["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a",
6570             "11a","12a","13a","14a","15a","16a","17a","18a","19a","20a",
6571             "21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]];
6572 0           $$d{"num_word"}=
6573             [["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo",
6574             "Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo",
6575             "Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto",
6576             "Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo",
6577             "Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero",
6578             "Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto",
6579             "Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo",
6580             "Trigesimo Primero"],
6581             ["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima",
6582             "Octava","Novena","Decima","Decimo Primera","Decimo Segunda",
6583             "Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta",
6584             "Decimo Septima","Decimo Octava","Decimo Novena","Vigesima",
6585             "Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera",
6586             "Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta",
6587             "Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima",
6588             "Trigesimo Primera"]];
6589              
6590 0           $$d{"now"} =["Ahora"];
6591 0           $$d{"today"} =["Hoy"];
6592 0           $$d{"last"} =["ultimo"];
6593 0           $$d{"each"} =["cada"];
6594 0           $$d{"of"} =["en","de"];
6595 0           $$d{"at"} =["a"];
6596 0           $$d{"on"} =["el"];
6597 0           $$d{"future"} =["en"];
6598 0           $$d{"past"} =["hace"];
6599 0           $$d{"next"} =["siguiente"];
6600 0           $$d{"prev"} =["anterior"];
6601 0           $$d{"later"} =["later"];
6602              
6603 0           $$d{"exact"} =["exactamente"];
6604 0           $$d{"approx"} =["aproximadamente"];
6605 0           $$d{"business"}=["laborales"];
6606              
6607 0           $$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"];
6608 0           $$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"];
6609              
6610 0           $$d{"years"} =["a","ano","ano","anos","anos"];
6611 0           $$d{"months"} =["m","mes","mes","meses"];
6612 0           $$d{"weeks"} =["sem","semana","semana","semanas"];
6613 0           $$d{"days"} =["d","dia","dias"];
6614 0           $$d{"hours"} =["hr","hrs","hora","horas"];
6615 0           $$d{"minutes"} =["min","min","minuto","minutos"];
6616 0           $$d{"seconds"} =["s","seg","segundo","segundos"];
6617 0           $$d{"replace"} =["m","mes"];
6618              
6619 0           $$d{"sephm"} =':';
6620 0           $$d{"sepms"} =':';
6621 0           $$d{"sepss"} ='[.:]';
6622              
6623 0           $$d{"am"} = ["AM","A.M."];
6624 0           $$d{"pm"} = ["PM","P.M."];
6625             }
6626              
6627             sub _Date_Init_Portuguese {
6628 0 0   0     print "DEBUG: _Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
6629 0           my($d)=@_;
6630 0           my(%h)=();
6631 0           _Char_8Bit(\%h);
6632 0           my($o) = $h{"-o"};
6633 0           my($c) = $h{",c"};
6634 0           my($a) = $h{"a'"};
6635 0           my($e) = $h{"e'"};
6636 0           my($u) = $h{"u'"};
6637 0           my($o2)= $h{"o'"};
6638 0           my($a2)= $h{"a`"};
6639 0           my($a3)= $h{"a~"};
6640 0           my($e2)= $h{"e^"};
6641              
6642 0           $$d{"month_name"}=
6643             [["Janeiro","Fevereiro","Marco","Abril","Maio","Junho",
6644             "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"],
6645             ["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho",
6646             "Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]];
6647              
6648 0           $$d{"month_abb"}=
6649             [["Jan","Fev","Mar","Abr","Mai","Jun",
6650             "Jul","Ago","Set","Out","Nov","Dez"]];
6651              
6652 0           $$d{"day_name"}=
6653             [["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
6654             ["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
6655 0           $$d{"day_abb"}=
6656             [["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
6657             ["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
6658 0           $$d{"day_char"}=
6659             [["Sg","T","Qa","Qi","Sx","Sb","D"]];
6660              
6661 0           $$d{"num_suff"}=
6662             [["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}",
6663             "9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}",
6664             "16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}",
6665             "23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}",
6666             "30${o}","31${o}"]];
6667 0           $$d{"num_word"}=
6668             [["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo",
6669             "oitavo","nono","decimo","decimo primeiro","decimo segundo",
6670             "decimo terceiro","decimo quarto","decimo quinto","decimo sexto",
6671             "decimo setimo","decimo oitavo","decimo nono","vigesimo",
6672             "vigesimo primeiro","vigesimo segundo","vigesimo terceiro",
6673             "vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo",
6674             "vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"],
6675             ["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo",
6676             "oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo",
6677             "d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto",
6678             "d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo",
6679             "d${e}cimo nono","vig${e}simo","vig${e}simo primeiro",
6680             "vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto",
6681             "vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo",
6682             "vig${e}simo oitavo","vig${e}simo nono","trig${e}simo",
6683             "trig${e}simo primeiro"]];
6684              
6685 0           $$d{"now"} =["agora"];
6686 0           $$d{"today"} =["hoje"];
6687 0           $$d{"last"} =["${u}ltimo","ultimo"];
6688 0           $$d{"each"} =["cada"];
6689 0           $$d{"of"} =["da","do"];
6690 0           $$d{"at"} =["as","${a2}s"];
6691 0           $$d{"on"} =["na","no"];
6692 0           $$d{"future"} =["em"];
6693 0           $$d{"past"} =["a","${a2}"];
6694 0           $$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"];
6695 0           $$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"];
6696 0           $$d{"later"} =["passadas","passados"];
6697              
6698 0           $$d{"exact"} =["exactamente"];
6699 0           $$d{"approx"} =["aproximadamente"];
6700 0           $$d{"business"}=["util","uteis"];
6701              
6702 0           $$d{"offset"} =["ontem","-0:0:0:1:0:0:0",
6703             "amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"];
6704 0           $$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"];
6705              
6706 0           $$d{"years"} =["anos","ano","ans","an","a"];
6707 0           $$d{"months"} =["meses","m${e2}s","mes","m"];
6708 0           $$d{"weeks"} =["semanas","semana","sem","sems","s"];
6709 0           $$d{"days"} =["dias","dia","d"];
6710 0           $$d{"hours"} =["horas","hora","hr","hrs"];
6711 0           $$d{"minutes"} =["minutos","minuto","min","mn"];
6712 0           $$d{"seconds"} =["segundos","segundo","seg","sg"];
6713 0           $$d{"replace"} =["m","mes","s","sems"];
6714              
6715 0           $$d{"sephm"} =':';
6716 0           $$d{"sepms"} =':';
6717 0           $$d{"sepss"} ='[,]';
6718              
6719 0           $$d{"am"} = ["AM","A.M."];
6720 0           $$d{"pm"} = ["PM","P.M."];
6721             }
6722              
6723             sub _Date_Init_Russian {
6724 0 0   0     print "DEBUG: _Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
6725 0           my($d)=@_;
6726 0           my(%h)=();
6727 0           _Char_8Bit(\%h);
6728 0           my($a) =$h{"a:"};
6729              
6730 0           $$d{"month_name"}=
6731             [
6732             ["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1",
6733             "\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1",
6734             "\xc9\xc0\xce\xd1",
6735             "\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1",
6736             "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1",
6737             "\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"],
6738             ["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8",
6739             "\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca",
6740             "\xc9\xc0\xce\xd8",
6741             "\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4",
6742             "\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8",
6743             "\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"]
6744             ];
6745              
6746 0           $$d{"month_abb"}=
6747             [["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2",
6748             "\xcd\xc1\xca","\xc9\xc0\xce",
6749             "\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4",
6750             "\xce\xcf\xd1\xc2","\xc4\xc5\xcb"],
6751             ["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","",
6752             "","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]];
6753              
6754 0           $$d{"day_name"}=
6755             [["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb",
6756             "\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1",
6757             "\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1",
6758             "\xd3\xd5\xc2\xc2\xcf\xd4\xc1",
6759             "\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]];
6760 0           $$d{"day_abb"}=
6761             [["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7",
6762             "\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"],
6763             ["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4",
6764             "\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]];
6765 0           $$d{"day_char"}=
6766             [["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
6767             "\xd7\xd3"]];
6768              
6769 0           $$d{"num_suff"}=
6770             [["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ",
6771             "11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ",
6772             "21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ",
6773             "31 "]];
6774 0           $$d{"num_word"}=
6775             [["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca",
6776             "\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6777             "\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca",
6778             "\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca",
6779             "\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca",
6780             "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6781             "\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca",
6782             "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6783             "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6784             "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6785             "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6786             "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6787             "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6788             "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6789             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca",
6790             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca",
6791             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca",
6792             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca",
6793             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
6794             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca",
6795             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca",
6796             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca",
6797             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca",
6798             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca",
6799             "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca",
6800             "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"],
6801              
6802             ["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5",
6803             "\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6804             "\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5",
6805             "\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6806             "\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5",
6807             "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6808             "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6809             "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6810             "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6811             "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6812             "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6813             "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6814             "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6815             "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6816             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
6817             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5",
6818             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6819             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5",
6820             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
6821             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5",
6822             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5",
6823             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5",
6824             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5",
6825             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5",
6826             "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5",
6827             "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"],
6828              
6829             ["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf",
6830             "\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6831             "\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf",
6832             "\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6833             "\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6834             "\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf",
6835             "\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6836             "\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6837             "\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6838             "\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6839             "\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6840             "\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6841             "\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6842             "\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6843             "\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6844             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6845             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf",
6846             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
6847             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
6848             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf",
6849             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf",
6850             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf",
6851             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
6852             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
6853             "\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf",
6854             "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
6855             "\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]];
6856              
6857 0           $$d{"now"} =["\xd3\xc5\xca\xde\xc1\xd3"];
6858 0           $$d{"today"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1"];
6859 0           $$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"];
6860 0           $$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"];
6861 0           $$d{"of"} =[" "];
6862 0           $$d{"at"} =["\xd7"];
6863 0           $$d{"on"} =["\xd7"];
6864 0           $$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"];
6865 0           $$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "];
6866 0           $$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"];
6867 0           $$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"];
6868 0           $$d{"later"} =["\xd0\xcf\xda\xd6\xc5"];
6869              
6870 0           $$d{"exact"} =["\xd4\xcf\xde\xce\xcf"];
6871 0           $$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"];
6872 0           $$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"];
6873              
6874 0           $$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0",
6875             "\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0",
6876             "\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0",
6877             "\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1",
6878             "+0:0:0:2:0:0:0"];
6879 0           $$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00",
6880             "\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"];
6881              
6882 0           $$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4",
6883             "\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"];
6884 0           $$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3",
6885             "\xcd\xc5\xd3\xd1\xc3\xc5\xd7"];
6886 0           $$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8",
6887             "\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"];
6888 0           $$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca",
6889             "\xc4\xce\xd1"];
6890 0           $$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3",
6891             "\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"];
6892 0           $$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1",
6893             "\xcd\xc9\xce\xd5\xd4"];
6894 0           $$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
6895             "\xd3\xc5\xcb\xd5\xce\xc4"];
6896 0           $$d{"replace"} =[];
6897              
6898 0           $$d{"sephm"} ="[:\xde]";
6899 0           $$d{"sepms"} ="[:\xcd]";
6900 0           $$d{"sepss"} ="[:.\xd3]";
6901              
6902 0           $$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
6903             "\xd5\xd4\xd2\xc1",
6904             "\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"];
6905 0           $$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1",
6906             "\xd7\xc5\xde\xc5\xd2\xc1",
6907             "\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1",
6908             "\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"];
6909             }
6910              
6911             sub _Date_Init_Turkish {
6912 0 0   0     print "DEBUG: _Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
6913 0           my($d)=@_;
6914              
6915 0           $$d{"month_name"}=
6916             [
6917             ["ocak","subat","mart","nisan","mayis","haziran",
6918             "temmuz","agustos","eylul","ekim","kasim","aralik"],
6919             ["ocak","\xfeubat","mart","nisan","may\xfds","haziran",
6920             "temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"]
6921             ];
6922              
6923 0           $$d{"month_abb"}=
6924             [
6925             ["oca","sub","mar","nis","may","haz",
6926             "tem","agu","eyl","eki","kas","ara"],
6927             ["oca","\xfeub","mar","nis","may","haz",
6928             "tem","a\xf0u","eyl","eki","kas","ara"]
6929             ];
6930              
6931 0           $$d{"day_name"}=
6932             [
6933             ["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
6934             ["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
6935             "cumartesi","pazar"],
6936             ];
6937              
6938 0           $$d{"day_abb"}=
6939             [
6940             ["pzt","sal","car","per","cum","cts","paz"],
6941             ["pzt","sal","\xe7ar","per","cum","cts","paz"],
6942             ];
6943              
6944 0           $$d{"day_char"}=
6945             [["Pt","S","Cr","Pr","C","Ct","P"],
6946             ["Pt","S","\xc7","Pr","C","Ct","P"]];
6947              
6948 0           $$d{"num_suff"}=
6949             [[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.",
6950             "11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.",
6951             "21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.",
6952             "31."]];
6953              
6954 0           $$d{"num_word"}=
6955             [
6956             ["birinci","ikinci","ucuncu","dorduncu",
6957             "besinci","altinci","yedinci","sekizinci",
6958             "dokuzuncu","onuncu","onbirinci","onikinci",
6959             "onucuncu","ondordoncu",
6960             "onbesinci","onaltinci","onyedinci","onsekizinci",
6961             "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
6962             "yirmiucuncu","yirmidorduncu",
6963             "yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci",
6964             "yirmidokuzuncu","otuzuncu","otuzbirinci"],
6965             ["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc",
6966             "be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci",
6967             "dokuzuncu","onuncu","onbirinci","onikinci",
6968             "on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc",
6969             "onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci",
6970             "ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
6971             "yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc",
6972             "yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci",
6973             "yirmidokuzuncu","otuzuncu","otuzbirinci"]
6974             ];
6975              
6976 0           $$d{"now"} =["\xfeimdi", "simdi"];
6977 0           $$d{"today"} =["bugun", "bug\xfcn"];
6978 0           $$d{"last"} =["son", "sonuncu"];
6979 0           $$d{"each"} =["her"];
6980 0           $$d{"of"} =["of"];
6981 0           $$d{"at"} =["saat"];
6982 0           $$d{"on"} =["on"];
6983 0           $$d{"future"} =["gelecek"];
6984 0           $$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
6985 0           $$d{"next"} =["gelecek","sonraki"];
6986 0           $$d{"prev"} =["onceki","\xf6nceki"];
6987 0           $$d{"later"} =["sonra"];
6988              
6989 0           $$d{"exact"} =["tam"];
6990 0           $$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"];
6991 0           $$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"];
6992              
6993 0           $$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0",
6994             "dun", "-0:0:0:1:0:0:0",
6995             "yar\xfdn","+0:0:0:1:0:0:0",
6996             "yarin","+0:0:0:1:0:0:0"];
6997              
6998 0           $$d{"times"} =["\xf6\xf0len","12:00:00",
6999             "oglen","12:00:00",
7000             "yarim","12:300:00",
7001             "yar\xfdm","12:30:00",
7002             "gece yar\xfds\xfd","00:00:00",
7003             "gece yarisi","00:00:00"];
7004              
7005 0           $$d{"years"} =["yil","y"];
7006 0           $$d{"months"} =["ay","a"];
7007 0           $$d{"weeks"} =["hafta", "h"];
7008 0           $$d{"days"} =["gun","g"];
7009 0           $$d{"hours"} =["saat"];
7010 0           $$d{"minutes"} =["dakika","dak","d"];
7011 0           $$d{"seconds"} =["saniye","sn",];
7012 0           $$d{"replace"} =["s","saat"];
7013              
7014 0           $$d{"sephm"} =':';
7015 0           $$d{"sepms"} =':';
7016 0           $$d{"sepss"} ='[.:,]';
7017              
7018 0           $$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
7019 0           $$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
7020             }
7021              
7022             sub _Date_Init_Danish {
7023 0 0   0     print "DEBUG: _Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
7024 0           my($d)=@_;
7025              
7026 0           $$d{"month_name"}=
7027             [["Januar","Februar","Marts","April","Maj","Juni",
7028             "Juli","August","September","Oktober","November","December"]];
7029 0           $$d{"month_abb"}=
7030             [["Jan","Feb","Mar","Apr","Maj","Jun",
7031             "Jul","Aug","Sep","Okt","Nov","Dec"]];
7032              
7033 0           $$d{"day_name"}=
7034             [["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
7035             ["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
7036              
7037 0           $$d{"day_abb"}=
7038             [["Man","Tir","Ons","Tor","Fre","Lor","Son"],
7039             ["Man","Tir","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
7040 0           $$d{"day_char"}=
7041             [["M","Ti","O","To","F","L","S"]];
7042              
7043 0           $$d{"num_suff"}=
7044             [["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
7045             "11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
7046             "21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
7047             "31:e"]];
7048 0           $$d{"num_word"}=
7049             [["forste","anden","tredie","fjerde","femte","sjette","syvende",
7050             "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7051             "femtende","sekstende","syttende","attende","nittende","tyvende",
7052             "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7053             "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7054             "tredivte","enogtredivte"],
7055             ["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende",
7056             "ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
7057             "femtende","sekstende","syttende","attende","nittende","tyvende",
7058             "enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
7059             "seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
7060             "tredivte","enogtredivte"]];
7061              
7062 0           $$d{"now"} =["nu"];
7063 0           $$d{"today"} =["idag"];
7064 0           $$d{"last"} =["forrige","sidste","nyeste"];
7065 0           $$d{"each"} =["hver"];
7066 0           $$d{"of"} =["om"];
7067 0           $$d{"at"} =["kl","kl.","klokken"];
7068 0           $$d{"on"} =["pa","p\xe5"];
7069 0           $$d{"future"} =["om"];
7070 0           $$d{"past"} =["siden"];
7071 0           $$d{"next"} =["nasta","n\xe6ste"];
7072 0           $$d{"prev"} =["forrige"];
7073 0           $$d{"later"} =["senere"];
7074              
7075 0           $$d{"exact"} =["pracist","pr\xe6cist"];
7076 0           $$d{"approx"} =["circa"];
7077 0           $$d{"business"}=["arbejdsdag","arbejdsdage"];
7078              
7079 0           $$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
7080             "imorgen","+0:0:0:1:0:0:0"];
7081 0           $$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00",
7082             "midnat","00:00:00"];
7083              
7084 0           $$d{"years"} =["ar","\xe5r"];
7085 0           $$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"];
7086 0           $$d{"weeks"} =["u","uge","uger"];
7087 0           $$d{"days"} =["d","dag","dage"];
7088 0           $$d{"hours"} =["t","tim","time","timer"];
7089 0           $$d{"minutes"} =["min","minut","minutter"];
7090 0           $$d{"seconds"} =["s","sek","sekund","sekunder"];
7091 0           $$d{"replace"} =["m","minut"];
7092              
7093 0           $$d{"sephm"} ='[.:]';
7094 0           $$d{"sepms"} =':';
7095 0           $$d{"sepss"} ='[.:]';
7096              
7097 0           $$d{"am"} = ["FM"];
7098 0           $$d{"pm"} = ["EM"];
7099             }
7100              
7101             sub _Date_Init_Catalan {
7102 0 0   0     print "DEBUG: _Date_Init_Catalan\n" if ($Curr{"Debug"} =~ /trace/);
7103 0           my($d)=@_;
7104              
7105 0           $$d{"month_name"}=
7106             [["Gener","Febrer","Marc","Abril","Maig","Juny",
7107             "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7108             ["Gener","Febrer","Mar?","Abril","Maig","Juny",
7109             "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"],
7110             ["Gener","Febrer","Marc,","Abril","Maig","Juny",
7111             "Juliol","Agost","Setembre","Octubre","Novembre","Desembre"]];
7112              
7113 0           $$d{"month_abb"}=
7114             [["Gen","Feb","Mar","Abr","Mai","Jun",
7115             "Jul","Ago","Set","Oct","Nov","Des"],
7116             [],
7117             ["","","","","","",
7118             "","","","","","Dec"] #common mistake
7119             ];
7120              
7121 0           $$d{"day_name"}=
7122             [["Dilluns","Dimarts","Dimecres","Dijous","Divendres","Dissabte","Diumenge"]];
7123 0           $$d{"day_abb"}=
7124             [["Dll","Dmt","Dmc","Dij","Div","Dis","Diu"],
7125             ["","Dim","","","","",""],
7126             ["","","Dic","","","",""]
7127             ];
7128 0           $$d{"day_char"}=
7129             [["Dl","Dm","Dc","Dj","Dv","Ds","Du"] ,
7130             ["L","M","X","J","V","S","U"]];
7131              
7132 0           $$d{"num_suff"}=
7133             [["1er","2n","3r","4t","5e","6e","7e","8e","9e","10e",
7134             "11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
7135             "21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
7136             "31e"],
7137             ["1er","2n","3r","4t","5?","6?","7?","8?","9?","10?",
7138             "11?","12?","13?","14?","15?","16?","17?","18?","19?","20?",
7139             "21?","22?","23?","24?","25?","26?","27?","28?","29?","30?",
7140             "31?"]];
7141 0           $$d{"num_word"}=
7142             [["primer","segon","tercer","quart","cinque","sise","sete","vuite",
7143             "nove","dese","onze","dotze","tretze","catorze",
7144             "quinze","setze","dissete","divuite","dinove",
7145             "vinte","vint-i-une","vint-i-dose","vint-i-trese",
7146             "vint-i-quatre","vint-i-cinque","vint-i-sise","vint-i-sete",
7147             "vint-i-vuite","vint-i-nove","trente","trenta-une"],
7148             ["primer","segon","tercer","quart","cinqu?","sis?","set?","vuit?",
7149             "nov?","des?","onz?","dotz?","tretz?","catorz?",
7150             "quinz?","setz?","disset?","divuit?","dinov?",
7151             "vint?","vint-i-un?","vint-i-dos?","vint-i-tres?",
7152             "vint-i-quatr?","vint-i-cinqu?","vint-i-sis?","vint-i-set?",
7153             "vint-i-vuit?","vint-i-nov?","trent?","trenta-un?"]];
7154              
7155 0           $$d{"now"} =["avui","ara"];
7156 0           $$d{"last"} =["darrer","?ltim","darrera","?ltima"];
7157 0           $$d{"each"} =["cada","cadascun","cadascuna"];
7158 0           $$d{"of"} =["de","d'"];
7159 0           $$d{"at"} =["a les","a","al"];
7160 0           $$d{"on"} =["el"];
7161 0           $$d{"future"} =["d'aqu? a"];
7162 0           $$d{"past"} =["fa"];
7163 0           $$d{"next"} =["proper"];
7164 0           $$d{"prev"} =["passat","proppassat","anterior"];
7165 0           $$d{"later"} =["m?s tard"];
7166              
7167 0           $$d{"exact"} =["exactament"];
7168 0           $$d{"approx"} =["approximadament"];
7169 0           $$d{"business"}=["empresa"];
7170              
7171 0           $$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",];
7172 0           $$d{"times"} =["migdia","12:00:00","mitjanit","00:00:00"];
7173              
7174 0           $$d{"years"} =["a","an","any","anys"];
7175 0           $$d{"months"} =["mes","me","ms"];
7176 0           $$d{"weeks"} =["se","set","setm","setmana","setmanes"];
7177 0           $$d{"days"} =["d","dia","dies"];
7178 0           $$d{"hours"} =["h","ho","hores","hora"];
7179 0           $$d{"minutes"} =["mn","min","minut","minuts"];
7180 0           $$d{"seconds"} =["s","seg","segon","segons"];
7181 0           $$d{"replace"} =["m","mes","s","setmana"];
7182              
7183 0           $$d{"sephm"} =':';
7184 0           $$d{"sepms"} =':';
7185 0           $$d{"sepss"} ='[.:]';
7186              
7187 0           $$d{"am"} = ["AM","A.M."];
7188 0           $$d{"pm"} = ["PM","P.M."];
7189             }
7190              
7191             ########################################################################
7192             # FROM MY PERSONAL LIBRARIES
7193             ########################################################################
7194              
7195 36     36   618575 no integer;
  36         83  
  36         223  
7196              
7197             # _ModuloAddition($N,$add,\$val,\$rem);
7198             # This calculates $val=$val+$add and forces $val to be in a certain range.
7199             # This is useful for adding numbers for which only a certain range is
7200             # allowed (for example, minutes can be between 0 and 59 or months can be
7201             # between 1 and 12). The absolute value of $N determines the range and
7202             # the sign of $N determines whether the range is 0 to N-1 (if N>0) or
7203             # 1 to N (N<0). The remainder (as modulo N) is added to $rem.
7204             # Example:
7205             # To add 2 hours together (with the excess returned in days) use:
7206             # _ModuloAddition(60,$s1,\$s,\$day);
7207             sub _ModuloAddition {
7208 0     0     my($N,$add,$val,$rem)=@_;
7209 0 0         return if ($N==0);
7210 0           $$val+=$add;
7211 0 0         if ($N<0) {
7212             # 1 to N
7213 0           $N = -$N;
7214 0 0         if ($$val>$N) {
    0          
7215 0           $$rem+= int(($$val-1)/$N);
7216 0           $$val = ($$val-1)%$N +1;
7217             } elsif ($$val<1) {
7218 0           $$rem-= int(-$$val/$N)+1;
7219 0           $$val = $N-(-$$val % $N);
7220             }
7221              
7222             } else {
7223             # 0 to N-1
7224 0 0         if ($$val>($N-1)) {
    0          
7225 0           $$rem+= int($$val/$N);
7226 0           $$val = $$val%$N;
7227             } elsif ($$val<0) {
7228 0           $$rem-= int(-($$val+1)/$N)+1;
7229 0           $$val = ($N-1)-(-($$val+1)%$N);
7230             }
7231             }
7232             }
7233              
7234             # $Flag=_IsInt($String [,$low, $high]);
7235             # Returns 1 if $String is a valid integer, 0 otherwise. If $low is
7236             # entered, $String must be >= $low. If $high is entered, $String must
7237             # be <= $high. It is valid to check only one of the bounds.
7238             sub _IsInt {
7239 0     0     my($N,$low,$high)=@_;
7240 0 0 0       return 0 if (! defined $N or
      0        
      0        
      0        
      0        
7241             $N !~ /^\s*[-+]?\d+\s*$/ or
7242             defined $low && $N<$low or
7243             defined $high && $N>$high);
7244 0           return 1;
7245             }
7246              
7247             # $File=_CleanFile($file);
7248             # This cleans up a path to remove the following things:
7249             # double slash /a//b -> /a/b
7250             # trailing dot /a/. -> /a
7251             # leading dot ./a -> a
7252             # trailing slash a/ -> a
7253             sub _CleanFile {
7254 0     0     my($file)=@_;
7255 0           $file =~ s/\s*$//;
7256 0           $file =~ s/^\s*//;
7257 0           $file =~ s|//+|/|g; # multiple slash
7258 0           $file =~ s|/\.$|/|; # trailing /. (leaves trailing slash)
7259 0 0         $file =~ s|^\./|| # leading ./
7260             if ($file ne "./");
7261 0 0         $file =~ s|/$|| # trailing slash
7262             if ($file ne "/");
7263 0           return $file;
7264             }
7265              
7266             # $File=_ExpandTilde($file);
7267             # This checks to see if a "~" appears as the first character in a path.
7268             # If it does, the "~" expansion is interpreted (if possible) and the full
7269             # path is returned. If a "~" expansion is used but cannot be
7270             # interpreted, an empty string is returned.
7271             #
7272             # This is Windows/Mac friendly.
7273             # This is efficient.
7274             sub _ExpandTilde {
7275 0     0     my($file)=shift;
7276 0           my($user,$home)=();
7277             # ~aaa/bbb= ~ aaa /bbb
7278 0 0         if ($file =~ s|^~([^/]*)||) {
7279 0           $user=$1;
7280             # Single user operating systems (Mac, MSWindows) don't have the getpwnam
7281             # and getpwuid routines defined. Try to catch various different ways
7282             # of knowing we are on one of these systems:
7283 0 0 0       return "" if ($OS eq "Windows" or
      0        
      0        
7284             $OS eq "Mac" or
7285             $OS eq "Netware" or
7286             $OS eq "MPE");
7287 0 0         $user="" if (! defined $user);
7288              
7289 0 0         if ($user) {
7290 0           $home= (getpwnam($user))[7];
7291             } else {
7292 0           $home= (getpwuid($<))[7];
7293             }
7294 0 0         $home = VMS::Filespec::unixpath($home) if ($OS eq "VMS");
7295 0 0         return "" if (! defined $home);
7296 0           $file="$home/$file";
7297             }
7298 0           $file;
7299             }
7300              
7301             # $File=_FullFilePath($file);
7302             # Returns the full or relative path to $file (expanding "~" if necessary).
7303             # Returns an empty string if a "~" expansion cannot be interpreted. The
7304             # path does not need to exist. _CleanFile is called.
7305             sub _FullFilePath {
7306 0     0     my($file)=shift;
7307 0           my($rootpat) = '^/'; #default pattern to match absolute path
7308 0 0         $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
7309 0           $file=_ExpandTilde($file);
7310 0 0         return "" if (! defined $file);
7311 0           return _CleanFile($file);
7312             }
7313              
7314             # $Flag=_CheckFilePath($file [,$mode]);
7315             # Checks to see if $file exists, to see what type it is, and whether
7316             # the script can access it. If it exists and has the correct mode, 1
7317             # is returned.
7318             #
7319             # $mode is a string which may contain any of the valid file test operator
7320             # characters except t, M, A, C. The appropriate test is run for each
7321             # character. For example, if $mode is "re" the -r and -e tests are both
7322             # run.
7323             #
7324             # An empty string is returned if the file doesn't exist. A 0 is returned
7325             # if the file exists but any test fails.
7326             #
7327             # All characters in $mode which do not correspond to valid tests are
7328             # ignored.
7329             sub _CheckFilePath {
7330 0     0     my($file,$mode)=@_;
7331 0           my($test)=();
7332 0           $file=_FullFilePath($file);
7333 0 0         $mode = "" if (! defined $mode);
7334              
7335             # Run tests
7336 0 0 0       return 0 if (! defined $file or ! $file);
7337 0 0 0       return 0 if (( ! -e $file) or
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
7338             ($mode =~ /r/ && ! -r $file) or
7339             ($mode =~ /w/ && ! -w $file) or
7340             ($mode =~ /x/ && ! -x $file) or
7341             ($mode =~ /R/ && ! -R $file) or
7342             ($mode =~ /W/ && ! -W $file) or
7343             ($mode =~ /X/ && ! -X $file) or
7344             ($mode =~ /o/ && ! -o $file) or
7345             ($mode =~ /O/ && ! -O $file) or
7346             ($mode =~ /z/ && ! -z $file) or
7347             ($mode =~ /s/ && ! -s $file) or
7348             ($mode =~ /f/ && ! -f $file) or
7349             ($mode =~ /d/ && ! -d $file) or
7350             ($mode =~ /l/ && ! -l $file) or
7351             ($mode =~ /s/ && ! -s $file) or
7352             ($mode =~ /p/ && ! -p $file) or
7353             ($mode =~ /b/ && ! -b $file) or
7354             ($mode =~ /c/ && ! -c $file) or
7355             ($mode =~ /u/ && ! -u $file) or
7356             ($mode =~ /g/ && ! -g $file) or
7357             ($mode =~ /k/ && ! -k $file) or
7358             ($mode =~ /T/ && ! -T $file) or
7359             ($mode =~ /B/ && ! -B $file));
7360 0           return 1;
7361             }
7362             #&&
7363              
7364             # $Path=_FixPath($path [,$full] [,$mode] [,$error]);
7365             # Makes sure that every directory in $path (a colon separated list of
7366             # directories) appears as a full path or relative path. All "~"
7367             # expansions are removed. All trailing slashes are removed also. If
7368             # $full is non-nil, relative paths are expanded to full paths as well.
7369             #
7370             # If $mode is given, it may be either "e", "r", or "w". In this case,
7371             # additional checking is done to each directory. If $mode is "e", it
7372             # need ony exist to pass the check. If $mode is "r", it must have have
7373             # read and execute permission. If $mode is "w", it must have read,
7374             # write, and execute permission.
7375             #
7376             # The value of $error determines what happens if the directory does not
7377             # pass the test. If it is non-nil, if any directory does not pass the
7378             # test, the subroutine returns the empty string. Otherwise, it is simply
7379             # removed from $path.
7380             #
7381             # The corrected path is returned.
7382             sub _FixPath {
7383 0     0     my($path,$full,$mode,$err)=@_;
7384 0           local($_)="";
7385 0           my(@dir)=split(/$Cnf{"PathSep"}/,$path);
7386 0 0         $full=0 if (! defined $full);
7387 0 0         $mode="" if (! defined $mode);
7388 0 0         $err=0 if (! defined $err);
7389 0           $path="";
7390 0 0         if ($mode eq "e") {
    0          
    0          
7391 0           $mode="de";
7392             } elsif ($mode eq "r") {
7393 0           $mode="derx";
7394             } elsif ($mode eq "w") {
7395 0           $mode="derwx";
7396             }
7397              
7398 0           foreach (@dir) {
7399              
7400             # Expand path
7401 0 0         if ($full) {
7402 0           $_=_FullFilePath($_);
7403             } else {
7404 0           $_=_ExpandTilde($_);
7405             }
7406 0 0         if (! defined $_) {
7407 0 0         return "" if ($err);
7408 0           next;
7409             }
7410              
7411             # Check mode
7412 0 0 0       if (! defined $mode or _CheckFilePath($_,$mode)) {
7413 0           $path .= $Cnf{"PathSep"} . $_;
7414             } else {
7415 0 0         return "" if ($err);
7416             }
7417             }
7418 0           $path =~ s/^$Cnf{"PathSep"}//;
7419 0           return $path;
7420             }
7421             #&&
7422              
7423             # $File=_SearchPath($file,$path [,$mode] [,@suffixes]);
7424             # Searches through directories in $path for a file named $file. The
7425             # full path is returned if one is found, or an empty string otherwise.
7426             # The file may exist with one of the @suffixes. The mode is checked
7427             # similar to _CheckFilePath.
7428             #
7429             # The first full path that matches the name and mode is returned. If none
7430             # is found, an empty string is returned.
7431             sub _SearchPath {
7432 0     0     my($file,$path,$mode,@suff)=@_;
7433 0           my($f,$s,$d,@dir,$fs)=();
7434 0           $path=_FixPath($path,1,"r");
7435 0           @dir=split(/$Cnf{"PathSep"}/,$path);
7436 0           foreach $d (@dir) {
7437 0           $f="$d/$file";
7438 0           $f=~ s|//|/|g;
7439 0 0         return $f if (_CheckFilePath($f,$mode));
7440 0           foreach $s (@suff) {
7441 0           $fs="$f.$s";
7442 0 0         return $fs if (_CheckFilePath($fs,$mode));
7443             }
7444             }
7445 0           return "";
7446             }
7447              
7448             # @list=_ReturnList($str);
7449             # This takes a string which should be a comma separated list of integers
7450             # or ranges (5-7). It returns a sorted list of all integers referred to
7451             # by the string, or () if there is an invalid element.
7452             #
7453             # Negative integers are also handled. "-2--1" is equivalent to "-2,-1".
7454             sub _ReturnList {
7455 0     0     my($str)=@_;
7456 0           my(@ret,@str,$from,$to,$tmp)=();
7457 0           @str=split(/,/,$str);
7458 0           foreach $str (@str) {
7459 0 0         if ($str =~ /^[-+]?\d+$/) {
    0          
7460 0           push(@ret,$str);
7461             } elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {
7462 0           ($from,$to)=($1,$2);
7463 0 0         if ($from>$to) {
7464 0           $tmp=$from;
7465 0           $from=$to;
7466 0           $to=$tmp;
7467             }
7468 0           push(@ret,$from..$to);
7469             } else {
7470 0           return ();
7471             }
7472             }
7473 0           @ret;
7474             }
7475              
7476             1;
7477             # Local Variables:
7478             # mode: cperl
7479             # indent-tabs-mode: nil
7480             # cperl-indent-level: 3
7481             # cperl-continued-statement-offset: 2
7482             # cperl-continued-brace-offset: 0
7483             # cperl-brace-offset: 0
7484             # cperl-brace-imaginary-offset: 0
7485             # cperl-label-offset: 0
7486             # End: