|
655
|
1 |
package Date::Manip;
|
|
|
2 |
# Copyright (c) 1995-2003 Sullivan Beck. All rights reserved.
|
|
|
3 |
# This program is free software; you can redistribute it and/or modify it
|
|
|
4 |
# under the same terms as Perl itself.
|
|
|
5 |
|
|
|
6 |
###########################################################################
|
|
|
7 |
###########################################################################
|
|
|
8 |
|
|
|
9 |
use vars qw($OS %Lang %Holiday %Events %Curr %Cnf %Zone $VERSION @ISA @EXPORT);
|
|
|
10 |
|
|
|
11 |
# Determine the type of OS...
|
|
|
12 |
$OS="Unix";
|
|
|
13 |
$OS="Windows" if ((defined $^O and
|
|
|
14 |
$^O =~ /MSWin32/i ||
|
|
|
15 |
$^O =~ /Windows_95/i ||
|
|
|
16 |
$^O =~ /Windows_NT/i) ||
|
|
|
17 |
(defined $ENV{OS} and
|
|
|
18 |
$ENV{OS} =~ /MSWin32/i ||
|
|
|
19 |
$ENV{OS} =~ /Windows_95/i ||
|
|
|
20 |
$ENV{OS} =~ /Windows_NT/i));
|
|
|
21 |
$OS="Netware" if (defined $^O and
|
|
|
22 |
$^O =~ /NetWare/i);
|
|
|
23 |
$OS="Mac" if ((defined $^O and
|
|
|
24 |
$^O =~ /MacOS/i) ||
|
|
|
25 |
(defined $ENV{OS} and
|
|
|
26 |
$ENV{OS} =~ /MacOS/i));
|
|
|
27 |
$OS="MPE" if (defined $^O and
|
|
|
28 |
$^O =~ /MPE/i);
|
|
|
29 |
$OS="OS2" if (defined $^O and
|
|
|
30 |
$^O =~ /os2/i);
|
|
|
31 |
$OS="VMS" if (defined $^O and
|
|
|
32 |
$^O =~ /VMS/i);
|
|
|
33 |
|
|
|
34 |
# Determine if we're doing taint checking
|
|
|
35 |
$Date::Manip::NoTaint = eval { local $^W; unlink "$^X$^T"; 1 };
|
|
|
36 |
|
|
|
37 |
###########################################################################
|
|
|
38 |
# CUSTOMIZATION
|
|
|
39 |
###########################################################################
|
|
|
40 |
#
|
|
|
41 |
# See the section of the POD documentation section CUSTOMIZING DATE::MANIP
|
|
|
42 |
# below for a complete description of each of these variables.
|
|
|
43 |
|
|
|
44 |
|
|
|
45 |
# Location of a the global config file. Tilde (~) expansions are allowed.
|
|
|
46 |
# This should be set in Date_Init arguments.
|
|
|
47 |
$Cnf{"GlobalCnf"}="";
|
|
|
48 |
$Cnf{"IgnoreGlobalCnf"}="";
|
|
|
49 |
|
|
|
50 |
# Name of a personal config file and the path to search for it. Tilde (~)
|
|
|
51 |
# expansions are allowed. This should be set in Date_Init arguments or in
|
|
|
52 |
# the global config file.
|
|
|
53 |
|
|
|
54 |
@Date::Manip::DatePath=();
|
|
|
55 |
if ($OS eq "Windows") {
|
|
|
56 |
$Cnf{"PathSep"} = ";";
|
|
|
57 |
$Cnf{"PersonalCnf"} = "Manip.cnf";
|
|
|
58 |
$Cnf{"PersonalCnfPath"} = ".";
|
|
|
59 |
|
|
|
60 |
} elsif ($OS eq "Netware") {
|
|
|
61 |
$Cnf{"PathSep"} = ";";
|
|
|
62 |
$Cnf{"PersonalCnf"} = "Manip.cnf";
|
|
|
63 |
$Cnf{"PersonalCnfPath"} = ".";
|
|
|
64 |
|
|
|
65 |
} elsif ($OS eq "MPE") {
|
|
|
66 |
$Cnf{"PathSep"} = ":";
|
|
|
67 |
$Cnf{"PersonalCnf"} = "Manip.cnf";
|
|
|
68 |
$Cnf{"PersonalCnfPath"} = ".";
|
|
|
69 |
|
|
|
70 |
} elsif ($OS eq "OS2") {
|
|
|
71 |
$Cnf{"PathSep"} = ":";
|
|
|
72 |
$Cnf{"PersonalCnf"} = "Manip.cnf";
|
|
|
73 |
$Cnf{"PersonalCnfPath"} = ".";
|
|
|
74 |
|
|
|
75 |
} elsif ($OS eq "Mac") {
|
|
|
76 |
$Cnf{"PathSep"} = ":";
|
|
|
77 |
$Cnf{"PersonalCnf"} = "Manip.cnf";
|
|
|
78 |
$Cnf{"PersonalCnfPath"} = ".";
|
|
|
79 |
|
|
|
80 |
} elsif ($OS eq "VMS") {
|
|
|
81 |
# VMS doesn't like files starting with "."
|
|
|
82 |
$Cnf{"PathSep"} = "\n";
|
|
|
83 |
$Cnf{"PersonalCnf"} = "Manip.cnf";
|
|
|
84 |
$Cnf{"PersonalCnfPath"} = ".\n~";
|
|
|
85 |
|
|
|
86 |
} else {
|
|
|
87 |
# Unix
|
|
|
88 |
$Cnf{"PathSep"} = ":";
|
|
|
89 |
$Cnf{"PersonalCnf"} = ".DateManip.cnf";
|
|
|
90 |
$Cnf{"PersonalCnfPath"} = ".:~";
|
|
|
91 |
@Date::Manip::DatePath=qw(/bin /usr/bin /usr/local/bin);
|
|
|
92 |
}
|
|
|
93 |
|
|
|
94 |
### Date::Manip variables set in the global or personal config file
|
|
|
95 |
|
|
|
96 |
# Which language to use when parsing dates.
|
|
|
97 |
$Cnf{"Language"}="English";
|
|
|
98 |
|
|
|
99 |
# 12/10 = Dec 10 (US) or Oct 12 (anything else)
|
|
|
100 |
$Cnf{"DateFormat"}="US";
|
|
|
101 |
|
|
|
102 |
# Local timezone
|
|
|
103 |
$Cnf{"TZ"}="";
|
|
|
104 |
|
|
|
105 |
# Timezone to work in (""=local, "IGNORE", or a timezone)
|
|
|
106 |
$Cnf{"ConvTZ"}="";
|
|
|
107 |
|
|
|
108 |
# Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
|
|
|
109 |
$Cnf{"Internal"}=0;
|
|
|
110 |
|
|
|
111 |
# First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
|
|
|
112 |
$Cnf{"FirstDay"}=1;
|
|
|
113 |
|
|
|
114 |
# First and last day of the work week (1=monday, 7=sunday)
|
|
|
115 |
$Cnf{"WorkWeekBeg"}=1;
|
|
|
116 |
$Cnf{"WorkWeekEnd"}=5;
|
|
|
117 |
|
|
|
118 |
# If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
|
|
|
119 |
# ignored)
|
|
|
120 |
$Cnf{"WorkDay24Hr"}=0;
|
|
|
121 |
|
|
|
122 |
# Start and end time of the work day (any time format allowed, seconds
|
|
|
123 |
# ignored)
|
|
|
124 |
$Cnf{"WorkDayBeg"}="08:00";
|
|
|
125 |
$Cnf{"WorkDayEnd"}="17:00";
|
|
|
126 |
|
|
|
127 |
# If "today" is a holiday, we look either to "tomorrow" or "yesterday" for
|
|
|
128 |
# the nearest business day. By default, we'll always look "tomorrow"
|
|
|
129 |
# first.
|
|
|
130 |
$Cnf{"TomorrowFirst"}=1;
|
|
|
131 |
|
|
|
132 |
# Erase the old holidays
|
|
|
133 |
$Cnf{"EraseHolidays"}="";
|
|
|
134 |
|
|
|
135 |
# Set this to non-zero to be produce completely backwards compatible deltas
|
|
|
136 |
$Cnf{"DeltaSigns"}=0;
|
|
|
137 |
|
|
|
138 |
# If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
|
|
|
139 |
# make week 1 contain Jan 1.
|
|
|
140 |
$Cnf{"Jan1Week1"}=0;
|
|
|
141 |
|
|
|
142 |
# 2 digit years fall into the 100 year period given by [ CURR-N,
|
|
|
143 |
# CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful
|
|
|
144 |
# numbers might be 0 (forced to be this year or later) and 99 (forced to be
|
|
|
145 |
# this year or earlier). It can also be set to "c" (current century) or
|
|
|
146 |
# "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the
|
|
|
147 |
# form cNNNN to give the 100 year period NNNN to NNNN+99.
|
|
|
148 |
$Cnf{"YYtoYYYY"}=89;
|
|
|
149 |
|
|
|
150 |
# Set this to 1 if you want a long-running script to always update the
|
|
|
151 |
# timezone. This will slow Date::Manip down. Read the POD documentation.
|
|
|
152 |
$Cnf{"UpdateCurrTZ"}=0;
|
|
|
153 |
|
|
|
154 |
# Use an international character set.
|
|
|
155 |
$Cnf{"IntCharSet"}=0;
|
|
|
156 |
|
|
|
157 |
# Use this to force the current date to be set to this:
|
|
|
158 |
$Cnf{"ForceDate"}="";
|
|
|
159 |
|
|
|
160 |
###########################################################################
|
|
|
161 |
|
|
|
162 |
require 5.000;
|
|
|
163 |
require Exporter;
|
|
|
164 |
@ISA = qw(Exporter);
|
|
|
165 |
@EXPORT = qw(
|
|
|
166 |
DateManipVersion
|
|
|
167 |
Date_Init
|
|
|
168 |
ParseDateString
|
|
|
169 |
ParseDate
|
|
|
170 |
ParseRecur
|
|
|
171 |
Date_Cmp
|
|
|
172 |
DateCalc
|
|
|
173 |
ParseDateDelta
|
|
|
174 |
UnixDate
|
|
|
175 |
Delta_Format
|
|
|
176 |
Date_GetPrev
|
|
|
177 |
Date_GetNext
|
|
|
178 |
Date_SetTime
|
|
|
179 |
Date_SetDateField
|
|
|
180 |
Date_IsHoliday
|
|
|
181 |
Events_List
|
|
|
182 |
|
|
|
183 |
Date_DaysInMonth
|
|
|
184 |
Date_DayOfWeek
|
|
|
185 |
Date_SecsSince1970
|
|
|
186 |
Date_SecsSince1970GMT
|
|
|
187 |
Date_DaysSince1BC
|
|
|
188 |
Date_DayOfYear
|
|
|
189 |
Date_DaysInYear
|
|
|
190 |
Date_WeekOfYear
|
|
|
191 |
Date_LeapYear
|
|
|
192 |
Date_DaySuffix
|
|
|
193 |
Date_ConvTZ
|
|
|
194 |
Date_TimeZone
|
|
|
195 |
Date_IsWorkDay
|
|
|
196 |
Date_NextWorkDay
|
|
|
197 |
Date_PrevWorkDay
|
|
|
198 |
Date_NearestWorkDay
|
|
|
199 |
Date_NthDayOfYear
|
|
|
200 |
);
|
|
|
201 |
use strict;
|
|
|
202 |
use integer;
|
|
|
203 |
use Carp;
|
|
|
204 |
|
|
|
205 |
use IO::File;
|
|
|
206 |
|
|
|
207 |
$VERSION="5.42";
|
|
|
208 |
|
|
|
209 |
########################################################################
|
|
|
210 |
########################################################################
|
|
|
211 |
|
|
|
212 |
$Curr{"InitLang"} = 1; # Whether a language is being init'ed
|
|
|
213 |
$Curr{"InitDone"} = 0; # Whether Init_Date has been called
|
|
|
214 |
$Curr{"InitFilesRead"} = 0;
|
|
|
215 |
$Curr{"ResetWorkDay"} = 1;
|
|
|
216 |
$Curr{"Debug"} = "";
|
|
|
217 |
$Curr{"DebugVal"} = "";
|
|
|
218 |
|
|
|
219 |
$Holiday{"year"} = 0;
|
|
|
220 |
$Holiday{"dates"} = {};
|
|
|
221 |
$Holiday{"desc"} = {};
|
|
|
222 |
|
|
|
223 |
$Events{"raw"} = [];
|
|
|
224 |
$Events{"parsed"} = 0;
|
|
|
225 |
$Events{"dates"} = [];
|
|
|
226 |
$Events{"recur"} = [];
|
|
|
227 |
|
|
|
228 |
########################################################################
|
|
|
229 |
########################################################################
|
|
|
230 |
# THESE ARE THE MAIN ROUTINES
|
|
|
231 |
########################################################################
|
|
|
232 |
########################################################################
|
|
|
233 |
|
|
|
234 |
# Get rid of a problem with old versions of perl
|
|
|
235 |
no strict "vars";
|
|
|
236 |
# This sorts from longest to shortest element
|
|
|
237 |
sub sortByLength {
|
|
|
238 |
return (length $b <=> length $a);
|
|
|
239 |
}
|
|
|
240 |
use strict "vars";
|
|
|
241 |
|
|
|
242 |
sub DateManipVersion {
|
|
|
243 |
print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
244 |
return $VERSION;
|
|
|
245 |
}
|
|
|
246 |
|
|
|
247 |
sub Date_Init {
|
|
|
248 |
print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
249 |
$Curr{"Debug"}="";
|
|
|
250 |
|
|
|
251 |
my(@args)=@_;
|
|
|
252 |
$Curr{"InitDone"}=1;
|
|
|
253 |
local($_)=();
|
|
|
254 |
my($internal,$firstday)=();
|
|
|
255 |
my($var,$val,$file,@tmp)=();
|
|
|
256 |
|
|
|
257 |
# InitFilesRead = 0 : no conf files read yet
|
|
|
258 |
# 1 : global read, no personal read
|
|
|
259 |
# 2 : personal read
|
|
|
260 |
|
|
|
261 |
$Cnf{"EraseHolidays"}=0;
|
|
|
262 |
foreach (@args) {
|
|
|
263 |
s/\s*$//;
|
|
|
264 |
s/^\s*//;
|
|
|
265 |
/^(\S+) \s* = \s* (.+)$/x;
|
|
|
266 |
($var,$val)=($1,$2);
|
|
|
267 |
if ($var =~ /^GlobalCnf$/i) {
|
|
|
268 |
$Cnf{"GlobalCnf"}=$val;
|
|
|
269 |
if ($val) {
|
|
|
270 |
$Curr{"InitFilesRead"}=0;
|
|
|
271 |
&EraseHolidays();
|
|
|
272 |
}
|
|
|
273 |
} elsif ($var =~ /^PathSep$/i) {
|
|
|
274 |
$Cnf{"PathSep"}=$val;
|
|
|
275 |
} elsif ($var =~ /^PersonalCnf$/i) {
|
|
|
276 |
$Cnf{"PersonalCnf"}=$val;
|
|
|
277 |
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
|
|
|
278 |
} elsif ($var =~ /^PersonalCnfPath$/i) {
|
|
|
279 |
$Cnf{"PersonalCnfPath"}=$val;
|
|
|
280 |
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
|
|
|
281 |
} elsif ($var =~ /^IgnoreGlobalCnf$/i) {
|
|
|
282 |
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0);
|
|
|
283 |
$Cnf{"IgnoreGlobalCnf"}=1;
|
|
|
284 |
} elsif ($var =~ /^EraseHolidays$/i) {
|
|
|
285 |
&EraseHolidays();
|
|
|
286 |
} else {
|
|
|
287 |
push(@tmp,$_);
|
|
|
288 |
}
|
|
|
289 |
}
|
|
|
290 |
@args=@tmp;
|
|
|
291 |
|
|
|
292 |
# Read global config file
|
|
|
293 |
if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
|
|
|
294 |
$Curr{"InitFilesRead"}=1;
|
|
|
295 |
|
|
|
296 |
if ($Cnf{"GlobalCnf"}) {
|
|
|
297 |
$file=&ExpandTilde($Cnf{"GlobalCnf"});
|
|
|
298 |
&Date_InitFile($file) if ($file);
|
|
|
299 |
}
|
|
|
300 |
}
|
|
|
301 |
|
|
|
302 |
# Read personal config file
|
|
|
303 |
if ($Curr{"InitFilesRead"}<2) {
|
|
|
304 |
$Curr{"InitFilesRead"}=2;
|
|
|
305 |
|
|
|
306 |
if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) {
|
|
|
307 |
$file=&SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r");
|
|
|
308 |
&Date_InitFile($file) if ($file);
|
|
|
309 |
}
|
|
|
310 |
}
|
|
|
311 |
|
|
|
312 |
foreach (@args) {
|
|
|
313 |
s/\s*$//;
|
|
|
314 |
s/^\s*//;
|
|
|
315 |
/^(\S+) \s* = \s* (.*)$/x;
|
|
|
316 |
($var,$val)=($1,$2);
|
|
|
317 |
$val="" if (! defined $val);
|
|
|
318 |
&Date_SetConfigVariable($var,$val);
|
|
|
319 |
}
|
|
|
320 |
|
|
|
321 |
confess "ERROR: Unknown FirstDay in Date::Manip.\n"
|
|
|
322 |
if (! &IsInt($Cnf{"FirstDay"},1,7));
|
|
|
323 |
confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n"
|
|
|
324 |
if (! &IsInt($Cnf{"WorkWeekBeg"},1,7));
|
|
|
325 |
confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n"
|
|
|
326 |
if (! &IsInt($Cnf{"WorkWeekEnd"},1,7));
|
|
|
327 |
confess "ERROR: Invalid WorkWeek in Date::Manip.\n"
|
|
|
328 |
if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"});
|
|
|
329 |
|
|
|
330 |
my(%lang,
|
|
|
331 |
$tmp,%tmp,$tmp2,@tmp2,
|
|
|
332 |
$i,$j,@tmp3,
|
|
|
333 |
$zonesrfc,@zones)=();
|
|
|
334 |
|
|
|
335 |
my($L)=$Cnf{"Language"};
|
|
|
336 |
|
|
|
337 |
if ($Curr{"InitLang"}) {
|
|
|
338 |
$Curr{"InitLang"}=0;
|
|
|
339 |
|
|
|
340 |
if ($L eq "English") {
|
|
|
341 |
&Date_Init_English(\%lang);
|
|
|
342 |
|
|
|
343 |
} elsif ($L eq "French") {
|
|
|
344 |
&Date_Init_French(\%lang);
|
|
|
345 |
|
|
|
346 |
} elsif ($L eq "Swedish") {
|
|
|
347 |
&Date_Init_Swedish(\%lang);
|
|
|
348 |
|
|
|
349 |
} elsif ($L eq "German") {
|
|
|
350 |
&Date_Init_German(\%lang);
|
|
|
351 |
|
|
|
352 |
} elsif ($L eq "Polish") {
|
|
|
353 |
&Date_Init_Polish(\%lang);
|
|
|
354 |
|
|
|
355 |
} elsif ($L eq "Dutch" ||
|
|
|
356 |
$L eq "Nederlands") {
|
|
|
357 |
&Date_Init_Dutch(\%lang);
|
|
|
358 |
|
|
|
359 |
} elsif ($L eq "Spanish") {
|
|
|
360 |
&Date_Init_Spanish(\%lang);
|
|
|
361 |
|
|
|
362 |
} elsif ($L eq "Portuguese") {
|
|
|
363 |
&Date_Init_Portuguese(\%lang);
|
|
|
364 |
|
|
|
365 |
} elsif ($L eq "Romanian") {
|
|
|
366 |
&Date_Init_Romanian(\%lang);
|
|
|
367 |
|
|
|
368 |
} elsif ($L eq "Italian") {
|
|
|
369 |
&Date_Init_Italian(\%lang);
|
|
|
370 |
|
|
|
371 |
} elsif ($L eq "Russian") {
|
|
|
372 |
&Date_Init_Russian(\%lang);
|
|
|
373 |
|
|
|
374 |
} elsif ($L eq "Turkish") {
|
|
|
375 |
&Date_Init_Turkish(\%lang);
|
|
|
376 |
|
|
|
377 |
} elsif ($L eq "Danish") {
|
|
|
378 |
&Date_Init_Danish(\%lang);
|
|
|
379 |
|
|
|
380 |
} else {
|
|
|
381 |
confess "ERROR: Unknown language in Date::Manip.\n";
|
|
|
382 |
}
|
|
|
383 |
|
|
|
384 |
# variables for months
|
|
|
385 |
# Month = "(jan|january|feb|february ... )"
|
|
|
386 |
# MonL = [ "Jan","Feb",... ]
|
|
|
387 |
# MonthL = [ "January","February", ... ]
|
|
|
388 |
# MonthH = { "january"=>1, "jan"=>1, ... }
|
|
|
389 |
|
|
|
390 |
$Lang{$L}{"MonthH"}={};
|
|
|
391 |
$Lang{$L}{"MonthL"}=[];
|
|
|
392 |
$Lang{$L}{"MonL"}=[];
|
|
|
393 |
&Date_InitLists([$lang{"month_name"},
|
|
|
394 |
$lang{"month_abb"}],
|
|
|
395 |
\$Lang{$L}{"Month"},"lc,sort,back",
|
|
|
396 |
[$Lang{$L}{"MonthL"},
|
|
|
397 |
$Lang{$L}{"MonL"}],
|
|
|
398 |
[$Lang{$L}{"MonthH"},1]);
|
|
|
399 |
|
|
|
400 |
# variables for day of week
|
|
|
401 |
# Week = "(mon|monday|tue|tuesday ... )"
|
|
|
402 |
# WL = [ "M","T",... ]
|
|
|
403 |
# WkL = [ "Mon","Tue",... ]
|
|
|
404 |
# WeekL = [ "Monday","Tudesday",... ]
|
|
|
405 |
# WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
|
|
|
406 |
|
|
|
407 |
$Lang{$L}{"WeekH"}={};
|
|
|
408 |
$Lang{$L}{"WeekL"}=[];
|
|
|
409 |
$Lang{$L}{"WkL"}=[];
|
|
|
410 |
$Lang{$L}{"WL"}=[];
|
|
|
411 |
&Date_InitLists([$lang{"day_name"},
|
|
|
412 |
$lang{"day_abb"}],
|
|
|
413 |
\$Lang{$L}{"Week"},"lc,sort,back",
|
|
|
414 |
[$Lang{$L}{"WeekL"},
|
|
|
415 |
$Lang{$L}{"WkL"}],
|
|
|
416 |
[$Lang{$L}{"WeekH"},1]);
|
|
|
417 |
&Date_InitLists([$lang{"day_char"}],
|
|
|
418 |
"","lc",
|
|
|
419 |
[$Lang{$L}{"WL"}],
|
|
|
420 |
[\%tmp,1]);
|
|
|
421 |
%{ $Lang{$L}{"WeekH"} } =
|
|
|
422 |
(%{ $Lang{$L}{"WeekH"} },%tmp);
|
|
|
423 |
|
|
|
424 |
# variables for last
|
|
|
425 |
# Last = "(last)"
|
|
|
426 |
# LastL = [ "last" ]
|
|
|
427 |
# Each = "(each)"
|
|
|
428 |
# EachL = [ "each" ]
|
|
|
429 |
# variables for day of month
|
|
|
430 |
# DoM = "(1st|first ... 31st)"
|
|
|
431 |
# DoML = [ "1st","2nd",... "31st" ]
|
|
|
432 |
# DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 }
|
|
|
433 |
# variables for week of month
|
|
|
434 |
# WoM = "(1st|first| ... 5th|last)"
|
|
|
435 |
# WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 }
|
|
|
436 |
|
|
|
437 |
$Lang{$L}{"LastL"}=$lang{"last"};
|
|
|
438 |
&Date_InitStrings($lang{"last"},
|
|
|
439 |
\$Lang{$L}{"Last"},"lc,sort");
|
|
|
440 |
|
|
|
441 |
$Lang{$L}{"EachL"}=$lang{"each"};
|
|
|
442 |
&Date_InitStrings($lang{"each"},
|
|
|
443 |
\$Lang{$L}{"Each"},"lc,sort");
|
|
|
444 |
|
|
|
445 |
$Lang{$L}{"DoMH"}={};
|
|
|
446 |
$Lang{$L}{"DoML"}=[];
|
|
|
447 |
&Date_InitLists([$lang{"num_suff"},
|
|
|
448 |
$lang{"num_word"}],
|
|
|
449 |
\$Lang{$L}{"DoM"},"lc,sort,back,escape",
|
|
|
450 |
[$Lang{$L}{"DoML"},
|
|
|
451 |
\@tmp],
|
|
|
452 |
[$Lang{$L}{"DoMH"},1]);
|
|
|
453 |
|
|
|
454 |
@tmp=();
|
|
|
455 |
foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
|
|
|
456 |
$tmp2=$Lang{$L}{"DoMH"}{$tmp};
|
|
|
457 |
if ($tmp2<6) {
|
|
|
458 |
$Lang{$L}{"WoMH"}{$tmp} = $tmp2;
|
|
|
459 |
push(@tmp,$tmp);
|
|
|
460 |
}
|
|
|
461 |
}
|
|
|
462 |
foreach $tmp (@{ $Lang{$L}{"LastL"} }) {
|
|
|
463 |
$Lang{$L}{"WoMH"}{$tmp} = -1;
|
|
|
464 |
push(@tmp,$tmp);
|
|
|
465 |
}
|
|
|
466 |
&Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"},
|
|
|
467 |
"lc,sort,back,escape");
|
|
|
468 |
|
|
|
469 |
# variables for AM or PM
|
|
|
470 |
# AM = "(am)"
|
|
|
471 |
# PM = "(pm)"
|
|
|
472 |
# AmPm = "(am|pm)"
|
|
|
473 |
# AMstr = "AM"
|
|
|
474 |
# PMstr = "PM"
|
|
|
475 |
|
|
|
476 |
&Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape");
|
|
|
477 |
&Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape");
|
|
|
478 |
&Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"},
|
|
|
479 |
"lc,back,sort,escape");
|
|
|
480 |
$Lang{$L}{"AMstr"}=$lang{"am"}[0];
|
|
|
481 |
$Lang{$L}{"PMstr"}=$lang{"pm"}[0];
|
|
|
482 |
|
|
|
483 |
# variables for expressions used in parsing deltas
|
|
|
484 |
# Yabb = "(?:y|yr|year|years)"
|
|
|
485 |
# Mabb = similar for months
|
|
|
486 |
# Wabb = similar for weeks
|
|
|
487 |
# Dabb = similar for days
|
|
|
488 |
# Habb = similar for hours
|
|
|
489 |
# MNabb = similar for minutes
|
|
|
490 |
# Sabb = similar for seconds
|
|
|
491 |
# Repl = { "abb"=>"replacement" }
|
|
|
492 |
# Whenever an abbreviation could potentially refer to two different
|
|
|
493 |
# strings (M standing for Minutes or Months), the abbreviation must
|
|
|
494 |
# be listed in Repl instead of in the appropriate Xabb values. This
|
|
|
495 |
# only applies to abbreviations which are substrings of other values
|
|
|
496 |
# (so there is no confusion between Mn and Month).
|
|
|
497 |
|
|
|
498 |
&Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort");
|
|
|
499 |
&Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort");
|
|
|
500 |
&Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort");
|
|
|
501 |
&Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort");
|
|
|
502 |
&Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort");
|
|
|
503 |
&Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort");
|
|
|
504 |
&Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort");
|
|
|
505 |
$Lang{$L}{"Repl"}={};
|
|
|
506 |
&Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
|
|
|
507 |
|
|
|
508 |
# variables for special dates that are offsets from now
|
|
|
509 |
# Now = "(now|today)"
|
|
|
510 |
# Offset = "(yesterday|tomorrow)"
|
|
|
511 |
# OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ]
|
|
|
512 |
# Times = "(noon|midnight)"
|
|
|
513 |
# TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" }
|
|
|
514 |
# SepHM = hour/minute separator
|
|
|
515 |
# SepMS = minute/second separator
|
|
|
516 |
# SepSS = second/fraction separator
|
|
|
517 |
|
|
|
518 |
$Lang{$L}{"TimesH"}={};
|
|
|
519 |
&Date_InitHash($lang{"times"},
|
|
|
520 |
\$Lang{$L}{"Times"},"lc,sort,back",
|
|
|
521 |
$Lang{$L}{"TimesH"});
|
|
|
522 |
&Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort");
|
|
|
523 |
$Lang{$L}{"OffsetH"}={};
|
|
|
524 |
&Date_InitHash($lang{"offset"},
|
|
|
525 |
\$Lang{$L}{"Offset"},"lc,sort,back",
|
|
|
526 |
$Lang{$L}{"OffsetH"});
|
|
|
527 |
$Lang{$L}{"SepHM"}=$lang{"sephm"};
|
|
|
528 |
$Lang{$L}{"SepMS"}=$lang{"sepms"};
|
|
|
529 |
$Lang{$L}{"SepSS"}=$lang{"sepss"};
|
|
|
530 |
|
|
|
531 |
# variables for time zones
|
|
|
532 |
# zones = regular expression with all zone names (EST)
|
|
|
533 |
# n2o = a hash of all parsable zone names with their offsets
|
|
|
534 |
# tzones = reguar expression with all tzdata timezones (US/Eastern)
|
|
|
535 |
# tz2z = hash of all tzdata timezones to full timezone (EST#EDT)
|
|
|
536 |
|
|
|
537 |
$zonesrfc=
|
|
|
538 |
"idlw -1200 ". # International Date Line West
|
|
|
539 |
"nt -1100 ". # Nome
|
|
|
540 |
"hst -1000 ". # Hawaii Standard
|
|
|
541 |
"cat -1000 ". # Central Alaska
|
|
|
542 |
"ahst -1000 ". # Alaska-Hawaii Standard
|
|
|
543 |
"akst -0900 ". # Alaska Standard
|
|
|
544 |
"yst -0900 ". # Yukon Standard
|
|
|
545 |
"hdt -0900 ". # Hawaii Daylight
|
|
|
546 |
"akdt -0800 ". # Alaska Daylight
|
|
|
547 |
"ydt -0800 ". # Yukon Daylight
|
|
|
548 |
"pst -0800 ". # Pacific Standard
|
|
|
549 |
"pdt -0700 ". # Pacific Daylight
|
|
|
550 |
"mst -0700 ". # Mountain Standard
|
|
|
551 |
"mdt -0600 ". # Mountain Daylight
|
|
|
552 |
"cst -0600 ". # Central Standard
|
|
|
553 |
"cdt -0500 ". # Central Daylight
|
|
|
554 |
"est -0500 ". # Eastern Standard
|
|
|
555 |
"act -0500 ". # Brazil, Acre
|
|
|
556 |
"sat -0400 ". # Chile
|
|
|
557 |
"bot -0400 ". # Bolivia
|
|
|
558 |
"amt -0400 ". # Brazil, Amazon
|
|
|
559 |
"acst -0400 ". # Brazil, Acre Daylight
|
|
|
560 |
"edt -0400 ". # Eastern Daylight
|
|
|
561 |
"ast -0400 ". # Atlantic Standard
|
|
|
562 |
#"nst -0330 ". # Newfoundland Standard nst=North Sumatra +0630
|
|
|
563 |
"nft -0330 ". # Newfoundland
|
|
|
564 |
#"gst -0300 ". # Greenland Standard gst=Guam Standard +1000
|
|
|
565 |
#"bst -0300 ". # Brazil Standard bst=British Summer +0100
|
|
|
566 |
"brt -0300 ". # Brazil Standard (official time)
|
|
|
567 |
"brst -0300 ". # Brazil Standard
|
|
|
568 |
"adt -0300 ". # Atlantic Daylight
|
|
|
569 |
"art -0300 ". # Argentina
|
|
|
570 |
"amst -0300 ". # Brazil, Amazon Daylight
|
|
|
571 |
"ndt -0230 ". # Newfoundland Daylight
|
|
|
572 |
"brst -0200 ". # Brazil Daylight (official time)
|
|
|
573 |
"fnt -0200 ". # Brazil, Fernando de Noronha
|
|
|
574 |
"at -0200 ". # Azores
|
|
|
575 |
"wat -0100 ". # West Africa
|
|
|
576 |
"fnst -0100 ". # Brazil, Fernando de Noronha Daylight
|
|
|
577 |
"gmt +0000 ". # Greenwich Mean
|
|
|
578 |
"ut +0000 ". # Universal
|
|
|
579 |
"utc +0000 ". # Universal (Coordinated)
|
|
|
580 |
"wet +0000 ". # Western European
|
|
|
581 |
"cet +0100 ". # Central European
|
|
|
582 |
"fwt +0100 ". # French Winter
|
|
|
583 |
"met +0100 ". # Middle European
|
|
|
584 |
"mez +0100 ". # Middle European
|
|
|
585 |
"mewt +0100 ". # Middle European Winter
|
|
|
586 |
"swt +0100 ". # Swedish Winter
|
|
|
587 |
"bst +0100 ". # British Summer bst=Brazil standard -0300
|
|
|
588 |
"gb +0100 ". # GMT with daylight savings
|
|
|
589 |
"west +0000 ". # Western European Daylight
|
|
|
590 |
"eet +0200 ". # Eastern Europe, USSR Zone 1
|
|
|
591 |
"cest +0200 ". # Central European Summer
|
|
|
592 |
"fst +0200 ". # French Summer
|
|
|
593 |
"ist +0200 ". # Israel standard
|
|
|
594 |
"mest +0200 ". # Middle European Summer
|
|
|
595 |
"mesz +0200 ". # Middle European Summer
|
|
|
596 |
"metdst +0200 ". # An alias for mest used by HP-UX
|
|
|
597 |
"sast +0200 ". # South African Standard
|
|
|
598 |
"sst +0200 ". # Swedish Summer sst=South Sumatra +0700
|
|
|
599 |
"bt +0300 ". # Baghdad, USSR Zone 2
|
|
|
600 |
"eest +0300 ". # Eastern Europe Summer
|
|
|
601 |
"eetedt +0300 ". # Eastern Europe, USSR Zone 1
|
|
|
602 |
"idt +0300 ". # Israel Daylight
|
|
|
603 |
"msk +0300 ". # Moscow
|
|
|
604 |
"eat +0300 ". # East Africa
|
|
|
605 |
"it +0330 ". # Iran
|
|
|
606 |
"zp4 +0400 ". # USSR Zone 3
|
|
|
607 |
"msd +0400 ". # Moscow Daylight
|
|
|
608 |
"zp5 +0500 ". # USSR Zone 4
|
|
|
609 |
"ist +0530 ". # Indian Standard
|
|
|
610 |
"zp6 +0600 ". # USSR Zone 5
|
|
|
611 |
"novst +0600 ". # Novosibirsk time zone, Russia
|
|
|
612 |
"nst +0630 ". # North Sumatra nst=Newfoundland Std -0330
|
|
|
613 |
#"sst +0700 ". # South Sumatra, USSR Zone 6 sst=Swedish Summer +0200
|
|
|
614 |
"javt +0700 ". # Java
|
|
|
615 |
"hkt +0800 ". # Hong Kong
|
|
|
616 |
"sgt +0800 ". # Singapore
|
|
|
617 |
"cct +0800 ". # China Coast, USSR Zone 7
|
|
|
618 |
"awst +0800 ". # Australian Western Standard
|
|
|
619 |
"wst +0800 ". # West Australian Standard
|
|
|
620 |
"pht +0800 ". # Asia Manila
|
|
|
621 |
"kst +0900 ". # Republic of Korea
|
|
|
622 |
"jst +0900 ". # Japan Standard, USSR Zone 8
|
|
|
623 |
"rok +0900 ". # Republic of Korea
|
|
|
624 |
"acst +0930 ". # Australian Central Standard
|
|
|
625 |
"cast +0930 ". # Central Australian Standard
|
|
|
626 |
"aest +1000 ". # Australian Eastern Standard
|
|
|
627 |
"east +1000 ". # Eastern Australian Standard
|
|
|
628 |
"gst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
|
|
|
629 |
"acdt +1030 ". # Australian Central Daylight
|
|
|
630 |
"cadt +1030 ". # Central Australian Daylight
|
|
|
631 |
"aedt +1100 ". # Australian Eastern Daylight
|
|
|
632 |
"eadt +1100 ". # Eastern Australian Daylight
|
|
|
633 |
"idle +1200 ". # International Date Line East
|
|
|
634 |
"nzst +1200 ". # New Zealand Standard
|
|
|
635 |
"nzt +1200 ". # New Zealand
|
|
|
636 |
"nzdt +1300 ". # New Zealand Daylight
|
|
|
637 |
"z +0000 ".
|
|
|
638 |
"a +0100 b +0200 c +0300 d +0400 e +0500 f +0600 g +0700 h +0800 ".
|
|
|
639 |
"i +0900 k +1000 l +1100 m +1200 ".
|
|
|
640 |
"n -0100 o -0200 p -0300 q -0400 r -0500 s -0600 t -0700 u -0800 ".
|
|
|
641 |
"v -0900 w -1000 x -1100 y -1200";
|
|
|
642 |
|
|
|
643 |
$Zone{"n2o"} = {};
|
|
|
644 |
($Zone{"zones"},%{ $Zone{"n2o"} })=
|
|
|
645 |
&Date_Regexp($zonesrfc,"sort,lc,under,back",
|
|
|
646 |
"keys");
|
|
|
647 |
|
|
|
648 |
$tmp=
|
|
|
649 |
"US/Pacific PST8PDT ".
|
|
|
650 |
"US/Mountain MST7MDT ".
|
|
|
651 |
"US/Central CST6CDT ".
|
|
|
652 |
"US/Eastern EST5EDT ".
|
|
|
653 |
"Canada/Pacific PST8PDT ".
|
|
|
654 |
"Canada/Mountain MST7MDT ".
|
|
|
655 |
"Canada/Central CST6CDT ".
|
|
|
656 |
"Canada/Eastern EST5EDT";
|
|
|
657 |
|
|
|
658 |
$Zone{"tz2z"} = {};
|
|
|
659 |
($Zone{"tzones"},%{ $Zone{"tz2z"} })=
|
|
|
660 |
&Date_Regexp($tmp,"lc,under,back","keys");
|
|
|
661 |
$Cnf{"TZ"}=&Date_TimeZone;
|
|
|
662 |
|
|
|
663 |
# misc. variables
|
|
|
664 |
# At = "(?:at)"
|
|
|
665 |
# Of = "(?:in|of)"
|
|
|
666 |
# On = "(?:on)"
|
|
|
667 |
# Future = "(?:in)"
|
|
|
668 |
# Later = "(?:later)"
|
|
|
669 |
# Past = "(?:ago)"
|
|
|
670 |
# Next = "(?:next)"
|
|
|
671 |
# Prev = "(?:last|previous)"
|
|
|
672 |
|
|
|
673 |
&Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort");
|
|
|
674 |
&Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort");
|
|
|
675 |
&Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort");
|
|
|
676 |
&Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort");
|
|
|
677 |
&Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort");
|
|
|
678 |
&Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort");
|
|
|
679 |
&Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort");
|
|
|
680 |
&Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort");
|
|
|
681 |
|
|
|
682 |
# calc mode variables
|
|
|
683 |
# Approx = "(?:approximately)"
|
|
|
684 |
# Exact = "(?:exactly)"
|
|
|
685 |
# Business = "(?:business)"
|
|
|
686 |
|
|
|
687 |
&Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort");
|
|
|
688 |
&Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort");
|
|
|
689 |
&Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort");
|
|
|
690 |
|
|
|
691 |
############### END OF LANGUAGE INITIALIZATION
|
|
|
692 |
}
|
|
|
693 |
|
|
|
694 |
if ($Curr{"ResetWorkDay"}) {
|
|
|
695 |
my($h1,$m1,$h2,$m2)=();
|
|
|
696 |
if ($Cnf{"WorkDay24Hr"}) {
|
|
|
697 |
($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
|
|
|
698 |
($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
|
|
|
699 |
$Curr{"WDlen"}=24*60;
|
|
|
700 |
$Cnf{"WorkDayBeg"}="00:00";
|
|
|
701 |
$Cnf{"WorkDayEnd"}="23:59";
|
|
|
702 |
|
|
|
703 |
} else {
|
|
|
704 |
confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n"
|
|
|
705 |
if (! (($h1,$m1)=&CheckTime($Cnf{"WorkDayBeg"})));
|
|
|
706 |
$Cnf{"WorkDayBeg"}="$h1:$m1";
|
|
|
707 |
confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n"
|
|
|
708 |
if (! (($h2,$m2)=&CheckTime($Cnf{"WorkDayEnd"})));
|
|
|
709 |
$Cnf{"WorkDayEnd"}="$h2:$m2";
|
|
|
710 |
|
|
|
711 |
($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
|
|
|
712 |
($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
|
|
|
713 |
|
|
|
714 |
# Work day length = h1:m1 or 0:len (len minutes)
|
|
|
715 |
$h1=$h2-$h1;
|
|
|
716 |
$m1=$m2-$m1;
|
|
|
717 |
if ($m1<0) {
|
|
|
718 |
$h1--;
|
|
|
719 |
$m1+=60;
|
|
|
720 |
}
|
|
|
721 |
$Curr{"WDlen"}=$h1*60+$m1;
|
|
|
722 |
}
|
|
|
723 |
$Curr{"ResetWorkDay"}=0;
|
|
|
724 |
}
|
|
|
725 |
|
|
|
726 |
# current time
|
|
|
727 |
my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
|
|
|
728 |
if ($Cnf{"ForceDate"}=~
|
|
|
729 |
/^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
|
|
|
730 |
($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
|
|
|
731 |
} else {
|
|
|
732 |
($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
|
|
|
733 |
$y+=1900;
|
|
|
734 |
$m++;
|
|
|
735 |
}
|
|
|
736 |
&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
|
|
|
737 |
$Curr{"Y"}=$y;
|
|
|
738 |
$Curr{"M"}=$m;
|
|
|
739 |
$Curr{"D"}=$d;
|
|
|
740 |
$Curr{"H"}=$h;
|
|
|
741 |
$Curr{"Mn"}=$mn;
|
|
|
742 |
$Curr{"S"}=$s;
|
|
|
743 |
$Curr{"AmPm"}=$ampm;
|
|
|
744 |
$Curr{"Now"}=&Date_Join($y,$m,$d,$h,$mn,$s);
|
|
|
745 |
|
|
|
746 |
$Curr{"Debug"}=$Curr{"DebugVal"};
|
|
|
747 |
|
|
|
748 |
# If we're in array context, let's return a list of config variables
|
|
|
749 |
# that could be passed to Date_Init to get the same state as we're
|
|
|
750 |
# currently in.
|
|
|
751 |
if (wantarray) {
|
|
|
752 |
# Some special variables that have to be in a specific order
|
|
|
753 |
my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
|
|
|
754 |
my(%tmp)=map { $_,1 } @special;
|
|
|
755 |
my(@tmp,$key,$val);
|
|
|
756 |
foreach $key (@special) {
|
|
|
757 |
$val=$Cnf{$key};
|
|
|
758 |
push(@tmp,"$key=$val");
|
|
|
759 |
}
|
|
|
760 |
foreach $key (keys %Cnf) {
|
|
|
761 |
next if (exists $tmp{$key});
|
|
|
762 |
$val=$Cnf{$key};
|
|
|
763 |
push(@tmp,"$key=$val");
|
|
|
764 |
}
|
|
|
765 |
return @tmp;
|
|
|
766 |
}
|
|
|
767 |
return ();
|
|
|
768 |
}
|
|
|
769 |
|
|
|
770 |
sub ParseDateString {
|
|
|
771 |
print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
772 |
local($_)=@_;
|
|
|
773 |
return "" if (! $_);
|
|
|
774 |
|
|
|
775 |
my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
|
|
|
776 |
my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
|
|
|
777 |
|
|
|
778 |
# We only need to reinitialize if we have to determine what NOW is.
|
|
|
779 |
&Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
|
|
|
780 |
|
|
|
781 |
my($L)=$Cnf{"Language"};
|
|
|
782 |
my($type)=$Cnf{"DateFormat"};
|
|
|
783 |
|
|
|
784 |
# Mode is set in DateCalc. ParseDate only overrides it if the string
|
|
|
785 |
# contains a mode.
|
|
|
786 |
if ($Lang{$L}{"Exact"} &&
|
|
|
787 |
s/$Lang{$L}{"Exact"}//) {
|
|
|
788 |
$Curr{"Mode"}=0;
|
|
|
789 |
} elsif ($Lang{$L}{"Approx"} &&
|
|
|
790 |
s/$Lang{$L}{"Approx"}//) {
|
|
|
791 |
$Curr{"Mode"}=1;
|
|
|
792 |
} elsif ($Lang{$L}{"Business"} &&
|
|
|
793 |
s/$Lang{$L}{"Business"}//) {
|
|
|
794 |
$Curr{"Mode"}=2;
|
|
|
795 |
} elsif (! exists $Curr{"Mode"}) {
|
|
|
796 |
$Curr{"Mode"}=0;
|
|
|
797 |
}
|
|
|
798 |
|
|
|
799 |
# Unfortunately, some deltas can be parsed as dates. An example is
|
|
|
800 |
# 1 second == 1 2nd == 1 2
|
|
|
801 |
# But, some dates can be parsed as deltas. The most important being:
|
|
|
802 |
# 1998010101:00:00
|
|
|
803 |
# We'll check to see if a "date" can be parsed as a delta. If so, we'll
|
|
|
804 |
# assume that it is a delta (since they are much simpler, it is much
|
|
|
805 |
# less likely that we'll mistake a delta for a date than vice versa)
|
|
|
806 |
# unless it is an ISO-8601 date.
|
|
|
807 |
#
|
|
|
808 |
# This is important because we are using DateCalc to test whether a
|
|
|
809 |
# string is a date or a delta. Dates are tested first, so we need to
|
|
|
810 |
# be able to pass a delta into this routine and have it correctly NOT
|
|
|
811 |
# interpreted as a date.
|
|
|
812 |
#
|
|
|
813 |
# We will insist that the string contain something other than digits and
|
|
|
814 |
# colons so that the following will get correctly interpreted as a date
|
|
|
815 |
# rather than a delta:
|
|
|
816 |
# 12:30
|
|
|
817 |
# 19980101
|
|
|
818 |
|
|
|
819 |
$delta="";
|
|
|
820 |
$delta=&ParseDateDelta($_) if (/[^:0-9]/);
|
|
|
821 |
|
|
|
822 |
# Put parse in a simple loop for an easy exit.
|
|
|
823 |
PARSE: {
|
|
|
824 |
my(@tmp)=&Date_Split($_);
|
|
|
825 |
if (@tmp) {
|
|
|
826 |
($y,$m,$d,$h,$mn,$s)=@tmp;
|
|
|
827 |
last PARSE;
|
|
|
828 |
}
|
|
|
829 |
|
|
|
830 |
# Fundamental regular expressions
|
|
|
831 |
|
|
|
832 |
my($month)=$Lang{$L}{"Month"}; # (jan|january|...)
|
|
|
833 |
my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
|
|
|
834 |
my($week)=$Lang{$L}{"Week"}; # (mon|monday|...)
|
|
|
835 |
my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
|
|
|
836 |
my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last)
|
|
|
837 |
my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
|
|
|
838 |
my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st)
|
|
|
839 |
my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
|
|
|
840 |
my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm)
|
|
|
841 |
my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight)
|
|
|
842 |
my($now)=$Lang{$L}{"Now"}; # (now|today)
|
|
|
843 |
my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow)
|
|
|
844 |
my($zone)=$Zone{"zones"} . '(?:\s+|$)'; # (edt|est|...)\s+
|
|
|
845 |
my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days)
|
|
|
846 |
my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months)
|
|
|
847 |
my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks)
|
|
|
848 |
my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next)
|
|
|
849 |
my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous)
|
|
|
850 |
my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago)
|
|
|
851 |
my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in)
|
|
|
852 |
my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later)
|
|
|
853 |
my($at)=$Lang{$L}{"At"}; # (?:at)
|
|
|
854 |
my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of)
|
|
|
855 |
my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)';
|
|
|
856 |
# \s*(?:on)\s* or \s+
|
|
|
857 |
my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last)
|
|
|
858 |
my($hm)=$Lang{$L}{"SepHM"}; # :
|
|
|
859 |
my($ms)=$Lang{$L}{"SepMS"}; # :
|
|
|
860 |
my($ss)=$Lang{$L}{"SepSS"}; # .
|
|
|
861 |
|
|
|
862 |
# Other regular expressions
|
|
|
863 |
|
|
|
864 |
my($D4)='(\d{4})'; # 4 digits (yr)
|
|
|
865 |
my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr)
|
|
|
866 |
my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
|
|
|
867 |
my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
|
|
|
868 |
my($FS)="(?:$ss\\d+)?"; # fractional secs
|
|
|
869 |
my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
|
|
|
870 |
# absolute time zone +0700 (GMT)
|
|
|
871 |
my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23
|
|
|
872 |
my($mzone)='(?:[0-5][0-9])'; # 00 - 59
|
|
|
873 |
my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))".
|
|
|
874 |
# +0700 +07:00 -07
|
|
|
875 |
'(?:\s*\([^)]+\))?)'; # (GMT)
|
|
|
876 |
|
|
|
877 |
# A regular expression for the time EXCEPT for the hour part
|
|
|
878 |
my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
|
|
|
879 |
|
|
|
880 |
# A special regular expression for /YYYY:HH:MN:SS used by Apache
|
|
|
881 |
my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
|
|
|
882 |
|
|
|
883 |
my($time)="";
|
|
|
884 |
$ampm="";
|
|
|
885 |
$date="";
|
|
|
886 |
|
|
|
887 |
# Substitute all special time expressions.
|
|
|
888 |
if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
|
|
|
889 |
$tmp=$2;
|
|
|
890 |
$tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
|
|
|
891 |
s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
|
|
|
892 |
}
|
|
|
893 |
|
|
|
894 |
# Remove some punctuation
|
|
|
895 |
s/[,]/ /g;
|
|
|
896 |
|
|
|
897 |
# Make sure that ...7EST works (i.e. a timezone immediately following
|
|
|
898 |
# a digit.
|
|
|
899 |
s/(\d)$zone(\s+|$|[0-9])/$1 $2$3/i;
|
|
|
900 |
$zone = '\s+'.$zone;
|
|
|
901 |
|
|
|
902 |
# Remove the time
|
|
|
903 |
$iso=1;
|
|
|
904 |
$midnight=0;
|
|
|
905 |
$from="24${hm}00(?:${ms}00)?";
|
|
|
906 |
$falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
|
|
|
907 |
$to="00${hm}00${ms}00";
|
|
|
908 |
$midnight=1 if (!/$falsefrom/ && s/$from/$to/);
|
|
|
909 |
|
|
|
910 |
$h=$mn=$s=0;
|
|
|
911 |
if (/$D$mnsec/i || /$ampmexp/i) {
|
|
|
912 |
$iso=0;
|
|
|
913 |
$tmp=0;
|
|
|
914 |
$tmp=1 if (/$mnsec$zone2?\s*$/i); # or /$mnsec$zone/ ??
|
|
|
915 |
$tmp=0 if (/$ampmexp/i);
|
|
|
916 |
if (s/$apachetime$zone()/$1 /i ||
|
|
|
917 |
s/$apachetime$zone2?/$1 /i ||
|
|
|
918 |
s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i ||
|
|
|
919 |
s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i ||
|
|
|
920 |
s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i ||
|
|
|
921 |
s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i ||
|
|
|
922 |
(s/(t)$D$mnsec$zone()/$1 /i and (($iso=-$tmp) || 1)) ||
|
|
|
923 |
(s/(t)$D$mnsec$zone2?/$1 /i and (($iso=-$tmp) || 1)) ||
|
|
|
924 |
(s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) ||
|
|
|
925 |
(s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) ||
|
|
|
926 |
s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i ||
|
|
|
927 |
s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i ||
|
|
|
928 |
0
|
|
|
929 |
) {
|
|
|
930 |
($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
|
|
|
931 |
if (defined ($z)) {
|
|
|
932 |
if ($z =~ /^[+-]\d{2}:\d{2}$/) {
|
|
|
933 |
$z=~ s/://;
|
|
|
934 |
} elsif ($z =~ /^[+-]\d{2}$/) {
|
|
|
935 |
$z .= "00";
|
|
|
936 |
}
|
|
|
937 |
}
|
|
|
938 |
$time=1;
|
|
|
939 |
&Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
|
|
|
940 |
$y=$m=$d="";
|
|
|
941 |
# We're going to be calling TimeCheck again below (when we check the
|
|
|
942 |
# final date), so get rid of $ampm so that we don't have an error
|
|
|
943 |
# due to "15:30:00 PM". It'll get reset below.
|
|
|
944 |
$ampm="";
|
|
|
945 |
if (/^\s*$/) {
|
|
|
946 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
947 |
last PARSE;
|
|
|
948 |
}
|
|
|
949 |
}
|
|
|
950 |
}
|
|
|
951 |
$time=0 if ($time ne "1");
|
|
|
952 |
s/\s+$//;
|
|
|
953 |
s/^\s+//;
|
|
|
954 |
|
|
|
955 |
# dateTtime ISO 8601 formats
|
|
|
956 |
my($orig)=$_;
|
|
|
957 |
s/t$//i if ($iso<0);
|
|
|
958 |
|
|
|
959 |
# Parse ISO 8601 dates now (which may still have a zone stuck to it).
|
|
|
960 |
if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) ||
|
|
|
961 |
($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) ||
|
|
|
962 |
($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) ||
|
|
|
963 |
($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) ||
|
|
|
964 |
0) {
|
|
|
965 |
|
|
|
966 |
# ISO 8601 dates
|
|
|
967 |
($_,$z,$z2) = ($1,$2);
|
|
|
968 |
s,-, ,g; # Change all ISO8601 seps to spaces
|
|
|
969 |
s/^\s+//;
|
|
|
970 |
s/\s+$//;
|
|
|
971 |
|
|
|
972 |
if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
|
|
|
973 |
/^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
|
|
|
974 |
0
|
|
|
975 |
) {
|
|
|
976 |
# ISO 8601 Dates with times
|
|
|
977 |
# YYYYMMDDHHMNSSFFFF...
|
|
|
978 |
# YYYYMMDDHHMNSS
|
|
|
979 |
# YYYYMMDDHHMN
|
|
|
980 |
# YYYYMMDDHH
|
|
|
981 |
# YY MMDDHHMNSSFFFF...
|
|
|
982 |
# YY MMDDHHMNSS
|
|
|
983 |
# YY MMDDHHMN
|
|
|
984 |
# YY MMDDHH
|
|
|
985 |
($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
|
|
|
986 |
if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) {
|
|
|
987 |
$h=0;
|
|
|
988 |
$midnight=1;
|
|
|
989 |
}
|
|
|
990 |
$z = "" if (! defined $h);
|
|
|
991 |
return "" if ($time && defined $h);
|
|
|
992 |
last PARSE;
|
|
|
993 |
|
|
|
994 |
} elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
|
|
|
995 |
/^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
|
|
|
996 |
# ISO 8601 Dates
|
|
|
997 |
# YYYYMMDD
|
|
|
998 |
# YYYYMM
|
|
|
999 |
# YYYY
|
|
|
1000 |
# YY MMDD
|
|
|
1001 |
# YY MM
|
|
|
1002 |
# YY
|
|
|
1003 |
($y,$m,$d)=($1,$2,$3);
|
|
|
1004 |
last PARSE;
|
|
|
1005 |
|
|
|
1006 |
} elsif (/^$YY\s+$D\s+$D/) {
|
|
|
1007 |
# YY-M-D
|
|
|
1008 |
($y,$m,$d)=($1,$2,$3);
|
|
|
1009 |
last PARSE;
|
|
|
1010 |
|
|
|
1011 |
} elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
|
|
|
1012 |
# YY-W##-D
|
|
|
1013 |
($y,$wofm,$dofw)=($1,$2,$3);
|
|
|
1014 |
($y,$m,$d)=&Date_NthWeekOfYear($y,$wofm,$dofw);
|
|
|
1015 |
last PARSE;
|
|
|
1016 |
|
|
|
1017 |
} elsif (/^$D4\s*(\d{3})$/ ||
|
|
|
1018 |
/^$DD\s*(\d{3})$/) {
|
|
|
1019 |
# YYDOY
|
|
|
1020 |
($y,$which)=($1,$2);
|
|
|
1021 |
($y,$m,$d)=&Date_NthDayOfYear($y,$which);
|
|
|
1022 |
last PARSE;
|
|
|
1023 |
|
|
|
1024 |
} elsif ($iso<0) {
|
|
|
1025 |
# We confused something like 1999/August12:00:00
|
|
|
1026 |
# with a dateTtime format
|
|
|
1027 |
$_=$orig;
|
|
|
1028 |
|
|
|
1029 |
} else {
|
|
|
1030 |
return "";
|
|
|
1031 |
}
|
|
|
1032 |
}
|
|
|
1033 |
|
|
|
1034 |
# All deltas that are not ISO-8601 dates are NOT dates.
|
|
|
1035 |
return "" if ($Curr{"InCalc"} && $delta);
|
|
|
1036 |
if ($delta) {
|
|
|
1037 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1038 |
return &DateCalc_DateDelta($Curr{"Now"},$delta);
|
|
|
1039 |
}
|
|
|
1040 |
|
|
|
1041 |
# Check for some special types of dates (next, prev)
|
|
|
1042 |
foreach $from (keys %{ $Lang{$L}{"Repl"} }) {
|
|
|
1043 |
$to=$Lang{$L}{"Repl"}{$from};
|
|
|
1044 |
s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
|
|
|
1045 |
}
|
|
|
1046 |
if (/$wom/i || /$future/i || /$later/i || /$past/i ||
|
|
|
1047 |
/$next/i || /$prev/i || /^$week$/i || /$wkabb/i) {
|
|
|
1048 |
$tmp=0;
|
|
|
1049 |
|
|
|
1050 |
if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
|
|
|
1051 |
# last friday in October 95
|
|
|
1052 |
($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
|
|
|
1053 |
# fix $m, $y
|
|
|
1054 |
return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
|
|
1055 |
$dofw=$week{lc($dofw)};
|
|
|
1056 |
$wofm=$wom{lc($wofm)};
|
|
|
1057 |
# Get the first day of the month
|
|
|
1058 |
$date=&Date_Join($y,$m,1,$h,$mn,$s);
|
|
|
1059 |
if ($wofm==-1) {
|
|
|
1060 |
$date=&DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0);
|
|
|
1061 |
$date=&Date_GetPrev($date,$dofw,0);
|
|
|
1062 |
} else {
|
|
|
1063 |
for ($i=0; $i<$wofm; $i++) {
|
|
|
1064 |
if ($i==0) {
|
|
|
1065 |
$date=&Date_GetNext($date,$dofw,1);
|
|
|
1066 |
} else {
|
|
|
1067 |
$date=&Date_GetNext($date,$dofw,0);
|
|
|
1068 |
}
|
|
|
1069 |
}
|
|
|
1070 |
}
|
|
|
1071 |
last PARSE;
|
|
|
1072 |
|
|
|
1073 |
} elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
|
|
|
1074 |
# last day in month
|
|
|
1075 |
($m,$y)=($1,$2);
|
|
|
1076 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1077 |
$y=&Date_FixYear($y) if (! defined $y or length($y)<4);
|
|
|
1078 |
$m=$month{lc($m)};
|
|
|
1079 |
$d=&Date_DaysInMonth($m,$y);
|
|
|
1080 |
last PARSE;
|
|
|
1081 |
|
|
|
1082 |
} elsif (/^$week$/i) {
|
|
|
1083 |
# friday
|
|
|
1084 |
($dofw)=($1);
|
|
|
1085 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1086 |
$date=&Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1);
|
|
|
1087 |
$date=&Date_GetNext($date,$dofw,1,$h,$mn,$s);
|
|
|
1088 |
last PARSE;
|
|
|
1089 |
|
|
|
1090 |
} elsif (/^$next\s*$week$/i) {
|
|
|
1091 |
# next friday
|
|
|
1092 |
($dofw)=($1);
|
|
|
1093 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1094 |
$date=&Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s);
|
|
|
1095 |
last PARSE;
|
|
|
1096 |
|
|
|
1097 |
} elsif (/^$prev\s*$week$/i) {
|
|
|
1098 |
# last friday
|
|
|
1099 |
($dofw)=($1);
|
|
|
1100 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1101 |
$date=&Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s);
|
|
|
1102 |
last PARSE;
|
|
|
1103 |
|
|
|
1104 |
} elsif (/^$next$wkabb$/i) {
|
|
|
1105 |
# next week
|
|
|
1106 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1107 |
$date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0);
|
|
|
1108 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1109 |
last PARSE;
|
|
|
1110 |
} elsif (/^$prev$wkabb$/i) {
|
|
|
1111 |
# last week
|
|
|
1112 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1113 |
$date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0);
|
|
|
1114 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1115 |
last PARSE;
|
|
|
1116 |
|
|
|
1117 |
} elsif (/^$next$mabb$/i) {
|
|
|
1118 |
# next month
|
|
|
1119 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1120 |
$date=&DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0);
|
|
|
1121 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1122 |
last PARSE;
|
|
|
1123 |
} elsif (/^$prev$mabb$/i) {
|
|
|
1124 |
# last month
|
|
|
1125 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1126 |
$date=&DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0);
|
|
|
1127 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1128 |
last PARSE;
|
|
|
1129 |
|
|
|
1130 |
} elsif (/^$future\s*(\d+)$day$/i ||
|
|
|
1131 |
/^(\d+)$day$later$/i) {
|
|
|
1132 |
# in 2 days
|
|
|
1133 |
# 2 days later
|
|
|
1134 |
($num)=($1);
|
|
|
1135 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1136 |
$date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0",
|
|
|
1137 |
\$err,0);
|
|
|
1138 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1139 |
last PARSE;
|
|
|
1140 |
} elsif (/^(\d+)$day$past$/i) {
|
|
|
1141 |
# 2 days ago
|
|
|
1142 |
($num)=($1);
|
|
|
1143 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1144 |
$date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0",
|
|
|
1145 |
\$err,0);
|
|
|
1146 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1147 |
last PARSE;
|
|
|
1148 |
|
|
|
1149 |
} elsif (/^$future\s*(\d+)$wkabb$/i ||
|
|
|
1150 |
/^(\d+)$wkabb$later$/i) {
|
|
|
1151 |
# in 2 weeks
|
|
|
1152 |
# 2 weeks later
|
|
|
1153 |
($num)=($1);
|
|
|
1154 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1155 |
$date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0",
|
|
|
1156 |
\$err,0);
|
|
|
1157 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1158 |
last PARSE;
|
|
|
1159 |
} elsif (/^(\d+)$wkabb$past$/i) {
|
|
|
1160 |
# 2 weeks ago
|
|
|
1161 |
($num)=($1);
|
|
|
1162 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1163 |
$date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0",
|
|
|
1164 |
\$err,0);
|
|
|
1165 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1166 |
last PARSE;
|
|
|
1167 |
|
|
|
1168 |
} elsif (/^$future\s*(\d+)$mabb$/i ||
|
|
|
1169 |
/^(\d+)$mabb$later$/i) {
|
|
|
1170 |
# in 2 months
|
|
|
1171 |
# 2 months later
|
|
|
1172 |
($num)=($1);
|
|
|
1173 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1174 |
$date=&DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0",
|
|
|
1175 |
\$err,0);
|
|
|
1176 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1177 |
last PARSE;
|
|
|
1178 |
} elsif (/^(\d+)$mabb$past$/i) {
|
|
|
1179 |
# 2 months ago
|
|
|
1180 |
($num)=($1);
|
|
|
1181 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1182 |
$date=&DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0",
|
|
|
1183 |
\$err,0);
|
|
|
1184 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1185 |
last PARSE;
|
|
|
1186 |
|
|
|
1187 |
} elsif (/^$week$future\s*(\d+)$wkabb$/i ||
|
|
|
1188 |
/^$week\s*(\d+)$wkabb$later$/i) {
|
|
|
1189 |
# friday in 2 weeks
|
|
|
1190 |
# friday 2 weeks later
|
|
|
1191 |
($dofw,$num)=($1,$2);
|
|
|
1192 |
$tmp="+";
|
|
|
1193 |
} elsif (/^$week\s*(\d+)$wkabb$past$/i) {
|
|
|
1194 |
# friday 2 weeks ago
|
|
|
1195 |
($dofw,$num)=($1,$2);
|
|
|
1196 |
$tmp="-";
|
|
|
1197 |
} elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
|
|
|
1198 |
/^(\d+)$wkabb$later$on$week$/i) {
|
|
|
1199 |
# in 2 weeks on friday
|
|
|
1200 |
# 2 weeks later on friday
|
|
|
1201 |
($num,$dofw)=($1,$2);
|
|
|
1202 |
$tmp="+"
|
|
|
1203 |
} elsif (/^(\d+)$wkabb$past$on$week$/i) {
|
|
|
1204 |
# 2 weeks ago on friday
|
|
|
1205 |
($num,$dofw)=($1,$2);
|
|
|
1206 |
$tmp="-";
|
|
|
1207 |
} elsif (/^$week\s*$wkabb$/i) {
|
|
|
1208 |
# monday week (British date: in 1 week on monday)
|
|
|
1209 |
$dofw=$1;
|
|
|
1210 |
$num=1;
|
|
|
1211 |
$tmp="+";
|
|
|
1212 |
} elsif (/^$now\s*$wkabb$/i) {
|
|
|
1213 |
# today week (British date: 1 week from today)
|
|
|
1214 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1215 |
$date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0);
|
|
|
1216 |
$date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
|
|
|
1217 |
last PARSE;
|
|
|
1218 |
} elsif (/^$offset\s*$wkabb$/i) {
|
|
|
1219 |
# tomorrow week (British date: 1 week from tomorrow)
|
|
|
1220 |
($offset)=($1);
|
|
|
1221 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1222 |
$offset=$Lang{$L}{"OffsetH"}{lc($offset)};
|
|
|
1223 |
$date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
|
|
|
1224 |
$date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0);
|
|
|
1225 |
if ($time) {
|
|
|
1226 |
return ""
|
|
|
1227 |
if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
|
|
1228 |
$date=&Date_SetTime($date,$h,$mn,$s);
|
|
|
1229 |
}
|
|
|
1230 |
last PARSE;
|
|
|
1231 |
}
|
|
|
1232 |
|
|
|
1233 |
if ($tmp) {
|
|
|
1234 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1235 |
$date=&DateCalc_DateDelta($Curr{"Now"},
|
|
|
1236 |
$tmp . "0:0:$num:0:0:0:0",\$err,0);
|
|
|
1237 |
$date=&Date_GetPrev($date,$Cnf{"FirstDay"},1);
|
|
|
1238 |
$date=&Date_GetNext($date,$dofw,1,$h,$mn,$s);
|
|
|
1239 |
last PARSE;
|
|
|
1240 |
}
|
|
|
1241 |
}
|
|
|
1242 |
|
|
|
1243 |
# Change (2nd, second) to 2
|
|
|
1244 |
$tmp=0;
|
|
|
1245 |
if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
|
|
|
1246 |
if (/^\s*$dom\s*$/) {
|
|
|
1247 |
($d)=($1);
|
|
|
1248 |
$d=$dom{lc($d)};
|
|
|
1249 |
$m=$Curr{"M"};
|
|
|
1250 |
last PARSE;
|
|
|
1251 |
}
|
|
|
1252 |
my $from = $2;
|
|
|
1253 |
my $to = $dom{ lc($from) };
|
|
|
1254 |
s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
|
|
|
1255 |
s/^\s+//;
|
|
|
1256 |
s/\s+$//;
|
|
|
1257 |
}
|
|
|
1258 |
|
|
|
1259 |
# Another set of special dates (Nth week)
|
|
|
1260 |
if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
|
|
|
1261 |
# 22nd sunday in 1996
|
|
|
1262 |
($which,$dofw,$y)=($1,$2,$3);
|
|
|
1263 |
$y=$Curr{"Y"} if (! $y);
|
|
|
1264 |
$y--; # previous year
|
|
|
1265 |
$tmp=&Date_GetNext("$y-12-31",$dofw,0);
|
|
|
1266 |
if ($which>1) {
|
|
|
1267 |
$tmp=&DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0);
|
|
|
1268 |
}
|
|
|
1269 |
($y,$m,$d)=(&Date_Split($tmp, 1))[0..2];
|
|
|
1270 |
last PARSE;
|
|
|
1271 |
} elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
|
|
|
1272 |
/^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
|
|
|
1273 |
# sunday week 22 in 1996
|
|
|
1274 |
# sunday 22nd week in 1996
|
|
|
1275 |
($dofw,$which,$y)=($1,$2,$3);
|
|
|
1276 |
($y,$m,$d)=&Date_NthWeekOfYear($y,$which,$dofw);
|
|
|
1277 |
last PARSE;
|
|
|
1278 |
}
|
|
|
1279 |
|
|
|
1280 |
# Get rid of day of week
|
|
|
1281 |
if (/(^|[^a-z])$week($|[^a-z])/i) {
|
|
|
1282 |
$wk=$2;
|
|
|
1283 |
(s/(^|[^a-z])$week,/$1 /i) ||
|
|
|
1284 |
s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
|
|
|
1285 |
s/^\s+//;
|
|
|
1286 |
s/\s+$//;
|
|
|
1287 |
}
|
|
|
1288 |
|
|
|
1289 |
{
|
|
|
1290 |
# So that we can handle negative epoch times, let's convert
|
|
|
1291 |
# things like "epoch -" to "epochNEGATIVE " before we strip out
|
|
|
1292 |
# the $sep chars, which include '-'.
|
|
|
1293 |
s,epoch\s*-,epochNEGATIVE ,g;
|
|
|
1294 |
|
|
|
1295 |
# Non-ISO8601 dates
|
|
|
1296 |
s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces
|
|
|
1297 |
s,^\s*,,; # remove leading/trailing space
|
|
|
1298 |
s,\s*$,,;
|
|
|
1299 |
|
|
|
1300 |
if (/^$D\s+$D(?:\s+$YY)?$/) {
|
|
|
1301 |
# MM DD YY (DD MM YY non-US)
|
|
|
1302 |
($m,$d,$y)=($1,$2,$3);
|
|
|
1303 |
($m,$d)=($d,$m) if ($type ne "US");
|
|
|
1304 |
last PARSE;
|
|
|
1305 |
|
|
|
1306 |
} elsif (/^$D4\s*$D\s*$D$/) {
|
|
|
1307 |
# YYYY MM DD
|
|
|
1308 |
($y,$m,$d)=($1,$2,$3);
|
|
|
1309 |
last PARSE;
|
|
|
1310 |
|
|
|
1311 |
} elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
|
|
|
1312 |
($m)=($2);
|
|
|
1313 |
|
|
|
1314 |
if (/^\s*$D(?:\s+$YY)?\s*$/) {
|
|
|
1315 |
# mmm DD YY
|
|
|
1316 |
# DD mmm YY
|
|
|
1317 |
# DD YY mmm
|
|
|
1318 |
($d,$y)=($1,$2);
|
|
|
1319 |
last PARSE;
|
|
|
1320 |
|
|
|
1321 |
} elsif (/^\s*$D$D4\s*$/) {
|
|
|
1322 |
# mmm DD YYYY
|
|
|
1323 |
# DD mmm YYYY
|
|
|
1324 |
# DD YYYY mmm
|
|
|
1325 |
($d,$y)=($1,$2);
|
|
|
1326 |
last PARSE;
|
|
|
1327 |
|
|
|
1328 |
} elsif (/^\s*$D4\s*$D\s*$/) {
|
|
|
1329 |
# mmm YYYY DD
|
|
|
1330 |
# YYYY mmm DD
|
|
|
1331 |
# YYYY DD mmm
|
|
|
1332 |
($y,$d)=($1,$2);
|
|
|
1333 |
last PARSE;
|
|
|
1334 |
|
|
|
1335 |
} elsif (/^\s*$D4\s*$/) {
|
|
|
1336 |
# mmm YYYY
|
|
|
1337 |
# YYYY mmm
|
|
|
1338 |
($y,$d)=($1,1);
|
|
|
1339 |
last PARSE;
|
|
|
1340 |
|
|
|
1341 |
} else {
|
|
|
1342 |
return "";
|
|
|
1343 |
}
|
|
|
1344 |
|
|
|
1345 |
} elsif (/^epochNEGATIVE (\d+)$/) {
|
|
|
1346 |
$s=$1;
|
|
|
1347 |
$date=&DateCalc("1970-01-01 00:00 GMT","-0:0:$s");
|
|
|
1348 |
} elsif (/^epoch\s*(\d+)$/i) {
|
|
|
1349 |
$s=$1;
|
|
|
1350 |
$date=&DateCalc("1970-01-01 00:00 GMT","+0:0:$s");
|
|
|
1351 |
|
|
|
1352 |
} elsif (/^$now$/i) {
|
|
|
1353 |
# now, today
|
|
|
1354 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1355 |
$date=$Curr{"Now"};
|
|
|
1356 |
if ($time) {
|
|
|
1357 |
return ""
|
|
|
1358 |
if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
|
|
1359 |
$date=&Date_SetTime($date,$h,$mn,$s);
|
|
|
1360 |
}
|
|
|
1361 |
last PARSE;
|
|
|
1362 |
|
|
|
1363 |
} elsif (/^$offset$/i) {
|
|
|
1364 |
# yesterday, tomorrow
|
|
|
1365 |
($offset)=($1);
|
|
|
1366 |
&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
|
|
|
1367 |
$offset=$Lang{$L}{"OffsetH"}{lc($offset)};
|
|
|
1368 |
$date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
|
|
|
1369 |
if ($time) {
|
|
|
1370 |
return ""
|
|
|
1371 |
if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
|
|
1372 |
$date=&Date_SetTime($date,$h,$mn,$s);
|
|
|
1373 |
}
|
|
|
1374 |
last PARSE;
|
|
|
1375 |
|
|
|
1376 |
} else {
|
|
|
1377 |
return "";
|
|
|
1378 |
}
|
|
|
1379 |
}
|
|
|
1380 |
}
|
|
|
1381 |
|
|
|
1382 |
if (! $date) {
|
|
|
1383 |
return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
|
|
1384 |
$date=&Date_Join($y,$m,$d,$h,$mn,$s);
|
|
|
1385 |
}
|
|
|
1386 |
$date=&Date_ConvTZ($date,$z);
|
|
|
1387 |
if ($midnight) {
|
|
|
1388 |
$date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0");
|
|
|
1389 |
}
|
|
|
1390 |
return $date;
|
|
|
1391 |
}
|
|
|
1392 |
|
|
|
1393 |
sub ParseDate {
|
|
|
1394 |
print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
1395 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
1396 |
my($args,@args,@a,$ref,$date)=();
|
|
|
1397 |
@a=@_;
|
|
|
1398 |
|
|
|
1399 |
# @a : is the list of args to ParseDate. Currently, only one argument
|
|
|
1400 |
# is allowed and it must be a scalar (or a reference to a scalar)
|
|
|
1401 |
# or a reference to an array.
|
|
|
1402 |
|
|
|
1403 |
if ($#a!=0) {
|
|
|
1404 |
print "ERROR: Invalid number of arguments to ParseDate.\n";
|
|
|
1405 |
return "";
|
|
|
1406 |
}
|
|
|
1407 |
$args=$a[0];
|
|
|
1408 |
$ref=ref $args;
|
|
|
1409 |
if (! $ref) {
|
|
|
1410 |
return $args if (&Date_Split($args));
|
|
|
1411 |
@args=($args);
|
|
|
1412 |
} elsif ($ref eq "ARRAY") {
|
|
|
1413 |
@args=@$args;
|
|
|
1414 |
} elsif ($ref eq "SCALAR") {
|
|
|
1415 |
return $$args if (&Date_Split($$args));
|
|
|
1416 |
@args=($$args);
|
|
|
1417 |
} else {
|
|
|
1418 |
print "ERROR: Invalid arguments to ParseDate.\n";
|
|
|
1419 |
return "";
|
|
|
1420 |
}
|
|
|
1421 |
@a=@args;
|
|
|
1422 |
|
|
|
1423 |
# @args : a list containing all the arguments (dereferenced if appropriate)
|
|
|
1424 |
# @a : a list containing all the arguments currently being examined
|
|
|
1425 |
# $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
|
|
|
1426 |
# reference to a scalar, or a reference to an array was passed in
|
|
|
1427 |
# $args : the scalar or refererence passed in
|
|
|
1428 |
|
|
|
1429 |
PARSE: while($#a>=0) {
|
|
|
1430 |
$date=join(" ",@a);
|
|
|
1431 |
$date=&ParseDateString($date);
|
|
|
1432 |
last if ($date);
|
|
|
1433 |
pop(@a);
|
|
|
1434 |
} # PARSE
|
|
|
1435 |
|
|
|
1436 |
splice(@args,0,$#a + 1);
|
|
|
1437 |
@$args= @args if (defined $ref and $ref eq "ARRAY");
|
|
|
1438 |
$date;
|
|
|
1439 |
}
|
|
|
1440 |
|
|
|
1441 |
sub Date_Cmp {
|
|
|
1442 |
my($D1,$D2)=@_;
|
|
|
1443 |
my($date1)=&ParseDateString($D1);
|
|
|
1444 |
my($date2)=&ParseDateString($D2);
|
|
|
1445 |
return $date1 cmp $date2;
|
|
|
1446 |
}
|
|
|
1447 |
|
|
|
1448 |
# **NOTE**
|
|
|
1449 |
# The calc routines all call parse routines, so it is never necessary to
|
|
|
1450 |
# call Date_Init in the calc routines.
|
|
|
1451 |
sub DateCalc {
|
|
|
1452 |
print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
1453 |
my($D1,$D2,@arg)=@_;
|
|
|
1454 |
my($ref,$err,$errref,$mode)=();
|
|
|
1455 |
|
|
|
1456 |
$errref=shift(@arg);
|
|
|
1457 |
$ref=0;
|
|
|
1458 |
if (defined $errref) {
|
|
|
1459 |
if (ref $errref) {
|
|
|
1460 |
$mode=shift(@arg);
|
|
|
1461 |
$ref=1;
|
|
|
1462 |
} else {
|
|
|
1463 |
$mode=$errref;
|
|
|
1464 |
$errref="";
|
|
|
1465 |
}
|
|
|
1466 |
}
|
|
|
1467 |
|
|
|
1468 |
my(@date,@delta,$ret,$tmp,$old)=();
|
|
|
1469 |
|
|
|
1470 |
if (defined $mode and $mode>=0 and $mode<=3) {
|
|
|
1471 |
$Curr{"Mode"}=$mode;
|
|
|
1472 |
} else {
|
|
|
1473 |
$Curr{"Mode"}=0;
|
|
|
1474 |
}
|
|
|
1475 |
|
|
|
1476 |
$old=$Curr{"InCalc"};
|
|
|
1477 |
$Curr{"InCalc"}=1;
|
|
|
1478 |
|
|
|
1479 |
if ($tmp=&ParseDateString($D1)) {
|
|
|
1480 |
# If we've already parsed the date, we don't want to do it a second
|
|
|
1481 |
# time (so we don't convert timezones twice).
|
|
|
1482 |
if (&Date_Split($D1)) {
|
|
|
1483 |
push(@date,$D1);
|
|
|
1484 |
} else {
|
|
|
1485 |
push(@date,$tmp);
|
|
|
1486 |
}
|
|
|
1487 |
} elsif ($tmp=&ParseDateDelta($D1)) {
|
|
|
1488 |
push(@delta,$tmp);
|
|
|
1489 |
} else {
|
|
|
1490 |
$$errref=1 if ($ref);
|
|
|
1491 |
return;
|
|
|
1492 |
}
|
|
|
1493 |
|
|
|
1494 |
if ($tmp=&ParseDateString($D2)) {
|
|
|
1495 |
if (&Date_Split($D2)) {
|
|
|
1496 |
push(@date,$D2);
|
|
|
1497 |
} else {
|
|
|
1498 |
push(@date,$tmp);
|
|
|
1499 |
}
|
|
|
1500 |
} elsif ($tmp=&ParseDateDelta($D2)) {
|
|
|
1501 |
push(@delta,$tmp);
|
|
|
1502 |
} else {
|
|
|
1503 |
$$errref=2 if ($ref);
|
|
|
1504 |
return;
|
|
|
1505 |
}
|
|
|
1506 |
$mode=$Curr{"Mode"};
|
|
|
1507 |
$Curr{"InCalc"}=$old;
|
|
|
1508 |
|
|
|
1509 |
if ($#date==1) {
|
|
|
1510 |
$ret=&DateCalc_DateDate(@date,$mode);
|
|
|
1511 |
} elsif ($#date==0) {
|
|
|
1512 |
$ret=&DateCalc_DateDelta(@date,@delta,\$err,$mode);
|
|
|
1513 |
$$errref=$err if ($ref);
|
|
|
1514 |
} else {
|
|
|
1515 |
$ret=&DateCalc_DeltaDelta(@delta,$mode);
|
|
|
1516 |
}
|
|
|
1517 |
$ret;
|
|
|
1518 |
}
|
|
|
1519 |
|
|
|
1520 |
sub ParseDateDelta {
|
|
|
1521 |
print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
1522 |
my($args,@args,@a,$ref)=();
|
|
|
1523 |
local($_)=();
|
|
|
1524 |
@a=@_;
|
|
|
1525 |
|
|
|
1526 |
# @a : is the list of args to ParseDateDelta. Currently, only one argument
|
|
|
1527 |
# is allowed and it must be a scalar (or a reference to a scalar)
|
|
|
1528 |
# or a reference to an array.
|
|
|
1529 |
|
|
|
1530 |
if ($#a!=0) {
|
|
|
1531 |
print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
|
|
|
1532 |
return "";
|
|
|
1533 |
}
|
|
|
1534 |
$args=$a[0];
|
|
|
1535 |
$ref=ref $args;
|
|
|
1536 |
if (! $ref) {
|
|
|
1537 |
@args=($args);
|
|
|
1538 |
} elsif ($ref eq "ARRAY") {
|
|
|
1539 |
@args=@$args;
|
|
|
1540 |
} elsif ($ref eq "SCALAR") {
|
|
|
1541 |
@args=($$args);
|
|
|
1542 |
} else {
|
|
|
1543 |
print "ERROR: Invalid arguments to ParseDateDelta.\n";
|
|
|
1544 |
return "";
|
|
|
1545 |
}
|
|
|
1546 |
@a=@args;
|
|
|
1547 |
|
|
|
1548 |
# @args : a list containing all the arguments (dereferenced if appropriate)
|
|
|
1549 |
# @a : a list containing all the arguments currently being examined
|
|
|
1550 |
# $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
|
|
|
1551 |
# reference to a scalar, or a reference to an array was passed in
|
|
|
1552 |
# $args : the scalar or refererence passed in
|
|
|
1553 |
|
|
|
1554 |
my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=();
|
|
|
1555 |
my($len,$tmp,$tmp2,$tmpl)=();
|
|
|
1556 |
my($from,$to)=();
|
|
|
1557 |
my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1;
|
|
|
1558 |
|
|
|
1559 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
1560 |
# A sign can be a sequence of zero or more + and - signs, this
|
|
|
1561 |
# allows for deltas like '+ -2 days'.
|
|
|
1562 |
my($signexp)='((?:[+-]\s*)*)';
|
|
|
1563 |
my($numexp)='(\d+)';
|
|
|
1564 |
my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)";
|
|
|
1565 |
my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=();
|
|
|
1566 |
$yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()";
|
|
|
1567 |
$yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?";
|
|
|
1568 |
$mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?";
|
|
|
1569 |
$wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?";
|
|
|
1570 |
$dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?";
|
|
|
1571 |
$hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?";
|
|
|
1572 |
$mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?";
|
|
|
1573 |
$sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?";
|
|
|
1574 |
my($future)=$Lang{$Cnf{"Language"}}{"Future"};
|
|
|
1575 |
my($later)=$Lang{$Cnf{"Language"}}{"Later"};
|
|
|
1576 |
my($past)=$Lang{$Cnf{"Language"}}{"Past"};
|
|
|
1577 |
|
|
|
1578 |
$delta="";
|
|
|
1579 |
PARSE: while (@a) {
|
|
|
1580 |
$_ = join(" ", grep {defined;} @a);
|
|
|
1581 |
s/\s+$//;
|
|
|
1582 |
last if ($_ eq "");
|
|
|
1583 |
|
|
|
1584 |
# Mode is set in DateCalc. ParseDateDelta only overrides it if the
|
|
|
1585 |
# string contains a mode.
|
|
|
1586 |
if ($Lang{$Cnf{"Language"}}{"Exact"} &&
|
|
|
1587 |
s/$Lang{$Cnf{"Language"}}{"Exact"}//) {
|
|
|
1588 |
$Curr{"Mode"}=0;
|
|
|
1589 |
} elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
|
|
|
1590 |
s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
|
|
|
1591 |
$Curr{"Mode"}=1;
|
|
|
1592 |
} elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
|
|
|
1593 |
s/$Lang{$Cnf{"Language"}}{"Business"}//) {
|
|
|
1594 |
$Curr{"Mode"}=2;
|
|
|
1595 |
} elsif (! exists $Curr{"Mode"}) {
|
|
|
1596 |
$Curr{"Mode"}=0;
|
|
|
1597 |
}
|
|
|
1598 |
$workweek=7 if ($Curr{"Mode"} != 2);
|
|
|
1599 |
|
|
|
1600 |
foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) {
|
|
|
1601 |
$to=$Lang{$Cnf{"Language"}}{"Repl"}{$from};
|
|
|
1602 |
s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
|
|
|
1603 |
}
|
|
|
1604 |
|
|
|
1605 |
# in or ago
|
|
|
1606 |
#
|
|
|
1607 |
# We need to make sure that $later, $future, and $past don't contain each
|
|
|
1608 |
# other... Romanian pointed this out where $past is "in urma" and $future
|
|
|
1609 |
# is "in". When they do, we have to take this into account.
|
|
|
1610 |
# $len length of best match (greatest wins)
|
|
|
1611 |
# $tmp string after best match
|
|
|
1612 |
# $dir direction (prior, after) of best match
|
|
|
1613 |
#
|
|
|
1614 |
# $tmp2 string before/after current match
|
|
|
1615 |
# $tmpl length of current match
|
|
|
1616 |
|
|
|
1617 |
$len=0;
|
|
|
1618 |
$tmp=$_;
|
|
|
1619 |
$dir=1;
|
|
|
1620 |
|
|
|
1621 |
$tmp2=$_;
|
|
|
1622 |
if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
|
|
|
1623 |
$tmpl=length($2);
|
|
|
1624 |
if ($tmpl>$len) {
|
|
|
1625 |
$tmp=$tmp2;
|
|
|
1626 |
$dir=1;
|
|
|
1627 |
$len=$tmpl;
|
|
|
1628 |
}
|
|
|
1629 |
}
|
|
|
1630 |
|
|
|
1631 |
$tmp2=$_;
|
|
|
1632 |
if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
|
|
|
1633 |
$tmpl=length($2);
|
|
|
1634 |
if ($tmpl>$len) {
|
|
|
1635 |
$tmp=$tmp2;
|
|
|
1636 |
$dir=1;
|
|
|
1637 |
$len=$tmpl;
|
|
|
1638 |
}
|
|
|
1639 |
}
|
|
|
1640 |
|
|
|
1641 |
$tmp2=$_;
|
|
|
1642 |
if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
|
|
|
1643 |
$tmpl=length($2);
|
|
|
1644 |
if ($tmpl>$len) {
|
|
|
1645 |
$tmp=$tmp2;
|
|
|
1646 |
$dir=-1;
|
|
|
1647 |
$len=$tmpl;
|
|
|
1648 |
}
|
|
|
1649 |
}
|
|
|
1650 |
|
|
|
1651 |
$_ = $tmp;
|
|
|
1652 |
s/\s*$//;
|
|
|
1653 |
|
|
|
1654 |
# the colon part of the delta
|
|
|
1655 |
$colon="";
|
|
|
1656 |
if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
|
|
|
1657 |
$colon=$1;
|
|
|
1658 |
s/\s+$//;
|
|
|
1659 |
}
|
|
|
1660 |
@colon=split(/:/,$colon);
|
|
|
1661 |
|
|
|
1662 |
# the non-colon part of the delta
|
|
|
1663 |
$sign="+";
|
|
|
1664 |
@delta=();
|
|
|
1665 |
$i=6;
|
|
|
1666 |
foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
|
|
|
1667 |
last if ($#colon>=$i--);
|
|
|
1668 |
$val=0;
|
|
|
1669 |
if (s/^$exp1//ix) {
|
|
|
1670 |
$val=$2 if ($2);
|
|
|
1671 |
$sign=$1 if ($1);
|
|
|
1672 |
}
|
|
|
1673 |
|
|
|
1674 |
# Collapse a sign like '+ -' into a single character like '-',
|
|
|
1675 |
# by counting the occurrences of '-'.
|
|
|
1676 |
#
|
|
|
1677 |
$sign =~ s/\s+//g;
|
|
|
1678 |
$sign =~ tr/+//d;
|
|
|
1679 |
my $count = ($sign =~ tr/-//d);
|
|
|
1680 |
die "bad characters in sign: $sign" if length $sign;
|
|
|
1681 |
$sign = $count % 2 ? '-' : '+';
|
|
|
1682 |
|
|
|
1683 |
push(@delta,"$sign$val");
|
|
|
1684 |
}
|
|
|
1685 |
if (! /^\s*$/) {
|
|
|
1686 |
pop(@a);
|
|
|
1687 |
next PARSE;
|
|
|
1688 |
}
|
|
|
1689 |
|
|
|
1690 |
# make sure that the colon part has a sign
|
|
|
1691 |
for ($i=0; $i<=$#colon; $i++) {
|
|
|
1692 |
$val=0;
|
|
|
1693 |
if ($colon[$i] =~ /^$signexp$numexp?/) {
|
|
|
1694 |
$val=$2 if ($2);
|
|
|
1695 |
$sign=$1 if ($1);
|
|
|
1696 |
}
|
|
|
1697 |
$colon[$i] = "$sign$val";
|
|
|
1698 |
}
|
|
|
1699 |
|
|
|
1700 |
# combine the two
|
|
|
1701 |
push(@delta,@colon);
|
|
|
1702 |
if ($dir<0) {
|
|
|
1703 |
for ($i=0; $i<=$#delta; $i++) {
|
|
|
1704 |
$delta[$i] =~ tr/-+/+-/;
|
|
|
1705 |
}
|
|
|
1706 |
}
|
|
|
1707 |
|
|
|
1708 |
# form the delta and shift off the valid part
|
|
|
1709 |
$delta=join(":",@delta);
|
|
|
1710 |
splice(@args,0,$#a+1);
|
|
|
1711 |
@$args=@args if (defined $ref and $ref eq "ARRAY");
|
|
|
1712 |
last PARSE;
|
|
|
1713 |
}
|
|
|
1714 |
|
|
|
1715 |
$delta=&Delta_Normalize($delta,$Curr{"Mode"});
|
|
|
1716 |
return $delta;
|
|
|
1717 |
}
|
|
|
1718 |
|
|
|
1719 |
sub UnixDate {
|
|
|
1720 |
print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
1721 |
my($date,@format)=@_;
|
|
|
1722 |
local($_)=();
|
|
|
1723 |
my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
|
|
|
1724 |
my($scalar)=();
|
|
|
1725 |
$date=&ParseDateString($date);
|
|
|
1726 |
return if (! $date);
|
|
|
1727 |
|
|
|
1728 |
my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
|
|
|
1729 |
&Date_Split($date, 1);
|
|
|
1730 |
$f{"y"}=substr $f{"Y"},2;
|
|
|
1731 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
1732 |
|
|
|
1733 |
if (! wantarray) {
|
|
|
1734 |
$format=join(" ",@format);
|
|
|
1735 |
@format=($format);
|
|
|
1736 |
$scalar=1;
|
|
|
1737 |
}
|
|
|
1738 |
|
|
|
1739 |
# month, week
|
|
|
1740 |
$_=$m;
|
|
|
1741 |
s/^0//;
|
|
|
1742 |
$f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
|
|
|
1743 |
$f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
|
|
|
1744 |
$_=$m;
|
|
|
1745 |
s/^0/ /;
|
|
|
1746 |
$f{"f"}=$_;
|
|
|
1747 |
$f{"U"}=&Date_WeekOfYear($m,$d,$y,7);
|
|
|
1748 |
$f{"W"}=&Date_WeekOfYear($m,$d,$y,1);
|
|
|
1749 |
|
|
|
1750 |
# check week 52,53 and 0
|
|
|
1751 |
$f{"G"}=$f{"L"}=$y;
|
|
|
1752 |
if ($f{"W"}>=52 || $f{"U"}>=52) {
|
|
|
1753 |
my($dd,$mm,$yy)=($d,$m,$y);
|
|
|
1754 |
$dd+=7;
|
|
|
1755 |
if ($dd>31) {
|
|
|
1756 |
$dd-=31;
|
|
|
1757 |
$mm=1;
|
|
|
1758 |
$yy++;
|
|
|
1759 |
if (&Date_WeekOfYear($mm,$dd,$yy,1)==2) {
|
|
|
1760 |
$f{"G"}=$yy;
|
|
|
1761 |
$f{"W"}=1;
|
|
|
1762 |
}
|
|
|
1763 |
if (&Date_WeekOfYear($mm,$dd,$yy,7)==2) {
|
|
|
1764 |
$f{"L"}=$yy;
|
|
|
1765 |
$f{"U"}=1;
|
|
|
1766 |
}
|
|
|
1767 |
}
|
|
|
1768 |
}
|
|
|
1769 |
if ($f{"W"}==0) {
|
|
|
1770 |
my($dd,$mm,$yy)=($d,$m,$y);
|
|
|
1771 |
$dd-=7;
|
|
|
1772 |
$dd+=31 if ($dd<1);
|
|
|
1773 |
$yy--;
|
|
|
1774 |
$mm=12;
|
|
|
1775 |
$f{"G"}=$yy;
|
|
|
1776 |
$f{"W"}=&Date_WeekOfYear($mm,$dd,$yy,1)+1;
|
|
|
1777 |
}
|
|
|
1778 |
if ($f{"U"}==0) {
|
|
|
1779 |
my($dd,$mm,$yy)=($d,$m,$y);
|
|
|
1780 |
$dd-=7;
|
|
|
1781 |
$dd+=31 if ($dd<1);
|
|
|
1782 |
$yy--;
|
|
|
1783 |
$mm=12;
|
|
|
1784 |
$f{"L"}=$yy;
|
|
|
1785 |
$f{"U"}=&Date_WeekOfYear($mm,$dd,$yy,7)+1;
|
|
|
1786 |
}
|
|
|
1787 |
|
|
|
1788 |
$f{"U"}="0".$f{"U"} if (length $f{"U"} < 2);
|
|
|
1789 |
$f{"W"}="0".$f{"W"} if (length $f{"W"} < 2);
|
|
|
1790 |
|
|
|
1791 |
# day
|
|
|
1792 |
$f{"j"}=&Date_DayOfYear($m,$d,$y);
|
|
|
1793 |
$f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
|
|
|
1794 |
$_=$d;
|
|
|
1795 |
s/^0/ /;
|
|
|
1796 |
$f{"e"}=$_;
|
|
|
1797 |
$f{"w"}=&Date_DayOfWeek($m,$d,$y);
|
|
|
1798 |
$f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1];
|
|
|
1799 |
$f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2);
|
|
|
1800 |
$f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1];
|
|
|
1801 |
$f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1];
|
|
|
1802 |
$f{"E"}=&Date_DaySuffix($f{"e"});
|
|
|
1803 |
|
|
|
1804 |
# hour
|
|
|
1805 |
$_=$h;
|
|
|
1806 |
s/^0/ /;
|
|
|
1807 |
$f{"k"}=$_;
|
|
|
1808 |
$f{"i"}=$f{"k"}+1;
|
|
|
1809 |
$f{"i"}=$f{"k"};
|
|
|
1810 |
$f{"i"}=12 if ($f{"k"}==0);
|
|
|
1811 |
$f{"i"}=$f{"k"}-12 if ($f{"k"}>12);
|
|
|
1812 |
$f{"i"}=$f{"i"}-12 if ($f{"i"}>12);
|
|
|
1813 |
$f{"i"}=" ".$f{"i"} if (length($f{"i"})<2);
|
|
|
1814 |
$f{"I"}=$f{"i"};
|
|
|
1815 |
$f{"I"}=~ s/^ /0/;
|
|
|
1816 |
$f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"};
|
|
|
1817 |
$f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11);
|
|
|
1818 |
|
|
|
1819 |
# minute, second, timezone
|
|
|
1820 |
$f{"o"}=&Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
|
|
|
1821 |
$f{"s"}=&Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s);
|
|
|
1822 |
$f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ?
|
|
|
1823 |
$Cnf{"TZ"} : $Cnf{"ConvTZ"};
|
|
|
1824 |
$f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || "");
|
|
|
1825 |
|
|
|
1826 |
# date, time
|
|
|
1827 |
$f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
|
|
|
1828 |
$f{"C"}=$f{"u"}=
|
|
|
1829 |
qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|;
|
|
|
1830 |
$f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|;
|
|
|
1831 |
$f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|;
|
|
|
1832 |
$f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|;
|
|
|
1833 |
$f{"R"}=qq|$h:$mn|;
|
|
|
1834 |
$f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
|
|
|
1835 |
$f{"V"}=qq|$m$d$h$mn$f{"y"}|;
|
|
|
1836 |
$f{"Q"}="$y$m$d";
|
|
|
1837 |
$f{"q"}=qq|$y$m$d$h$mn$s|;
|
|
|
1838 |
$f{"P"}=qq|$y$m$d$h:$mn:$s|;
|
|
|
1839 |
$f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|;
|
|
|
1840 |
if ($f{"W"}==0) {
|
|
|
1841 |
$y--;
|
|
|
1842 |
$tmp=&Date_WeekOfYear(12,31,$y,1);
|
|
|
1843 |
$tmp="0$tmp" if (length($tmp) < 2);
|
|
|
1844 |
$f{"J"}=qq|$y-W$tmp-$f{"w"}|;
|
|
|
1845 |
} else {
|
|
|
1846 |
$f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|;
|
|
|
1847 |
}
|
|
|
1848 |
$f{"K"}=qq|$y-$f{"j"}|;
|
|
|
1849 |
# %l is a special case. Since it requires the use of the calculator
|
|
|
1850 |
# which requires this routine, an infinite recursion results. To get
|
|
|
1851 |
# around this, %l is NOT determined every time this is called so the
|
|
|
1852 |
# recursion breaks.
|
|
|
1853 |
|
|
|
1854 |
# other formats
|
|
|
1855 |
$f{"n"}="\n";
|
|
|
1856 |
$f{"t"}="\t";
|
|
|
1857 |
$f{"%"}="%";
|
|
|
1858 |
$f{"+"}="+";
|
|
|
1859 |
|
|
|
1860 |
foreach $format (@format) {
|
|
|
1861 |
$format=reverse($format);
|
|
|
1862 |
$out="";
|
|
|
1863 |
while ($format ne "") {
|
|
|
1864 |
$c=chop($format);
|
|
|
1865 |
if ($c eq "%") {
|
|
|
1866 |
$c=chop($format);
|
|
|
1867 |
if ($c eq "l") {
|
|
|
1868 |
&Date_Init();
|
|
|
1869 |
$date1=&DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0");
|
|
|
1870 |
$date2=&DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0");
|
|
|
1871 |
if (&Date_Cmp($date,$date1)>=0 && &Date_Cmp($date,$date2)<=0) {
|
|
|
1872 |
$f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|;
|
|
|
1873 |
} else {
|
|
|
1874 |
$f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
|
|
|
1875 |
}
|
|
|
1876 |
$out .= $f{"$c"};
|
|
|
1877 |
} elsif (exists $f{"$c"}) {
|
|
|
1878 |
$out .= $f{"$c"};
|
|
|
1879 |
} else {
|
|
|
1880 |
$out .= $c;
|
|
|
1881 |
}
|
|
|
1882 |
} else {
|
|
|
1883 |
$out .= $c;
|
|
|
1884 |
}
|
|
|
1885 |
}
|
|
|
1886 |
push(@out,$out);
|
|
|
1887 |
}
|
|
|
1888 |
if ($scalar) {
|
|
|
1889 |
return $out[0];
|
|
|
1890 |
} else {
|
|
|
1891 |
return (@out);
|
|
|
1892 |
}
|
|
|
1893 |
}
|
|
|
1894 |
|
|
|
1895 |
# Can't be in "use integer" because we're doing decimal arithmatic
|
|
|
1896 |
no integer;
|
|
|
1897 |
sub Delta_Format {
|
|
|
1898 |
print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
1899 |
my($delta,$dec,@format)=@_;
|
|
|
1900 |
$delta=&ParseDateDelta($delta);
|
|
|
1901 |
return "" if (! $delta);
|
|
|
1902 |
my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
|
|
|
1903 |
local($_)=$delta;
|
|
|
1904 |
my($y,$M,$w,$d,$h,$m,$s)=&Delta_Split($delta);
|
|
|
1905 |
# Get rid of positive signs.
|
|
|
1906 |
($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s);
|
|
|
1907 |
|
|
|
1908 |
if (defined $dec && $dec>0) {
|
|
|
1909 |
$dec="%." . ($dec*1) . "f";
|
|
|
1910 |
} else {
|
|
|
1911 |
$dec="%f";
|
|
|
1912 |
}
|
|
|
1913 |
|
|
|
1914 |
if (! wantarray) {
|
|
|
1915 |
$format=join(" ",@format);
|
|
|
1916 |
@format=($format);
|
|
|
1917 |
$scalar=1;
|
|
|
1918 |
}
|
|
|
1919 |
|
|
|
1920 |
# Length of each unit in seconds
|
|
|
1921 |
my($sl,$ml,$hl,$dl,$wl,$yl)=();
|
|
|
1922 |
$sl = 1;
|
|
|
1923 |
$ml = $sl*60;
|
|
|
1924 |
$hl = $ml*60;
|
|
|
1925 |
$dl = $hl*24;
|
|
|
1926 |
$wl = $dl*7;
|
|
|
1927 |
$yl = $dl*365.25;
|
|
|
1928 |
|
|
|
1929 |
# The decimal amount of each unit contained in all smaller units
|
|
|
1930 |
my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
|
|
|
1931 |
if ($M) {
|
|
|
1932 |
$yd = $M/12;
|
|
|
1933 |
$Md = 0;
|
|
|
1934 |
} else {
|
|
|
1935 |
$yd = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
|
|
|
1936 |
$Md = 0;
|
|
|
1937 |
}
|
|
|
1938 |
|
|
|
1939 |
$wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
|
|
|
1940 |
$dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
|
|
|
1941 |
$hd = ($m*$ml + $s*$sl)/$hl;
|
|
|
1942 |
$md = ($s*$sl)/$ml;
|
|
|
1943 |
$sd = 0;
|
|
|
1944 |
|
|
|
1945 |
# The amount of each unit contained in higher units.
|
|
|
1946 |
my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
|
|
|
1947 |
$yh = 0;
|
|
|
1948 |
|
|
|
1949 |
if ($M) {
|
|
|
1950 |
$Mh = ($yh+$y)*12;
|
|
|
1951 |
$wh = 0;
|
|
|
1952 |
$dh = ($wh+$w)*7;
|
|
|
1953 |
} else {
|
|
|
1954 |
$Mh = 0;
|
|
|
1955 |
$wh = ($yh+$y)*365.25/7;
|
|
|
1956 |
$dh = ($yh+$y)*365.25 + $w*7;
|
|
|
1957 |
}
|
|
|
1958 |
|
|
|
1959 |
$hh = ($dh+$d)*24;
|
|
|
1960 |
$mh = ($hh+$h)*60;
|
|
|
1961 |
$sh = ($mh+$m)*60;
|
|
|
1962 |
|
|
|
1963 |
# Set up the formats
|
|
|
1964 |
|
|
|
1965 |
$f{"yv"} = $y;
|
|
|
1966 |
$f{"Mv"} = $M;
|
|
|
1967 |
$f{"wv"} = $w;
|
|
|
1968 |
$f{"dv"} = $d;
|
|
|
1969 |
$f{"hv"} = $h;
|
|
|
1970 |
$f{"mv"} = $m;
|
|
|
1971 |
$f{"sv"} = $s;
|
|
|
1972 |
|
|
|
1973 |
$f{"yh"} = $y+$yh;
|
|
|
1974 |
$f{"Mh"} = $M+$Mh;
|
|
|
1975 |
$f{"wh"} = $w+$wh;
|
|
|
1976 |
$f{"dh"} = $d+$dh;
|
|
|
1977 |
$f{"hh"} = $h+$hh;
|
|
|
1978 |
$f{"mh"} = $m+$mh;
|
|
|
1979 |
$f{"sh"} = $s+$sh;
|
|
|
1980 |
|
|
|
1981 |
$f{"yd"} = sprintf($dec,$y+$yd);
|
|
|
1982 |
$f{"Md"} = sprintf($dec,$M+$Md);
|
|
|
1983 |
$f{"wd"} = sprintf($dec,$w+$wd);
|
|
|
1984 |
$f{"dd"} = sprintf($dec,$d+$dd);
|
|
|
1985 |
$f{"hd"} = sprintf($dec,$h+$hd);
|
|
|
1986 |
$f{"md"} = sprintf($dec,$m+$md);
|
|
|
1987 |
$f{"sd"} = sprintf($dec,$s+$sd);
|
|
|
1988 |
|
|
|
1989 |
$f{"yt"} = sprintf($dec,$yh+$y+$yd);
|
|
|
1990 |
$f{"Mt"} = sprintf($dec,$Mh+$M+$Md);
|
|
|
1991 |
$f{"wt"} = sprintf($dec,$wh+$w+$wd);
|
|
|
1992 |
$f{"dt"} = sprintf($dec,$dh+$d+$dd);
|
|
|
1993 |
$f{"ht"} = sprintf($dec,$hh+$h+$hd);
|
|
|
1994 |
$f{"mt"} = sprintf($dec,$mh+$m+$md);
|
|
|
1995 |
$f{"st"} = sprintf($dec,$sh+$s+$sd);
|
|
|
1996 |
|
|
|
1997 |
$f{"%"} = "%";
|
|
|
1998 |
|
|
|
1999 |
foreach $format (@format) {
|
|
|
2000 |
$format=reverse($format);
|
|
|
2001 |
$out="";
|
|
|
2002 |
PARSE: while ($format) {
|
|
|
2003 |
$c1=chop($format);
|
|
|
2004 |
if ($c1 eq "%") {
|
|
|
2005 |
$c1=chop($format);
|
|
|
2006 |
if (exists($f{$c1})) {
|
|
|
2007 |
$out .= $f{$c1};
|
|
|
2008 |
next PARSE;
|
|
|
2009 |
}
|
|
|
2010 |
$c2=chop($format);
|
|
|
2011 |
if (exists($f{"$c1$c2"})) {
|
|
|
2012 |
$out .= $f{"$c1$c2"};
|
|
|
2013 |
next PARSE;
|
|
|
2014 |
}
|
|
|
2015 |
$out .= $c1;
|
|
|
2016 |
$format .= $c2;
|
|
|
2017 |
} else {
|
|
|
2018 |
$out .= $c1;
|
|
|
2019 |
}
|
|
|
2020 |
}
|
|
|
2021 |
push(@out,$out);
|
|
|
2022 |
}
|
|
|
2023 |
if ($scalar) {
|
|
|
2024 |
return $out[0];
|
|
|
2025 |
} else {
|
|
|
2026 |
return (@out);
|
|
|
2027 |
}
|
|
|
2028 |
}
|
|
|
2029 |
use integer;
|
|
|
2030 |
|
|
|
2031 |
sub ParseRecur {
|
|
|
2032 |
print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
2033 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
2034 |
|
|
|
2035 |
my($recur,$dateb,$date0,$date1,$flag)=@_;
|
|
|
2036 |
local($_)=$recur;
|
|
|
2037 |
|
|
|
2038 |
my($recur_0,$recur_1,@recur0,@recur1)=();
|
|
|
2039 |
my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=();
|
|
|
2040 |
my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=();
|
|
|
2041 |
|
|
|
2042 |
# $date0, $date1, $dateb, $flag : passed in (these are always the final say
|
|
|
2043 |
# in determining whether a date matches a
|
|
|
2044 |
# recurrence IF they are present.
|
|
|
2045 |
# $date_b, $date_0, $date_1 : if a value can be determined from the
|
|
|
2046 |
# $flag_t recurrence, they are stored here.
|
|
|
2047 |
#
|
|
|
2048 |
# If values can be determined from the recurrence AND are passed in, the
|
|
|
2049 |
# following are used:
|
|
|
2050 |
# max($date0,$date_0) i.e. the later of the two dates
|
|
|
2051 |
# min($date1,$date_1) i.e. the earlier of the two dates
|
|
|
2052 |
#
|
|
|
2053 |
# The base date that is used is the first one defined from
|
|
|
2054 |
# $dateb $date_b
|
|
|
2055 |
# The base date is only used if necessary (as determined by the recur).
|
|
|
2056 |
# For example, "every other friday" requires a base date, but "2nd
|
|
|
2057 |
# friday of every month" doesn't.
|
|
|
2058 |
|
|
|
2059 |
my($date_b,$date_0,$date_1,$flag_t);
|
|
|
2060 |
|
|
|
2061 |
#
|
|
|
2062 |
# Check the arguments passed in.
|
|
|
2063 |
#
|
|
|
2064 |
|
|
|
2065 |
$date0="" if (! defined $date0);
|
|
|
2066 |
$date1="" if (! defined $date1);
|
|
|
2067 |
$dateb="" if (! defined $dateb);
|
|
|
2068 |
$flag ="" if (! defined $flag);
|
|
|
2069 |
|
|
|
2070 |
if ($dateb) {
|
|
|
2071 |
$dateb=&ParseDateString($dateb);
|
|
|
2072 |
return "" if (! $dateb);
|
|
|
2073 |
}
|
|
|
2074 |
if ($date0) {
|
|
|
2075 |
$date0=&ParseDateString($date0);
|
|
|
2076 |
return "" if (! $date0);
|
|
|
2077 |
}
|
|
|
2078 |
if ($date1) {
|
|
|
2079 |
$date1=&ParseDateString($date1);
|
|
|
2080 |
return "" if (! $date1);
|
|
|
2081 |
}
|
|
|
2082 |
|
|
|
2083 |
#
|
|
|
2084 |
# Parse the recur. $date_b, $date_0, and $date_e are values obtained
|
|
|
2085 |
# from the recur.
|
|
|
2086 |
#
|
|
|
2087 |
|
|
|
2088 |
@tmp=&Recur_Split($_);
|
|
|
2089 |
|
|
|
2090 |
if (@tmp) {
|
|
|
2091 |
($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp;
|
|
|
2092 |
$recur_0 = "" if (! defined $recur_0);
|
|
|
2093 |
$recur_1 = "" if (! defined $recur_1);
|
|
|
2094 |
$flag_t = "" if (! defined $flag_t);
|
|
|
2095 |
$date_b = "" if (! defined $date_b);
|
|
|
2096 |
$date_0 = "" if (! defined $date_0);
|
|
|
2097 |
$date_1 = "" if (! defined $date_1);
|
|
|
2098 |
|
|
|
2099 |
@recur0 = split(/:/,$recur_0);
|
|
|
2100 |
@recur1 = split(/:/,$recur_1);
|
|
|
2101 |
return "" if ($#recur0 + $#recur1 + 2 != 7);
|
|
|
2102 |
|
|
|
2103 |
if ($date_b) {
|
|
|
2104 |
$date_b=&ParseDateString($date_b);
|
|
|
2105 |
return "" if (! $date_b);
|
|
|
2106 |
}
|
|
|
2107 |
if ($date_0) {
|
|
|
2108 |
$date_0=&ParseDateString($date_0);
|
|
|
2109 |
return "" if (! $date_0);
|
|
|
2110 |
}
|
|
|
2111 |
if ($date_1) {
|
|
|
2112 |
$date_1=&ParseDateString($date_1);
|
|
|
2113 |
return "" if (! $date_1);
|
|
|
2114 |
}
|
|
|
2115 |
|
|
|
2116 |
} else {
|
|
|
2117 |
|
|
|
2118 |
my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...)
|
|
|
2119 |
my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... }
|
|
|
2120 |
my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...)
|
|
|
2121 |
my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... }
|
|
|
2122 |
my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days)
|
|
|
2123 |
my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months)
|
|
|
2124 |
my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks)
|
|
|
2125 |
my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st)
|
|
|
2126 |
my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} };
|
|
|
2127 |
# { 1st=>1,first=>1,...}
|
|
|
2128 |
my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of)
|
|
|
2129 |
my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last)
|
|
|
2130 |
my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every)
|
|
|
2131 |
|
|
|
2132 |
my($D)='\s*(\d+)';
|
|
|
2133 |
my($Y)='\s*(\d{4}|\d{2})';
|
|
|
2134 |
|
|
|
2135 |
# Change 1st to 1
|
|
|
2136 |
if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
|
|
|
2137 |
$tmp=lc($2);
|
|
|
2138 |
$tmp=$dayshash{"$tmp"};
|
|
|
2139 |
s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
|
|
|
2140 |
}
|
|
|
2141 |
s/\s*$//;
|
|
|
2142 |
|
|
|
2143 |
# Get rid of "each"
|
|
|
2144 |
if (/(^|[^a-z])$each($|[^a-z])/i) {
|
|
|
2145 |
s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
|
|
|
2146 |
$each=1;
|
|
|
2147 |
} else {
|
|
|
2148 |
$each=0;
|
|
|
2149 |
}
|
|
|
2150 |
|
|
|
2151 |
if ($each) {
|
|
|
2152 |
|
|
|
2153 |
if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
|
|
|
2154 |
/^$D?$day(?:$of$mmm())?$/i) {
|
|
|
2155 |
# every [2nd] day in [june] 1997
|
|
|
2156 |
# every [2nd] day [in june]
|
|
|
2157 |
($num,$m,$y)=($1,$2,$3);
|
|
|
2158 |
$num=1 if (! defined $num);
|
|
|
2159 |
$m="" if (! defined $m);
|
|
|
2160 |
$y="" if (! defined $y);
|
|
|
2161 |
|
|
|
2162 |
$y=$Curr{"Y"} if (! $y);
|
|
|
2163 |
if ($m) {
|
|
|
2164 |
$m=$mmm{lc($m)};
|
|
|
2165 |
$date_0=&Date_Join($y,$m,1,0,0,0);
|
|
|
2166 |
$date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
|
|
|
2167 |
} else {
|
|
|
2168 |
$date_0=&Date_Join($y, 1,1,0,0,0);
|
|
|
2169 |
$date_1=&Date_Join($y+1,1,1,0,0,0);
|
|
|
2170 |
}
|
|
|
2171 |
$date_b=&DateCalc($date_0,"-0:0:0:1:0:0:0",0);
|
|
|
2172 |
@recur0=(0,0,0,$num,0,0,0);
|
|
|
2173 |
@recur1=();
|
|
|
2174 |
|
|
|
2175 |
} elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
|
|
|
2176 |
# 2nd [day] of every month [in 1997]
|
|
|
2177 |
($num,$y)=($1,$2);
|
|
|
2178 |
$y=$Curr{"Y"} if (! $y);
|
|
|
2179 |
|
|
|
2180 |
$date_0=&Date_Join($y, 1,1,0,0,0);
|
|
|
2181 |
$date_1=&Date_Join($y+1,1,1,0,0,0);
|
|
|
2182 |
$date_b=$date_0;
|
|
|
2183 |
|
|
|
2184 |
@recur0=(0,1,0);
|
|
|
2185 |
@recur1=($num,0,0,0);
|
|
|
2186 |
|
|
|
2187 |
} elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ ||
|
|
|
2188 |
/^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) {
|
|
|
2189 |
# 2nd tuesday of every month [in 1997]
|
|
|
2190 |
# last tuesday of every month [in 1997]
|
|
|
2191 |
($num,$d,$y)=($1,$2,$3);
|
|
|
2192 |
$y=$Curr{"Y"} if (! $y);
|
|
|
2193 |
$d=$week{lc($d)};
|
|
|
2194 |
$num=-1 if ($num !~ /^$D$/);
|
|
|
2195 |
|
|
|
2196 |
$date_0=&Date_Join($y,1,1,0,0,0);
|
|
|
2197 |
$date_1=&Date_Join($y+1,1,1,0,0,0);
|
|
|
2198 |
$date_b=$date_0;
|
|
|
2199 |
|
|
|
2200 |
@recur0=(0,1);
|
|
|
2201 |
@recur1=($num,$d,0,0,0);
|
|
|
2202 |
|
|
|
2203 |
} elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i ||
|
|
|
2204 |
/^$D?$wkexp(?:$of$mmm())?$/i) {
|
|
|
2205 |
# every tuesday in june 1997
|
|
|
2206 |
# every 2nd tuesday in june 1997
|
|
|
2207 |
($num,$d,$m,$y)=($1,$2,$3,$4);
|
|
|
2208 |
$y=$Curr{"Y"} if (! $y);
|
|
|
2209 |
$num=1 if (! defined $num);
|
|
|
2210 |
$m="" if (! defined $m);
|
|
|
2211 |
$d=$week{lc($d)};
|
|
|
2212 |
|
|
|
2213 |
if ($m) {
|
|
|
2214 |
$m=$mmm{lc($m)};
|
|
|
2215 |
$date_0=&Date_Join($y,$m,1,0,0,0);
|
|
|
2216 |
$date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
|
|
|
2217 |
} else {
|
|
|
2218 |
$date_0=&Date_Join($y,1,1,0,0,0);
|
|
|
2219 |
$date_1=&Date_Join($y+1,1,1,0,0,0);
|
|
|
2220 |
}
|
|
|
2221 |
$date_b=&DateCalc($date_0,"-0:0:0:1:0:0:0",0);
|
|
|
2222 |
|
|
|
2223 |
@recur0=(0,0,$num);
|
|
|
2224 |
@recur1=($d,0,0,0);
|
|
|
2225 |
|
|
|
2226 |
} else {
|
|
|
2227 |
return "";
|
|
|
2228 |
}
|
|
|
2229 |
|
|
|
2230 |
$date_0="" if ($date0);
|
|
|
2231 |
$date_1="" if ($date1);
|
|
|
2232 |
} else {
|
|
|
2233 |
return "";
|
|
|
2234 |
}
|
|
|
2235 |
}
|
|
|
2236 |
|
|
|
2237 |
#
|
|
|
2238 |
# Override with any values passed in
|
|
|
2239 |
#
|
|
|
2240 |
|
|
|
2241 |
if ($date0 && $date_0) {
|
|
|
2242 |
$date0=( &Date_Cmp($date0,$date_0) > 1 ? $date0 : $date_0);
|
|
|
2243 |
} elsif ($date_0) {
|
|
|
2244 |
$date0 = $date_0;
|
|
|
2245 |
}
|
|
|
2246 |
|
|
|
2247 |
if ($date1 && $date_1) {
|
|
|
2248 |
$date1=( &Date_Cmp($date1,$date_1) > 1 ? $date_1 : $date1);
|
|
|
2249 |
} elsif ($date_1) {
|
|
|
2250 |
$date1 = $date_1;
|
|
|
2251 |
}
|
|
|
2252 |
|
|
|
2253 |
$dateb=$date_b if (! $dateb);
|
|
|
2254 |
|
|
|
2255 |
if ($flag =~ s/^\+//) {
|
|
|
2256 |
if ($flag_t) {
|
|
|
2257 |
$flag="$flag_t,$flag";
|
|
|
2258 |
}
|
|
|
2259 |
}
|
|
|
2260 |
$flag =$flag_t if (! $flag && $flag_t);
|
|
|
2261 |
|
|
|
2262 |
if (! wantarray) {
|
|
|
2263 |
$tmp = join(":",@recur0);
|
|
|
2264 |
$tmp .= "*" . join(":",@recur1) if (@recur1);
|
|
|
2265 |
$tmp .= "*$flag*$dateb*$date0*$date1";
|
|
|
2266 |
return $tmp;
|
|
|
2267 |
}
|
|
|
2268 |
if (@recur0) {
|
|
|
2269 |
return () if (! $date0 || ! $date1); # dateb is NOT required in all case
|
|
|
2270 |
}
|
|
|
2271 |
|
|
|
2272 |
#
|
|
|
2273 |
# Some flags affect parsing.
|
|
|
2274 |
#
|
|
|
2275 |
|
|
|
2276 |
@flags = split(/,/,$flag);
|
|
|
2277 |
my($MDn) = 0;
|
|
|
2278 |
my($MWn) = 7;
|
|
|
2279 |
my($f);
|
|
|
2280 |
foreach $f (@flags) {
|
|
|
2281 |
if ($f =~ /^MW([1-7])$/i) {
|
|
|
2282 |
$MWn=$1;
|
|
|
2283 |
$MDn=0;
|
|
|
2284 |
|
|
|
2285 |
} elsif ($f =~ /^MD([1-7])$/i) {
|
|
|
2286 |
$MDn=$1;
|
|
|
2287 |
$MWn=0;
|
|
|
2288 |
|
|
|
2289 |
} elsif ($f =~ /^EASTER$/i) {
|
|
|
2290 |
($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
|
|
|
2291 |
# We want something that will return Jan 1 for the given years.
|
|
|
2292 |
if ($#recur0==-1) {
|
|
|
2293 |
@recur1=($y,1,0,1,$h,$mn,$s);
|
|
|
2294 |
} elsif ($#recur0<=3) {
|
|
|
2295 |
@recur0=($y,0,0,0);
|
|
|
2296 |
@recur1=($h,$mn,$s);
|
|
|
2297 |
} elsif ($#recur0==4) {
|
|
|
2298 |
@recur0=($y,0,0,0,0);
|
|
|
2299 |
@recur1=($mn,$s);
|
|
|
2300 |
} elsif ($#recur0==5) {
|
|
|
2301 |
@recur0=($y,0,0,0,0,0);
|
|
|
2302 |
@recur1=($s);
|
|
|
2303 |
} else {
|
|
|
2304 |
@recur0=($y,0,0,0,0,0,0);
|
|
|
2305 |
}
|
|
|
2306 |
}
|
|
|
2307 |
}
|
|
|
2308 |
|
|
|
2309 |
#
|
|
|
2310 |
# Determine the dates referenced by the recur. Also, fix the base date
|
|
|
2311 |
# as necessary for the recurrences which require it.
|
|
|
2312 |
#
|
|
|
2313 |
|
|
|
2314 |
($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
|
|
|
2315 |
@y=@m=@w=@d=();
|
|
|
2316 |
my(@time)=($h,$mn,$s);
|
|
|
2317 |
|
|
|
2318 |
RECUR: while (1) {
|
|
|
2319 |
|
|
|
2320 |
if ($#recur0==-1) {
|
|
|
2321 |
# * Y-M-W-D-H-MN-S
|
|
|
2322 |
if ($y eq "0") {
|
|
|
2323 |
push(@recur0,0);
|
|
|
2324 |
shift(@recur1);
|
|
|
2325 |
|
|
|
2326 |
} else {
|
|
|
2327 |
@y=&ReturnList($y);
|
|
|
2328 |
foreach $y (@y) {
|
|
|
2329 |
$y=&Date_FixYear($y) if (length($y)==2);
|
|
|
2330 |
return () if (length($y)!=4 || ! &IsInt($y));
|
|
|
2331 |
}
|
|
|
2332 |
@y=sort { $a<=>$b } @y;
|
|
|
2333 |
|
|
|
2334 |
$date0=&ParseDate("0000-01-01") if (! $date0);
|
|
|
2335 |
$date1=&ParseDate("9999-12-31 23:59:59") if (! $date1);
|
|
|
2336 |
|
|
|
2337 |
if ($m eq "0" and $w eq "0") {
|
|
|
2338 |
# * Y-0-0-0-H-MN-S
|
|
|
2339 |
# * Y-0-0-DOY-H-MN-S
|
|
|
2340 |
if ($d eq "0") {
|
|
|
2341 |
@d=(1);
|
|
|
2342 |
} else {
|
|
|
2343 |
@d=&ReturnList($d);
|
|
|
2344 |
return () if (! @d);
|
|
|
2345 |
foreach $d (@d) {
|
|
|
2346 |
return () if (! &IsInt($d,1,366));
|
|
|
2347 |
}
|
|
|
2348 |
@d=sort { $a<=>$b } (@d);
|
|
|
2349 |
}
|
|
|
2350 |
|
|
|
2351 |
@date=();
|
|
|
2352 |
foreach $yy (@y) {
|
|
|
2353 |
foreach $d (@d) {
|
|
|
2354 |
($y,$m,$dd)=&Date_NthDayOfYear($yy,$d);
|
|
|
2355 |
push(@date, &Date_Join($y,$m,$dd,0,0,0));
|
|
|
2356 |
}
|
|
|
2357 |
}
|
|
|
2358 |
last RECUR;
|
|
|
2359 |
|
|
|
2360 |
} elsif ($w eq "0") {
|
|
|
2361 |
# * Y-M-0-0-H-MN-S
|
|
|
2362 |
# * Y-M-0-DOM-H-MN-S
|
|
|
2363 |
|
|
|
2364 |
@m=&ReturnList($m);
|
|
|
2365 |
return () if (! @m);
|
|
|
2366 |
foreach $m (@m) {
|
|
|
2367 |
return () if (! &IsInt($m,1,12));
|
|
|
2368 |
}
|
|
|
2369 |
@m=sort { $a<=>$b } (@m);
|
|
|
2370 |
|
|
|
2371 |
if ($d eq "0") {
|
|
|
2372 |
@d=(1);
|
|
|
2373 |
} else {
|
|
|
2374 |
@d=&ReturnList($d);
|
|
|
2375 |
return () if (! @d);
|
|
|
2376 |
foreach $d (@d) {
|
|
|
2377 |
return () if (! &IsInt($d,1,31));
|
|
|
2378 |
}
|
|
|
2379 |
@d=sort { $a<=>$b } (@d);
|
|
|
2380 |
}
|
|
|
2381 |
|
|
|
2382 |
@date=();
|
|
|
2383 |
foreach $y (@y) {
|
|
|
2384 |
foreach $m (@m) {
|
|
|
2385 |
foreach $d (@d) {
|
|
|
2386 |
$date=&Date_Join($y,$m,$d,0,0,0);
|
|
|
2387 |
push(@date,$date) if ($d<29 || &Date_Split($date));
|
|
|
2388 |
}
|
|
|
2389 |
}
|
|
|
2390 |
}
|
|
|
2391 |
last RECUR;
|
|
|
2392 |
|
|
|
2393 |
} elsif ($m eq "0") {
|
|
|
2394 |
# * Y-0-WOY-DOW-H-MN-S
|
|
|
2395 |
# * Y-0-WOY-0-H-MN-S
|
|
|
2396 |
@w=&ReturnList($w);
|
|
|
2397 |
return () if (! @w);
|
|
|
2398 |
foreach $w (@w) {
|
|
|
2399 |
return () if (! &IsInt($w,1,53));
|
|
|
2400 |
}
|
|
|
2401 |
|
|
|
2402 |
if ($d eq "0") {
|
|
|
2403 |
@d=($Cnf{"FirstDay"});
|
|
|
2404 |
} else {
|
|
|
2405 |
@d=&ReturnList($d);
|
|
|
2406 |
return () if (! @d);
|
|
|
2407 |
foreach $d (@d) {
|
|
|
2408 |
return () if (! &IsInt($d,1,7));
|
|
|
2409 |
}
|
|
|
2410 |
@d=sort { $a<=>$b } (@d);
|
|
|
2411 |
}
|
|
|
2412 |
|
|
|
2413 |
@date=();
|
|
|
2414 |
foreach $y (@y) {
|
|
|
2415 |
foreach $w (@w) {
|
|
|
2416 |
$w="0$w" if (length($w)==1);
|
|
|
2417 |
foreach $d (@d) {
|
|
|
2418 |
$date=&ParseDateString("$y-W$w-$d");
|
|
|
2419 |
push(@date,$date);
|
|
|
2420 |
}
|
|
|
2421 |
}
|
|
|
2422 |
}
|
|
|
2423 |
last RECUR;
|
|
|
2424 |
|
|
|
2425 |
} else {
|
|
|
2426 |
# * Y-M-WOM-DOW-H-MN-S
|
|
|
2427 |
# * Y-M-WOM-0-H-MN-S
|
|
|
2428 |
|
|
|
2429 |
@m=&ReturnList($m);
|
|
|
2430 |
return () if (! @m);
|
|
|
2431 |
foreach $m (@m) {
|
|
|
2432 |
return () if (! &IsInt($m,1,12));
|
|
|
2433 |
}
|
|
|
2434 |
@m=sort { $a<=>$b } (@m);
|
|
|
2435 |
|
|
|
2436 |
@w=&ReturnList($w);
|
|
|
2437 |
|
|
|
2438 |
if ($d eq "0") {
|
|
|
2439 |
@d=();
|
|
|
2440 |
} else {
|
|
|
2441 |
@d=&ReturnList($d);
|
|
|
2442 |
}
|
|
|
2443 |
|
|
|
2444 |
@date=&Date_Recur_WoM(\@y,\@m,\@w,\@d,$MWn,$MDn);
|
|
|
2445 |
last RECUR;
|
|
|
2446 |
}
|
|
|
2447 |
}
|
|
|
2448 |
}
|
|
|
2449 |
|
|
|
2450 |
if ($#recur0==0) {
|
|
|
2451 |
# Y * M-W-D-H-MN-S
|
|
|
2452 |
$n=$y;
|
|
|
2453 |
$n=1 if ($n==0);
|
|
|
2454 |
|
|
|
2455 |
@m=&ReturnList($m);
|
|
|
2456 |
return () if (! @m);
|
|
|
2457 |
foreach $m (@m) {
|
|
|
2458 |
return () if (! &IsInt($m,1,12));
|
|
|
2459 |
}
|
|
|
2460 |
@m=sort { $a<=>$b } (@m);
|
|
|
2461 |
|
|
|
2462 |
if ($m eq "0") {
|
|
|
2463 |
# Y * 0-W-D-H-MN-S (equiv to Y-0 * W-D-H-MN-S)
|
|
|
2464 |
push(@recur0,0);
|
|
|
2465 |
shift(@recur1);
|
|
|
2466 |
|
|
|
2467 |
} elsif ($w eq "0") {
|
|
|
2468 |
# Y * M-0-DOM-H-MN-S
|
|
|
2469 |
return () if (! $dateb);
|
|
|
2470 |
$d=1 if ($d eq "0");
|
|
|
2471 |
|
|
|
2472 |
@d=&ReturnList($d);
|
|
|
2473 |
return () if (! @d);
|
|
|
2474 |
foreach $d (@d) {
|
|
|
2475 |
return () if (! &IsInt($d,1,31));
|
|
|
2476 |
}
|
|
|
2477 |
@d=sort { $a<=>$b } (@d);
|
|
|
2478 |
|
|
|
2479 |
# We need to find years that are a multiple of $n from $y(base)
|
|
|
2480 |
($y0)=( &Date_Split($date0, 1) )[0];
|
|
|
2481 |
($y1)=( &Date_Split($date1, 1) )[0];
|
|
|
2482 |
($yb)=( &Date_Split($dateb, 1) )[0];
|
|
|
2483 |
@date=();
|
|
|
2484 |
for ($yy=$y0; $yy<=$y1; $yy++) {
|
|
|
2485 |
if (($yy-$yb)%$n == 0) {
|
|
|
2486 |
foreach $m (@m) {
|
|
|
2487 |
foreach $d (@d) {
|
|
|
2488 |
$date=&Date_Join($yy,$m,$d,0,0,0);
|
|
|
2489 |
push(@date,$date) if ($d<29 || &Date_Split($date));
|
|
|
2490 |
}
|
|
|
2491 |
}
|
|
|
2492 |
}
|
|
|
2493 |
}
|
|
|
2494 |
last RECUR;
|
|
|
2495 |
|
|
|
2496 |
} else {
|
|
|
2497 |
# Y * M-WOM-DOW-H-MN-S
|
|
|
2498 |
# Y * M-WOM-0-H-MN-S
|
|
|
2499 |
return () if (! $dateb);
|
|
|
2500 |
@m=&ReturnList($m);
|
|
|
2501 |
@w=&ReturnList($w);
|
|
|
2502 |
if ($d eq "0") {
|
|
|
2503 |
@d=();
|
|
|
2504 |
} else {
|
|
|
2505 |
@d=&ReturnList($d);
|
|
|
2506 |
}
|
|
|
2507 |
|
|
|
2508 |
($y0)=( &Date_Split($date0, 1) )[0];
|
|
|
2509 |
($y1)=( &Date_Split($date1, 1) )[0];
|
|
|
2510 |
($yb)=( &Date_Split($dateb, 1) )[0];
|
|
|
2511 |
@y=();
|
|
|
2512 |
for ($yy=$y0; $yy<=$y1; $yy++) {
|
|
|
2513 |
if (($yy-$yb)%$n == 0) {
|
|
|
2514 |
push(@y,$yy);
|
|
|
2515 |
}
|
|
|
2516 |
}
|
|
|
2517 |
|
|
|
2518 |
@date=&Date_Recur_WoM(\@y,\@m,\@w,\@d,$MWn,$MDn);
|
|
|
2519 |
last RECUR;
|
|
|
2520 |
}
|
|
|
2521 |
}
|
|
|
2522 |
|
|
|
2523 |
if ($#recur0==1) {
|
|
|
2524 |
# Y-M * W-D-H-MN-S
|
|
|
2525 |
|
|
|
2526 |
if ($w eq "0") {
|
|
|
2527 |
# Y-M * 0-D-H-MN-S (equiv to Y-M-0 * D-H-MN-S)
|
|
|
2528 |
push(@recur0,0);
|
|
|
2529 |
shift(@recur1);
|
|
|
2530 |
|
|
|
2531 |
} elsif ($m==0) {
|
|
|
2532 |
# Y-0 * WOY-0-H-MN-S
|
|
|
2533 |
# Y-0 * WOY-DOW-H-MN-S
|
|
|
2534 |
return () if (! $dateb);
|
|
|
2535 |
$n=$y;
|
|
|
2536 |
$n=1 if ($n==0);
|
|
|
2537 |
|
|
|
2538 |
@w=&ReturnList($w);
|
|
|
2539 |
return () if (! @w);
|
|
|
2540 |
foreach $w (@w) {
|
|
|
2541 |
return () if (! &IsInt($w,1,53));
|
|
|
2542 |
}
|
|
|
2543 |
|
|
|
2544 |
if ($d eq "0") {
|
|
|
2545 |
@d=($Cnf{"FirstDay"});
|
|
|
2546 |
} else {
|
|
|
2547 |
@d=&ReturnList($d);
|
|
|
2548 |
return () if (! @d);
|
|
|
2549 |
foreach $d (@d) {
|
|
|
2550 |
return () if (! &IsInt($d,1,7));
|
|
|
2551 |
}
|
|
|
2552 |
@d=sort { $a<=>$b } (@d);
|
|
|
2553 |
}
|
|
|
2554 |
|
|
|
2555 |
# We need to find years that are a multiple of $n from $y(base)
|
|
|
2556 |
($y0)=( &Date_Split($date0, 1) )[0];
|
|
|
2557 |
($y1)=( &Date_Split($date1, 1) )[0];
|
|
|
2558 |
($yb)=( &Date_Split($dateb, 1) )[0];
|
|
|
2559 |
@date=();
|
|
|
2560 |
for ($yy=$y0; $yy<=$y1; $yy++) {
|
|
|
2561 |
if (($yy-$yb)%$n == 0) {
|
|
|
2562 |
foreach $w (@w) {
|
|
|
2563 |
$w="0$w" if (length($w)==1);
|
|
|
2564 |
foreach $tmp (@d) {
|
|
|
2565 |
$date=&ParseDateString("$yy-W$w-$tmp");
|
|
|
2566 |
push(@date,$date);
|
|
|
2567 |
}
|
|
|
2568 |
}
|
|
|
2569 |
}
|
|
|
2570 |
}
|
|
|
2571 |
last RECUR;
|
|
|
2572 |
|
|
|
2573 |
} else {
|
|
|
2574 |
# Y-M * WOM-0-H-MN-S
|
|
|
2575 |
# Y-M * WOM-DOW-H-MN-S
|
|
|
2576 |
return () if (! $dateb);
|
|
|
2577 |
@tmp=(@recur0);
|
|
|
2578 |
push(@tmp,0) while ($#tmp<6);
|
|
|
2579 |
$delta=join(":",@tmp);
|
|
|
2580 |
@tmp=&Date_Recur($date0,$date1,$dateb,$delta);
|
|
|
2581 |
|
|
|
2582 |
@w=&ReturnList($w);
|
|
|
2583 |
@m=();
|
|
|
2584 |
if ($d eq "0") {
|
|
|
2585 |
@d=();
|
|
|
2586 |
} else {
|
|
|
2587 |
@d=&ReturnList($d);
|
|
|
2588 |
}
|
|
|
2589 |
|
|
|
2590 |
@date=&Date_Recur_WoM(\@tmp,\@m,\@w,\@d,$MWn,$MDn);
|
|
|
2591 |
last RECUR;
|
|
|
2592 |
}
|
|
|
2593 |
}
|
|
|
2594 |
|
|
|
2595 |
if ($#recur0==2) {
|
|
|
2596 |
# Y-M-W * D-H-MN-S
|
|
|
2597 |
|
|
|
2598 |
if ($d eq "0") {
|
|
|
2599 |
# Y-M-W * 0-H-MN-S
|
|
|
2600 |
return () if (! $dateb);
|
|
|
2601 |
$y=1 if ($y==0 && $m==0 && $w==0);
|
|
|
2602 |
$delta="$y:$m:$w:0:0:0:0";
|
|
|
2603 |
@date=&Date_Recur($date0,$date1,$dateb,$delta);
|
|
|
2604 |
last RECUR;
|
|
|
2605 |
|
|
|
2606 |
} elsif ($m==0 && $w==0) {
|
|
|
2607 |
# Y-0-0 * DOY-H-MN-S
|
|
|
2608 |
$y=1 if ($y==0);
|
|
|
2609 |
$n=$y;
|
|
|
2610 |
return () if (! $dateb && $y!=1);
|
|
|
2611 |
|
|
|
2612 |
@d=&ReturnList($d);
|
|
|
2613 |
return () if (! @d);
|
|
|
2614 |
foreach $d (@d) {
|
|
|
2615 |
return () if (! &IsInt($d,1,366));
|
|
|
2616 |
}
|
|
|
2617 |
@d=sort { $a<=>$b } (@d);
|
|
|
2618 |
|
|
|
2619 |
# We need to find years that are a multiple of $n from $y(base)
|
|
|
2620 |
($y0)=( &Date_Split($date0, 1) )[0];
|
|
|
2621 |
($y1)=( &Date_Split($date1, 1) )[0];
|
|
|
2622 |
($yb)=( &Date_Split($dateb, 1) )[0];
|
|
|
2623 |
@date=();
|
|
|
2624 |
for ($yy=$y0; $yy<=$y1; $yy++) {
|
|
|
2625 |
if (($yy-$yb)%$n == 0) {
|
|
|
2626 |
foreach $d (@d) {
|
|
|
2627 |
($y,$m,$dd)=&Date_NthDayOfYear($yy,$d);
|
|
|
2628 |
push(@date, &Date_Join($y,$m,$dd,0,0,0));
|
|
|
2629 |
}
|
|
|
2630 |
}
|
|
|
2631 |
}
|
|
|
2632 |
last RECUR;
|
|
|
2633 |
|
|
|
2634 |
} elsif ($w>0) {
|
|
|
2635 |
# Y-M-W * DOW-H-MN-S
|
|
|
2636 |
return () if (! $dateb);
|
|
|
2637 |
@tmp=(@recur0);
|
|
|
2638 |
push(@tmp,0) while ($#tmp<6);
|
|
|
2639 |
$delta=join(":",@tmp);
|
|
|
2640 |
|
|
|
2641 |
@d=&ReturnList($d);
|
|
|
2642 |
return () if (! @d);
|
|
|
2643 |
foreach $d (@d) {
|
|
|
2644 |
return () if (! &IsInt($d,1,7));
|
|
|
2645 |
}
|
|
|
2646 |
|
|
|
2647 |
# Find out what DofW the basedate is.
|
|
|
2648 |
@tmp2=&Date_Split($dateb, 1);
|
|
|
2649 |
$tmp=&Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]);
|
|
|
2650 |
|
|
|
2651 |
@date=();
|
|
|
2652 |
foreach $d (@d) {
|
|
|
2653 |
$date_b=$dateb;
|
|
|
2654 |
# Move basedate to DOW
|
|
|
2655 |
if ($d != $tmp) {
|
|
|
2656 |
if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
|
|
|
2657 |
($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
|
|
|
2658 |
($tmp<$d && $d<$Cnf{"FirstDay"})) {
|
|
|
2659 |
$date_b=&Date_GetNext($date_b,$d);
|
|
|
2660 |
} else {
|
|
|
2661 |
$date_b=&Date_GetPrev($date_b,$d);
|
|
|
2662 |
}
|
|
|
2663 |
}
|
|
|
2664 |
push(@date,&Date_Recur($date0,$date1,$date_b,$delta));
|
|
|
2665 |
}
|
|
|
2666 |
@date=sort(@date);
|
|
|
2667 |
last RECUR;
|
|
|
2668 |
|
|
|
2669 |
} elsif ($m>0) {
|
|
|
2670 |
# Y-M-0 * DOM-H-MN-S
|
|
|
2671 |
return () if (! $dateb);
|
|
|
2672 |
@tmp=(@recur0);
|
|
|
2673 |
push(@tmp,0) while ($#tmp<6);
|
|
|
2674 |
$delta=join(":",@tmp);
|
|
|
2675 |
|
|
|
2676 |
@d=&ReturnList($d);
|
|
|
2677 |
return () if (! @d);
|
|
|
2678 |
foreach $d (@d) {
|
|
|
2679 |
return () if (! &IsInt($d,-31,31) || $d==0);
|
|
|
2680 |
}
|
|
|
2681 |
@d=sort { $a<=>$b } (@d);
|
|
|
2682 |
|
|
|
2683 |
@tmp2=&Date_Recur($date0,$date1,$dateb,$delta);
|
|
|
2684 |
@date=();
|
|
|
2685 |
foreach $date (@tmp2) {
|
|
|
2686 |
($y,$m)=( &Date_Split($date, 1) )[0..1];
|
|
|
2687 |
$tmp2=&Date_DaysInMonth($m,$y);
|
|
|
2688 |
foreach $d (@d) {
|
|
|
2689 |
$d2=$d;
|
|
|
2690 |
$d2=$tmp2+1+$d if ($d<0);
|
|
|
2691 |
push(@date,&Date_Join($y,$m,$d2,0,0,0)) if ($d2<=$tmp2);
|
|
|
2692 |
}
|
|
|
2693 |
}
|
|
|
2694 |
@date=sort (@date);
|
|
|
2695 |
last RECUR;
|
|
|
2696 |
|
|
|
2697 |
} else {
|
|
|
2698 |
return ();
|
|
|
2699 |
}
|
|
|
2700 |
}
|
|
|
2701 |
|
|
|
2702 |
if ($#recur0>2) {
|
|
|
2703 |
# Y-M-W-D * H-MN-S
|
|
|
2704 |
# Y-M-W-D-H * MN-S
|
|
|
2705 |
# Y-M-W-D-H-MN * S
|
|
|
2706 |
# Y-M-W-D-H-S
|
|
|
2707 |
return () if (! $dateb);
|
|
|
2708 |
@tmp=(@recur0);
|
|
|
2709 |
push(@tmp,0) while ($#tmp<6);
|
|
|
2710 |
$delta=join(":",@tmp);
|
|
|
2711 |
return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
|
|
|
2712 |
@date=&Date_Recur($date0,$date1,$dateb,$delta);
|
|
|
2713 |
if (@recur1) {
|
|
|
2714 |
unshift(@recur1,-1) while ($#recur1<2);
|
|
|
2715 |
@time=@recur1;
|
|
|
2716 |
} else {
|
|
|
2717 |
shift(@date);
|
|
|
2718 |
pop(@date);
|
|
|
2719 |
@time=();
|
|
|
2720 |
}
|
|
|
2721 |
}
|
|
|
2722 |
|
|
|
2723 |
last RECUR;
|
|
|
2724 |
}
|
|
|
2725 |
@date=&Date_RecurSetTime($date0,$date1,\@date,@time) if (@time);
|
|
|
2726 |
|
|
|
2727 |
#
|
|
|
2728 |
# We've got a list of dates. Operate on them with the flags.
|
|
|
2729 |
#
|
|
|
2730 |
|
|
|
2731 |
my($sign,$forw,$today,$df,$db,$work,$i);
|
|
|
2732 |
if (@flags) {
|
|
|
2733 |
FLAG: foreach $f (@flags) {
|
|
|
2734 |
$f = uc($f);
|
|
|
2735 |
|
|
|
2736 |
if ($f =~ /^(P|N)(D|T)([1-7])$/) {
|
|
|
2737 |
@tmp=($1,$2,$3);
|
|
|
2738 |
$forw =($tmp[0] eq "P" ? 0 : 1);
|
|
|
2739 |
$today=($tmp[1] eq "D" ? 0 : 1);
|
|
|
2740 |
$d=$tmp[2];
|
|
|
2741 |
@tmp=();
|
|
|
2742 |
foreach $date (@date) {
|
|
|
2743 |
if ($forw) {
|
|
|
2744 |
push(@tmp, &Date_GetNext($date,$d,$today));
|
|
|
2745 |
} else {
|
|
|
2746 |
push(@tmp, &Date_GetPrev($date,$d,$today));
|
|
|
2747 |
}
|
|
|
2748 |
}
|
|
|
2749 |
@date=@tmp;
|
|
|
2750 |
next FLAG;
|
|
|
2751 |
}
|
|
|
2752 |
|
|
|
2753 |
# We want to go forward exact amounts of time instead of
|
|
|
2754 |
# business mode calculations so that we don't change the time
|
|
|
2755 |
# (which may have been set in the recur).
|
|
|
2756 |
if ($f =~ /^(F|B)(D|W)(\d+)$/) {
|
|
|
2757 |
@tmp=($1,$2,$3);
|
|
|
2758 |
$sign="+";
|
|
|
2759 |
$sign="-" if ($tmp[0] eq "B");
|
|
|
2760 |
$work=0;
|
|
|
2761 |
$work=1 if ($tmp[1] eq "W");
|
|
|
2762 |
$n=$tmp[2];
|
|
|
2763 |
@tmp=();
|
|
|
2764 |
foreach $date (@date) {
|
|
|
2765 |
for ($i=1; $i<=$n; $i++) {
|
|
|
2766 |
while (1) {
|
|
|
2767 |
$date=&DateCalc($date,"${sign}0:0:0:1:0:0:0");
|
|
|
2768 |
last if (! $work || &Date_IsWorkDay($date,0));
|
|
|
2769 |
}
|
|
|
2770 |
}
|
|
|
2771 |
push(@tmp,$date);
|
|
|
2772 |
}
|
|
|
2773 |
@date=@tmp;
|
|
|
2774 |
next FLAG;
|
|
|
2775 |
}
|
|
|
2776 |
|
|
|
2777 |
if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
|
|
|
2778 |
$tmp=$1;
|
|
|
2779 |
my $noalt = $2 ? 1 : 0;
|
|
|
2780 |
if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
|
|
|
2781 |
$forw=1;
|
|
|
2782 |
} else {
|
|
|
2783 |
$forw=0;
|
|
|
2784 |
}
|
|
|
2785 |
|
|
|
2786 |
@tmp=();
|
|
|
2787 |
DATE: foreach $date (@date) {
|
|
|
2788 |
$df=$db=$date;
|
|
|
2789 |
if (&Date_IsWorkDay($date)) {
|
|
|
2790 |
push(@tmp,$date);
|
|
|
2791 |
next DATE;
|
|
|
2792 |
}
|
|
|
2793 |
while (1) {
|
|
|
2794 |
if ($forw) {
|
|
|
2795 |
$d=$df=&DateCalc($df,"+0:0:0:1:0:0:0");
|
|
|
2796 |
} else {
|
|
|
2797 |
$d=$db=&DateCalc($db,"-0:0:0:1:0:0:0");
|
|
|
2798 |
}
|
|
|
2799 |
if (&Date_IsWorkDay($d)) {
|
|
|
2800 |
push(@tmp,$d);
|
|
|
2801 |
next DATE;
|
|
|
2802 |
}
|
|
|
2803 |
$forw=1-$forw if (! $noalt);
|
|
|
2804 |
}
|
|
|
2805 |
}
|
|
|
2806 |
@date=@tmp;
|
|
|
2807 |
next FLAG;
|
|
|
2808 |
}
|
|
|
2809 |
|
|
|
2810 |
if ($f eq "EASTER") {
|
|
|
2811 |
@tmp=();
|
|
|
2812 |
foreach $date (@date) {
|
|
|
2813 |
($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
|
|
|
2814 |
($m,$d)=&Date_Easter($y);
|
|
|
2815 |
$date=&Date_Join($y,$m,$d,$h,$mn,$s);
|
|
|
2816 |
next if (&Date_Cmp($date,$date0)<0 ||
|
|
|
2817 |
&Date_Cmp($date,$date1)>0);
|
|
|
2818 |
push(@tmp,$date);
|
|
|
2819 |
}
|
|
|
2820 |
@date=@tmp;
|
|
|
2821 |
}
|
|
|
2822 |
}
|
|
|
2823 |
@date = sort(@date);
|
|
|
2824 |
}
|
|
|
2825 |
@date;
|
|
|
2826 |
}
|
|
|
2827 |
|
|
|
2828 |
sub Date_GetPrev {
|
|
|
2829 |
print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
2830 |
my($date,$dow,$today,$hr,$min,$sec)=@_;
|
|
|
2831 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
2832 |
my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
|
|
|
2833 |
$adjust,$curr)=();
|
|
|
2834 |
$hr="00" if (defined $hr && $hr eq "0");
|
|
|
2835 |
$min="00" if (defined $min && $min eq "0");
|
|
|
2836 |
$sec="00" if (defined $sec && $sec eq "0");
|
|
|
2837 |
|
|
|
2838 |
if (! &Date_Split($date)) {
|
|
|
2839 |
$date=&ParseDateString($date);
|
|
|
2840 |
return "" if (! $date);
|
|
|
2841 |
}
|
|
|
2842 |
$curr=$date;
|
|
|
2843 |
($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
|
|
|
2844 |
|
|
|
2845 |
if ($dow) {
|
|
|
2846 |
$curr_dow=&Date_DayOfWeek($m,$d,$y);
|
|
|
2847 |
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
|
|
|
2848 |
if (&IsInt($dow)) {
|
|
|
2849 |
return "" if ($dow<1 || $dow>7);
|
|
|
2850 |
} else {
|
|
|
2851 |
return "" if (! exists $dow{lc($dow)});
|
|
|
2852 |
$dow=$dow{lc($dow)};
|
|
|
2853 |
}
|
|
|
2854 |
if ($dow == $curr_dow) {
|
|
|
2855 |
$date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today);
|
|
|
2856 |
$adjust=1 if ($today==2);
|
|
|
2857 |
} else {
|
|
|
2858 |
$dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
|
|
|
2859 |
$num = $curr_dow - $dow;
|
|
|
2860 |
$date=&DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0);
|
|
|
2861 |
}
|
|
|
2862 |
$date=&Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
|
|
|
2863 |
$date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0)
|
|
|
2864 |
if ($adjust && &Date_Cmp($date,$curr)>0);
|
|
|
2865 |
|
|
|
2866 |
} else {
|
|
|
2867 |
($h,$mn,$s)=( &Date_Split($date, 1) )[3..5];
|
|
|
2868 |
($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec);
|
|
|
2869 |
if ($hr) {
|
|
|
2870 |
($hr,$min,$sec)=($th,$tm,$ts);
|
|
|
2871 |
$delta="-0:0:0:1:0:0:0";
|
|
|
2872 |
} elsif ($min) {
|
|
|
2873 |
($hr,$min,$sec)=($h,$tm,$ts);
|
|
|
2874 |
$delta="-0:0:0:0:1:0:0";
|
|
|
2875 |
} elsif ($sec) {
|
|
|
2876 |
($hr,$min,$sec)=($h,$mn,$ts);
|
|
|
2877 |
$delta="-0:0:0:0:0:1:0";
|
|
|
2878 |
} else {
|
|
|
2879 |
confess "ERROR: invalid arguments in Date_GetPrev.\n";
|
|
|
2880 |
}
|
|
|
2881 |
|
|
|
2882 |
$d=&Date_SetTime($date,$hr,$min,$sec);
|
|
|
2883 |
if ($today) {
|
|
|
2884 |
$d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>0);
|
|
|
2885 |
} else {
|
|
|
2886 |
$d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>=0);
|
|
|
2887 |
}
|
|
|
2888 |
$date=$d;
|
|
|
2889 |
}
|
|
|
2890 |
return $date;
|
|
|
2891 |
}
|
|
|
2892 |
|
|
|
2893 |
sub Date_GetNext {
|
|
|
2894 |
print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
2895 |
my($date,$dow,$today,$hr,$min,$sec)=@_;
|
|
|
2896 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
2897 |
my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
|
|
|
2898 |
$adjust,$curr)=();
|
|
|
2899 |
$hr="00" if (defined $hr && $hr eq "0");
|
|
|
2900 |
$min="00" if (defined $min && $min eq "0");
|
|
|
2901 |
$sec="00" if (defined $sec && $sec eq "0");
|
|
|
2902 |
|
|
|
2903 |
if (! &Date_Split($date)) {
|
|
|
2904 |
$date=&ParseDateString($date);
|
|
|
2905 |
return "" if (! $date);
|
|
|
2906 |
}
|
|
|
2907 |
$curr=$date;
|
|
|
2908 |
($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
|
|
|
2909 |
|
|
|
2910 |
if ($dow) {
|
|
|
2911 |
$curr_dow=&Date_DayOfWeek($m,$d,$y);
|
|
|
2912 |
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
|
|
|
2913 |
if (&IsInt($dow)) {
|
|
|
2914 |
return "" if ($dow<1 || $dow>7);
|
|
|
2915 |
} else {
|
|
|
2916 |
return "" if (! exists $dow{lc($dow)});
|
|
|
2917 |
$dow=$dow{lc($dow)};
|
|
|
2918 |
}
|
|
|
2919 |
if ($dow == $curr_dow) {
|
|
|
2920 |
$date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today);
|
|
|
2921 |
$adjust=1 if ($today==2);
|
|
|
2922 |
} else {
|
|
|
2923 |
$curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
|
|
|
2924 |
$num = $dow - $curr_dow;
|
|
|
2925 |
$date=&DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0);
|
|
|
2926 |
}
|
|
|
2927 |
$date=&Date_SetTime($date,$hr,$min,$sec) if (defined $hr);
|
|
|
2928 |
$date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0)
|
|
|
2929 |
if ($adjust && &Date_Cmp($date,$curr)<0);
|
|
|
2930 |
|
|
|
2931 |
} else {
|
|
|
2932 |
($h,$mn,$s)=( &Date_Split($date, 1) )[3..5];
|
|
|
2933 |
($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec);
|
|
|
2934 |
if ($hr) {
|
|
|
2935 |
($hr,$min,$sec)=($th,$tm,$ts);
|
|
|
2936 |
$delta="+0:0:0:1:0:0:0";
|
|
|
2937 |
} elsif ($min) {
|
|
|
2938 |
($hr,$min,$sec)=($h,$tm,$ts);
|
|
|
2939 |
$delta="+0:0:0:0:1:0:0";
|
|
|
2940 |
} elsif ($sec) {
|
|
|
2941 |
($hr,$min,$sec)=($h,$mn,$ts);
|
|
|
2942 |
$delta="+0:0:0:0:0:1:0";
|
|
|
2943 |
} else {
|
|
|
2944 |
confess "ERROR: invalid arguments in Date_GetNext.\n";
|
|
|
2945 |
}
|
|
|
2946 |
|
|
|
2947 |
$d=&Date_SetTime($date,$hr,$min,$sec);
|
|
|
2948 |
if ($today) {
|
|
|
2949 |
$d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<0);
|
|
|
2950 |
} else {
|
|
|
2951 |
$d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<1);
|
|
|
2952 |
}
|
|
|
2953 |
$date=$d;
|
|
|
2954 |
}
|
|
|
2955 |
|
|
|
2956 |
return $date;
|
|
|
2957 |
}
|
|
|
2958 |
|
|
|
2959 |
sub Date_IsHoliday {
|
|
|
2960 |
print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
2961 |
my($date)=@_;
|
|
|
2962 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
2963 |
$date=&ParseDateString($date);
|
|
|
2964 |
return undef if (! $date);
|
|
|
2965 |
$date=&Date_SetTime($date,0,0,0);
|
|
|
2966 |
my($y)=(&Date_Split($date, 1))[0];
|
|
|
2967 |
&Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y});
|
|
|
2968 |
return undef if (! exists $Holiday{"dates"}{$y}{$date});
|
|
|
2969 |
my($name)=$Holiday{"dates"}{$y}{$date};
|
|
|
2970 |
return "" if (! $name);
|
|
|
2971 |
$name;
|
|
|
2972 |
}
|
|
|
2973 |
|
|
|
2974 |
sub Events_List {
|
|
|
2975 |
print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
2976 |
my(@args)=@_;
|
|
|
2977 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
2978 |
&Events_ParseRaw();
|
|
|
2979 |
|
|
|
2980 |
my($tmp,$date0,$date1,$flag);
|
|
|
2981 |
$date0=&ParseDateString($args[0]);
|
|
|
2982 |
warn "Invalid date $args[0]", return undef if (! $date0);
|
|
|
2983 |
|
|
|
2984 |
if ($#args == 0) {
|
|
|
2985 |
return &Events_Calc($date0);
|
|
|
2986 |
}
|
|
|
2987 |
|
|
|
2988 |
if ($args[1]) {
|
|
|
2989 |
$date1=&ParseDateString($args[1]);
|
|
|
2990 |
warn "Invalid date $args[1]\n", return undef if (! $date1);
|
|
|
2991 |
if (&Date_Cmp($date0,$date1)>0) {
|
|
|
2992 |
$tmp=$date1;
|
|
|
2993 |
$date1=$date0;
|
|
|
2994 |
$date0=$tmp;
|
|
|
2995 |
}
|
|
|
2996 |
} else {
|
|
|
2997 |
$date0=&Date_SetTime($date0,"00:00:00");
|
|
|
2998 |
$date1=&DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0");
|
|
|
2999 |
}
|
|
|
3000 |
|
|
|
3001 |
$tmp=&Events_Calc($date0,$date1);
|
|
|
3002 |
|
|
|
3003 |
$flag=$args[2];
|
|
|
3004 |
return $tmp if (! $flag);
|
|
|
3005 |
|
|
|
3006 |
my(@tmp,%ret,$delta)=();
|
|
|
3007 |
@tmp=@$tmp;
|
|
|
3008 |
push(@tmp,$date1);
|
|
|
3009 |
|
|
|
3010 |
if ($flag==1) {
|
|
|
3011 |
while ($#tmp>0) {
|
|
|
3012 |
($date0,$tmp)=splice(@tmp,0,2);
|
|
|
3013 |
$date1=$tmp[0];
|
|
|
3014 |
$delta=&DateCalc_DateDate($date0,$date1);
|
|
|
3015 |
foreach $flag (@$tmp) {
|
|
|
3016 |
if (exists $ret{$flag}) {
|
|
|
3017 |
$ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta);
|
|
|
3018 |
} else {
|
|
|
3019 |
$ret{$flag}=$delta;
|
|
|
3020 |
}
|
|
|
3021 |
}
|
|
|
3022 |
}
|
|
|
3023 |
return \%ret;
|
|
|
3024 |
|
|
|
3025 |
} elsif ($flag==2) {
|
|
|
3026 |
while ($#tmp>0) {
|
|
|
3027 |
($date0,$tmp)=splice(@tmp,0,2);
|
|
|
3028 |
$date1=$tmp[0];
|
|
|
3029 |
$delta=&DateCalc_DateDate($date0,$date1);
|
|
|
3030 |
$flag=join("+",sort @$tmp);
|
|
|
3031 |
next if (! $flag);
|
|
|
3032 |
if (exists $ret{$flag}) {
|
|
|
3033 |
$ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta);
|
|
|
3034 |
} else {
|
|
|
3035 |
$ret{$flag}=$delta;
|
|
|
3036 |
}
|
|
|
3037 |
}
|
|
|
3038 |
return \%ret;
|
|
|
3039 |
}
|
|
|
3040 |
|
|
|
3041 |
warn "Invalid flag $flag\n";
|
|
|
3042 |
return undef;
|
|
|
3043 |
}
|
|
|
3044 |
|
|
|
3045 |
###
|
|
|
3046 |
# NOTE: The following routines may be called in the routines below with very
|
|
|
3047 |
# little time penalty.
|
|
|
3048 |
###
|
|
|
3049 |
sub Date_SetTime {
|
|
|
3050 |
print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3051 |
my($date,$h,$mn,$s)=@_;
|
|
|
3052 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3053 |
my($y,$m,$d)=();
|
|
|
3054 |
|
|
|
3055 |
if (! &Date_Split($date)) {
|
|
|
3056 |
$date=&ParseDateString($date);
|
|
|
3057 |
return "" if (! $date);
|
|
|
3058 |
}
|
|
|
3059 |
|
|
|
3060 |
($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
|
|
|
3061 |
($h,$mn,$s)=&Date_ParseTime($h,$mn,$s);
|
|
|
3062 |
|
|
|
3063 |
my($ampm,$wk);
|
|
|
3064 |
return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
|
|
|
3065 |
&Date_Join($y,$m,$d,$h,$mn,$s);
|
|
|
3066 |
}
|
|
|
3067 |
|
|
|
3068 |
sub Date_SetDateField {
|
|
|
3069 |
print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3070 |
my($date,$field,$val,$nocheck)=@_;
|
|
|
3071 |
my($y,$m,$d,$h,$mn,$s)=();
|
|
|
3072 |
$nocheck=0 if (! defined $nocheck);
|
|
|
3073 |
|
|
|
3074 |
($y,$m,$d,$h,$mn,$s)=&Date_Split($date);
|
|
|
3075 |
|
|
|
3076 |
if (! $y) {
|
|
|
3077 |
$date=&ParseDateString($date);
|
|
|
3078 |
return "" if (! $date);
|
|
|
3079 |
($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
|
|
|
3080 |
}
|
|
|
3081 |
|
|
|
3082 |
if (lc($field) eq "y") {
|
|
|
3083 |
$y=$val;
|
|
|
3084 |
} elsif (lc($field) eq "m") {
|
|
|
3085 |
$m=$val;
|
|
|
3086 |
} elsif (lc($field) eq "d") {
|
|
|
3087 |
$d=$val;
|
|
|
3088 |
} elsif (lc($field) eq "h") {
|
|
|
3089 |
$h=$val;
|
|
|
3090 |
} elsif (lc($field) eq "mn") {
|
|
|
3091 |
$mn=$val;
|
|
|
3092 |
} elsif (lc($field) eq "s") {
|
|
|
3093 |
$s=$val;
|
|
|
3094 |
} else {
|
|
|
3095 |
confess "ERROR: Date_SetDateField: invalid field: $field\n";
|
|
|
3096 |
}
|
|
|
3097 |
|
|
|
3098 |
$date=&Date_Join($y,$m,$d,$h,$mn,$s);
|
|
|
3099 |
return $date if ($nocheck || &Date_Split($date));
|
|
|
3100 |
return "";
|
|
|
3101 |
}
|
|
|
3102 |
|
|
|
3103 |
########################################################################
|
|
|
3104 |
# OTHER SUBROUTINES
|
|
|
3105 |
########################################################################
|
|
|
3106 |
# NOTE: These routines should not call any of the routines above as
|
|
|
3107 |
# there will be a severe time penalty (and the possibility of
|
|
|
3108 |
# infinite recursion). The last couple routines above are
|
|
|
3109 |
# exceptions.
|
|
|
3110 |
# NOTE: Date_Init is a special case. It should be called (conditionally)
|
|
|
3111 |
# in every routine that uses any variable from the Date::Manip
|
|
|
3112 |
# namespace.
|
|
|
3113 |
########################################################################
|
|
|
3114 |
|
|
|
3115 |
sub Date_DaysInMonth {
|
|
|
3116 |
print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3117 |
my($m,$y)=@_;
|
|
|
3118 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3119 |
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
|
|
3120 |
$d_in_m[2]=29 if (&Date_LeapYear($y));
|
|
|
3121 |
return $d_in_m[$m];
|
|
|
3122 |
}
|
|
|
3123 |
|
|
|
3124 |
sub Date_DayOfWeek {
|
|
|
3125 |
print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3126 |
my($m,$d,$y)=@_;
|
|
|
3127 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3128 |
my($dayofweek,$dec31)=();
|
|
|
3129 |
|
|
|
3130 |
$dec31=5; # Dec 31, 1BC was Friday
|
|
|
3131 |
$dayofweek=(&Date_DaysSince1BC($m,$d,$y)+$dec31) % 7;
|
|
|
3132 |
$dayofweek=7 if ($dayofweek==0);
|
|
|
3133 |
return $dayofweek;
|
|
|
3134 |
}
|
|
|
3135 |
|
|
|
3136 |
# Can't be in "use integer" because the numbers are too big.
|
|
|
3137 |
no integer;
|
|
|
3138 |
sub Date_SecsSince1970 {
|
|
|
3139 |
print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3140 |
my($m,$d,$y,$h,$mn,$s)=@_;
|
|
|
3141 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3142 |
my($sec_now,$sec_70)=();
|
|
|
3143 |
$sec_now=(&Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s;
|
|
|
3144 |
# $sec_70 =(&Date_DaysSince1BC(1,1,1970)-1)*24*3600;
|
|
|
3145 |
$sec_70 =62167219200;
|
|
|
3146 |
return ($sec_now-$sec_70);
|
|
|
3147 |
}
|
|
|
3148 |
|
|
|
3149 |
sub Date_SecsSince1970GMT {
|
|
|
3150 |
print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3151 |
my($m,$d,$y,$h,$mn,$s)=@_;
|
|
|
3152 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3153 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3154 |
|
|
|
3155 |
my($sec)=&Date_SecsSince1970($m,$d,$y,$h,$mn,$s);
|
|
|
3156 |
return $sec if ($Cnf{"ConvTZ"} eq "IGNORE");
|
|
|
3157 |
|
|
|
3158 |
my($tz)=$Cnf{"ConvTZ"};
|
|
|
3159 |
$tz=$Cnf{"TZ"} if (! $tz);
|
|
|
3160 |
$tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
|
|
|
3161 |
|
|
|
3162 |
my($tzs)=1;
|
|
|
3163 |
$tzs=-1 if ($tz<0);
|
|
|
3164 |
$tz=~/.(..)(..)/;
|
|
|
3165 |
my($tzh,$tzm)=($1,$2);
|
|
|
3166 |
$sec - $tzs*($tzh*3600+$tzm*60);
|
|
|
3167 |
}
|
|
|
3168 |
use integer;
|
|
|
3169 |
|
|
|
3170 |
sub Date_DaysSince1BC {
|
|
|
3171 |
print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3172 |
my($m,$d,$y)=@_;
|
|
|
3173 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3174 |
my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
|
|
|
3175 |
my($cc,$yy)=();
|
|
|
3176 |
|
|
|
3177 |
$y=~ /(\d{2})(\d{2})/;
|
|
|
3178 |
($cc,$yy)=($1,$2);
|
|
|
3179 |
|
|
|
3180 |
# Number of full years since Dec 31, 1BC (counting the year 0000).
|
|
|
3181 |
$Ny=$y;
|
|
|
3182 |
|
|
|
3183 |
# Number of full 4th years (incl. 0000) since Dec 31, 1BC
|
|
|
3184 |
$N4=($Ny-1)/4 + 1;
|
|
|
3185 |
$N4=0 if ($y==0);
|
|
|
3186 |
|
|
|
3187 |
# Number of full 100th years (incl. 0000)
|
|
|
3188 |
$N100=$cc + 1;
|
|
|
3189 |
$N100-- if ($yy==0);
|
|
|
3190 |
$N100=0 if ($y==0);
|
|
|
3191 |
|
|
|
3192 |
# Number of full 400th years (incl. 0000)
|
|
|
3193 |
$N400=($N100-1)/4 + 1;
|
|
|
3194 |
$N400=0 if ($y==0);
|
|
|
3195 |
|
|
|
3196 |
$dayofyear=&Date_DayOfYear($m,$d,$y);
|
|
|
3197 |
$days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
|
|
|
3198 |
|
|
|
3199 |
return $days;
|
|
|
3200 |
}
|
|
|
3201 |
|
|
|
3202 |
sub Date_DayOfYear {
|
|
|
3203 |
print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3204 |
my($m,$d,$y)=@_;
|
|
|
3205 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3206 |
# DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
|
|
|
3207 |
my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
|
|
|
3208 |
my($ly)=0;
|
|
|
3209 |
$ly=1 if ($m>2 && &Date_LeapYear($y));
|
|
|
3210 |
return ($days[$m-1]+$d+$ly);
|
|
|
3211 |
}
|
|
|
3212 |
|
|
|
3213 |
sub Date_DaysInYear {
|
|
|
3214 |
print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3215 |
my($y)=@_;
|
|
|
3216 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3217 |
return 366 if (&Date_LeapYear($y));
|
|
|
3218 |
return 365;
|
|
|
3219 |
}
|
|
|
3220 |
|
|
|
3221 |
sub Date_WeekOfYear {
|
|
|
3222 |
print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3223 |
my($m,$d,$y,$f)=@_;
|
|
|
3224 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3225 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3226 |
|
|
|
3227 |
my($day,$dow,$doy)=();
|
|
|
3228 |
$doy=&Date_DayOfYear($m,$d,$y);
|
|
|
3229 |
|
|
|
3230 |
# The current DayOfYear and DayOfWeek
|
|
|
3231 |
if ($Cnf{"Jan1Week1"}) {
|
|
|
3232 |
$day=1;
|
|
|
3233 |
} else {
|
|
|
3234 |
$day=4;
|
|
|
3235 |
}
|
|
|
3236 |
$dow=&Date_DayOfWeek(1,$day,$y);
|
|
|
3237 |
|
|
|
3238 |
# Move back to the first day of week 1.
|
|
|
3239 |
$f-=7 if ($f>$dow);
|
|
|
3240 |
$day-= ($dow-$f);
|
|
|
3241 |
|
|
|
3242 |
return 0 if ($day>$doy); # Day is in last week of previous year
|
|
|
3243 |
return (($doy-$day)/7 + 1);
|
|
|
3244 |
}
|
|
|
3245 |
|
|
|
3246 |
sub Date_LeapYear {
|
|
|
3247 |
print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3248 |
my($y)=@_;
|
|
|
3249 |
$y=&Date_FixYear($y) if (length($y)!=4);
|
|
|
3250 |
return 0 unless $y % 4 == 0;
|
|
|
3251 |
return 1 unless $y % 100 == 0;
|
|
|
3252 |
return 0 unless $y % 400 == 0;
|
|
|
3253 |
return 1;
|
|
|
3254 |
}
|
|
|
3255 |
|
|
|
3256 |
sub Date_DaySuffix {
|
|
|
3257 |
print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3258 |
my($d)=@_;
|
|
|
3259 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3260 |
return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
|
|
|
3261 |
}
|
|
|
3262 |
|
|
|
3263 |
sub Date_ConvTZ {
|
|
|
3264 |
print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3265 |
my($date,$from,$to)=@_;
|
|
|
3266 |
if (not Date_Split($date)) {
|
|
|
3267 |
croak "date passed in ('$date') is not a Date::Manip object";
|
|
|
3268 |
}
|
|
|
3269 |
|
|
|
3270 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3271 |
my($gmt)=();
|
|
|
3272 |
|
|
|
3273 |
if (! $from) {
|
|
|
3274 |
|
|
|
3275 |
if (! $to) {
|
|
|
3276 |
# TZ -> ConvTZ
|
|
|
3277 |
return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
|
|
|
3278 |
$from=$Cnf{"TZ"};
|
|
|
3279 |
$to=$Cnf{"ConvTZ"};
|
|
|
3280 |
|
|
|
3281 |
} else {
|
|
|
3282 |
# ConvTZ,TZ -> $to
|
|
|
3283 |
$from=$Cnf{"ConvTZ"};
|
|
|
3284 |
$from=$Cnf{"TZ"} if (! $from);
|
|
|
3285 |
}
|
|
|
3286 |
|
|
|
3287 |
} else {
|
|
|
3288 |
|
|
|
3289 |
if (! $to) {
|
|
|
3290 |
# $from -> ConvTZ,TZ
|
|
|
3291 |
return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
|
|
|
3292 |
$to=$Cnf{"ConvTZ"};
|
|
|
3293 |
$to=$Cnf{"TZ"} if (! $to);
|
|
|
3294 |
|
|
|
3295 |
} else {
|
|
|
3296 |
# $from -> $to
|
|
|
3297 |
}
|
|
|
3298 |
}
|
|
|
3299 |
|
|
|
3300 |
$to=$Zone{"n2o"}{lc($to)}
|
|
|
3301 |
if (exists $Zone{"n2o"}{lc($to)});
|
|
|
3302 |
$from=$Zone{"n2o"}{lc($from)}
|
|
|
3303 |
if (exists $Zone{"n2o"}{lc($from)});
|
|
|
3304 |
$gmt=$Zone{"n2o"}{"gmt"};
|
|
|
3305 |
|
|
|
3306 |
return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/);
|
|
|
3307 |
return $date if ($from eq $to);
|
|
|
3308 |
|
|
|
3309 |
my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=();
|
|
|
3310 |
# We're going to try to do the calculation without calling DateCalc.
|
|
|
3311 |
($yr,$mon,$d,$h,$m,$sec)=&Date_Split($date, 1);
|
|
|
3312 |
|
|
|
3313 |
# Convert $date from $from to GMT
|
|
|
3314 |
$from=~/([+-])(\d{2})(\d{2})/;
|
|
|
3315 |
($s1,$h1,$m1)=($1,$2,$3);
|
|
|
3316 |
$s1= ($s1 eq "-" ? "+" : "-"); # switch sign
|
|
|
3317 |
$sign=$s1 . "1"; # + or - 1
|
|
|
3318 |
|
|
|
3319 |
# and from GMT to $to
|
|
|
3320 |
$to=~/([+-])(\d{2})(\d{2})/;
|
|
|
3321 |
($s2,$h2,$m2)=($1,$2,$3);
|
|
|
3322 |
|
|
|
3323 |
if ($s1 eq $s2) {
|
|
|
3324 |
# Both the same sign
|
|
|
3325 |
$m+= $sign*($m1+$m2);
|
|
|
3326 |
$h+= $sign*($h1+$h2);
|
|
|
3327 |
} else {
|
|
|
3328 |
$sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
|
|
|
3329 |
$m+= $sign*($m1-$m2);
|
|
|
3330 |
$h+= $sign*($h1-$h2);
|
|
|
3331 |
}
|
|
|
3332 |
|
|
|
3333 |
if ($m>59) {
|
|
|
3334 |
$h+= $m/60;
|
|
|
3335 |
$m-= ($m/60)*60;
|
|
|
3336 |
} elsif ($m<0) {
|
|
|
3337 |
$h+= ($m/60 - 1);
|
|
|
3338 |
$m-= ($m/60 - 1)*60;
|
|
|
3339 |
}
|
|
|
3340 |
|
|
|
3341 |
if ($h>23) {
|
|
|
3342 |
$delta=$h/24;
|
|
|
3343 |
$h -= $delta*24;
|
|
|
3344 |
if (($d + $delta) > 28) {
|
|
|
3345 |
$date=&Date_Join($yr,$mon,$d,$h,$m,$sec);
|
|
|
3346 |
return &DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0);
|
|
|
3347 |
}
|
|
|
3348 |
$d+= $delta;
|
|
|
3349 |
} elsif ($h<0) {
|
|
|
3350 |
$delta=-$h/24 + 1;
|
|
|
3351 |
$h += $delta*24;
|
|
|
3352 |
if (($d - $delta) < 1) {
|
|
|
3353 |
$date=&Date_Join($yr,$mon,$d,$h,$m,$sec);
|
|
|
3354 |
return &DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0);
|
|
|
3355 |
}
|
|
|
3356 |
$d-= $delta;
|
|
|
3357 |
}
|
|
|
3358 |
return &Date_Join($yr,$mon,$d,$h,$m,$sec);
|
|
|
3359 |
}
|
|
|
3360 |
|
|
|
3361 |
sub Date_TimeZone {
|
|
|
3362 |
print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3363 |
my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=();
|
|
|
3364 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3365 |
|
|
|
3366 |
# Get timezones from all of the relevant places
|
|
|
3367 |
|
|
|
3368 |
push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var
|
|
|
3369 |
push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var
|
|
|
3370 |
push(@tz,$ENV{'SYS$TIMEZONE_RULE'})
|
|
|
3371 |
if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var
|
|
|
3372 |
push(@tz,$ENV{'SYS$TIMEZONE_NAME'})
|
|
|
3373 |
if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var
|
|
|
3374 |
push(@tz,$ENV{'UCX$TZ'})
|
|
|
3375 |
if defined $ENV{'UCX$TZ'}; # VMS TZ environ var
|
|
|
3376 |
push(@tz,$ENV{'TCPIP$TZ'})
|
|
|
3377 |
if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var
|
|
|
3378 |
|
|
|
3379 |
# The `date` command... if we're doing taint checking, we need to
|
|
|
3380 |
# always call it with a full path... otherwise, use the user's path.
|
|
|
3381 |
#
|
|
|
3382 |
# Microsoft operating systems don't have a date command built in. Try
|
|
|
3383 |
# to trap all the various ways of knowing we are on one of these systems.
|
|
|
3384 |
#
|
|
|
3385 |
# We'll try `date +%Z` first, and if that fails, we'll take just the
|
|
|
3386 |
# `date` program and assume the output is of the format:
|
|
|
3387 |
# Thu Aug 31 14:57:46 EDT 2000
|
|
|
3388 |
|
|
|
3389 |
unless (($^X =~ /perl\.exe$/i) or
|
|
|
3390 |
($OS eq "Windows") or
|
|
|
3391 |
($OS eq "Netware") or
|
|
|
3392 |
($OS eq "VMS")) {
|
|
|
3393 |
if ($Date::Manip::NoTaint) {
|
|
|
3394 |
if ($OS eq "VMS") {
|
|
|
3395 |
$tz=$ENV{'SYS$TIMEZONE_NAME'};
|
|
|
3396 |
if (! $tz) {
|
|
|
3397 |
$tz=$ENV{'MULTINET_TIMEZONE'};
|
|
|
3398 |
if (! $tz) {
|
|
|
3399 |
$tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
|
|
|
3400 |
}
|
|
|
3401 |
}
|
|
|
3402 |
} else {
|
|
|
3403 |
$tz=`date +%Z 2> /dev/null`;
|
|
|
3404 |
chomp($tz);
|
|
|
3405 |
if (! $tz) {
|
|
|
3406 |
$tz=`date 2> /dev/null`;
|
|
|
3407 |
chomp($tz);
|
|
|
3408 |
$tz=(split(/\s+/,$tz))[4];
|
|
|
3409 |
}
|
|
|
3410 |
}
|
|
|
3411 |
push(@tz,$tz);
|
|
|
3412 |
} else {
|
|
|
3413 |
# We need to satisfy taint checking, but also look in all the
|
|
|
3414 |
# directories in @DatePath.
|
|
|
3415 |
#
|
|
|
3416 |
local $ENV{PATH} = join(':', @Date::Manip::DatePath);
|
|
|
3417 |
local $ENV{BASH_ENV} = '';
|
|
|
3418 |
$tz=`date +%Z 2> /dev/null`;
|
|
|
3419 |
chomp($tz);
|
|
|
3420 |
if (! $tz) {
|
|
|
3421 |
$tz=`date 2> /dev/null`;
|
|
|
3422 |
chomp($tz);
|
|
|
3423 |
$tz=(split(/\s+/,$tz))[4];
|
|
|
3424 |
}
|
|
|
3425 |
push(@tz,$tz);
|
|
|
3426 |
}
|
|
|
3427 |
}
|
|
|
3428 |
|
|
|
3429 |
push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ
|
|
|
3430 |
|
|
|
3431 |
if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE
|
|
|
3432 |
$in=new IO::File;
|
|
|
3433 |
$in->open("/etc/TIMEZONE","r");
|
|
|
3434 |
while (! eof($in)) {
|
|
|
3435 |
$tmp=<$in>;
|
|
|
3436 |
if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
|
|
|
3437 |
push(@tz,$1);
|
|
|
3438 |
last;
|
|
|
3439 |
}
|
|
|
3440 |
}
|
|
|
3441 |
$in->close;
|
|
|
3442 |
}
|
|
|
3443 |
|
|
|
3444 |
if (-s "/etc/timezone") { # /etc/timezone
|
|
|
3445 |
$in=new IO::File;
|
|
|
3446 |
$in->open("/etc/timezone","r");
|
|
|
3447 |
while (! eof($in)) {
|
|
|
3448 |
$tmp=<$in>;
|
|
|
3449 |
next if ($tmp =~ /^\s*\043/);
|
|
|
3450 |
chomp($tmp);
|
|
|
3451 |
if ($tmp =~ /^\s*(.*?)\s*$/) {
|
|
|
3452 |
push(@tz,$1);
|
|
|
3453 |
last;
|
|
|
3454 |
}
|
|
|
3455 |
}
|
|
|
3456 |
$in->close;
|
|
|
3457 |
}
|
|
|
3458 |
|
|
|
3459 |
# Now parse each one to find the first valid one.
|
|
|
3460 |
foreach $tz (@tz) {
|
|
|
3461 |
$tz =~ s/\s*$//;
|
|
|
3462 |
$tz =~ s/^\s*//;
|
|
|
3463 |
next if (! $tz);
|
|
|
3464 |
|
|
|
3465 |
return uc($tz)
|
|
|
3466 |
if (defined $Zone{"n2o"}{lc($tz)});
|
|
|
3467 |
|
|
|
3468 |
if ($tz =~ /^[+-]\d{4}$/) {
|
|
|
3469 |
return $tz;
|
|
|
3470 |
} elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
|
|
|
3471 |
my($h,$m)=($1,$2);
|
|
|
3472 |
$m="00" if (! $m);
|
|
|
3473 |
return "$h$m";
|
|
|
3474 |
}
|
|
|
3475 |
|
|
|
3476 |
# Handle US/Eastern format
|
|
|
3477 |
if ($tz =~ /^$Zone{"tzones"}$/i) {
|
|
|
3478 |
$tmp=lc $1;
|
|
|
3479 |
$tz=$Zone{"tz2z"}{$tmp};
|
|
|
3480 |
}
|
|
|
3481 |
|
|
|
3482 |
# Handle STD#DST# format (and STD-#DST-# formats)
|
|
|
3483 |
if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
|
|
|
3484 |
($std,$dst)=($1,$2);
|
|
|
3485 |
next if (! defined $Zone{"n2o"}{lc($std)} or
|
|
|
3486 |
! defined $Zone{"n2o"}{lc($dst)});
|
|
|
3487 |
$time = time();
|
|
|
3488 |
($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
|
|
|
3489 |
localtime($time);
|
|
|
3490 |
return uc($dst) if ($isdst);
|
|
|
3491 |
return uc($std);
|
|
|
3492 |
}
|
|
|
3493 |
}
|
|
|
3494 |
|
|
|
3495 |
confess "ERROR: Date::Manip unable to determine TimeZone.\n";
|
|
|
3496 |
}
|
|
|
3497 |
|
|
|
3498 |
# Returns 1 if $date is a work day. If $time is non-zero, the time is
|
|
|
3499 |
# also checked to see if it falls within work hours. Returns "" if
|
|
|
3500 |
# an invalid date is passed in.
|
|
|
3501 |
sub Date_IsWorkDay {
|
|
|
3502 |
print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3503 |
my($date,$time)=@_;
|
|
|
3504 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3505 |
$date=&ParseDateString($date);
|
|
|
3506 |
return "" if (! $date);
|
|
|
3507 |
my($d)=$date;
|
|
|
3508 |
$d=&Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time);
|
|
|
3509 |
|
|
|
3510 |
my($y,$mon,$day,$tmp,$h,$m,$dow)=();
|
|
|
3511 |
($y,$mon,$day,$h,$m,$tmp)=&Date_Split($d, 1);
|
|
|
3512 |
$dow=&Date_DayOfWeek($mon,$day,$y);
|
|
|
3513 |
|
|
|
3514 |
return 0 if ($dow<$Cnf{"WorkWeekBeg"} or
|
|
|
3515 |
$dow>$Cnf{"WorkWeekEnd"} or
|
|
|
3516 |
"$h:$m" lt $Cnf{"WorkDayBeg"} or
|
|
|
3517 |
"$h:$m" gt $Cnf{"WorkDayEnd"});
|
|
|
3518 |
|
|
|
3519 |
if (! exists $Holiday{"dates"}{$y}) {
|
|
|
3520 |
# There will be recursion problems if we ever end up here twice.
|
|
|
3521 |
$Holiday{"dates"}{$y}={};
|
|
|
3522 |
&Date_UpdateHolidays($y)
|
|
|
3523 |
}
|
|
|
3524 |
$d=&Date_SetTime($date,"00:00:00");
|
|
|
3525 |
return 0 if (exists $Holiday{"dates"}{$y}{$d});
|
|
|
3526 |
1;
|
|
|
3527 |
}
|
|
|
3528 |
|
|
|
3529 |
# Finds the day $off work days from now. If $time is passed in, we must
|
|
|
3530 |
# also take into account the time of day.
|
|
|
3531 |
#
|
|
|
3532 |
# If $time is not passed in, day 0 is today (if today is a workday) or the
|
|
|
3533 |
# next work day if it isn't. In any case, the time of day is unaffected.
|
|
|
3534 |
#
|
|
|
3535 |
# If $time is passed in, day 0 is now (if now is part of a workday) or the
|
|
|
3536 |
# start of the very next work day.
|
|
|
3537 |
sub Date_NextWorkDay {
|
|
|
3538 |
print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3539 |
my($date,$off,$time)=@_;
|
|
|
3540 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3541 |
$date=&ParseDateString($date);
|
|
|
3542 |
my($err)=();
|
|
|
3543 |
|
|
|
3544 |
if (! &Date_IsWorkDay($date,$time)) {
|
|
|
3545 |
if ($time) {
|
|
|
3546 |
while (1) {
|
|
|
3547 |
$date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
|
|
|
3548 |
last if (&Date_IsWorkDay($date,$time));
|
|
|
3549 |
}
|
|
|
3550 |
} else {
|
|
|
3551 |
while (1) {
|
|
|
3552 |
$date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
|
|
|
3553 |
last if (&Date_IsWorkDay($date,$time));
|
|
|
3554 |
}
|
|
|
3555 |
}
|
|
|
3556 |
}
|
|
|
3557 |
|
|
|
3558 |
while ($off>0) {
|
|
|
3559 |
while (1) {
|
|
|
3560 |
$date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
|
|
|
3561 |
last if (&Date_IsWorkDay($date,$time));
|
|
|
3562 |
}
|
|
|
3563 |
$off--;
|
|
|
3564 |
}
|
|
|
3565 |
|
|
|
3566 |
return $date;
|
|
|
3567 |
}
|
|
|
3568 |
|
|
|
3569 |
# Finds the day $off work days before now. If $time is passed in, we must
|
|
|
3570 |
# also take into account the time of day.
|
|
|
3571 |
#
|
|
|
3572 |
# If $time is not passed in, day 0 is today (if today is a workday) or the
|
|
|
3573 |
# previous work day if it isn't. In any case, the time of day is unaffected.
|
|
|
3574 |
#
|
|
|
3575 |
# If $time is passed in, day 0 is now (if now is part of a workday) or the
|
|
|
3576 |
# end of the previous work period. Note that since the end of a work day
|
|
|
3577 |
# will automatically be turned into the start of the next one, this time
|
|
|
3578 |
# may actually be treated as AFTER the current time.
|
|
|
3579 |
sub Date_PrevWorkDay {
|
|
|
3580 |
print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3581 |
my($date,$off,$time)=@_;
|
|
|
3582 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3583 |
$date=&ParseDateString($date);
|
|
|
3584 |
my($err)=();
|
|
|
3585 |
|
|
|
3586 |
if (! &Date_IsWorkDay($date,$time)) {
|
|
|
3587 |
if ($time) {
|
|
|
3588 |
while (1) {
|
|
|
3589 |
$date=&Date_GetPrev($date,undef,0,$Cnf{"WorkDayEnd"});
|
|
|
3590 |
last if (&Date_IsWorkDay($date,$time));
|
|
|
3591 |
}
|
|
|
3592 |
while (1) {
|
|
|
3593 |
$date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
|
|
|
3594 |
last if (&Date_IsWorkDay($date,$time));
|
|
|
3595 |
}
|
|
|
3596 |
} else {
|
|
|
3597 |
while (1) {
|
|
|
3598 |
$date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
|
|
|
3599 |
last if (&Date_IsWorkDay($date,$time));
|
|
|
3600 |
}
|
|
|
3601 |
}
|
|
|
3602 |
}
|
|
|
3603 |
|
|
|
3604 |
while ($off>0) {
|
|
|
3605 |
while (1) {
|
|
|
3606 |
$date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
|
|
|
3607 |
last if (&Date_IsWorkDay($date,$time));
|
|
|
3608 |
}
|
|
|
3609 |
$off--;
|
|
|
3610 |
}
|
|
|
3611 |
|
|
|
3612 |
return $date;
|
|
|
3613 |
}
|
|
|
3614 |
|
|
|
3615 |
# This finds the nearest workday to $date. If $date is a workday, it
|
|
|
3616 |
# is returned.
|
|
|
3617 |
sub Date_NearestWorkDay {
|
|
|
3618 |
print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3619 |
my($date,$tomorrow)=@_;
|
|
|
3620 |
&Date_Init() if (! $Curr{"InitDone"});
|
|
|
3621 |
$date=&ParseDateString($date);
|
|
|
3622 |
my($a,$b,$dela,$delb,$err)=();
|
|
|
3623 |
$tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow);
|
|
|
3624 |
|
|
|
3625 |
return $date if (&Date_IsWorkDay($date));
|
|
|
3626 |
|
|
|
3627 |
# Find the nearest one.
|
|
|
3628 |
if ($tomorrow) {
|
|
|
3629 |
$dela="+0:0:0:1:0:0:0";
|
|
|
3630 |
$delb="-0:0:0:1:0:0:0";
|
|
|
3631 |
} else {
|
|
|
3632 |
$dela="-0:0:0:1:0:0:0";
|
|
|
3633 |
$delb="+0:0:0:1:0:0:0";
|
|
|
3634 |
}
|
|
|
3635 |
$a=$b=$date;
|
|
|
3636 |
|
|
|
3637 |
while (1) {
|
|
|
3638 |
$a=&DateCalc_DateDelta($a,$dela,\$err);
|
|
|
3639 |
return $a if (&Date_IsWorkDay($a));
|
|
|
3640 |
$b=&DateCalc_DateDelta($b,$delb,\$err);
|
|
|
3641 |
return $b if (&Date_IsWorkDay($b));
|
|
|
3642 |
}
|
|
|
3643 |
}
|
|
|
3644 |
|
|
|
3645 |
# &Date_NthDayOfYear($y,$n);
|
|
|
3646 |
# Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year.
|
|
|
3647 |
sub Date_NthDayOfYear {
|
|
|
3648 |
no integer;
|
|
|
3649 |
print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3650 |
my($y,$n)=@_;
|
|
|
3651 |
$y=$Curr{"Y"} if (! $y);
|
|
|
3652 |
$n=1 if (! defined $n or $n eq "");
|
|
|
3653 |
$n+=0; # to turn 023 into 23
|
|
|
3654 |
$y=&Date_FixYear($y) if (length($y)<4);
|
|
|
3655 |
my $leap=&Date_LeapYear($y);
|
|
|
3656 |
return () if ($n<1);
|
|
|
3657 |
return () if ($n >= ($leap ? 367 : 366));
|
|
|
3658 |
|
|
|
3659 |
my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31);
|
|
|
3660 |
$d_in_m[1]=29 if ($leap);
|
|
|
3661 |
|
|
|
3662 |
# Calculate the hours, minutes, and seconds into the day.
|
|
|
3663 |
my $remain=($n - int($n))*24;
|
|
|
3664 |
my $h=int($remain);
|
|
|
3665 |
$remain=($remain - $h)*60;
|
|
|
3666 |
my $mn=int($remain);
|
|
|
3667 |
$remain=($remain - $mn)*60;
|
|
|
3668 |
my $s=$remain;
|
|
|
3669 |
|
|
|
3670 |
# Calculate the month and the day.
|
|
|
3671 |
my($m,$d)=(0,0);
|
|
|
3672 |
$n=int($n);
|
|
|
3673 |
while ($n>0) {
|
|
|
3674 |
$m++;
|
|
|
3675 |
if ($n<=$d_in_m[0]) {
|
|
|
3676 |
$d=int($n);
|
|
|
3677 |
$n=0;
|
|
|
3678 |
} else {
|
|
|
3679 |
$n-= $d_in_m[0];
|
|
|
3680 |
shift(@d_in_m);
|
|
|
3681 |
}
|
|
|
3682 |
}
|
|
|
3683 |
|
|
|
3684 |
($y,$m,$d,$h,$mn,$s);
|
|
|
3685 |
}
|
|
|
3686 |
|
|
|
3687 |
########################################################################
|
|
|
3688 |
# NOT FOR EXPORT
|
|
|
3689 |
########################################################################
|
|
|
3690 |
|
|
|
3691 |
# This is used in Date_Init to fill in a hash based on international
|
|
|
3692 |
# data. It takes a list of keys and values and returns both a hash
|
|
|
3693 |
# with these values and a regular expression of keys.
|
|
|
3694 |
#
|
|
|
3695 |
# IN:
|
|
|
3696 |
# $data = [ key1 val1 key2 val2 ... ]
|
|
|
3697 |
# $opts = lc : lowercase the keys in the regexp
|
|
|
3698 |
# sort : sort (by length) the keys in the regexp
|
|
|
3699 |
# back : create a regexp with a back reference
|
|
|
3700 |
# escape : escape all strings in the regexp
|
|
|
3701 |
#
|
|
|
3702 |
# OUT:
|
|
|
3703 |
# $regexp = '(?:key1|key2|...)'
|
|
|
3704 |
# $hash = { key1=>val1 key2=>val2 ... }
|
|
|
3705 |
|
|
|
3706 |
sub Date_InitHash {
|
|
|
3707 |
print "DEBUG: Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3708 |
my($data,$regexp,$opts,$hash)=@_;
|
|
|
3709 |
my(@data)=@$data;
|
|
|
3710 |
my($key,$val,@list)=();
|
|
|
3711 |
|
|
|
3712 |
# Parse the options
|
|
|
3713 |
my($lc,$sort,$back,$escape)=(0,0,0,0);
|
|
|
3714 |
$lc=1 if ($opts =~ /lc/i);
|
|
|
3715 |
$sort=1 if ($opts =~ /sort/i);
|
|
|
3716 |
$back=1 if ($opts =~ /back/i);
|
|
|
3717 |
$escape=1 if ($opts =~ /escape/i);
|
|
|
3718 |
|
|
|
3719 |
# Create the hash
|
|
|
3720 |
while (@data) {
|
|
|
3721 |
($key,$val,@data)=@data;
|
|
|
3722 |
$key=lc($key) if ($lc);
|
|
|
3723 |
$$hash{$key}=$val;
|
|
|
3724 |
}
|
|
|
3725 |
|
|
|
3726 |
# Create the regular expression
|
|
|
3727 |
if ($regexp) {
|
|
|
3728 |
@list=keys(%$hash);
|
|
|
3729 |
@list=sort sortByLength(@list) if ($sort);
|
|
|
3730 |
if ($escape) {
|
|
|
3731 |
foreach $val (@list) {
|
|
|
3732 |
$val="\Q$val\E";
|
|
|
3733 |
}
|
|
|
3734 |
}
|
|
|
3735 |
if ($back) {
|
|
|
3736 |
$$regexp="(" . join("|",@list) . ")";
|
|
|
3737 |
} else {
|
|
|
3738 |
$$regexp="(?:" . join("|",@list) . ")";
|
|
|
3739 |
}
|
|
|
3740 |
}
|
|
|
3741 |
}
|
|
|
3742 |
|
|
|
3743 |
# This is used in Date_Init to fill in regular expressions, lists, and
|
|
|
3744 |
# hashes based on international data. It takes a list of lists which have
|
|
|
3745 |
# to be stored as regular expressions (to find any element in the list),
|
|
|
3746 |
# lists, and hashes (indicating the location in the lists).
|
|
|
3747 |
#
|
|
|
3748 |
# IN:
|
|
|
3749 |
# $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ]
|
|
|
3750 |
# [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ]
|
|
|
3751 |
# ...
|
|
|
3752 |
# [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ]
|
|
|
3753 |
# $lists = [ \@listA \@listB ... \@listZ ]
|
|
|
3754 |
# $opts = lc : lowercase the values in the regexp
|
|
|
3755 |
# sort : sort (by length) the values in the regexp
|
|
|
3756 |
# back : create a regexp with a back reference
|
|
|
3757 |
# escape : escape all strings in the regexp
|
|
|
3758 |
# $hash = [ \%hash, TYPE ]
|
|
|
3759 |
# TYPE 0 : $hash{ valBn=>n-1 }
|
|
|
3760 |
# TYPE 1 : $hash{ valBn=>n }
|
|
|
3761 |
#
|
|
|
3762 |
# OUT:
|
|
|
3763 |
# $regexp = '(?:valA1|valA2|...|valB1|...)'
|
|
|
3764 |
# $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
|
|
|
3765 |
# [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
|
|
|
3766 |
# $hash
|
|
|
3767 |
|
|
|
3768 |
sub Date_InitLists {
|
|
|
3769 |
print "DEBUG: Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3770 |
my($data,$regexp,$opts,$lists,$hash)=@_;
|
|
|
3771 |
my(@data)=@$data;
|
|
|
3772 |
my(@lists)=@$lists;
|
|
|
3773 |
my($i,@ele,$ele,@list,$j,$tmp)=();
|
|
|
3774 |
|
|
|
3775 |
# Parse the options
|
|
|
3776 |
my($lc,$sort,$back,$escape)=(0,0,0,0);
|
|
|
3777 |
$lc=1 if ($opts =~ /lc/i);
|
|
|
3778 |
$sort=1 if ($opts =~ /sort/i);
|
|
|
3779 |
$back=1 if ($opts =~ /back/i);
|
|
|
3780 |
$escape=1 if ($opts =~ /escape/i);
|
|
|
3781 |
|
|
|
3782 |
# Set each of the lists
|
|
|
3783 |
if (@lists) {
|
|
|
3784 |
confess "ERROR: Date_InitLists: lists must be 1 per data\n"
|
|
|
3785 |
if ($#lists != $#data);
|
|
|
3786 |
for ($i=0; $i<=$#data; $i++) {
|
|
|
3787 |
@ele=@{ $data[$i] };
|
|
|
3788 |
if ($Cnf{"IntCharSet"} && $#ele>0) {
|
|
|
3789 |
@{ $lists[$i] } = @{ $ele[1] };
|
|
|
3790 |
} else {
|
|
|
3791 |
@{ $lists[$i] } = @{ $ele[0] };
|
|
|
3792 |
}
|
|
|
3793 |
}
|
|
|
3794 |
}
|
|
|
3795 |
|
|
|
3796 |
# Create the hash
|
|
|
3797 |
my($hashtype,$hashsave,%hash)=();
|
|
|
3798 |
if (@$hash) {
|
|
|
3799 |
($hash,$hashtype)=@$hash;
|
|
|
3800 |
$hashsave=1;
|
|
|
3801 |
} else {
|
|
|
3802 |
$hashtype=0;
|
|
|
3803 |
$hashsave=0;
|
|
|
3804 |
}
|
|
|
3805 |
for ($i=0; $i<=$#data; $i++) {
|
|
|
3806 |
@ele=@{ $data[$i] };
|
|
|
3807 |
foreach $ele (@ele) {
|
|
|
3808 |
@list = @{ $ele };
|
|
|
3809 |
for ($j=0; $j<=$#list; $j++) {
|
|
|
3810 |
$tmp=$list[$j];
|
|
|
3811 |
next if (! $tmp);
|
|
|
3812 |
$tmp=lc($tmp) if ($lc);
|
|
|
3813 |
$hash{$tmp}= $j+$hashtype;
|
|
|
3814 |
}
|
|
|
3815 |
}
|
|
|
3816 |
}
|
|
|
3817 |
%$hash = %hash if ($hashsave);
|
|
|
3818 |
|
|
|
3819 |
# Create the regular expression
|
|
|
3820 |
if ($regexp) {
|
|
|
3821 |
@list=keys(%hash);
|
|
|
3822 |
@list=sort sortByLength(@list) if ($sort);
|
|
|
3823 |
if ($escape) {
|
|
|
3824 |
foreach $ele (@list) {
|
|
|
3825 |
$ele="\Q$ele\E";
|
|
|
3826 |
}
|
|
|
3827 |
}
|
|
|
3828 |
if ($back) {
|
|
|
3829 |
$$regexp="(" . join("|",@list) . ")";
|
|
|
3830 |
} else {
|
|
|
3831 |
$$regexp="(?:" . join("|",@list) . ")";
|
|
|
3832 |
}
|
|
|
3833 |
}
|
|
|
3834 |
}
|
|
|
3835 |
|
|
|
3836 |
# This is used in Date_Init to fill in regular expressions and lists based
|
|
|
3837 |
# on international data. This takes a list of strings and returns a regular
|
|
|
3838 |
# expression (to find any one of them).
|
|
|
3839 |
#
|
|
|
3840 |
# IN:
|
|
|
3841 |
# $data = [ string1 string2 ... ]
|
|
|
3842 |
# $opts = lc : lowercase the values in the regexp
|
|
|
3843 |
# sort : sort (by length) the values in the regexp
|
|
|
3844 |
# back : create a regexp with a back reference
|
|
|
3845 |
# escape : escape all strings in the regexp
|
|
|
3846 |
#
|
|
|
3847 |
# OUT:
|
|
|
3848 |
# $regexp = '(string1|string2|...)'
|
|
|
3849 |
|
|
|
3850 |
sub Date_InitStrings {
|
|
|
3851 |
print "DEBUG: Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3852 |
my($data,$regexp,$opts)=@_;
|
|
|
3853 |
my(@list)=@{ $data };
|
|
|
3854 |
|
|
|
3855 |
# Parse the options
|
|
|
3856 |
my($lc,$sort,$back,$escape)=(0,0,0,0);
|
|
|
3857 |
$lc=1 if ($opts =~ /lc/i);
|
|
|
3858 |
$sort=1 if ($opts =~ /sort/i);
|
|
|
3859 |
$back=1 if ($opts =~ /back/i);
|
|
|
3860 |
$escape=1 if ($opts =~ /escape/i);
|
|
|
3861 |
|
|
|
3862 |
# Create the regular expression
|
|
|
3863 |
my($ele)=();
|
|
|
3864 |
@list=sort sortByLength(@list) if ($sort);
|
|
|
3865 |
if ($escape) {
|
|
|
3866 |
foreach $ele (@list) {
|
|
|
3867 |
$ele="\Q$ele\E";
|
|
|
3868 |
}
|
|
|
3869 |
}
|
|
|
3870 |
if ($back) {
|
|
|
3871 |
$$regexp="(" . join("|",@list) . ")";
|
|
|
3872 |
} else {
|
|
|
3873 |
$$regexp="(?:" . join("|",@list) . ")";
|
|
|
3874 |
}
|
|
|
3875 |
$$regexp=lc($$regexp) if ($lc);
|
|
|
3876 |
}
|
|
|
3877 |
|
|
|
3878 |
# items is passed in (either as a space separated string, or a reference to
|
|
|
3879 |
# a list) and a regular expression which matches any one of the items is
|
|
|
3880 |
# prepared. The regular expression will be of one of the forms:
|
|
|
3881 |
# "(a|b)" @list not empty, back option included
|
|
|
3882 |
# "(?:a|b)" @list not empty
|
|
|
3883 |
# "()" @list empty, back option included
|
|
|
3884 |
# "" @list empty
|
|
|
3885 |
# $options is a string which contains any of the following strings:
|
|
|
3886 |
# back : the regular expression has a backreference
|
|
|
3887 |
# opt : the regular expression is optional and a "?" is appended in
|
|
|
3888 |
# the first two forms
|
|
|
3889 |
# optws : the regular expression is optional and may be replaced by
|
|
|
3890 |
# whitespace
|
|
|
3891 |
# optWs : the regular expression is optional, but if not present, must
|
|
|
3892 |
# be replaced by whitespace
|
|
|
3893 |
# sort : the items in the list are sorted by length (longest first)
|
|
|
3894 |
# lc : the string is lowercased
|
|
|
3895 |
# under : any underscores are converted to spaces
|
|
|
3896 |
# pre : it may be preceded by whitespace
|
|
|
3897 |
# Pre : it must be preceded by whitespace
|
|
|
3898 |
# PRE : it must be preceded by whitespace or the start
|
|
|
3899 |
# post : it may be followed by whitespace
|
|
|
3900 |
# Post : it must be followed by whitespace
|
|
|
3901 |
# POST : it must be followed by whitespace or the end
|
|
|
3902 |
# Spaces due to pre/post options will not be included in the back reference.
|
|
|
3903 |
#
|
|
|
3904 |
# If $array is included, then the elements will also be returned as a list.
|
|
|
3905 |
# $array is a string which may contain any of the following:
|
|
|
3906 |
# keys : treat the list as a hash and only the keys go into the regexp
|
|
|
3907 |
# key0 : treat the list as the values of a hash with keys 0 .. N-1
|
|
|
3908 |
# key1 : treat the list as the values of a hash with keys 1 .. N
|
|
|
3909 |
# val0 : treat the list as the keys of a hash with values 0 .. N-1
|
|
|
3910 |
# val1 : treat the list as the keys of a hash with values 1 .. N
|
|
|
3911 |
|
|
|
3912 |
# &Date_InitLists([$lang{"month_name"},$lang{"month_abb"}],
|
|
|
3913 |
# [\$Month,"lc,sort,back"],
|
|
|
3914 |
# [\@Month,\@Mon],
|
|
|
3915 |
# [\%Month,1]);
|
|
|
3916 |
|
|
|
3917 |
# This is used in Date_Init to prepare regular expressions. A list of
|
|
|
3918 |
# items is passed in (either as a space separated string, or a reference to
|
|
|
3919 |
# a list) and a regular expression which matches any one of the items is
|
|
|
3920 |
# prepared. The regular expression will be of one of the forms:
|
|
|
3921 |
# "(a|b)" @list not empty, back option included
|
|
|
3922 |
# "(?:a|b)" @list not empty
|
|
|
3923 |
# "()" @list empty, back option included
|
|
|
3924 |
# "" @list empty
|
|
|
3925 |
# $options is a string which contains any of the following strings:
|
|
|
3926 |
# back : the regular expression has a backreference
|
|
|
3927 |
# opt : the regular expression is optional and a "?" is appended in
|
|
|
3928 |
# the first two forms
|
|
|
3929 |
# optws : the regular expression is optional and may be replaced by
|
|
|
3930 |
# whitespace
|
|
|
3931 |
# optWs : the regular expression is optional, but if not present, must
|
|
|
3932 |
# be replaced by whitespace
|
|
|
3933 |
# sort : the items in the list are sorted by length (longest first)
|
|
|
3934 |
# lc : the string is lowercased
|
|
|
3935 |
# under : any underscores are converted to spaces
|
|
|
3936 |
# pre : it may be preceded by whitespace
|
|
|
3937 |
# Pre : it must be preceded by whitespace
|
|
|
3938 |
# PRE : it must be preceded by whitespace or the start
|
|
|
3939 |
# post : it may be followed by whitespace
|
|
|
3940 |
# Post : it must be followed by whitespace
|
|
|
3941 |
# POST : it must be followed by whitespace or the end
|
|
|
3942 |
# Spaces due to pre/post options will not be included in the back reference.
|
|
|
3943 |
#
|
|
|
3944 |
# If $array is included, then the elements will also be returned as a list.
|
|
|
3945 |
# $array is a string which may contain any of the following:
|
|
|
3946 |
# keys : treat the list as a hash and only the keys go into the regexp
|
|
|
3947 |
# key0 : treat the list as the values of a hash with keys 0 .. N-1
|
|
|
3948 |
# key1 : treat the list as the values of a hash with keys 1 .. N
|
|
|
3949 |
# val0 : treat the list as the keys of a hash with values 0 .. N-1
|
|
|
3950 |
# val1 : treat the list as the keys of a hash with values 1 .. N
|
|
|
3951 |
sub Date_Regexp {
|
|
|
3952 |
print "DEBUG: Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
3953 |
my($list,$options,$array)=@_;
|
|
|
3954 |
my(@list,$ret,%hash,$i)=();
|
|
|
3955 |
local($_)=();
|
|
|
3956 |
$options="" if (! defined $options);
|
|
|
3957 |
$array="" if (! defined $array);
|
|
|
3958 |
|
|
|
3959 |
my($sort,$lc,$under)=(0,0,0);
|
|
|
3960 |
$sort =1 if ($options =~ /sort/i);
|
|
|
3961 |
$lc =1 if ($options =~ /lc/i);
|
|
|
3962 |
$under=1 if ($options =~ /under/i);
|
|
|
3963 |
my($back,$opt,$pre,$post,$ws)=("?:","","","","");
|
|
|
3964 |
$back ="" if ($options =~ /back/i);
|
|
|
3965 |
$opt ="?" if ($options =~ /opt/i);
|
|
|
3966 |
$pre ='\s*' if ($options =~ /pre/);
|
|
|
3967 |
$pre ='\s+' if ($options =~ /Pre/);
|
|
|
3968 |
$pre ='(?:\s+|^)' if ($options =~ /PRE/);
|
|
|
3969 |
$post ='\s*' if ($options =~ /post/);
|
|
|
3970 |
$post ='\s+' if ($options =~ /Post/);
|
|
|
3971 |
$post ='(?:$|\s+)' if ($options =~ /POST/);
|
|
|
3972 |
$ws ='\s*' if ($options =~ /optws/);
|
|
|
3973 |
$ws ='\s+' if ($options =~ /optws/);
|
|
|
3974 |
|
|
|
3975 |
my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0);
|
|
|
3976 |
$keys =1 if ($array =~ /keys/i);
|
|
|
3977 |
$key0 =1 if ($array =~ /key0/i);
|
|
|
3978 |
$key1 =1 if ($array =~ /key1/i);
|
|
|
3979 |
$val0 =1 if ($array =~ /val0/i);
|
|
|
3980 |
$val1 =1 if ($array =~ /val1/i);
|
|
|
3981 |
$hash =1 if ($keys or $key0 or $key1 or $val0 or $val1);
|
|
|
3982 |
|
|
|
3983 |
my($ref)=ref $list;
|
|
|
3984 |
if (! $ref) {
|
|
|
3985 |
$list =~ s/\s*$//;
|
|
|
3986 |
$list =~ s/^\s*//;
|
|
|
3987 |
$list =~ s/\s+/&&&/g;
|
|
|
3988 |
} elsif ($ref eq "ARRAY") {
|
|
|
3989 |
$list = join("&&&",@$list);
|
|
|
3990 |
} else {
|
|
|
3991 |
confess "ERROR: Date_Regexp.\n";
|
|
|
3992 |
}
|
|
|
3993 |
|
|
|
3994 |
if (! $list) {
|
|
|
3995 |
if ($back eq "") {
|
|
|
3996 |
return "()";
|
|
|
3997 |
} else {
|
|
|
3998 |
return "";
|
|
|
3999 |
}
|
|
|
4000 |
}
|
|
|
4001 |
|
|
|
4002 |
$list=lc($list) if ($lc);
|
|
|
4003 |
$list=~ s/_/ /g if ($under);
|
|
|
4004 |
@list=split(/&&&/,$list);
|
|
|
4005 |
if ($keys) {
|
|
|
4006 |
%hash=@list;
|
|
|
4007 |
@list=keys %hash;
|
|
|
4008 |
} elsif ($key0 or $key1 or $val0 or $val1) {
|
|
|
4009 |
$i=0;
|
|
|
4010 |
$i=1 if ($key1 or $val1);
|
|
|
4011 |
if ($key0 or $key1) {
|
|
|
4012 |
%hash= map { $_,$i++ } @list;
|
|
|
4013 |
} else {
|
|
|
4014 |
%hash= map { $i++,$_ } @list;
|
|
|
4015 |
}
|
|
|
4016 |
}
|
|
|
4017 |
@list=sort sortByLength(@list) if ($sort);
|
|
|
4018 |
|
|
|
4019 |
$ret="($back" . join("|",@list) . ")";
|
|
|
4020 |
$ret="(?:$pre$ret$post)" if ($pre or $post);
|
|
|
4021 |
$ret.=$opt;
|
|
|
4022 |
$ret="(?:$ret|$ws)" if ($ws);
|
|
|
4023 |
|
|
|
4024 |
if ($array and $hash) {
|
|
|
4025 |
return ($ret,%hash);
|
|
|
4026 |
} elsif ($array) {
|
|
|
4027 |
return ($ret,@list);
|
|
|
4028 |
} else {
|
|
|
4029 |
return $ret;
|
|
|
4030 |
}
|
|
|
4031 |
}
|
|
|
4032 |
|
|
|
4033 |
# This will produce a delta with the correct number of signs. At most two
|
|
|
4034 |
# signs will be in it normally (one before the year, and one in front of
|
|
|
4035 |
# the day), but if appropriate, signs will be in front of all elements.
|
|
|
4036 |
# Also, as many of the signs will be equivalent as possible.
|
|
|
4037 |
sub Delta_Normalize {
|
|
|
4038 |
print "DEBUG: Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4039 |
my($delta,$mode)=@_;
|
|
|
4040 |
return "" if (! $delta);
|
|
|
4041 |
return "+0:+0:+0:+0:+0:+0:+0"
|
|
|
4042 |
if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"});
|
|
|
4043 |
return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/);
|
|
|
4044 |
|
|
|
4045 |
my($tmp,$sign1,$sign2,$len)=();
|
|
|
4046 |
|
|
|
4047 |
# Calculate the length of the day in minutes
|
|
|
4048 |
$len=24*60;
|
|
|
4049 |
$len=$Curr{"WDlen"} if ($mode==2 || $mode==3);
|
|
|
4050 |
|
|
|
4051 |
# We have to get the sign of every component explicitely so that a "-0"
|
|
|
4052 |
# or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must
|
|
|
4053 |
# be a negative delta).
|
|
|
4054 |
|
|
|
4055 |
my($y,$mon,$w,$d,$h,$m,$s)=&Delta_Split($delta);
|
|
|
4056 |
|
|
|
4057 |
# We need to make sure that the signs of all parts of a delta are the
|
|
|
4058 |
# same. The easiest way to do this is to convert all of the large
|
|
|
4059 |
# components to the smallest ones, then convert the smaller components
|
|
|
4060 |
# back to the larger ones.
|
|
|
4061 |
|
|
|
4062 |
# Do the year/month part
|
|
|
4063 |
|
|
|
4064 |
$mon += $y*12; # convert y to m
|
|
|
4065 |
$sign1="+";
|
|
|
4066 |
if ($mon<0) {
|
|
|
4067 |
$mon *= -1;
|
|
|
4068 |
$sign1="-";
|
|
|
4069 |
}
|
|
|
4070 |
|
|
|
4071 |
$y = $mon/12; # convert m to y
|
|
|
4072 |
$mon -= $y*12;
|
|
|
4073 |
|
|
|
4074 |
$y=0 if ($y eq "-0"); # get around silly -0 problem
|
|
|
4075 |
$mon=0 if ($mon eq "-0");
|
|
|
4076 |
|
|
|
4077 |
# Do the wk/day/hour/min/sec part
|
|
|
4078 |
|
|
|
4079 |
{
|
|
|
4080 |
# Unfortunately, $s is overflowing for dates more than ~70 years
|
|
|
4081 |
# apart.
|
|
|
4082 |
no integer;
|
|
|
4083 |
|
|
|
4084 |
if ($mode==3 || $mode==2) {
|
|
|
4085 |
$s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
|
|
|
4086 |
} else {
|
|
|
4087 |
$s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
|
|
|
4088 |
}
|
|
|
4089 |
$sign2="+";
|
|
|
4090 |
if ($s<0) {
|
|
|
4091 |
$s*=-1;
|
|
|
4092 |
$sign2="-";
|
|
|
4093 |
}
|
|
|
4094 |
|
|
|
4095 |
$m = int($s/60); # convert s to m
|
|
|
4096 |
$s -= $m*60;
|
|
|
4097 |
$d = int($m/$len); # convert m to d
|
|
|
4098 |
$m -= $d*$len;
|
|
|
4099 |
|
|
|
4100 |
# The rest should be fine.
|
|
|
4101 |
}
|
|
|
4102 |
$h = $m/60; # convert m to h
|
|
|
4103 |
$m -= $h*60;
|
|
|
4104 |
if ($mode == 3 || $mode == 2) {
|
|
|
4105 |
$w = $w*1; # get around +0 problem
|
|
|
4106 |
} else {
|
|
|
4107 |
$w = $d/7; # convert d to w
|
|
|
4108 |
$d -= $w*7;
|
|
|
4109 |
}
|
|
|
4110 |
|
|
|
4111 |
$w=0 if ($w eq "-0"); # get around silly -0 problem
|
|
|
4112 |
$d=0 if ($d eq "-0");
|
|
|
4113 |
$h=0 if ($h eq "-0");
|
|
|
4114 |
$m=0 if ($m eq "-0");
|
|
|
4115 |
$s=0 if ($s eq "-0");
|
|
|
4116 |
|
|
|
4117 |
# Only include two signs if necessary
|
|
|
4118 |
$sign1=$sign2 if ($y==0 and $mon==0);
|
|
|
4119 |
$sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0);
|
|
|
4120 |
$sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"});
|
|
|
4121 |
|
|
|
4122 |
if ($Cnf{"DeltaSigns"}) {
|
|
|
4123 |
return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s";
|
|
|
4124 |
} else {
|
|
|
4125 |
return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s";
|
|
|
4126 |
}
|
|
|
4127 |
}
|
|
|
4128 |
|
|
|
4129 |
# This checks a delta to make sure it is valid. If it is, it splits
|
|
|
4130 |
# it and returns the elements with a sign on each. The 2nd argument
|
|
|
4131 |
# specifies the default sign. Blank elements are set to 0. If the
|
|
|
4132 |
# third element is non-nil, exactly 7 elements must be included.
|
|
|
4133 |
sub Delta_Split {
|
|
|
4134 |
print "DEBUG: Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4135 |
my($delta,$sign,$exact)=@_;
|
|
|
4136 |
my(@delta)=split(/:/,$delta);
|
|
|
4137 |
return () if ($exact and $#delta != 6);
|
|
|
4138 |
my($i)=();
|
|
|
4139 |
$sign="+" if (! defined $sign);
|
|
|
4140 |
for ($i=0; $i<=$#delta; $i++) {
|
|
|
4141 |
$delta[$i]="0" if (! $delta[$i]);
|
|
|
4142 |
return () if ($delta[$i] !~ /^[+-]?\d+$/);
|
|
|
4143 |
$sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign);
|
|
|
4144 |
$delta[$i] = $sign.$delta[$i];
|
|
|
4145 |
}
|
|
|
4146 |
@delta;
|
|
|
4147 |
}
|
|
|
4148 |
|
|
|
4149 |
# Reads up to 3 arguments. $h may contain the time in any international
|
|
|
4150 |
# format. Any empty elements are set to 0.
|
|
|
4151 |
sub Date_ParseTime {
|
|
|
4152 |
print "DEBUG: Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4153 |
my($h,$m,$s)=@_;
|
|
|
4154 |
my($t)=&CheckTime("one");
|
|
|
4155 |
|
|
|
4156 |
if (defined $h and $h =~ /$t/) {
|
|
|
4157 |
$h=$1;
|
|
|
4158 |
$m=$2;
|
|
|
4159 |
$s=$3 if (defined $3);
|
|
|
4160 |
}
|
|
|
4161 |
$h="00" if (! defined $h);
|
|
|
4162 |
$m="00" if (! defined $m);
|
|
|
4163 |
$s="00" if (! defined $s);
|
|
|
4164 |
|
|
|
4165 |
($h,$m,$s);
|
|
|
4166 |
}
|
|
|
4167 |
|
|
|
4168 |
# Forms a date with the 6 elements passed in (all of which must be defined).
|
|
|
4169 |
# No check as to validity is made.
|
|
|
4170 |
sub Date_Join {
|
|
|
4171 |
print "DEBUG: Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4172 |
foreach (0 .. $#_) {
|
|
|
4173 |
croak "undefined arg $_ to Date_Join()" if not defined $_[$_];
|
|
|
4174 |
}
|
|
|
4175 |
my($y,$m,$d,$h,$mn,$s)=@_;
|
|
|
4176 |
my($ym,$md,$dh,$hmn,$mns)=();
|
|
|
4177 |
|
|
|
4178 |
if ($Cnf{"Internal"} == 0) {
|
|
|
4179 |
$ym=$md=$dh="";
|
|
|
4180 |
$hmn=$mns=":";
|
|
|
4181 |
|
|
|
4182 |
} elsif ($Cnf{"Internal"} == 1) {
|
|
|
4183 |
$ym=$md=$dh=$hmn=$mns="";
|
|
|
4184 |
|
|
|
4185 |
} elsif ($Cnf{"Internal"} == 2) {
|
|
|
4186 |
$ym=$md="-";
|
|
|
4187 |
$dh=" ";
|
|
|
4188 |
$hmn=$mns=":";
|
|
|
4189 |
|
|
|
4190 |
} else {
|
|
|
4191 |
confess "ERROR: Invalid internal format in Date_Join.\n";
|
|
|
4192 |
}
|
|
|
4193 |
$m="0$m" if (length($m)==1);
|
|
|
4194 |
$d="0$d" if (length($d)==1);
|
|
|
4195 |
$h="0$h" if (length($h)==1);
|
|
|
4196 |
$mn="0$mn" if (length($mn)==1);
|
|
|
4197 |
$s="0$s" if (length($s)==1);
|
|
|
4198 |
"$y$ym$m$md$d$dh$h$hmn$mn$mns$s";
|
|
|
4199 |
}
|
|
|
4200 |
|
|
|
4201 |
# This checks a time. If it is valid, it splits it and returns 3 elements.
|
|
|
4202 |
# If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is
|
|
|
4203 |
# returned.
|
|
|
4204 |
sub CheckTime {
|
|
|
4205 |
print "DEBUG: CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4206 |
my($time)=@_;
|
|
|
4207 |
my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
|
|
|
4208 |
my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
|
|
|
4209 |
my($m)='[0-5][0-9]';
|
|
|
4210 |
my($s)=$m;
|
|
|
4211 |
my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)";
|
|
|
4212 |
my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)";
|
|
|
4213 |
my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"};
|
|
|
4214 |
my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
|
|
|
4215 |
if ($time eq "one") {
|
|
|
4216 |
return $t;
|
|
|
4217 |
} elsif ($time eq "two") {
|
|
|
4218 |
$t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
|
|
|
4219 |
return $t;
|
|
|
4220 |
}
|
|
|
4221 |
|
|
|
4222 |
if ($time =~ /$t/i) {
|
|
|
4223 |
($h,$m,$s)=($1,$2,$3);
|
|
|
4224 |
$h="0$h" if (length($h)<2);
|
|
|
4225 |
$m="0$m" if (length($m)<2);
|
|
|
4226 |
$s="00" if (! defined $s);
|
|
|
4227 |
return ($h,$m,$s);
|
|
|
4228 |
} else {
|
|
|
4229 |
return ();
|
|
|
4230 |
}
|
|
|
4231 |
}
|
|
|
4232 |
|
|
|
4233 |
# This checks a recurrence. If it is valid, it splits it and returns the
|
|
|
4234 |
# elements. Otherwise, it returns an empty list.
|
|
|
4235 |
# ($recur0,$recur1,$flags,$dateb,$date0,$date1)=&Recur_Split($recur);
|
|
|
4236 |
sub Recur_Split {
|
|
|
4237 |
print "DEBUG: Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4238 |
my($recur)=@_;
|
|
|
4239 |
my(@ret,@tmp);
|
|
|
4240 |
|
|
|
4241 |
my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
|
|
|
4242 |
my($F) = '(?:\*([^*]*))';
|
|
|
4243 |
my($DB,$D0,$D1);
|
|
|
4244 |
$DB=$D0=$D1=$F;
|
|
|
4245 |
|
|
|
4246 |
if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
|
|
|
4247 |
@ret=($1,$2,$3,$4,$5);
|
|
|
4248 |
@tmp=split(/\*/,shift(@ret));
|
|
|
4249 |
return () if ($#tmp>1);
|
|
|
4250 |
return (@tmp,"",@ret) if ($#tmp==0);
|
|
|
4251 |
return (@tmp,@ret);
|
|
|
4252 |
}
|
|
|
4253 |
return ();
|
|
|
4254 |
}
|
|
|
4255 |
|
|
|
4256 |
# This checks a date. If it is valid, it splits it and returns the elements.
|
|
|
4257 |
# If no date is passed in, it returns a regular expression for the date.
|
|
|
4258 |
#
|
|
|
4259 |
# The optional second argument says 'I really expect this to be a
|
|
|
4260 |
# valid Date::Manip object, please throw an exception if it is
|
|
|
4261 |
# not'. Otherwise, errors are signalled by returning ().
|
|
|
4262 |
#
|
|
|
4263 |
sub Date_Split {
|
|
|
4264 |
print "DEBUG: Date_Split\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4265 |
my($date, $definitely_valid)=@_;
|
|
|
4266 |
$definitely_valid = 0 if not defined $definitely_valid;
|
|
|
4267 |
my($ym,$md,$dh,$hmn,$mns)=();
|
|
|
4268 |
my($y)='(\d{4})';
|
|
|
4269 |
my($m)='(0[1-9]|1[0-2])';
|
|
|
4270 |
my($d)='(0[1-9]|[1-2][0-9]|3[0-1])';
|
|
|
4271 |
my($h)='([0-1][0-9]|2[0-3])';
|
|
|
4272 |
my($mn)='([0-5][0-9])';
|
|
|
4273 |
my($s)=$mn;
|
|
|
4274 |
|
|
|
4275 |
if ($Cnf{"Internal"} == 0) {
|
|
|
4276 |
$ym=$md=$dh="";
|
|
|
4277 |
$hmn=$mns=":";
|
|
|
4278 |
|
|
|
4279 |
} elsif ($Cnf{"Internal"} == 1) {
|
|
|
4280 |
$ym=$md=$dh=$hmn=$mns="";
|
|
|
4281 |
|
|
|
4282 |
} elsif ($Cnf{"Internal"} == 2) {
|
|
|
4283 |
$ym=$md="-";
|
|
|
4284 |
$dh=" ";
|
|
|
4285 |
$hmn=$mns=":";
|
|
|
4286 |
|
|
|
4287 |
} else {
|
|
|
4288 |
confess "ERROR: Invalid internal format in Date_Split.\n";
|
|
|
4289 |
}
|
|
|
4290 |
|
|
|
4291 |
my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$";
|
|
|
4292 |
|
|
|
4293 |
if (not defined $date or $date eq '') {
|
|
|
4294 |
if ($definitely_valid) {
|
|
|
4295 |
die "bad date '$date'";
|
|
|
4296 |
} else {
|
|
|
4297 |
return $t;
|
|
|
4298 |
}
|
|
|
4299 |
}
|
|
|
4300 |
|
|
|
4301 |
if ($date =~ /$t/) {
|
|
|
4302 |
($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
|
|
|
4303 |
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
|
|
4304 |
$d_in_m[2]=29 if (&Date_LeapYear($y));
|
|
|
4305 |
if ($d>$d_in_m[$m]) {
|
|
|
4306 |
my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
|
|
|
4307 |
if ($definitely_valid) {
|
|
|
4308 |
die $msg;
|
|
|
4309 |
}
|
|
|
4310 |
else {
|
|
|
4311 |
warn $msg;
|
|
|
4312 |
return ();
|
|
|
4313 |
}
|
|
|
4314 |
}
|
|
|
4315 |
return ($y,$m,$d,$h,$mn,$s);
|
|
|
4316 |
}
|
|
|
4317 |
|
|
|
4318 |
if ($definitely_valid) {
|
|
|
4319 |
die "invalid date $date: doesn't match regexp $t";
|
|
|
4320 |
}
|
|
|
4321 |
return ();
|
|
|
4322 |
}
|
|
|
4323 |
|
|
|
4324 |
# This returns the date easter occurs on for a given year as ($month,$day).
|
|
|
4325 |
# This is from the Calendar FAQ.
|
|
|
4326 |
sub Date_Easter {
|
|
|
4327 |
my($y)=@_;
|
|
|
4328 |
$y=&Date_FixYear($y) if (length($y)==2);
|
|
|
4329 |
|
|
|
4330 |
my($c) = $y/100;
|
|
|
4331 |
my($g) = $y % 19;
|
|
|
4332 |
my($k) = ($c-17)/25;
|
|
|
4333 |
my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30;
|
|
|
4334 |
$i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11));
|
|
|
4335 |
my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7;
|
|
|
4336 |
my($l) = $i-$j;
|
|
|
4337 |
my($m) = 3 + ($l+40)/44;
|
|
|
4338 |
my($d) = $l + 28 - 31*($m/4);
|
|
|
4339 |
return ($m,$d);
|
|
|
4340 |
}
|
|
|
4341 |
|
|
|
4342 |
# This takes a list of years, months, WeekOfMonth's, and optionally
|
|
|
4343 |
# DayOfWeek's, and returns a list of dates. Optionally, a list of dates
|
|
|
4344 |
# can be passed in as the 1st argument (with the 2nd argument the null list)
|
|
|
4345 |
# and the year/month of these will be used.
|
|
|
4346 |
#
|
|
|
4347 |
# If $FDn is non-zero, the first week of the month contains the first
|
|
|
4348 |
# occurence of this day (1=Monday). If $FIn is non-zero, the first week of
|
|
|
4349 |
# the month contains the date (i.e. $FIn'th day of the month).
|
|
|
4350 |
sub Date_Recur_WoM {
|
|
|
4351 |
my($y,$m,$w,$d,$FDn,$FIn)=@_;
|
|
|
4352 |
my(@y)=@$y;
|
|
|
4353 |
my(@m)=@$m;
|
|
|
4354 |
my(@w)=@$w;
|
|
|
4355 |
my(@d)=@$d;
|
|
|
4356 |
my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
|
|
|
4357 |
|
|
|
4358 |
if (@m) {
|
|
|
4359 |
@tmp=();
|
|
|
4360 |
foreach $y (@y) {
|
|
|
4361 |
return () if (length($y)==1 || length($y)==3 || ! &IsInt($y,0,9999));
|
|
|
4362 |
$y=&Date_FixYear($y) if (length($y)==2);
|
|
|
4363 |
push(@tmp,$y);
|
|
|
4364 |
}
|
|
|
4365 |
@y=sort { $a<=>$b } (@tmp);
|
|
|
4366 |
|
|
|
4367 |
return () if (! @m);
|
|
|
4368 |
foreach $m (@m) {
|
|
|
4369 |
return () if (! &IsInt($m,1,12));
|
|
|
4370 |
}
|
|
|
4371 |
@m=sort { $a<=>$b } (@m);
|
|
|
4372 |
|
|
|
4373 |
@tmp=@tmp2=();
|
|
|
4374 |
foreach $y (@y) {
|
|
|
4375 |
foreach $m (@m) {
|
|
|
4376 |
push(@tmp,$y);
|
|
|
4377 |
push(@tmp2,$m);
|
|
|
4378 |
}
|
|
|
4379 |
}
|
|
|
4380 |
|
|
|
4381 |
@y=@tmp;
|
|
|
4382 |
@m=@tmp2;
|
|
|
4383 |
|
|
|
4384 |
} else {
|
|
|
4385 |
foreach $d0 (@y) {
|
|
|
4386 |
@tmp=&Date_Split($d0);
|
|
|
4387 |
return () if (! @tmp);
|
|
|
4388 |
push(@tmp2,$tmp[0]);
|
|
|
4389 |
push(@m,$tmp[1]);
|
|
|
4390 |
}
|
|
|
4391 |
@y=@tmp2;
|
|
|
4392 |
}
|
|
|
4393 |
|
|
|
4394 |
return () if (! @w);
|
|
|
4395 |
foreach $w (@w) {
|
|
|
4396 |
return () if ($w==0 || ! &IsInt($w,-5,5));
|
|
|
4397 |
}
|
|
|
4398 |
|
|
|
4399 |
if (@d) {
|
|
|
4400 |
foreach $d (@d) {
|
|
|
4401 |
return () if (! &IsInt($d,1,7));
|
|
|
4402 |
}
|
|
|
4403 |
@d=sort { $a<=>$b } (@d);
|
|
|
4404 |
}
|
|
|
4405 |
|
|
|
4406 |
@date=();
|
|
|
4407 |
foreach $y (@y) {
|
|
|
4408 |
$m=shift(@m);
|
|
|
4409 |
|
|
|
4410 |
# Find 1st day of this month and next month
|
|
|
4411 |
$date0=&Date_Join($y,$m,1,0,0,0);
|
|
|
4412 |
$date1=&DateCalc($date0,"+0:1:0:0:0:0:0");
|
|
|
4413 |
|
|
|
4414 |
if (@d) {
|
|
|
4415 |
foreach $d (@d) {
|
|
|
4416 |
# Find 1st occurence of DOW (in both months)
|
|
|
4417 |
$d0=&Date_GetNext($date0,$d,1);
|
|
|
4418 |
$d1=&Date_GetNext($date1,$d,1);
|
|
|
4419 |
|
|
|
4420 |
@tmp=();
|
|
|
4421 |
while (&Date_Cmp($d0,$d1)<0) {
|
|
|
4422 |
push(@tmp,$d0);
|
|
|
4423 |
$d0=&DateCalc($d0,"+0:0:1:0:0:0:0");
|
|
|
4424 |
}
|
|
|
4425 |
|
|
|
4426 |
@tmp2=();
|
|
|
4427 |
foreach $w (@w) {
|
|
|
4428 |
if ($w>0) {
|
|
|
4429 |
push(@tmp2,$tmp[$w-1]);
|
|
|
4430 |
} else {
|
|
|
4431 |
push(@tmp2,$tmp[$#tmp+1+$w]);
|
|
|
4432 |
}
|
|
|
4433 |
}
|
|
|
4434 |
@tmp2=sort(@tmp2);
|
|
|
4435 |
push(@date,@tmp2);
|
|
|
4436 |
}
|
|
|
4437 |
|
|
|
4438 |
} else {
|
|
|
4439 |
# Find 1st day of 1st week
|
|
|
4440 |
if ($FDn != 0) {
|
|
|
4441 |
$date0=&Date_GetNext($date0,$FDn,1);
|
|
|
4442 |
} else {
|
|
|
4443 |
$date0=&Date_Join($y,$m,$FIn,0,0,0);
|
|
|
4444 |
}
|
|
|
4445 |
$date0=&Date_GetPrev($date0,$Cnf{"FirstDay"},1);
|
|
|
4446 |
|
|
|
4447 |
# Find 1st day of 1st week of next month
|
|
|
4448 |
if ($FDn != 0) {
|
|
|
4449 |
$date1=&Date_GetNext($date1,$FDn,1);
|
|
|
4450 |
} else {
|
|
|
4451 |
$date1=&DateCalc($date1,"+0:0:0:".($FIn-1).":0:0:0") if ($FIn>1);
|
|
|
4452 |
}
|
|
|
4453 |
$date1=&Date_GetPrev($date1,$Cnf{"FirstDay"},1);
|
|
|
4454 |
|
|
|
4455 |
@tmp=();
|
|
|
4456 |
while (&Date_Cmp($date0,$date1)<0) {
|
|
|
4457 |
push(@tmp,$date0);
|
|
|
4458 |
$date0=&DateCalc($date0,"+0:0:1:0:0:0:0");
|
|
|
4459 |
}
|
|
|
4460 |
|
|
|
4461 |
@tmp2=();
|
|
|
4462 |
foreach $w (@w) {
|
|
|
4463 |
if ($w>0) {
|
|
|
4464 |
push(@tmp2,$tmp[$w-1]);
|
|
|
4465 |
} else {
|
|
|
4466 |
push(@tmp2,$tmp[$#tmp+1+$w]);
|
|
|
4467 |
}
|
|
|
4468 |
}
|
|
|
4469 |
@tmp2=sort(@tmp2);
|
|
|
4470 |
push(@date,@tmp2);
|
|
|
4471 |
}
|
|
|
4472 |
}
|
|
|
4473 |
|
|
|
4474 |
@date;
|
|
|
4475 |
}
|
|
|
4476 |
|
|
|
4477 |
# This returns a sorted list of dates formed by adding/subtracting
|
|
|
4478 |
# $delta to $dateb in the range $date0<=$d<$dateb. The first date int
|
|
|
4479 |
# the list is actually the first date<$date0 and the last date in the
|
|
|
4480 |
# list is the first date>=$date1 (because sometimes the set part will
|
|
|
4481 |
# move the date back into the range).
|
|
|
4482 |
sub Date_Recur {
|
|
|
4483 |
my($date0,$date1,$dateb,$delta)=@_;
|
|
|
4484 |
my(@ret,$d)=();
|
|
|
4485 |
|
|
|
4486 |
while (&Date_Cmp($dateb,$date0)<0) {
|
|
|
4487 |
$dateb=&DateCalc_DateDelta($dateb,$delta);
|
|
|
4488 |
}
|
|
|
4489 |
while (&Date_Cmp($dateb,$date1)>=0) {
|
|
|
4490 |
$dateb=&DateCalc_DateDelta($dateb,"-$delta");
|
|
|
4491 |
}
|
|
|
4492 |
|
|
|
4493 |
# Add the dates $date0..$dateb
|
|
|
4494 |
$d=$dateb;
|
|
|
4495 |
while (&Date_Cmp($d,$date0)>=0) {
|
|
|
4496 |
unshift(@ret,$d);
|
|
|
4497 |
$d=&DateCalc_DateDelta($d,"-$delta");
|
|
|
4498 |
}
|
|
|
4499 |
# Add the first date earler than the range
|
|
|
4500 |
unshift(@ret,$d);
|
|
|
4501 |
|
|
|
4502 |
# Add the dates $dateb..$date1
|
|
|
4503 |
$d=&DateCalc_DateDelta($dateb,$delta);
|
|
|
4504 |
while (&Date_Cmp($d,$date1)<0) {
|
|
|
4505 |
push(@ret,$d);
|
|
|
4506 |
$d=&DateCalc_DateDelta($d,$delta);
|
|
|
4507 |
}
|
|
|
4508 |
# Add the first date later than the range
|
|
|
4509 |
push(@ret,$d);
|
|
|
4510 |
|
|
|
4511 |
@ret;
|
|
|
4512 |
}
|
|
|
4513 |
|
|
|
4514 |
# This sets the values in each date of a recurrence.
|
|
|
4515 |
#
|
|
|
4516 |
# $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1",
|
|
|
4517 |
# they are not set (and none of the larger elements are set).
|
|
|
4518 |
sub Date_RecurSetTime {
|
|
|
4519 |
my($date0,$date1,$dates,$h,$m,$s)=@_;
|
|
|
4520 |
my(@dates)=@$dates;
|
|
|
4521 |
my(@h,@m,@s,$date,@tmp)=();
|
|
|
4522 |
|
|
|
4523 |
$m="-1" if ($s eq "-1");
|
|
|
4524 |
$h="-1" if ($m eq "-1");
|
|
|
4525 |
|
|
|
4526 |
if ($h ne "-1") {
|
|
|
4527 |
@h=&ReturnList($h);
|
|
|
4528 |
return () if ! (@h);
|
|
|
4529 |
@h=sort { $a<=>$b } (@h);
|
|
|
4530 |
|
|
|
4531 |
@tmp=();
|
|
|
4532 |
foreach $date (@dates) {
|
|
|
4533 |
foreach $h (@h) {
|
|
|
4534 |
push(@tmp,&Date_SetDateField($date,"h",$h,1));
|
|
|
4535 |
}
|
|
|
4536 |
}
|
|
|
4537 |
@dates=@tmp;
|
|
|
4538 |
}
|
|
|
4539 |
|
|
|
4540 |
if ($m ne "-1") {
|
|
|
4541 |
@m=&ReturnList($m);
|
|
|
4542 |
return () if ! (@m);
|
|
|
4543 |
@m=sort { $a<=>$b } (@m);
|
|
|
4544 |
|
|
|
4545 |
@tmp=();
|
|
|
4546 |
foreach $date (@dates) {
|
|
|
4547 |
foreach $m (@m) {
|
|
|
4548 |
push(@tmp,&Date_SetDateField($date,"mn",$m,1));
|
|
|
4549 |
}
|
|
|
4550 |
}
|
|
|
4551 |
@dates=@tmp;
|
|
|
4552 |
}
|
|
|
4553 |
|
|
|
4554 |
if ($s ne "-1") {
|
|
|
4555 |
@s=&ReturnList($s);
|
|
|
4556 |
return () if ! (@s);
|
|
|
4557 |
@s=sort { $a<=>$b } (@s);
|
|
|
4558 |
|
|
|
4559 |
@tmp=();
|
|
|
4560 |
foreach $date (@dates) {
|
|
|
4561 |
foreach $s (@s) {
|
|
|
4562 |
push(@tmp,&Date_SetDateField($date,"s",$s,1));
|
|
|
4563 |
}
|
|
|
4564 |
}
|
|
|
4565 |
@dates=@tmp;
|
|
|
4566 |
}
|
|
|
4567 |
|
|
|
4568 |
@tmp=();
|
|
|
4569 |
foreach $date (@dates) {
|
|
|
4570 |
push(@tmp,$date) if (&Date_Cmp($date,$date0)>=0 &&
|
|
|
4571 |
&Date_Cmp($date,$date1)<0 &&
|
|
|
4572 |
&Date_Split($date));
|
|
|
4573 |
}
|
|
|
4574 |
|
|
|
4575 |
@tmp;
|
|
|
4576 |
}
|
|
|
4577 |
|
|
|
4578 |
sub DateCalc_DateDate {
|
|
|
4579 |
print "DEBUG: DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4580 |
my($D1,$D2,$mode)=@_;
|
|
|
4581 |
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
|
|
4582 |
$mode=0 if (! defined $mode);
|
|
|
4583 |
|
|
|
4584 |
# Exact mode
|
|
|
4585 |
if ($mode==0) {
|
|
|
4586 |
my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split($D1, 1);
|
|
|
4587 |
my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split($D2, 1);
|
|
|
4588 |
my($i,@delta,$d,$delta,$y)=();
|
|
|
4589 |
|
|
|
4590 |
# form the delta for hour/min/sec
|
|
|
4591 |
$delta[4]=$h2-$h1;
|
|
|
4592 |
$delta[5]=$mn2-$mn1;
|
|
|
4593 |
$delta[6]=$s2-$s1;
|
|
|
4594 |
|
|
|
4595 |
# form the delta for yr/mon/day
|
|
|
4596 |
$delta[0]=$delta[1]=0;
|
|
|
4597 |
$d=0;
|
|
|
4598 |
if ($y2>$y1) {
|
|
|
4599 |
$d=&Date_DaysInYear($y1) - &Date_DayOfYear($m1,$d1,$y1);
|
|
|
4600 |
$d+=&Date_DayOfYear($m2,$d2,$y2);
|
|
|
4601 |
for ($y=$y1+1; $y<$y2; $y++) {
|
|
|
4602 |
$d+= &Date_DaysInYear($y);
|
|
|
4603 |
}
|
|
|
4604 |
} elsif ($y2<$y1) {
|
|
|
4605 |
$d=&Date_DaysInYear($y2) - &Date_DayOfYear($m2,$d2,$y2);
|
|
|
4606 |
$d+=&Date_DayOfYear($m1,$d1,$y1);
|
|
|
4607 |
for ($y=$y2+1; $y<$y1; $y++) {
|
|
|
4608 |
$d+= &Date_DaysInYear($y);
|
|
|
4609 |
}
|
|
|
4610 |
$d *= -1;
|
|
|
4611 |
} else {
|
|
|
4612 |
$d=&Date_DayOfYear($m2,$d2,$y2) - &Date_DayOfYear($m1,$d1,$y1);
|
|
|
4613 |
}
|
|
|
4614 |
$delta[2]=0;
|
|
|
4615 |
$delta[3]=$d;
|
|
|
4616 |
|
|
|
4617 |
for ($i=0; $i<7; $i++) {
|
|
|
4618 |
$delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
|
|
|
4619 |
}
|
|
|
4620 |
|
|
|
4621 |
$delta=join(":",@delta);
|
|
|
4622 |
$delta=&Delta_Normalize($delta,0);
|
|
|
4623 |
return $delta;
|
|
|
4624 |
}
|
|
|
4625 |
|
|
|
4626 |
my($date1,$date2)=($D1,$D2);
|
|
|
4627 |
my($tmp,$sign,$err,@tmp)=();
|
|
|
4628 |
|
|
|
4629 |
# make sure both are work days
|
|
|
4630 |
if ($mode==2 || $mode==3) {
|
|
|
4631 |
$date1=&Date_NextWorkDay($date1,0,1);
|
|
|
4632 |
$date2=&Date_NextWorkDay($date2,0,1);
|
|
|
4633 |
}
|
|
|
4634 |
|
|
|
4635 |
# make sure date1 comes before date2
|
|
|
4636 |
if (&Date_Cmp($date1,$date2)>0) {
|
|
|
4637 |
$sign="-";
|
|
|
4638 |
$tmp=$date1;
|
|
|
4639 |
$date1=$date2;
|
|
|
4640 |
$date2=$tmp;
|
|
|
4641 |
} else {
|
|
|
4642 |
$sign="+";
|
|
|
4643 |
}
|
|
|
4644 |
if (&Date_Cmp($date1,$date2)==0) {
|
|
|
4645 |
return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
|
|
|
4646 |
return "+0:0:0:0:0:0:0";
|
|
|
4647 |
}
|
|
|
4648 |
|
|
|
4649 |
my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split($date1, 1);
|
|
|
4650 |
my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split($date2, 1);
|
|
|
4651 |
my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0);
|
|
|
4652 |
|
|
|
4653 |
if ($mode != 3) {
|
|
|
4654 |
|
|
|
4655 |
# Do years
|
|
|
4656 |
$dy=$y2-$y1;
|
|
|
4657 |
$dm=0;
|
|
|
4658 |
if ($dy>0) {
|
|
|
4659 |
$tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0);
|
|
|
4660 |
if (&Date_Cmp($tmp,$date2)>0) {
|
|
|
4661 |
$dy--;
|
|
|
4662 |
$tmp=$date1;
|
|
|
4663 |
$tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0)
|
|
|
4664 |
if ($dy>0);
|
|
|
4665 |
$dm=12;
|
|
|
4666 |
}
|
|
|
4667 |
$date1=$tmp;
|
|
|
4668 |
}
|
|
|
4669 |
|
|
|
4670 |
# Do months
|
|
|
4671 |
$dm+=$m2-$m1;
|
|
|
4672 |
if ($dm>0) {
|
|
|
4673 |
$tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0);
|
|
|
4674 |
if (&Date_Cmp($tmp,$date2)>0) {
|
|
|
4675 |
$dm--;
|
|
|
4676 |
$tmp=$date1;
|
|
|
4677 |
$tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0)
|
|
|
4678 |
if ($dm>0);
|
|
|
4679 |
}
|
|
|
4680 |
$date1=$tmp;
|
|
|
4681 |
}
|
|
|
4682 |
|
|
|
4683 |
# At this point, check to see that we're on a business day again so that
|
|
|
4684 |
# Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month
|
|
|
4685 |
if ($mode==2) {
|
|
|
4686 |
if (! &Date_IsWorkDay($date1,0)) {
|
|
|
4687 |
$date1=&Date_NextWorkDay($date1,0,1);
|
|
|
4688 |
}
|
|
|
4689 |
}
|
|
|
4690 |
}
|
|
|
4691 |
|
|
|
4692 |
# Do days
|
|
|
4693 |
if ($mode==2 || $mode==3) {
|
|
|
4694 |
$dd=0;
|
|
|
4695 |
while (1) {
|
|
|
4696 |
$tmp=&Date_NextWorkDay($date1,1,1);
|
|
|
4697 |
if (&Date_Cmp($tmp,$date2)<=0) {
|
|
|
4698 |
$dd++;
|
|
|
4699 |
$date1=$tmp;
|
|
|
4700 |
} else {
|
|
|
4701 |
last;
|
|
|
4702 |
}
|
|
|
4703 |
}
|
|
|
4704 |
|
|
|
4705 |
} else {
|
|
|
4706 |
($y1,$m1,$d1)=( &Date_Split($date1, 1) )[0..2];
|
|
|
4707 |
$dd=0;
|
|
|
4708 |
# If we're jumping across months, set $d1 to the first of the next month
|
|
|
4709 |
# (or possibly the 0th of next month which is equivalent to the last day
|
|
|
4710 |
# of this month)
|
|
|
4711 |
if ($m1!=$m2) {
|
|
|
4712 |
$d_in_m[2]=29 if (&Date_LeapYear($y1));
|
|
|
4713 |
$dd=$d_in_m[$m1]-$d1+1;
|
|
|
4714 |
$d1=1;
|
|
|
4715 |
$tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
|
|
|
4716 |
if (&Date_Cmp($tmp,$date2)>0) {
|
|
|
4717 |
$dd--;
|
|
|
4718 |
$d1--;
|
|
|
4719 |
$tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
|
|
|
4720 |
}
|
|
|
4721 |
$date1=$tmp;
|
|
|
4722 |
}
|
|
|
4723 |
|
|
|
4724 |
$ddd=0;
|
|
|
4725 |
if ($d1<$d2) {
|
|
|
4726 |
$ddd=$d2-$d1;
|
|
|
4727 |
$tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
|
|
|
4728 |
if (&Date_Cmp($tmp,$date2)>0) {
|
|
|
4729 |
$ddd--;
|
|
|
4730 |
$tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
|
|
|
4731 |
}
|
|
|
4732 |
$date1=$tmp;
|
|
|
4733 |
}
|
|
|
4734 |
$dd+=$ddd;
|
|
|
4735 |
}
|
|
|
4736 |
|
|
|
4737 |
# in business mode, make sure h1 comes before h2 (if not find delta between
|
|
|
4738 |
# now and end of day and move to start of next business day)
|
|
|
4739 |
$d1=( &Date_Split($date1, 1) )[2];
|
|
|
4740 |
$dh=$dmn=$ds=0;
|
|
|
4741 |
if ($mode==2 || $mode==3 and $d1 != $d2) {
|
|
|
4742 |
$tmp=&Date_SetTime($date1,$Cnf{"WorkDayEnd"});
|
|
|
4743 |
$tmp=&DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0")
|
|
|
4744 |
if ($Cnf{"WorkDay24Hr"});
|
|
|
4745 |
$tmp=&DateCalc_DateDate($date1,$tmp,0);
|
|
|
4746 |
($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=&Delta_Split($tmp);
|
|
|
4747 |
$date1=&Date_NextWorkDay($date1,1,0);
|
|
|
4748 |
$date1=&Date_SetTime($date1,$Cnf{"WorkDayBeg"});
|
|
|
4749 |
$d1=( &Date_Split($date1, 1) )[2];
|
|
|
4750 |
confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2);
|
|
|
4751 |
}
|
|
|
4752 |
|
|
|
4753 |
# Hours, minutes, seconds
|
|
|
4754 |
$tmp=&DateCalc_DateDate($date1,$date2,0);
|
|
|
4755 |
@tmp=&Delta_Split($tmp);
|
|
|
4756 |
$dh += $tmp[4];
|
|
|
4757 |
$dmn += $tmp[5];
|
|
|
4758 |
$ds += $tmp[6];
|
|
|
4759 |
|
|
|
4760 |
$tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds";
|
|
|
4761 |
&Delta_Normalize($tmp,$mode);
|
|
|
4762 |
}
|
|
|
4763 |
|
|
|
4764 |
sub DateCalc_DeltaDelta {
|
|
|
4765 |
print "DEBUG: DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4766 |
my($D1,$D2,$mode)=@_;
|
|
|
4767 |
my(@delta1,@delta2,$i,$delta,@delta)=();
|
|
|
4768 |
$mode=0 if (! defined $mode);
|
|
|
4769 |
|
|
|
4770 |
@delta1=&Delta_Split($D1);
|
|
|
4771 |
@delta2=&Delta_Split($D2);
|
|
|
4772 |
for ($i=0; $i<7; $i++) {
|
|
|
4773 |
$delta[$i]=$delta1[$i]+$delta2[$i];
|
|
|
4774 |
$delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
|
|
|
4775 |
}
|
|
|
4776 |
|
|
|
4777 |
$delta=join(":",@delta);
|
|
|
4778 |
$delta=&Delta_Normalize($delta,$mode);
|
|
|
4779 |
return $delta;
|
|
|
4780 |
}
|
|
|
4781 |
|
|
|
4782 |
sub DateCalc_DateDelta {
|
|
|
4783 |
print "DEBUG: DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4784 |
my($D1,$D2,$errref,$mode)=@_;
|
|
|
4785 |
my($date)=();
|
|
|
4786 |
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
|
|
4787 |
my($h1,$m1,$h2,$m2,$len,$hh,$mm)=();
|
|
|
4788 |
$mode=0 if (! defined $mode);
|
|
|
4789 |
|
|
|
4790 |
if ($mode==2 || $mode==3) {
|
|
|
4791 |
$h1=$Curr{"WDBh"};
|
|
|
4792 |
$m1=$Curr{"WDBm"};
|
|
|
4793 |
$h2=$Curr{"WDEh"};
|
|
|
4794 |
$m2=$Curr{"WDEm"};
|
|
|
4795 |
$hh=$h2-$h1;
|
|
|
4796 |
$mm=$m2-$m1;
|
|
|
4797 |
if ($mm<0) {
|
|
|
4798 |
$hh--;
|
|
|
4799 |
$mm+=60;
|
|
|
4800 |
}
|
|
|
4801 |
}
|
|
|
4802 |
|
|
|
4803 |
# Date, delta
|
|
|
4804 |
my($y,$m,$d,$h,$mn,$s)=&Date_Split($D1, 1);
|
|
|
4805 |
my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=&Delta_Split($D2);
|
|
|
4806 |
|
|
|
4807 |
# do the month/year part
|
|
|
4808 |
$y+=$dy;
|
|
|
4809 |
while (length($y)<4) {
|
|
|
4810 |
$y = "0$y";
|
|
|
4811 |
}
|
|
|
4812 |
&ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11
|
|
|
4813 |
$d_in_m[2]=29 if (&Date_LeapYear($y));
|
|
|
4814 |
|
|
|
4815 |
# if we have gone past the last day of a month, move the date back to
|
|
|
4816 |
# the last day of the month
|
|
|
4817 |
if ($d>$d_in_m[$m]) {
|
|
|
4818 |
$d=$d_in_m[$m];
|
|
|
4819 |
}
|
|
|
4820 |
|
|
|
4821 |
# do the week part
|
|
|
4822 |
if ($mode==0 || $mode==1) {
|
|
|
4823 |
$dd += $dw*7;
|
|
|
4824 |
} else {
|
|
|
4825 |
$date=&DateCalc_DateDelta(&Date_Join($y,$m,$d,$h,$mn,$s),
|
|
|
4826 |
"+0:0:$dw:0:0:0:0",0);
|
|
|
4827 |
($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
|
|
|
4828 |
}
|
|
|
4829 |
|
|
|
4830 |
# in business mode, set the day to a work day at this point so the h/mn/s
|
|
|
4831 |
# stuff will work out
|
|
|
4832 |
if ($mode==2 || $mode==3) {
|
|
|
4833 |
$d=$d_in_m[$m] if ($d>$d_in_m[$m]);
|
|
|
4834 |
$date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),0,1);
|
|
|
4835 |
($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
|
|
|
4836 |
}
|
|
|
4837 |
|
|
|
4838 |
# seconds, minutes, hours
|
|
|
4839 |
&ModuloAddition(60,$ds,\$s,\$mn);
|
|
|
4840 |
if ($mode==2 || $mode==3) {
|
|
|
4841 |
while (1) {
|
|
|
4842 |
&ModuloAddition(60,$dmn,\$mn,\$h);
|
|
|
4843 |
$h+= $dh;
|
|
|
4844 |
|
|
|
4845 |
if ($h>$h2 or $h==$h2 && $mn>$m2) {
|
|
|
4846 |
$dh=$h-$h2;
|
|
|
4847 |
$dmn=$mn-$m2;
|
|
|
4848 |
$h=$h1;
|
|
|
4849 |
$mn=$m1;
|
|
|
4850 |
$dd++;
|
|
|
4851 |
|
|
|
4852 |
} elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
|
|
|
4853 |
$dh=$h-$h1;
|
|
|
4854 |
$dmn=$m1-$mn;
|
|
|
4855 |
$h=$h2;
|
|
|
4856 |
$mn=$m2;
|
|
|
4857 |
$dd--;
|
|
|
4858 |
|
|
|
4859 |
} elsif ($h==$h2 && $mn==$m2) {
|
|
|
4860 |
$dd++;
|
|
|
4861 |
$dh=-$hh;
|
|
|
4862 |
$dmn=-$mm;
|
|
|
4863 |
|
|
|
4864 |
} else {
|
|
|
4865 |
last;
|
|
|
4866 |
}
|
|
|
4867 |
}
|
|
|
4868 |
|
|
|
4869 |
} else {
|
|
|
4870 |
&ModuloAddition(60,$dmn,\$mn,\$h);
|
|
|
4871 |
&ModuloAddition(24,$dh,\$h,\$d);
|
|
|
4872 |
}
|
|
|
4873 |
|
|
|
4874 |
# If we have just gone past the last day of the month, we need to make
|
|
|
4875 |
# up for this:
|
|
|
4876 |
if ($d>$d_in_m[$m]) {
|
|
|
4877 |
$dd+= $d-$d_in_m[$m];
|
|
|
4878 |
$d=$d_in_m[$m];
|
|
|
4879 |
}
|
|
|
4880 |
|
|
|
4881 |
# days
|
|
|
4882 |
if ($mode==2 || $mode==3) {
|
|
|
4883 |
if ($dd>=0) {
|
|
|
4884 |
$date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),$dd,1);
|
|
|
4885 |
} else {
|
|
|
4886 |
$date=&Date_PrevWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1);
|
|
|
4887 |
}
|
|
|
4888 |
($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
|
|
|
4889 |
|
|
|
4890 |
} else {
|
|
|
4891 |
$d_in_m[2]=29 if (&Date_LeapYear($y));
|
|
|
4892 |
$d=$d_in_m[$m] if ($d>$d_in_m[$m]);
|
|
|
4893 |
$d += $dd;
|
|
|
4894 |
while ($d<1) {
|
|
|
4895 |
$m--;
|
|
|
4896 |
if ($m==0) {
|
|
|
4897 |
$m=12;
|
|
|
4898 |
$y--;
|
|
|
4899 |
if (&Date_LeapYear($y)) {
|
|
|
4900 |
$d_in_m[2]=29;
|
|
|
4901 |
} else {
|
|
|
4902 |
$d_in_m[2]=28;
|
|
|
4903 |
}
|
|
|
4904 |
}
|
|
|
4905 |
$d += $d_in_m[$m];
|
|
|
4906 |
}
|
|
|
4907 |
while ($d>$d_in_m[$m]) {
|
|
|
4908 |
$d -= $d_in_m[$m];
|
|
|
4909 |
$m++;
|
|
|
4910 |
if ($m==13) {
|
|
|
4911 |
$m=1;
|
|
|
4912 |
$y++;
|
|
|
4913 |
if (&Date_LeapYear($y)) {
|
|
|
4914 |
$d_in_m[2]=29;
|
|
|
4915 |
} else {
|
|
|
4916 |
$d_in_m[2]=28;
|
|
|
4917 |
}
|
|
|
4918 |
}
|
|
|
4919 |
}
|
|
|
4920 |
}
|
|
|
4921 |
|
|
|
4922 |
if ($y<0 or $y>9999) {
|
|
|
4923 |
$$errref=3;
|
|
|
4924 |
return;
|
|
|
4925 |
}
|
|
|
4926 |
&Date_Join($y,$m,$d,$h,$mn,$s);
|
|
|
4927 |
}
|
|
|
4928 |
|
|
|
4929 |
sub Date_UpdateHolidays {
|
|
|
4930 |
print "DEBUG: Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4931 |
my($year)=@_;
|
|
|
4932 |
$Holiday{"year"}=$year;
|
|
|
4933 |
$Holiday{"dates"}{$year}={};
|
|
|
4934 |
|
|
|
4935 |
my($date,$delta,$err)=();
|
|
|
4936 |
my($key,@tmp,$tmp);
|
|
|
4937 |
|
|
|
4938 |
foreach $key (keys %{ $Holiday{"desc"} }) {
|
|
|
4939 |
@tmp=&Recur_Split($key);
|
|
|
4940 |
if (@tmp) {
|
|
|
4941 |
$tmp=&ParseDateString("${year}010100:00:00");
|
|
|
4942 |
($date)=&ParseRecur($key,$tmp,$tmp,($year+1)."-01-01");
|
|
|
4943 |
next if (! $date);
|
|
|
4944 |
|
|
|
4945 |
} elsif ($key =~ /^(.*)([+-].*)$/) {
|
|
|
4946 |
# Date +/- Delta
|
|
|
4947 |
($date,$delta)=($1,$2);
|
|
|
4948 |
$tmp=&ParseDateString("$date $year");
|
|
|
4949 |
if ($tmp) {
|
|
|
4950 |
$date=$tmp;
|
|
|
4951 |
} else {
|
|
|
4952 |
$date=&ParseDateString($date);
|
|
|
4953 |
next if ($date !~ /^$year/);
|
|
|
4954 |
}
|
|
|
4955 |
$date=&DateCalc($date,$delta,\$err,0);
|
|
|
4956 |
|
|
|
4957 |
} else {
|
|
|
4958 |
# Date
|
|
|
4959 |
$date=$key;
|
|
|
4960 |
$tmp=&ParseDateString("$date $year");
|
|
|
4961 |
if ($tmp) {
|
|
|
4962 |
$date=$tmp;
|
|
|
4963 |
} else {
|
|
|
4964 |
$date=&ParseDateString($date);
|
|
|
4965 |
next if ($date !~ /^$year/);
|
|
|
4966 |
}
|
|
|
4967 |
}
|
|
|
4968 |
$Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key};
|
|
|
4969 |
}
|
|
|
4970 |
}
|
|
|
4971 |
|
|
|
4972 |
# This sets a Date::Manip config variable.
|
|
|
4973 |
sub Date_SetConfigVariable {
|
|
|
4974 |
print "DEBUG: Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
4975 |
my($var,$val)=@_;
|
|
|
4976 |
|
|
|
4977 |
# These are most appropriate for command line options instead of in files.
|
|
|
4978 |
$Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i);
|
|
|
4979 |
$Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i);
|
|
|
4980 |
$Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i);
|
|
|
4981 |
&EraseHolidays(), return if ($var =~ /^EraseHolidays$/i);
|
|
|
4982 |
$Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i);
|
|
|
4983 |
$Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i);
|
|
|
4984 |
|
|
|
4985 |
$Curr{"InitLang"}=1,
|
|
|
4986 |
$Cnf{"Language"}=$val, return if ($var =~ /^Language$/i);
|
|
|
4987 |
$Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i);
|
|
|
4988 |
$Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i);
|
|
|
4989 |
$Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i);
|
|
|
4990 |
$Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i);
|
|
|
4991 |
$Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i);
|
|
|
4992 |
$Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i);
|
|
|
4993 |
$Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i);
|
|
|
4994 |
$Cnf{"WorkDayBeg"}=$val,
|
|
|
4995 |
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
|
|
|
4996 |
$Cnf{"WorkDayEnd"}=$val,
|
|
|
4997 |
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i);
|
|
|
4998 |
$Cnf{"WorkDay24Hr"}=$val,
|
|
|
4999 |
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i);
|
|
|
5000 |
$Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i);
|
|
|
5001 |
$Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i);
|
|
|
5002 |
$Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i);
|
|
|
5003 |
$Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i);
|
|
|
5004 |
$Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i);
|
|
|
5005 |
$Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i);
|
|
|
5006 |
$Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i);
|
|
|
5007 |
$Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i);
|
|
|
5008 |
|
|
|
5009 |
confess "ERROR: Unknown configuration variable $var in Date::Manip.\n";
|
|
|
5010 |
}
|
|
|
5011 |
|
|
|
5012 |
sub EraseHolidays {
|
|
|
5013 |
print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5014 |
|
|
|
5015 |
$Cnf{"EraseHolidays"}=0;
|
|
|
5016 |
delete $Holiday{"list"};
|
|
|
5017 |
$Holiday{"list"}={};
|
|
|
5018 |
delete $Holiday{"desc"};
|
|
|
5019 |
$Holiday{"desc"}={};
|
|
|
5020 |
$Holiday{"dates"}={};
|
|
|
5021 |
}
|
|
|
5022 |
|
|
|
5023 |
# This returns a pointer to a list of times and events in the format
|
|
|
5024 |
# [ date, [ events ], date, [ events ], ... ]
|
|
|
5025 |
# where each list of events are events that are in effect at the date
|
|
|
5026 |
# immediately preceding the list.
|
|
|
5027 |
#
|
|
|
5028 |
# This takes either one date or two dates as arguments.
|
|
|
5029 |
sub Events_Calc {
|
|
|
5030 |
print "DEBUG: Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5031 |
|
|
|
5032 |
my($date0,$date1)=@_;
|
|
|
5033 |
|
|
|
5034 |
my($tmp);
|
|
|
5035 |
$date0=&ParseDateString($date0);
|
|
|
5036 |
return undef if (! $date0);
|
|
|
5037 |
if ($date1) {
|
|
|
5038 |
$date1=&ParseDateString($date1);
|
|
|
5039 |
if (&Date_Cmp($date0,$date1)>0) {
|
|
|
5040 |
$tmp=$date1;
|
|
|
5041 |
$date1=$date0;
|
|
|
5042 |
$date0=$tmp;
|
|
|
5043 |
}
|
|
|
5044 |
} else {
|
|
|
5045 |
$date1=&DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1");
|
|
|
5046 |
}
|
|
|
5047 |
|
|
|
5048 |
#
|
|
|
5049 |
# [ d0,d1,del,name ] => [ d0, d1+del )
|
|
|
5050 |
# [ d0,0,del,name ] => [ d0, d0+del )
|
|
|
5051 |
#
|
|
|
5052 |
my(%ret,$d0,$d1,$del,$name,$c0,$c1);
|
|
|
5053 |
my(@tmp)=@{ $Events{"dates"} };
|
|
|
5054 |
DATE: while (@tmp) {
|
|
|
5055 |
($d0,$d1,$del,$name)=splice(@tmp,0,4);
|
|
|
5056 |
$d0=&ParseDateString($d0);
|
|
|
5057 |
$d1=&ParseDateString($d1) if ($d1);
|
|
|
5058 |
$del=&ParseDateDelta($del) if ($del);
|
|
|
5059 |
if ($d1) {
|
|
|
5060 |
if ($del) {
|
|
|
5061 |
$d1=&DateCalc_DateDelta($d1,$del);
|
|
|
5062 |
}
|
|
|
5063 |
} else {
|
|
|
5064 |
$d1=&DateCalc_DateDelta($d0,$del);
|
|
|
5065 |
}
|
|
|
5066 |
if (&Date_Cmp($d0,$d1)>0) {
|
|
|
5067 |
$tmp=$d1;
|
|
|
5068 |
$d1=$d0;
|
|
|
5069 |
$d0=$tmp;
|
|
|
5070 |
}
|
|
|
5071 |
# [ date0,date1 )
|
|
|
5072 |
# [ d0,d1 ) OR [ d0,d1 )
|
|
|
5073 |
next DATE if (&Date_Cmp($d1,$date0)<=0 ||
|
|
|
5074 |
&Date_Cmp($d0,$date1)>=0);
|
|
|
5075 |
# [ date0,date1 )
|
|
|
5076 |
# [ d0,d1 )
|
|
|
5077 |
# [ d0, d1 )
|
|
|
5078 |
if (&Date_Cmp($d0,$date0)<=0) {
|
|
|
5079 |
push @{ $ret{$date0} },$name;
|
|
|
5080 |
push @{ $ret{$d1} },"!$name" if (&Date_Cmp($d1,$date1)<0);
|
|
|
5081 |
next DATE;
|
|
|
5082 |
}
|
|
|
5083 |
# [ date0,date1 )
|
|
|
5084 |
# [ d0,d1 )
|
|
|
5085 |
if (&Date_Cmp($d1,$date1)>=0) {
|
|
|
5086 |
push @{ $ret{$d0} },$name;
|
|
|
5087 |
next DATE;
|
|
|
5088 |
}
|
|
|
5089 |
# [ date0,date1 )
|
|
|
5090 |
# [ d0,d1 )
|
|
|
5091 |
push @{ $ret{$d0} },$name;
|
|
|
5092 |
push @{ $ret{$d1} },"!$name";
|
|
|
5093 |
}
|
|
|
5094 |
|
|
|
5095 |
#
|
|
|
5096 |
# [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
|
|
|
5097 |
#
|
|
|
5098 |
my($rec,$del0,$del1,@d);
|
|
|
5099 |
@tmp=@{ $Events{"recur"} };
|
|
|
5100 |
RECUR: while (@tmp) {
|
|
|
5101 |
($rec,$del0,$del1,$name)=splice(@tmp,0,4);
|
|
|
5102 |
@d=();
|
|
|
5103 |
|
|
|
5104 |
}
|
|
|
5105 |
|
|
|
5106 |
# Sort them AND take into account the "!$name" entries.
|
|
|
5107 |
my(%tmp,$date,@tmp2,@ret);
|
|
|
5108 |
@d=sort { &Date_Cmp($a,$b) } keys %ret;
|
|
|
5109 |
foreach $date (@d) {
|
|
|
5110 |
@tmp=@{ $ret{$date} };
|
|
|
5111 |
@tmp2=();
|
|
|
5112 |
foreach $tmp (@tmp) {
|
|
|
5113 |
push(@tmp2,$tmp), next if ($tmp =~ /^!/);
|
|
|
5114 |
$tmp{$tmp}=1;
|
|
|
5115 |
}
|
|
|
5116 |
foreach $tmp (@tmp2) {
|
|
|
5117 |
$tmp =~ s/^!//;
|
|
|
5118 |
delete $tmp{$tmp};
|
|
|
5119 |
}
|
|
|
5120 |
push(@ret,$date,[ keys %tmp ]);
|
|
|
5121 |
}
|
|
|
5122 |
|
|
|
5123 |
return \@ret;
|
|
|
5124 |
}
|
|
|
5125 |
|
|
|
5126 |
# This parses the raw events list
|
|
|
5127 |
sub Events_ParseRaw {
|
|
|
5128 |
print "DEBUG: Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5129 |
|
|
|
5130 |
# Only need to be parsed once
|
|
|
5131 |
my($force)=@_;
|
|
|
5132 |
$Events{"parsed"}=0 if ($force);
|
|
|
5133 |
return if ($Events{"parsed"});
|
|
|
5134 |
$Events{"parsed"}=1;
|
|
|
5135 |
|
|
|
5136 |
my(@events)=@{ $Events{"raw"} };
|
|
|
5137 |
my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
|
|
|
5138 |
$recur);
|
|
|
5139 |
EVENT: while (@events) {
|
|
|
5140 |
($event,$name)=splice(@events,0,2);
|
|
|
5141 |
@event=split(/\s*;\s*/,$event);
|
|
|
5142 |
|
|
|
5143 |
if ($#event == 0) {
|
|
|
5144 |
|
|
|
5145 |
if ($date0=&ParseDateString($event[0])) {
|
|
|
5146 |
#
|
|
|
5147 |
# date = event
|
|
|
5148 |
#
|
|
|
5149 |
$tmp=&ParseDateString("$event[0] 00:00:00");
|
|
|
5150 |
if ($tmp && $tmp eq $date0) {
|
|
|
5151 |
$delta="+0:0:0:1:0:0:0";
|
|
|
5152 |
} else {
|
|
|
5153 |
$delta="+0:0:0:0:1:0:0";
|
|
|
5154 |
}
|
|
|
5155 |
push @{ $Events{"dates"} },($date0,0,$delta,$name);
|
|
|
5156 |
|
|
|
5157 |
} elsif ($recur=&ParseRecur($event[0])) {
|
|
|
5158 |
#
|
|
|
5159 |
# recur = event
|
|
|
5160 |
#
|
|
|
5161 |
($recur0,$recur1)=&Recur_Split($recur);
|
|
|
5162 |
if ($recur0) {
|
|
|
5163 |
if ($recur1) {
|
|
|
5164 |
$r="$recur0:$recur1";
|
|
|
5165 |
} else {
|
|
|
5166 |
$r=$recur0;
|
|
|
5167 |
}
|
|
|
5168 |
} else {
|
|
|
5169 |
$r=$recur1;
|
|
|
5170 |
}
|
|
|
5171 |
(@recur)=split(/:/,$r);
|
|
|
5172 |
if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
|
|
|
5173 |
$delta="+0:0:0:1:0:0:0";
|
|
|
5174 |
} else {
|
|
|
5175 |
$delta="+0:0:0:0:1:0:0";
|
|
|
5176 |
}
|
|
|
5177 |
push @{ $Events{"recur"} },($recur,0,$delta,$name);
|
|
|
5178 |
|
|
|
5179 |
} else {
|
|
|
5180 |
# ??? = event
|
|
|
5181 |
warn "WARNING: illegal event ignored [ @event ]\n";
|
|
|
5182 |
next EVENT;
|
|
|
5183 |
}
|
|
|
5184 |
|
|
|
5185 |
} elsif ($#event == 1) {
|
|
|
5186 |
|
|
|
5187 |
if ($date0=&ParseDateString($event[0])) {
|
|
|
5188 |
|
|
|
5189 |
if ($date1=&ParseDateString($event[1])) {
|
|
|
5190 |
#
|
|
|
5191 |
# date ; date = event
|
|
|
5192 |
#
|
|
|
5193 |
$tmp=&ParseDateString("$event[1] 00:00:00");
|
|
|
5194 |
if ($tmp && $tmp eq $date1) {
|
|
|
5195 |
$date1=&DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0");
|
|
|
5196 |
}
|
|
|
5197 |
push @{ $Events{"dates"} },($date0,$date1,0,$name);
|
|
|
5198 |
|
|
|
5199 |
} elsif ($delta=&ParseDateDelta($event[1])) {
|
|
|
5200 |
#
|
|
|
5201 |
# date ; delta = event
|
|
|
5202 |
#
|
|
|
5203 |
push @{ $Events{"dates"} },($date0,0,$delta,$name);
|
|
|
5204 |
|
|
|
5205 |
} else {
|
|
|
5206 |
# date ; ??? = event
|
|
|
5207 |
warn "WARNING: illegal event ignored [ @event ]\n";
|
|
|
5208 |
next EVENT;
|
|
|
5209 |
}
|
|
|
5210 |
|
|
|
5211 |
} elsif ($recur=&ParseRecur($event[0])) {
|
|
|
5212 |
|
|
|
5213 |
if ($delta=&ParseDateDelta($event[1])) {
|
|
|
5214 |
#
|
|
|
5215 |
# recur ; delta = event
|
|
|
5216 |
#
|
|
|
5217 |
push @{ $Events{"recur"} },($recur,0,$delta,$name);
|
|
|
5218 |
|
|
|
5219 |
} else {
|
|
|
5220 |
# recur ; ??? = event
|
|
|
5221 |
warn "WARNING: illegal event ignored [ @event ]\n";
|
|
|
5222 |
next EVENT;
|
|
|
5223 |
}
|
|
|
5224 |
|
|
|
5225 |
} else {
|
|
|
5226 |
# ??? ; ??? = event
|
|
|
5227 |
warn "WARNING: illegal event ignored [ @event ]\n";
|
|
|
5228 |
next EVENT;
|
|
|
5229 |
}
|
|
|
5230 |
|
|
|
5231 |
} else {
|
|
|
5232 |
# date ; delta0 ; delta1 = event
|
|
|
5233 |
# recur ; delta0 ; delta1 = event
|
|
|
5234 |
# ??? ; ??? ; ??? ... = event
|
|
|
5235 |
warn "WARNING: illegal event ignored [ @event ]\n";
|
|
|
5236 |
next EVENT;
|
|
|
5237 |
}
|
|
|
5238 |
}
|
|
|
5239 |
}
|
|
|
5240 |
|
|
|
5241 |
# This reads an init file.
|
|
|
5242 |
sub Date_InitFile {
|
|
|
5243 |
print "DEBUG: Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5244 |
my($file)=@_;
|
|
|
5245 |
my($in)=new IO::File;
|
|
|
5246 |
local($_)=();
|
|
|
5247 |
my($section)="vars";
|
|
|
5248 |
my($var,$val,$recur,$name)=();
|
|
|
5249 |
|
|
|
5250 |
$in->open($file) || return;
|
|
|
5251 |
while(defined ($_=<$in>)) {
|
|
|
5252 |
chomp;
|
|
|
5253 |
s/^\s+//;
|
|
|
5254 |
s/\s+$//;
|
|
|
5255 |
next if (! $_ or /^\#/);
|
|
|
5256 |
|
|
|
5257 |
if (/^\*holiday/i) {
|
|
|
5258 |
$section="holiday";
|
|
|
5259 |
&EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
|
|
|
5260 |
next;
|
|
|
5261 |
} elsif (/^\*events/i) {
|
|
|
5262 |
$section="events";
|
|
|
5263 |
next;
|
|
|
5264 |
}
|
|
|
5265 |
|
|
|
5266 |
if ($section =~ /var/i) {
|
|
|
5267 |
confess "ERROR: invalid Date::Manip config file line.\n $_\n"
|
|
|
5268 |
if (! /(.*\S)\s*=\s*(.*)$/);
|
|
|
5269 |
($var,$val)=($1,$2);
|
|
|
5270 |
&Date_SetConfigVariable($var,$val);
|
|
|
5271 |
|
|
|
5272 |
} elsif ($section =~ /holiday/i) {
|
|
|
5273 |
confess "ERROR: invalid Date::Manip config file line.\n $_\n"
|
|
|
5274 |
if (! /(.*\S)\s*=\s*(.*)$/);
|
|
|
5275 |
($recur,$name)=($1,$2);
|
|
|
5276 |
$name="" if (! defined $name);
|
|
|
5277 |
$Holiday{"desc"}{$recur}=$name;
|
|
|
5278 |
|
|
|
5279 |
} elsif ($section =~ /events/i) {
|
|
|
5280 |
confess "ERROR: invalid Date::Manip config file line.\n $_\n"
|
|
|
5281 |
if (! /(.*\S)\s*=\s*(.*)$/);
|
|
|
5282 |
($val,$var)=($1,$2);
|
|
|
5283 |
push @{ $Events{"raw"} },($val,$var);
|
|
|
5284 |
|
|
|
5285 |
} else {
|
|
|
5286 |
# A section not currently used by Date::Manip (but may be
|
|
|
5287 |
# used by some extension to it).
|
|
|
5288 |
next;
|
|
|
5289 |
}
|
|
|
5290 |
}
|
|
|
5291 |
close($in);
|
|
|
5292 |
}
|
|
|
5293 |
|
|
|
5294 |
# $flag=&Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
|
|
|
5295 |
# Returns 1 if any of the fields are bad. All fields are optional, and
|
|
|
5296 |
# all possible checks are done on the data. If a field is not passed in,
|
|
|
5297 |
# it is set to default values. If data is missing, appropriate defaults
|
|
|
5298 |
# are supplied.
|
|
|
5299 |
sub Date_TimeCheck {
|
|
|
5300 |
print "DEBUG: Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5301 |
my($h,$mn,$s,$ampm)=@_;
|
|
|
5302 |
my($tmp1,$tmp2,$tmp3)=();
|
|
|
5303 |
|
|
|
5304 |
$$h="" if (! defined $$h);
|
|
|
5305 |
$$mn="" if (! defined $$mn);
|
|
|
5306 |
$$s="" if (! defined $$s);
|
|
|
5307 |
$$ampm="" if (! defined $$ampm);
|
|
|
5308 |
$$ampm=uc($$ampm) if ($$ampm);
|
|
|
5309 |
|
|
|
5310 |
# Check hour
|
|
|
5311 |
$tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
|
|
|
5312 |
$tmp2="";
|
|
|
5313 |
if ($$ampm =~ /^$tmp1$/i) {
|
|
|
5314 |
$tmp3=$Lang{$Cnf{"Language"}}{"AM"};
|
|
|
5315 |
$tmp2="AM" if ($$ampm =~ /^$tmp3$/i);
|
|
|
5316 |
$tmp3=$Lang{$Cnf{"Language"}}{"PM"};
|
|
|
5317 |
$tmp2="PM" if ($$ampm =~ /^$tmp3$/i);
|
|
|
5318 |
} elsif ($$ampm) {
|
|
|
5319 |
return 1;
|
|
|
5320 |
}
|
|
|
5321 |
if ($tmp2 eq "AM" || $tmp2 eq "PM") {
|
|
|
5322 |
$$h="0$$h" if (length($$h)==1);
|
|
|
5323 |
return 1 if ($$h<1 || $$h>12);
|
|
|
5324 |
$$h="00" if ($tmp2 eq "AM" and $$h==12);
|
|
|
5325 |
$$h += 12 if ($tmp2 eq "PM" and $$h!=12);
|
|
|
5326 |
} else {
|
|
|
5327 |
$$h="00" if ($$h eq "");
|
|
|
5328 |
$$h="0$$h" if (length($$h)==1);
|
|
|
5329 |
return 1 if (! &IsInt($$h,0,23));
|
|
|
5330 |
$tmp2="AM" if ($$h<12);
|
|
|
5331 |
$tmp2="PM" if ($$h>=12);
|
|
|
5332 |
}
|
|
|
5333 |
$$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
|
|
|
5334 |
$$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
|
|
|
5335 |
|
|
|
5336 |
# Check minutes
|
|
|
5337 |
$$mn="00" if ($$mn eq "");
|
|
|
5338 |
$$mn="0$$mn" if (length($$mn)==1);
|
|
|
5339 |
return 1 if (! &IsInt($$mn,0,59));
|
|
|
5340 |
|
|
|
5341 |
# Check seconds
|
|
|
5342 |
$$s="00" if ($$s eq "");
|
|
|
5343 |
$$s="0$$s" if (length($$s)==1);
|
|
|
5344 |
return 1 if (! &IsInt($$s,0,59));
|
|
|
5345 |
|
|
|
5346 |
return 0;
|
|
|
5347 |
}
|
|
|
5348 |
|
|
|
5349 |
# $flag=&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
|
|
|
5350 |
# Returns 1 if any of the fields are bad. All fields are optional, and
|
|
|
5351 |
# all possible checks are done on the data. If a field is not passed in,
|
|
|
5352 |
# it is set to default values. If data is missing, appropriate defaults
|
|
|
5353 |
# are supplied.
|
|
|
5354 |
#
|
|
|
5355 |
# If the flag UpdateHolidays is set, the year is set to
|
|
|
5356 |
# CurrHolidayYear.
|
|
|
5357 |
sub Date_DateCheck {
|
|
|
5358 |
print "DEBUG: Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5359 |
my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_;
|
|
|
5360 |
my($tmp1,$tmp2,$tmp3)=();
|
|
|
5361 |
|
|
|
5362 |
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
|
|
|
5363 |
my($curr_y)=$Curr{"Y"};
|
|
|
5364 |
my($curr_m)=$Curr{"M"};
|
|
|
5365 |
my($curr_d)=$Curr{"D"};
|
|
|
5366 |
$$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d);
|
|
|
5367 |
$$y="" if (! defined $$y);
|
|
|
5368 |
$$m="" if (! defined $$m);
|
|
|
5369 |
$$d="" if (! defined $$d);
|
|
|
5370 |
$$wk="" if (! defined $$wk);
|
|
|
5371 |
$$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq "");
|
|
|
5372 |
|
|
|
5373 |
# Check year.
|
|
|
5374 |
$$y=$curr_y if ($$y eq "");
|
|
|
5375 |
$$y=&Date_FixYear($$y) if (length($$y)<4);
|
|
|
5376 |
return 1 if (! &IsInt($$y,0,9999));
|
|
|
5377 |
$d_in_m[2]=29 if (&Date_LeapYear($$y));
|
|
|
5378 |
|
|
|
5379 |
# Check month
|
|
|
5380 |
$$m=$curr_m if ($$m eq "");
|
|
|
5381 |
$$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}
|
|
|
5382 |
if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)});
|
|
|
5383 |
$$m="0$$m" if (length($$m)==1);
|
|
|
5384 |
return 1 if (! &IsInt($$m,1,12));
|
|
|
5385 |
|
|
|
5386 |
# Check day
|
|
|
5387 |
$$d="01" if ($$d eq "");
|
|
|
5388 |
$$d="0$$d" if (length($$d)==1);
|
|
|
5389 |
return 1 if (! &IsInt($$d,1,$d_in_m[$$m]));
|
|
|
5390 |
if ($$wk) {
|
|
|
5391 |
$tmp1=&Date_DayOfWeek($$m,$$d,$$y);
|
|
|
5392 |
$tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}
|
|
|
5393 |
if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)});
|
|
|
5394 |
return 1 if ($tmp1 != $tmp2);
|
|
|
5395 |
}
|
|
|
5396 |
|
|
|
5397 |
return &Date_TimeCheck($h,$mn,$s,$ampm);
|
|
|
5398 |
}
|
|
|
5399 |
|
|
|
5400 |
# Takes a year in 2 digit form and returns it in 4 digit form
|
|
|
5401 |
sub Date_FixYear {
|
|
|
5402 |
print "DEBUG: Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5403 |
my($y)=@_;
|
|
|
5404 |
my($curr_y)=$Curr{"Y"};
|
|
|
5405 |
$y=$curr_y if (! defined $y or ! $y);
|
|
|
5406 |
return $y if (length($y)==4);
|
|
|
5407 |
confess "ERROR: Invalid year ($y)\n" if (length($y)!=2);
|
|
|
5408 |
my($y1,$y2)=();
|
|
|
5409 |
|
|
|
5410 |
if (lc($Cnf{"YYtoYYYY"}) eq "c") {
|
|
|
5411 |
$y1=substring($y,0,2);
|
|
|
5412 |
$y="$y1$y";
|
|
|
5413 |
|
|
|
5414 |
} elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
|
|
|
5415 |
$y1=$1;
|
|
|
5416 |
$y="$y1$y";
|
|
|
5417 |
|
|
|
5418 |
} elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
|
|
|
5419 |
$y1="$1$2";
|
|
|
5420 |
$y ="$1$y";
|
|
|
5421 |
$y += 100 if ($y<$y1);
|
|
|
5422 |
|
|
|
5423 |
} else {
|
|
|
5424 |
$y1=$curr_y-$Cnf{"YYtoYYYY"};
|
|
|
5425 |
$y2=$y1+99;
|
|
|
5426 |
$y="19$y";
|
|
|
5427 |
while ($y<$y1) {
|
|
|
5428 |
$y+=100;
|
|
|
5429 |
}
|
|
|
5430 |
while ($y>$y2) {
|
|
|
5431 |
$y-=100;
|
|
|
5432 |
}
|
|
|
5433 |
}
|
|
|
5434 |
$y;
|
|
|
5435 |
}
|
|
|
5436 |
|
|
|
5437 |
# &Date_NthWeekOfYear($y,$n);
|
|
|
5438 |
# Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
|
|
|
5439 |
# year.
|
|
|
5440 |
# &Date_NthWeekOfYear($y,$n,$dow,$flag);
|
|
|
5441 |
# Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag
|
|
|
5442 |
# is nil, the first DoW of the year may actually be in the previous
|
|
|
5443 |
# year (since the 1st week may include days from the previous year).
|
|
|
5444 |
# If flag is non-nil, the 1st DoW of the year refers to the 1st one
|
|
|
5445 |
# actually in the year
|
|
|
5446 |
sub Date_NthWeekOfYear {
|
|
|
5447 |
print "DEBUG: Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5448 |
my($y,$n,$dow,$flag)=@_;
|
|
|
5449 |
my($m,$d,$err,$tmp,$date,%dow)=();
|
|
|
5450 |
$y=$Curr{"Y"} if (! defined $y or ! $y);
|
|
|
5451 |
$n=1 if (! defined $n or $n eq "");
|
|
|
5452 |
return () if ($n<0 || $n>53);
|
|
|
5453 |
if (defined $dow) {
|
|
|
5454 |
$dow=lc($dow);
|
|
|
5455 |
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
|
|
|
5456 |
$dow=$dow{$dow} if (exists $dow{$dow});
|
|
|
5457 |
return () if ($dow<1 || $dow>7);
|
|
|
5458 |
$flag="" if (! defined $flag);
|
|
|
5459 |
} else {
|
|
|
5460 |
$dow="";
|
|
|
5461 |
$flag="";
|
|
|
5462 |
}
|
|
|
5463 |
|
|
|
5464 |
$y=&Date_FixYear($y) if (length($y)<4);
|
|
|
5465 |
if ($Cnf{"Jan1Week1"}) {
|
|
|
5466 |
$date=&Date_Join($y,1,1,0,0,0);
|
|
|
5467 |
} else {
|
|
|
5468 |
$date=&Date_Join($y,1,4,0,0,0);
|
|
|
5469 |
}
|
|
|
5470 |
$date=&Date_GetPrev($date,$Cnf{"FirstDay"},1);
|
|
|
5471 |
$date=&Date_GetNext($date,$dow,1) if ($dow ne "");
|
|
|
5472 |
|
|
|
5473 |
if ($flag) {
|
|
|
5474 |
($tmp)=&Date_Split($date, 1);
|
|
|
5475 |
$n++ if ($tmp != $y);
|
|
|
5476 |
}
|
|
|
5477 |
|
|
|
5478 |
if ($n>1) {
|
|
|
5479 |
$date=&DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0);
|
|
|
5480 |
} elsif ($n==0) {
|
|
|
5481 |
$date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0);
|
|
|
5482 |
}
|
|
|
5483 |
($y,$m,$d)=&Date_Split($date, 1);
|
|
|
5484 |
($y,$m,$d);
|
|
|
5485 |
}
|
|
|
5486 |
|
|
|
5487 |
########################################################################
|
|
|
5488 |
# LANGUAGE INITIALIZATION
|
|
|
5489 |
########################################################################
|
|
|
5490 |
|
|
|
5491 |
# 8-bit international characters can be gotten by "\xXX". I don't know
|
|
|
5492 |
# how to get 16-bit characters. I've got to read up on perllocale.
|
|
|
5493 |
sub Char_8Bit {
|
|
|
5494 |
my($hash)=@_;
|
|
|
5495 |
|
|
|
5496 |
# grave `
|
|
|
5497 |
# A` 00c0 a` 00e0
|
|
|
5498 |
# E` 00c8 e` 00e8
|
|
|
5499 |
# I` 00cc i` 00ec
|
|
|
5500 |
# O` 00d2 o` 00f2
|
|
|
5501 |
# U` 00d9 u` 00f9
|
|
|
5502 |
# W` 1e80 w` 1e81
|
|
|
5503 |
# Y` 1ef2 y` 1ef3
|
|
|
5504 |
|
|
|
5505 |
$$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE
|
|
|
5506 |
$$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE
|
|
|
5507 |
$$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE
|
|
|
5508 |
$$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE
|
|
|
5509 |
$$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE
|
|
|
5510 |
$$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE
|
|
|
5511 |
$$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE
|
|
|
5512 |
$$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE
|
|
|
5513 |
$$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE
|
|
|
5514 |
$$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE
|
|
|
5515 |
|
|
|
5516 |
# acute '
|
|
|
5517 |
# A' 00c1 a' 00e1
|
|
|
5518 |
# C' 0106 c' 0107
|
|
|
5519 |
# E' 00c9 e' 00e9
|
|
|
5520 |
# I' 00cd i' 00ed
|
|
|
5521 |
# L' 0139 l' 013a
|
|
|
5522 |
# N' 0143 n' 0144
|
|
|
5523 |
# O' 00d3 o' 00f3
|
|
|
5524 |
# R' 0154 r' 0155
|
|
|
5525 |
# S' 015a s' 015b
|
|
|
5526 |
# U' 00da u' 00fa
|
|
|
5527 |
# W' 1e82 w' 1e83
|
|
|
5528 |
# Y' 00dd y' 00fd
|
|
|
5529 |
# Z' 0179 z' 017a
|
|
|
5530 |
|
|
|
5531 |
$$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE
|
|
|
5532 |
$$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE
|
|
|
5533 |
$$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE
|
|
|
5534 |
$$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE
|
|
|
5535 |
$$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE
|
|
|
5536 |
$$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE
|
|
|
5537 |
$$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE
|
|
|
5538 |
$$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE
|
|
|
5539 |
$$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE
|
|
|
5540 |
$$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE
|
|
|
5541 |
$$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE
|
|
|
5542 |
$$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE
|
|
|
5543 |
|
|
|
5544 |
# double acute " "
|
|
|
5545 |
# O" 0150 o" 0151
|
|
|
5546 |
# U" 0170 u" 0171
|
|
|
5547 |
|
|
|
5548 |
# circumflex ^
|
|
|
5549 |
# A^ 00c2 a^ 00e2
|
|
|
5550 |
# C^ 0108 c^ 0109
|
|
|
5551 |
# E^ 00ca e^ 00ea
|
|
|
5552 |
# G^ 011c g^ 011d
|
|
|
5553 |
# H^ 0124 h^ 0125
|
|
|
5554 |
# I^ 00ce i^ 00ee
|
|
|
5555 |
# J^ 0134 j^ 0135
|
|
|
5556 |
# O^ 00d4 o^ 00f4
|
|
|
5557 |
# S^ 015c s^ 015d
|
|
|
5558 |
# U^ 00db u^ 00fb
|
|
|
5559 |
# W^ 0174 w^ 0175
|
|
|
5560 |
# Y^ 0176 y^ 0177
|
|
|
5561 |
|
|
|
5562 |
$$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
|
|
|
5563 |
$$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
|
|
|
5564 |
$$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
|
|
|
5565 |
$$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
|
|
|
5566 |
$$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
|
|
|
5567 |
$$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX
|
|
|
5568 |
$$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX
|
|
|
5569 |
$$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX
|
|
|
5570 |
$$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX
|
|
|
5571 |
$$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX
|
|
|
5572 |
|
|
|
5573 |
# tilde ~
|
|
|
5574 |
# A~ 00c3 a~ 00e3
|
|
|
5575 |
# I~ 0128 i~ 0129
|
|
|
5576 |
# N~ 00d1 n~ 00f1
|
|
|
5577 |
# O~ 00d5 o~ 00f5
|
|
|
5578 |
# U~ 0168 u~ 0169
|
|
|
5579 |
|
|
|
5580 |
$$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE
|
|
|
5581 |
$$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE
|
|
|
5582 |
$$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE
|
|
|
5583 |
$$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE
|
|
|
5584 |
$$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE
|
|
|
5585 |
$$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE
|
|
|
5586 |
|
|
|
5587 |
# macron -
|
|
|
5588 |
# A- 0100 a- 0101
|
|
|
5589 |
# E- 0112 e- 0113
|
|
|
5590 |
# I- 012a i- 012b
|
|
|
5591 |
# O- 014c o- 014d
|
|
|
5592 |
# U- 016a u- 016b
|
|
|
5593 |
|
|
|
5594 |
# breve ( [half circle up]
|
|
|
5595 |
# A( 0102 a( 0103
|
|
|
5596 |
# G( 011e g( 011f
|
|
|
5597 |
# U( 016c u( 016d
|
|
|
5598 |
|
|
|
5599 |
# dot .
|
|
|
5600 |
# C. 010a c. 010b
|
|
|
5601 |
# E. 0116 e. 0117
|
|
|
5602 |
# G. 0120 g. 0121
|
|
|
5603 |
# I. 0130
|
|
|
5604 |
# Z. 017b z. 017c
|
|
|
5605 |
|
|
|
5606 |
# diaeresis : [side by side dots]
|
|
|
5607 |
# A: 00c4 a: 00e4
|
|
|
5608 |
# E: 00cb e: 00eb
|
|
|
5609 |
# I: 00cf i: 00ef
|
|
|
5610 |
# O: 00d6 o: 00f6
|
|
|
5611 |
# U: 00dc u: 00fc
|
|
|
5612 |
# W: 1e84 w: 1e85
|
|
|
5613 |
# Y: 0178 y: 00ff
|
|
|
5614 |
|
|
|
5615 |
$$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS
|
|
|
5616 |
$$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS
|
|
|
5617 |
$$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS
|
|
|
5618 |
$$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS
|
|
|
5619 |
$$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS
|
|
|
5620 |
$$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS
|
|
|
5621 |
$$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS
|
|
|
5622 |
$$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS
|
|
|
5623 |
$$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS
|
|
|
5624 |
$$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS
|
|
|
5625 |
$$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS
|
|
|
5626 |
|
|
|
5627 |
# ring o
|
|
|
5628 |
# U0 016e u0 016f
|
|
|
5629 |
|
|
|
5630 |
# cedilla , [squiggle down and left below the letter]
|
|
|
5631 |
# ,C 00c7 ,c 00e7
|
|
|
5632 |
# ,G 0122 ,g 0123
|
|
|
5633 |
# ,K 0136 ,k 0137
|
|
|
5634 |
# ,L 013b ,l 013c
|
|
|
5635 |
# ,N 0145 ,n 0146
|
|
|
5636 |
# ,R 0156 ,r 0157
|
|
|
5637 |
# ,S 015e ,s 015f
|
|
|
5638 |
# ,T 0162 ,t 0163
|
|
|
5639 |
|
|
|
5640 |
$$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA
|
|
|
5641 |
$$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA
|
|
|
5642 |
|
|
|
5643 |
# ogonek ; [squiggle down and right below the letter]
|
|
|
5644 |
# A; 0104 a; 0105
|
|
|
5645 |
# E; 0118 e; 0119
|
|
|
5646 |
# I; 012e i; 012f
|
|
|
5647 |
# U; 0172 u; 0173
|
|
|
5648 |
|
|
|
5649 |
# caron < [little v on top]
|
|
|
5650 |
# A< 01cd a< 01ce
|
|
|
5651 |
# C< 010c c< 010d
|
|
|
5652 |
# D< 010e d< 010f
|
|
|
5653 |
# E< 011a e< 011b
|
|
|
5654 |
# L< 013d l< 013e
|
|
|
5655 |
# N< 0147 n< 0148
|
|
|
5656 |
# R< 0158 r< 0159
|
|
|
5657 |
# S< 0160 s< 0161
|
|
|
5658 |
# T< 0164 t< 0165
|
|
|
5659 |
# Z< 017d z< 017e
|
|
|
5660 |
|
|
|
5661 |
|
|
|
5662 |
# Other characters
|
|
|
5663 |
|
|
|
5664 |
# First character is below, 2nd character is above
|
|
|
5665 |
$$hash{"||"} = "\xa6"; # BROKEN BAR
|
|
|
5666 |
$$hash{" :"} = "\xa8"; # DIAERESIS
|
|
|
5667 |
$$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR
|
|
|
5668 |
#$$hash{" -"}= "\xaf"; # MACRON (narrow bar)
|
|
|
5669 |
$$hash{" -"} = "\xad"; # HYPHEN (wide bar)
|
|
|
5670 |
$$hash{" o"} = "\xb0"; # DEGREE SIGN
|
|
|
5671 |
$$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN
|
|
|
5672 |
$$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE
|
|
|
5673 |
$$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO
|
|
|
5674 |
$$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE
|
|
|
5675 |
$$hash{" '"} = "\xb4"; # ACUTE ACCENT
|
|
|
5676 |
$$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR
|
|
|
5677 |
$$hash{" ."} = "\xb7"; # MIDDLE DOT
|
|
|
5678 |
$$hash{", "} = "\xb8"; # CEDILLA
|
|
|
5679 |
$$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE
|
|
|
5680 |
$$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE
|
|
|
5681 |
$$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH
|
|
|
5682 |
|
|
|
5683 |
# upside down characters
|
|
|
5684 |
|
|
|
5685 |
$$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
|
|
|
5686 |
$$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
|
|
|
5687 |
|
|
|
5688 |
# overlay characters
|
|
|
5689 |
|
|
|
5690 |
$$hash{"X o"} = "\xa4"; # CURRENCY SIGN
|
|
|
5691 |
$$hash{"Y ="} = "\xa5"; # YEN SIGN
|
|
|
5692 |
$$hash{"S o"} = "\xa7"; # SECTION SIGN
|
|
|
5693 |
$$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright
|
|
|
5694 |
$$hash{"O R"} = "\xae"; # REGISTERED SIGN
|
|
|
5695 |
$$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH
|
|
|
5696 |
$$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE
|
|
|
5697 |
$$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE
|
|
|
5698 |
|
|
|
5699 |
# special names
|
|
|
5700 |
|
|
|
5701 |
$$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER
|
|
|
5702 |
$$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF
|
|
|
5703 |
$$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS
|
|
|
5704 |
$$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK
|
|
|
5705 |
$$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK
|
|
|
5706 |
$$hash{"cent"}= "\xa2"; # CENT SIGN
|
|
|
5707 |
$$hash{"lb"} = "\xa3"; # POUND SIGN
|
|
|
5708 |
$$hash{"mu"} = "\xb5"; # MICRO SIGN
|
|
|
5709 |
$$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S
|
|
|
5710 |
$$hash{"para"}= "\xb6"; # PILCROW SIGN
|
|
|
5711 |
$$hash{"-|"} = "\xac"; # NOT SIGN
|
|
|
5712 |
$$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE
|
|
|
5713 |
$$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE
|
|
|
5714 |
$$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN
|
|
|
5715 |
$$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN
|
|
|
5716 |
$$hash{"/"} = "\xf7"; # DIVISION SIGN
|
|
|
5717 |
$$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN
|
|
|
5718 |
}
|
|
|
5719 |
|
|
|
5720 |
# $hashref = &Date_Init_LANGUAGE;
|
|
|
5721 |
# This returns a hash containing all of the initialization for a
|
|
|
5722 |
# specific language. The hash elements are:
|
|
|
5723 |
#
|
|
|
5724 |
# @ month_name full month names January February ...
|
|
|
5725 |
# @ month_abb month abbreviations Jan Feb ...
|
|
|
5726 |
# @ day_name day names Monday Tuesday ...
|
|
|
5727 |
# @ day_abb day abbreviations Mon Tue ...
|
|
|
5728 |
# @ day_char day character abbrevs M T ...
|
|
|
5729 |
# @ am AM notations
|
|
|
5730 |
# @ pm PM notations
|
|
|
5731 |
#
|
|
|
5732 |
# @ num_suff number with suffix 1st 2nd ...
|
|
|
5733 |
# @ num_word numbers spelled out first second ...
|
|
|
5734 |
#
|
|
|
5735 |
# $ now words which mean now now today ...
|
|
|
5736 |
# $ last words which mean last last final ...
|
|
|
5737 |
# $ each words which mean each each every ...
|
|
|
5738 |
# $ of of (as in a member of) in of ...
|
|
|
5739 |
# ex. 4th day OF June
|
|
|
5740 |
# $ at at 4:00 at
|
|
|
5741 |
# $ on on Sunday on
|
|
|
5742 |
# $ future in the future in
|
|
|
5743 |
# $ past in the past ago
|
|
|
5744 |
# $ next next item next
|
|
|
5745 |
# $ prev previous item last previous
|
|
|
5746 |
# $ later 2 hours later
|
|
|
5747 |
#
|
|
|
5748 |
# % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 }
|
|
|
5749 |
# % times a hash of times { noon->12:00:00 ... }
|
|
|
5750 |
#
|
|
|
5751 |
# $ years words for year y yr year ...
|
|
|
5752 |
# $ months words for month
|
|
|
5753 |
# $ weeks words for week
|
|
|
5754 |
# $ days words for day
|
|
|
5755 |
# $ hours words for hour
|
|
|
5756 |
# $ minutes words for minute
|
|
|
5757 |
# $ seconds words for second
|
|
|
5758 |
# % replace
|
|
|
5759 |
# The replace element is quite important, but a bit tricky. In
|
|
|
5760 |
# English (and probably other languages), one of the abbreviations
|
|
|
5761 |
# for the word month that would be nice is "m". The problem is that
|
|
|
5762 |
# "m" matches the "m" in "minute" which causes the string to be
|
|
|
5763 |
# improperly matched in some cases. Hence, the list of abbreviations
|
|
|
5764 |
# for month is given as:
|
|
|
5765 |
# "mon month months"
|
|
|
5766 |
# In order to allow you to enter "m", replacements can be done.
|
|
|
5767 |
# $replace is a list of pairs of words which are matched and replaced
|
|
|
5768 |
# AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that
|
|
|
5769 |
# the entire word "m" will be replaced with "month". This allows the
|
|
|
5770 |
# desired abbreviation to be used. Make sure that replace contains
|
|
|
5771 |
# an even number of words (i.e. all must be pairs). Any time a
|
|
|
5772 |
# desired abbreviation matches the start of any other, it has to go
|
|
|
5773 |
# here.
|
|
|
5774 |
#
|
|
|
5775 |
# $ exact exact mode exactly
|
|
|
5776 |
# $ approx approximate mode approximately
|
|
|
5777 |
# $ business business mode business
|
|
|
5778 |
#
|
|
|
5779 |
# r sephm hour/minute separator (?::)
|
|
|
5780 |
# r sepms minute/second separator (?::)
|
|
|
5781 |
# r sepss second/fraction separator (?:[.:])
|
|
|
5782 |
#
|
|
|
5783 |
# Elements marked with an asterix (@) are returned as a set of lists.
|
|
|
5784 |
# Each list contains the strings for each element. The first set is used
|
|
|
5785 |
# when the 7-bit ASCII (US) character set is wanted. The 2nd set is used
|
|
|
5786 |
# when an international character set is available. Both of the 1st two
|
|
|
5787 |
# sets should be complete (but the 2nd list can be left empty to force the
|
|
|
5788 |
# first set to be used always). The 3rd set and later can be partial sets
|
|
|
5789 |
# if desired.
|
|
|
5790 |
#
|
|
|
5791 |
# Elements marked with a dollar ($) are returned as a simple list of words.
|
|
|
5792 |
#
|
|
|
5793 |
# Elements marked with a percent (%) are returned as a hash list.
|
|
|
5794 |
#
|
|
|
5795 |
# Elements marked with (r) are regular expression elements which must not
|
|
|
5796 |
# create a back reference.
|
|
|
5797 |
#
|
|
|
5798 |
# ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in
|
|
|
5799 |
# every language.
|
|
|
5800 |
|
|
|
5801 |
sub Date_Init_English {
|
|
|
5802 |
print "DEBUG: Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5803 |
my($d)=@_;
|
|
|
5804 |
|
|
|
5805 |
$$d{"month_name"}=
|
|
|
5806 |
[["January","February","March","April","May","June",
|
|
|
5807 |
"July","August","September","October","November","December"]];
|
|
|
5808 |
|
|
|
5809 |
$$d{"month_abb"}=
|
|
|
5810 |
[["Jan","Feb","Mar","Apr","May","Jun",
|
|
|
5811 |
"Jul","Aug","Sep","Oct","Nov","Dec"],
|
|
|
5812 |
[],
|
|
|
5813 |
["","","","","","","","","Sept"]];
|
|
|
5814 |
|
|
|
5815 |
$$d{"day_name"}=
|
|
|
5816 |
[["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
|
|
|
5817 |
$$d{"day_abb"}=
|
|
|
5818 |
[["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
|
|
|
5819 |
["", "Tues","", "Thur","", "", ""]];
|
|
|
5820 |
$$d{"day_char"}=
|
|
|
5821 |
[["M","T","W","Th","F","Sa","S"]];
|
|
|
5822 |
|
|
|
5823 |
$$d{"num_suff"}=
|
|
|
5824 |
[["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th",
|
|
|
5825 |
"11th","12th","13th","14th","15th","16th","17th","18th","19th","20th",
|
|
|
5826 |
"21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th",
|
|
|
5827 |
"31st"]];
|
|
|
5828 |
$$d{"num_word"}=
|
|
|
5829 |
[["first","second","third","fourth","fifth","sixth","seventh","eighth",
|
|
|
5830 |
"ninth","tenth","eleventh","twelfth","thirteenth","fourteenth",
|
|
|
5831 |
"fifteenth","sixteenth","seventeenth","eighteenth","nineteenth",
|
|
|
5832 |
"twentieth","twenty-first","twenty-second","twenty-third",
|
|
|
5833 |
"twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh",
|
|
|
5834 |
"twenty-eighth","twenty-ninth","thirtieth","thirty-first"]];
|
|
|
5835 |
|
|
|
5836 |
$$d{"now"} =["today","now"];
|
|
|
5837 |
$$d{"last"} =["last","final"];
|
|
|
5838 |
$$d{"each"} =["each","every"];
|
|
|
5839 |
$$d{"of"} =["in","of"];
|
|
|
5840 |
$$d{"at"} =["at"];
|
|
|
5841 |
$$d{"on"} =["on"];
|
|
|
5842 |
$$d{"future"} =["in"];
|
|
|
5843 |
$$d{"past"} =["ago"];
|
|
|
5844 |
$$d{"next"} =["next"];
|
|
|
5845 |
$$d{"prev"} =["previous","last"];
|
|
|
5846 |
$$d{"later"} =["later"];
|
|
|
5847 |
|
|
|
5848 |
$$d{"exact"} =["exactly"];
|
|
|
5849 |
$$d{"approx"} =["approximately"];
|
|
|
5850 |
$$d{"business"}=["business"];
|
|
|
5851 |
|
|
|
5852 |
$$d{"offset"} =["yesterday","-0:0:0:1:0:0:0","tomorrow","+0:0:0:1:0:0:0"];
|
|
|
5853 |
$$d{"times"} =["noon","12:00:00","midnight","00:00:00"];
|
|
|
5854 |
|
|
|
5855 |
$$d{"years"} =["y","yr","year","yrs","years"];
|
|
|
5856 |
$$d{"months"} =["mon","month","months"];
|
|
|
5857 |
$$d{"weeks"} =["w","wk","wks","week","weeks"];
|
|
|
5858 |
$$d{"days"} =["d","day","days"];
|
|
|
5859 |
$$d{"hours"} =["h","hr","hrs","hour","hours"];
|
|
|
5860 |
$$d{"minutes"} =["mn","min","minute","minutes"];
|
|
|
5861 |
$$d{"seconds"} =["s","sec","second","seconds"];
|
|
|
5862 |
$$d{"replace"} =["m","month"];
|
|
|
5863 |
|
|
|
5864 |
$$d{"sephm"} =':';
|
|
|
5865 |
$$d{"sepms"} =':';
|
|
|
5866 |
$$d{"sepss"} ='[.:]';
|
|
|
5867 |
|
|
|
5868 |
$$d{"am"} = ["AM","A.M."];
|
|
|
5869 |
$$d{"pm"} = ["PM","P.M."];
|
|
|
5870 |
}
|
|
|
5871 |
|
|
|
5872 |
sub Date_Init_Italian {
|
|
|
5873 |
print "DEBUG: Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5874 |
my($d)=@_;
|
|
|
5875 |
my(%h)=();
|
|
|
5876 |
&Char_8Bit(\%h);
|
|
|
5877 |
my($i)=$h{"i'"};
|
|
|
5878 |
|
|
|
5879 |
$$d{"month_name"}=
|
|
|
5880 |
[[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
|
|
|
5881 |
Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
|
|
|
5882 |
|
|
|
5883 |
$$d{"month_abb"}=
|
|
|
5884 |
[[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
|
|
|
5885 |
|
|
|
5886 |
$$d{"day_name"}=
|
|
|
5887 |
[[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
|
|
|
5888 |
[qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
|
|
|
5889 |
$$d{"day_abb"}=
|
|
|
5890 |
[[qw(Lun Mar Mer Gio Ven Sab Dom)]];
|
|
|
5891 |
$$d{"day_char"}=
|
|
|
5892 |
[[qw(L Ma Me G V S D)]];
|
|
|
5893 |
|
|
|
5894 |
$$d{"num_suff"}=
|
|
|
5895 |
[[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo
|
|
|
5896 |
16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo
|
|
|
5897 |
29mo 3mo 31mo)]];
|
|
|
5898 |
$$d{"num_word"}=
|
|
|
5899 |
[[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo
|
|
|
5900 |
undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo
|
|
|
5901 |
sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo
|
|
|
5902 |
ventunesimo ventiduesimo ventitreesimo ventiquattresimo
|
|
|
5903 |
venticinquesimo ventiseiesimo ventisettesimo ventottesimo
|
|
|
5904 |
ventinovesimo trentesimo trentunesimo)]];
|
|
|
5905 |
|
|
|
5906 |
$$d{"now"} =[qw(adesso oggi)];
|
|
|
5907 |
$$d{"last"} =[qw(ultimo)];
|
|
|
5908 |
$$d{"each"} =[qw(ogni)];
|
|
|
5909 |
$$d{"of"} =[qw(della del)];
|
|
|
5910 |
$$d{"at"} =[qw(alle)];
|
|
|
5911 |
$$d{"on"} =[qw(di)];
|
|
|
5912 |
$$d{"future"} =[qw(fra)];
|
|
|
5913 |
$$d{"past"} =[qw(fa)];
|
|
|
5914 |
$$d{"next"} =[qw(prossimo)];
|
|
|
5915 |
$$d{"prev"} =[qw(ultimo)];
|
|
|
5916 |
$$d{"later"} =[qw(dopo)];
|
|
|
5917 |
|
|
|
5918 |
$$d{"exact"} =[qw(esattamente)];
|
|
|
5919 |
$$d{"approx"} =[qw(circa)];
|
|
|
5920 |
$$d{"business"}=[qw(lavorativi lavorativo)];
|
|
|
5921 |
|
|
|
5922 |
$$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)];
|
|
|
5923 |
$$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)];
|
|
|
5924 |
|
|
|
5925 |
$$d{"years"} =[qw(anni anno a)];
|
|
|
5926 |
$$d{"months"} =[qw(mesi mese mes)];
|
|
|
5927 |
$$d{"weeks"} =[qw(settimane settimana sett)];
|
|
|
5928 |
$$d{"days"} =[qw(giorni giorno g)];
|
|
|
5929 |
$$d{"hours"} =[qw(ore ora h)];
|
|
|
5930 |
$$d{"minutes"} =[qw(minuti minuto min)];
|
|
|
5931 |
$$d{"seconds"} =[qw(secondi secondo sec)];
|
|
|
5932 |
$$d{"replace"} =[qw(s sec m mes)];
|
|
|
5933 |
|
|
|
5934 |
$$d{"sephm"} =':';
|
|
|
5935 |
$$d{"sepms"} =':';
|
|
|
5936 |
$$d{"sepss"} ='[.:]';
|
|
|
5937 |
|
|
|
5938 |
$$d{"am"} = [qw(AM)];
|
|
|
5939 |
$$d{"pm"} = [qw(PM)];
|
|
|
5940 |
}
|
|
|
5941 |
|
|
|
5942 |
sub Date_Init_French {
|
|
|
5943 |
print "DEBUG: Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
5944 |
my($d)=@_;
|
|
|
5945 |
my(%h)=();
|
|
|
5946 |
&Char_8Bit(\%h);
|
|
|
5947 |
my($e)=$h{"e'"};
|
|
|
5948 |
my($u)=$h{"u^"};
|
|
|
5949 |
my($a)=$h{"a'"};
|
|
|
5950 |
|
|
|
5951 |
$$d{"month_name"}=
|
|
|
5952 |
[["janvier","fevrier","mars","avril","mai","juin",
|
|
|
5953 |
"juillet","aout","septembre","octobre","novembre","decembre"],
|
|
|
5954 |
["janvier","f${e}vrier","mars","avril","mai","juin",
|
|
|
5955 |
"juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]];
|
|
|
5956 |
$$d{"month_abb"}=
|
|
|
5957 |
[["jan","fev","mar","avr","mai","juin",
|
|
|
5958 |
"juil","aout","sept","oct","nov","dec"],
|
|
|
5959 |
["jan","f${e}v","mar","avr","mai","juin",
|
|
|
5960 |
"juil","ao${u}t","sept","oct","nov","d${e}c"]];
|
|
|
5961 |
|
|
|
5962 |
$$d{"day_name"}=
|
|
|
5963 |
[["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
|
|
|
5964 |
$$d{"day_abb"}=
|
|
|
5965 |
[["lun","mar","mer","jeu","ven","sam","dim"]];
|
|
|
5966 |
$$d{"day_char"}=
|
|
|
5967 |
[["l","ma","me","j","v","s","d"]];
|
|
|
5968 |
|
|
|
5969 |
$$d{"num_suff"}=
|
|
|
5970 |
[["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e",
|
|
|
5971 |
"11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
|
|
|
5972 |
"21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
|
|
|
5973 |
"31e"]];
|
|
|
5974 |
$$d{"num_word"}=
|
|
|
5975 |
[["premier","deux","trois","quatre","cinq","six","sept","huit","neuf",
|
|
|
5976 |
"dix","onze","douze","treize","quatorze","quinze","seize","dix-sept",
|
|
|
5977 |
"dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois",
|
|
|
5978 |
"vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit",
|
|
|
5979 |
"vingt-neuf","trente","trente et un"],
|
|
|
5980 |
["1re"]];
|
|
|
5981 |
|
|
|
5982 |
$$d{"now"} =["aujourd'hui","maintenant"];
|
|
|
5983 |
$$d{"last"} =["dernier"];
|
|
|
5984 |
$$d{"each"} =["chaque","tous les","toutes les"];
|
|
|
5985 |
$$d{"of"} =["en","de"];
|
|
|
5986 |
$$d{"at"} =["a","${a}0"];
|
|
|
5987 |
$$d{"on"} =["sur"];
|
|
|
5988 |
$$d{"future"} =["en"];
|
|
|
5989 |
$$d{"past"} =["il y a"];
|
|
|
5990 |
$$d{"next"} =["suivant"];
|
|
|
5991 |
$$d{"prev"} =["precedent","pr${e}c${e}dent"];
|
|
|
5992 |
$$d{"later"} =["plus tard"];
|
|
|
5993 |
|
|
|
5994 |
$$d{"exact"} =["exactement"];
|
|
|
5995 |
$$d{"approx"} =["approximativement"];
|
|
|
5996 |
$$d{"business"}=["professionel"];
|
|
|
5997 |
|
|
|
5998 |
$$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"];
|
|
|
5999 |
$$d{"times"} =["midi","12:00:00","minuit","00:00:00"];
|
|
|
6000 |
|
|
|
6001 |
$$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"];
|
|
|
6002 |
$$d{"months"} =["mois"];
|
|
|
6003 |
$$d{"weeks"} =["sem","semaine"];
|
|
|
6004 |
$$d{"days"} =["j","jour","jours"];
|
|
|
6005 |
$$d{"hours"} =["h","heure","heures"];
|
|
|
6006 |
$$d{"minutes"} =["mn","min","minute","minutes"];
|
|
|
6007 |
$$d{"seconds"} =["s","sec","seconde","secondes"];
|
|
|
6008 |
$$d{"replace"} =["m","mois"];
|
|
|
6009 |
|
|
|
6010 |
$$d{"sephm"} ='[h:]';
|
|
|
6011 |
$$d{"sepms"} =':';
|
|
|
6012 |
$$d{"sepss"} ='[.:,]';
|
|
|
6013 |
|
|
|
6014 |
$$d{"am"} = ["du matin"];
|
|
|
6015 |
$$d{"pm"} = ["du soir"];
|
|
|
6016 |
}
|
|
|
6017 |
|
|
|
6018 |
sub Date_Init_Romanian {
|
|
|
6019 |
print "DEBUG: Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6020 |
my($d)=@_;
|
|
|
6021 |
my(%h)=();
|
|
|
6022 |
&Char_8Bit(\%h);
|
|
|
6023 |
my($p)=$h{"p"};
|
|
|
6024 |
my($i)=$h{"i^"};
|
|
|
6025 |
my($a)=$h{"a~"};
|
|
|
6026 |
my($o)=$h{"-o"};
|
|
|
6027 |
|
|
|
6028 |
$$d{"month_name"}=
|
|
|
6029 |
[["ianuarie","februarie","martie","aprilie","mai","iunie",
|
|
|
6030 |
"iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
|
|
|
6031 |
$$d{"month_abb"}=
|
|
|
6032 |
[["ian","febr","mart","apr","mai","iun",
|
|
|
6033 |
"iul","aug","sept","oct","nov","dec"],
|
|
|
6034 |
["","feb"]];
|
|
|
6035 |
|
|
|
6036 |
$$d{"day_name"}=
|
|
|
6037 |
[["luni","marti","miercuri","joi","vineri","simbata","duminica"],
|
|
|
6038 |
["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
|
|
|
6039 |
"duminic${a}"]];
|
|
|
6040 |
$$d{"day_abb"}=
|
|
|
6041 |
[["lun","mar","mie","joi","vin","sim","dum"],
|
|
|
6042 |
["lun","mar","mie","joi","vin","s${i}m","dum"]];
|
|
|
6043 |
$$d{"day_char"}=
|
|
|
6044 |
[["L","Ma","Mi","J","V","S","D"]];
|
|
|
6045 |
|
|
|
6046 |
$$d{"num_suff"}=
|
|
|
6047 |
[["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a",
|
|
|
6048 |
"a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a",
|
|
|
6049 |
"a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a",
|
|
|
6050 |
"a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a",
|
|
|
6051 |
"a 30-a","a 31-a"]];
|
|
|
6052 |
|
|
|
6053 |
$$d{"num_word"}=
|
|
|
6054 |
[["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea",
|
|
|
6055 |
"a opta","a noua","a zecea","a unsprezecea","a doisprezecea",
|
|
|
6056 |
"a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea",
|
|
|
6057 |
"a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea",
|
|
|
6058 |
"a douazecisiuna","a douazecisidoua","a douazecisitreia",
|
|
|
6059 |
"a douazecisipatra","a douazecisicincea","a douazecisisasea",
|
|
|
6060 |
"a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea",
|
|
|
6061 |
"a treizecisiuna"],
|
|
|
6062 |
["prima","a doua","a treia","a patra","a cincea","a ${o}asea",
|
|
|
6063 |
"a ${o}aptea","a opta","a noua","a zecea","a unsprezecea",
|
|
|
6064 |
"a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea",
|
|
|
6065 |
"a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea",
|
|
|
6066 |
"a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna",
|
|
|
6067 |
"a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia",
|
|
|
6068 |
"a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea",
|
|
|
6069 |
"a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea",
|
|
|
6070 |
"a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea",
|
|
|
6071 |
"a treizeci${o}iuna"],
|
|
|
6072 |
["intii", "doi", "trei", "patru", "cinci", "sase", "sapte",
|
|
|
6073 |
"opt","noua","zece","unsprezece","doisprezece",
|
|
|
6074 |
"treisprezece","patrusprezece","cincisprezece","saiprezece",
|
|
|
6075 |
"saptesprezece","optsprezece","nouasprezece","douazeci",
|
|
|
6076 |
"douazecisiunu","douazecisidoi","douazecisitrei",
|
|
|
6077 |
"douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte",
|
|
|
6078 |
"douazecisiopt","douazecisinoua","treizeci","treizecisiunu"],
|
|
|
6079 |
["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte",
|
|
|
6080 |
"opt","nou${a}","zece","unsprezece","doisprezece",
|
|
|
6081 |
"treisprezece","patrusprezece","cincisprezece","${o}aiprezece",
|
|
|
6082 |
"${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci",
|
|
|
6083 |
"dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei",
|
|
|
6084 |
"dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase",
|
|
|
6085 |
"dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt",
|
|
|
6086 |
"dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]];
|
|
|
6087 |
|
|
|
6088 |
$$d{"now"} =["acum","azi","astazi","ast${a}zi"];
|
|
|
6089 |
$$d{"last"} =["ultima"];
|
|
|
6090 |
$$d{"each"} =["fiecare"];
|
|
|
6091 |
$$d{"of"} =["din","in","n"];
|
|
|
6092 |
$$d{"at"} =["la"];
|
|
|
6093 |
$$d{"on"} =["on"];
|
|
|
6094 |
$$d{"future"} =["in","${i}n"];
|
|
|
6095 |
$$d{"past"} =["in urma", "${i}n urm${a}"];
|
|
|
6096 |
$$d{"next"} =["urmatoarea","urm${a}toarea"];
|
|
|
6097 |
$$d{"prev"} =["precedenta","ultima"];
|
|
|
6098 |
$$d{"later"} =["mai tirziu", "mai t${i}rziu"];
|
|
|
6099 |
|
|
|
6100 |
$$d{"exact"} =["exact"];
|
|
|
6101 |
$$d{"approx"} =["aproximativ"];
|
|
|
6102 |
$$d{"business"}=["de lucru","lucratoare","lucr${a}toare"];
|
|
|
6103 |
|
|
|
6104 |
$$d{"offset"} =["ieri","-0:0:0:1:0:0:0",
|
|
|
6105 |
"alaltaieri", "-0:0:0:2:0:0:0",
|
|
|
6106 |
"alalt${a}ieri","-0:0:0:2:0:0:0",
|
|
|
6107 |
"miine","+0:0:0:1:0:0:0",
|
|
|
6108 |
"m${i}ine","+0:0:0:1:0:0:0",
|
|
|
6109 |
"poimiine","+0:0:0:2:0:0:0",
|
|
|
6110 |
"poim${i}ine","+0:0:0:2:0:0:0"];
|
|
|
6111 |
$$d{"times"} =["amiaza","12:00:00",
|
|
|
6112 |
"amiaz${a}","12:00:00",
|
|
|
6113 |
"miezul noptii","00:00:00",
|
|
|
6114 |
"miezul nop${p}ii","00:00:00"];
|
|
|
6115 |
|
|
|
6116 |
$$d{"years"} =["ani","an","a"];
|
|
|
6117 |
$$d{"months"} =["luni","luna","lun${a}","l"];
|
|
|
6118 |
$$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina",
|
|
|
6119 |
"s${a}pt${a}m${i}na","sapt","s${a}pt"];
|
|
|
6120 |
$$d{"days"} =["zile","zi","z"];
|
|
|
6121 |
$$d{"hours"} =["ore", "ora", "or${a}", "h"];
|
|
|
6122 |
$$d{"minutes"} =["minute","min","m"];
|
|
|
6123 |
$$d{"seconds"} =["secunde","sec",];
|
|
|
6124 |
$$d{"replace"} =["s","secunde"];
|
|
|
6125 |
|
|
|
6126 |
$$d{"sephm"} =':';
|
|
|
6127 |
$$d{"sepms"} =':';
|
|
|
6128 |
$$d{"sepss"} ='[.:,]';
|
|
|
6129 |
|
|
|
6130 |
$$d{"am"} = ["AM","A.M."];
|
|
|
6131 |
$$d{"pm"} = ["PM","P.M."];
|
|
|
6132 |
}
|
|
|
6133 |
|
|
|
6134 |
sub Date_Init_Swedish {
|
|
|
6135 |
print "DEBUG: Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6136 |
my($d)=@_;
|
|
|
6137 |
my(%h)=();
|
|
|
6138 |
&Char_8Bit(\%h);
|
|
|
6139 |
my($ao)=$h{"ao"};
|
|
|
6140 |
my($o) =$h{"o:"};
|
|
|
6141 |
my($a) =$h{"a:"};
|
|
|
6142 |
|
|
|
6143 |
$$d{"month_name"}=
|
|
|
6144 |
[["Januari","Februari","Mars","April","Maj","Juni",
|
|
|
6145 |
"Juli","Augusti","September","Oktober","November","December"]];
|
|
|
6146 |
$$d{"month_abb"}=
|
|
|
6147 |
[["Jan","Feb","Mar","Apr","Maj","Jun",
|
|
|
6148 |
"Jul","Aug","Sep","Okt","Nov","Dec"]];
|
|
|
6149 |
|
|
|
6150 |
$$d{"day_name"}=
|
|
|
6151 |
[["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
|
|
|
6152 |
["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
|
|
|
6153 |
"S${o}ndag"]];
|
|
|
6154 |
$$d{"day_abb"}=
|
|
|
6155 |
[["Man","Tis","Ons","Tor","Fre","Lor","Son"],
|
|
|
6156 |
["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
|
|
|
6157 |
$$d{"day_char"}=
|
|
|
6158 |
[["M","Ti","O","To","F","L","S"]];
|
|
|
6159 |
|
|
|
6160 |
$$d{"num_suff"}=
|
|
|
6161 |
[["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
|
|
|
6162 |
"11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
|
|
|
6163 |
"21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
|
|
|
6164 |
"31:a"]];
|
|
|
6165 |
$$d{"num_word"}=
|
|
|
6166 |
[["forsta","andra","tredje","fjarde","femte","sjatte","sjunde",
|
|
|
6167 |
"attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
|
|
|
6168 |
"femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
|
|
|
6169 |
"tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte",
|
|
|
6170 |
"tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde",
|
|
|
6171 |
"trettionde","trettioforsta"],
|
|
|
6172 |
["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde",
|
|
|
6173 |
"${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
|
|
|
6174 |
"femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
|
|
|
6175 |
"tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte",
|
|
|
6176 |
"tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde",
|
|
|
6177 |
"trettionde","trettiof${o}rsta"]];
|
|
|
6178 |
|
|
|
6179 |
$$d{"now"} =["idag","nu"];
|
|
|
6180 |
$$d{"last"} =["forra","f${o}rra","senaste"];
|
|
|
6181 |
$$d{"each"} =["varje"];
|
|
|
6182 |
$$d{"of"} =["om"];
|
|
|
6183 |
$$d{"at"} =["kl","kl.","klockan"];
|
|
|
6184 |
$$d{"on"} =["pa","p${ao}"];
|
|
|
6185 |
$$d{"future"} =["om"];
|
|
|
6186 |
$$d{"past"} =["sedan"];
|
|
|
6187 |
$$d{"next"} =["nasta","n${a}sta"];
|
|
|
6188 |
$$d{"prev"} =["forra","f${o}rra"];
|
|
|
6189 |
$$d{"later"} =["senare"];
|
|
|
6190 |
|
|
|
6191 |
$$d{"exact"} =["exakt"];
|
|
|
6192 |
$$d{"approx"} =["ungefar","ungef${a}r"];
|
|
|
6193 |
$$d{"business"}=["arbetsdag","arbetsdagar"];
|
|
|
6194 |
|
|
|
6195 |
$$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
|
|
|
6196 |
"imorgon","+0:0:0:1:0:0:0"];
|
|
|
6197 |
$$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00",
|
|
|
6198 |
"midnatt","00:00:00"];
|
|
|
6199 |
|
|
|
6200 |
$$d{"years"} =["ar","${ao}r"];
|
|
|
6201 |
$$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"];
|
|
|
6202 |
$$d{"weeks"} =["v","vecka","veckor"];
|
|
|
6203 |
$$d{"days"} =["d","dag","dagar"];
|
|
|
6204 |
$$d{"hours"} =["t","tim","timme","timmar"];
|
|
|
6205 |
$$d{"minutes"} =["min","minut","minuter"];
|
|
|
6206 |
$$d{"seconds"} =["s","sek","sekund","sekunder"];
|
|
|
6207 |
$$d{"replace"} =["m","minut"];
|
|
|
6208 |
|
|
|
6209 |
$$d{"sephm"} ='[.:]';
|
|
|
6210 |
$$d{"sepms"} =':';
|
|
|
6211 |
$$d{"sepss"} ='[.:]';
|
|
|
6212 |
|
|
|
6213 |
$$d{"am"} = ["FM"];
|
|
|
6214 |
$$d{"pm"} = ["EM"];
|
|
|
6215 |
}
|
|
|
6216 |
|
|
|
6217 |
sub Date_Init_German {
|
|
|
6218 |
print "DEBUG: Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6219 |
my($d)=@_;
|
|
|
6220 |
my(%h)=();
|
|
|
6221 |
&Char_8Bit(\%h);
|
|
|
6222 |
my($a)=$h{"a:"};
|
|
|
6223 |
my($u)=$h{"u:"};
|
|
|
6224 |
my($o)=$h{"o:"};
|
|
|
6225 |
my($b)=$h{"beta"};
|
|
|
6226 |
|
|
|
6227 |
$$d{"month_name"}=
|
|
|
6228 |
[["Januar","Februar","Maerz","April","Mai","Juni",
|
|
|
6229 |
"Juli","August","September","Oktober","November","Dezember"],
|
|
|
6230 |
["J${a}nner","Februar","M${a}rz","April","Mai","Juni",
|
|
|
6231 |
"Juli","August","September","Oktober","November","Dezember"]];
|
|
|
6232 |
$$d{"month_abb"}=
|
|
|
6233 |
[["Jan","Feb","Mar","Apr","Mai","Jun",
|
|
|
6234 |
"Jul","Aug","Sep","Okt","Nov","Dez"],
|
|
|
6235 |
["J${a}n","Feb","M${a}r","Apr","Mai","Jun",
|
|
|
6236 |
"Jul","Aug","Sep","Okt","Nov","Dez"]];
|
|
|
6237 |
|
|
|
6238 |
$$d{"day_name"}=
|
|
|
6239 |
[["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
|
|
|
6240 |
"Sonntag"]];
|
|
|
6241 |
$$d{"day_abb"}=
|
|
|
6242 |
[["Mon","Die","Mit","Don","Fre","Sam","Son"]];
|
|
|
6243 |
$$d{"day_char"}=
|
|
|
6244 |
[["M","Di","Mi","Do","F","Sa","So"]];
|
|
|
6245 |
|
|
|
6246 |
$$d{"num_suff"}=
|
|
|
6247 |
[["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
|
|
|
6248 |
"11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
|
|
|
6249 |
"21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
|
|
|
6250 |
"31."]];
|
|
|
6251 |
$$d{"num_word"}=
|
|
|
6252 |
[
|
|
|
6253 |
["erste","zweite","dritte","vierte","funfte","sechste","siebente",
|
|
|
6254 |
"achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte",
|
|
|
6255 |
"funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte",
|
|
|
6256 |
"zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste",
|
|
|
6257 |
"vierundzwanzigste","funfundzwanzigste","sechundzwanzigste",
|
|
|
6258 |
"siebundzwanzigste","achtundzwanzigste","neunundzwanzigste",
|
|
|
6259 |
"dreibigste","einunddreibigste"],
|
|
|
6260 |
["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente",
|
|
|
6261 |
"achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte",
|
|
|
6262 |
"vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte",
|
|
|
6263 |
"neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste",
|
|
|
6264 |
"dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste",
|
|
|
6265 |
"sechundzwanzigste","siebundzwanzigste","achtundzwanzigste",
|
|
|
6266 |
"neunundzwanzigste","drei${b}igste","einunddrei${b}igste"],
|
|
|
6267 |
["erster"]];
|
|
|
6268 |
|
|
|
6269 |
$$d{"now"} =["heute","jetzt"];
|
|
|
6270 |
$$d{"last"} =["letzte","letzten"];
|
|
|
6271 |
$$d{"each"} =["jeden"];
|
|
|
6272 |
$$d{"of"} =["der","im","des"];
|
|
|
6273 |
$$d{"at"} =["um"];
|
|
|
6274 |
$$d{"on"} =["am"];
|
|
|
6275 |
$$d{"future"} =["in"];
|
|
|
6276 |
$$d{"past"} =["vor"];
|
|
|
6277 |
$$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
|
|
|
6278 |
$$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
|
|
|
6279 |
$$d{"later"} =["spater","sp${a}ter"];
|
|
|
6280 |
|
|
|
6281 |
$$d{"exact"} =["genau"];
|
|
|
6282 |
$$d{"approx"} =["ungefahr","ungef${a}hr"];
|
|
|
6283 |
$$d{"business"}=["Arbeitstag"];
|
|
|
6284 |
|
|
|
6285 |
$$d{"offset"} =["gestern","-0:0:0:1:0:0:0","morgen","+0:0:0:1:0:0:0"];
|
|
|
6286 |
$$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"];
|
|
|
6287 |
|
|
|
6288 |
$$d{"years"} =["j","Jahr","Jahre"];
|
|
|
6289 |
$$d{"months"} =["Monat","Monate"];
|
|
|
6290 |
$$d{"weeks"} =["w","Woche","Wochen"];
|
|
|
6291 |
$$d{"days"} =["t","Tag","Tage"];
|
|
|
6292 |
$$d{"hours"} =["h","std","Stunde","Stunden"];
|
|
|
6293 |
$$d{"minutes"} =["min","Minute","Minuten"];
|
|
|
6294 |
$$d{"seconds"} =["s","sek","Sekunde","Sekunden"];
|
|
|
6295 |
$$d{"replace"} =["m","Monat"];
|
|
|
6296 |
|
|
|
6297 |
$$d{"sephm"} =':';
|
|
|
6298 |
$$d{"sepms"} ='[: ]';
|
|
|
6299 |
$$d{"sepss"} ='[.:]';
|
|
|
6300 |
|
|
|
6301 |
$$d{"am"} = ["FM"];
|
|
|
6302 |
$$d{"pm"} = ["EM"];
|
|
|
6303 |
}
|
|
|
6304 |
|
|
|
6305 |
sub Date_Init_Dutch {
|
|
|
6306 |
print "DEBUG: Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6307 |
my($d)=@_;
|
|
|
6308 |
my(%h)=();
|
|
|
6309 |
&Char_8Bit(\%h);
|
|
|
6310 |
|
|
|
6311 |
$$d{"month_name"}=
|
|
|
6312 |
[["januari","februari","maart","april","mei","juni","juli","augustus",
|
|
|
6313 |
"september","october","november","december"],
|
|
|
6314 |
["","","","","","","","","","oktober"]];
|
|
|
6315 |
|
|
|
6316 |
$$d{"month_abb"}=
|
|
|
6317 |
[["jan","feb","maa","apr","mei","jun","jul",
|
|
|
6318 |
"aug","sep","oct","nov","dec"],
|
|
|
6319 |
["","","mrt","","","","","","","okt"]];
|
|
|
6320 |
$$d{"day_name"}=
|
|
|
6321 |
[["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
|
|
|
6322 |
"zondag"]];
|
|
|
6323 |
$$d{"day_abb"}=
|
|
|
6324 |
[["ma","di","wo","do","vr","zat","zon"],
|
|
|
6325 |
["","","","","","za","zo"]];
|
|
|
6326 |
$$d{"day_char"}=
|
|
|
6327 |
[["M","D","W","D","V","Za","Zo"]];
|
|
|
6328 |
|
|
|
6329 |
$$d{"num_suff"}=
|
|
|
6330 |
[["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de",
|
|
|
6331 |
"11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste",
|
|
|
6332 |
"21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste",
|
|
|
6333 |
"30ste","31ste"]];
|
|
|
6334 |
$$d{"num_word"}=
|
|
|
6335 |
[["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
|
|
|
6336 |
"negende","tiende","elfde","twaalfde",
|
|
|
6337 |
map {"${_}tiende";} qw (der veer vijf zes zeven acht negen),
|
|
|
6338 |
"twintigste",
|
|
|
6339 |
map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht
|
|
|
6340 |
negen),
|
|
|
6341 |
"dertigste","eenendertigste"],
|
|
|
6342 |
["","","","","","","","","","","","","","","","","","","","",
|
|
|
6343 |
map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht
|
|
|
6344 |
negen),
|
|
|
6345 |
"dertigste","een-en-dertigste"],
|
|
|
6346 |
["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
|
|
|
6347 |
"elf","twaalf",
|
|
|
6348 |
map {"${_}tien"} qw (der veer vijf zes zeven acht negen),
|
|
|
6349 |
"twintig",
|
|
|
6350 |
map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen),
|
|
|
6351 |
"dertig","eenendertig"],
|
|
|
6352 |
["","","","","","","","","","","","","","","","","","","","",
|
|
|
6353 |
map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht
|
|
|
6354 |
negen),
|
|
|
6355 |
"dertig","een-en-dertig"]];
|
|
|
6356 |
|
|
|
6357 |
$$d{"now"} =["nu","nou","vandaag"];
|
|
|
6358 |
$$d{"last"} =["laatste"];
|
|
|
6359 |
$$d{"each"} =["elke","elk"];
|
|
|
6360 |
$$d{"of"} =["in","van"];
|
|
|
6361 |
$$d{"at"} =["om"];
|
|
|
6362 |
$$d{"on"} =["op"];
|
|
|
6363 |
$$d{"future"} =["over"];
|
|
|
6364 |
$$d{"past"} =["geleden","vroeger","eerder"];
|
|
|
6365 |
$$d{"next"} =["volgende","volgend"];
|
|
|
6366 |
$$d{"prev"} =["voorgaande","voorgaand"];
|
|
|
6367 |
$$d{"later"} =["later"];
|
|
|
6368 |
|
|
|
6369 |
$$d{"exact"} =["exact","precies","nauwkeurig"];
|
|
|
6370 |
$$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.'];
|
|
|
6371 |
$$d{"business"}=["werk","zakelijke","zakelijk"];
|
|
|
6372 |
|
|
|
6373 |
$$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0",
|
|
|
6374 |
"gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"];
|
|
|
6375 |
$$d{"times"} =["noen","12:00:00","middernacht","00:00:00"];
|
|
|
6376 |
|
|
|
6377 |
$$d{"years"} =["jaar","jaren","ja","j"];
|
|
|
6378 |
$$d{"months"} =["maand","maanden","mnd"];
|
|
|
6379 |
$$d{"weeks"} =["week","weken","w"];
|
|
|
6380 |
$$d{"days"} =["dag","dagen","d"];
|
|
|
6381 |
$$d{"hours"} =["uur","uren","u","h"];
|
|
|
6382 |
$$d{"minutes"} =["minuut","minuten","min"];
|
|
|
6383 |
$$d{"seconds"} =["seconde","seconden","sec","s"];
|
|
|
6384 |
$$d{"replace"} =["m","minuten"];
|
|
|
6385 |
|
|
|
6386 |
$$d{"sephm"} ='[:.uh]';
|
|
|
6387 |
$$d{"sepms"} ='[:.m]';
|
|
|
6388 |
$$d{"sepss"} ='[.:]';
|
|
|
6389 |
|
|
|
6390 |
$$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends",
|
|
|
6391 |
"ochtend","'s_nachts","nacht"];
|
|
|
6392 |
$$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag",
|
|
|
6393 |
"'s_avonds","avond"];
|
|
|
6394 |
}
|
|
|
6395 |
|
|
|
6396 |
sub Date_Init_Polish {
|
|
|
6397 |
print "DEBUG: Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6398 |
my($d)=@_;
|
|
|
6399 |
|
|
|
6400 |
$$d{"month_name"}=
|
|
|
6401 |
[["stycznia","luty","marca","kwietnia","maja","czerwca",
|
|
|
6402 |
"lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"],
|
|
|
6403 |
["stycznia","luty","marca","kwietnia","maja","czerwca","lipca",
|
|
|
6404 |
"sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]];
|
|
|
6405 |
$$d{"month_abb"}=
|
|
|
6406 |
[["sty.","lut.","mar.","kwi.","maj","cze.",
|
|
|
6407 |
"lip.","sie.","wrz.","paz.","lis.","gru."],
|
|
|
6408 |
["sty.","lut.","mar.","kwi.","maj","cze.",
|
|
|
6409 |
"lip.","sie.","wrz.","pa\x9f.","lis.","gru."]];
|
|
|
6410 |
|
|
|
6411 |
$$d{"day_name"}=
|
|
|
6412 |
[["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
|
|
|
6413 |
"niedziela"],
|
|
|
6414 |
["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
|
|
|
6415 |
"sobota","niedziela"]];
|
|
|
6416 |
$$d{"day_abb"}=
|
|
|
6417 |
[["po.","wt.","sr.","cz.","pi.","so.","ni."],
|
|
|
6418 |
["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
|
|
|
6419 |
$$d{"day_char"}=
|
|
|
6420 |
[["p","w","e","c","p","s","n"],
|
|
|
6421 |
["p","w","\x9c.","c","p","s","n"]];
|
|
|
6422 |
|
|
|
6423 |
$$d{"num_suff"}=
|
|
|
6424 |
[["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
|
|
|
6425 |
"11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
|
|
|
6426 |
"21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
|
|
|
6427 |
"31."]];
|
|
|
6428 |
$$d{"num_word"}=
|
|
|
6429 |
[["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
|
|
|
6430 |
"siodmego","osmego","dziewiatego","dziesiatego",
|
|
|
6431 |
"jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
|
|
|
6432 |
"szestnastego","siedemnastego","osiemnastego","dziewietnastego",
|
|
|
6433 |
"dwudziestego",
|
|
|
6434 |
"dwudziestego pierwszego","dwudziestego drugiego",
|
|
|
6435 |
"dwudziestego trzeczego","dwudziestego czwartego",
|
|
|
6436 |
"dwudziestego piatego","dwudziestego szostego",
|
|
|
6437 |
"dwudziestego siodmego","dwudziestego osmego",
|
|
|
6438 |
"dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"],
|
|
|
6439 |
["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego",
|
|
|
6440 |
"sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego",
|
|
|
6441 |
"dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego",
|
|
|
6442 |
"czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego",
|
|
|
6443 |
"osiemnastego","dziewietnastego","dwudziestego",
|
|
|
6444 |
"dwudziestego pierwszego","dwudziestego drugiego",
|
|
|
6445 |
"dwudziestego trzeczego","dwudziestego czwartego",
|
|
|
6446 |
"dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego",
|
|
|
6447 |
"dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego",
|
|
|
6448 |
"dwudziestego dziewi\x81\xb9tego","trzydziestego",
|
|
|
6449 |
"trzydziestego pierwszego"]];
|
|
|
6450 |
|
|
|
6451 |
$$d{"now"} =["dzisaj","teraz"];
|
|
|
6452 |
$$d{"last"} =["ostatni","ostatna"];
|
|
|
6453 |
$$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"];
|
|
|
6454 |
$$d{"of"} =["w","z"];
|
|
|
6455 |
$$d{"at"} =["o","u"];
|
|
|
6456 |
$$d{"on"} =["na"];
|
|
|
6457 |
$$d{"future"} =["za"];
|
|
|
6458 |
$$d{"past"} =["temu"];
|
|
|
6459 |
$$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
|
|
|
6460 |
"przyszly","przysz\x81\xb3y","przyszlym",
|
|
|
6461 |
"przysz\x81\xb3ym"];
|
|
|
6462 |
$$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
|
|
|
6463 |
$$d{"later"} =["later"];
|
|
|
6464 |
|
|
|
6465 |
$$d{"exact"} =["doklandnie","dok\x81\xb3andnie"];
|
|
|
6466 |
$$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej",
|
|
|
6467 |
"mniej wi\x81\xeacej","okolo","oko\x81\xb3o"];
|
|
|
6468 |
$$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym",
|
|
|
6469 |
"s\x81\xb3u\x81\xbfbowym"];
|
|
|
6470 |
|
|
|
6471 |
$$d{"times"} =["po\x81\xb3udnie","12:00:00",
|
|
|
6472 |
"p\x81\xf3\x81\xb3noc","00:00:00",
|
|
|
6473 |
"poludnie","12:00:00","polnoc","00:00:00"];
|
|
|
6474 |
$$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"];
|
|
|
6475 |
|
|
|
6476 |
$$d{"years"} =["rok","lat","lata","latach"];
|
|
|
6477 |
$$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy",
|
|
|
6478 |
"miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"];
|
|
|
6479 |
$$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"];
|
|
|
6480 |
$$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"];
|
|
|
6481 |
$$d{"hours"} =["g.","godzina","godziny","godzinie"];
|
|
|
6482 |
$$d{"minutes"} =["mn.","min.","minut","minuty"];
|
|
|
6483 |
$$d{"seconds"} =["s.","sekund","sekundy"];
|
|
|
6484 |
$$d{"replace"} =["m.","miesiac"];
|
|
|
6485 |
|
|
|
6486 |
$$d{"sephm"} =':';
|
|
|
6487 |
$$d{"sepms"} =':';
|
|
|
6488 |
$$d{"sepss"} ='[.:]';
|
|
|
6489 |
|
|
|
6490 |
$$d{"am"} = ["AM","A.M."];
|
|
|
6491 |
$$d{"pm"} = ["PM","P.M."];
|
|
|
6492 |
}
|
|
|
6493 |
|
|
|
6494 |
sub Date_Init_Spanish {
|
|
|
6495 |
print "DEBUG: Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6496 |
my($d)=@_;
|
|
|
6497 |
my(%h)=();
|
|
|
6498 |
&Char_8Bit(\%h);
|
|
|
6499 |
|
|
|
6500 |
$$d{"month_name"}=
|
|
|
6501 |
[["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
|
|
|
6502 |
"Septiembre","Octubre","Noviembre","Diciembre"]];
|
|
|
6503 |
|
|
|
6504 |
$$d{"month_abb"}=
|
|
|
6505 |
[["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
|
|
|
6506 |
"Nov","Dic"]];
|
|
|
6507 |
|
|
|
6508 |
$$d{"day_name"}=
|
|
|
6509 |
[["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
|
|
|
6510 |
$$d{"day_abb"}=
|
|
|
6511 |
[["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
|
|
|
6512 |
$$d{"day_char"}=
|
|
|
6513 |
[["L","Ma","Mi","J","V","S","D"]];
|
|
|
6514 |
|
|
|
6515 |
$$d{"num_suff"}=
|
|
|
6516 |
[["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o",
|
|
|
6517 |
"11o","12o","13o","14o","15o","16o","17o","18o","19o","20o",
|
|
|
6518 |
"21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"],
|
|
|
6519 |
["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a",
|
|
|
6520 |
"11a","12a","13a","14a","15a","16a","17a","18a","19a","20a",
|
|
|
6521 |
"21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]];
|
|
|
6522 |
$$d{"num_word"}=
|
|
|
6523 |
[["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo",
|
|
|
6524 |
"Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo",
|
|
|
6525 |
"Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto",
|
|
|
6526 |
"Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo",
|
|
|
6527 |
"Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero",
|
|
|
6528 |
"Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto",
|
|
|
6529 |
"Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo",
|
|
|
6530 |
"Trigesimo Primero"],
|
|
|
6531 |
["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima",
|
|
|
6532 |
"Octava","Novena","Decima","Decimo Primera","Decimo Segunda",
|
|
|
6533 |
"Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta",
|
|
|
6534 |
"Decimo Septima","Decimo Octava","Decimo Novena","Vigesima",
|
|
|
6535 |
"Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera",
|
|
|
6536 |
"Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta",
|
|
|
6537 |
"Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima",
|
|
|
6538 |
"Trigesimo Primera"]];
|
|
|
6539 |
|
|
|
6540 |
$$d{"now"} =["Hoy","Ahora"];
|
|
|
6541 |
$$d{"last"} =["ultimo"];
|
|
|
6542 |
$$d{"each"} =["cada"];
|
|
|
6543 |
$$d{"of"} =["en","de"];
|
|
|
6544 |
$$d{"at"} =["a"];
|
|
|
6545 |
$$d{"on"} =["el"];
|
|
|
6546 |
$$d{"future"} =["en"];
|
|
|
6547 |
$$d{"past"} =["hace"];
|
|
|
6548 |
$$d{"next"} =["siguiente"];
|
|
|
6549 |
$$d{"prev"} =["anterior"];
|
|
|
6550 |
$$d{"later"} =["later"];
|
|
|
6551 |
|
|
|
6552 |
$$d{"exact"} =["exactamente"];
|
|
|
6553 |
$$d{"approx"} =["aproximadamente"];
|
|
|
6554 |
$$d{"business"}=["laborales"];
|
|
|
6555 |
|
|
|
6556 |
$$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"];
|
|
|
6557 |
$$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"];
|
|
|
6558 |
|
|
|
6559 |
$$d{"years"} =["a","ano","ano","anos","anos"];
|
|
|
6560 |
$$d{"months"} =["m","mes","mes","meses"];
|
|
|
6561 |
$$d{"weeks"} =["sem","semana","semana","semanas"];
|
|
|
6562 |
$$d{"days"} =["d","dia","dias"];
|
|
|
6563 |
$$d{"hours"} =["hr","hrs","hora","horas"];
|
|
|
6564 |
$$d{"minutes"} =["min","min","minuto","minutos"];
|
|
|
6565 |
$$d{"seconds"} =["s","seg","segundo","segundos"];
|
|
|
6566 |
$$d{"replace"} =["m","mes"];
|
|
|
6567 |
|
|
|
6568 |
$$d{"sephm"} =':';
|
|
|
6569 |
$$d{"sepms"} =':';
|
|
|
6570 |
$$d{"sepss"} ='[.:]';
|
|
|
6571 |
|
|
|
6572 |
$$d{"am"} = ["AM","A.M."];
|
|
|
6573 |
$$d{"pm"} = ["PM","P.M."];
|
|
|
6574 |
}
|
|
|
6575 |
|
|
|
6576 |
sub Date_Init_Portuguese {
|
|
|
6577 |
print "DEBUG: Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6578 |
my($d)=@_;
|
|
|
6579 |
my(%h)=();
|
|
|
6580 |
&Char_8Bit(\%h);
|
|
|
6581 |
my($o) = $h{"-o"};
|
|
|
6582 |
my($c) = $h{",c"};
|
|
|
6583 |
my($a) = $h{"a'"};
|
|
|
6584 |
my($e) = $h{"e'"};
|
|
|
6585 |
my($u) = $h{"u'"};
|
|
|
6586 |
my($o2)= $h{"o'"};
|
|
|
6587 |
my($a2)= $h{"a`"};
|
|
|
6588 |
my($a3)= $h{"a~"};
|
|
|
6589 |
my($e2)= $h{"e^"};
|
|
|
6590 |
|
|
|
6591 |
$$d{"month_name"}=
|
|
|
6592 |
[["Janeiro","Fevereiro","Marco","Abril","Maio","Junho",
|
|
|
6593 |
"Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"],
|
|
|
6594 |
["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho",
|
|
|
6595 |
"Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]];
|
|
|
6596 |
|
|
|
6597 |
$$d{"month_abb"}=
|
|
|
6598 |
[["Jan","Fev","Mar","Abr","Mai","Jun",
|
|
|
6599 |
"Jul","Ago","Set","Out","Nov","Dez"]];
|
|
|
6600 |
|
|
|
6601 |
$$d{"day_name"}=
|
|
|
6602 |
[["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
|
|
|
6603 |
["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
|
|
|
6604 |
$$d{"day_abb"}=
|
|
|
6605 |
[["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
|
|
|
6606 |
["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
|
|
|
6607 |
$$d{"day_char"}=
|
|
|
6608 |
[["Sg","T","Qa","Qi","Sx","Sb","D"]];
|
|
|
6609 |
|
|
|
6610 |
$$d{"num_suff"}=
|
|
|
6611 |
[["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}",
|
|
|
6612 |
"9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}",
|
|
|
6613 |
"16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}",
|
|
|
6614 |
"23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}",
|
|
|
6615 |
"30${o}","31${o}"]];
|
|
|
6616 |
$$d{"num_word"}=
|
|
|
6617 |
[["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo",
|
|
|
6618 |
"oitavo","nono","decimo","decimo primeiro","decimo segundo",
|
|
|
6619 |
"decimo terceiro","decimo quarto","decimo quinto","decimo sexto",
|
|
|
6620 |
"decimo setimo","decimo oitavo","decimo nono","vigesimo",
|
|
|
6621 |
"vigesimo primeiro","vigesimo segundo","vigesimo terceiro",
|
|
|
6622 |
"vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo",
|
|
|
6623 |
"vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"],
|
|
|
6624 |
["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo",
|
|
|
6625 |
"oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo",
|
|
|
6626 |
"d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto",
|
|
|
6627 |
"d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo",
|
|
|
6628 |
"d${e}cimo nono","vig${e}simo","vig${e}simo primeiro",
|
|
|
6629 |
"vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto",
|
|
|
6630 |
"vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo",
|
|
|
6631 |
"vig${e}simo oitavo","vig${e}simo nono","trig${e}simo",
|
|
|
6632 |
"trig${e}simo primeiro"]];
|
|
|
6633 |
|
|
|
6634 |
$$d{"now"} =["agora","hoje"];
|
|
|
6635 |
$$d{"last"} =["${u}ltimo","ultimo"];
|
|
|
6636 |
$$d{"each"} =["cada"];
|
|
|
6637 |
$$d{"of"} =["da","do"];
|
|
|
6638 |
$$d{"at"} =["as","${a2}s"];
|
|
|
6639 |
$$d{"on"} =["na","no"];
|
|
|
6640 |
$$d{"future"} =["em"];
|
|
|
6641 |
$$d{"past"} =["a","${a2}"];
|
|
|
6642 |
$$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"];
|
|
|
6643 |
$$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"];
|
|
|
6644 |
$$d{"later"} =["passadas","passados"];
|
|
|
6645 |
|
|
|
6646 |
$$d{"exact"} =["exactamente"];
|
|
|
6647 |
$$d{"approx"} =["aproximadamente"];
|
|
|
6648 |
$$d{"business"}=["util","uteis"];
|
|
|
6649 |
|
|
|
6650 |
$$d{"offset"} =["ontem","-0:0:0:1:0:0:0",
|
|
|
6651 |
"amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"];
|
|
|
6652 |
$$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"];
|
|
|
6653 |
|
|
|
6654 |
$$d{"years"} =["anos","ano","ans","an","a"];
|
|
|
6655 |
$$d{"months"} =["meses","m${e2}s","mes","m"];
|
|
|
6656 |
$$d{"weeks"} =["semanas","semana","sem","sems","s"];
|
|
|
6657 |
$$d{"days"} =["dias","dia","d"];
|
|
|
6658 |
$$d{"hours"} =["horas","hora","hr","hrs"];
|
|
|
6659 |
$$d{"minutes"} =["minutos","minuto","min","mn"];
|
|
|
6660 |
$$d{"seconds"} =["segundos","segundo","seg","sg"];
|
|
|
6661 |
$$d{"replace"} =["m","mes","s","sems"];
|
|
|
6662 |
|
|
|
6663 |
$$d{"sephm"} =':';
|
|
|
6664 |
$$d{"sepms"} =':';
|
|
|
6665 |
$$d{"sepss"} ='[,]';
|
|
|
6666 |
|
|
|
6667 |
$$d{"am"} = ["AM","A.M."];
|
|
|
6668 |
$$d{"pm"} = ["PM","P.M."];
|
|
|
6669 |
}
|
|
|
6670 |
|
|
|
6671 |
sub Date_Init_Russian {
|
|
|
6672 |
print "DEBUG: Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6673 |
my($d)=@_;
|
|
|
6674 |
my(%h)=();
|
|
|
6675 |
&Char_8Bit(\%h);
|
|
|
6676 |
my($a) =$h{"a:"};
|
|
|
6677 |
|
|
|
6678 |
$$d{"month_name"}=
|
|
|
6679 |
[
|
|
|
6680 |
["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1",
|
|
|
6681 |
"\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1",
|
|
|
6682 |
"\xc9\xc0\xce\xd1",
|
|
|
6683 |
"\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1",
|
|
|
6684 |
"\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1",
|
|
|
6685 |
"\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"],
|
|
|
6686 |
["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8",
|
|
|
6687 |
"\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca",
|
|
|
6688 |
"\xc9\xc0\xce\xd8",
|
|
|
6689 |
"\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4",
|
|
|
6690 |
"\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8",
|
|
|
6691 |
"\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"]
|
|
|
6692 |
];
|
|
|
6693 |
|
|
|
6694 |
$$d{"month_abb"}=
|
|
|
6695 |
[["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2",
|
|
|
6696 |
"\xcd\xc1\xca","\xc9\xc0\xce",
|
|
|
6697 |
"\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4",
|
|
|
6698 |
"\xce\xcf\xd1\xc2","\xc4\xc5\xcb"],
|
|
|
6699 |
["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","",
|
|
|
6700 |
"","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]];
|
|
|
6701 |
|
|
|
6702 |
$$d{"day_name"}=
|
|
|
6703 |
[["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb",
|
|
|
6704 |
"\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1",
|
|
|
6705 |
"\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1",
|
|
|
6706 |
"\xd3\xd5\xc2\xc2\xcf\xd4\xc1",
|
|
|
6707 |
"\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]];
|
|
|
6708 |
$$d{"day_abb"}=
|
|
|
6709 |
[["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7",
|
|
|
6710 |
"\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"],
|
|
|
6711 |
["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4",
|
|
|
6712 |
"\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]];
|
|
|
6713 |
$$d{"day_char"}=
|
|
|
6714 |
[["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
|
|
|
6715 |
"\xd7\xd3"]];
|
|
|
6716 |
|
|
|
6717 |
$$d{"num_suff"}=
|
|
|
6718 |
[["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ",
|
|
|
6719 |
"11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ",
|
|
|
6720 |
"21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ",
|
|
|
6721 |
"31 "]];
|
|
|
6722 |
$$d{"num_word"}=
|
|
|
6723 |
[["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca",
|
|
|
6724 |
"\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
|
|
|
6725 |
"\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca",
|
|
|
6726 |
"\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca",
|
|
|
6727 |
"\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca",
|
|
|
6728 |
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6729 |
"\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca",
|
|
|
6730 |
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6731 |
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6732 |
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6733 |
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6734 |
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6735 |
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6736 |
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6737 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6738 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca",
|
|
|
6739 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca",
|
|
|
6740 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca",
|
|
|
6741 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
|
|
|
6742 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca",
|
|
|
6743 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca",
|
|
|
6744 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca",
|
|
|
6745 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca",
|
|
|
6746 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca",
|
|
|
6747 |
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca",
|
|
|
6748 |
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"],
|
|
|
6749 |
|
|
|
6750 |
["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5",
|
|
|
6751 |
"\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
|
|
|
6752 |
"\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5",
|
|
|
6753 |
"\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5",
|
|
|
6754 |
"\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5",
|
|
|
6755 |
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6756 |
"\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6757 |
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6758 |
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6759 |
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6760 |
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6761 |
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6762 |
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6763 |
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6764 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6765 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5",
|
|
|
6766 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
|
|
|
6767 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5",
|
|
|
6768 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
|
|
|
6769 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5",
|
|
|
6770 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5",
|
|
|
6771 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5",
|
|
|
6772 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5",
|
|
|
6773 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5",
|
|
|
6774 |
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5",
|
|
|
6775 |
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"],
|
|
|
6776 |
|
|
|
6777 |
["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf",
|
|
|
6778 |
"\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
|
|
|
6779 |
"\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf",
|
|
|
6780 |
"\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
|
|
|
6781 |
"\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
|
|
|
6782 |
"\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf",
|
|
|
6783 |
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6784 |
"\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6785 |
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6786 |
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6787 |
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6788 |
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6789 |
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6790 |
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6791 |
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6792 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6793 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf",
|
|
|
6794 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
|
|
|
6795 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
|
|
|
6796 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf",
|
|
|
6797 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf",
|
|
|
6798 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf",
|
|
|
6799 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
|
|
|
6800 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
|
|
|
6801 |
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf",
|
|
|
6802 |
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
|
|
|
6803 |
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]];
|
|
|
6804 |
|
|
|
6805 |
$$d{"now"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1","\xd3\xc5\xca\xde\xc1\xd3"];
|
|
|
6806 |
$$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"];
|
|
|
6807 |
$$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"];
|
|
|
6808 |
$$d{"of"} =[" "];
|
|
|
6809 |
$$d{"at"} =["\xd7"];
|
|
|
6810 |
$$d{"on"} =["\xd7"];
|
|
|
6811 |
$$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"];
|
|
|
6812 |
$$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "];
|
|
|
6813 |
$$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"];
|
|
|
6814 |
$$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"];
|
|
|
6815 |
$$d{"later"} =["\xd0\xcf\xda\xd6\xc5"];
|
|
|
6816 |
|
|
|
6817 |
$$d{"exact"} =["\xd4\xcf\xde\xce\xcf"];
|
|
|
6818 |
$$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"];
|
|
|
6819 |
$$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"];
|
|
|
6820 |
|
|
|
6821 |
$$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0",
|
|
|
6822 |
"\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0",
|
|
|
6823 |
"\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0",
|
|
|
6824 |
"\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1",
|
|
|
6825 |
"+0:0:0:2:0:0:0"];
|
|
|
6826 |
$$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00",
|
|
|
6827 |
"\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"];
|
|
|
6828 |
|
|
|
6829 |
$$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4",
|
|
|
6830 |
"\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"];
|
|
|
6831 |
$$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3",
|
|
|
6832 |
"\xcd\xc5\xd3\xd1\xc3\xc5\xd7"];
|
|
|
6833 |
$$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8",
|
|
|
6834 |
"\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"];
|
|
|
6835 |
$$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca",
|
|
|
6836 |
"\xc4\xce\xd1"];
|
|
|
6837 |
$$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3",
|
|
|
6838 |
"\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"];
|
|
|
6839 |
$$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1",
|
|
|
6840 |
"\xcd\xc9\xce\xd5\xd4"];
|
|
|
6841 |
$$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
|
|
|
6842 |
"\xd3\xc5\xcb\xd5\xce\xc4"];
|
|
|
6843 |
$$d{"replace"} =[];
|
|
|
6844 |
|
|
|
6845 |
$$d{"sephm"} ="[:\xde]";
|
|
|
6846 |
$$d{"sepms"} ="[:\xcd]";
|
|
|
6847 |
$$d{"sepss"} ="[:.\xd3]";
|
|
|
6848 |
|
|
|
6849 |
$$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
|
|
|
6850 |
"\xd5\xd4\xd2\xc1",
|
|
|
6851 |
"\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"];
|
|
|
6852 |
$$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1",
|
|
|
6853 |
"\xd7\xc5\xde\xc5\xd2\xc1",
|
|
|
6854 |
"\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1",
|
|
|
6855 |
"\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"];
|
|
|
6856 |
}
|
|
|
6857 |
|
|
|
6858 |
sub Date_Init_Turkish {
|
|
|
6859 |
print "DEBUG: Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6860 |
my($d)=@_;
|
|
|
6861 |
|
|
|
6862 |
$$d{"month_name"}=
|
|
|
6863 |
[
|
|
|
6864 |
["ocak","subat","mart","nisan","mayis","haziran",
|
|
|
6865 |
"temmuz","agustos","eylul","ekim","kasim","aralik"],
|
|
|
6866 |
["ocak","\xfeubat","mart","nisan","may\xfds","haziran",
|
|
|
6867 |
"temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"]
|
|
|
6868 |
];
|
|
|
6869 |
|
|
|
6870 |
$$d{"month_abb"}=
|
|
|
6871 |
[
|
|
|
6872 |
["oca","sub","mar","nis","may","haz",
|
|
|
6873 |
"tem","agu","eyl","eki","kas","ara"],
|
|
|
6874 |
["oca","\xfeub","mar","nis","may","haz",
|
|
|
6875 |
"tem","a\xf0u","eyl","eki","kas","ara"]
|
|
|
6876 |
];
|
|
|
6877 |
|
|
|
6878 |
$$d{"day_name"}=
|
|
|
6879 |
[
|
|
|
6880 |
["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
|
|
|
6881 |
["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
|
|
|
6882 |
"cumartesi","pazar"],
|
|
|
6883 |
];
|
|
|
6884 |
|
|
|
6885 |
$$d{"day_abb"}=
|
|
|
6886 |
[
|
|
|
6887 |
["pzt","sal","car","per","cum","cts","paz"],
|
|
|
6888 |
["pzt","sal","\xe7ar","per","cum","cts","paz"],
|
|
|
6889 |
];
|
|
|
6890 |
|
|
|
6891 |
$$d{"day_char"}=
|
|
|
6892 |
[["Pt","S","Cr","Pr","C","Ct","P"],
|
|
|
6893 |
["Pt","S","\xc7","Pr","C","Ct","P"]];
|
|
|
6894 |
|
|
|
6895 |
$$d{"num_suff"}=
|
|
|
6896 |
[[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.",
|
|
|
6897 |
"11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.",
|
|
|
6898 |
"21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.",
|
|
|
6899 |
"31."]];
|
|
|
6900 |
|
|
|
6901 |
$$d{"num_word"}=
|
|
|
6902 |
[
|
|
|
6903 |
["birinci","ikinci","ucuncu","dorduncu",
|
|
|
6904 |
"besinci","altinci","yedinci","sekizinci",
|
|
|
6905 |
"dokuzuncu","onuncu","onbirinci","onikinci",
|
|
|
6906 |
"onucuncu","ondordoncu",
|
|
|
6907 |
"onbesinci","onaltinci","onyedinci","onsekizinci",
|
|
|
6908 |
"ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
|
|
|
6909 |
"yirmiucuncu","yirmidorduncu",
|
|
|
6910 |
"yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci",
|
|
|
6911 |
"yirmidokuzuncu","otuzuncu","otuzbirinci"],
|
|
|
6912 |
["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc",
|
|
|
6913 |
"be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci",
|
|
|
6914 |
"dokuzuncu","onuncu","onbirinci","onikinci",
|
|
|
6915 |
"on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc",
|
|
|
6916 |
"onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci",
|
|
|
6917 |
"ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
|
|
|
6918 |
"yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc",
|
|
|
6919 |
"yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci",
|
|
|
6920 |
"yirmidokuzuncu","otuzuncu","otuzbirinci"]
|
|
|
6921 |
];
|
|
|
6922 |
|
|
|
6923 |
$$d{"now"} =["\xfeimdi", "simdi", "bugun","bug\xfcn"];
|
|
|
6924 |
$$d{"last"} =["son", "sonuncu"];
|
|
|
6925 |
$$d{"each"} =["her"];
|
|
|
6926 |
$$d{"of"} =["of"];
|
|
|
6927 |
$$d{"at"} =["saat"];
|
|
|
6928 |
$$d{"on"} =["on"];
|
|
|
6929 |
$$d{"future"} =["gelecek"];
|
|
|
6930 |
$$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
|
|
|
6931 |
$$d{"next"} =["gelecek","sonraki"];
|
|
|
6932 |
$$d{"prev"} =["onceki","\xf6nceki"];
|
|
|
6933 |
$$d{"later"} =["sonra"];
|
|
|
6934 |
|
|
|
6935 |
$$d{"exact"} =["tam"];
|
|
|
6936 |
$$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"];
|
|
|
6937 |
$$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"];
|
|
|
6938 |
|
|
|
6939 |
$$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0",
|
|
|
6940 |
"dun", "-0:0:0:1:0:0:0",
|
|
|
6941 |
"yar\xfdn","+0:0:0:1:0:0:0",
|
|
|
6942 |
"yarin","+0:0:0:1:0:0:0"];
|
|
|
6943 |
|
|
|
6944 |
$$d{"times"} =["\xf6\xf0len","12:00:00",
|
|
|
6945 |
"oglen","12:00:00",
|
|
|
6946 |
"yarim","12:300:00",
|
|
|
6947 |
"yar\xfdm","12:30:00",
|
|
|
6948 |
"gece yar\xfds\xfd","00:00:00",
|
|
|
6949 |
"gece yarisi","00:00:00"];
|
|
|
6950 |
|
|
|
6951 |
$$d{"years"} =["yil","y"];
|
|
|
6952 |
$$d{"months"} =["ay","a"];
|
|
|
6953 |
$$d{"weeks"} =["hafta", "h"];
|
|
|
6954 |
$$d{"days"} =["gun","g"];
|
|
|
6955 |
$$d{"hours"} =["saat"];
|
|
|
6956 |
$$d{"minutes"} =["dakika","dak","d"];
|
|
|
6957 |
$$d{"seconds"} =["saniye","sn",];
|
|
|
6958 |
$$d{"replace"} =["s","saat"];
|
|
|
6959 |
|
|
|
6960 |
$$d{"sephm"} =':';
|
|
|
6961 |
$$d{"sepms"} =':';
|
|
|
6962 |
$$d{"sepss"} ='[.:,]';
|
|
|
6963 |
|
|
|
6964 |
$$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
|
|
|
6965 |
$$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
|
|
|
6966 |
}
|
|
|
6967 |
|
|
|
6968 |
sub Date_Init_Danish {
|
|
|
6969 |
print "DEBUG: Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
|
|
|
6970 |
my($d)=@_;
|
|
|
6971 |
|
|
|
6972 |
$$d{"month_name"}=
|
|
|
6973 |
[["Januar","Februar","Marts","April","Maj","Juni",
|
|
|
6974 |
"Juli","August","September","Oktober","November","December"]];
|
|
|
6975 |
$$d{"month_abb"}=
|
|
|
6976 |
[["Jan","Feb","Mar","Apr","Maj","Jun",
|
|
|
6977 |
"Jul","Aug","Sep","Okt","Nov","Dec"]];
|
|
|
6978 |
|
|
|
6979 |
$$d{"day_name"}=
|
|
|
6980 |
[["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
|
|
|
6981 |
["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
|
|
|
6982 |
|
|
|
6983 |
$$d{"day_abb"}=
|
|
|
6984 |
[["Man","Tis","Ons","Tor","Fre","Lor","Son"],
|
|
|
6985 |
["Man","Tis","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
|
|
|
6986 |
$$d{"day_char"}=
|
|
|
6987 |
[["M","Ti","O","To","F","L","S"]];
|
|
|
6988 |
|
|
|
6989 |
$$d{"num_suff"}=
|
|
|
6990 |
[["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
|
|
|
6991 |
"11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
|
|
|
6992 |
"21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
|
|
|
6993 |
"31:e"]];
|
|
|
6994 |
$$d{"num_word"}=
|
|
|
6995 |
[["forste","anden","tredie","fjerde","femte","sjette","syvende",
|
|
|
6996 |
"ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
|
|
|
6997 |
"femtende","sekstende","syttende","attende","nittende","tyvende",
|
|
|
6998 |
"enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
|
|
|
6999 |
"seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
|
|
|
7000 |
"tredivte","enogtredivte"],
|
|
|
7001 |
["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende",
|
|
|
7002 |
"ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
|
|
|
7003 |
"femtende","sekstende","syttende","attende","nittende","tyvende",
|
|
|
7004 |
"enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
|
|
|
7005 |
"seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
|
|
|
7006 |
"tredivte","enogtredivte"]];
|
|
|
7007 |
|
|
|
7008 |
$$d{"now"} =["idag","nu"];
|
|
|
7009 |
$$d{"last"} =["forrige","sidste","nyeste"];
|
|
|
7010 |
$$d{"each"} =["hver"];
|
|
|
7011 |
$$d{"of"} =["om"];
|
|
|
7012 |
$$d{"at"} =["kl","kl.","klokken"];
|
|
|
7013 |
$$d{"on"} =["pa","p\xe5"];
|
|
|
7014 |
$$d{"future"} =["om"];
|
|
|
7015 |
$$d{"past"} =["siden"];
|
|
|
7016 |
$$d{"next"} =["nasta","n\xe6ste"];
|
|
|
7017 |
$$d{"prev"} =["forrige"];
|
|
|
7018 |
$$d{"later"} =["senere"];
|
|
|
7019 |
|
|
|
7020 |
$$d{"exact"} =["pracist","pr\xe6cist"];
|
|
|
7021 |
$$d{"approx"} =["circa"];
|
|
|
7022 |
$$d{"business"}=["arbejdsdag","arbejdsdage"];
|
|
|
7023 |
|
|
|
7024 |
$$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
|
|
|
7025 |
"imorgen","+0:0:0:1:0:0:0"];
|
|
|
7026 |
$$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00",
|
|
|
7027 |
"midnat","00:00:00"];
|
|
|
7028 |
|
|
|
7029 |
$$d{"years"} =["ar","\xe5r"];
|
|
|
7030 |
$$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"];
|
|
|
7031 |
$$d{"weeks"} =["u","uge","uger"];
|
|
|
7032 |
$$d{"days"} =["d","dag","dage"];
|
|
|
7033 |
$$d{"hours"} =["t","tim","time","timer"];
|
|
|
7034 |
$$d{"minutes"} =["min","minut","minutter"];
|
|
|
7035 |
$$d{"seconds"} =["s","sek","sekund","sekunder"];
|
|
|
7036 |
$$d{"replace"} =["m","minut"];
|
|
|
7037 |
|
|
|
7038 |
$$d{"sephm"} ='[.:]';
|
|
|
7039 |
$$d{"sepms"} =':';
|
|
|
7040 |
$$d{"sepss"} ='[.:]';
|
|
|
7041 |
|
|
|
7042 |
$$d{"am"} = ["FM"];
|
|
|
7043 |
$$d{"pm"} = ["EM"];
|
|
|
7044 |
}
|
|
|
7045 |
|
|
|
7046 |
########################################################################
|
|
|
7047 |
# FROM MY PERSONAL LIBRARIES
|
|
|
7048 |
########################################################################
|
|
|
7049 |
|
|
|
7050 |
no integer;
|
|
|
7051 |
|
|
|
7052 |
# &ModuloAddition($N,$add,\$val,\$rem);
|
|
|
7053 |
# This calculates $val=$val+$add and forces $val to be in a certain range.
|
|
|
7054 |
# This is useful for adding numbers for which only a certain range is
|
|
|
7055 |
# allowed (for example, minutes can be between 0 and 59 or months can be
|
|
|
7056 |
# between 1 and 12). The absolute value of $N determines the range and
|
|
|
7057 |
# the sign of $N determines whether the range is 0 to N-1 (if N>0) or
|
|
|
7058 |
# 1 to N (N<0). The remainder (as modulo N) is added to $rem.
|
|
|
7059 |
# Example:
|
|
|
7060 |
# To add 2 hours together (with the excess returned in days) use:
|
|
|
7061 |
# &ModuloAddition(60,$s1,\$s,\$day);
|
|
|
7062 |
sub ModuloAddition {
|
|
|
7063 |
my($N,$add,$val,$rem)=@_;
|
|
|
7064 |
return if ($N==0);
|
|
|
7065 |
$$val+=$add;
|
|
|
7066 |
if ($N<0) {
|
|
|
7067 |
# 1 to N
|
|
|
7068 |
$N = -$N;
|
|
|
7069 |
if ($$val>$N) {
|
|
|
7070 |
$$rem+= int(($$val-1)/$N);
|
|
|
7071 |
$$val = ($$val-1)%$N +1;
|
|
|
7072 |
} elsif ($$val<1) {
|
|
|
7073 |
$$rem-= int(-$$val/$N)+1;
|
|
|
7074 |
$$val = $N-(-$$val % $N);
|
|
|
7075 |
}
|
|
|
7076 |
|
|
|
7077 |
} else {
|
|
|
7078 |
# 0 to N-1
|
|
|
7079 |
if ($$val>($N-1)) {
|
|
|
7080 |
$$rem+= int($$val/$N);
|
|
|
7081 |
$$val = $$val%$N;
|
|
|
7082 |
} elsif ($$val<0) {
|
|
|
7083 |
$$rem-= int(-($$val+1)/$N)+1;
|
|
|
7084 |
$$val = ($N-1)-(-($$val+1)%$N);
|
|
|
7085 |
}
|
|
|
7086 |
}
|
|
|
7087 |
}
|
|
|
7088 |
|
|
|
7089 |
# $Flag=&IsInt($String [,$low, $high]);
|
|
|
7090 |
# Returns 1 if $String is a valid integer, 0 otherwise. If $low is
|
|
|
7091 |
# entered, $String must be >= $low. If $high is entered, $String must
|
|
|
7092 |
# be <= $high. It is valid to check only one of the bounds.
|
|
|
7093 |
sub IsInt {
|
|
|
7094 |
my($N,$low,$high)=@_;
|
|
|
7095 |
return 0 if (! defined $N or
|
|
|
7096 |
$N !~ /^\s*[-+]?\d+\s*$/ or
|
|
|
7097 |
defined $low && $N<$low or
|
|
|
7098 |
defined $high && $N>$high);
|
|
|
7099 |
return 1;
|
|
|
7100 |
}
|
|
|
7101 |
|
|
|
7102 |
# $Pos=&SinLindex(\@List,$Str [,$offset [,$CaseInsensitive]]);
|
|
|
7103 |
# Searches for an exact string in a list.
|
|
|
7104 |
#
|
|
|
7105 |
# This is similar to RinLindex except that it searches for elements
|
|
|
7106 |
# which are exactly equal to $Str (possibly case insensitive).
|
|
|
7107 |
sub SinLindex {
|
|
|
7108 |
my($listref,$Str,$offset,$Insensitive)=@_;
|
|
|
7109 |
my($i,$len,$tmp)=();
|
|
|
7110 |
$len=$#$listref;
|
|
|
7111 |
return -2 if ($len<0 or ! $Str);
|
|
|
7112 |
return -1 if (&Index_First(\$offset,$len));
|
|
|
7113 |
$Str=uc($Str) if ($Insensitive);
|
|
|
7114 |
for ($i=$offset; $i<=$len; $i++) {
|
|
|
7115 |
$tmp=$$listref[$i];
|
|
|
7116 |
$tmp=uc($tmp) if ($Insensitive);
|
|
|
7117 |
return $i if ($tmp eq $Str);
|
|
|
7118 |
}
|
|
|
7119 |
return -1;
|
|
|
7120 |
}
|
|
|
7121 |
|
|
|
7122 |
sub Index_First {
|
|
|
7123 |
my($offsetref,$max)=@_;
|
|
|
7124 |
$$offsetref=0 if (! $$offsetref);
|
|
|
7125 |
if ($$offsetref < 0) {
|
|
|
7126 |
$$offsetref += $max + 1;
|
|
|
7127 |
$$offsetref=0 if ($$offsetref < 0);
|
|
|
7128 |
}
|
|
|
7129 |
return -1 if ($$offsetref > $max);
|
|
|
7130 |
return 0;
|
|
|
7131 |
}
|
|
|
7132 |
|
|
|
7133 |
# $File=&CleanFile($file);
|
|
|
7134 |
# This cleans up a path to remove the following things:
|
|
|
7135 |
# double slash /a//b -> /a/b
|
|
|
7136 |
# trailing dot /a/. -> /a
|
|
|
7137 |
# leading dot ./a -> a
|
|
|
7138 |
# trailing slash a/ -> a
|
|
|
7139 |
sub CleanFile {
|
|
|
7140 |
my($file)=@_;
|
|
|
7141 |
$file =~ s/\s*$//;
|
|
|
7142 |
$file =~ s/^\s*//;
|
|
|
7143 |
$file =~ s|//+|/|g; # multiple slash
|
|
|
7144 |
$file =~ s|/\.$|/|; # trailing /. (leaves trailing slash)
|
|
|
7145 |
$file =~ s|^\./|| # leading ./
|
|
|
7146 |
if ($file ne "./");
|
|
|
7147 |
$file =~ s|/$|| # trailing slash
|
|
|
7148 |
if ($file ne "/");
|
|
|
7149 |
return $file;
|
|
|
7150 |
}
|
|
|
7151 |
|
|
|
7152 |
# $File=&ExpandTilde($file);
|
|
|
7153 |
# This checks to see if a "~" appears as the first character in a path.
|
|
|
7154 |
# If it does, the "~" expansion is interpreted (if possible) and the full
|
|
|
7155 |
# path is returned. If a "~" expansion is used but cannot be
|
|
|
7156 |
# interpreted, an empty string is returned.
|
|
|
7157 |
#
|
|
|
7158 |
# This is Windows/Mac friendly.
|
|
|
7159 |
# This is efficient.
|
|
|
7160 |
sub ExpandTilde {
|
|
|
7161 |
my($file)=shift;
|
|
|
7162 |
my($user,$home)=();
|
|
|
7163 |
# ~aaa/bbb= ~ aaa /bbb
|
|
|
7164 |
if ($file =~ s|^~([^/]*)||) {
|
|
|
7165 |
$user=$1;
|
|
|
7166 |
# Single user operating systems (Mac, MSWindows) don't have the getpwnam
|
|
|
7167 |
# and getpwuid routines defined. Try to catch various different ways
|
|
|
7168 |
# of knowing we are on one of these systems:
|
|
|
7169 |
return "" if ($OS eq "Windows" or
|
|
|
7170 |
$OS eq "Mac" or
|
|
|
7171 |
$OS eq "Netware" or
|
|
|
7172 |
$OS eq "MPE");
|
|
|
7173 |
$user="" if (! defined $user);
|
|
|
7174 |
|
|
|
7175 |
if ($user) {
|
|
|
7176 |
$home= (getpwnam($user))[7];
|
|
|
7177 |
} else {
|
|
|
7178 |
$home= (getpwuid($<))[7];
|
|
|
7179 |
}
|
|
|
7180 |
$home = VMS::Filespec::unixpath($home) if ($OS eq "VMS");
|
|
|
7181 |
return "" if (! $home);
|
|
|
7182 |
$file="$home/$file";
|
|
|
7183 |
}
|
|
|
7184 |
$file;
|
|
|
7185 |
}
|
|
|
7186 |
|
|
|
7187 |
# $File=&FullFilePath($file);
|
|
|
7188 |
# Returns the full or relative path to $file (expanding "~" if necessary).
|
|
|
7189 |
# Returns an empty string if a "~" expansion cannot be interpreted. The
|
|
|
7190 |
# path does not need to exist. CleanFile is called.
|
|
|
7191 |
sub FullFilePath {
|
|
|
7192 |
my($file)=shift;
|
|
|
7193 |
my($rootpat) = '^/'; #default pattern to match absolute path
|
|
|
7194 |
$rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
|
|
|
7195 |
$file=&ExpandTilde($file);
|
|
|
7196 |
return "" if (! $file);
|
|
|
7197 |
return &CleanFile($file);
|
|
|
7198 |
}
|
|
|
7199 |
|
|
|
7200 |
# $Flag=&CheckFilePath($file [,$mode]);
|
|
|
7201 |
# Checks to see if $file exists, to see what type it is, and whether
|
|
|
7202 |
# the script can access it. If it exists and has the correct mode, 1
|
|
|
7203 |
# is returned.
|
|
|
7204 |
#
|
|
|
7205 |
# $mode is a string which may contain any of the valid file test operator
|
|
|
7206 |
# characters except t, M, A, C. The appropriate test is run for each
|
|
|
7207 |
# character. For example, if $mode is "re" the -r and -e tests are both
|
|
|
7208 |
# run.
|
|
|
7209 |
#
|
|
|
7210 |
# An empty string is returned if the file doesn't exist. A 0 is returned
|
|
|
7211 |
# if the file exists but any test fails.
|
|
|
7212 |
#
|
|
|
7213 |
# All characters in $mode which do not correspond to valid tests are
|
|
|
7214 |
# ignored.
|
|
|
7215 |
sub CheckFilePath {
|
|
|
7216 |
my($file,$mode)=@_;
|
|
|
7217 |
my($test)=();
|
|
|
7218 |
$file=&FullFilePath($file);
|
|
|
7219 |
$mode = "" if (! defined $mode);
|
|
|
7220 |
|
|
|
7221 |
# Run tests
|
|
|
7222 |
return 0 if (! defined $file or ! $file);
|
|
|
7223 |
return 0 if (( ! -e $file) or
|
|
|
7224 |
($mode =~ /r/ && ! -r $file) or
|
|
|
7225 |
($mode =~ /w/ && ! -w $file) or
|
|
|
7226 |
($mode =~ /x/ && ! -x $file) or
|
|
|
7227 |
($mode =~ /R/ && ! -R $file) or
|
|
|
7228 |
($mode =~ /W/ && ! -W $file) or
|
|
|
7229 |
($mode =~ /X/ && ! -X $file) or
|
|
|
7230 |
($mode =~ /o/ && ! -o $file) or
|
|
|
7231 |
($mode =~ /O/ && ! -O $file) or
|
|
|
7232 |
($mode =~ /z/ && ! -z $file) or
|
|
|
7233 |
($mode =~ /s/ && ! -s $file) or
|
|
|
7234 |
($mode =~ /f/ && ! -f $file) or
|
|
|
7235 |
($mode =~ /d/ && ! -d $file) or
|
|
|
7236 |
($mode =~ /l/ && ! -l $file) or
|
|
|
7237 |
($mode =~ /s/ && ! -s $file) or
|
|
|
7238 |
($mode =~ /p/ && ! -p $file) or
|
|
|
7239 |
($mode =~ /b/ && ! -b $file) or
|
|
|
7240 |
($mode =~ /c/ && ! -c $file) or
|
|
|
7241 |
($mode =~ /u/ && ! -u $file) or
|
|
|
7242 |
($mode =~ /g/ && ! -g $file) or
|
|
|
7243 |
($mode =~ /k/ && ! -k $file) or
|
|
|
7244 |
($mode =~ /T/ && ! -T $file) or
|
|
|
7245 |
($mode =~ /B/ && ! -B $file));
|
|
|
7246 |
return 1;
|
|
|
7247 |
}
|
|
|
7248 |
#&&
|
|
|
7249 |
|
|
|
7250 |
# $Path=&FixPath($path [,$full] [,$mode] [,$error]);
|
|
|
7251 |
# Makes sure that every directory in $path (a colon separated list of
|
|
|
7252 |
# directories) appears as a full path or relative path. All "~"
|
|
|
7253 |
# expansions are removed. All trailing slashes are removed also. If
|
|
|
7254 |
# $full is non-nil, relative paths are expanded to full paths as well.
|
|
|
7255 |
#
|
|
|
7256 |
# If $mode is given, it may be either "e", "r", or "w". In this case,
|
|
|
7257 |
# additional checking is done to each directory. If $mode is "e", it
|
|
|
7258 |
# need ony exist to pass the check. If $mode is "r", it must have have
|
|
|
7259 |
# read and execute permission. If $mode is "w", it must have read,
|
|
|
7260 |
# write, and execute permission.
|
|
|
7261 |
#
|
|
|
7262 |
# The value of $error determines what happens if the directory does not
|
|
|
7263 |
# pass the test. If it is non-nil, if any directory does not pass the
|
|
|
7264 |
# test, the subroutine returns the empty string. Otherwise, it is simply
|
|
|
7265 |
# removed from $path.
|
|
|
7266 |
#
|
|
|
7267 |
# The corrected path is returned.
|
|
|
7268 |
sub FixPath {
|
|
|
7269 |
my($path,$full,$mode,$err)=@_;
|
|
|
7270 |
local($_)="";
|
|
|
7271 |
my(@dir)=split(/$Cnf{"PathSep"}/,$path);
|
|
|
7272 |
$full=0 if (! defined $full);
|
|
|
7273 |
$mode="" if (! defined $mode);
|
|
|
7274 |
$err=0 if (! defined $err);
|
|
|
7275 |
$path="";
|
|
|
7276 |
if ($mode eq "e") {
|
|
|
7277 |
$mode="de";
|
|
|
7278 |
} elsif ($mode eq "r") {
|
|
|
7279 |
$mode="derx";
|
|
|
7280 |
} elsif ($mode eq "w") {
|
|
|
7281 |
$mode="derwx";
|
|
|
7282 |
}
|
|
|
7283 |
|
|
|
7284 |
foreach (@dir) {
|
|
|
7285 |
|
|
|
7286 |
# Expand path
|
|
|
7287 |
if ($full) {
|
|
|
7288 |
$_=&FullFilePath($_);
|
|
|
7289 |
} else {
|
|
|
7290 |
$_=&ExpandTilde($_);
|
|
|
7291 |
}
|
|
|
7292 |
if (! $_) {
|
|
|
7293 |
return "" if ($err);
|
|
|
7294 |
next;
|
|
|
7295 |
}
|
|
|
7296 |
|
|
|
7297 |
# Check mode
|
|
|
7298 |
if (! $mode or &CheckFilePath($_,$mode)) {
|
|
|
7299 |
$path .= $Cnf{"PathSep"} . $_;
|
|
|
7300 |
} else {
|
|
|
7301 |
return "" if ($err);
|
|
|
7302 |
}
|
|
|
7303 |
}
|
|
|
7304 |
$path =~ s/^$Cnf{"PathSep"}//;
|
|
|
7305 |
return $path;
|
|
|
7306 |
}
|
|
|
7307 |
#&&
|
|
|
7308 |
|
|
|
7309 |
# $File=&SearchPath($file,$path [,$mode] [,@suffixes]);
|
|
|
7310 |
# Searches through directories in $path for a file named $file. The
|
|
|
7311 |
# full path is returned if one is found, or an empty string otherwise.
|
|
|
7312 |
# The file may exist with one of the @suffixes. The mode is checked
|
|
|
7313 |
# similar to &CheckFilePath.
|
|
|
7314 |
#
|
|
|
7315 |
# The first full path that matches the name and mode is returned. If none
|
|
|
7316 |
# is found, an empty string is returned.
|
|
|
7317 |
sub SearchPath {
|
|
|
7318 |
my($file,$path,$mode,@suff)=@_;
|
|
|
7319 |
my($f,$s,$d,@dir,$fs)=();
|
|
|
7320 |
$path=&FixPath($path,1,"r");
|
|
|
7321 |
@dir=split(/$Cnf{"PathSep"}/,$path);
|
|
|
7322 |
foreach $d (@dir) {
|
|
|
7323 |
$f="$d/$file";
|
|
|
7324 |
$f=~ s|//|/|g;
|
|
|
7325 |
return $f if (&CheckFilePath($f,$mode));
|
|
|
7326 |
foreach $s (@suff) {
|
|
|
7327 |
$fs="$f.$s";
|
|
|
7328 |
return $fs if (&CheckFilePath($fs,$mode));
|
|
|
7329 |
}
|
|
|
7330 |
}
|
|
|
7331 |
return "";
|
|
|
7332 |
}
|
|
|
7333 |
|
|
|
7334 |
# @list=&ReturnList($str);
|
|
|
7335 |
# This takes a string which should be a comma separated list of integers
|
|
|
7336 |
# or ranges (5-7). It returns a sorted list of all integers referred to
|
|
|
7337 |
# by the string, or () if there is an invalid element.
|
|
|
7338 |
#
|
|
|
7339 |
# Negative integers are also handled. "-2--1" is equivalent to "-2,-1".
|
|
|
7340 |
sub ReturnList {
|
|
|
7341 |
my($str)=@_;
|
|
|
7342 |
my(@ret,@str,$from,$to,$tmp)=();
|
|
|
7343 |
@str=split(/,/,$str);
|
|
|
7344 |
foreach $str (@str) {
|
|
|
7345 |
if ($str =~ /^[-+]?\d+$/) {
|
|
|
7346 |
push(@ret,$str);
|
|
|
7347 |
} elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {
|
|
|
7348 |
($from,$to)=($1,$2);
|
|
|
7349 |
if ($from>$to) {
|
|
|
7350 |
$tmp=$from;
|
|
|
7351 |
$from=$to;
|
|
|
7352 |
$to=$tmp;
|
|
|
7353 |
}
|
|
|
7354 |
push(@ret,$from..$to);
|
|
|
7355 |
} else {
|
|
|
7356 |
return ();
|
|
|
7357 |
}
|
|
|
7358 |
}
|
|
|
7359 |
@ret;
|
|
|
7360 |
}
|
|
|
7361 |
|
|
|
7362 |
1;
|