line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Date::Manip::DM5; |
2
|
|
|
|
|
|
|
# Copyright (c) 1995-2022 Sullivan Beck. All rights reserved. |
3
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify it |
4
|
|
|
|
|
|
|
# under the same terms as Perl itself. |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
########################################################################### |
7
|
|
|
|
|
|
|
########################################################################### |
8
|
|
|
|
|
|
|
|
9
|
36
|
|
|
36
|
|
244
|
use warnings; |
|
36
|
|
|
|
|
73
|
|
|
36
|
|
|
|
|
23835
|
|
10
|
|
|
|
|
|
|
warnings::warnif('deprecated', 'Date::Manip::DM5 is deprecated and will be removed from the Date::Manip package starting in version 7.00'); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our($OS,%Lang,%Holiday,%Events,%Curr,%Cnf,%Zone,$VERSION,@ISA,@EXPORT); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Determine the type of OS... |
15
|
|
|
|
|
|
|
$OS="Unix"; |
16
|
|
|
|
|
|
|
$OS="Windows" if ((defined $^O and |
17
|
|
|
|
|
|
|
$^O =~ /MSWin32/i || |
18
|
|
|
|
|
|
|
$^O =~ /Windows_95/i || |
19
|
|
|
|
|
|
|
$^O =~ /Windows_NT/i) || |
20
|
|
|
|
|
|
|
(defined $ENV{OS} and |
21
|
|
|
|
|
|
|
$ENV{OS} =~ /MSWin32/i || |
22
|
|
|
|
|
|
|
$ENV{OS} =~ /Windows_95/i || |
23
|
|
|
|
|
|
|
$ENV{OS} =~ /Windows_NT/i)); |
24
|
|
|
|
|
|
|
$OS="Unix" if (defined $^O and |
25
|
|
|
|
|
|
|
$^O =~ /cygwin/i); |
26
|
|
|
|
|
|
|
$OS="Netware" if (defined $^O and |
27
|
|
|
|
|
|
|
$^O =~ /NetWare/i); |
28
|
|
|
|
|
|
|
$OS="Mac" if ((defined $^O and |
29
|
|
|
|
|
|
|
$^O =~ /MacOS/i) || |
30
|
|
|
|
|
|
|
(defined $ENV{OS} and |
31
|
|
|
|
|
|
|
$ENV{OS} =~ /MacOS/i)); |
32
|
|
|
|
|
|
|
$OS="MPE" if (defined $^O and |
33
|
|
|
|
|
|
|
$^O =~ /MPE/i); |
34
|
|
|
|
|
|
|
$OS="OS2" if (defined $^O and |
35
|
|
|
|
|
|
|
$^O =~ /os2/i); |
36
|
|
|
|
|
|
|
$OS="VMS" if (defined $^O and |
37
|
|
|
|
|
|
|
$^O =~ /VMS/i); |
38
|
|
|
|
|
|
|
$OS="AIX" if (defined $^O and |
39
|
|
|
|
|
|
|
$^O =~ /aix/i); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# Determine if we're doing taint checking |
42
|
|
|
|
|
|
|
#if ($] < 5.0080) { |
43
|
|
|
|
|
|
|
$Date::Manip::DM5::NoTaint = eval { local $^W=0; eval("#" . substr($^X, 0, 0)); 1 }; |
44
|
|
|
|
|
|
|
#} else { |
45
|
|
|
|
|
|
|
# $Date::Manip::DM5::NoTaint = (${^TAINT} == 0 ? 1 : 0); |
46
|
|
|
|
|
|
|
#} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
########################################################################### |
49
|
|
|
|
|
|
|
# CUSTOMIZATION |
50
|
|
|
|
|
|
|
########################################################################### |
51
|
|
|
|
|
|
|
# |
52
|
|
|
|
|
|
|
# See the section of the POD documentation section CUSTOMIZING DATE::MANIP |
53
|
|
|
|
|
|
|
# below for a complete description of each of these variables. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Location of a the global config file. Tilde (~) expansions are allowed. |
57
|
|
|
|
|
|
|
# This should be set in Date_Init arguments. |
58
|
|
|
|
|
|
|
$Cnf{"GlobalCnf"}=""; |
59
|
|
|
|
|
|
|
$Cnf{"IgnoreGlobalCnf"}=""; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Name of a personal config file and the path to search for it. Tilde (~) |
62
|
|
|
|
|
|
|
# expansions are allowed. This should be set in Date_Init arguments or in |
63
|
|
|
|
|
|
|
# the global config file. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
@Date::Manip::DM5::DatePath=(); |
66
|
|
|
|
|
|
|
if ($OS eq "Windows") { |
67
|
|
|
|
|
|
|
$Cnf{"PathSep"} = ";"; |
68
|
|
|
|
|
|
|
$Cnf{"PersonalCnf"} = "Manip.cnf"; |
69
|
|
|
|
|
|
|
$Cnf{"PersonalCnfPath"} = "."; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
} elsif ($OS eq "Netware") { |
72
|
|
|
|
|
|
|
$Cnf{"PathSep"} = ";"; |
73
|
|
|
|
|
|
|
$Cnf{"PersonalCnf"} = "Manip.cnf"; |
74
|
|
|
|
|
|
|
$Cnf{"PersonalCnfPath"} = "."; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
} elsif ($OS eq "MPE") { |
77
|
|
|
|
|
|
|
$Cnf{"PathSep"} = ":"; |
78
|
|
|
|
|
|
|
$Cnf{"PersonalCnf"} = "Manip.cnf"; |
79
|
|
|
|
|
|
|
$Cnf{"PersonalCnfPath"} = "."; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
} elsif ($OS eq "OS2") { |
82
|
|
|
|
|
|
|
$Cnf{"PathSep"} = ":"; |
83
|
|
|
|
|
|
|
$Cnf{"PersonalCnf"} = "Manip.cnf"; |
84
|
|
|
|
|
|
|
$Cnf{"PersonalCnfPath"} = "."; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
} elsif ($OS eq "Mac") { |
87
|
|
|
|
|
|
|
$Cnf{"PathSep"} = ":"; |
88
|
|
|
|
|
|
|
$Cnf{"PersonalCnf"} = "Manip.cnf"; |
89
|
|
|
|
|
|
|
$Cnf{"PersonalCnfPath"} = "."; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
} elsif ($OS eq "VMS") { |
92
|
|
|
|
|
|
|
# VMS doesn't like files starting with "." |
93
|
|
|
|
|
|
|
$Cnf{"PathSep"} = ","; |
94
|
|
|
|
|
|
|
$Cnf{"PersonalCnf"} = "Manip.cnf"; |
95
|
|
|
|
|
|
|
$Cnf{"PersonalCnfPath"} = "/sys\$login"; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
} else { |
98
|
|
|
|
|
|
|
# Unix |
99
|
|
|
|
|
|
|
$Cnf{"PathSep"} = ":"; |
100
|
|
|
|
|
|
|
$Cnf{"PersonalCnf"} = ".DateManip.cnf"; |
101
|
|
|
|
|
|
|
$Cnf{"PersonalCnfPath"} = ".:~"; |
102
|
|
|
|
|
|
|
@Date::Manip::DM5::DatePath=qw(/bin /usr/bin /usr/local/bin); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
### Date::Manip variables set in the global or personal config file |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Which language to use when parsing dates. |
108
|
|
|
|
|
|
|
$Cnf{"Language"}="English"; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# 12/10 = Dec 10 (US) or Oct 12 (anything else) |
111
|
|
|
|
|
|
|
$Cnf{"DateFormat"}="US"; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# Local timezone |
114
|
|
|
|
|
|
|
$Cnf{"TZ"}=""; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# Timezone to work in (""=local, "IGNORE", or a timezone) |
117
|
|
|
|
|
|
|
$Cnf{"ConvTZ"}=""; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS) |
120
|
|
|
|
|
|
|
$Cnf{"Internal"}=0; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# First day of the week (1=monday, 7=sunday). ISO 8601 says monday. |
123
|
|
|
|
|
|
|
$Cnf{"FirstDay"}=1; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# First and last day of the work week (1=monday, 7=sunday) |
126
|
|
|
|
|
|
|
$Cnf{"WorkWeekBeg"}=1; |
127
|
|
|
|
|
|
|
$Cnf{"WorkWeekEnd"}=5; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd |
130
|
|
|
|
|
|
|
# ignored) |
131
|
|
|
|
|
|
|
$Cnf{"WorkDay24Hr"}=0; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# Start and end time of the work day (any time format allowed, seconds |
134
|
|
|
|
|
|
|
# ignored) |
135
|
|
|
|
|
|
|
$Cnf{"WorkDayBeg"}="08:00"; |
136
|
|
|
|
|
|
|
$Cnf{"WorkDayEnd"}="17:00"; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# If "today" is a holiday, we look either to "tomorrow" or "yesterday" for |
139
|
|
|
|
|
|
|
# the nearest business day. By default, we'll always look "tomorrow" |
140
|
|
|
|
|
|
|
# first. |
141
|
|
|
|
|
|
|
$Cnf{"TomorrowFirst"}=1; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# Erase the old holidays |
144
|
|
|
|
|
|
|
$Cnf{"EraseHolidays"}=""; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# Set this to non-zero to be produce completely backwards compatible deltas |
147
|
|
|
|
|
|
|
$Cnf{"DeltaSigns"}=0; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1, |
150
|
|
|
|
|
|
|
# make week 1 contain Jan 1. |
151
|
|
|
|
|
|
|
$Cnf{"Jan1Week1"}=0; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# 2 digit years fall into the 100 year period given by [ CURR-N, |
154
|
|
|
|
|
|
|
# CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful |
155
|
|
|
|
|
|
|
# numbers might be 0 (forced to be this year or later) and 99 (forced to be |
156
|
|
|
|
|
|
|
# this year or earlier). It can also be set to "c" (current century) or |
157
|
|
|
|
|
|
|
# "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the |
158
|
|
|
|
|
|
|
# form cNNNN to give the 100 year period NNNN to NNNN+99. |
159
|
|
|
|
|
|
|
$Cnf{"YYtoYYYY"}=89; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# Set this to 1 if you want a long-running script to always update the |
162
|
|
|
|
|
|
|
# timezone. This will slow Date::Manip down. Read the POD documentation. |
163
|
|
|
|
|
|
|
$Cnf{"UpdateCurrTZ"}=0; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Use an international character set. |
166
|
|
|
|
|
|
|
$Cnf{"IntCharSet"}=0; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# Use this to force the current date to be set to this: |
169
|
|
|
|
|
|
|
$Cnf{"ForceDate"}=""; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# Use this to make "today" mean "today at midnight". |
172
|
|
|
|
|
|
|
$Cnf{"TodayIsMidnight"}=0; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
########################################################################### |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
require 5.000; |
177
|
|
|
|
|
|
|
require Exporter; |
178
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
179
|
|
|
|
|
|
|
@EXPORT = qw( |
180
|
|
|
|
|
|
|
DateManipVersion |
181
|
|
|
|
|
|
|
Date_Init |
182
|
|
|
|
|
|
|
ParseDateString |
183
|
|
|
|
|
|
|
ParseDate |
184
|
|
|
|
|
|
|
ParseRecur |
185
|
|
|
|
|
|
|
Date_Cmp |
186
|
|
|
|
|
|
|
DateCalc |
187
|
|
|
|
|
|
|
ParseDateDelta |
188
|
|
|
|
|
|
|
UnixDate |
189
|
|
|
|
|
|
|
Delta_Format |
190
|
|
|
|
|
|
|
Date_GetPrev |
191
|
|
|
|
|
|
|
Date_GetNext |
192
|
|
|
|
|
|
|
Date_SetTime |
193
|
|
|
|
|
|
|
Date_SetDateField |
194
|
|
|
|
|
|
|
Date_IsHoliday |
195
|
|
|
|
|
|
|
Events_List |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Date_DaysInMonth |
198
|
|
|
|
|
|
|
Date_DayOfWeek |
199
|
|
|
|
|
|
|
Date_SecsSince1970 |
200
|
|
|
|
|
|
|
Date_SecsSince1970GMT |
201
|
|
|
|
|
|
|
Date_DaysSince1BC |
202
|
|
|
|
|
|
|
Date_DayOfYear |
203
|
|
|
|
|
|
|
Date_DaysInYear |
204
|
|
|
|
|
|
|
Date_WeekOfYear |
205
|
|
|
|
|
|
|
Date_LeapYear |
206
|
|
|
|
|
|
|
Date_DaySuffix |
207
|
|
|
|
|
|
|
Date_ConvTZ |
208
|
|
|
|
|
|
|
Date_TimeZone |
209
|
|
|
|
|
|
|
Date_IsWorkDay |
210
|
|
|
|
|
|
|
Date_NextWorkDay |
211
|
|
|
|
|
|
|
Date_PrevWorkDay |
212
|
|
|
|
|
|
|
Date_NearestWorkDay |
213
|
|
|
|
|
|
|
Date_NthDayOfYear |
214
|
|
|
|
|
|
|
); |
215
|
36
|
|
|
36
|
|
254
|
use strict; |
|
36
|
|
|
|
|
72
|
|
|
36
|
|
|
|
|
781
|
|
216
|
36
|
|
|
36
|
|
17246
|
use integer; |
|
36
|
|
|
|
|
559
|
|
|
36
|
|
|
|
|
182
|
|
217
|
36
|
|
|
36
|
|
1070
|
use Carp; |
|
36
|
|
|
|
|
76
|
|
|
36
|
|
|
|
|
2406
|
|
218
|
|
|
|
|
|
|
|
219
|
36
|
|
|
36
|
|
240
|
use IO::File; |
|
36
|
|
|
|
|
67
|
|
|
36
|
|
|
|
|
5186
|
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
our($Abbrevs); |
222
|
36
|
|
|
36
|
|
14832
|
use Date::Manip::DM5abbrevs; |
|
36
|
|
|
|
|
87
|
|
|
36
|
|
|
|
|
5057
|
|
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
$VERSION='6.90'; |
225
|
|
|
|
|
|
|
our $DM5_VERSION = '5.66'; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
######################################################################## |
228
|
|
|
|
|
|
|
######################################################################## |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
$Curr{"InitLang"} = 1; # Whether a language is being init'ed |
231
|
|
|
|
|
|
|
$Curr{"InitDone"} = 0; # Whether Init_Date has been called |
232
|
|
|
|
|
|
|
$Curr{"InitFilesRead"} = 0; |
233
|
|
|
|
|
|
|
$Curr{"ResetWorkDay"} = 1; |
234
|
|
|
|
|
|
|
$Curr{"Debug"} = ""; |
235
|
|
|
|
|
|
|
$Curr{"DebugVal"} = ""; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
$Holiday{"year"} = 0; |
238
|
|
|
|
|
|
|
$Holiday{"dates"} = {}; |
239
|
|
|
|
|
|
|
$Holiday{"desc"} = {}; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
$Events{"raw"} = []; |
242
|
|
|
|
|
|
|
$Events{"parsed"} = 0; |
243
|
|
|
|
|
|
|
$Events{"dates"} = []; |
244
|
|
|
|
|
|
|
$Events{"recur"} = []; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
######################################################################## |
247
|
|
|
|
|
|
|
######################################################################## |
248
|
|
|
|
|
|
|
# THESE ARE THE MAIN ROUTINES |
249
|
|
|
|
|
|
|
######################################################################## |
250
|
|
|
|
|
|
|
######################################################################## |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# Get rid of a problem with old versions of perl |
253
|
36
|
|
|
36
|
|
223
|
no strict "vars"; |
|
36
|
|
|
|
|
69
|
|
|
36
|
|
|
|
|
2052
|
|
254
|
|
|
|
|
|
|
# This sorts from longest to shortest element |
255
|
|
|
|
|
|
|
sub _sortByLength { |
256
|
0
|
|
|
0
|
|
|
return (length $b <=> length $a); |
257
|
|
|
|
|
|
|
} |
258
|
36
|
|
|
36
|
|
187
|
use strict "vars"; |
|
36
|
|
|
|
|
76
|
|
|
36
|
|
|
|
|
453608
|
|
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub DateManipVersion { |
261
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/); |
262
|
0
|
|
|
|
|
|
return $DM5_VERSION; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub Date_Init { |
266
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/); |
267
|
0
|
|
|
|
|
|
$Curr{"Debug"}=""; |
268
|
|
|
|
|
|
|
|
269
|
0
|
|
|
|
|
|
my(@args)=@_; |
270
|
0
|
|
|
|
|
|
$Curr{"InitDone"}=1; |
271
|
0
|
|
|
|
|
|
local($_)=(); |
272
|
0
|
|
|
|
|
|
my($internal,$firstday)=(); |
273
|
0
|
|
|
|
|
|
my($var,$val,$file,@tmp)=(); |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# InitFilesRead = 0 : no conf files read yet |
276
|
|
|
|
|
|
|
# 1 : global read, no personal read |
277
|
|
|
|
|
|
|
# 2 : personal read |
278
|
|
|
|
|
|
|
|
279
|
0
|
|
|
|
|
|
$Cnf{"EraseHolidays"}=0; |
280
|
0
|
|
|
|
|
|
foreach (@args) { |
281
|
0
|
|
|
|
|
|
s/\s*$//; |
282
|
0
|
|
|
|
|
|
s/^\s*//; |
283
|
0
|
|
|
|
|
|
/^(\S+) \s* = \s* (.*)$/x; |
284
|
0
|
|
|
|
|
|
($var,$val)=($1,$2); |
285
|
0
|
0
|
|
|
|
|
if ($var =~ /^GlobalCnf$/i) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
$Cnf{"GlobalCnf"}=$val; |
287
|
0
|
0
|
|
|
|
|
if ($val) { |
288
|
0
|
|
|
|
|
|
$Curr{"InitFilesRead"}=0; |
289
|
0
|
|
|
|
|
|
EraseHolidays(); |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} elsif ($var =~ /^PathSep$/i) { |
292
|
0
|
|
|
|
|
|
$Cnf{"PathSep"}=$val; |
293
|
|
|
|
|
|
|
} elsif ($var =~ /^PersonalCnf$/i) { |
294
|
0
|
|
|
|
|
|
$Cnf{"PersonalCnf"}=$val; |
295
|
0
|
0
|
|
|
|
|
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2); |
296
|
|
|
|
|
|
|
} elsif ($var =~ /^PersonalCnfPath$/i) { |
297
|
0
|
|
|
|
|
|
$Cnf{"PersonalCnfPath"}=$val; |
298
|
0
|
0
|
|
|
|
|
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2); |
299
|
|
|
|
|
|
|
} elsif ($var =~ /^IgnoreGlobalCnf$/i) { |
300
|
0
|
0
|
|
|
|
|
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0); |
301
|
0
|
|
|
|
|
|
$Cnf{"IgnoreGlobalCnf"}=1; |
302
|
|
|
|
|
|
|
} elsif ($var =~ /^EraseHolidays$/i) { |
303
|
0
|
|
|
|
|
|
EraseHolidays(); |
304
|
|
|
|
|
|
|
} else { |
305
|
0
|
|
|
|
|
|
push(@tmp,$_); |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
} |
308
|
0
|
|
|
|
|
|
@args=@tmp; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# Read global config file |
311
|
0
|
0
|
0
|
|
|
|
if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) { |
312
|
0
|
|
|
|
|
|
$Curr{"InitFilesRead"}=1; |
313
|
|
|
|
|
|
|
|
314
|
0
|
0
|
|
|
|
|
if ($Cnf{"GlobalCnf"}) { |
315
|
0
|
|
|
|
|
|
$file=_ExpandTilde($Cnf{"GlobalCnf"}); |
316
|
0
|
0
|
|
|
|
|
_Date_InitFile($file) if ($file); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# Read personal config file |
321
|
0
|
0
|
|
|
|
|
if ($Curr{"InitFilesRead"}<2) { |
322
|
0
|
|
|
|
|
|
$Curr{"InitFilesRead"}=2; |
323
|
|
|
|
|
|
|
|
324
|
0
|
0
|
0
|
|
|
|
if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) { |
325
|
0
|
|
|
|
|
|
$file=_SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r"); |
326
|
0
|
0
|
|
|
|
|
_Date_InitFile($file) if ($file); |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
0
|
|
|
|
|
|
foreach (@args) { |
331
|
0
|
|
|
|
|
|
s/\s*$//; |
332
|
0
|
|
|
|
|
|
s/^\s*//; |
333
|
0
|
|
|
|
|
|
/^(\S+) \s* = \s* (.*)$/x; |
334
|
0
|
|
|
|
|
|
($var,$val)=($1,$2); |
335
|
0
|
0
|
|
|
|
|
$val="" if (! defined $val); |
336
|
0
|
|
|
|
|
|
_Date_SetConfigVariable($var,$val); |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
confess "ERROR: Unknown FirstDay in Date::Manip.\n" |
340
|
0
|
0
|
|
|
|
|
if (! _IsInt($Cnf{"FirstDay"},1,7)); |
341
|
|
|
|
|
|
|
confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n" |
342
|
0
|
0
|
|
|
|
|
if (! _IsInt($Cnf{"WorkWeekBeg"},1,7)); |
343
|
|
|
|
|
|
|
confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n" |
344
|
0
|
0
|
|
|
|
|
if (! _IsInt($Cnf{"WorkWeekEnd"},1,7)); |
345
|
|
|
|
|
|
|
confess "ERROR: Invalid WorkWeek in Date::Manip.\n" |
346
|
0
|
0
|
|
|
|
|
if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"}); |
347
|
|
|
|
|
|
|
|
348
|
0
|
|
|
|
|
|
my(%lang, |
349
|
|
|
|
|
|
|
$tmp,%tmp,$tmp2,@tmp2, |
350
|
|
|
|
|
|
|
$i,$j,@tmp3, |
351
|
|
|
|
|
|
|
@zones)=(); |
352
|
|
|
|
|
|
|
|
353
|
0
|
|
|
|
|
|
my($L)=$Cnf{"Language"}; |
354
|
|
|
|
|
|
|
|
355
|
0
|
0
|
|
|
|
|
if ($Curr{"InitLang"}) { |
356
|
0
|
|
|
|
|
|
$Curr{"InitLang"}=0; |
357
|
|
|
|
|
|
|
|
358
|
0
|
0
|
0
|
|
|
|
if ($L eq "English") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
359
|
0
|
|
|
|
|
|
_Date_Init_English(\%lang); |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
} elsif ($L eq "French") { |
362
|
0
|
|
|
|
|
|
_Date_Init_French(\%lang); |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
} elsif ($L eq "Swedish") { |
365
|
0
|
|
|
|
|
|
_Date_Init_Swedish(\%lang); |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
} elsif ($L eq "German") { |
368
|
0
|
|
|
|
|
|
_Date_Init_German(\%lang); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
} elsif ($L eq "Polish") { |
371
|
0
|
|
|
|
|
|
_Date_Init_Polish(\%lang); |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
} elsif ($L eq "Dutch" || |
374
|
|
|
|
|
|
|
$L eq "Nederlands") { |
375
|
0
|
|
|
|
|
|
_Date_Init_Dutch(\%lang); |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
} elsif ($L eq "Spanish") { |
378
|
0
|
|
|
|
|
|
_Date_Init_Spanish(\%lang); |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
} elsif ($L eq "Portuguese") { |
381
|
0
|
|
|
|
|
|
_Date_Init_Portuguese(\%lang); |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
} elsif ($L eq "Romanian") { |
384
|
0
|
|
|
|
|
|
_Date_Init_Romanian(\%lang); |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
} elsif ($L eq "Italian") { |
387
|
0
|
|
|
|
|
|
_Date_Init_Italian(\%lang); |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
} elsif ($L eq "Russian") { |
390
|
0
|
|
|
|
|
|
_Date_Init_Russian(\%lang); |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
} elsif ($L eq "Turkish") { |
393
|
0
|
|
|
|
|
|
_Date_Init_Turkish(\%lang); |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
} elsif ($L eq "Danish") { |
396
|
0
|
|
|
|
|
|
_Date_Init_Danish(\%lang); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
} elsif ($L eq "Catalan") { |
399
|
0
|
|
|
|
|
|
_Date_Init_Catalan(\%lang); |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
} else { |
402
|
0
|
|
|
|
|
|
confess "ERROR: Unknown language in Date::Manip.\n"; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# variables for months |
406
|
|
|
|
|
|
|
# Month = "(jan|january|feb|february ... )" |
407
|
|
|
|
|
|
|
# MonL = [ "Jan","Feb",... ] |
408
|
|
|
|
|
|
|
# MonthL = [ "January","February", ... ] |
409
|
|
|
|
|
|
|
# MonthH = { "january"=>1, "jan"=>1, ... } |
410
|
|
|
|
|
|
|
|
411
|
0
|
|
|
|
|
|
$Lang{$L}{"MonthH"}={}; |
412
|
0
|
|
|
|
|
|
$Lang{$L}{"MonthL"}=[]; |
413
|
0
|
|
|
|
|
|
$Lang{$L}{"MonL"}=[]; |
414
|
|
|
|
|
|
|
_Date_InitLists([$lang{"month_name"}, |
415
|
|
|
|
|
|
|
$lang{"month_abb"}], |
416
|
|
|
|
|
|
|
\$Lang{$L}{"Month"},"lc,sort,back", |
417
|
|
|
|
|
|
|
[$Lang{$L}{"MonthL"}, |
418
|
|
|
|
|
|
|
$Lang{$L}{"MonL"}], |
419
|
0
|
|
|
|
|
|
[$Lang{$L}{"MonthH"},1]); |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# variables for day of week |
422
|
|
|
|
|
|
|
# Week = "(mon|monday|tue|tuesday ... )" |
423
|
|
|
|
|
|
|
# WL = [ "M","T",... ] |
424
|
|
|
|
|
|
|
# WkL = [ "Mon","Tue",... ] |
425
|
|
|
|
|
|
|
# WeekL = [ "Monday","Tudesday",... ] |
426
|
|
|
|
|
|
|
# WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... } |
427
|
|
|
|
|
|
|
|
428
|
0
|
|
|
|
|
|
$Lang{$L}{"WeekH"}={}; |
429
|
0
|
|
|
|
|
|
$Lang{$L}{"WeekL"}=[]; |
430
|
0
|
|
|
|
|
|
$Lang{$L}{"WkL"}=[]; |
431
|
0
|
|
|
|
|
|
$Lang{$L}{"WL"}=[]; |
432
|
|
|
|
|
|
|
_Date_InitLists([$lang{"day_name"}, |
433
|
|
|
|
|
|
|
$lang{"day_abb"}], |
434
|
|
|
|
|
|
|
\$Lang{$L}{"Week"},"lc,sort,back", |
435
|
|
|
|
|
|
|
[$Lang{$L}{"WeekL"}, |
436
|
|
|
|
|
|
|
$Lang{$L}{"WkL"}], |
437
|
0
|
|
|
|
|
|
[$Lang{$L}{"WeekH"},1]); |
438
|
|
|
|
|
|
|
_Date_InitLists([$lang{"day_char"}], |
439
|
|
|
|
|
|
|
"","lc", |
440
|
0
|
|
|
|
|
|
[$Lang{$L}{"WL"}], |
441
|
|
|
|
|
|
|
[\%tmp,1]); |
442
|
0
|
|
|
|
|
|
%{ $Lang{$L}{"WeekH"} } = |
443
|
0
|
|
|
|
|
|
(%{ $Lang{$L}{"WeekH"} },%tmp); |
|
0
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
# variables for last |
446
|
|
|
|
|
|
|
# Last = "(last)" |
447
|
|
|
|
|
|
|
# LastL = [ "last" ] |
448
|
|
|
|
|
|
|
# Each = "(each)" |
449
|
|
|
|
|
|
|
# EachL = [ "each" ] |
450
|
|
|
|
|
|
|
# variables for day of month |
451
|
|
|
|
|
|
|
# DoM = "(1st|first ... 31st)" |
452
|
|
|
|
|
|
|
# DoML = [ "1st","2nd",... "31st" ] |
453
|
|
|
|
|
|
|
# DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 } |
454
|
|
|
|
|
|
|
# variables for week of month |
455
|
|
|
|
|
|
|
# WoM = "(1st|first| ... 5th|last)" |
456
|
|
|
|
|
|
|
# WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 } |
457
|
|
|
|
|
|
|
|
458
|
0
|
|
|
|
|
|
$Lang{$L}{"LastL"}=$lang{"last"}; |
459
|
|
|
|
|
|
|
_Date_InitStrings($lang{"last"}, |
460
|
0
|
|
|
|
|
|
\$Lang{$L}{"Last"},"lc,sort"); |
461
|
|
|
|
|
|
|
|
462
|
0
|
|
|
|
|
|
$Lang{$L}{"EachL"}=$lang{"each"}; |
463
|
|
|
|
|
|
|
_Date_InitStrings($lang{"each"}, |
464
|
0
|
|
|
|
|
|
\$Lang{$L}{"Each"},"lc,sort"); |
465
|
|
|
|
|
|
|
|
466
|
0
|
|
|
|
|
|
$Lang{$L}{"DoMH"}={}; |
467
|
0
|
|
|
|
|
|
$Lang{$L}{"DoML"}=[]; |
468
|
|
|
|
|
|
|
_Date_InitLists([$lang{"num_suff"}, |
469
|
|
|
|
|
|
|
$lang{"num_word"}], |
470
|
|
|
|
|
|
|
\$Lang{$L}{"DoM"},"lc,sort,back,escape", |
471
|
|
|
|
|
|
|
[$Lang{$L}{"DoML"}, |
472
|
|
|
|
|
|
|
\@tmp], |
473
|
0
|
|
|
|
|
|
[$Lang{$L}{"DoMH"},1]); |
474
|
|
|
|
|
|
|
|
475
|
0
|
|
|
|
|
|
@tmp=(); |
476
|
0
|
|
|
|
|
|
foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) { |
|
0
|
|
|
|
|
|
|
477
|
0
|
|
|
|
|
|
$tmp2=$Lang{$L}{"DoMH"}{$tmp}; |
478
|
0
|
0
|
|
|
|
|
if ($tmp2<6) { |
479
|
0
|
|
|
|
|
|
$Lang{$L}{"WoMH"}{$tmp} = $tmp2; |
480
|
0
|
|
|
|
|
|
push(@tmp,$tmp); |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
} |
483
|
0
|
|
|
|
|
|
foreach $tmp (@{ $Lang{$L}{"LastL"} }) { |
|
0
|
|
|
|
|
|
|
484
|
0
|
|
|
|
|
|
$Lang{$L}{"WoMH"}{$tmp} = -1; |
485
|
0
|
|
|
|
|
|
push(@tmp,$tmp); |
486
|
|
|
|
|
|
|
} |
487
|
0
|
|
|
|
|
|
_Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"}, |
488
|
|
|
|
|
|
|
"lc,sort,back,escape"); |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
# variables for AM or PM |
491
|
|
|
|
|
|
|
# AM = "(am)" |
492
|
|
|
|
|
|
|
# PM = "(pm)" |
493
|
|
|
|
|
|
|
# AmPm = "(am|pm)" |
494
|
|
|
|
|
|
|
# AMstr = "AM" |
495
|
|
|
|
|
|
|
# PMstr = "PM" |
496
|
|
|
|
|
|
|
|
497
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape"); |
498
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape"); |
499
|
0
|
|
|
|
|
|
_Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"}, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
"lc,back,sort,escape"); |
501
|
0
|
|
|
|
|
|
$Lang{$L}{"AMstr"}=$lang{"am"}[0]; |
502
|
0
|
|
|
|
|
|
$Lang{$L}{"PMstr"}=$lang{"pm"}[0]; |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
# variables for expressions used in parsing deltas |
505
|
|
|
|
|
|
|
# Yabb = "(?:y|yr|year|years)" |
506
|
|
|
|
|
|
|
# Mabb = similar for months |
507
|
|
|
|
|
|
|
# Wabb = similar for weeks |
508
|
|
|
|
|
|
|
# Dabb = similar for days |
509
|
|
|
|
|
|
|
# Habb = similar for hours |
510
|
|
|
|
|
|
|
# MNabb = similar for minutes |
511
|
|
|
|
|
|
|
# Sabb = similar for seconds |
512
|
|
|
|
|
|
|
# Repl = { "abb"=>"replacement" } |
513
|
|
|
|
|
|
|
# Whenever an abbreviation could potentially refer to two different |
514
|
|
|
|
|
|
|
# strings (M standing for Minutes or Months), the abbreviation must |
515
|
|
|
|
|
|
|
# be listed in Repl instead of in the appropriate Xabb values. This |
516
|
|
|
|
|
|
|
# only applies to abbreviations which are substrings of other values |
517
|
|
|
|
|
|
|
# (so there is no confusion between Mn and Month). |
518
|
|
|
|
|
|
|
|
519
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort"); |
520
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort"); |
521
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort"); |
522
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort"); |
523
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort"); |
524
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort"); |
525
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort"); |
526
|
0
|
|
|
|
|
|
$Lang{$L}{"Repl"}={}; |
527
|
0
|
|
|
|
|
|
_Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"}); |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# variables for special dates that are offsets from now |
530
|
|
|
|
|
|
|
# Now = "now" |
531
|
|
|
|
|
|
|
# Today = "today" |
532
|
|
|
|
|
|
|
# Offset = "(yesterday|tomorrow)" |
533
|
|
|
|
|
|
|
# OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ] |
534
|
|
|
|
|
|
|
# Times = "(noon|midnight)" |
535
|
|
|
|
|
|
|
# TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" } |
536
|
|
|
|
|
|
|
# SepHM = hour/minute separator |
537
|
|
|
|
|
|
|
# SepMS = minute/second separator |
538
|
|
|
|
|
|
|
# SepSS = second/fraction separator |
539
|
|
|
|
|
|
|
|
540
|
0
|
|
|
|
|
|
$Lang{$L}{"TimesH"}={}; |
541
|
|
|
|
|
|
|
_Date_InitHash($lang{"times"}, |
542
|
|
|
|
|
|
|
\$Lang{$L}{"Times"},"lc,sort,back", |
543
|
0
|
|
|
|
|
|
$Lang{$L}{"TimesH"}); |
544
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort"); |
545
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"today"},\$Lang{$L}{"Today"},"lc,sort"); |
546
|
0
|
|
|
|
|
|
$Lang{$L}{"OffsetH"}={}; |
547
|
|
|
|
|
|
|
_Date_InitHash($lang{"offset"}, |
548
|
|
|
|
|
|
|
\$Lang{$L}{"Offset"},"lc,sort,back", |
549
|
0
|
|
|
|
|
|
$Lang{$L}{"OffsetH"}); |
550
|
0
|
|
|
|
|
|
$Lang{$L}{"SepHM"}=$lang{"sephm"}; |
551
|
0
|
|
|
|
|
|
$Lang{$L}{"SepMS"}=$lang{"sepms"}; |
552
|
0
|
|
|
|
|
|
$Lang{$L}{"SepSS"}=$lang{"sepss"}; |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
# variables for time zones |
555
|
|
|
|
|
|
|
# zones = regular expression with all zone names (EST) |
556
|
|
|
|
|
|
|
# n2o = a hash of all parsable zone names with their offsets |
557
|
|
|
|
|
|
|
# tzones = reguar expression with all tzdata timezones (US/Eastern) |
558
|
|
|
|
|
|
|
# tz2z = hash of all tzdata timezones to full timezone (EST#EDT) |
559
|
|
|
|
|
|
|
|
560
|
0
|
|
|
|
|
|
$Zone{"n2o"} = {}; |
561
|
0
|
|
|
|
|
|
($Zone{"zones"},%{ $Zone{"n2o"} })= |
|
0
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
_Date_Regexp($Abbrevs,"sort,lc,under,back", |
563
|
|
|
|
|
|
|
"keys"); |
564
|
|
|
|
|
|
|
|
565
|
0
|
|
|
|
|
|
$tmp= |
566
|
|
|
|
|
|
|
"US/Pacific PST8PDT ". |
567
|
|
|
|
|
|
|
"US/Mountain MST7MDT ". |
568
|
|
|
|
|
|
|
"US/Central CST6CDT ". |
569
|
|
|
|
|
|
|
"US/Eastern EST5EDT ". |
570
|
|
|
|
|
|
|
"Canada/Pacific PST8PDT ". |
571
|
|
|
|
|
|
|
"Canada/Mountain MST7MDT ". |
572
|
|
|
|
|
|
|
"Canada/Central CST6CDT ". |
573
|
|
|
|
|
|
|
"Canada/Eastern EST5EDT"; |
574
|
|
|
|
|
|
|
|
575
|
0
|
|
|
|
|
|
$Zone{"tz2z"} = {}; |
576
|
0
|
|
|
|
|
|
($Zone{"tzones"},%{ $Zone{"tz2z"} })= |
|
0
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
_Date_Regexp($tmp,"lc,under,back","keys"); |
578
|
0
|
|
|
|
|
|
$Cnf{"TZ"}=Date_TimeZone(); |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
# misc. variables |
581
|
|
|
|
|
|
|
# At = "(?:at)" |
582
|
|
|
|
|
|
|
# Of = "(?:in|of)" |
583
|
|
|
|
|
|
|
# On = "(?:on)" |
584
|
|
|
|
|
|
|
# Future = "(?:in)" |
585
|
|
|
|
|
|
|
# Later = "(?:later)" |
586
|
|
|
|
|
|
|
# Past = "(?:ago)" |
587
|
|
|
|
|
|
|
# Next = "(?:next)" |
588
|
|
|
|
|
|
|
# Prev = "(?:last|previous)" |
589
|
|
|
|
|
|
|
|
590
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort"); |
591
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort"); |
592
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort"); |
593
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort"); |
594
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort"); |
595
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort"); |
596
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort"); |
597
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort"); |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
# calc mode variables |
600
|
|
|
|
|
|
|
# Approx = "(?:approximately)" |
601
|
|
|
|
|
|
|
# Exact = "(?:exactly)" |
602
|
|
|
|
|
|
|
# Business = "(?:business)" |
603
|
|
|
|
|
|
|
|
604
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort"); |
605
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort"); |
606
|
0
|
|
|
|
|
|
_Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort"); |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
############### END OF LANGUAGE INITIALIZATION |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
0
|
0
|
|
|
|
|
if ($Curr{"ResetWorkDay"}) { |
612
|
0
|
|
|
|
|
|
my($h1,$m1,$h2,$m2)=(); |
613
|
0
|
0
|
|
|
|
|
if ($Cnf{"WorkDay24Hr"}) { |
614
|
0
|
|
|
|
|
|
($Curr{"WDBh"},$Curr{"WDBm"})=(0,0); |
615
|
0
|
|
|
|
|
|
($Curr{"WDEh"},$Curr{"WDEm"})=(24,0); |
616
|
0
|
|
|
|
|
|
$Curr{"WDlen"}=24*60; |
617
|
0
|
|
|
|
|
|
$Cnf{"WorkDayBeg"}="00:00"; |
618
|
0
|
|
|
|
|
|
$Cnf{"WorkDayEnd"}="23:59"; |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
} else { |
621
|
|
|
|
|
|
|
confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n" |
622
|
0
|
0
|
|
|
|
|
if (! (($h1,$m1)=_CheckTime($Cnf{"WorkDayBeg"}))); |
623
|
0
|
|
|
|
|
|
$Cnf{"WorkDayBeg"}="$h1:$m1"; |
624
|
|
|
|
|
|
|
confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n" |
625
|
0
|
0
|
|
|
|
|
if (! (($h2,$m2)=_CheckTime($Cnf{"WorkDayEnd"}))); |
626
|
0
|
|
|
|
|
|
$Cnf{"WorkDayEnd"}="$h2:$m2"; |
627
|
|
|
|
|
|
|
|
628
|
0
|
|
|
|
|
|
($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1); |
629
|
0
|
|
|
|
|
|
($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2); |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
# Work day length = h1:m1 or 0:len (len minutes) |
632
|
0
|
|
|
|
|
|
$h1=$h2-$h1; |
633
|
0
|
|
|
|
|
|
$m1=$m2-$m1; |
634
|
0
|
0
|
|
|
|
|
if ($m1<0) { |
635
|
0
|
|
|
|
|
|
$h1--; |
636
|
0
|
|
|
|
|
|
$m1+=60; |
637
|
|
|
|
|
|
|
} |
638
|
0
|
|
|
|
|
|
$Curr{"WDlen"}=$h1*60+$m1; |
639
|
|
|
|
|
|
|
} |
640
|
0
|
|
|
|
|
|
$Curr{"ResetWorkDay"}=0; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# current time |
644
|
0
|
|
|
|
|
|
my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=(); |
645
|
0
|
0
|
|
|
|
|
if ($Cnf{"ForceDate"}=~ |
646
|
|
|
|
|
|
|
/^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) { |
647
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6); |
648
|
|
|
|
|
|
|
} else { |
649
|
0
|
|
|
|
|
|
($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time); |
650
|
0
|
|
|
|
|
|
$y+=1900; |
651
|
0
|
|
|
|
|
|
$m++; |
652
|
|
|
|
|
|
|
} |
653
|
0
|
|
|
|
|
|
_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk); |
654
|
0
|
|
|
|
|
|
$Curr{"Y"}=$y; |
655
|
0
|
|
|
|
|
|
$Curr{"M"}=$m; |
656
|
0
|
|
|
|
|
|
$Curr{"D"}=$d; |
657
|
0
|
|
|
|
|
|
$Curr{"H"}=$h; |
658
|
0
|
|
|
|
|
|
$Curr{"Mn"}=$mn; |
659
|
0
|
|
|
|
|
|
$Curr{"S"}=$s; |
660
|
0
|
|
|
|
|
|
$Curr{"AmPm"}=$ampm; |
661
|
0
|
|
|
|
|
|
$Curr{"Now"}=_Date_Join($y,$m,$d,$h,$mn,$s); |
662
|
0
|
0
|
|
|
|
|
if ($Cnf{"TodayIsMidnight"}) { |
663
|
0
|
|
|
|
|
|
$Curr{"Today"}=_Date_Join($y,$m,$d,0,0,0); |
664
|
|
|
|
|
|
|
} else { |
665
|
0
|
|
|
|
|
|
$Curr{"Today"}=$Curr{"Now"}; |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
|
668
|
0
|
|
|
|
|
|
$Curr{"Debug"}=$Curr{"DebugVal"}; |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
# If we're in array context, let's return a list of config variables |
671
|
|
|
|
|
|
|
# that could be passed to Date_Init to get the same state as we're |
672
|
|
|
|
|
|
|
# currently in. |
673
|
0
|
0
|
|
|
|
|
if (wantarray) { |
674
|
|
|
|
|
|
|
# Some special variables that have to be in a specific order |
675
|
0
|
|
|
|
|
|
my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath); |
676
|
0
|
|
|
|
|
|
my(%tmp)=map { $_,1 } @special; |
|
0
|
|
|
|
|
|
|
677
|
0
|
|
|
|
|
|
my(@tmp,$key,$val); |
678
|
0
|
|
|
|
|
|
foreach $key (@special) { |
679
|
0
|
|
|
|
|
|
$val=$Cnf{$key}; |
680
|
0
|
|
|
|
|
|
push(@tmp,"$key=$val"); |
681
|
|
|
|
|
|
|
} |
682
|
0
|
|
|
|
|
|
foreach $key (keys %Cnf) { |
683
|
0
|
0
|
|
|
|
|
next if (exists $tmp{$key}); |
684
|
0
|
|
|
|
|
|
$val=$Cnf{$key}; |
685
|
0
|
|
|
|
|
|
push(@tmp,"$key=$val"); |
686
|
|
|
|
|
|
|
} |
687
|
0
|
|
|
|
|
|
return @tmp; |
688
|
|
|
|
|
|
|
} |
689
|
0
|
|
|
|
|
|
return (); |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
sub ParseDateString { |
693
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/); |
694
|
0
|
|
|
|
|
|
local($_)=@_; |
695
|
0
|
0
|
|
|
|
|
return "" if (! $_); |
696
|
|
|
|
|
|
|
|
697
|
0
|
|
|
|
|
|
my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=(); |
698
|
0
|
|
|
|
|
|
my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=(); |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
# We only need to reinitialize if we have to determine what NOW is. |
701
|
0
|
0
|
0
|
|
|
|
Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"}); |
702
|
|
|
|
|
|
|
|
703
|
0
|
|
|
|
|
|
my($L)=$Cnf{"Language"}; |
704
|
0
|
|
|
|
|
|
my($type)=$Cnf{"DateFormat"}; |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
# Mode is set in DateCalc. ParseDate only overrides it if the string |
707
|
|
|
|
|
|
|
# contains a mode. |
708
|
0
|
0
|
0
|
|
|
|
if ($Lang{$L}{"Exact"} && |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
709
|
|
|
|
|
|
|
s/$Lang{$L}{"Exact"}//) { |
710
|
0
|
|
|
|
|
|
$Curr{"Mode"}=0; |
711
|
|
|
|
|
|
|
} elsif ($Lang{$L}{"Approx"} && |
712
|
|
|
|
|
|
|
s/$Lang{$L}{"Approx"}//) { |
713
|
0
|
|
|
|
|
|
$Curr{"Mode"}=1; |
714
|
|
|
|
|
|
|
} elsif ($Lang{$L}{"Business"} && |
715
|
|
|
|
|
|
|
s/$Lang{$L}{"Business"}//) { |
716
|
0
|
|
|
|
|
|
$Curr{"Mode"}=2; |
717
|
|
|
|
|
|
|
} elsif (! exists $Curr{"Mode"}) { |
718
|
0
|
|
|
|
|
|
$Curr{"Mode"}=0; |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
# Unfortunately, some deltas can be parsed as dates. An example is |
722
|
|
|
|
|
|
|
# 1 second == 1 2nd == 1 2 |
723
|
|
|
|
|
|
|
# But, some dates can be parsed as deltas. The most important being: |
724
|
|
|
|
|
|
|
# 1998010101:00:00 |
725
|
|
|
|
|
|
|
# |
726
|
|
|
|
|
|
|
# We'll check to see if a "date" can be parsed as a delta. If so, we'll |
727
|
|
|
|
|
|
|
# assume that it is a delta (since they are much simpler, it is much |
728
|
|
|
|
|
|
|
# less likely that we'll mistake a delta for a date than vice versa) |
729
|
|
|
|
|
|
|
# unless it is an ISO-8601 date. |
730
|
|
|
|
|
|
|
# |
731
|
|
|
|
|
|
|
# This is important because we are using DateCalc to test whether a |
732
|
|
|
|
|
|
|
# string is a date or a delta. Dates are tested first, so we need to |
733
|
|
|
|
|
|
|
# be able to pass a delta into this routine and have it correctly NOT |
734
|
|
|
|
|
|
|
# interpreted as a date. |
735
|
|
|
|
|
|
|
# |
736
|
|
|
|
|
|
|
# We will insist that the string contain something other than digits and |
737
|
|
|
|
|
|
|
# colons so that the following will get correctly interpreted as a date |
738
|
|
|
|
|
|
|
# rather than a delta: |
739
|
|
|
|
|
|
|
# 12:30 |
740
|
|
|
|
|
|
|
# 19980101 |
741
|
|
|
|
|
|
|
|
742
|
0
|
|
|
|
|
|
$delta=""; |
743
|
0
|
0
|
|
|
|
|
$delta=ParseDateDelta($_) if (/[^:0-9]/); |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
# Put parse in a simple loop for an easy exit. |
746
|
|
|
|
|
|
|
PARSE: { |
747
|
0
|
|
|
|
|
|
my(@tmp)=_Date_Split($_); |
|
0
|
|
|
|
|
|
|
748
|
0
|
0
|
|
|
|
|
if (@tmp) { |
749
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=@tmp; |
750
|
0
|
|
|
|
|
|
last PARSE; |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# Fundamental regular expressions |
754
|
|
|
|
|
|
|
|
755
|
0
|
|
|
|
|
|
my($month)=$Lang{$L}{"Month"}; # (jan|january|...) |
756
|
0
|
|
|
|
|
|
my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... } |
|
0
|
|
|
|
|
|
|
757
|
0
|
|
|
|
|
|
my($week)=$Lang{$L}{"Week"}; # (mon|monday|...) |
758
|
0
|
|
|
|
|
|
my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... } |
|
0
|
|
|
|
|
|
|
759
|
0
|
|
|
|
|
|
my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last) |
760
|
0
|
|
|
|
|
|
my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 } |
|
0
|
|
|
|
|
|
|
761
|
0
|
|
|
|
|
|
my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st) |
762
|
0
|
|
|
|
|
|
my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... } |
|
0
|
|
|
|
|
|
|
763
|
0
|
|
|
|
|
|
my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm) |
764
|
0
|
|
|
|
|
|
my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight) |
765
|
0
|
|
|
|
|
|
my($now)=$Lang{$L}{"Now"}; # now |
766
|
0
|
|
|
|
|
|
my($today)=$Lang{$L}{"Today"}; # today |
767
|
0
|
|
|
|
|
|
my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow) |
768
|
0
|
|
|
|
|
|
my($zone)=$Zone{"zones"}; # (edt|est|...) |
769
|
0
|
|
|
|
|
|
my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days) |
770
|
0
|
|
|
|
|
|
my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months) |
771
|
0
|
|
|
|
|
|
my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks) |
772
|
0
|
|
|
|
|
|
my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next) |
773
|
0
|
|
|
|
|
|
my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous) |
774
|
0
|
|
|
|
|
|
my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago) |
775
|
0
|
|
|
|
|
|
my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in) |
776
|
0
|
|
|
|
|
|
my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later) |
777
|
0
|
|
|
|
|
|
my($at)=$Lang{$L}{"At"}; # (?:at) |
778
|
0
|
|
|
|
|
|
my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of) |
779
|
0
|
|
|
|
|
|
my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)'; |
780
|
|
|
|
|
|
|
# \s*(?:on)\s* or \s+ |
781
|
0
|
|
|
|
|
|
my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last) |
782
|
0
|
|
|
|
|
|
my($hm)=$Lang{$L}{"SepHM"}; # : |
783
|
0
|
|
|
|
|
|
my($ms)=$Lang{$L}{"SepMS"}; # : |
784
|
0
|
|
|
|
|
|
my($ss)=$Lang{$L}{"SepSS"}; # . |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
# Other regular expressions |
787
|
|
|
|
|
|
|
|
788
|
0
|
|
|
|
|
|
my($D4)='(\d{4})'; # 4 digits (yr) |
789
|
0
|
|
|
|
|
|
my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr) |
790
|
0
|
|
|
|
|
|
my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec) |
791
|
0
|
|
|
|
|
|
my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr) |
792
|
0
|
|
|
|
|
|
my($FS)="(?:$ss\\d+)?"; # fractional secs |
793
|
0
|
|
|
|
|
|
my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators |
794
|
|
|
|
|
|
|
# absolute time zone +0700 (GMT) |
795
|
0
|
|
|
|
|
|
my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23 |
796
|
0
|
|
|
|
|
|
my($mzone)='(?:[0-5][0-9])'; # 00 - 59 |
797
|
0
|
|
|
|
|
|
my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))". |
798
|
|
|
|
|
|
|
# +0700 +07:00 -07 |
799
|
|
|
|
|
|
|
'(?:\s*\([^)]+\))?)'; # (GMT) |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
# A regular expression for the time EXCEPT for the hour part |
802
|
0
|
|
|
|
|
|
my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?"; |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
# A special regular expression for /YYYY:HH:MN:SS used by Apache |
805
|
0
|
|
|
|
|
|
my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD"; |
806
|
|
|
|
|
|
|
|
807
|
0
|
|
|
|
|
|
my($time)=""; |
808
|
0
|
|
|
|
|
|
$ampm=""; |
809
|
0
|
|
|
|
|
|
$date=""; |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
# Substitute all special time expressions. |
812
|
0
|
0
|
|
|
|
|
if (/(^|[^a-z])$timeexp($|[^a-z])/i) { |
813
|
0
|
|
|
|
|
|
$tmp=$2; |
814
|
0
|
|
|
|
|
|
$tmp=$Lang{$L}{"TimesH"}{lc($tmp)}; |
815
|
0
|
|
|
|
|
|
s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
# Remove some punctuation |
819
|
0
|
|
|
|
|
|
s/[,]/ /g; |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
# When we have a digit followed immediately by a timezone (7EST), we |
822
|
|
|
|
|
|
|
# will put a space between the digit, EXCEPT in the case of a single |
823
|
|
|
|
|
|
|
# character military timezone. If the single character is followed |
824
|
|
|
|
|
|
|
# by anything, no space is added. |
825
|
0
|
|
|
|
|
|
$tmp = ""; |
826
|
0
|
|
|
|
|
|
while ( s/^(.*?\d)$zone(\s|$|[0-9])/$3/i ) { |
827
|
0
|
|
|
|
|
|
my($bef,$z,$aft) = ($1,$2,$3); |
828
|
0
|
0
|
0
|
|
|
|
if (length($z) != 1 || length($aft) == 0) { |
829
|
0
|
|
|
|
|
|
$tmp .= "$bef $z"; |
830
|
|
|
|
|
|
|
} else { |
831
|
0
|
|
|
|
|
|
$tmp .= "$bef$z"; |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
} |
834
|
0
|
|
|
|
|
|
$_ = "$tmp$_"; |
835
|
0
|
|
|
|
|
|
$zone = '\s+' . $zone . '(?:\s+|$)'; |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
# Remove the time |
838
|
0
|
|
|
|
|
|
$iso=1; |
839
|
0
|
|
|
|
|
|
$midnight=0; |
840
|
0
|
|
|
|
|
|
$from="24${hm}00(?:${ms}00)?"; |
841
|
0
|
|
|
|
|
|
$falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00 |
842
|
0
|
|
|
|
|
|
$to="00${hm}00${ms}00"; |
843
|
0
|
0
|
0
|
|
|
|
$midnight=1 if (!/$falsefrom/ && s/$from/$to/); |
844
|
|
|
|
|
|
|
|
845
|
0
|
|
|
|
|
|
$h=$mn=$s=0; |
846
|
0
|
0
|
0
|
|
|
|
if (/$D$mnsec/i || /$ampmexp/i) { |
847
|
0
|
|
|
|
|
|
$iso=0; |
848
|
0
|
|
|
|
|
|
$tmp=0; |
849
|
0
|
0
|
0
|
|
|
|
$tmp=1 if (/$mnsec$zone2?\s*$/i or /$mnsec$zone\s*$/i); |
850
|
0
|
0
|
|
|
|
|
$tmp=0 if (/$ampmexp/i); |
851
|
0
|
0
|
0
|
|
|
|
if (s/$apachetime$zone()/$1 /i || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
852
|
|
|
|
|
|
|
s/$apachetime$zone2?/$1 /i || |
853
|
|
|
|
|
|
|
s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i || |
854
|
|
|
|
|
|
|
s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i || |
855
|
|
|
|
|
|
|
s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i || |
856
|
|
|
|
|
|
|
s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i || |
857
|
|
|
|
|
|
|
(s/(t)$D$mnsec$zone()/$1 /i and (($iso=$tmp) || 1)) || |
858
|
|
|
|
|
|
|
(s/(t)$D$mnsec$zone2?/$1 /i and (($iso=$tmp) || 1)) || |
859
|
|
|
|
|
|
|
(s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) || |
860
|
|
|
|
|
|
|
(s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) || |
861
|
|
|
|
|
|
|
s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i || |
862
|
|
|
|
|
|
|
s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i || |
863
|
|
|
|
|
|
|
0 |
864
|
|
|
|
|
|
|
) { |
865
|
0
|
|
|
|
|
|
($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7); |
866
|
0
|
0
|
|
|
|
|
if (defined ($z)) { |
867
|
0
|
0
|
|
|
|
|
if ($z =~ /^[+-]\d{2}:\d{2}$/) { |
|
|
0
|
|
|
|
|
|
868
|
0
|
|
|
|
|
|
$z=~ s/://; |
869
|
|
|
|
|
|
|
} elsif ($z =~ /^[+-]\d{2}$/) { |
870
|
0
|
|
|
|
|
|
$z .= "00"; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
} |
873
|
0
|
|
|
|
|
|
$time=1; |
874
|
0
|
|
|
|
|
|
_Date_TimeCheck(\$h,\$mn,\$s,\$ampm); |
875
|
0
|
|
|
|
|
|
$y=$m=$d=""; |
876
|
|
|
|
|
|
|
# We're going to be calling TimeCheck again below (when we check the |
877
|
|
|
|
|
|
|
# final date), so get rid of $ampm so that we don't have an error |
878
|
|
|
|
|
|
|
# due to "15:30:00 PM". It'll get reset below. |
879
|
0
|
|
|
|
|
|
$ampm=""; |
880
|
0
|
0
|
|
|
|
|
if (/^\s*$/) { |
881
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
882
|
0
|
|
|
|
|
|
last PARSE; |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
} |
886
|
0
|
0
|
|
|
|
|
$time=0 if ($time ne "1"); |
887
|
0
|
|
|
|
|
|
s/\s+$//; |
888
|
0
|
|
|
|
|
|
s/^\s+//; |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
# if a zone was found, get rid of the regexps |
891
|
0
|
0
|
|
|
|
|
if ($z) { |
892
|
0
|
|
|
|
|
|
$zone=""; |
893
|
0
|
|
|
|
|
|
$zone2=""; |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
# dateTtime ISO 8601 formats |
897
|
0
|
|
|
|
|
|
my($orig)=$_; |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
# Parse ISO 8601 dates now (which may still have a zone stuck to it). |
900
|
0
|
0
|
0
|
|
|
|
if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
901
|
|
|
|
|
|
|
($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) || |
902
|
|
|
|
|
|
|
($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) || |
903
|
|
|
|
|
|
|
($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) || |
904
|
|
|
|
|
|
|
($iso && /^([0-9-]+)T$zone?$/i) || |
905
|
|
|
|
|
|
|
($iso && /^([0-9-]+)T$zone2?$/i) || |
906
|
|
|
|
|
|
|
0) { |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
# If we already got a timezone, don't get another one. |
909
|
0
|
|
|
|
|
|
my(@z); |
910
|
0
|
0
|
|
|
|
|
if ($z) { |
911
|
0
|
|
|
|
|
|
@z=($z,$z2); |
912
|
0
|
|
|
|
|
|
$z=""; |
913
|
|
|
|
|
|
|
} |
914
|
0
|
|
|
|
|
|
($_,$z,$z2) = ($1,$2,$3); |
915
|
0
|
0
|
|
|
|
|
($z,$z2)=@z if (@z); |
916
|
|
|
|
|
|
|
|
917
|
0
|
|
|
|
|
|
s,([0-9])\s*-,$1 ,g; # Change all ISO8601 seps to spaces |
918
|
0
|
|
|
|
|
|
s/^\s+//; |
919
|
0
|
|
|
|
|
|
s/\s+$//; |
920
|
|
|
|
|
|
|
|
921
|
0
|
0
|
0
|
|
|
|
if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i || |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
922
|
|
|
|
|
|
|
/^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i || |
923
|
|
|
|
|
|
|
0 |
924
|
|
|
|
|
|
|
) { |
925
|
|
|
|
|
|
|
# ISO 8601 Dates with times |
926
|
|
|
|
|
|
|
# YYYYMMDDtHHMNSSFFFF... |
927
|
|
|
|
|
|
|
# YYYYMMDDtHHMNSS |
928
|
|
|
|
|
|
|
# YYYYMMDDtHHMN |
929
|
|
|
|
|
|
|
# YYYYMMDDtHH |
930
|
|
|
|
|
|
|
# YY MMDDtHHMNSSFFFF... |
931
|
|
|
|
|
|
|
# YY MMDDtHHMNSS |
932
|
|
|
|
|
|
|
# YY MMDDtHHMN |
933
|
|
|
|
|
|
|
# YY MMDDtHH |
934
|
|
|
|
|
|
|
# The t is an optional letter "t". |
935
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7); |
936
|
0
|
0
|
0
|
|
|
|
if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
937
|
0
|
|
|
|
|
|
$h=0; |
938
|
0
|
|
|
|
|
|
$midnight=1; |
939
|
|
|
|
|
|
|
} |
940
|
0
|
0
|
|
|
|
|
$z = "" if (! defined $h); |
941
|
0
|
0
|
0
|
|
|
|
return "" if ($time && defined $h); |
942
|
0
|
|
|
|
|
|
last PARSE; |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
} elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ || |
945
|
|
|
|
|
|
|
/^$DD(?:\s+$DD(?:\s*$DD)?)?$/) { |
946
|
|
|
|
|
|
|
# ISO 8601 Dates |
947
|
|
|
|
|
|
|
# YYYYMMDD |
948
|
|
|
|
|
|
|
# YYYYMM |
949
|
|
|
|
|
|
|
# YYYY |
950
|
|
|
|
|
|
|
# YY MMDD |
951
|
|
|
|
|
|
|
# YY MM |
952
|
|
|
|
|
|
|
# YY |
953
|
0
|
|
|
|
|
|
($y,$m,$d)=($1,$2,$3); |
954
|
0
|
|
|
|
|
|
last PARSE; |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
} elsif (/^$YY\s+$D\s+$D/) { |
957
|
|
|
|
|
|
|
# YY-M-D |
958
|
0
|
|
|
|
|
|
($y,$m,$d)=($1,$2,$3); |
959
|
0
|
|
|
|
|
|
last PARSE; |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
} elsif (/^$YY\s*W$DD\s*(\d)?$/i) { |
962
|
|
|
|
|
|
|
# YY-W##-D |
963
|
0
|
|
|
|
|
|
($y,$wofm,$dofw)=($1,$2,$3); |
964
|
0
|
|
|
|
|
|
($y,$m,$d)=_Date_NthWeekOfYear($y,$wofm,$dofw); |
965
|
0
|
|
|
|
|
|
last PARSE; |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
} elsif (/^$D4\s*(\d{3})$/ || |
968
|
|
|
|
|
|
|
/^$DD\s*(\d{3})$/) { |
969
|
|
|
|
|
|
|
# YYDOY |
970
|
0
|
|
|
|
|
|
($y,$which)=($1,$2); |
971
|
0
|
|
|
|
|
|
($y,$m,$d)=Date_NthDayOfYear($y,$which); |
972
|
0
|
|
|
|
|
|
last PARSE; |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
} elsif ($iso<0) { |
975
|
|
|
|
|
|
|
# We confused something like 1999/August12:00:00 |
976
|
|
|
|
|
|
|
# with a dateTtime format |
977
|
0
|
|
|
|
|
|
$_=$orig; |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
} else { |
980
|
0
|
|
|
|
|
|
return ""; |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
} |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
# All deltas that are not ISO-8601 dates are NOT dates. |
985
|
0
|
0
|
0
|
|
|
|
return "" if ($Curr{"InCalc"} && $delta); |
986
|
0
|
0
|
|
|
|
|
if ($delta) { |
987
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
988
|
0
|
|
|
|
|
|
return _DateCalc_DateDelta($Curr{"Now"},$delta); |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
# Check for some special types of dates (next, prev) |
992
|
0
|
|
|
|
|
|
foreach $from (keys %{ $Lang{$L}{"Repl"} }) { |
|
0
|
|
|
|
|
|
|
993
|
0
|
|
|
|
|
|
$to=$Lang{$L}{"Repl"}{$from}; |
994
|
0
|
|
|
|
|
|
s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i; |
995
|
|
|
|
|
|
|
} |
996
|
0
|
0
|
0
|
|
|
|
if (/$wom/i || /$future/i || /$later/i || /$past/i || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
997
|
|
|
|
|
|
|
/$next/i || /$prev/i || /^$week$/i || /$wkabb/i) { |
998
|
0
|
|
|
|
|
|
$tmp=0; |
999
|
|
|
|
|
|
|
|
1000
|
0
|
0
|
0
|
|
|
|
if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
# last friday in October 95 |
1002
|
0
|
|
|
|
|
|
($wofm,$dofw,$m,$y)=($1,$2,$3,$4); |
1003
|
|
|
|
|
|
|
# fix $m, $y |
1004
|
0
|
0
|
|
|
|
|
return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
1005
|
0
|
|
|
|
|
|
$dofw=$week{lc($dofw)}; |
1006
|
0
|
|
|
|
|
|
$wofm=$wom{lc($wofm)}; |
1007
|
|
|
|
|
|
|
# Get the first day of the month |
1008
|
0
|
|
|
|
|
|
$date=_Date_Join($y,$m,1,$h,$mn,$s); |
1009
|
0
|
0
|
|
|
|
|
if ($wofm==-1) { |
1010
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0); |
1011
|
0
|
|
|
|
|
|
$date=Date_GetPrev($date,$dofw,0); |
1012
|
|
|
|
|
|
|
} else { |
1013
|
0
|
|
|
|
|
|
for ($i=0; $i<$wofm; $i++) { |
1014
|
0
|
0
|
|
|
|
|
if ($i==0) { |
1015
|
0
|
|
|
|
|
|
$date=Date_GetNext($date,$dofw,1); |
1016
|
|
|
|
|
|
|
} else { |
1017
|
0
|
|
|
|
|
|
$date=Date_GetNext($date,$dofw,0); |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
} |
1021
|
0
|
|
|
|
|
|
last PARSE; |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
} elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) { |
1024
|
|
|
|
|
|
|
# last day in month |
1025
|
0
|
|
|
|
|
|
($m,$y)=($1,$2); |
1026
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1027
|
0
|
0
|
0
|
|
|
|
$y=_Date_FixYear($y) if (! defined $y or length($y)<4); |
1028
|
0
|
|
|
|
|
|
$m=$month{lc($m)}; |
1029
|
0
|
|
|
|
|
|
$d=Date_DaysInMonth($m,$y); |
1030
|
0
|
|
|
|
|
|
last PARSE; |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
} elsif (/^$week$/i) { |
1033
|
|
|
|
|
|
|
# friday |
1034
|
0
|
|
|
|
|
|
($dofw)=($1); |
1035
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1036
|
0
|
|
|
|
|
|
$date=Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1); |
1037
|
0
|
|
|
|
|
|
$date=Date_GetNext($date,$dofw,1,$h,$mn,$s); |
1038
|
0
|
|
|
|
|
|
last PARSE; |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
} elsif (/^$next\s*$week$/i) { |
1041
|
|
|
|
|
|
|
# next friday |
1042
|
0
|
|
|
|
|
|
($dofw)=($1); |
1043
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1044
|
0
|
|
|
|
|
|
$date=Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s); |
1045
|
0
|
|
|
|
|
|
last PARSE; |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
} elsif (/^$prev\s*$week$/i) { |
1048
|
|
|
|
|
|
|
# last friday |
1049
|
0
|
|
|
|
|
|
($dofw)=($1); |
1050
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1051
|
0
|
|
|
|
|
|
$date=Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s); |
1052
|
0
|
|
|
|
|
|
last PARSE; |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
} elsif (/^$next$wkabb$/i) { |
1055
|
|
|
|
|
|
|
# next week |
1056
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1057
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:1:0:0:0:0",\$err,0); |
1058
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1059
|
0
|
|
|
|
|
|
last PARSE; |
1060
|
|
|
|
|
|
|
} elsif (/^$prev$wkabb$/i) { |
1061
|
|
|
|
|
|
|
# last week |
1062
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1063
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:1:0:0:0:0",\$err,0); |
1064
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1065
|
0
|
|
|
|
|
|
last PARSE; |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
} elsif (/^$next$mabb$/i) { |
1068
|
|
|
|
|
|
|
# next month |
1069
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1070
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"+0:1:0:0:0:0:0",\$err,0); |
1071
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1072
|
0
|
|
|
|
|
|
last PARSE; |
1073
|
|
|
|
|
|
|
} elsif (/^$prev$mabb$/i) { |
1074
|
|
|
|
|
|
|
# last month |
1075
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1076
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"-0:1:0:0:0:0:0",\$err,0); |
1077
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1078
|
0
|
|
|
|
|
|
last PARSE; |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
} elsif (/^$future\s*(\d+)$day$/i || |
1081
|
|
|
|
|
|
|
/^(\d+)$day$later$/i) { |
1082
|
|
|
|
|
|
|
# in 2 days |
1083
|
|
|
|
|
|
|
# 2 days later |
1084
|
0
|
|
|
|
|
|
($num)=($1); |
1085
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1086
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0", |
1087
|
|
|
|
|
|
|
\$err,0); |
1088
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1089
|
0
|
|
|
|
|
|
last PARSE; |
1090
|
|
|
|
|
|
|
} elsif (/^(\d+)$day$past$/i) { |
1091
|
|
|
|
|
|
|
# 2 days ago |
1092
|
0
|
|
|
|
|
|
($num)=($1); |
1093
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1094
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0", |
1095
|
|
|
|
|
|
|
\$err,0); |
1096
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1097
|
0
|
|
|
|
|
|
last PARSE; |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
} elsif (/^$future\s*(\d+)$wkabb$/i || |
1100
|
|
|
|
|
|
|
/^(\d+)$wkabb$later$/i) { |
1101
|
|
|
|
|
|
|
# in 2 weeks |
1102
|
|
|
|
|
|
|
# 2 weeks later |
1103
|
0
|
|
|
|
|
|
($num)=($1); |
1104
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1105
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0", |
1106
|
|
|
|
|
|
|
\$err,0); |
1107
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1108
|
0
|
|
|
|
|
|
last PARSE; |
1109
|
|
|
|
|
|
|
} elsif (/^(\d+)$wkabb$past$/i) { |
1110
|
|
|
|
|
|
|
# 2 weeks ago |
1111
|
0
|
|
|
|
|
|
($num)=($1); |
1112
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1113
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0", |
1114
|
|
|
|
|
|
|
\$err,0); |
1115
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1116
|
0
|
|
|
|
|
|
last PARSE; |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
} elsif (/^$future\s*(\d+)$mabb$/i || |
1119
|
|
|
|
|
|
|
/^(\d+)$mabb$later$/i) { |
1120
|
|
|
|
|
|
|
# in 2 months |
1121
|
|
|
|
|
|
|
# 2 months later |
1122
|
0
|
|
|
|
|
|
($num)=($1); |
1123
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1124
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0", |
1125
|
|
|
|
|
|
|
\$err,0); |
1126
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1127
|
0
|
|
|
|
|
|
last PARSE; |
1128
|
|
|
|
|
|
|
} elsif (/^(\d+)$mabb$past$/i) { |
1129
|
|
|
|
|
|
|
# 2 months ago |
1130
|
0
|
|
|
|
|
|
($num)=($1); |
1131
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1132
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0", |
1133
|
|
|
|
|
|
|
\$err,0); |
1134
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if (defined $h); |
1135
|
0
|
|
|
|
|
|
last PARSE; |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
} elsif (/^$week$future\s*(\d+)$wkabb$/i || |
1138
|
|
|
|
|
|
|
/^$week\s*(\d+)$wkabb$later$/i) { |
1139
|
|
|
|
|
|
|
# friday in 2 weeks |
1140
|
|
|
|
|
|
|
# friday 2 weeks later |
1141
|
0
|
|
|
|
|
|
($dofw,$num)=($1,$2); |
1142
|
0
|
|
|
|
|
|
$tmp="+"; |
1143
|
|
|
|
|
|
|
} elsif (/^$week\s*(\d+)$wkabb$past$/i) { |
1144
|
|
|
|
|
|
|
# friday 2 weeks ago |
1145
|
0
|
|
|
|
|
|
($dofw,$num)=($1,$2); |
1146
|
0
|
|
|
|
|
|
$tmp="-"; |
1147
|
|
|
|
|
|
|
} elsif (/^$future\s*(\d+)$wkabb$on$week$/i || |
1148
|
|
|
|
|
|
|
/^(\d+)$wkabb$later$on$week$/i) { |
1149
|
|
|
|
|
|
|
# in 2 weeks on friday |
1150
|
|
|
|
|
|
|
# 2 weeks later on friday |
1151
|
0
|
|
|
|
|
|
($num,$dofw)=($1,$2); |
1152
|
0
|
|
|
|
|
|
$tmp="+" |
1153
|
|
|
|
|
|
|
} elsif (/^(\d+)$wkabb$past$on$week$/i) { |
1154
|
|
|
|
|
|
|
# 2 weeks ago on friday |
1155
|
0
|
|
|
|
|
|
($num,$dofw)=($1,$2); |
1156
|
0
|
|
|
|
|
|
$tmp="-"; |
1157
|
|
|
|
|
|
|
} elsif (/^$week\s*$wkabb$/i) { |
1158
|
|
|
|
|
|
|
# monday week (British date: in 1 week on monday) |
1159
|
0
|
|
|
|
|
|
$dofw=$1; |
1160
|
0
|
|
|
|
|
|
$num=1; |
1161
|
0
|
|
|
|
|
|
$tmp="+"; |
1162
|
|
|
|
|
|
|
} elsif ( (/^$now\s*$wkabb$/i && ($tmp="Now")) || |
1163
|
|
|
|
|
|
|
(/^$today\s*$wkabb$/i && ($tmp="Today")) ) { |
1164
|
|
|
|
|
|
|
# now week (British date: 1 week from now) |
1165
|
|
|
|
|
|
|
# today week (British date: 1 week from today) |
1166
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1167
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{$tmp},"+0:0:1:0:0:0:0",\$err,0); |
1168
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s) if ($time); |
1169
|
0
|
|
|
|
|
|
last PARSE; |
1170
|
|
|
|
|
|
|
} elsif (/^$offset\s*$wkabb$/i) { |
1171
|
|
|
|
|
|
|
# tomorrow week (British date: 1 week from tomorrow) |
1172
|
0
|
|
|
|
|
|
($offset)=($1); |
1173
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1174
|
0
|
|
|
|
|
|
$offset=$Lang{$L}{"OffsetH"}{lc($offset)}; |
1175
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0); |
1176
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0); |
1177
|
0
|
0
|
|
|
|
|
if ($time) { |
1178
|
0
|
0
|
|
|
|
|
return "" |
1179
|
|
|
|
|
|
|
if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
1180
|
0
|
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s); |
1181
|
|
|
|
|
|
|
} |
1182
|
0
|
|
|
|
|
|
last PARSE; |
1183
|
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
|
|
1185
|
0
|
0
|
|
|
|
|
if ($tmp) { |
1186
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1187
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"}, |
1188
|
|
|
|
|
|
|
$tmp . "0:0:$num:0:0:0:0",\$err,0); |
1189
|
0
|
|
|
|
|
|
$date=Date_GetPrev($date,$Cnf{"FirstDay"},1); |
1190
|
0
|
|
|
|
|
|
$date=Date_GetNext($date,$dofw,1,$h,$mn,$s); |
1191
|
0
|
|
|
|
|
|
last PARSE; |
1192
|
|
|
|
|
|
|
} |
1193
|
|
|
|
|
|
|
} |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
# Change (2nd, second) to 2 |
1196
|
0
|
|
|
|
|
|
$tmp=0; |
1197
|
0
|
0
|
|
|
|
|
if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) { |
1198
|
0
|
0
|
|
|
|
|
if (/^\s*$dom\s*$/) { |
1199
|
0
|
|
|
|
|
|
($d)=($1); |
1200
|
0
|
|
|
|
|
|
$d=$dom{lc($d)}; |
1201
|
0
|
|
|
|
|
|
$m=$Curr{"M"}; |
1202
|
0
|
|
|
|
|
|
last PARSE; |
1203
|
|
|
|
|
|
|
} |
1204
|
0
|
|
|
|
|
|
my $from = $2; |
1205
|
0
|
|
|
|
|
|
my $to = $dom{ lc($from) }; |
1206
|
0
|
|
|
|
|
|
s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i; |
1207
|
0
|
|
|
|
|
|
s/^\s+//; |
1208
|
0
|
|
|
|
|
|
s/\s+$//; |
1209
|
|
|
|
|
|
|
} |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
# Another set of special dates (Nth week) |
1212
|
0
|
0
|
0
|
|
|
|
if (/^$D\s*$week(?:$of?\s*$YY)?$/i) { |
|
|
0
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
# 22nd sunday in 1996 |
1214
|
0
|
|
|
|
|
|
($which,$dofw,$y)=($1,$2,$3); |
1215
|
0
|
0
|
|
|
|
|
$y=$Curr{"Y"} if (! $y); |
1216
|
0
|
|
|
|
|
|
$y--; # previous year |
1217
|
0
|
|
|
|
|
|
$tmp=Date_GetNext("$y-12-31",$dofw,0); |
1218
|
0
|
0
|
|
|
|
|
if ($which>1) { |
1219
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0); |
1220
|
|
|
|
|
|
|
} |
1221
|
0
|
|
|
|
|
|
($y,$m,$d)=(_Date_Split($tmp, 1))[0..2]; |
1222
|
0
|
|
|
|
|
|
last PARSE; |
1223
|
|
|
|
|
|
|
} elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i || |
1224
|
|
|
|
|
|
|
/^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) { |
1225
|
|
|
|
|
|
|
# sunday week 22 in 1996 |
1226
|
|
|
|
|
|
|
# sunday 22nd week in 1996 |
1227
|
0
|
|
|
|
|
|
($dofw,$which,$y)=($1,$2,$3); |
1228
|
0
|
|
|
|
|
|
($y,$m,$d)=_Date_NthWeekOfYear($y,$which,$dofw); |
1229
|
0
|
|
|
|
|
|
last PARSE; |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
# Get rid of day of week |
1233
|
0
|
0
|
|
|
|
|
if (/(^|[^a-z])$week($|[^a-z])/i) { |
1234
|
0
|
|
|
|
|
|
$wk=$2; |
1235
|
0
|
0
|
|
|
|
|
(s/(^|[^a-z])$week,/$1 /i) || |
1236
|
|
|
|
|
|
|
s/(^|[^a-z])$week($|[^a-z])/$1 $3/i; |
1237
|
0
|
|
|
|
|
|
s/^\s+//; |
1238
|
0
|
|
|
|
|
|
s/\s+$//; |
1239
|
|
|
|
|
|
|
} |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
{ |
1242
|
|
|
|
|
|
|
# So that we can handle negative epoch times, let's convert |
1243
|
|
|
|
|
|
|
# things like "epoch -" to "epochNEGATIVE " before we strip out |
1244
|
|
|
|
|
|
|
# the $sep chars, which include '-'. |
1245
|
0
|
|
|
|
|
|
s,epoch\s*-,epochNEGATIVE ,g; |
|
0
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
# Non-ISO8601 dates |
1248
|
0
|
|
|
|
|
|
s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces |
1249
|
0
|
|
|
|
|
|
s,^\s*,,; # remove leading/trailing space |
1250
|
0
|
|
|
|
|
|
s,\s*$,,; |
1251
|
|
|
|
|
|
|
|
1252
|
0
|
0
|
0
|
|
|
|
if (/^$D\s+$D(?:\s+$YY)?$/) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
# MM DD YY (DD MM YY non-US) |
1254
|
0
|
|
|
|
|
|
($m,$d,$y)=($1,$2,$3); |
1255
|
0
|
0
|
|
|
|
|
($m,$d)=($d,$m) if ($type ne "US"); |
1256
|
0
|
|
|
|
|
|
last PARSE; |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
} elsif (/^$D4\s*$D\s*$D$/) { |
1259
|
|
|
|
|
|
|
# YYYY MM DD |
1260
|
0
|
|
|
|
|
|
($y,$m,$d)=($1,$2,$3); |
1261
|
0
|
|
|
|
|
|
last PARSE; |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
} elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) { |
1264
|
0
|
|
|
|
|
|
($m)=($2); |
1265
|
|
|
|
|
|
|
|
1266
|
0
|
0
|
|
|
|
|
if (/^\s*$D(?:\s+$YY)?\s*$/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
# mmm DD YY |
1268
|
|
|
|
|
|
|
# DD mmm YY |
1269
|
|
|
|
|
|
|
# DD YY mmm |
1270
|
0
|
|
|
|
|
|
($d,$y)=($1,$2); |
1271
|
0
|
|
|
|
|
|
last PARSE; |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
} elsif (/^\s*$D$D4\s*$/) { |
1274
|
|
|
|
|
|
|
# mmm DD YYYY |
1275
|
|
|
|
|
|
|
# DD mmm YYYY |
1276
|
|
|
|
|
|
|
# DD YYYY mmm |
1277
|
0
|
|
|
|
|
|
($d,$y)=($1,$2); |
1278
|
0
|
|
|
|
|
|
last PARSE; |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
} elsif (/^\s*$D4\s*$D\s*$/) { |
1281
|
|
|
|
|
|
|
# mmm YYYY DD |
1282
|
|
|
|
|
|
|
# YYYY mmm DD |
1283
|
|
|
|
|
|
|
# YYYY DD mmm |
1284
|
0
|
|
|
|
|
|
($y,$d)=($1,$2); |
1285
|
0
|
|
|
|
|
|
last PARSE; |
1286
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
} elsif (/^\s*$D4\s*$/) { |
1288
|
|
|
|
|
|
|
# mmm YYYY |
1289
|
|
|
|
|
|
|
# YYYY mmm |
1290
|
0
|
|
|
|
|
|
($y,$d)=($1,1); |
1291
|
0
|
|
|
|
|
|
last PARSE; |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
} else { |
1294
|
0
|
|
|
|
|
|
return ""; |
1295
|
|
|
|
|
|
|
} |
1296
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
} elsif (/^epochNEGATIVE (\d+)$/) { |
1298
|
0
|
|
|
|
|
|
$s=$1; |
1299
|
0
|
|
|
|
|
|
$date=DateCalc("1970-01-01 00:00 GMT","-0:0:$s"); |
1300
|
|
|
|
|
|
|
} elsif (/^epoch\s*(\d+)$/i) { |
1301
|
0
|
|
|
|
|
|
$s=$1; |
1302
|
0
|
|
|
|
|
|
$date=DateCalc("1970-01-01 00:00 GMT","+0:0:$s"); |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
} elsif ( (/^$now$/i && ($tmp="Now")) || |
1305
|
|
|
|
|
|
|
(/^$today$/i && ($tmp="Today")) ) { |
1306
|
|
|
|
|
|
|
# now, today |
1307
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1308
|
0
|
|
|
|
|
|
$date=$Curr{$tmp}; |
1309
|
0
|
0
|
|
|
|
|
if ($time) { |
1310
|
0
|
0
|
|
|
|
|
return "" |
1311
|
|
|
|
|
|
|
if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
1312
|
0
|
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s); |
1313
|
|
|
|
|
|
|
} |
1314
|
0
|
|
|
|
|
|
last PARSE; |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
} elsif (/^$offset$/i) { |
1317
|
|
|
|
|
|
|
# yesterday, tomorrow |
1318
|
0
|
|
|
|
|
|
($offset)=($1); |
1319
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Cnf{"UpdateCurrTZ"}); |
1320
|
0
|
|
|
|
|
|
$offset=$Lang{$L}{"OffsetH"}{lc($offset)}; |
1321
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0); |
1322
|
0
|
0
|
|
|
|
|
if ($time) { |
1323
|
0
|
0
|
|
|
|
|
return "" |
1324
|
|
|
|
|
|
|
if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
1325
|
0
|
|
|
|
|
|
$date=Date_SetTime($date,$h,$mn,$s); |
1326
|
|
|
|
|
|
|
} |
1327
|
0
|
|
|
|
|
|
last PARSE; |
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
} else { |
1330
|
0
|
|
|
|
|
|
return ""; |
1331
|
|
|
|
|
|
|
} |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
} |
1334
|
|
|
|
|
|
|
|
1335
|
0
|
0
|
|
|
|
|
if (! $date) { |
1336
|
0
|
0
|
|
|
|
|
return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
1337
|
0
|
|
|
|
|
|
$date=_Date_Join($y,$m,$d,$h,$mn,$s); |
1338
|
|
|
|
|
|
|
} |
1339
|
0
|
|
|
|
|
|
$date=Date_ConvTZ($date,$z); |
1340
|
0
|
0
|
|
|
|
|
if ($midnight) { |
1341
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0"); |
1342
|
|
|
|
|
|
|
} |
1343
|
0
|
|
|
|
|
|
return $date; |
1344
|
|
|
|
|
|
|
} |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
sub ParseDate { |
1347
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/); |
1348
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
1349
|
0
|
|
|
|
|
|
my($args,@args,@a,$ref,$date)=(); |
1350
|
0
|
|
|
|
|
|
@a=@_; |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
# @a : is the list of args to ParseDate. Currently, only one argument |
1353
|
|
|
|
|
|
|
# is allowed and it must be a scalar (or a reference to a scalar) |
1354
|
|
|
|
|
|
|
# or a reference to an array. |
1355
|
|
|
|
|
|
|
|
1356
|
0
|
0
|
|
|
|
|
if ($#a!=0) { |
1357
|
0
|
|
|
|
|
|
print "ERROR: Invalid number of arguments to ParseDate.\n"; |
1358
|
0
|
|
|
|
|
|
return ""; |
1359
|
|
|
|
|
|
|
} |
1360
|
0
|
|
|
|
|
|
$args=$a[0]; |
1361
|
0
|
|
|
|
|
|
$ref=ref $args; |
1362
|
0
|
0
|
|
|
|
|
if (! $ref) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1363
|
0
|
0
|
|
|
|
|
return $args if (_Date_Split($args)); |
1364
|
0
|
|
|
|
|
|
@args=($args); |
1365
|
|
|
|
|
|
|
} elsif ($ref eq "ARRAY") { |
1366
|
0
|
|
|
|
|
|
@args=@$args; |
1367
|
|
|
|
|
|
|
} elsif ($ref eq "SCALAR") { |
1368
|
0
|
0
|
|
|
|
|
return $$args if (_Date_Split($$args)); |
1369
|
0
|
|
|
|
|
|
@args=($$args); |
1370
|
|
|
|
|
|
|
} else { |
1371
|
0
|
|
|
|
|
|
print "ERROR: Invalid arguments to ParseDate.\n"; |
1372
|
0
|
|
|
|
|
|
return ""; |
1373
|
|
|
|
|
|
|
} |
1374
|
0
|
|
|
|
|
|
@a=@args; |
1375
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
# @args : a list containing all the arguments (dereferenced if appropriate) |
1377
|
|
|
|
|
|
|
# @a : a list containing all the arguments currently being examined |
1378
|
|
|
|
|
|
|
# $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a |
1379
|
|
|
|
|
|
|
# reference to a scalar, or a reference to an array was passed in |
1380
|
|
|
|
|
|
|
# $args : the scalar or refererence passed in |
1381
|
|
|
|
|
|
|
|
1382
|
0
|
|
|
|
|
|
PARSE: while($#a>=0) { |
1383
|
0
|
|
|
|
|
|
$date=join(" ",@a); |
1384
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
1385
|
0
|
0
|
|
|
|
|
last if ($date); |
1386
|
0
|
|
|
|
|
|
pop(@a); |
1387
|
|
|
|
|
|
|
} # PARSE |
1388
|
|
|
|
|
|
|
|
1389
|
0
|
|
|
|
|
|
splice(@args,0,$#a + 1); |
1390
|
0
|
0
|
0
|
|
|
|
@$args= @args if (defined $ref and $ref eq "ARRAY"); |
1391
|
0
|
|
|
|
|
|
$date; |
1392
|
|
|
|
|
|
|
} |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
sub Date_Cmp { |
1395
|
0
|
|
|
0
|
1
|
|
my($D1,$D2)=@_; |
1396
|
0
|
|
|
|
|
|
my($date1)=ParseDateString($D1); |
1397
|
0
|
|
|
|
|
|
my($date2)=ParseDateString($D2); |
1398
|
0
|
|
|
|
|
|
return $date1 cmp $date2; |
1399
|
|
|
|
|
|
|
} |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
# **NOTE** |
1402
|
|
|
|
|
|
|
# The calc routines all call parse routines, so it is never necessary to |
1403
|
|
|
|
|
|
|
# call Date_Init in the calc routines. |
1404
|
|
|
|
|
|
|
sub DateCalc { |
1405
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/); |
1406
|
0
|
|
|
|
|
|
my($D1,$D2,@arg)=@_; |
1407
|
0
|
|
|
|
|
|
my($ref,$err,$errref,$mode)=(); |
1408
|
|
|
|
|
|
|
|
1409
|
0
|
|
|
|
|
|
($errref,$mode) = (@arg); |
1410
|
0
|
|
|
|
|
|
$ref=0; |
1411
|
|
|
|
|
|
|
|
1412
|
0
|
0
|
|
|
|
|
if (defined $errref) { |
1413
|
0
|
0
|
|
|
|
|
if (ref $errref) { |
|
|
0
|
|
|
|
|
|
1414
|
0
|
|
|
|
|
|
$ref=1; |
1415
|
|
|
|
|
|
|
} elsif (! defined $mode) { |
1416
|
0
|
|
|
|
|
|
$mode=$errref; |
1417
|
0
|
|
|
|
|
|
$errref=""; |
1418
|
|
|
|
|
|
|
} |
1419
|
|
|
|
|
|
|
} |
1420
|
|
|
|
|
|
|
|
1421
|
0
|
|
|
|
|
|
my(@date,@delta,$ret,$tmp,$oldincalc,$oldmode)=(); |
1422
|
|
|
|
|
|
|
|
1423
|
0
|
0
|
|
|
|
|
if (exists $Curr{"Mode"}) { |
1424
|
0
|
|
|
|
|
|
$oldmode = $Curr{"Mode"}; |
1425
|
|
|
|
|
|
|
} else { |
1426
|
0
|
|
|
|
|
|
$oldmode = 0; |
1427
|
|
|
|
|
|
|
} |
1428
|
|
|
|
|
|
|
|
1429
|
0
|
0
|
0
|
|
|
|
if (defined $mode and $mode>=0 and $mode<=3) { |
|
|
|
0
|
|
|
|
|
1430
|
0
|
|
|
|
|
|
$Curr{"Mode"}=$mode; |
1431
|
|
|
|
|
|
|
} else { |
1432
|
0
|
|
|
|
|
|
$Curr{"Mode"}=0; |
1433
|
|
|
|
|
|
|
} |
1434
|
|
|
|
|
|
|
|
1435
|
0
|
0
|
|
|
|
|
if (exists $Curr{"InCalc"}) { |
1436
|
0
|
|
|
|
|
|
$oldincalc = $Curr{"InCalc"}; |
1437
|
|
|
|
|
|
|
} else { |
1438
|
0
|
|
|
|
|
|
$oldincalc = 0; |
1439
|
|
|
|
|
|
|
} |
1440
|
0
|
|
|
|
|
|
$Curr{"InCalc"}=1; |
1441
|
|
|
|
|
|
|
|
1442
|
0
|
0
|
|
|
|
|
if ($tmp=ParseDateString($D1)) { |
|
|
0
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
# If we've already parsed the date, we don't want to do it a second |
1444
|
|
|
|
|
|
|
# time (so we don't convert timezones twice). |
1445
|
0
|
0
|
|
|
|
|
if (_Date_Split($D1)) { |
1446
|
0
|
|
|
|
|
|
push(@date,$D1); |
1447
|
|
|
|
|
|
|
} else { |
1448
|
0
|
|
|
|
|
|
push(@date,$tmp); |
1449
|
|
|
|
|
|
|
} |
1450
|
|
|
|
|
|
|
} elsif ($tmp=ParseDateDelta($D1)) { |
1451
|
0
|
|
|
|
|
|
push(@delta,$tmp); |
1452
|
|
|
|
|
|
|
} else { |
1453
|
0
|
0
|
|
|
|
|
$$errref=1 if ($ref); |
1454
|
0
|
|
|
|
|
|
$Curr{"InCalc"} = $oldincalc; |
1455
|
0
|
|
|
|
|
|
$Curr{"Mode"} = $oldmode; |
1456
|
0
|
|
|
|
|
|
return; |
1457
|
|
|
|
|
|
|
} |
1458
|
|
|
|
|
|
|
|
1459
|
0
|
0
|
|
|
|
|
if ($tmp=ParseDateString($D2)) { |
|
|
0
|
|
|
|
|
|
1460
|
0
|
0
|
|
|
|
|
if (_Date_Split($D2)) { |
1461
|
0
|
|
|
|
|
|
push(@date,$D2); |
1462
|
|
|
|
|
|
|
} else { |
1463
|
0
|
|
|
|
|
|
push(@date,$tmp); |
1464
|
|
|
|
|
|
|
} |
1465
|
|
|
|
|
|
|
} elsif ($tmp=ParseDateDelta($D2)) { |
1466
|
0
|
|
|
|
|
|
push(@delta,$tmp); |
1467
|
0
|
|
|
|
|
|
$mode = $Curr{"Mode"}; |
1468
|
|
|
|
|
|
|
} else { |
1469
|
0
|
0
|
|
|
|
|
$$errref=2 if ($ref); |
1470
|
0
|
|
|
|
|
|
$Curr{"InCalc"} = $oldincalc; |
1471
|
0
|
|
|
|
|
|
$Curr{"Mode"} = $oldmode; |
1472
|
0
|
|
|
|
|
|
return; |
1473
|
|
|
|
|
|
|
} |
1474
|
|
|
|
|
|
|
|
1475
|
0
|
|
|
|
|
|
$Curr{"InCalc"} = $oldincalc; |
1476
|
0
|
|
|
|
|
|
$Curr{"Mode"} = $oldmode; |
1477
|
|
|
|
|
|
|
|
1478
|
0
|
0
|
|
|
|
|
if ($#date==1) { |
|
|
0
|
|
|
|
|
|
1479
|
0
|
|
|
|
|
|
$ret=_DateCalc_DateDate(@date,$mode); |
1480
|
|
|
|
|
|
|
} elsif ($#date==0) { |
1481
|
0
|
|
|
|
|
|
$ret=_DateCalc_DateDelta(@date,@delta,\$err,$mode); |
1482
|
0
|
0
|
|
|
|
|
$$errref=$err if ($ref); |
1483
|
|
|
|
|
|
|
} else { |
1484
|
0
|
|
|
|
|
|
$ret=_DateCalc_DeltaDelta(@delta,$mode); |
1485
|
|
|
|
|
|
|
} |
1486
|
0
|
|
|
|
|
|
$ret; |
1487
|
|
|
|
|
|
|
} |
1488
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
sub ParseDateDelta { |
1490
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/); |
1491
|
0
|
|
|
|
|
|
my($args,@args,@a,$ref)=(); |
1492
|
0
|
|
|
|
|
|
local($_)=(); |
1493
|
0
|
|
|
|
|
|
@a=@_; |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
# @a : is the list of args to ParseDateDelta. Currently, only one argument |
1496
|
|
|
|
|
|
|
# is allowed and it must be a scalar (or a reference to a scalar) |
1497
|
|
|
|
|
|
|
# or a reference to an array. |
1498
|
|
|
|
|
|
|
|
1499
|
0
|
0
|
|
|
|
|
if ($#a!=0) { |
1500
|
0
|
|
|
|
|
|
print "ERROR: Invalid number of arguments to ParseDateDelta.\n"; |
1501
|
0
|
|
|
|
|
|
return ""; |
1502
|
|
|
|
|
|
|
} |
1503
|
0
|
|
|
|
|
|
$args=$a[0]; |
1504
|
0
|
|
|
|
|
|
$ref=ref $args; |
1505
|
0
|
0
|
|
|
|
|
if (! $ref) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1506
|
0
|
|
|
|
|
|
@args=($args); |
1507
|
|
|
|
|
|
|
} elsif ($ref eq "ARRAY") { |
1508
|
0
|
|
|
|
|
|
@args=@$args; |
1509
|
|
|
|
|
|
|
} elsif ($ref eq "SCALAR") { |
1510
|
0
|
|
|
|
|
|
@args=($$args); |
1511
|
|
|
|
|
|
|
} else { |
1512
|
0
|
|
|
|
|
|
print "ERROR: Invalid arguments to ParseDateDelta.\n"; |
1513
|
0
|
|
|
|
|
|
return ""; |
1514
|
|
|
|
|
|
|
} |
1515
|
0
|
|
|
|
|
|
@a=@args; |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
# @args : a list containing all the arguments (dereferenced if appropriate) |
1518
|
|
|
|
|
|
|
# @a : a list containing all the arguments currently being examined |
1519
|
|
|
|
|
|
|
# $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a |
1520
|
|
|
|
|
|
|
# reference to a scalar, or a reference to an array was passed in |
1521
|
|
|
|
|
|
|
# $args : the scalar or refererence passed in |
1522
|
|
|
|
|
|
|
|
1523
|
0
|
|
|
|
|
|
my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=(); |
1524
|
0
|
|
|
|
|
|
my($len,$tmp,$tmp2,$tmpl)=(); |
1525
|
0
|
|
|
|
|
|
my($from,$to)=(); |
1526
|
0
|
|
|
|
|
|
my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1; |
1527
|
|
|
|
|
|
|
|
1528
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
1529
|
|
|
|
|
|
|
# A sign can be a sequence of zero or more + and - signs, this |
1530
|
|
|
|
|
|
|
# allows for deltas like '+ -2 days'. |
1531
|
0
|
|
|
|
|
|
my($signexp)='((?:[+-]\s*)*)'; |
1532
|
0
|
|
|
|
|
|
my($numexp)='(\d+)'; |
1533
|
0
|
|
|
|
|
|
my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)"; |
1534
|
0
|
|
|
|
|
|
my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=(); |
1535
|
0
|
|
|
|
|
|
$yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()"; |
1536
|
0
|
|
|
|
|
|
$yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?"; |
1537
|
0
|
|
|
|
|
|
$mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?"; |
1538
|
0
|
|
|
|
|
|
$wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?"; |
1539
|
0
|
|
|
|
|
|
$dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?"; |
1540
|
0
|
|
|
|
|
|
$hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?"; |
1541
|
0
|
|
|
|
|
|
$mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?"; |
1542
|
0
|
|
|
|
|
|
$sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?"; |
1543
|
0
|
|
|
|
|
|
my($future)=$Lang{$Cnf{"Language"}}{"Future"}; |
1544
|
0
|
|
|
|
|
|
my($later)=$Lang{$Cnf{"Language"}}{"Later"}; |
1545
|
0
|
|
|
|
|
|
my($past)=$Lang{$Cnf{"Language"}}{"Past"}; |
1546
|
|
|
|
|
|
|
|
1547
|
0
|
|
|
|
|
|
$delta=""; |
1548
|
0
|
|
|
|
|
|
PARSE: while (@a) { |
1549
|
0
|
|
|
|
|
|
$_ = join(" ", grep {defined;} @a); |
|
0
|
|
|
|
|
|
|
1550
|
0
|
|
|
|
|
|
s/\s+$//; |
1551
|
0
|
0
|
|
|
|
|
last if ($_ eq ""); |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
# Mode is set in DateCalc. ParseDateDelta only overrides it if the |
1554
|
|
|
|
|
|
|
# string contains a mode. |
1555
|
0
|
0
|
0
|
|
|
|
if ($Lang{$Cnf{"Language"}}{"Exact"} && |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
s/$Lang{$Cnf{"Language"}}{"Exact"}//) { |
1557
|
0
|
|
|
|
|
|
$Curr{"Mode"}=0; |
1558
|
|
|
|
|
|
|
} elsif ($Lang{$Cnf{"Language"}}{"Approx"} && |
1559
|
|
|
|
|
|
|
s/$Lang{$Cnf{"Language"}}{"Approx"}//) { |
1560
|
0
|
|
|
|
|
|
$Curr{"Mode"}=1; |
1561
|
|
|
|
|
|
|
} elsif ($Lang{$Cnf{"Language"}}{"Business"} && |
1562
|
|
|
|
|
|
|
s/$Lang{$Cnf{"Language"}}{"Business"}//) { |
1563
|
0
|
|
|
|
|
|
$Curr{"Mode"}=2; |
1564
|
|
|
|
|
|
|
} elsif (! exists $Curr{"Mode"}) { |
1565
|
0
|
|
|
|
|
|
$Curr{"Mode"}=0; |
1566
|
|
|
|
|
|
|
} |
1567
|
0
|
0
|
|
|
|
|
$workweek=7 if ($Curr{"Mode"} != 2); |
1568
|
|
|
|
|
|
|
|
1569
|
0
|
|
|
|
|
|
foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) { |
|
0
|
|
|
|
|
|
|
1570
|
0
|
|
|
|
|
|
$to=$Lang{$Cnf{"Language"}}{"Repl"}{$from}; |
1571
|
0
|
|
|
|
|
|
s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i; |
1572
|
|
|
|
|
|
|
} |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
# in or ago |
1575
|
|
|
|
|
|
|
# |
1576
|
|
|
|
|
|
|
# We need to make sure that $later, $future, and $past don't contain each |
1577
|
|
|
|
|
|
|
# other... Romanian pointed this out where $past is "in urma" and $future |
1578
|
|
|
|
|
|
|
# is "in". When they do, we have to take this into account. |
1579
|
|
|
|
|
|
|
# $len length of best match (greatest wins) |
1580
|
|
|
|
|
|
|
# $tmp string after best match |
1581
|
|
|
|
|
|
|
# $dir direction (prior, after) of best match |
1582
|
|
|
|
|
|
|
# |
1583
|
|
|
|
|
|
|
# $tmp2 string before/after current match |
1584
|
|
|
|
|
|
|
# $tmpl length of current match |
1585
|
|
|
|
|
|
|
|
1586
|
0
|
|
|
|
|
|
$len=0; |
1587
|
0
|
|
|
|
|
|
$tmp=$_; |
1588
|
0
|
|
|
|
|
|
$dir=1; |
1589
|
|
|
|
|
|
|
|
1590
|
0
|
|
|
|
|
|
$tmp2=$_; |
1591
|
0
|
0
|
|
|
|
|
if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) { |
1592
|
0
|
|
|
|
|
|
$tmpl=length($2); |
1593
|
0
|
0
|
|
|
|
|
if ($tmpl>$len) { |
1594
|
0
|
|
|
|
|
|
$tmp=$tmp2; |
1595
|
0
|
|
|
|
|
|
$dir=1; |
1596
|
0
|
|
|
|
|
|
$len=$tmpl; |
1597
|
|
|
|
|
|
|
} |
1598
|
|
|
|
|
|
|
} |
1599
|
|
|
|
|
|
|
|
1600
|
0
|
|
|
|
|
|
$tmp2=$_; |
1601
|
0
|
0
|
|
|
|
|
if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) { |
1602
|
0
|
|
|
|
|
|
$tmpl=length($2); |
1603
|
0
|
0
|
|
|
|
|
if ($tmpl>$len) { |
1604
|
0
|
|
|
|
|
|
$tmp=$tmp2; |
1605
|
0
|
|
|
|
|
|
$dir=1; |
1606
|
0
|
|
|
|
|
|
$len=$tmpl; |
1607
|
|
|
|
|
|
|
} |
1608
|
|
|
|
|
|
|
} |
1609
|
|
|
|
|
|
|
|
1610
|
0
|
|
|
|
|
|
$tmp2=$_; |
1611
|
0
|
0
|
|
|
|
|
if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) { |
1612
|
0
|
|
|
|
|
|
$tmpl=length($2); |
1613
|
0
|
0
|
|
|
|
|
if ($tmpl>$len) { |
1614
|
0
|
|
|
|
|
|
$tmp=$tmp2; |
1615
|
0
|
|
|
|
|
|
$dir=-1; |
1616
|
0
|
|
|
|
|
|
$len=$tmpl; |
1617
|
|
|
|
|
|
|
} |
1618
|
|
|
|
|
|
|
} |
1619
|
|
|
|
|
|
|
|
1620
|
0
|
|
|
|
|
|
$_ = $tmp; |
1621
|
0
|
|
|
|
|
|
s/\s*$//; |
1622
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
# the colon part of the delta |
1624
|
0
|
|
|
|
|
|
$colon=""; |
1625
|
0
|
0
|
|
|
|
|
if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) { |
1626
|
0
|
|
|
|
|
|
$colon=$1; |
1627
|
0
|
|
|
|
|
|
s/\s+$//; |
1628
|
|
|
|
|
|
|
} |
1629
|
0
|
|
|
|
|
|
@colon=split(/:/,$colon); |
1630
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
# the non-colon part of the delta |
1632
|
0
|
|
|
|
|
|
$sign="+"; |
1633
|
0
|
|
|
|
|
|
@delta=(); |
1634
|
0
|
|
|
|
|
|
$i=6; |
1635
|
0
|
|
|
|
|
|
foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) { |
1636
|
0
|
0
|
|
|
|
|
last if ($#colon>=$i--); |
1637
|
0
|
|
|
|
|
|
$val=0; |
1638
|
0
|
0
|
|
|
|
|
if (s/^$exp1//ix) { |
1639
|
0
|
0
|
|
|
|
|
$val=$2 if ($2); |
1640
|
0
|
0
|
|
|
|
|
$sign=$1 if ($1); |
1641
|
|
|
|
|
|
|
} |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
# Collapse a sign like '+ -' into a single character like '-', |
1644
|
|
|
|
|
|
|
# by counting the occurrences of '-'. |
1645
|
|
|
|
|
|
|
# |
1646
|
0
|
|
|
|
|
|
$sign =~ s/\s+//g; |
1647
|
0
|
|
|
|
|
|
$sign =~ tr/+//d; |
1648
|
0
|
|
|
|
|
|
my $count = ($sign =~ tr/-//d); |
1649
|
0
|
0
|
|
|
|
|
die "bad characters in sign: $sign" if length $sign; |
1650
|
0
|
0
|
|
|
|
|
$sign = $count % 2 ? '-' : '+'; |
1651
|
|
|
|
|
|
|
|
1652
|
0
|
|
|
|
|
|
push(@delta,"$sign$val"); |
1653
|
|
|
|
|
|
|
} |
1654
|
0
|
0
|
|
|
|
|
if (! /^\s*$/) { |
1655
|
0
|
|
|
|
|
|
pop(@a); |
1656
|
0
|
|
|
|
|
|
next PARSE; |
1657
|
|
|
|
|
|
|
} |
1658
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
# make sure that the colon part has a sign |
1660
|
0
|
|
|
|
|
|
for ($i=0; $i<=$#colon; $i++) { |
1661
|
0
|
|
|
|
|
|
$val=0; |
1662
|
0
|
0
|
|
|
|
|
if ($colon[$i] =~ /^$signexp$numexp?/) { |
1663
|
0
|
0
|
|
|
|
|
$val=$2 if ($2); |
1664
|
0
|
0
|
|
|
|
|
$sign=$1 if ($1); |
1665
|
|
|
|
|
|
|
} |
1666
|
0
|
|
|
|
|
|
$colon[$i] = "$sign$val"; |
1667
|
|
|
|
|
|
|
} |
1668
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
# combine the two |
1670
|
0
|
|
|
|
|
|
push(@delta,@colon); |
1671
|
0
|
0
|
|
|
|
|
if ($dir<0) { |
1672
|
0
|
|
|
|
|
|
for ($i=0; $i<=$#delta; $i++) { |
1673
|
0
|
|
|
|
|
|
$delta[$i] =~ tr/-+/+-/; |
1674
|
|
|
|
|
|
|
} |
1675
|
|
|
|
|
|
|
} |
1676
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
# form the delta and shift off the valid part |
1678
|
0
|
|
|
|
|
|
$delta=join(":",@delta); |
1679
|
0
|
|
|
|
|
|
splice(@args,0,$#a+1); |
1680
|
0
|
0
|
0
|
|
|
|
@$args=@args if (defined $ref and $ref eq "ARRAY"); |
1681
|
0
|
|
|
|
|
|
last PARSE; |
1682
|
|
|
|
|
|
|
} |
1683
|
|
|
|
|
|
|
|
1684
|
0
|
|
|
|
|
|
$delta=_Delta_Normalize($delta,$Curr{"Mode"}); |
1685
|
0
|
|
|
|
|
|
return $delta; |
1686
|
|
|
|
|
|
|
} |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
sub UnixDate { |
1689
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/); |
1690
|
0
|
|
|
|
|
|
my($date,@format)=@_; |
1691
|
0
|
|
|
|
|
|
local($_)=(); |
1692
|
0
|
|
|
|
|
|
my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=(); |
1693
|
0
|
|
|
|
|
|
my($scalar)=(); |
1694
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
1695
|
0
|
0
|
|
|
|
|
return if (! $date); |
1696
|
|
|
|
|
|
|
|
1697
|
0
|
|
|
|
|
|
my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})= |
1698
|
|
|
|
|
|
|
_Date_Split($date, 1); |
1699
|
0
|
|
|
|
|
|
$f{"y"}=substr $f{"Y"},2; |
1700
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
1701
|
|
|
|
|
|
|
|
1702
|
0
|
0
|
|
|
|
|
if (! wantarray) { |
1703
|
0
|
|
|
|
|
|
$format=join(" ",@format); |
1704
|
0
|
|
|
|
|
|
@format=($format); |
1705
|
0
|
|
|
|
|
|
$scalar=1; |
1706
|
|
|
|
|
|
|
} |
1707
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
# month, week |
1709
|
0
|
|
|
|
|
|
$_=$m; |
1710
|
0
|
|
|
|
|
|
s/^0//; |
1711
|
0
|
|
|
|
|
|
$f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1]; |
1712
|
0
|
|
|
|
|
|
$f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1]; |
1713
|
0
|
|
|
|
|
|
$_=$m; |
1714
|
0
|
|
|
|
|
|
s/^0/ /; |
1715
|
0
|
|
|
|
|
|
$f{"f"}=$_; |
1716
|
0
|
|
|
|
|
|
$f{"U"}=Date_WeekOfYear($m,$d,$y,7); |
1717
|
0
|
|
|
|
|
|
$f{"W"}=Date_WeekOfYear($m,$d,$y,1); |
1718
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
# check week 52,53 and 0 |
1720
|
0
|
|
|
|
|
|
$f{"G"}=$f{"L"}=$y; |
1721
|
0
|
0
|
0
|
|
|
|
if ($f{"W"}>=52 || $f{"U"}>=52) { |
1722
|
0
|
|
|
|
|
|
my($dd,$mm,$yy)=($d,$m,$y); |
1723
|
0
|
|
|
|
|
|
$dd+=7; |
1724
|
0
|
0
|
|
|
|
|
if ($dd>31) { |
1725
|
0
|
|
|
|
|
|
$dd-=31; |
1726
|
0
|
|
|
|
|
|
$mm=1; |
1727
|
0
|
|
|
|
|
|
$yy++; |
1728
|
0
|
0
|
|
|
|
|
if (Date_WeekOfYear($mm,$dd,$yy,1)==2) { |
1729
|
0
|
|
|
|
|
|
$f{"G"}=$yy; |
1730
|
0
|
|
|
|
|
|
$f{"W"}=1; |
1731
|
|
|
|
|
|
|
} |
1732
|
0
|
0
|
|
|
|
|
if (Date_WeekOfYear($mm,$dd,$yy,7)==2) { |
1733
|
0
|
|
|
|
|
|
$f{"L"}=$yy; |
1734
|
0
|
|
|
|
|
|
$f{"U"}=1; |
1735
|
|
|
|
|
|
|
} |
1736
|
|
|
|
|
|
|
} |
1737
|
|
|
|
|
|
|
} |
1738
|
0
|
0
|
|
|
|
|
if ($f{"W"}==0) { |
1739
|
0
|
|
|
|
|
|
my($dd,$mm,$yy)=($d,$m,$y); |
1740
|
0
|
|
|
|
|
|
$dd-=7; |
1741
|
0
|
0
|
|
|
|
|
$dd+=31 if ($dd<1); |
1742
|
0
|
|
|
|
|
|
$yy = sprintf "%04d", $yy-1; |
1743
|
0
|
|
|
|
|
|
$mm=12; |
1744
|
0
|
|
|
|
|
|
$f{"G"}=$yy; |
1745
|
0
|
|
|
|
|
|
$f{"W"}=Date_WeekOfYear($mm,$dd,$yy,1)+1; |
1746
|
|
|
|
|
|
|
} |
1747
|
0
|
0
|
|
|
|
|
if ($f{"U"}==0) { |
1748
|
0
|
|
|
|
|
|
my($dd,$mm,$yy)=($d,$m,$y); |
1749
|
0
|
|
|
|
|
|
$dd-=7; |
1750
|
0
|
0
|
|
|
|
|
$dd+=31 if ($dd<1); |
1751
|
0
|
|
|
|
|
|
$yy = sprintf "%04d", $yy-1; |
1752
|
0
|
|
|
|
|
|
$mm=12; |
1753
|
0
|
|
|
|
|
|
$f{"L"}=$yy; |
1754
|
0
|
|
|
|
|
|
$f{"U"}=Date_WeekOfYear($mm,$dd,$yy,7)+1; |
1755
|
|
|
|
|
|
|
} |
1756
|
|
|
|
|
|
|
|
1757
|
0
|
0
|
|
|
|
|
$f{"U"}="0".$f{"U"} if (length $f{"U"} < 2); |
1758
|
0
|
0
|
|
|
|
|
$f{"W"}="0".$f{"W"} if (length $f{"W"} < 2); |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
# day |
1761
|
0
|
|
|
|
|
|
$f{"j"}=Date_DayOfYear($m,$d,$y); |
1762
|
0
|
|
|
|
|
|
$f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3); |
1763
|
0
|
|
|
|
|
|
$_=$d; |
1764
|
0
|
|
|
|
|
|
s/^0/ /; |
1765
|
0
|
|
|
|
|
|
$f{"e"}=$_; |
1766
|
0
|
|
|
|
|
|
$f{"w"}=Date_DayOfWeek($m,$d,$y); |
1767
|
0
|
|
|
|
|
|
$f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1]; |
1768
|
0
|
0
|
|
|
|
|
$f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2); |
1769
|
0
|
|
|
|
|
|
$f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1]; |
1770
|
0
|
|
|
|
|
|
$f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1]; |
1771
|
0
|
|
|
|
|
|
$f{"E"}=Date_DaySuffix($f{"e"}); |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
# hour |
1774
|
0
|
|
|
|
|
|
$_=$h; |
1775
|
0
|
|
|
|
|
|
s/^0/ /; |
1776
|
0
|
|
|
|
|
|
$f{"k"}=$_; |
1777
|
0
|
|
|
|
|
|
$f{"i"}=$f{"k"}+1; |
1778
|
0
|
|
|
|
|
|
$f{"i"}=$f{"k"}; |
1779
|
0
|
0
|
|
|
|
|
$f{"i"}=12 if ($f{"k"}==0); |
1780
|
0
|
0
|
|
|
|
|
$f{"i"}=$f{"k"}-12 if ($f{"k"}>12); |
1781
|
0
|
0
|
|
|
|
|
$f{"i"}=$f{"i"}-12 if ($f{"i"}>12); |
1782
|
0
|
0
|
|
|
|
|
$f{"i"}=" ".$f{"i"} if (length($f{"i"})<2); |
1783
|
0
|
|
|
|
|
|
$f{"I"}=$f{"i"}; |
1784
|
0
|
|
|
|
|
|
$f{"I"}=~ s/^ /0/; |
1785
|
0
|
|
|
|
|
|
$f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"}; |
1786
|
0
|
0
|
|
|
|
|
$f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11); |
1787
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
# minute, second, timezone |
1789
|
0
|
|
|
|
|
|
$f{"o"}=Date_SecsSince1970($m,$d,$y,$h,$mn,$s); |
1790
|
0
|
|
|
|
|
|
$f{"s"}=Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s); |
1791
|
|
|
|
|
|
|
$f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ? |
1792
|
0
|
0
|
0
|
|
|
|
$Cnf{"TZ"} : $Cnf{"ConvTZ"}; |
1793
|
0
|
0
|
0
|
|
|
|
$f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ? $f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || ""); |
1794
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
# date, time |
1796
|
0
|
|
|
|
|
|
$f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|; |
1797
|
0
|
|
|
|
|
|
$f{"C"}=$f{"u"}= |
1798
|
|
|
|
|
|
|
qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|; |
1799
|
0
|
|
|
|
|
|
$f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|; |
1800
|
0
|
|
|
|
|
|
$f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|; |
1801
|
0
|
0
|
|
|
|
|
$f{"x"}=qq|$d/$m/$f{"y"}| if ($Cnf{"DateFormat"} ne "US"); |
1802
|
0
|
|
|
|
|
|
$f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|; |
1803
|
0
|
|
|
|
|
|
$f{"R"}=qq|$h:$mn|; |
1804
|
0
|
|
|
|
|
|
$f{"T"}=$f{"X"}=qq|$h:$mn:$s|; |
1805
|
0
|
|
|
|
|
|
$f{"V"}=qq|$m$d$h$mn$f{"y"}|; |
1806
|
0
|
|
|
|
|
|
$f{"Q"}="$y$m$d"; |
1807
|
0
|
|
|
|
|
|
$f{"q"}=qq|$y$m$d$h$mn$s|; |
1808
|
0
|
|
|
|
|
|
$f{"P"}=qq|$y$m$d$h:$mn:$s|; |
1809
|
0
|
|
|
|
|
|
$f{"O"}=qq|$y-$m-${d}T$h:$mn:$s|; |
1810
|
0
|
|
|
|
|
|
$f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|; |
1811
|
0
|
0
|
|
|
|
|
if ($f{"W"}==0) { |
1812
|
0
|
|
|
|
|
|
$y--; |
1813
|
0
|
|
|
|
|
|
$tmp=Date_WeekOfYear(12,31,$y,1); |
1814
|
0
|
0
|
|
|
|
|
$tmp="0$tmp" if (length($tmp) < 2); |
1815
|
0
|
|
|
|
|
|
$f{"J"}=qq|$y-W$tmp-$f{"w"}|; |
1816
|
|
|
|
|
|
|
} else { |
1817
|
0
|
|
|
|
|
|
$f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|; |
1818
|
|
|
|
|
|
|
} |
1819
|
0
|
|
|
|
|
|
$f{"K"}=qq|$y-$f{"j"}|; |
1820
|
|
|
|
|
|
|
# %l is a special case. Since it requires the use of the calculator |
1821
|
|
|
|
|
|
|
# which requires this routine, an infinite recursion results. To get |
1822
|
|
|
|
|
|
|
# around this, %l is NOT determined every time this is called so the |
1823
|
|
|
|
|
|
|
# recursion breaks. |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
# other formats |
1826
|
0
|
|
|
|
|
|
$f{"n"}="\n"; |
1827
|
0
|
|
|
|
|
|
$f{"t"}="\t"; |
1828
|
0
|
|
|
|
|
|
$f{"%"}="%"; |
1829
|
0
|
|
|
|
|
|
$f{"+"}="+"; |
1830
|
|
|
|
|
|
|
|
1831
|
0
|
|
|
|
|
|
foreach $format (@format) { |
1832
|
0
|
|
|
|
|
|
$format=reverse($format); |
1833
|
0
|
|
|
|
|
|
$out=""; |
1834
|
0
|
|
|
|
|
|
while ($format ne "") { |
1835
|
0
|
|
|
|
|
|
$c=chop($format); |
1836
|
0
|
0
|
|
|
|
|
if ($c eq "%") { |
1837
|
0
|
|
|
|
|
|
$c=chop($format); |
1838
|
0
|
0
|
|
|
|
|
if ($c eq "l") { |
|
|
0
|
|
|
|
|
|
1839
|
0
|
|
|
|
|
|
Date_Init(); |
1840
|
0
|
|
|
|
|
|
$date1=_DateCalc_DateDelta($Curr{"Now"},"-0:6:0:0:0:0:0"); |
1841
|
0
|
|
|
|
|
|
$date2=_DateCalc_DateDelta($Curr{"Now"},"+0:6:0:0:0:0:0"); |
1842
|
0
|
0
|
0
|
|
|
|
if (Date_Cmp($date,$date1)>=0 && Date_Cmp($date,$date2)<=0) { |
1843
|
0
|
|
|
|
|
|
$f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|; |
1844
|
|
|
|
|
|
|
} else { |
1845
|
0
|
|
|
|
|
|
$f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|; |
1846
|
|
|
|
|
|
|
} |
1847
|
0
|
|
|
|
|
|
$out .= $f{"$c"}; |
1848
|
|
|
|
|
|
|
} elsif (exists $f{"$c"}) { |
1849
|
0
|
|
|
|
|
|
$out .= $f{"$c"}; |
1850
|
|
|
|
|
|
|
} else { |
1851
|
0
|
|
|
|
|
|
$out .= $c; |
1852
|
|
|
|
|
|
|
} |
1853
|
|
|
|
|
|
|
} else { |
1854
|
0
|
|
|
|
|
|
$out .= $c; |
1855
|
|
|
|
|
|
|
} |
1856
|
|
|
|
|
|
|
} |
1857
|
0
|
|
|
|
|
|
push(@out,$out); |
1858
|
|
|
|
|
|
|
} |
1859
|
0
|
0
|
|
|
|
|
if ($scalar) { |
1860
|
0
|
|
|
|
|
|
return $out[0]; |
1861
|
|
|
|
|
|
|
} else { |
1862
|
0
|
|
|
|
|
|
return (@out); |
1863
|
|
|
|
|
|
|
} |
1864
|
|
|
|
|
|
|
} |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
# Can't be in "use integer" because we're doing decimal arithmatic |
1867
|
36
|
|
|
36
|
|
383
|
no integer; |
|
36
|
|
|
|
|
83
|
|
|
36
|
|
|
|
|
236
|
|
1868
|
|
|
|
|
|
|
sub Delta_Format { |
1869
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/); |
1870
|
0
|
|
|
|
|
|
my($delta,@arg)=@_; |
1871
|
0
|
|
|
|
|
|
my($mode); |
1872
|
0
|
0
|
|
|
|
|
if (lc($arg[0]) eq "approx") { |
1873
|
0
|
|
|
|
|
|
$mode = "approx"; |
1874
|
0
|
|
|
|
|
|
shift(@arg); |
1875
|
|
|
|
|
|
|
} else { |
1876
|
0
|
|
|
|
|
|
$mode = "exact"; |
1877
|
|
|
|
|
|
|
} |
1878
|
0
|
|
|
|
|
|
my($dec,@format) = @arg; |
1879
|
|
|
|
|
|
|
|
1880
|
0
|
|
|
|
|
|
$delta=ParseDateDelta($delta); |
1881
|
0
|
0
|
|
|
|
|
return "" if (! $delta); |
1882
|
0
|
|
|
|
|
|
my(@out,%f,$out,$c1,$c2,$scalar,$format)=(); |
1883
|
0
|
|
|
|
|
|
local($_)=$delta; |
1884
|
0
|
|
|
|
|
|
my($y,$M,$w,$d,$h,$m,$s)=_Delta_Split($delta); |
1885
|
|
|
|
|
|
|
# Get rid of positive signs. |
1886
|
0
|
|
|
|
|
|
($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s); |
|
0
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
|
1888
|
0
|
0
|
0
|
|
|
|
if (defined $dec && $dec>0) { |
1889
|
0
|
|
|
|
|
|
$dec="%." . ($dec*1) . "f"; |
1890
|
|
|
|
|
|
|
} else { |
1891
|
0
|
|
|
|
|
|
$dec="%f"; |
1892
|
|
|
|
|
|
|
} |
1893
|
|
|
|
|
|
|
|
1894
|
0
|
0
|
|
|
|
|
if (! wantarray) { |
1895
|
0
|
|
|
|
|
|
$format=join(" ",@format); |
1896
|
0
|
|
|
|
|
|
@format=($format); |
1897
|
0
|
|
|
|
|
|
$scalar=1; |
1898
|
|
|
|
|
|
|
} |
1899
|
|
|
|
|
|
|
|
1900
|
|
|
|
|
|
|
# Length of each unit in seconds |
1901
|
0
|
|
|
|
|
|
my($sl,$ml,$hl,$dl,$wl,$Ml,$yl)=(); |
1902
|
0
|
|
|
|
|
|
$sl = 1; |
1903
|
0
|
|
|
|
|
|
$ml = $sl*60; |
1904
|
0
|
|
|
|
|
|
$hl = $ml*60; |
1905
|
0
|
|
|
|
|
|
$dl = $hl*24; |
1906
|
0
|
|
|
|
|
|
$wl = $dl*7; |
1907
|
0
|
|
|
|
|
|
$yl = $dl*365.25; |
1908
|
0
|
|
|
|
|
|
$Ml = $yl/12; |
1909
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
# The decimal amount of each unit contained in all smaller units |
1911
|
0
|
|
|
|
|
|
my($yd,$Md,$sd,$md,$hd,$dd,$wd)=(); |
1912
|
0
|
0
|
|
|
|
|
if ($mode eq "exact") { |
1913
|
0
|
|
|
|
|
|
$yd = $M/12; |
1914
|
0
|
|
|
|
|
|
$Md = 0; |
1915
|
|
|
|
|
|
|
} else { |
1916
|
0
|
|
|
|
|
|
$yd = ($M*$Ml + $w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl; |
1917
|
0
|
|
|
|
|
|
$Md = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$Ml; |
1918
|
|
|
|
|
|
|
} |
1919
|
|
|
|
|
|
|
|
1920
|
0
|
|
|
|
|
|
$wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl; |
1921
|
0
|
|
|
|
|
|
$dd = ($h*$hl + $m*$ml + $s*$sl)/$dl; |
1922
|
0
|
|
|
|
|
|
$hd = ($m*$ml + $s*$sl)/$hl; |
1923
|
0
|
|
|
|
|
|
$md = ($s*$sl)/$ml; |
1924
|
0
|
|
|
|
|
|
$sd = 0; |
1925
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
# The amount of each unit contained in higher units. |
1927
|
0
|
|
|
|
|
|
my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=(); |
1928
|
0
|
|
|
|
|
|
$yh = 0; |
1929
|
0
|
|
|
|
|
|
$Mh = ($yh+$y)*12; |
1930
|
|
|
|
|
|
|
|
1931
|
0
|
0
|
|
|
|
|
if ($mode eq "exact") { |
1932
|
0
|
|
|
|
|
|
$wh = 0; |
1933
|
0
|
|
|
|
|
|
$dh = ($wh+$w)*7; |
1934
|
|
|
|
|
|
|
} else { |
1935
|
0
|
|
|
|
|
|
$wh = ($yh+$y+$M/12)*365.25/7; |
1936
|
0
|
|
|
|
|
|
$dh = ($wh+$w)*7; |
1937
|
|
|
|
|
|
|
} |
1938
|
|
|
|
|
|
|
|
1939
|
0
|
|
|
|
|
|
$hh = ($dh+$d)*24; |
1940
|
0
|
|
|
|
|
|
$mh = ($hh+$h)*60; |
1941
|
0
|
|
|
|
|
|
$sh = ($mh+$m)*60; |
1942
|
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
|
# Set up the formats |
1944
|
|
|
|
|
|
|
|
1945
|
0
|
|
|
|
|
|
$f{"yv"} = $y; |
1946
|
0
|
|
|
|
|
|
$f{"Mv"} = $M; |
1947
|
0
|
|
|
|
|
|
$f{"wv"} = $w; |
1948
|
0
|
|
|
|
|
|
$f{"dv"} = $d; |
1949
|
0
|
|
|
|
|
|
$f{"hv"} = $h; |
1950
|
0
|
|
|
|
|
|
$f{"mv"} = $m; |
1951
|
0
|
|
|
|
|
|
$f{"sv"} = $s; |
1952
|
|
|
|
|
|
|
|
1953
|
0
|
|
|
|
|
|
$f{"yh"} = $y+$yh; |
1954
|
0
|
|
|
|
|
|
$f{"Mh"} = $M+$Mh; |
1955
|
0
|
|
|
|
|
|
$f{"wh"} = $w+$wh; |
1956
|
0
|
|
|
|
|
|
$f{"dh"} = $d+$dh; |
1957
|
0
|
|
|
|
|
|
$f{"hh"} = $h+$hh; |
1958
|
0
|
|
|
|
|
|
$f{"mh"} = $m+$mh; |
1959
|
0
|
|
|
|
|
|
$f{"sh"} = $s+$sh; |
1960
|
|
|
|
|
|
|
|
1961
|
0
|
|
|
|
|
|
$f{"yd"} = sprintf($dec,$y+$yd); |
1962
|
0
|
|
|
|
|
|
$f{"Md"} = sprintf($dec,$M+$Md); |
1963
|
0
|
|
|
|
|
|
$f{"wd"} = sprintf($dec,$w+$wd); |
1964
|
0
|
|
|
|
|
|
$f{"dd"} = sprintf($dec,$d+$dd); |
1965
|
0
|
|
|
|
|
|
$f{"hd"} = sprintf($dec,$h+$hd); |
1966
|
0
|
|
|
|
|
|
$f{"md"} = sprintf($dec,$m+$md); |
1967
|
0
|
|
|
|
|
|
$f{"sd"} = sprintf($dec,$s+$sd); |
1968
|
|
|
|
|
|
|
|
1969
|
0
|
|
|
|
|
|
$f{"yt"} = sprintf($dec,$yh+$y+$yd); |
1970
|
0
|
|
|
|
|
|
$f{"Mt"} = sprintf($dec,$Mh+$M+$Md); |
1971
|
0
|
|
|
|
|
|
$f{"wt"} = sprintf($dec,$wh+$w+$wd); |
1972
|
0
|
|
|
|
|
|
$f{"dt"} = sprintf($dec,$dh+$d+$dd); |
1973
|
0
|
|
|
|
|
|
$f{"ht"} = sprintf($dec,$hh+$h+$hd); |
1974
|
0
|
|
|
|
|
|
$f{"mt"} = sprintf($dec,$mh+$m+$md); |
1975
|
0
|
|
|
|
|
|
$f{"st"} = sprintf($dec,$sh+$s+$sd); |
1976
|
|
|
|
|
|
|
|
1977
|
0
|
|
|
|
|
|
$f{"%"} = "%"; |
1978
|
|
|
|
|
|
|
|
1979
|
0
|
|
|
|
|
|
foreach $format (@format) { |
1980
|
0
|
|
|
|
|
|
$format=reverse($format); |
1981
|
0
|
|
|
|
|
|
$out=""; |
1982
|
0
|
|
|
|
|
|
PARSE: while ($format) { |
1983
|
0
|
|
|
|
|
|
$c1=chop($format); |
1984
|
0
|
0
|
|
|
|
|
if ($c1 eq "%") { |
1985
|
0
|
|
|
|
|
|
$c1=chop($format); |
1986
|
0
|
0
|
|
|
|
|
if (exists($f{$c1})) { |
1987
|
0
|
|
|
|
|
|
$out .= $f{$c1}; |
1988
|
0
|
|
|
|
|
|
next PARSE; |
1989
|
|
|
|
|
|
|
} |
1990
|
0
|
|
|
|
|
|
$c2=chop($format); |
1991
|
0
|
0
|
|
|
|
|
if (exists($f{"$c1$c2"})) { |
1992
|
0
|
|
|
|
|
|
$out .= $f{"$c1$c2"}; |
1993
|
0
|
|
|
|
|
|
next PARSE; |
1994
|
|
|
|
|
|
|
} |
1995
|
0
|
|
|
|
|
|
$out .= $c1; |
1996
|
0
|
|
|
|
|
|
$format .= $c2; |
1997
|
|
|
|
|
|
|
} else { |
1998
|
0
|
|
|
|
|
|
$out .= $c1; |
1999
|
|
|
|
|
|
|
} |
2000
|
|
|
|
|
|
|
} |
2001
|
0
|
|
|
|
|
|
push(@out,$out); |
2002
|
|
|
|
|
|
|
} |
2003
|
0
|
0
|
|
|
|
|
if ($scalar) { |
2004
|
0
|
|
|
|
|
|
return $out[0]; |
2005
|
|
|
|
|
|
|
} else { |
2006
|
0
|
|
|
|
|
|
return (@out); |
2007
|
|
|
|
|
|
|
} |
2008
|
|
|
|
|
|
|
} |
2009
|
36
|
|
|
36
|
|
33828
|
use integer; |
|
36
|
|
|
|
|
83
|
|
|
36
|
|
|
|
|
195
|
|
2010
|
|
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
sub ParseRecur { |
2012
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/); |
2013
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
2014
|
|
|
|
|
|
|
|
2015
|
0
|
|
|
|
|
|
my($recur,$dateb,$date0,$date1,$flag)=@_; |
2016
|
0
|
|
|
|
|
|
local($_)=$recur; |
2017
|
|
|
|
|
|
|
|
2018
|
0
|
|
|
|
|
|
my($recur_0,$recur_1,@recur0,@recur1)=(); |
2019
|
0
|
|
|
|
|
|
my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=(); |
2020
|
0
|
|
|
|
|
|
my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=(); |
2021
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
# $date0, $date1, $dateb, $flag : passed in (these are always the final say |
2023
|
|
|
|
|
|
|
# in determining whether a date matches a |
2024
|
|
|
|
|
|
|
# recurrence IF they are present. |
2025
|
|
|
|
|
|
|
# $date_b, $date_0, $date_1 : if a value can be determined from the |
2026
|
|
|
|
|
|
|
# $flag_t recurrence, they are stored here. |
2027
|
|
|
|
|
|
|
# |
2028
|
|
|
|
|
|
|
# If values can be determined from the recurrence AND are passed in, the |
2029
|
|
|
|
|
|
|
# following are used: |
2030
|
|
|
|
|
|
|
# max($date0,$date_0) i.e. the later of the two dates |
2031
|
|
|
|
|
|
|
# min($date1,$date_1) i.e. the earlier of the two dates |
2032
|
|
|
|
|
|
|
# |
2033
|
|
|
|
|
|
|
# The base date that is used is the first one defined from |
2034
|
|
|
|
|
|
|
# $dateb $date_b |
2035
|
|
|
|
|
|
|
# The base date is only used if necessary (as determined by the recur). |
2036
|
|
|
|
|
|
|
# For example, "every other friday" requires a base date, but "2nd |
2037
|
|
|
|
|
|
|
# friday of every month" doesn't. |
2038
|
|
|
|
|
|
|
|
2039
|
0
|
|
|
|
|
|
my($date_b,$date_0,$date_1,$flag_t); |
2040
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
# |
2042
|
|
|
|
|
|
|
# Check the arguments passed in. |
2043
|
|
|
|
|
|
|
# |
2044
|
|
|
|
|
|
|
|
2045
|
0
|
0
|
|
|
|
|
$date0="" if (! defined $date0); |
2046
|
0
|
0
|
|
|
|
|
$date1="" if (! defined $date1); |
2047
|
0
|
0
|
|
|
|
|
$dateb="" if (! defined $dateb); |
2048
|
0
|
0
|
|
|
|
|
$flag ="" if (! defined $flag); |
2049
|
|
|
|
|
|
|
|
2050
|
0
|
0
|
|
|
|
|
if ($dateb) { |
2051
|
0
|
|
|
|
|
|
$dateb=ParseDateString($dateb); |
2052
|
0
|
0
|
|
|
|
|
return "" if (! $dateb); |
2053
|
|
|
|
|
|
|
} |
2054
|
0
|
0
|
|
|
|
|
if ($date0) { |
2055
|
0
|
|
|
|
|
|
$date0=ParseDateString($date0); |
2056
|
0
|
0
|
|
|
|
|
return "" if (! $date0); |
2057
|
|
|
|
|
|
|
} |
2058
|
0
|
0
|
|
|
|
|
if ($date1) { |
2059
|
0
|
|
|
|
|
|
$date1=ParseDateString($date1); |
2060
|
0
|
0
|
|
|
|
|
return "" if (! $date1); |
2061
|
|
|
|
|
|
|
} |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
# |
2064
|
|
|
|
|
|
|
# Parse the recur. $date_b, $date_0, and $date_e are values obtained |
2065
|
|
|
|
|
|
|
# from the recur. |
2066
|
|
|
|
|
|
|
# |
2067
|
|
|
|
|
|
|
|
2068
|
0
|
|
|
|
|
|
@tmp=_Recur_Split($_); |
2069
|
|
|
|
|
|
|
|
2070
|
0
|
0
|
|
|
|
|
if (@tmp) { |
2071
|
0
|
|
|
|
|
|
($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp; |
2072
|
0
|
0
|
|
|
|
|
$recur_0 = "" if (! defined $recur_0); |
2073
|
0
|
0
|
|
|
|
|
$recur_1 = "" if (! defined $recur_1); |
2074
|
0
|
0
|
|
|
|
|
$flag_t = "" if (! defined $flag_t); |
2075
|
0
|
0
|
|
|
|
|
$date_b = "" if (! defined $date_b); |
2076
|
0
|
0
|
|
|
|
|
$date_0 = "" if (! defined $date_0); |
2077
|
0
|
0
|
|
|
|
|
$date_1 = "" if (! defined $date_1); |
2078
|
|
|
|
|
|
|
|
2079
|
0
|
|
|
|
|
|
@recur0 = split(/:/,$recur_0); |
2080
|
0
|
|
|
|
|
|
@recur1 = split(/:/,$recur_1); |
2081
|
0
|
0
|
|
|
|
|
return "" if ($#recur0 + $#recur1 + 2 != 7); |
2082
|
|
|
|
|
|
|
|
2083
|
0
|
0
|
|
|
|
|
if ($date_b) { |
2084
|
0
|
|
|
|
|
|
$date_b=ParseDateString($date_b); |
2085
|
0
|
0
|
|
|
|
|
return "" if (! $date_b); |
2086
|
|
|
|
|
|
|
} |
2087
|
0
|
0
|
|
|
|
|
if ($date_0) { |
2088
|
0
|
|
|
|
|
|
$date_0=ParseDateString($date_0); |
2089
|
0
|
0
|
|
|
|
|
return "" if (! $date_0); |
2090
|
|
|
|
|
|
|
} |
2091
|
0
|
0
|
|
|
|
|
if ($date_1) { |
2092
|
0
|
|
|
|
|
|
$date_1=ParseDateString($date_1); |
2093
|
0
|
0
|
|
|
|
|
return "" if (! $date_1); |
2094
|
|
|
|
|
|
|
} |
2095
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
} else { |
2097
|
|
|
|
|
|
|
|
2098
|
0
|
|
|
|
|
|
my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...) |
2099
|
0
|
|
|
|
|
|
my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... } |
|
0
|
|
|
|
|
|
|
2100
|
0
|
|
|
|
|
|
my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...) |
2101
|
0
|
|
|
|
|
|
my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... } |
|
0
|
|
|
|
|
|
|
2102
|
0
|
|
|
|
|
|
my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days) |
2103
|
0
|
|
|
|
|
|
my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months) |
2104
|
0
|
|
|
|
|
|
my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks) |
2105
|
0
|
|
|
|
|
|
my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st) |
2106
|
0
|
|
|
|
|
|
my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} }; |
|
0
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
# { 1st=>1,first=>1,...} |
2108
|
0
|
|
|
|
|
|
my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of) |
2109
|
0
|
|
|
|
|
|
my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last) |
2110
|
0
|
|
|
|
|
|
my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every) |
2111
|
|
|
|
|
|
|
|
2112
|
0
|
|
|
|
|
|
my($D)='\s*(\d+)'; |
2113
|
0
|
|
|
|
|
|
my($Y)='\s*(\d{4}|\d{2})'; |
2114
|
|
|
|
|
|
|
|
2115
|
|
|
|
|
|
|
# Change 1st to 1 |
2116
|
0
|
0
|
|
|
|
|
if (/(^|[^a-z])$daysexp($|[^a-z])/i) { |
2117
|
0
|
|
|
|
|
|
$tmp=lc($2); |
2118
|
0
|
|
|
|
|
|
$tmp=$dayshash{"$tmp"}; |
2119
|
0
|
|
|
|
|
|
s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i; |
2120
|
|
|
|
|
|
|
} |
2121
|
0
|
|
|
|
|
|
s/\s*$//; |
2122
|
|
|
|
|
|
|
|
2123
|
|
|
|
|
|
|
# Get rid of "each" |
2124
|
0
|
0
|
|
|
|
|
if (/(^|[^a-z])$each($|[^a-z])/i) { |
2125
|
0
|
|
|
|
|
|
s/(^|[^a-z])$each($|[^a-z])/$1 $2/i; |
2126
|
0
|
|
|
|
|
|
$each=1; |
2127
|
|
|
|
|
|
|
} else { |
2128
|
0
|
|
|
|
|
|
$each=0; |
2129
|
|
|
|
|
|
|
} |
2130
|
|
|
|
|
|
|
|
2131
|
0
|
0
|
|
|
|
|
if ($each) { |
2132
|
|
|
|
|
|
|
|
2133
|
0
|
0
|
0
|
|
|
|
if (/^$D?$day(?:$of$mmm?$Y)?$/i || |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2134
|
|
|
|
|
|
|
/^$D?$day(?:$of$mmm())?$/i) { |
2135
|
|
|
|
|
|
|
# every [2nd] day in [june] 1997 |
2136
|
|
|
|
|
|
|
# every [2nd] day [in june] |
2137
|
0
|
|
|
|
|
|
($num,$m,$y)=($1,$2,$3); |
2138
|
0
|
0
|
|
|
|
|
$num=1 if (! defined $num); |
2139
|
0
|
0
|
|
|
|
|
$m="" if (! defined $m); |
2140
|
0
|
0
|
|
|
|
|
$y="" if (! defined $y); |
2141
|
|
|
|
|
|
|
|
2142
|
0
|
0
|
|
|
|
|
$y=$Curr{"Y"} if (! $y); |
2143
|
0
|
0
|
|
|
|
|
if ($m) { |
2144
|
0
|
|
|
|
|
|
$m=$mmm{lc($m)}; |
2145
|
0
|
|
|
|
|
|
$date_0=_Date_Join($y,$m,1,0,0,0); |
2146
|
0
|
|
|
|
|
|
$date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0); |
2147
|
|
|
|
|
|
|
} else { |
2148
|
0
|
|
|
|
|
|
$date_0=_Date_Join($y, 1,1,0,0,0); |
2149
|
0
|
|
|
|
|
|
$date_1=_Date_Join($y+1,1,1,0,0,0); |
2150
|
|
|
|
|
|
|
} |
2151
|
0
|
|
|
|
|
|
$date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0); |
2152
|
0
|
|
|
|
|
|
@recur0=(0,0,0,$num,0,0,0); |
2153
|
0
|
|
|
|
|
|
@recur1=(); |
2154
|
|
|
|
|
|
|
|
2155
|
|
|
|
|
|
|
} elsif (/^$D$day?$of$month(?:$of?$Y)?$/) { |
2156
|
|
|
|
|
|
|
# 2nd [day] of every month [in 1997] |
2157
|
0
|
|
|
|
|
|
($num,$y)=($1,$2); |
2158
|
0
|
0
|
|
|
|
|
$y=$Curr{"Y"} if (! $y); |
2159
|
|
|
|
|
|
|
|
2160
|
0
|
|
|
|
|
|
$date_0=_Date_Join($y, 1,1,0,0,0); |
2161
|
0
|
|
|
|
|
|
$date_1=_Date_Join($y+1,1,1,0,0,0); |
2162
|
0
|
|
|
|
|
|
$date_b=$date_0; |
2163
|
|
|
|
|
|
|
|
2164
|
0
|
|
|
|
|
|
@recur0=(0,1,0); |
2165
|
0
|
|
|
|
|
|
@recur1=($num,0,0,0); |
2166
|
|
|
|
|
|
|
|
2167
|
|
|
|
|
|
|
} elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ || |
2168
|
|
|
|
|
|
|
/^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) { |
2169
|
|
|
|
|
|
|
# 2nd tuesday of every month [in 1997] |
2170
|
|
|
|
|
|
|
# last tuesday of every month [in 1997] |
2171
|
0
|
|
|
|
|
|
($num,$d,$y)=($1,$2,$3); |
2172
|
0
|
0
|
|
|
|
|
$y=$Curr{"Y"} if (! $y); |
2173
|
0
|
|
|
|
|
|
$d=$week{lc($d)}; |
2174
|
0
|
0
|
|
|
|
|
$num=-1 if ($num !~ /^$D$/); |
2175
|
|
|
|
|
|
|
|
2176
|
0
|
|
|
|
|
|
$date_0=_Date_Join($y,1,1,0,0,0); |
2177
|
0
|
|
|
|
|
|
$date_1=_Date_Join($y+1,1,1,0,0,0); |
2178
|
0
|
|
|
|
|
|
$date_b=$date_0; |
2179
|
|
|
|
|
|
|
|
2180
|
0
|
|
|
|
|
|
@recur0=(0,1); |
2181
|
0
|
|
|
|
|
|
@recur1=($num,$d,0,0,0); |
2182
|
|
|
|
|
|
|
|
2183
|
|
|
|
|
|
|
} elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i || |
2184
|
|
|
|
|
|
|
/^$D?$wkexp(?:$of$mmm())?$/i) { |
2185
|
|
|
|
|
|
|
# every tuesday in june 1997 |
2186
|
|
|
|
|
|
|
# every 2nd tuesday in june 1997 |
2187
|
0
|
|
|
|
|
|
($num,$d,$m,$y)=($1,$2,$3,$4); |
2188
|
0
|
0
|
|
|
|
|
$y=$Curr{"Y"} if (! $y); |
2189
|
0
|
0
|
|
|
|
|
$num=1 if (! defined $num); |
2190
|
0
|
0
|
|
|
|
|
$m="" if (! defined $m); |
2191
|
0
|
|
|
|
|
|
$d=$week{lc($d)}; |
2192
|
|
|
|
|
|
|
|
2193
|
0
|
0
|
|
|
|
|
if ($m) { |
2194
|
0
|
|
|
|
|
|
$m=$mmm{lc($m)}; |
2195
|
0
|
|
|
|
|
|
$date_0=_Date_Join($y,$m,1,0,0,0); |
2196
|
0
|
|
|
|
|
|
$date_1=_DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0); |
2197
|
|
|
|
|
|
|
} else { |
2198
|
0
|
|
|
|
|
|
$date_0=_Date_Join($y,1,1,0,0,0); |
2199
|
0
|
|
|
|
|
|
$date_1=_Date_Join($y+1,1,1,0,0,0); |
2200
|
|
|
|
|
|
|
} |
2201
|
0
|
|
|
|
|
|
$date_b=DateCalc($date_0,"-0:0:0:1:0:0:0",0); |
2202
|
|
|
|
|
|
|
|
2203
|
0
|
|
|
|
|
|
@recur0=(0,0,$num); |
2204
|
0
|
|
|
|
|
|
@recur1=($d,0,0,0); |
2205
|
|
|
|
|
|
|
|
2206
|
|
|
|
|
|
|
} else { |
2207
|
0
|
|
|
|
|
|
return ""; |
2208
|
|
|
|
|
|
|
} |
2209
|
|
|
|
|
|
|
|
2210
|
0
|
0
|
|
|
|
|
$date_0="" if ($date0); |
2211
|
0
|
0
|
|
|
|
|
$date_1="" if ($date1); |
2212
|
|
|
|
|
|
|
} else { |
2213
|
0
|
|
|
|
|
|
return ""; |
2214
|
|
|
|
|
|
|
} |
2215
|
|
|
|
|
|
|
} |
2216
|
|
|
|
|
|
|
|
2217
|
|
|
|
|
|
|
# |
2218
|
|
|
|
|
|
|
# Override with any values passed in |
2219
|
|
|
|
|
|
|
# |
2220
|
|
|
|
|
|
|
|
2221
|
0
|
0
|
|
|
|
|
$date0 = $date_0 if (! $date0); |
2222
|
0
|
0
|
|
|
|
|
$date1 = $date_1 if (! $date1); |
2223
|
0
|
0
|
|
|
|
|
$dateb = $date_b if (! $dateb); |
2224
|
0
|
0
|
|
|
|
|
if ($flag =~ s/^\+//) { |
2225
|
0
|
0
|
|
|
|
|
$flag = "$flag_t,$flag" if ($flag_t); |
2226
|
|
|
|
|
|
|
} |
2227
|
0
|
0
|
|
|
|
|
$flag = $flag_t if (! $flag); |
2228
|
0
|
0
|
|
|
|
|
$flag = "" if (! $flag); |
2229
|
|
|
|
|
|
|
|
2230
|
0
|
0
|
|
|
|
|
if (! wantarray) { |
2231
|
0
|
|
|
|
|
|
$tmp = join(":",@recur0); |
2232
|
0
|
0
|
|
|
|
|
$tmp .= "*" . join(":",@recur1) if (@recur1); |
2233
|
0
|
|
|
|
|
|
$tmp .= "*$flag*$dateb*$date0*$date1"; |
2234
|
0
|
|
|
|
|
|
return $tmp; |
2235
|
|
|
|
|
|
|
} |
2236
|
0
|
0
|
|
|
|
|
if (@recur0) { |
2237
|
0
|
0
|
0
|
|
|
|
return () if (! $date0 || ! $date1); # dateb is NOT required in all case |
2238
|
|
|
|
|
|
|
} |
2239
|
|
|
|
|
|
|
|
2240
|
|
|
|
|
|
|
# |
2241
|
|
|
|
|
|
|
# Some flags affect parsing. |
2242
|
|
|
|
|
|
|
# |
2243
|
|
|
|
|
|
|
|
2244
|
0
|
|
|
|
|
|
@flags = split(/,/,$flag); |
2245
|
0
|
|
|
|
|
|
my($f); |
2246
|
0
|
|
|
|
|
|
foreach $f (@flags) { |
2247
|
0
|
0
|
|
|
|
|
if ($f =~ /^EASTER$/i) { |
2248
|
0
|
|
|
|
|
|
($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1); |
2249
|
|
|
|
|
|
|
# We want something that will return Jan 1 for the given years. |
2250
|
0
|
0
|
|
|
|
|
if ($#recur0==-1) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2251
|
0
|
|
|
|
|
|
@recur1=($y,1,0,1,$h,$mn,$s); |
2252
|
|
|
|
|
|
|
} elsif ($#recur0<=3) { |
2253
|
0
|
|
|
|
|
|
@recur0=($y,0,0,0); |
2254
|
0
|
|
|
|
|
|
@recur1=($h,$mn,$s); |
2255
|
|
|
|
|
|
|
} elsif ($#recur0==4) { |
2256
|
0
|
|
|
|
|
|
@recur0=($y,0,0,0,0); |
2257
|
0
|
|
|
|
|
|
@recur1=($mn,$s); |
2258
|
|
|
|
|
|
|
} elsif ($#recur0==5) { |
2259
|
0
|
|
|
|
|
|
@recur0=($y,0,0,0,0,0); |
2260
|
0
|
|
|
|
|
|
@recur1=($s); |
2261
|
|
|
|
|
|
|
} else { |
2262
|
0
|
|
|
|
|
|
@recur0=($y,0,0,0,0,0,0); |
2263
|
|
|
|
|
|
|
} |
2264
|
|
|
|
|
|
|
} |
2265
|
|
|
|
|
|
|
} |
2266
|
|
|
|
|
|
|
|
2267
|
|
|
|
|
|
|
# |
2268
|
|
|
|
|
|
|
# Determine the dates referenced by the recur. Also, fix the base date |
2269
|
|
|
|
|
|
|
# as necessary for the recurrences which require it. |
2270
|
|
|
|
|
|
|
# |
2271
|
|
|
|
|
|
|
|
2272
|
0
|
|
|
|
|
|
($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1); |
2273
|
0
|
|
|
|
|
|
@y=@m=@w=@d=(); |
2274
|
0
|
|
|
|
|
|
my(@time)=($h,$mn,$s); |
2275
|
|
|
|
|
|
|
|
2276
|
0
|
|
|
|
|
|
RECUR: while (1) { |
2277
|
|
|
|
|
|
|
|
2278
|
0
|
0
|
|
|
|
|
if ($#recur0==-1) { |
2279
|
|
|
|
|
|
|
# * 0-M-W-D-H-MN-S => 0 * M-W-D-H-MN-S |
2280
|
|
|
|
|
|
|
|
2281
|
0
|
0
|
|
|
|
|
if ($y eq "0") { |
2282
|
0
|
|
|
|
|
|
push(@recur0,1); |
2283
|
0
|
|
|
|
|
|
shift(@recur1); |
2284
|
0
|
|
|
|
|
|
next RECUR; |
2285
|
|
|
|
|
|
|
} |
2286
|
|
|
|
|
|
|
|
2287
|
|
|
|
|
|
|
# Y-M-W-D-H-MN-S |
2288
|
|
|
|
|
|
|
|
2289
|
0
|
|
|
|
|
|
@y=_ReturnList($y); |
2290
|
0
|
|
|
|
|
|
foreach $y (@y) { |
2291
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)==2); |
2292
|
0
|
0
|
0
|
|
|
|
return () if (length($y)!=4 || ! _IsInt($y)); |
2293
|
|
|
|
|
|
|
} |
2294
|
|
|
|
|
|
|
|
2295
|
0
|
0
|
|
|
|
|
$date0=ParseDate("0000-01-01") if (! $date0); |
2296
|
0
|
0
|
|
|
|
|
$date1=ParseDate("9999-12-31 23:59:59") if (! $date1); |
2297
|
|
|
|
|
|
|
|
2298
|
0
|
0
|
0
|
|
|
|
if ($m eq "0" and $w eq "0") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2299
|
|
|
|
|
|
|
|
2300
|
|
|
|
|
|
|
# * Y-0-0-0-H-MN-S |
2301
|
|
|
|
|
|
|
# * Y-0-0-DOY-H-MN-S |
2302
|
|
|
|
|
|
|
|
2303
|
0
|
0
|
|
|
|
|
if ($d eq "0") { |
2304
|
0
|
|
|
|
|
|
@d=(1); |
2305
|
|
|
|
|
|
|
} else { |
2306
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2307
|
0
|
0
|
|
|
|
|
return () if (! @d); |
2308
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2309
|
0
|
0
|
0
|
|
|
|
return () if (! _IsInt($d,-366,366) || $d==0); |
2310
|
|
|
|
|
|
|
} |
2311
|
|
|
|
|
|
|
} |
2312
|
|
|
|
|
|
|
|
2313
|
0
|
|
|
|
|
|
@date=(); |
2314
|
0
|
|
|
|
|
|
foreach $yy (@y) { |
2315
|
0
|
|
|
|
|
|
my $diy = Date_DaysInYear($yy); |
2316
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2317
|
0
|
|
|
|
|
|
my $tmpd = $d; |
2318
|
0
|
0
|
|
|
|
|
$tmpd += ($diy+1) if ($tmpd < 0); |
2319
|
0
|
0
|
|
|
|
|
next if (! _IsInt($tmpd,1,$diy)); |
2320
|
0
|
|
|
|
|
|
($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd); |
2321
|
0
|
|
|
|
|
|
push(@date, _Date_Join($y,$m,$dd,0,0,0)); |
2322
|
|
|
|
|
|
|
} |
2323
|
|
|
|
|
|
|
} |
2324
|
0
|
|
|
|
|
|
last RECUR; |
2325
|
|
|
|
|
|
|
|
2326
|
|
|
|
|
|
|
} elsif ($w eq "0") { |
2327
|
|
|
|
|
|
|
|
2328
|
|
|
|
|
|
|
# * Y-M-0-0-H-MN-S |
2329
|
|
|
|
|
|
|
# * Y-M-0-DOM-H-MN-S |
2330
|
|
|
|
|
|
|
|
2331
|
0
|
|
|
|
|
|
@m=_ReturnList($m); |
2332
|
0
|
0
|
|
|
|
|
return () if (! @m); |
2333
|
0
|
|
|
|
|
|
foreach $m (@m) { |
2334
|
0
|
0
|
|
|
|
|
return () if (! _IsInt($m,1,12)); |
2335
|
|
|
|
|
|
|
} |
2336
|
|
|
|
|
|
|
|
2337
|
0
|
0
|
|
|
|
|
if ($d eq "0") { |
2338
|
0
|
|
|
|
|
|
@d=(1); |
2339
|
|
|
|
|
|
|
} else { |
2340
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2341
|
0
|
0
|
|
|
|
|
return () if (! @d); |
2342
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2343
|
0
|
0
|
0
|
|
|
|
return () if (! _IsInt($d,-31,31) || $d==0); |
2344
|
|
|
|
|
|
|
} |
2345
|
|
|
|
|
|
|
} |
2346
|
|
|
|
|
|
|
|
2347
|
0
|
|
|
|
|
|
@date=(); |
2348
|
0
|
|
|
|
|
|
foreach $y (@y) { |
2349
|
0
|
|
|
|
|
|
foreach $m (@m) { |
2350
|
0
|
|
|
|
|
|
my $dim = Date_DaysInMonth($m,$y); |
2351
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2352
|
0
|
|
|
|
|
|
my $tmpd = $d; |
2353
|
0
|
0
|
|
|
|
|
$tmpd += ($dim+1) if ($d<0); |
2354
|
0
|
0
|
|
|
|
|
next if (! _IsInt($tmpd,1,$dim)); |
2355
|
0
|
|
|
|
|
|
$date=_Date_Join($y,$m,$tmpd,0,0,0); |
2356
|
0
|
|
|
|
|
|
push(@date,$date); |
2357
|
|
|
|
|
|
|
} |
2358
|
|
|
|
|
|
|
} |
2359
|
|
|
|
|
|
|
} |
2360
|
0
|
|
|
|
|
|
last RECUR; |
2361
|
|
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
} elsif ($m eq "0") { |
2363
|
|
|
|
|
|
|
|
2364
|
|
|
|
|
|
|
# * Y-0-WOY-DOW-H-MN-S |
2365
|
|
|
|
|
|
|
# * Y-0-WOY-0-H-MN-S |
2366
|
|
|
|
|
|
|
|
2367
|
0
|
|
|
|
|
|
@w=_ReturnList($w); |
2368
|
0
|
0
|
|
|
|
|
return () if (! @w); |
2369
|
0
|
|
|
|
|
|
foreach $w (@w) { |
2370
|
0
|
0
|
0
|
|
|
|
return () if (! _IsInt($w,-53,53) || $w==0); |
2371
|
|
|
|
|
|
|
} |
2372
|
|
|
|
|
|
|
|
2373
|
0
|
0
|
|
|
|
|
if ($d eq "0") { |
2374
|
0
|
|
|
|
|
|
@d=(1); |
2375
|
|
|
|
|
|
|
} else { |
2376
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2377
|
0
|
0
|
|
|
|
|
return () if (! @d); |
2378
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2379
|
0
|
0
|
|
|
|
|
$d += 8 if ($d<0); |
2380
|
0
|
0
|
|
|
|
|
return () if (! _IsInt($d,1,7)); |
2381
|
|
|
|
|
|
|
} |
2382
|
|
|
|
|
|
|
} |
2383
|
|
|
|
|
|
|
|
2384
|
0
|
|
|
|
|
|
@date=(); |
2385
|
0
|
|
|
|
|
|
foreach $y (@y) { |
2386
|
0
|
|
|
|
|
|
foreach $w (@w) { |
2387
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2388
|
0
|
|
|
|
|
|
my($tmpw,$del); |
2389
|
0
|
0
|
|
|
|
|
if ($w<0) { |
2390
|
0
|
|
|
|
|
|
$date="$y-12-31-00:00:00"; |
2391
|
0
|
|
|
|
|
|
$tmpw = (-$w)-1; |
2392
|
0
|
|
|
|
|
|
$del="-0:0:$tmpw:0:0:0:0"; |
2393
|
0
|
|
|
|
|
|
$date=Date_GetPrev($date,$d,1); |
2394
|
|
|
|
|
|
|
} else { |
2395
|
0
|
|
|
|
|
|
$date="$y-01-01-00:00:00"; |
2396
|
0
|
|
|
|
|
|
$tmpw = ($w)-1; |
2397
|
0
|
|
|
|
|
|
$del="0:0:$tmpw:0:0:0:0"; |
2398
|
0
|
|
|
|
|
|
$date=Date_GetNext($date,$d,1); |
2399
|
|
|
|
|
|
|
} |
2400
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,$del); |
2401
|
0
|
0
|
|
|
|
|
push(@date,$date) if ( (_Date_Split($date))[0] == $y); |
2402
|
|
|
|
|
|
|
} |
2403
|
|
|
|
|
|
|
} |
2404
|
|
|
|
|
|
|
} |
2405
|
0
|
|
|
|
|
|
last RECUR; |
2406
|
|
|
|
|
|
|
|
2407
|
|
|
|
|
|
|
} else { |
2408
|
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
|
# * Y-M-WOM-DOW-H-MN-S |
2410
|
|
|
|
|
|
|
# * Y-M-WOM-0-H-MN-S |
2411
|
|
|
|
|
|
|
|
2412
|
0
|
|
|
|
|
|
@m=_ReturnList($m); |
2413
|
0
|
0
|
|
|
|
|
return () if (! @m); |
2414
|
0
|
|
|
|
|
|
@w=_ReturnList($w); |
2415
|
0
|
0
|
|
|
|
|
return () if (! @w); |
2416
|
0
|
0
|
|
|
|
|
if ($d eq "0") { |
2417
|
0
|
|
|
|
|
|
@d=(1); |
2418
|
|
|
|
|
|
|
} else { |
2419
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2420
|
|
|
|
|
|
|
} |
2421
|
|
|
|
|
|
|
|
2422
|
0
|
|
|
|
|
|
@date=_Date_Recur_WoM(\@y,\@m,\@w,\@d); |
2423
|
0
|
|
|
|
|
|
last RECUR; |
2424
|
|
|
|
|
|
|
} |
2425
|
|
|
|
|
|
|
} |
2426
|
|
|
|
|
|
|
|
2427
|
0
|
0
|
|
|
|
|
if ($#recur0==0) { |
2428
|
|
|
|
|
|
|
|
2429
|
|
|
|
|
|
|
# Y * M-W-D-H-MN-S |
2430
|
0
|
|
|
|
|
|
$n=$y; |
2431
|
0
|
0
|
|
|
|
|
$n=1 if ($n==0); |
2432
|
|
|
|
|
|
|
|
2433
|
0
|
0
|
|
|
|
|
if ($m eq "0") { |
|
|
0
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
|
2435
|
|
|
|
|
|
|
# Y * 0-W-D-H-MN-S => Y-0 * W-D-H-MN-S |
2436
|
0
|
|
|
|
|
|
push(@recur0,0); |
2437
|
0
|
|
|
|
|
|
shift(@recur1); |
2438
|
|
|
|
|
|
|
|
2439
|
|
|
|
|
|
|
} elsif ($w eq "0") { |
2440
|
|
|
|
|
|
|
|
2441
|
|
|
|
|
|
|
# Y * M-0-DOM-H-MN-S |
2442
|
0
|
0
|
0
|
|
|
|
return () if (! $dateb && $y != 1); |
2443
|
|
|
|
|
|
|
|
2444
|
0
|
|
|
|
|
|
@m=_ReturnList($m); |
2445
|
0
|
0
|
|
|
|
|
return () if (! @m); |
2446
|
0
|
|
|
|
|
|
foreach $m (@m) { |
2447
|
0
|
0
|
|
|
|
|
return () if (! _IsInt($m,1,12)); |
2448
|
|
|
|
|
|
|
} |
2449
|
|
|
|
|
|
|
|
2450
|
0
|
0
|
|
|
|
|
if ($d eq "0") { |
2451
|
0
|
|
|
|
|
|
@d = (1); |
2452
|
|
|
|
|
|
|
} else { |
2453
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2454
|
0
|
0
|
|
|
|
|
return () if (! @d); |
2455
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2456
|
0
|
0
|
0
|
|
|
|
return () if (! _IsInt($d,-31,31) || $d==0); |
2457
|
|
|
|
|
|
|
} |
2458
|
|
|
|
|
|
|
} |
2459
|
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
# We need to find years that are a multiple of $n from $y(base) |
2461
|
0
|
|
|
|
|
|
($y0)=( _Date_Split($date0, 1) )[0]; |
2462
|
0
|
|
|
|
|
|
($y1)=( _Date_Split($date1, 1) )[0]; |
2463
|
0
|
0
|
|
|
|
|
if ($dateb) { |
2464
|
0
|
|
|
|
|
|
($yb)=( _Date_Split($dateb, 1) )[0]; |
2465
|
|
|
|
|
|
|
} else { |
2466
|
|
|
|
|
|
|
# If $y=1, there is no base year |
2467
|
0
|
|
|
|
|
|
$yb=0; |
2468
|
|
|
|
|
|
|
} |
2469
|
|
|
|
|
|
|
|
2470
|
0
|
|
|
|
|
|
@date=(); |
2471
|
0
|
|
|
|
|
|
for ($yy=$y0; $yy<=$y1; $yy++) { |
2472
|
0
|
0
|
|
|
|
|
if (($yy-$yb)%$n == 0) { |
2473
|
0
|
|
|
|
|
|
foreach $m (@m) { |
2474
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2475
|
0
|
|
|
|
|
|
my $dim = Date_DaysInMonth($m,$yy); |
2476
|
0
|
|
|
|
|
|
my $tmpd = $d; |
2477
|
0
|
0
|
|
|
|
|
if ($tmpd < 0) { |
2478
|
0
|
|
|
|
|
|
$tmpd += ($dim+1); |
2479
|
|
|
|
|
|
|
} |
2480
|
0
|
0
|
|
|
|
|
next if (! _IsInt($tmpd,1,$dim)); |
2481
|
0
|
|
|
|
|
|
$date=_Date_Join($yy,$m,$tmpd,0,0,0); |
2482
|
0
|
|
|
|
|
|
push(@date,$date); |
2483
|
|
|
|
|
|
|
} |
2484
|
|
|
|
|
|
|
} |
2485
|
|
|
|
|
|
|
} |
2486
|
|
|
|
|
|
|
} |
2487
|
0
|
|
|
|
|
|
last RECUR; |
2488
|
|
|
|
|
|
|
|
2489
|
|
|
|
|
|
|
} else { |
2490
|
|
|
|
|
|
|
|
2491
|
|
|
|
|
|
|
# Y * M-WOM-DOW-H-MN-S |
2492
|
|
|
|
|
|
|
# Y * M-WOM-0-H-MN-S |
2493
|
0
|
0
|
0
|
|
|
|
return () if (! $dateb && $y != 1); |
2494
|
|
|
|
|
|
|
|
2495
|
0
|
|
|
|
|
|
@m=_ReturnList($m); |
2496
|
0
|
0
|
|
|
|
|
return () if (! @m); |
2497
|
0
|
|
|
|
|
|
@w=_ReturnList($w); |
2498
|
0
|
0
|
|
|
|
|
return () if (! @w); |
2499
|
|
|
|
|
|
|
|
2500
|
0
|
0
|
|
|
|
|
if ($d eq "0") { |
2501
|
0
|
|
|
|
|
|
@d=(1); |
2502
|
|
|
|
|
|
|
} else { |
2503
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2504
|
|
|
|
|
|
|
} |
2505
|
|
|
|
|
|
|
|
2506
|
0
|
|
|
|
|
|
($y0)=( _Date_Split($date0, 1) )[0]; |
2507
|
0
|
|
|
|
|
|
($y1)=( _Date_Split($date1, 1) )[0]; |
2508
|
0
|
0
|
|
|
|
|
if ($dateb) { |
2509
|
0
|
|
|
|
|
|
($yb)=( _Date_Split($dateb, 1) )[0]; |
2510
|
|
|
|
|
|
|
} else { |
2511
|
|
|
|
|
|
|
# If $y=1, there is no base year |
2512
|
0
|
|
|
|
|
|
$yb=0; |
2513
|
|
|
|
|
|
|
} |
2514
|
0
|
|
|
|
|
|
@y=(); |
2515
|
0
|
|
|
|
|
|
for ($yy=$y0; $yy<=$y1; $yy++) { |
2516
|
0
|
0
|
|
|
|
|
if (($yy-$yb)%$n == 0) { |
2517
|
0
|
|
|
|
|
|
push(@y,$yy); |
2518
|
|
|
|
|
|
|
} |
2519
|
|
|
|
|
|
|
} |
2520
|
|
|
|
|
|
|
|
2521
|
0
|
|
|
|
|
|
@date=_Date_Recur_WoM(\@y,\@m,\@w,\@d); |
2522
|
0
|
|
|
|
|
|
last RECUR; |
2523
|
|
|
|
|
|
|
} |
2524
|
|
|
|
|
|
|
} |
2525
|
|
|
|
|
|
|
|
2526
|
0
|
0
|
|
|
|
|
if ($#recur0==1) { |
2527
|
|
|
|
|
|
|
|
2528
|
|
|
|
|
|
|
# Y-M * W-D-H-MN-S |
2529
|
|
|
|
|
|
|
|
2530
|
0
|
0
|
|
|
|
|
if ($w eq "0") { |
|
|
0
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
# Y-M * 0-D-H-MN-S => Y-M-0 * D-H-MN-S |
2532
|
0
|
|
|
|
|
|
push(@recur0,0); |
2533
|
0
|
|
|
|
|
|
shift(@recur1); |
2534
|
|
|
|
|
|
|
|
2535
|
|
|
|
|
|
|
} elsif ($m==0) { |
2536
|
|
|
|
|
|
|
|
2537
|
|
|
|
|
|
|
# Y-0 * WOY-0-H-MN-S |
2538
|
|
|
|
|
|
|
# Y-0 * WOY-DOW-H-MN-S |
2539
|
0
|
0
|
0
|
|
|
|
return () if (! $dateb && $y != 1); |
2540
|
0
|
|
|
|
|
|
$n=$y; |
2541
|
0
|
0
|
|
|
|
|
$n=1 if ($n==0); |
2542
|
|
|
|
|
|
|
|
2543
|
0
|
|
|
|
|
|
@w=_ReturnList($w); |
2544
|
0
|
0
|
|
|
|
|
return () if (! @w); |
2545
|
0
|
|
|
|
|
|
foreach $w (@w) { |
2546
|
0
|
0
|
0
|
|
|
|
return () if ($w==0 || ! _IsInt($w,-53,53)); |
2547
|
|
|
|
|
|
|
} |
2548
|
|
|
|
|
|
|
|
2549
|
0
|
0
|
|
|
|
|
if ($d eq "0") { |
2550
|
0
|
|
|
|
|
|
@d=(1); |
2551
|
|
|
|
|
|
|
} else { |
2552
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2553
|
0
|
0
|
|
|
|
|
return () if (! @d); |
2554
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2555
|
0
|
0
|
|
|
|
|
$d += 8 if ($d<0); |
2556
|
0
|
0
|
|
|
|
|
return () if (! _IsInt($d,1,7)); |
2557
|
|
|
|
|
|
|
} |
2558
|
|
|
|
|
|
|
} |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
# We need to find years that are a multiple of $n from $y(base) |
2561
|
0
|
|
|
|
|
|
($y0)=( _Date_Split($date0, 1) )[0]; |
2562
|
0
|
|
|
|
|
|
($y1)=( _Date_Split($date1, 1) )[0]; |
2563
|
0
|
0
|
|
|
|
|
if ($dateb) { |
2564
|
0
|
|
|
|
|
|
($yb)=( _Date_Split($dateb, 1) )[0]; |
2565
|
|
|
|
|
|
|
} else { |
2566
|
|
|
|
|
|
|
# If $y=1, there is no base year |
2567
|
0
|
|
|
|
|
|
$yb=0; |
2568
|
|
|
|
|
|
|
} |
2569
|
|
|
|
|
|
|
|
2570
|
0
|
|
|
|
|
|
@date=(); |
2571
|
0
|
|
|
|
|
|
for ($yy=$y0; $yy<=$y1; $yy++) { |
2572
|
0
|
0
|
|
|
|
|
if (($yy-$yb)%$n == 0) { |
2573
|
0
|
|
|
|
|
|
foreach $w (@w) { |
2574
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2575
|
0
|
|
|
|
|
|
my($tmpw,$del); |
2576
|
0
|
0
|
|
|
|
|
if ($w<0) { |
2577
|
0
|
|
|
|
|
|
$date="$yy-12-31-00:00:00"; |
2578
|
0
|
|
|
|
|
|
$tmpw = (-$w)-1; |
2579
|
0
|
|
|
|
|
|
$del="-0:0:$tmpw:0:0:0:0"; |
2580
|
0
|
|
|
|
|
|
$date=Date_GetPrev($date,$d,1); |
2581
|
|
|
|
|
|
|
} else { |
2582
|
0
|
|
|
|
|
|
$date="$yy-01-01-00:00:00"; |
2583
|
0
|
|
|
|
|
|
$tmpw = ($w)-1; |
2584
|
0
|
|
|
|
|
|
$del="0:0:$tmpw:0:0:0:0"; |
2585
|
0
|
|
|
|
|
|
$date=Date_GetNext($date,$d,1); |
2586
|
|
|
|
|
|
|
} |
2587
|
0
|
|
|
|
|
|
$date=DateCalc($date,$del); |
2588
|
0
|
0
|
|
|
|
|
next if ((_Date_Split($date))[0] != $yy); |
2589
|
0
|
|
|
|
|
|
push(@date,$date); |
2590
|
|
|
|
|
|
|
} |
2591
|
|
|
|
|
|
|
} |
2592
|
|
|
|
|
|
|
} |
2593
|
|
|
|
|
|
|
} |
2594
|
0
|
|
|
|
|
|
last RECUR; |
2595
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
} else { |
2597
|
|
|
|
|
|
|
|
2598
|
|
|
|
|
|
|
# Y-M * WOM-0-H-MN-S |
2599
|
|
|
|
|
|
|
# Y-M * WOM-DOW-H-MN-S |
2600
|
0
|
0
|
0
|
|
|
|
return () if (! $dateb && ($y != 0 || $m != 1)); |
|
|
|
0
|
|
|
|
|
2601
|
0
|
|
|
|
|
|
@tmp=(@recur0); |
2602
|
0
|
|
|
|
|
|
push(@tmp,0) while ($#tmp<6); |
2603
|
0
|
|
|
|
|
|
$delta=join(":",@tmp); |
2604
|
0
|
0
|
|
|
|
|
$dateb=$date0 if (! $dateb); |
2605
|
0
|
|
|
|
|
|
@tmp=_Date_Recur($date0,$date1,$dateb,$delta); |
2606
|
|
|
|
|
|
|
|
2607
|
0
|
|
|
|
|
|
@w=_ReturnList($w); |
2608
|
0
|
|
|
|
|
|
@m=(); |
2609
|
0
|
0
|
|
|
|
|
if ($d eq "0") { |
2610
|
0
|
|
|
|
|
|
@d=(1); |
2611
|
|
|
|
|
|
|
} else { |
2612
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2613
|
|
|
|
|
|
|
} |
2614
|
|
|
|
|
|
|
|
2615
|
0
|
|
|
|
|
|
@date=_Date_Recur_WoM(\@tmp,\@m,\@w,\@d); |
2616
|
0
|
|
|
|
|
|
last RECUR; |
2617
|
|
|
|
|
|
|
} |
2618
|
|
|
|
|
|
|
} |
2619
|
|
|
|
|
|
|
|
2620
|
0
|
0
|
|
|
|
|
if ($#recur0==2) { |
2621
|
|
|
|
|
|
|
# Y-M-W * D-H-MN-S |
2622
|
|
|
|
|
|
|
|
2623
|
0
|
0
|
0
|
|
|
|
if ($d eq "0") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2624
|
|
|
|
|
|
|
|
2625
|
|
|
|
|
|
|
# Y-M-W * 0-H-MN-S |
2626
|
0
|
0
|
|
|
|
|
return () if (! $dateb); |
2627
|
0
|
0
|
0
|
|
|
|
$y=1 if ($y==0 && $m==0 && $w==0); |
|
|
|
0
|
|
|
|
|
2628
|
0
|
|
|
|
|
|
$delta="$y:$m:$w:0:0:0:0"; |
2629
|
0
|
|
|
|
|
|
@date=_Date_Recur($date0,$date1,$dateb,$delta); |
2630
|
0
|
|
|
|
|
|
last RECUR; |
2631
|
|
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
} elsif ($m==0 && $w==0) { |
2633
|
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
|
# Y-0-0 * DOY-H-MN-S |
2635
|
0
|
0
|
|
|
|
|
$y=1 if ($y==0); |
2636
|
0
|
|
|
|
|
|
$n=$y; |
2637
|
0
|
0
|
0
|
|
|
|
return () if (! $dateb && $y!=1); |
2638
|
|
|
|
|
|
|
|
2639
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2640
|
0
|
0
|
|
|
|
|
return () if (! @d); |
2641
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2642
|
0
|
0
|
0
|
|
|
|
return () if (! _IsInt($d,-366,366) || $d==0); |
2643
|
|
|
|
|
|
|
} |
2644
|
|
|
|
|
|
|
|
2645
|
|
|
|
|
|
|
# We need to find years that are a multiple of $n from $y(base) |
2646
|
0
|
|
|
|
|
|
($y0)=( _Date_Split($date0, 1) )[0]; |
2647
|
0
|
|
|
|
|
|
($y1)=( _Date_Split($date1, 1) )[0]; |
2648
|
0
|
0
|
|
|
|
|
if ($dateb) { |
2649
|
0
|
|
|
|
|
|
($yb)=( _Date_Split($dateb, 1) )[0]; |
2650
|
|
|
|
|
|
|
} else { |
2651
|
|
|
|
|
|
|
# If $y=1, there is no base year |
2652
|
0
|
|
|
|
|
|
$yb=0; |
2653
|
|
|
|
|
|
|
} |
2654
|
0
|
|
|
|
|
|
@date=(); |
2655
|
0
|
|
|
|
|
|
for ($yy=$y0; $yy<=$y1; $yy++) { |
2656
|
0
|
|
|
|
|
|
my $diy = Date_DaysInYear($yy); |
2657
|
0
|
0
|
|
|
|
|
if (($yy-$yb)%$n == 0) { |
2658
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2659
|
0
|
|
|
|
|
|
my $tmpd = $d; |
2660
|
0
|
0
|
|
|
|
|
$tmpd += ($diy+1) if ($tmpd<0); |
2661
|
0
|
0
|
|
|
|
|
next if (! _IsInt($tmpd,1,$diy)); |
2662
|
0
|
|
|
|
|
|
($y,$m,$dd)=Date_NthDayOfYear($yy,$tmpd); |
2663
|
0
|
|
|
|
|
|
push(@date, _Date_Join($y,$m,$dd,0,0,0)); |
2664
|
|
|
|
|
|
|
} |
2665
|
|
|
|
|
|
|
} |
2666
|
|
|
|
|
|
|
} |
2667
|
0
|
|
|
|
|
|
last RECUR; |
2668
|
|
|
|
|
|
|
|
2669
|
|
|
|
|
|
|
} elsif ($w>0) { |
2670
|
|
|
|
|
|
|
|
2671
|
|
|
|
|
|
|
# Y-M-W * DOW-H-MN-S |
2672
|
0
|
0
|
0
|
|
|
|
return () if (! $dateb && ($y != 0 && $m != 0 && $w != 1)); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2673
|
0
|
|
|
|
|
|
@tmp=(@recur0); |
2674
|
0
|
|
|
|
|
|
push(@tmp,0) while ($#tmp<6); |
2675
|
0
|
|
|
|
|
|
$delta=join(":",@tmp); |
2676
|
|
|
|
|
|
|
|
2677
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2678
|
0
|
0
|
|
|
|
|
return () if (! @d); |
2679
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2680
|
0
|
0
|
|
|
|
|
$d += 8 if ($d<0); |
2681
|
0
|
0
|
|
|
|
|
return () if (! _IsInt($d,1,7)); |
2682
|
|
|
|
|
|
|
} |
2683
|
|
|
|
|
|
|
|
2684
|
|
|
|
|
|
|
# Find out what DofW the basedate is. |
2685
|
0
|
0
|
|
|
|
|
$dateb = $date0 if (! $dateb); |
2686
|
0
|
|
|
|
|
|
@tmp2=_Date_Split($dateb, 1); |
2687
|
0
|
|
|
|
|
|
$tmp=Date_DayOfWeek($tmp2[1],$tmp2[2],$tmp2[0]); |
2688
|
|
|
|
|
|
|
|
2689
|
0
|
|
|
|
|
|
@date=(); |
2690
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2691
|
0
|
|
|
|
|
|
$date_b=$dateb; |
2692
|
|
|
|
|
|
|
# Move basedate to DOW in the same week |
2693
|
0
|
0
|
|
|
|
|
if ($d != $tmp) { |
2694
|
0
|
0
|
0
|
|
|
|
if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) || |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2695
|
|
|
|
|
|
|
($tmp>=$Cnf{"FirstDay"} && $d>$tmp) || |
2696
|
|
|
|
|
|
|
($tmp<$d && $d<$Cnf{"FirstDay"})) { |
2697
|
0
|
|
|
|
|
|
$date_b=Date_GetNext($date_b,$d); |
2698
|
|
|
|
|
|
|
} else { |
2699
|
0
|
|
|
|
|
|
$date_b=Date_GetPrev($date_b,$d); |
2700
|
|
|
|
|
|
|
} |
2701
|
|
|
|
|
|
|
} |
2702
|
0
|
|
|
|
|
|
push(@date,_Date_Recur($date0,$date1,$date_b,$delta)); |
2703
|
|
|
|
|
|
|
} |
2704
|
0
|
|
|
|
|
|
last RECUR; |
2705
|
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
|
} elsif ($m>0) { |
2707
|
|
|
|
|
|
|
|
2708
|
|
|
|
|
|
|
# Y-M-0 * DOM-H-MN-S |
2709
|
0
|
0
|
0
|
|
|
|
return () if (! $dateb && ($y != 0 && $m != 1)); |
|
|
|
0
|
|
|
|
|
2710
|
0
|
|
|
|
|
|
@tmp=(@recur0); |
2711
|
0
|
|
|
|
|
|
push(@tmp,0) while ($#tmp<6); |
2712
|
0
|
|
|
|
|
|
$delta=join(":",@tmp); |
2713
|
|
|
|
|
|
|
|
2714
|
0
|
|
|
|
|
|
@d=_ReturnList($d); |
2715
|
0
|
0
|
|
|
|
|
return () if (! @d); |
2716
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2717
|
0
|
0
|
0
|
|
|
|
return () if ($d==0 || ! _IsInt($d,-31,31)); |
2718
|
|
|
|
|
|
|
} |
2719
|
0
|
0
|
|
|
|
|
$dateb = $date0 if (! $dateb); |
2720
|
|
|
|
|
|
|
|
2721
|
0
|
|
|
|
|
|
@tmp2=_Date_Recur($date0,$date1,$dateb,$delta); |
2722
|
0
|
|
|
|
|
|
@date=(); |
2723
|
0
|
|
|
|
|
|
foreach $date (@tmp2) { |
2724
|
0
|
|
|
|
|
|
($y,$m)=( _Date_Split($date, 1) )[0..1]; |
2725
|
0
|
|
|
|
|
|
my $dim=Date_DaysInMonth($m,$y); |
2726
|
0
|
|
|
|
|
|
foreach $d (@d) { |
2727
|
0
|
|
|
|
|
|
my $tmpd = $d; |
2728
|
0
|
0
|
|
|
|
|
$tmpd += ($dim+1) if ($tmpd<0); |
2729
|
0
|
0
|
|
|
|
|
next if (! _IsInt($tmpd,1,$dim)); |
2730
|
0
|
|
|
|
|
|
push(@date,_Date_Join($y,$m,$tmpd,0,0,0)); |
2731
|
|
|
|
|
|
|
} |
2732
|
|
|
|
|
|
|
} |
2733
|
0
|
|
|
|
|
|
last RECUR; |
2734
|
|
|
|
|
|
|
|
2735
|
|
|
|
|
|
|
} else { |
2736
|
0
|
|
|
|
|
|
return (); |
2737
|
|
|
|
|
|
|
} |
2738
|
|
|
|
|
|
|
} |
2739
|
|
|
|
|
|
|
|
2740
|
0
|
0
|
|
|
|
|
if ($#recur0>2) { |
2741
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
# Y-M-W-D * H-MN-S |
2743
|
|
|
|
|
|
|
# Y-M-W-D-H * MN-S |
2744
|
|
|
|
|
|
|
# Y-M-W-D-H-MN * S |
2745
|
|
|
|
|
|
|
# Y-M-W-D-H-S |
2746
|
0
|
0
|
0
|
|
|
|
if (($#recur0 == 3 && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2747
|
|
|
|
|
|
|
($y == 0 && $m == 0 && $w == 0 && $d == 1)) || |
2748
|
|
|
|
|
|
|
($#recur0 == 4 && |
2749
|
|
|
|
|
|
|
($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 1)) || |
2750
|
|
|
|
|
|
|
($#recur0 == 5 && |
2751
|
|
|
|
|
|
|
($y == 0 && $m == 0 && $w == 0 && $d == 0 && $h == 0 && |
2752
|
|
|
|
|
|
|
$mn == 1))) { |
2753
|
0
|
|
|
|
|
|
$dateb = $date0; |
2754
|
|
|
|
|
|
|
} |
2755
|
0
|
0
|
|
|
|
|
return () if (! $dateb); |
2756
|
0
|
|
|
|
|
|
@tmp=(@recur0); |
2757
|
0
|
|
|
|
|
|
push(@tmp,0) while ($#tmp<6); |
2758
|
0
|
|
|
|
|
|
$delta=join(":",@tmp); |
2759
|
0
|
0
|
|
|
|
|
return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0" |
2760
|
0
|
|
|
|
|
|
@date=_Date_Recur($date0,$date1,$dateb,$delta); |
2761
|
0
|
0
|
|
|
|
|
if (@recur1) { |
2762
|
0
|
|
|
|
|
|
unshift(@recur1,-1) while ($#recur1<2); |
2763
|
0
|
|
|
|
|
|
@time=@recur1; |
2764
|
|
|
|
|
|
|
} else { |
2765
|
0
|
|
|
|
|
|
shift(@date); |
2766
|
0
|
|
|
|
|
|
pop(@date); |
2767
|
0
|
|
|
|
|
|
@time=(); |
2768
|
|
|
|
|
|
|
} |
2769
|
|
|
|
|
|
|
} |
2770
|
|
|
|
|
|
|
|
2771
|
0
|
|
|
|
|
|
last RECUR; |
2772
|
|
|
|
|
|
|
} |
2773
|
0
|
0
|
|
|
|
|
@date=_Date_RecurSetTime($date0,$date1,\@date,@time) if (@time); |
2774
|
|
|
|
|
|
|
|
2775
|
|
|
|
|
|
|
# |
2776
|
|
|
|
|
|
|
# We've got a list of dates. Operate on them with the flags. |
2777
|
|
|
|
|
|
|
# |
2778
|
|
|
|
|
|
|
|
2779
|
0
|
|
|
|
|
|
my($sign,$forw,$today,$df,$db,$work,$i); |
2780
|
0
|
0
|
|
|
|
|
if (@flags) { |
2781
|
0
|
|
|
|
|
|
FLAG: foreach $f (@flags) { |
2782
|
0
|
|
|
|
|
|
$f = uc($f); |
2783
|
|
|
|
|
|
|
|
2784
|
0
|
0
|
|
|
|
|
if ($f =~ /^(P|N)(D|T)([1-7])$/) { |
2785
|
0
|
|
|
|
|
|
@tmp=($1,$2,$3); |
2786
|
0
|
0
|
|
|
|
|
$forw =($tmp[0] eq "P" ? 0 : 1); |
2787
|
0
|
0
|
|
|
|
|
$today=($tmp[1] eq "D" ? 0 : 1); |
2788
|
0
|
|
|
|
|
|
$d=$tmp[2]; |
2789
|
0
|
|
|
|
|
|
@tmp=(); |
2790
|
0
|
|
|
|
|
|
foreach $date (@date) { |
2791
|
0
|
0
|
|
|
|
|
if ($forw) { |
2792
|
0
|
|
|
|
|
|
push(@tmp, Date_GetNext($date,$d,$today)); |
2793
|
|
|
|
|
|
|
} else { |
2794
|
0
|
|
|
|
|
|
push(@tmp, Date_GetPrev($date,$d,$today)); |
2795
|
|
|
|
|
|
|
} |
2796
|
|
|
|
|
|
|
} |
2797
|
0
|
|
|
|
|
|
@date=@tmp; |
2798
|
0
|
|
|
|
|
|
next FLAG; |
2799
|
|
|
|
|
|
|
} |
2800
|
|
|
|
|
|
|
|
2801
|
|
|
|
|
|
|
# We want to go forward exact amounts of time instead of |
2802
|
|
|
|
|
|
|
# business mode calculations so that we don't change the time |
2803
|
|
|
|
|
|
|
# (which may have been set in the recur). |
2804
|
0
|
0
|
|
|
|
|
if ($f =~ /^(F|B)(D|W)(\d+)$/) { |
2805
|
0
|
|
|
|
|
|
@tmp=($1,$2,$3); |
2806
|
0
|
|
|
|
|
|
$sign="+"; |
2807
|
0
|
0
|
|
|
|
|
$sign="-" if ($tmp[0] eq "B"); |
2808
|
0
|
|
|
|
|
|
$work=0; |
2809
|
0
|
0
|
|
|
|
|
$work=1 if ($tmp[1] eq "W"); |
2810
|
0
|
|
|
|
|
|
$n=$tmp[2]; |
2811
|
0
|
|
|
|
|
|
@tmp=(); |
2812
|
0
|
|
|
|
|
|
foreach $date (@date) { |
2813
|
0
|
|
|
|
|
|
for ($i=1; $i<=$n; $i++) { |
2814
|
0
|
|
|
|
|
|
while (1) { |
2815
|
0
|
|
|
|
|
|
$date=DateCalc($date,"${sign}0:0:0:1:0:0:0"); |
2816
|
0
|
0
|
0
|
|
|
|
last if (! $work || Date_IsWorkDay($date,0)); |
2817
|
|
|
|
|
|
|
} |
2818
|
|
|
|
|
|
|
} |
2819
|
0
|
|
|
|
|
|
push(@tmp,$date); |
2820
|
|
|
|
|
|
|
} |
2821
|
0
|
|
|
|
|
|
@date=@tmp; |
2822
|
0
|
|
|
|
|
|
next FLAG; |
2823
|
|
|
|
|
|
|
} |
2824
|
|
|
|
|
|
|
|
2825
|
0
|
0
|
0
|
|
|
|
if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) { |
2826
|
0
|
|
|
|
|
|
$tmp=$1; |
2827
|
0
|
0
|
|
|
|
|
my $noalt = $2 ? 1 : 0; |
2828
|
0
|
0
|
0
|
|
|
|
if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) { |
|
|
|
0
|
|
|
|
|
2829
|
0
|
|
|
|
|
|
$forw=1; |
2830
|
|
|
|
|
|
|
} else { |
2831
|
0
|
|
|
|
|
|
$forw=0; |
2832
|
|
|
|
|
|
|
} |
2833
|
|
|
|
|
|
|
|
2834
|
0
|
|
|
|
|
|
@tmp=(); |
2835
|
0
|
|
|
|
|
|
DATE: foreach $date (@date) { |
2836
|
0
|
|
|
|
|
|
$df=$db=$date; |
2837
|
0
|
0
|
|
|
|
|
if (Date_IsWorkDay($date)) { |
2838
|
0
|
|
|
|
|
|
push(@tmp,$date); |
2839
|
0
|
|
|
|
|
|
next DATE; |
2840
|
|
|
|
|
|
|
} |
2841
|
0
|
|
|
|
|
|
while (1) { |
2842
|
0
|
0
|
|
|
|
|
if ($forw) { |
2843
|
0
|
|
|
|
|
|
$d=$df=DateCalc($df,"+0:0:0:1:0:0:0"); |
2844
|
|
|
|
|
|
|
} else { |
2845
|
0
|
|
|
|
|
|
$d=$db=DateCalc($db,"-0:0:0:1:0:0:0"); |
2846
|
|
|
|
|
|
|
} |
2847
|
0
|
0
|
|
|
|
|
if (Date_IsWorkDay($d)) { |
2848
|
0
|
|
|
|
|
|
push(@tmp,$d); |
2849
|
0
|
|
|
|
|
|
next DATE; |
2850
|
|
|
|
|
|
|
} |
2851
|
0
|
0
|
|
|
|
|
$forw=1-$forw if (! $noalt); |
2852
|
|
|
|
|
|
|
} |
2853
|
|
|
|
|
|
|
} |
2854
|
0
|
|
|
|
|
|
@date=@tmp; |
2855
|
0
|
|
|
|
|
|
next FLAG; |
2856
|
|
|
|
|
|
|
} |
2857
|
|
|
|
|
|
|
|
2858
|
0
|
0
|
|
|
|
|
if ($f eq "EASTER") { |
2859
|
0
|
|
|
|
|
|
@tmp=(); |
2860
|
0
|
|
|
|
|
|
foreach $date (@date) { |
2861
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1); |
2862
|
0
|
|
|
|
|
|
($m,$d)=_Date_Easter($y); |
2863
|
0
|
|
|
|
|
|
$date=_Date_Join($y,$m,$d,$h,$mn,$s); |
2864
|
0
|
0
|
0
|
|
|
|
next if (Date_Cmp($date,$date0)<0 || |
2865
|
|
|
|
|
|
|
Date_Cmp($date,$date1)>0); |
2866
|
0
|
|
|
|
|
|
push(@tmp,$date); |
2867
|
|
|
|
|
|
|
} |
2868
|
0
|
|
|
|
|
|
@date=@tmp; |
2869
|
|
|
|
|
|
|
} |
2870
|
|
|
|
|
|
|
} |
2871
|
|
|
|
|
|
|
} |
2872
|
|
|
|
|
|
|
|
2873
|
0
|
|
|
|
|
|
@date = sort { Date_Cmp($a,$b) } @date; |
|
0
|
|
|
|
|
|
|
2874
|
0
|
|
|
|
|
|
return @date; |
2875
|
|
|
|
|
|
|
} |
2876
|
|
|
|
|
|
|
|
2877
|
|
|
|
|
|
|
sub Date_GetPrev { |
2878
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/); |
2879
|
0
|
|
|
|
|
|
my($date,$dow,$today,$hr,$min,$sec)=@_; |
2880
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
2881
|
0
|
|
|
|
|
|
my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts, |
2882
|
|
|
|
|
|
|
$adjust,$curr)=(); |
2883
|
0
|
0
|
0
|
|
|
|
$hr="00" if (defined $hr && $hr eq "0"); |
2884
|
0
|
0
|
0
|
|
|
|
$min="00" if (defined $min && $min eq "0"); |
2885
|
0
|
0
|
0
|
|
|
|
$sec="00" if (defined $sec && $sec eq "0"); |
2886
|
|
|
|
|
|
|
|
2887
|
0
|
0
|
|
|
|
|
if (! _Date_Split($date)) { |
2888
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
2889
|
0
|
0
|
|
|
|
|
return "" if (! $date); |
2890
|
|
|
|
|
|
|
} |
2891
|
0
|
|
|
|
|
|
$curr=$date; |
2892
|
0
|
|
|
|
|
|
($y,$m,$d)=( _Date_Split($date, 1) )[0..2]; |
2893
|
|
|
|
|
|
|
|
2894
|
0
|
0
|
|
|
|
|
if ($dow) { |
2895
|
0
|
|
|
|
|
|
$curr_dow=Date_DayOfWeek($m,$d,$y); |
2896
|
0
|
|
|
|
|
|
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; |
|
0
|
|
|
|
|
|
|
2897
|
0
|
0
|
|
|
|
|
if (_IsInt($dow)) { |
2898
|
0
|
0
|
0
|
|
|
|
return "" if ($dow<1 || $dow>7); |
2899
|
|
|
|
|
|
|
} else { |
2900
|
0
|
0
|
|
|
|
|
return "" if (! exists $dow{lc($dow)}); |
2901
|
0
|
|
|
|
|
|
$dow=$dow{lc($dow)}; |
2902
|
|
|
|
|
|
|
} |
2903
|
0
|
0
|
|
|
|
|
if ($dow == $curr_dow) { |
2904
|
0
|
0
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today); |
2905
|
0
|
0
|
|
|
|
|
$adjust=1 if ($today==2); |
2906
|
|
|
|
|
|
|
} else { |
2907
|
0
|
0
|
|
|
|
|
$dow -= 7 if ($dow>$curr_dow); # make sure previous day is less |
2908
|
0
|
|
|
|
|
|
$num = $curr_dow - $dow; |
2909
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"-0:0:0:$num:0:0:0",\$err,0); |
2910
|
|
|
|
|
|
|
} |
2911
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr); |
2912
|
0
|
0
|
0
|
|
|
|
$date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) |
2913
|
|
|
|
|
|
|
if ($adjust && Date_Cmp($date,$curr)>0); |
2914
|
|
|
|
|
|
|
|
2915
|
|
|
|
|
|
|
} else { |
2916
|
0
|
|
|
|
|
|
($h,$mn,$s)=( _Date_Split($date, 1) )[3..5]; |
2917
|
0
|
|
|
|
|
|
($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec); |
2918
|
0
|
0
|
|
|
|
|
if ($hr) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2919
|
0
|
|
|
|
|
|
($hr,$min,$sec)=($th,$tm,$ts); |
2920
|
0
|
|
|
|
|
|
$delta="-0:0:0:1:0:0:0"; |
2921
|
|
|
|
|
|
|
} elsif ($min) { |
2922
|
0
|
|
|
|
|
|
($hr,$min,$sec)=($h,$tm,$ts); |
2923
|
0
|
|
|
|
|
|
$delta="-0:0:0:0:1:0:0"; |
2924
|
|
|
|
|
|
|
} elsif ($sec) { |
2925
|
0
|
|
|
|
|
|
($hr,$min,$sec)=($h,$mn,$ts); |
2926
|
0
|
|
|
|
|
|
$delta="-0:0:0:0:0:1:0"; |
2927
|
|
|
|
|
|
|
} else { |
2928
|
0
|
|
|
|
|
|
confess "ERROR: invalid arguments in Date_GetPrev.\n"; |
2929
|
|
|
|
|
|
|
} |
2930
|
|
|
|
|
|
|
|
2931
|
0
|
|
|
|
|
|
$d=Date_SetTime($date,$hr,$min,$sec); |
2932
|
0
|
0
|
|
|
|
|
if ($today) { |
2933
|
0
|
0
|
|
|
|
|
$d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>0); |
2934
|
|
|
|
|
|
|
} else { |
2935
|
0
|
0
|
|
|
|
|
$d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)>=0); |
2936
|
|
|
|
|
|
|
} |
2937
|
0
|
|
|
|
|
|
$date=$d; |
2938
|
|
|
|
|
|
|
} |
2939
|
0
|
|
|
|
|
|
return $date; |
2940
|
|
|
|
|
|
|
} |
2941
|
|
|
|
|
|
|
|
2942
|
|
|
|
|
|
|
sub Date_GetNext { |
2943
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/); |
2944
|
0
|
|
|
|
|
|
my($date,$dow,$today,$hr,$min,$sec)=@_; |
2945
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
2946
|
0
|
|
|
|
|
|
my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts, |
2947
|
|
|
|
|
|
|
$adjust,$curr)=(); |
2948
|
0
|
0
|
0
|
|
|
|
$hr="00" if (defined $hr && $hr eq "0"); |
2949
|
0
|
0
|
0
|
|
|
|
$min="00" if (defined $min && $min eq "0"); |
2950
|
0
|
0
|
0
|
|
|
|
$sec="00" if (defined $sec && $sec eq "0"); |
2951
|
|
|
|
|
|
|
|
2952
|
0
|
0
|
|
|
|
|
if (! _Date_Split($date)) { |
2953
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
2954
|
0
|
0
|
|
|
|
|
return "" if (! $date); |
2955
|
|
|
|
|
|
|
} |
2956
|
0
|
|
|
|
|
|
$curr=$date; |
2957
|
0
|
|
|
|
|
|
($y,$m,$d)=( _Date_Split($date, 1) )[0..2]; |
2958
|
|
|
|
|
|
|
|
2959
|
0
|
0
|
|
|
|
|
if ($dow) { |
2960
|
0
|
|
|
|
|
|
$curr_dow=Date_DayOfWeek($m,$d,$y); |
2961
|
0
|
|
|
|
|
|
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; |
|
0
|
|
|
|
|
|
|
2962
|
0
|
0
|
|
|
|
|
if (_IsInt($dow)) { |
2963
|
0
|
0
|
0
|
|
|
|
return "" if ($dow<1 || $dow>7); |
2964
|
|
|
|
|
|
|
} else { |
2965
|
0
|
0
|
|
|
|
|
return "" if (! exists $dow{lc($dow)}); |
2966
|
0
|
|
|
|
|
|
$dow=$dow{lc($dow)}; |
2967
|
|
|
|
|
|
|
} |
2968
|
0
|
0
|
|
|
|
|
if ($dow == $curr_dow) { |
2969
|
0
|
0
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today); |
2970
|
0
|
0
|
|
|
|
|
$adjust=1 if ($today==2); |
2971
|
|
|
|
|
|
|
} else { |
2972
|
0
|
0
|
|
|
|
|
$curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater |
2973
|
0
|
|
|
|
|
|
$num = $dow - $curr_dow; |
2974
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:0:0:$num:0:0:0",\$err,0); |
2975
|
|
|
|
|
|
|
} |
2976
|
0
|
0
|
|
|
|
|
$date=Date_SetTime($date,$hr,$min,$sec) if (defined $hr); |
2977
|
0
|
0
|
0
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) |
2978
|
|
|
|
|
|
|
if ($adjust && Date_Cmp($date,$curr)<0); |
2979
|
|
|
|
|
|
|
|
2980
|
|
|
|
|
|
|
} else { |
2981
|
0
|
|
|
|
|
|
($h,$mn,$s)=( _Date_Split($date, 1) )[3..5]; |
2982
|
0
|
|
|
|
|
|
($th,$tm,$ts)=_Date_ParseTime($hr,$min,$sec); |
2983
|
0
|
0
|
|
|
|
|
if ($hr) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2984
|
0
|
|
|
|
|
|
($hr,$min,$sec)=($th,$tm,$ts); |
2985
|
0
|
|
|
|
|
|
$delta="+0:0:0:1:0:0:0"; |
2986
|
|
|
|
|
|
|
} elsif ($min) { |
2987
|
0
|
|
|
|
|
|
($hr,$min,$sec)=($h,$tm,$ts); |
2988
|
0
|
|
|
|
|
|
$delta="+0:0:0:0:1:0:0"; |
2989
|
|
|
|
|
|
|
} elsif ($sec) { |
2990
|
0
|
|
|
|
|
|
($hr,$min,$sec)=($h,$mn,$ts); |
2991
|
0
|
|
|
|
|
|
$delta="+0:0:0:0:0:1:0"; |
2992
|
|
|
|
|
|
|
} else { |
2993
|
0
|
|
|
|
|
|
confess "ERROR: invalid arguments in Date_GetNext.\n"; |
2994
|
|
|
|
|
|
|
} |
2995
|
|
|
|
|
|
|
|
2996
|
0
|
|
|
|
|
|
$d=Date_SetTime($date,$hr,$min,$sec); |
2997
|
0
|
0
|
|
|
|
|
if ($today) { |
2998
|
0
|
0
|
|
|
|
|
$d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<0); |
2999
|
|
|
|
|
|
|
} else { |
3000
|
0
|
0
|
|
|
|
|
$d=_DateCalc_DateDelta($d,$delta,\$err,0) if (Date_Cmp($d,$date)<1); |
3001
|
|
|
|
|
|
|
} |
3002
|
0
|
|
|
|
|
|
$date=$d; |
3003
|
|
|
|
|
|
|
} |
3004
|
|
|
|
|
|
|
|
3005
|
0
|
|
|
|
|
|
return $date; |
3006
|
|
|
|
|
|
|
} |
3007
|
|
|
|
|
|
|
|
3008
|
|
|
|
|
|
|
sub Date_IsHoliday { |
3009
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/); |
3010
|
0
|
|
|
|
|
|
my($date)=@_; |
3011
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3012
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
3013
|
0
|
0
|
|
|
|
|
return undef if (! $date); |
3014
|
0
|
|
|
|
|
|
$date=Date_SetTime($date,0,0,0); |
3015
|
0
|
|
|
|
|
|
my($y)=(_Date_Split($date, 1))[0]; |
3016
|
|
|
|
|
|
|
|
3017
|
0
|
0
|
|
|
|
|
_Date_UpdateHolidays($y) if (! exists $Holiday{"dates"}{$y}); |
3018
|
|
|
|
|
|
|
|
3019
|
0
|
0
|
|
|
|
|
return undef if (! exists $Holiday{"dates"}{$y}{$date}); |
3020
|
0
|
|
|
|
|
|
my($name)=$Holiday{"dates"}{$y}{$date}; |
3021
|
0
|
0
|
|
|
|
|
return "" if (! $name); |
3022
|
0
|
|
|
|
|
|
$name; |
3023
|
|
|
|
|
|
|
} |
3024
|
|
|
|
|
|
|
|
3025
|
|
|
|
|
|
|
sub Events_List { |
3026
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/); |
3027
|
0
|
|
|
|
|
|
my(@args)=@_; |
3028
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3029
|
0
|
|
|
|
|
|
_Events_ParseRaw(); |
3030
|
|
|
|
|
|
|
|
3031
|
0
|
|
|
|
|
|
my($tmp,$date0,$date1,$flag); |
3032
|
0
|
|
|
|
|
|
$date0=ParseDateString($args[0]); |
3033
|
0
|
0
|
|
|
|
|
warn "Invalid date $args[0]", return undef if (! $date0); |
3034
|
|
|
|
|
|
|
|
3035
|
0
|
0
|
|
|
|
|
if ($#args == 0) { |
3036
|
0
|
|
|
|
|
|
return _Events_Calc($date0); |
3037
|
|
|
|
|
|
|
} |
3038
|
|
|
|
|
|
|
|
3039
|
0
|
0
|
|
|
|
|
if ($args[1]) { |
3040
|
0
|
|
|
|
|
|
$date1=ParseDateString($args[1]); |
3041
|
0
|
0
|
|
|
|
|
warn "Invalid date $args[1]\n", return undef if (! $date1); |
3042
|
0
|
0
|
|
|
|
|
if (Date_Cmp($date0,$date1)>0) { |
3043
|
0
|
|
|
|
|
|
$tmp=$date1; |
3044
|
0
|
|
|
|
|
|
$date1=$date0; |
3045
|
0
|
|
|
|
|
|
$date0=$tmp; |
3046
|
|
|
|
|
|
|
} |
3047
|
|
|
|
|
|
|
} else { |
3048
|
0
|
|
|
|
|
|
$date0=Date_SetTime($date0,"00:00:00"); |
3049
|
0
|
|
|
|
|
|
$date1=_DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0"); |
3050
|
|
|
|
|
|
|
} |
3051
|
|
|
|
|
|
|
|
3052
|
0
|
|
|
|
|
|
$tmp=_Events_Calc($date0,$date1); |
3053
|
|
|
|
|
|
|
|
3054
|
0
|
|
|
|
|
|
$flag=$args[2]; |
3055
|
0
|
0
|
|
|
|
|
return $tmp if (! $flag); |
3056
|
|
|
|
|
|
|
|
3057
|
0
|
|
|
|
|
|
my(@tmp,%ret,$delta)=(); |
3058
|
0
|
|
|
|
|
|
@tmp=@$tmp; |
3059
|
0
|
|
|
|
|
|
push(@tmp,$date1); |
3060
|
|
|
|
|
|
|
|
3061
|
0
|
0
|
|
|
|
|
if ($flag==1) { |
|
|
0
|
|
|
|
|
|
3062
|
0
|
|
|
|
|
|
while ($#tmp>0) { |
3063
|
0
|
|
|
|
|
|
($date0,$tmp)=splice(@tmp,0,2); |
3064
|
0
|
|
|
|
|
|
$date1=$tmp[0]; |
3065
|
0
|
|
|
|
|
|
$delta=_DateCalc_DateDate($date0,$date1); |
3066
|
0
|
|
|
|
|
|
foreach $flag (@$tmp) { |
3067
|
0
|
0
|
|
|
|
|
if (exists $ret{$flag}) { |
3068
|
0
|
|
|
|
|
|
$ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta); |
3069
|
|
|
|
|
|
|
} else { |
3070
|
0
|
|
|
|
|
|
$ret{$flag}=$delta; |
3071
|
|
|
|
|
|
|
} |
3072
|
|
|
|
|
|
|
} |
3073
|
|
|
|
|
|
|
} |
3074
|
0
|
|
|
|
|
|
return \%ret; |
3075
|
|
|
|
|
|
|
|
3076
|
|
|
|
|
|
|
} elsif ($flag==2) { |
3077
|
0
|
|
|
|
|
|
while ($#tmp>0) { |
3078
|
0
|
|
|
|
|
|
($date0,$tmp)=splice(@tmp,0,2); |
3079
|
0
|
|
|
|
|
|
$date1=$tmp[0]; |
3080
|
0
|
|
|
|
|
|
$delta=_DateCalc_DateDate($date0,$date1); |
3081
|
0
|
|
|
|
|
|
$flag=join("+",sort { Date_Cmp($a,$b) } @$tmp); |
|
0
|
|
|
|
|
|
|
3082
|
0
|
0
|
|
|
|
|
next if (! $flag); |
3083
|
0
|
0
|
|
|
|
|
if (exists $ret{$flag}) { |
3084
|
0
|
|
|
|
|
|
$ret{$flag}=_DateCalc_DeltaDelta($ret{$flag},$delta); |
3085
|
|
|
|
|
|
|
} else { |
3086
|
0
|
|
|
|
|
|
$ret{$flag}=$delta; |
3087
|
|
|
|
|
|
|
} |
3088
|
|
|
|
|
|
|
} |
3089
|
0
|
|
|
|
|
|
return \%ret; |
3090
|
|
|
|
|
|
|
} |
3091
|
|
|
|
|
|
|
|
3092
|
0
|
|
|
|
|
|
warn "Invalid flag $flag\n"; |
3093
|
0
|
|
|
|
|
|
return undef; |
3094
|
|
|
|
|
|
|
} |
3095
|
|
|
|
|
|
|
|
3096
|
|
|
|
|
|
|
### |
3097
|
|
|
|
|
|
|
# NOTE: The following routines may be called in the routines below with very |
3098
|
|
|
|
|
|
|
# little time penalty. |
3099
|
|
|
|
|
|
|
### |
3100
|
|
|
|
|
|
|
sub Date_SetTime { |
3101
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/); |
3102
|
0
|
|
|
|
|
|
my($date,$h,$mn,$s)=@_; |
3103
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3104
|
0
|
|
|
|
|
|
my($y,$m,$d)=(); |
3105
|
|
|
|
|
|
|
|
3106
|
0
|
0
|
|
|
|
|
if (! _Date_Split($date)) { |
3107
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
3108
|
0
|
0
|
|
|
|
|
return "" if (! $date); |
3109
|
|
|
|
|
|
|
} |
3110
|
|
|
|
|
|
|
|
3111
|
0
|
|
|
|
|
|
($y,$m,$d)=( _Date_Split($date, 1) )[0..2]; |
3112
|
0
|
|
|
|
|
|
($h,$mn,$s)=_Date_ParseTime($h,$mn,$s); |
3113
|
|
|
|
|
|
|
|
3114
|
0
|
|
|
|
|
|
my($ampm,$wk); |
3115
|
0
|
0
|
|
|
|
|
return "" if (_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk)); |
3116
|
0
|
|
|
|
|
|
_Date_Join($y,$m,$d,$h,$mn,$s); |
3117
|
|
|
|
|
|
|
} |
3118
|
|
|
|
|
|
|
|
3119
|
|
|
|
|
|
|
sub Date_SetDateField { |
3120
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/); |
3121
|
0
|
|
|
|
|
|
my($date,$field,$val,$nocheck)=@_; |
3122
|
0
|
|
|
|
|
|
my($y,$m,$d,$h,$mn,$s)=(); |
3123
|
0
|
0
|
|
|
|
|
$nocheck=0 if (! defined $nocheck); |
3124
|
|
|
|
|
|
|
|
3125
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=_Date_Split($date); |
3126
|
|
|
|
|
|
|
|
3127
|
0
|
0
|
|
|
|
|
if (! $y) { |
3128
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
3129
|
0
|
0
|
|
|
|
|
return "" if (! $date); |
3130
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1); |
3131
|
|
|
|
|
|
|
} |
3132
|
|
|
|
|
|
|
|
3133
|
0
|
0
|
|
|
|
|
if (lc($field) eq "y") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3134
|
0
|
|
|
|
|
|
$y=$val; |
3135
|
|
|
|
|
|
|
} elsif (lc($field) eq "m") { |
3136
|
0
|
|
|
|
|
|
$m=$val; |
3137
|
|
|
|
|
|
|
} elsif (lc($field) eq "d") { |
3138
|
0
|
|
|
|
|
|
$d=$val; |
3139
|
|
|
|
|
|
|
} elsif (lc($field) eq "h") { |
3140
|
0
|
|
|
|
|
|
$h=$val; |
3141
|
|
|
|
|
|
|
} elsif (lc($field) eq "mn") { |
3142
|
0
|
|
|
|
|
|
$mn=$val; |
3143
|
|
|
|
|
|
|
} elsif (lc($field) eq "s") { |
3144
|
0
|
|
|
|
|
|
$s=$val; |
3145
|
|
|
|
|
|
|
} else { |
3146
|
0
|
|
|
|
|
|
confess "ERROR: Date_SetDateField: invalid field: $field\n"; |
3147
|
|
|
|
|
|
|
} |
3148
|
|
|
|
|
|
|
|
3149
|
0
|
|
|
|
|
|
$date=_Date_Join($y,$m,$d,$h,$mn,$s); |
3150
|
0
|
0
|
0
|
|
|
|
return $date if ($nocheck || _Date_Split($date)); |
3151
|
0
|
|
|
|
|
|
return ""; |
3152
|
|
|
|
|
|
|
} |
3153
|
|
|
|
|
|
|
|
3154
|
|
|
|
|
|
|
######################################################################## |
3155
|
|
|
|
|
|
|
# OTHER SUBROUTINES |
3156
|
|
|
|
|
|
|
######################################################################## |
3157
|
|
|
|
|
|
|
# NOTE: These routines should not call any of the routines above as |
3158
|
|
|
|
|
|
|
# there will be a severe time penalty (and the possibility of |
3159
|
|
|
|
|
|
|
# infinite recursion). The last couple routines above are |
3160
|
|
|
|
|
|
|
# exceptions. |
3161
|
|
|
|
|
|
|
# NOTE: Date_Init is a special case. It should be called (conditionally) |
3162
|
|
|
|
|
|
|
# in every routine that uses any variable from the Date::Manip |
3163
|
|
|
|
|
|
|
# namespace. |
3164
|
|
|
|
|
|
|
######################################################################## |
3165
|
|
|
|
|
|
|
|
3166
|
|
|
|
|
|
|
sub Date_DaysInMonth { |
3167
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/); |
3168
|
0
|
|
|
|
|
|
my($m,$y)=@_; |
3169
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3170
|
0
|
|
|
|
|
|
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
3171
|
0
|
0
|
|
|
|
|
$d_in_m[2]=29 if (Date_LeapYear($y)); |
3172
|
0
|
|
|
|
|
|
return $d_in_m[$m]; |
3173
|
|
|
|
|
|
|
} |
3174
|
|
|
|
|
|
|
|
3175
|
|
|
|
|
|
|
sub Date_DayOfWeek { |
3176
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/); |
3177
|
0
|
|
|
|
|
|
my($m,$d,$y)=@_; |
3178
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3179
|
0
|
|
|
|
|
|
my($dayofweek,$dec31)=(); |
3180
|
|
|
|
|
|
|
|
3181
|
0
|
|
|
|
|
|
$dec31=5; # Dec 31, 1BC was Friday |
3182
|
0
|
|
|
|
|
|
$dayofweek=(Date_DaysSince1BC($m,$d,$y)+$dec31) % 7; |
3183
|
0
|
0
|
|
|
|
|
$dayofweek=7 if ($dayofweek==0); |
3184
|
0
|
|
|
|
|
|
return $dayofweek; |
3185
|
|
|
|
|
|
|
} |
3186
|
|
|
|
|
|
|
|
3187
|
|
|
|
|
|
|
# Can't be in "use integer" because the numbers are too big. |
3188
|
36
|
|
|
36
|
|
295494
|
no integer; |
|
36
|
|
|
|
|
102
|
|
|
36
|
|
|
|
|
193
|
|
3189
|
|
|
|
|
|
|
sub Date_SecsSince1970 { |
3190
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/); |
3191
|
0
|
|
|
|
|
|
my($m,$d,$y,$h,$mn,$s)=@_; |
3192
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3193
|
0
|
|
|
|
|
|
my($sec_now,$sec_70)=(); |
3194
|
0
|
|
|
|
|
|
$sec_now=(Date_DaysSince1BC($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s; |
3195
|
|
|
|
|
|
|
# $sec_70 =(Date_DaysSince1BC(1,1,1970)-1)*24*3600; |
3196
|
0
|
|
|
|
|
|
$sec_70 =62167219200; |
3197
|
0
|
|
|
|
|
|
return ($sec_now-$sec_70); |
3198
|
|
|
|
|
|
|
} |
3199
|
|
|
|
|
|
|
|
3200
|
|
|
|
|
|
|
sub Date_SecsSince1970GMT { |
3201
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/); |
3202
|
0
|
|
|
|
|
|
my($m,$d,$y,$h,$mn,$s)=@_; |
3203
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3204
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3205
|
|
|
|
|
|
|
|
3206
|
0
|
|
|
|
|
|
my($sec)=Date_SecsSince1970($m,$d,$y,$h,$mn,$s); |
3207
|
0
|
0
|
|
|
|
|
return $sec if ($Cnf{"ConvTZ"} eq "IGNORE"); |
3208
|
|
|
|
|
|
|
|
3209
|
0
|
|
|
|
|
|
my($tz)=$Cnf{"ConvTZ"}; |
3210
|
0
|
0
|
0
|
|
|
|
$tz=$Cnf{"TZ"} if (not defined $tz or $tz eq ""); |
3211
|
0
|
0
|
|
|
|
|
$tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/); |
3212
|
|
|
|
|
|
|
|
3213
|
0
|
|
|
|
|
|
my($tzs)=1; |
3214
|
0
|
0
|
|
|
|
|
$tzs=-1 if ($tz<0); |
3215
|
0
|
|
|
|
|
|
$tz=~/.(..)(..)/; |
3216
|
0
|
|
|
|
|
|
my($tzh,$tzm)=($1,$2); |
3217
|
0
|
|
|
|
|
|
$sec - $tzs*($tzh*3600+$tzm*60); |
3218
|
|
|
|
|
|
|
} |
3219
|
36
|
|
|
36
|
|
16115
|
use integer; |
|
36
|
|
|
|
|
120
|
|
|
36
|
|
|
|
|
252
|
|
3220
|
|
|
|
|
|
|
|
3221
|
|
|
|
|
|
|
sub Date_DaysSince1BC { |
3222
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/); |
3223
|
0
|
|
|
|
|
|
my($m,$d,$y)=@_; |
3224
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3225
|
0
|
|
|
|
|
|
my($Ny,$N4,$N100,$N400,$dayofyear,$days)=(); |
3226
|
0
|
|
|
|
|
|
my($cc,$yy)=(); |
3227
|
|
|
|
|
|
|
|
3228
|
0
|
|
|
|
|
|
$y=~ /(\d{2})(\d{2})/; |
3229
|
0
|
|
|
|
|
|
($cc,$yy)=($1,$2); |
3230
|
|
|
|
|
|
|
|
3231
|
|
|
|
|
|
|
# Number of full years since Dec 31, 1BC (counting the year 0000). |
3232
|
0
|
|
|
|
|
|
$Ny=$y; |
3233
|
|
|
|
|
|
|
|
3234
|
|
|
|
|
|
|
# Number of full 4th years (incl. 0000) since Dec 31, 1BC |
3235
|
0
|
|
|
|
|
|
$N4=($Ny-1)/4 + 1; |
3236
|
0
|
0
|
|
|
|
|
$N4=0 if ($y==0); |
3237
|
|
|
|
|
|
|
|
3238
|
|
|
|
|
|
|
# Number of full 100th years (incl. 0000) |
3239
|
0
|
|
|
|
|
|
$N100=$cc + 1; |
3240
|
0
|
0
|
|
|
|
|
$N100-- if ($yy==0); |
3241
|
0
|
0
|
|
|
|
|
$N100=0 if ($y==0); |
3242
|
|
|
|
|
|
|
|
3243
|
|
|
|
|
|
|
# Number of full 400th years (incl. 0000) |
3244
|
0
|
|
|
|
|
|
$N400=($N100-1)/4 + 1; |
3245
|
0
|
0
|
|
|
|
|
$N400=0 if ($y==0); |
3246
|
|
|
|
|
|
|
|
3247
|
0
|
|
|
|
|
|
$dayofyear=Date_DayOfYear($m,$d,$y); |
3248
|
0
|
|
|
|
|
|
$days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear; |
3249
|
|
|
|
|
|
|
|
3250
|
0
|
|
|
|
|
|
return $days; |
3251
|
|
|
|
|
|
|
} |
3252
|
|
|
|
|
|
|
|
3253
|
|
|
|
|
|
|
sub Date_DayOfYear { |
3254
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/); |
3255
|
0
|
|
|
|
|
|
my($m,$d,$y)=@_; |
3256
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3257
|
|
|
|
|
|
|
# DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) |
3258
|
0
|
|
|
|
|
|
my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365); |
3259
|
0
|
|
|
|
|
|
my($ly)=0; |
3260
|
0
|
0
|
0
|
|
|
|
$ly=1 if ($m>2 && Date_LeapYear($y)); |
3261
|
0
|
|
|
|
|
|
return ($days[$m-1]+$d+$ly); |
3262
|
|
|
|
|
|
|
} |
3263
|
|
|
|
|
|
|
|
3264
|
|
|
|
|
|
|
sub Date_DaysInYear { |
3265
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/); |
3266
|
0
|
|
|
|
|
|
my($y)=@_; |
3267
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3268
|
0
|
0
|
|
|
|
|
return 366 if (Date_LeapYear($y)); |
3269
|
0
|
|
|
|
|
|
return 365; |
3270
|
|
|
|
|
|
|
} |
3271
|
|
|
|
|
|
|
|
3272
|
|
|
|
|
|
|
sub Date_WeekOfYear { |
3273
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/); |
3274
|
0
|
|
|
|
|
|
my($m,$d,$y,$f)=@_; |
3275
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3276
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3277
|
|
|
|
|
|
|
|
3278
|
0
|
|
|
|
|
|
my($day,$dow,$doy)=(); |
3279
|
0
|
|
|
|
|
|
$doy=Date_DayOfYear($m,$d,$y); |
3280
|
|
|
|
|
|
|
|
3281
|
|
|
|
|
|
|
# The current DayOfYear and DayOfWeek |
3282
|
0
|
0
|
|
|
|
|
if ($Cnf{"Jan1Week1"}) { |
3283
|
0
|
|
|
|
|
|
$day=1; |
3284
|
|
|
|
|
|
|
} else { |
3285
|
0
|
|
|
|
|
|
$day=4; |
3286
|
|
|
|
|
|
|
} |
3287
|
0
|
|
|
|
|
|
$dow=Date_DayOfWeek(1,$day,$y); |
3288
|
|
|
|
|
|
|
|
3289
|
|
|
|
|
|
|
# Move back to the first day of week 1. |
3290
|
0
|
0
|
|
|
|
|
$f-=7 if ($f>$dow); |
3291
|
0
|
|
|
|
|
|
$day-= ($dow-$f); |
3292
|
|
|
|
|
|
|
|
3293
|
0
|
0
|
|
|
|
|
return 0 if ($day>$doy); # Day is in last week of previous year |
3294
|
0
|
|
|
|
|
|
return (($doy-$day)/7 + 1); |
3295
|
|
|
|
|
|
|
} |
3296
|
|
|
|
|
|
|
|
3297
|
|
|
|
|
|
|
sub Date_LeapYear { |
3298
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/); |
3299
|
0
|
|
|
|
|
|
my($y)=@_; |
3300
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)!=4); |
3301
|
0
|
0
|
|
|
|
|
return 0 unless $y % 4 == 0; |
3302
|
0
|
0
|
|
|
|
|
return 1 unless $y % 100 == 0; |
3303
|
0
|
0
|
|
|
|
|
return 0 unless $y % 400 == 0; |
3304
|
0
|
|
|
|
|
|
return 1; |
3305
|
|
|
|
|
|
|
} |
3306
|
|
|
|
|
|
|
|
3307
|
|
|
|
|
|
|
sub Date_DaySuffix { |
3308
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/); |
3309
|
0
|
|
|
|
|
|
my($d)=@_; |
3310
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3311
|
0
|
|
|
|
|
|
return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1]; |
3312
|
|
|
|
|
|
|
} |
3313
|
|
|
|
|
|
|
|
3314
|
|
|
|
|
|
|
sub Date_ConvTZ { |
3315
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/); |
3316
|
0
|
|
|
|
|
|
my($date,$from,$to,$level)=@_; |
3317
|
0
|
0
|
|
|
|
|
if (not _Date_Split($date)) { |
3318
|
0
|
|
|
|
|
|
my $err = "date passed in ('$date') is not a Date::Manip object"; |
3319
|
0
|
0
|
|
|
|
|
if (! $level) { |
|
|
0
|
|
|
|
|
|
3320
|
0
|
|
|
|
|
|
croak $err; |
3321
|
|
|
|
|
|
|
} elsif ($level==1) { |
3322
|
0
|
|
|
|
|
|
carp $err; |
3323
|
|
|
|
|
|
|
} |
3324
|
0
|
|
|
|
|
|
return ""; |
3325
|
|
|
|
|
|
|
} |
3326
|
|
|
|
|
|
|
|
3327
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3328
|
0
|
|
|
|
|
|
my($gmt)=(); |
3329
|
|
|
|
|
|
|
|
3330
|
0
|
0
|
0
|
|
|
|
if ((! defined $from) or ($from eq '')) { |
3331
|
|
|
|
|
|
|
|
3332
|
0
|
0
|
0
|
|
|
|
if ((! defined $to) or ($to eq '')) { |
3333
|
|
|
|
|
|
|
# TZ -> ConvTZ |
3334
|
0
|
0
|
0
|
|
|
|
return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"}); |
3335
|
0
|
|
|
|
|
|
$from=$Cnf{"TZ"}; |
3336
|
0
|
|
|
|
|
|
$to=$Cnf{"ConvTZ"}; |
3337
|
|
|
|
|
|
|
|
3338
|
|
|
|
|
|
|
} else { |
3339
|
|
|
|
|
|
|
# ConvTZ,TZ -> $to |
3340
|
0
|
|
|
|
|
|
$from=$Cnf{"ConvTZ"}; |
3341
|
0
|
0
|
0
|
|
|
|
$from=$Cnf{"TZ"} if ((! defined $from) or ($from eq '')); |
3342
|
|
|
|
|
|
|
} |
3343
|
|
|
|
|
|
|
|
3344
|
|
|
|
|
|
|
} else { |
3345
|
|
|
|
|
|
|
|
3346
|
0
|
0
|
0
|
|
|
|
if ((! defined $to) or ($to eq '')) { |
3347
|
|
|
|
|
|
|
# $from -> ConvTZ,TZ |
3348
|
0
|
0
|
|
|
|
|
return $date if ($Cnf{"ConvTZ"} eq "IGNORE"); |
3349
|
0
|
|
|
|
|
|
$to=$Cnf{"ConvTZ"}; |
3350
|
0
|
0
|
0
|
|
|
|
$to=$Cnf{"TZ"} if ((! defined $to) or ($to eq '')); |
3351
|
|
|
|
|
|
|
|
3352
|
|
|
|
|
|
|
} else { |
3353
|
|
|
|
|
|
|
# $from -> $to |
3354
|
|
|
|
|
|
|
} |
3355
|
|
|
|
|
|
|
} |
3356
|
|
|
|
|
|
|
|
3357
|
|
|
|
|
|
|
$to=$Zone{"n2o"}{lc($to)} |
3358
|
0
|
0
|
|
|
|
|
if (exists $Zone{"n2o"}{lc($to)}); |
3359
|
|
|
|
|
|
|
$from=$Zone{"n2o"}{lc($from)} |
3360
|
0
|
0
|
|
|
|
|
if (exists $Zone{"n2o"}{lc($from)}); |
3361
|
0
|
|
|
|
|
|
$gmt=$Zone{"n2o"}{"gmt"}; |
3362
|
|
|
|
|
|
|
|
3363
|
0
|
0
|
0
|
|
|
|
return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/); |
3364
|
0
|
0
|
|
|
|
|
return $date if ($from eq $to); |
3365
|
|
|
|
|
|
|
|
3366
|
0
|
|
|
|
|
|
my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=(); |
3367
|
|
|
|
|
|
|
# We're going to try to do the calculation without calling DateCalc. |
3368
|
0
|
|
|
|
|
|
($yr,$mon,$d,$h,$m,$sec)=_Date_Split($date, 1); |
3369
|
|
|
|
|
|
|
|
3370
|
|
|
|
|
|
|
# Convert $date from $from to GMT |
3371
|
0
|
|
|
|
|
|
$from=~/([+-])(\d{2})(\d{2})/; |
3372
|
0
|
|
|
|
|
|
($s1,$h1,$m1)=($1,$2,$3); |
3373
|
0
|
0
|
|
|
|
|
$s1= ($s1 eq "-" ? "+" : "-"); # switch sign |
3374
|
0
|
|
|
|
|
|
$sign=$s1 . "1"; # + or - 1 |
3375
|
|
|
|
|
|
|
|
3376
|
|
|
|
|
|
|
# and from GMT to $to |
3377
|
0
|
|
|
|
|
|
$to=~/([+-])(\d{2})(\d{2})/; |
3378
|
0
|
|
|
|
|
|
($s2,$h2,$m2)=($1,$2,$3); |
3379
|
|
|
|
|
|
|
|
3380
|
0
|
0
|
|
|
|
|
if ($s1 eq $s2) { |
3381
|
|
|
|
|
|
|
# Both the same sign |
3382
|
0
|
|
|
|
|
|
$m+= $sign*($m1+$m2); |
3383
|
0
|
|
|
|
|
|
$h+= $sign*($h1+$h2); |
3384
|
|
|
|
|
|
|
} else { |
3385
|
0
|
0
|
0
|
|
|
|
$sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2)); |
|
|
0
|
0
|
|
|
|
|
3386
|
0
|
|
|
|
|
|
$m+= $sign*($m1-$m2); |
3387
|
0
|
|
|
|
|
|
$h+= $sign*($h1-$h2); |
3388
|
|
|
|
|
|
|
} |
3389
|
|
|
|
|
|
|
|
3390
|
0
|
0
|
|
|
|
|
if ($m>59) { |
|
|
0
|
|
|
|
|
|
3391
|
0
|
|
|
|
|
|
$h+= $m/60; |
3392
|
0
|
|
|
|
|
|
$m-= ($m/60)*60; |
3393
|
|
|
|
|
|
|
} elsif ($m<0) { |
3394
|
0
|
|
|
|
|
|
$h+= ($m/60 - 1); |
3395
|
0
|
|
|
|
|
|
$m-= ($m/60 - 1)*60; |
3396
|
|
|
|
|
|
|
} |
3397
|
|
|
|
|
|
|
|
3398
|
0
|
0
|
|
|
|
|
if ($h>23) { |
|
|
0
|
|
|
|
|
|
3399
|
0
|
|
|
|
|
|
$delta=$h/24; |
3400
|
0
|
|
|
|
|
|
$h -= $delta*24; |
3401
|
0
|
0
|
|
|
|
|
if (($d + $delta) > 28) { |
3402
|
0
|
|
|
|
|
|
$date=_Date_Join($yr,$mon,$d,$h,$m,$sec); |
3403
|
0
|
|
|
|
|
|
return _DateCalc_DateDelta($date,"+0:0:0:$delta:0:0:0",\$err,0); |
3404
|
|
|
|
|
|
|
} |
3405
|
0
|
|
|
|
|
|
$d+= $delta; |
3406
|
|
|
|
|
|
|
} elsif ($h<0) { |
3407
|
0
|
|
|
|
|
|
$delta=-$h/24 + 1; |
3408
|
0
|
|
|
|
|
|
$h += $delta*24; |
3409
|
0
|
0
|
|
|
|
|
if (($d - $delta) < 1) { |
3410
|
0
|
|
|
|
|
|
$date=_Date_Join($yr,$mon,$d,$h,$m,$sec); |
3411
|
0
|
|
|
|
|
|
return _DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0); |
3412
|
|
|
|
|
|
|
} |
3413
|
0
|
|
|
|
|
|
$d-= $delta; |
3414
|
|
|
|
|
|
|
} |
3415
|
0
|
|
|
|
|
|
return _Date_Join($yr,$mon,$d,$h,$m,$sec); |
3416
|
|
|
|
|
|
|
} |
3417
|
|
|
|
|
|
|
|
3418
|
|
|
|
|
|
|
sub Date_TimeZone { |
3419
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/); |
3420
|
0
|
|
|
|
|
|
my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=(); |
3421
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3422
|
|
|
|
|
|
|
|
3423
|
|
|
|
|
|
|
# Get timezones from all of the relevant places |
3424
|
|
|
|
|
|
|
|
3425
|
0
|
0
|
|
|
|
|
push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var |
3426
|
0
|
0
|
|
|
|
|
push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var |
3427
|
|
|
|
|
|
|
push(@tz,$ENV{'SYS$TIMEZONE_RULE'}) |
3428
|
0
|
0
|
|
|
|
|
if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var |
3429
|
|
|
|
|
|
|
push(@tz,$ENV{'SYS$TIMEZONE_NAME'}) |
3430
|
0
|
0
|
|
|
|
|
if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var |
3431
|
|
|
|
|
|
|
push(@tz,$ENV{'UCX$TZ'}) |
3432
|
0
|
0
|
|
|
|
|
if defined $ENV{'UCX$TZ'}; # VMS TZ environ var |
3433
|
|
|
|
|
|
|
push(@tz,$ENV{'TCPIP$TZ'}) |
3434
|
0
|
0
|
|
|
|
|
if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var |
3435
|
|
|
|
|
|
|
|
3436
|
|
|
|
|
|
|
# The `date` command... if we're doing taint checking, we need to |
3437
|
|
|
|
|
|
|
# always call it with a full path... otherwise, use the user's path. |
3438
|
|
|
|
|
|
|
# |
3439
|
|
|
|
|
|
|
# Microsoft operating systems don't have a date command built in. Try |
3440
|
|
|
|
|
|
|
# to trap all the various ways of knowing we are on one of these systems. |
3441
|
|
|
|
|
|
|
# |
3442
|
|
|
|
|
|
|
# We'll try `date +%Z` first, and if that fails, we'll take just the |
3443
|
|
|
|
|
|
|
# `date` program and assume the output is of the format: |
3444
|
|
|
|
|
|
|
# Thu Aug 31 14:57:46 EDT 2000 |
3445
|
|
|
|
|
|
|
|
3446
|
0
|
0
|
0
|
|
|
|
unless (($^O ne 'cygwin' && $^X =~ /perl\.exe$/i) or |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
3447
|
|
|
|
|
|
|
($OS eq "Windows") or |
3448
|
|
|
|
|
|
|
($OS eq "Netware") or |
3449
|
|
|
|
|
|
|
($OS eq "VMS")) { |
3450
|
0
|
0
|
|
|
|
|
if ($Date::Manip::DM5::NoTaint) { |
3451
|
0
|
0
|
|
|
|
|
if ($OS eq "VMS") { |
3452
|
0
|
|
|
|
|
|
$tz=$ENV{'SYS$TIMEZONE_NAME'}; |
3453
|
0
|
0
|
|
|
|
|
if (! defined $tz) { |
3454
|
0
|
|
|
|
|
|
$tz=$ENV{'MULTINET_TIMEZONE'}; |
3455
|
0
|
0
|
|
|
|
|
if (! defined $tz) { |
3456
|
0
|
|
|
|
|
|
$tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT |
3457
|
|
|
|
|
|
|
} |
3458
|
|
|
|
|
|
|
} |
3459
|
0
|
0
|
|
|
|
|
push(@tz,$tz) if (defined $tz); |
3460
|
|
|
|
|
|
|
|
3461
|
|
|
|
|
|
|
} else { |
3462
|
0
|
|
|
|
|
|
$tz=`date +%Z 2> /dev/null`; |
3463
|
0
|
|
|
|
|
|
chomp($tz); |
3464
|
0
|
0
|
|
|
|
|
if (! defined $tz) { |
3465
|
0
|
|
|
|
|
|
$tz=`date 2> /dev/null`; |
3466
|
0
|
|
|
|
|
|
chomp($tz); |
3467
|
0
|
|
|
|
|
|
$tz=(split(/\s+/,$tz))[4]; |
3468
|
|
|
|
|
|
|
} |
3469
|
0
|
0
|
|
|
|
|
push(@tz,$tz) if (defined $tz); |
3470
|
|
|
|
|
|
|
|
3471
|
|
|
|
|
|
|
# for international timezones |
3472
|
0
|
|
|
|
|
|
$tz=`date +%z 2> /dev/null`; |
3473
|
0
|
|
|
|
|
|
chomp($tz); |
3474
|
0
|
0
|
|
|
|
|
push(@tz,$tz) if (defined $tz); |
3475
|
|
|
|
|
|
|
} |
3476
|
|
|
|
|
|
|
} else { |
3477
|
|
|
|
|
|
|
# We need to satisfy taint checking, but also look in all the |
3478
|
|
|
|
|
|
|
# directories in @DatePath. |
3479
|
|
|
|
|
|
|
# |
3480
|
0
|
|
|
|
|
|
local $ENV{PATH} = join(':', @Date::Manip::DM5::DatePath); |
3481
|
0
|
|
|
|
|
|
local $ENV{BASH_ENV} = ''; |
3482
|
0
|
|
|
|
|
|
$tz=`date +%Z 2> /dev/null`; |
3483
|
0
|
|
|
|
|
|
chomp($tz); |
3484
|
0
|
0
|
|
|
|
|
if (! defined $tz) { |
3485
|
0
|
|
|
|
|
|
$tz=`date 2> /dev/null`; |
3486
|
0
|
|
|
|
|
|
chomp($tz); |
3487
|
0
|
|
|
|
|
|
$tz=(split(/\s+/,$tz))[4]; |
3488
|
|
|
|
|
|
|
} |
3489
|
0
|
0
|
|
|
|
|
push(@tz,$tz) if (defined $tz); |
3490
|
|
|
|
|
|
|
|
3491
|
|
|
|
|
|
|
# for international timezones |
3492
|
0
|
|
|
|
|
|
$tz=`date +%z 2> /dev/null`; |
3493
|
0
|
|
|
|
|
|
chomp($tz); |
3494
|
0
|
0
|
|
|
|
|
push(@tz,$tz) if (defined $tz); |
3495
|
|
|
|
|
|
|
} |
3496
|
|
|
|
|
|
|
} |
3497
|
|
|
|
|
|
|
|
3498
|
0
|
0
|
|
|
|
|
push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ |
3499
|
|
|
|
|
|
|
|
3500
|
0
|
0
|
|
|
|
|
if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE |
3501
|
0
|
|
|
|
|
|
$in=new IO::File; |
3502
|
0
|
|
|
|
|
|
$in->open("/etc/TIMEZONE","r"); |
3503
|
0
|
|
|
|
|
|
while (! eof($in)) { |
3504
|
0
|
|
|
|
|
|
$tmp=<$in>; |
3505
|
0
|
0
|
|
|
|
|
if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) { |
3506
|
0
|
|
|
|
|
|
push(@tz,$1); |
3507
|
0
|
|
|
|
|
|
last; |
3508
|
|
|
|
|
|
|
} |
3509
|
|
|
|
|
|
|
} |
3510
|
0
|
|
|
|
|
|
$in->close; |
3511
|
|
|
|
|
|
|
} |
3512
|
|
|
|
|
|
|
|
3513
|
0
|
0
|
|
|
|
|
if (-s "/etc/timezone") { # /etc/timezone |
3514
|
0
|
|
|
|
|
|
$in=new IO::File; |
3515
|
0
|
|
|
|
|
|
$in->open("/etc/timezone","r"); |
3516
|
0
|
|
|
|
|
|
while (! eof($in)) { |
3517
|
0
|
|
|
|
|
|
$tmp=<$in>; |
3518
|
0
|
0
|
|
|
|
|
next if ($tmp =~ /^\s*\043/); |
3519
|
0
|
|
|
|
|
|
chomp($tmp); |
3520
|
0
|
0
|
|
|
|
|
if ($tmp =~ /^\s*(.*?)\s*$/) { |
3521
|
0
|
|
|
|
|
|
push(@tz,$1); |
3522
|
0
|
|
|
|
|
|
last; |
3523
|
|
|
|
|
|
|
} |
3524
|
|
|
|
|
|
|
} |
3525
|
0
|
|
|
|
|
|
$in->close; |
3526
|
|
|
|
|
|
|
} |
3527
|
|
|
|
|
|
|
|
3528
|
|
|
|
|
|
|
# Now parse each one to find the first valid one. |
3529
|
0
|
|
|
|
|
|
foreach $tz (@tz) { |
3530
|
0
|
|
|
|
|
|
$tz =~ s/\s*$//; |
3531
|
0
|
|
|
|
|
|
$tz =~ s/^\s*//; |
3532
|
0
|
|
|
|
|
|
$tz =~ s/^://; |
3533
|
0
|
0
|
|
|
|
|
next if ($tz eq ""); |
3534
|
|
|
|
|
|
|
|
3535
|
|
|
|
|
|
|
return uc($tz) |
3536
|
0
|
0
|
|
|
|
|
if (defined $Zone{"n2o"}{lc($tz)}); |
3537
|
|
|
|
|
|
|
|
3538
|
0
|
0
|
|
|
|
|
if ($tz =~ /^[+-]\d{4}$/) { |
|
|
0
|
|
|
|
|
|
3539
|
0
|
|
|
|
|
|
return $tz; |
3540
|
|
|
|
|
|
|
} elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) { |
3541
|
0
|
|
|
|
|
|
my($h,$m)=($1,$2); |
3542
|
0
|
0
|
|
|
|
|
$m="00" if (! $m); |
3543
|
0
|
|
|
|
|
|
return "$h$m"; |
3544
|
|
|
|
|
|
|
} |
3545
|
|
|
|
|
|
|
|
3546
|
|
|
|
|
|
|
# Handle US/Eastern format |
3547
|
0
|
0
|
|
|
|
|
if ($tz =~ /^$Zone{"tzones"}$/i) { |
3548
|
0
|
|
|
|
|
|
$tmp=lc $1; |
3549
|
0
|
|
|
|
|
|
$tz=$Zone{"tz2z"}{$tmp}; |
3550
|
|
|
|
|
|
|
} |
3551
|
|
|
|
|
|
|
|
3552
|
|
|
|
|
|
|
# Handle STD#DST# format (and STD-#DST-# formats) |
3553
|
0
|
0
|
|
|
|
|
if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) { |
3554
|
0
|
|
|
|
|
|
($std,$dst)=($1,$2); |
3555
|
|
|
|
|
|
|
next if (! defined $Zone{"n2o"}{lc($std)} or |
3556
|
0
|
0
|
0
|
|
|
|
! defined $Zone{"n2o"}{lc($dst)}); |
3557
|
0
|
|
|
|
|
|
$time = time(); |
3558
|
0
|
|
|
|
|
|
($null,$null,$null,$null,$null,$null,$null,$null,$isdst) = |
3559
|
|
|
|
|
|
|
localtime($time); |
3560
|
0
|
0
|
|
|
|
|
return uc($dst) if ($isdst); |
3561
|
0
|
|
|
|
|
|
return uc($std); |
3562
|
|
|
|
|
|
|
} |
3563
|
|
|
|
|
|
|
} |
3564
|
|
|
|
|
|
|
|
3565
|
0
|
|
|
|
|
|
confess "ERROR: Date::Manip unable to determine Time Zone.\n"; |
3566
|
|
|
|
|
|
|
} |
3567
|
|
|
|
|
|
|
|
3568
|
|
|
|
|
|
|
# Returns 1 if $date is a work day. If $time is non-zero, the time is |
3569
|
|
|
|
|
|
|
# also checked to see if it falls within work hours. Returns "" if |
3570
|
|
|
|
|
|
|
# an invalid date is passed in. |
3571
|
|
|
|
|
|
|
sub Date_IsWorkDay { |
3572
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/); |
3573
|
0
|
|
|
|
|
|
my($date,$time)=@_; |
3574
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3575
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
3576
|
0
|
0
|
|
|
|
|
return "" if (! $date); |
3577
|
0
|
|
|
|
|
|
my($d)=$date; |
3578
|
0
|
0
|
|
|
|
|
$d=Date_SetTime($date,$Cnf{"WorkDayBeg"}) if (! $time); |
3579
|
|
|
|
|
|
|
|
3580
|
0
|
|
|
|
|
|
my($y,$mon,$day,$h,$m,$s,$dow)=(); |
3581
|
0
|
|
|
|
|
|
($y,$mon,$day,$h,$m,$s)=_Date_Split($d, 1); |
3582
|
0
|
|
|
|
|
|
$dow=Date_DayOfWeek($mon,$day,$y); |
3583
|
|
|
|
|
|
|
|
3584
|
|
|
|
|
|
|
return 0 if ($dow<$Cnf{"WorkWeekBeg"} or |
3585
|
|
|
|
|
|
|
$dow>$Cnf{"WorkWeekEnd"} or |
3586
|
|
|
|
|
|
|
"$h:$m" lt $Cnf{"WorkDayBeg"} or |
3587
|
0
|
0
|
0
|
|
|
|
"$h:$m" ge $Cnf{"WorkDayEnd"}); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
3588
|
|
|
|
|
|
|
|
3589
|
0
|
0
|
|
|
|
|
if (! exists $Holiday{"dates"}{$y}) { |
3590
|
|
|
|
|
|
|
# There will be recursion problems if we ever end up here twice. |
3591
|
0
|
|
|
|
|
|
$Holiday{"dates"}{$y}={}; |
3592
|
0
|
|
|
|
|
|
_Date_UpdateHolidays($y) |
3593
|
|
|
|
|
|
|
} |
3594
|
0
|
|
|
|
|
|
$d=Date_SetTime($date,"00:00:00"); |
3595
|
0
|
0
|
|
|
|
|
return 0 if (exists $Holiday{"dates"}{$y}{$d}); |
3596
|
0
|
|
|
|
|
|
1; |
3597
|
|
|
|
|
|
|
} |
3598
|
|
|
|
|
|
|
|
3599
|
|
|
|
|
|
|
# Finds the day $off work days from now. If $time is passed in, we must |
3600
|
|
|
|
|
|
|
# also take into account the time of day. |
3601
|
|
|
|
|
|
|
# |
3602
|
|
|
|
|
|
|
# If $time is not passed in, day 0 is today (if today is a workday) or the |
3603
|
|
|
|
|
|
|
# next work day if it isn't. In any case, the time of day is unaffected. |
3604
|
|
|
|
|
|
|
# |
3605
|
|
|
|
|
|
|
# If $time is passed in, day 0 is now (if now is part of a workday) or the |
3606
|
|
|
|
|
|
|
# start of the very next work day. |
3607
|
|
|
|
|
|
|
sub Date_NextWorkDay { |
3608
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/); |
3609
|
0
|
|
|
|
|
|
my($date,$off,$time)=@_; |
3610
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3611
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
3612
|
0
|
|
|
|
|
|
my($err)=(); |
3613
|
|
|
|
|
|
|
|
3614
|
0
|
0
|
|
|
|
|
if (! Date_IsWorkDay($date,$time)) { |
3615
|
0
|
0
|
|
|
|
|
if ($time) { |
3616
|
0
|
|
|
|
|
|
while (1) { |
3617
|
0
|
|
|
|
|
|
$date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"}); |
3618
|
0
|
0
|
|
|
|
|
last if (Date_IsWorkDay($date,$time)); |
3619
|
|
|
|
|
|
|
} |
3620
|
|
|
|
|
|
|
} else { |
3621
|
0
|
|
|
|
|
|
while (1) { |
3622
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0); |
3623
|
0
|
0
|
|
|
|
|
last if (Date_IsWorkDay($date,$time)); |
3624
|
|
|
|
|
|
|
} |
3625
|
|
|
|
|
|
|
} |
3626
|
|
|
|
|
|
|
} |
3627
|
|
|
|
|
|
|
|
3628
|
0
|
|
|
|
|
|
while ($off>0) { |
3629
|
0
|
|
|
|
|
|
while (1) { |
3630
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0); |
3631
|
0
|
0
|
|
|
|
|
last if (Date_IsWorkDay($date,$time)); |
3632
|
|
|
|
|
|
|
} |
3633
|
0
|
|
|
|
|
|
$off--; |
3634
|
|
|
|
|
|
|
} |
3635
|
|
|
|
|
|
|
|
3636
|
0
|
|
|
|
|
|
return $date; |
3637
|
|
|
|
|
|
|
} |
3638
|
|
|
|
|
|
|
|
3639
|
|
|
|
|
|
|
# Finds the day $off work days before now. If $time is passed in, we must |
3640
|
|
|
|
|
|
|
# also take into account the time of day. |
3641
|
|
|
|
|
|
|
# |
3642
|
|
|
|
|
|
|
# If $time is not passed in, day 0 is today (if today is a workday) or the |
3643
|
|
|
|
|
|
|
# previous work day if it isn't. In any case, the time of day is unaffected. |
3644
|
|
|
|
|
|
|
# |
3645
|
|
|
|
|
|
|
# If $time is passed in, day 0 is now (if now is part of a workday) or the |
3646
|
|
|
|
|
|
|
# end of the previous work period. Note that since the end of a work day |
3647
|
|
|
|
|
|
|
# will automatically be turned into the start of the next one, this time |
3648
|
|
|
|
|
|
|
# may actually be treated as AFTER the current time. |
3649
|
|
|
|
|
|
|
sub Date_PrevWorkDay { |
3650
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/); |
3651
|
0
|
|
|
|
|
|
my($date,$off,$time)=@_; |
3652
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3653
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
3654
|
0
|
|
|
|
|
|
my($err)=(); |
3655
|
|
|
|
|
|
|
|
3656
|
0
|
0
|
|
|
|
|
if (! Date_IsWorkDay($date,$time)) { |
3657
|
0
|
0
|
|
|
|
|
if ($time) { |
3658
|
0
|
|
|
|
|
|
while (1) { |
3659
|
0
|
|
|
|
|
|
$date=Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"}); |
3660
|
0
|
0
|
|
|
|
|
last if (Date_IsWorkDay($date,$time)); |
3661
|
|
|
|
|
|
|
} |
3662
|
|
|
|
|
|
|
} else { |
3663
|
0
|
|
|
|
|
|
while (1) { |
3664
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0); |
3665
|
0
|
0
|
|
|
|
|
last if (Date_IsWorkDay($date,$time)); |
3666
|
|
|
|
|
|
|
} |
3667
|
|
|
|
|
|
|
} |
3668
|
|
|
|
|
|
|
} |
3669
|
|
|
|
|
|
|
|
3670
|
0
|
|
|
|
|
|
while ($off>0) { |
3671
|
0
|
|
|
|
|
|
while (1) { |
3672
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0); |
3673
|
0
|
0
|
|
|
|
|
last if (Date_IsWorkDay($date,$time)); |
3674
|
|
|
|
|
|
|
} |
3675
|
0
|
|
|
|
|
|
$off--; |
3676
|
|
|
|
|
|
|
} |
3677
|
|
|
|
|
|
|
|
3678
|
0
|
|
|
|
|
|
return $date; |
3679
|
|
|
|
|
|
|
} |
3680
|
|
|
|
|
|
|
|
3681
|
|
|
|
|
|
|
# This finds the nearest workday to $date. If $date is a workday, it |
3682
|
|
|
|
|
|
|
# is returned. |
3683
|
|
|
|
|
|
|
sub Date_NearestWorkDay { |
3684
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/); |
3685
|
0
|
|
|
|
|
|
my($date,$tomorrow)=@_; |
3686
|
0
|
0
|
|
|
|
|
Date_Init() if (! $Curr{"InitDone"}); |
3687
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
3688
|
0
|
|
|
|
|
|
my($a,$b,$dela,$delb,$err)=(); |
3689
|
0
|
0
|
|
|
|
|
$tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow); |
3690
|
|
|
|
|
|
|
|
3691
|
0
|
0
|
|
|
|
|
return $date if (Date_IsWorkDay($date)); |
3692
|
|
|
|
|
|
|
|
3693
|
|
|
|
|
|
|
# Find the nearest one. |
3694
|
0
|
0
|
|
|
|
|
if ($tomorrow) { |
3695
|
0
|
|
|
|
|
|
$dela="+0:0:0:1:0:0:0"; |
3696
|
0
|
|
|
|
|
|
$delb="-0:0:0:1:0:0:0"; |
3697
|
|
|
|
|
|
|
} else { |
3698
|
0
|
|
|
|
|
|
$dela="-0:0:0:1:0:0:0"; |
3699
|
0
|
|
|
|
|
|
$delb="+0:0:0:1:0:0:0"; |
3700
|
|
|
|
|
|
|
} |
3701
|
0
|
|
|
|
|
|
$a=$b=$date; |
3702
|
|
|
|
|
|
|
|
3703
|
0
|
|
|
|
|
|
while (1) { |
3704
|
0
|
|
|
|
|
|
$a=_DateCalc_DateDelta($a,$dela,\$err); |
3705
|
0
|
0
|
|
|
|
|
return $a if (Date_IsWorkDay($a)); |
3706
|
0
|
|
|
|
|
|
$b=_DateCalc_DateDelta($b,$delb,\$err); |
3707
|
0
|
0
|
|
|
|
|
return $b if (Date_IsWorkDay($b)); |
3708
|
|
|
|
|
|
|
} |
3709
|
|
|
|
|
|
|
} |
3710
|
|
|
|
|
|
|
|
3711
|
|
|
|
|
|
|
# Date_NthDayOfYear($y,$n); |
3712
|
|
|
|
|
|
|
# Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year. |
3713
|
|
|
|
|
|
|
sub Date_NthDayOfYear { |
3714
|
36
|
|
|
36
|
|
137150
|
no integer; |
|
36
|
|
|
|
|
88
|
|
|
36
|
|
|
|
|
187
|
|
3715
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/); |
3716
|
0
|
|
|
|
|
|
my($y,$n)=@_; |
3717
|
0
|
0
|
|
|
|
|
$y=$Curr{"Y"} if (! $y); |
3718
|
0
|
0
|
0
|
|
|
|
$n=1 if (! defined $n or $n eq ""); |
3719
|
0
|
|
|
|
|
|
$n+=0; # to turn 023 into 23 |
3720
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)<4); |
3721
|
0
|
|
|
|
|
|
my $leap=Date_LeapYear($y); |
3722
|
0
|
0
|
|
|
|
|
return () if ($n<1); |
3723
|
0
|
0
|
|
|
|
|
return () if ($n >= ($leap ? 367 : 366)); |
|
|
0
|
|
|
|
|
|
3724
|
|
|
|
|
|
|
|
3725
|
0
|
|
|
|
|
|
my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31); |
3726
|
0
|
0
|
|
|
|
|
$d_in_m[1]=29 if ($leap); |
3727
|
|
|
|
|
|
|
|
3728
|
|
|
|
|
|
|
# Calculate the hours, minutes, and seconds into the day. |
3729
|
0
|
|
|
|
|
|
my $remain=($n - int($n))*24; |
3730
|
0
|
|
|
|
|
|
my $h=int($remain); |
3731
|
0
|
|
|
|
|
|
$remain=($remain - $h)*60; |
3732
|
0
|
|
|
|
|
|
my $mn=int($remain); |
3733
|
0
|
|
|
|
|
|
$remain=($remain - $mn)*60; |
3734
|
0
|
|
|
|
|
|
my $s=$remain; |
3735
|
|
|
|
|
|
|
|
3736
|
|
|
|
|
|
|
# Calculate the month and the day. |
3737
|
0
|
|
|
|
|
|
my($m,$d)=(0,0); |
3738
|
0
|
|
|
|
|
|
$n=int($n); |
3739
|
0
|
|
|
|
|
|
while ($n>0) { |
3740
|
0
|
|
|
|
|
|
$m++; |
3741
|
0
|
0
|
|
|
|
|
if ($n<=$d_in_m[0]) { |
3742
|
0
|
|
|
|
|
|
$d=int($n); |
3743
|
0
|
|
|
|
|
|
$n=0; |
3744
|
|
|
|
|
|
|
} else { |
3745
|
0
|
|
|
|
|
|
$n-= $d_in_m[0]; |
3746
|
0
|
|
|
|
|
|
shift(@d_in_m); |
3747
|
|
|
|
|
|
|
} |
3748
|
|
|
|
|
|
|
} |
3749
|
|
|
|
|
|
|
|
3750
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s); |
3751
|
|
|
|
|
|
|
} |
3752
|
|
|
|
|
|
|
|
3753
|
|
|
|
|
|
|
######################################################################## |
3754
|
|
|
|
|
|
|
# NOT FOR EXPORT |
3755
|
|
|
|
|
|
|
######################################################################## |
3756
|
|
|
|
|
|
|
|
3757
|
|
|
|
|
|
|
# This is used in Date_Init to fill in a hash based on international |
3758
|
|
|
|
|
|
|
# data. It takes a list of keys and values and returns both a hash |
3759
|
|
|
|
|
|
|
# with these values and a regular expression of keys. |
3760
|
|
|
|
|
|
|
# |
3761
|
|
|
|
|
|
|
# IN: |
3762
|
|
|
|
|
|
|
# $data = [ key1 val1 key2 val2 ... ] |
3763
|
|
|
|
|
|
|
# $opts = lc : lowercase the keys in the regexp |
3764
|
|
|
|
|
|
|
# sort : sort (by length) the keys in the regexp |
3765
|
|
|
|
|
|
|
# back : create a regexp with a back reference |
3766
|
|
|
|
|
|
|
# escape : escape all strings in the regexp |
3767
|
|
|
|
|
|
|
# |
3768
|
|
|
|
|
|
|
# OUT: |
3769
|
|
|
|
|
|
|
# $regexp = '(?:key1|key2|...)' |
3770
|
|
|
|
|
|
|
# $hash = { key1=>val1 key2=>val2 ... } |
3771
|
|
|
|
|
|
|
|
3772
|
|
|
|
|
|
|
sub _Date_InitHash { |
3773
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/); |
3774
|
0
|
|
|
|
|
|
my($data,$regexp,$opts,$hash)=@_; |
3775
|
0
|
|
|
|
|
|
my(@data)=@$data; |
3776
|
0
|
|
|
|
|
|
my($key,$val,@list)=(); |
3777
|
|
|
|
|
|
|
|
3778
|
|
|
|
|
|
|
# Parse the options |
3779
|
0
|
|
|
|
|
|
my($lc,$sort,$back,$escape)=(0,0,0,0); |
3780
|
0
|
0
|
|
|
|
|
$lc=1 if ($opts =~ /lc/i); |
3781
|
0
|
0
|
|
|
|
|
$sort=1 if ($opts =~ /sort/i); |
3782
|
0
|
0
|
|
|
|
|
$back=1 if ($opts =~ /back/i); |
3783
|
0
|
0
|
|
|
|
|
$escape=1 if ($opts =~ /escape/i); |
3784
|
|
|
|
|
|
|
|
3785
|
|
|
|
|
|
|
# Create the hash |
3786
|
0
|
|
|
|
|
|
while (@data) { |
3787
|
0
|
|
|
|
|
|
($key,$val,@data)=@data; |
3788
|
0
|
0
|
|
|
|
|
$key=lc($key) if ($lc); |
3789
|
0
|
|
|
|
|
|
$$hash{$key}=$val; |
3790
|
|
|
|
|
|
|
} |
3791
|
|
|
|
|
|
|
|
3792
|
|
|
|
|
|
|
# Create the regular expression |
3793
|
0
|
0
|
|
|
|
|
if ($regexp) { |
3794
|
0
|
|
|
|
|
|
@list=keys(%$hash); |
3795
|
0
|
0
|
|
|
|
|
@list=sort _sortByLength(@list) if ($sort); |
3796
|
0
|
0
|
|
|
|
|
if ($escape) { |
3797
|
0
|
|
|
|
|
|
foreach $val (@list) { |
3798
|
0
|
|
|
|
|
|
$val="\Q$val\E"; |
3799
|
|
|
|
|
|
|
} |
3800
|
|
|
|
|
|
|
} |
3801
|
0
|
0
|
|
|
|
|
if ($back) { |
3802
|
0
|
|
|
|
|
|
$$regexp="(" . join("|",@list) . ")"; |
3803
|
|
|
|
|
|
|
} else { |
3804
|
0
|
|
|
|
|
|
$$regexp="(?:" . join("|",@list) . ")"; |
3805
|
|
|
|
|
|
|
} |
3806
|
|
|
|
|
|
|
} |
3807
|
|
|
|
|
|
|
} |
3808
|
|
|
|
|
|
|
|
3809
|
|
|
|
|
|
|
# This is used in Date_Init to fill in regular expressions, lists, and |
3810
|
|
|
|
|
|
|
# hashes based on international data. It takes a list of lists which have |
3811
|
|
|
|
|
|
|
# to be stored as regular expressions (to find any element in the list), |
3812
|
|
|
|
|
|
|
# lists, and hashes (indicating the location in the lists). |
3813
|
|
|
|
|
|
|
# |
3814
|
|
|
|
|
|
|
# IN: |
3815
|
|
|
|
|
|
|
# $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ] |
3816
|
|
|
|
|
|
|
# [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ] |
3817
|
|
|
|
|
|
|
# ... |
3818
|
|
|
|
|
|
|
# [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ] |
3819
|
|
|
|
|
|
|
# $lists = [ \@listA \@listB ... \@listZ ] |
3820
|
|
|
|
|
|
|
# $opts = lc : lowercase the values in the regexp |
3821
|
|
|
|
|
|
|
# sort : sort (by length) the values in the regexp |
3822
|
|
|
|
|
|
|
# back : create a regexp with a back reference |
3823
|
|
|
|
|
|
|
# escape : escape all strings in the regexp |
3824
|
|
|
|
|
|
|
# $hash = [ \%hash, TYPE ] |
3825
|
|
|
|
|
|
|
# TYPE 0 : $hash{ valBn=>n-1 } |
3826
|
|
|
|
|
|
|
# TYPE 1 : $hash{ valBn=>n } |
3827
|
|
|
|
|
|
|
# |
3828
|
|
|
|
|
|
|
# OUT: |
3829
|
|
|
|
|
|
|
# $regexp = '(?:valA1|valA2|...|valB1|...)' |
3830
|
|
|
|
|
|
|
# $lists = [ [ valA1 valA2 ... ] # only the 1st list (or |
3831
|
|
|
|
|
|
|
# [ valB1 valB2 ... ] ... ] # 2nd for int. characters) |
3832
|
|
|
|
|
|
|
# $hash |
3833
|
|
|
|
|
|
|
|
3834
|
|
|
|
|
|
|
sub _Date_InitLists { |
3835
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/); |
3836
|
0
|
|
|
|
|
|
my($data,$regexp,$opts,$lists,$hash)=@_; |
3837
|
0
|
|
|
|
|
|
my(@data)=@$data; |
3838
|
0
|
|
|
|
|
|
my(@lists)=@$lists; |
3839
|
0
|
|
|
|
|
|
my($i,@ele,$ele,@list,$j,$tmp)=(); |
3840
|
|
|
|
|
|
|
|
3841
|
|
|
|
|
|
|
# Parse the options |
3842
|
0
|
|
|
|
|
|
my($lc,$sort,$back,$escape)=(0,0,0,0); |
3843
|
0
|
0
|
|
|
|
|
$lc=1 if ($opts =~ /lc/i); |
3844
|
0
|
0
|
|
|
|
|
$sort=1 if ($opts =~ /sort/i); |
3845
|
0
|
0
|
|
|
|
|
$back=1 if ($opts =~ /back/i); |
3846
|
0
|
0
|
|
|
|
|
$escape=1 if ($opts =~ /escape/i); |
3847
|
|
|
|
|
|
|
|
3848
|
|
|
|
|
|
|
# Set each of the lists |
3849
|
0
|
0
|
|
|
|
|
if (@lists) { |
3850
|
0
|
0
|
|
|
|
|
confess "ERROR: _Date_InitLists: lists must be 1 per data\n" |
3851
|
|
|
|
|
|
|
if ($#lists != $#data); |
3852
|
0
|
|
|
|
|
|
for ($i=0; $i<=$#data; $i++) { |
3853
|
0
|
|
|
|
|
|
@ele=@{ $data[$i] }; |
|
0
|
|
|
|
|
|
|
3854
|
0
|
0
|
0
|
|
|
|
if ($Cnf{"IntCharSet"} && $#ele>0) { |
3855
|
0
|
|
|
|
|
|
@{ $lists[$i] } = @{ $ele[1] }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3856
|
|
|
|
|
|
|
} else { |
3857
|
0
|
|
|
|
|
|
@{ $lists[$i] } = @{ $ele[0] }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3858
|
|
|
|
|
|
|
} |
3859
|
|
|
|
|
|
|
} |
3860
|
|
|
|
|
|
|
} |
3861
|
|
|
|
|
|
|
|
3862
|
|
|
|
|
|
|
# Create the hash |
3863
|
0
|
|
|
|
|
|
my($hashtype,$hashsave,%hash)=(); |
3864
|
0
|
0
|
|
|
|
|
if (@$hash) { |
3865
|
0
|
|
|
|
|
|
($hash,$hashtype)=@$hash; |
3866
|
0
|
|
|
|
|
|
$hashsave=1; |
3867
|
|
|
|
|
|
|
} else { |
3868
|
0
|
|
|
|
|
|
$hashtype=0; |
3869
|
0
|
|
|
|
|
|
$hashsave=0; |
3870
|
|
|
|
|
|
|
} |
3871
|
0
|
|
|
|
|
|
for ($i=0; $i<=$#data; $i++) { |
3872
|
0
|
|
|
|
|
|
@ele=@{ $data[$i] }; |
|
0
|
|
|
|
|
|
|
3873
|
0
|
|
|
|
|
|
foreach $ele (@ele) { |
3874
|
0
|
|
|
|
|
|
@list = @{ $ele }; |
|
0
|
|
|
|
|
|
|
3875
|
0
|
|
|
|
|
|
for ($j=0; $j<=$#list; $j++) { |
3876
|
0
|
|
|
|
|
|
$tmp=$list[$j]; |
3877
|
0
|
0
|
|
|
|
|
next if (! $tmp); |
3878
|
0
|
0
|
|
|
|
|
$tmp=lc($tmp) if ($lc); |
3879
|
0
|
|
|
|
|
|
$hash{$tmp}= $j+$hashtype; |
3880
|
|
|
|
|
|
|
} |
3881
|
|
|
|
|
|
|
} |
3882
|
|
|
|
|
|
|
} |
3883
|
0
|
0
|
|
|
|
|
%$hash = %hash if ($hashsave); |
3884
|
|
|
|
|
|
|
|
3885
|
|
|
|
|
|
|
# Create the regular expression |
3886
|
0
|
0
|
|
|
|
|
if ($regexp) { |
3887
|
0
|
|
|
|
|
|
@list=keys(%hash); |
3888
|
0
|
0
|
|
|
|
|
@list=sort _sortByLength(@list) if ($sort); |
3889
|
0
|
0
|
|
|
|
|
if ($escape) { |
3890
|
0
|
|
|
|
|
|
foreach $ele (@list) { |
3891
|
0
|
|
|
|
|
|
$ele="\Q$ele\E"; |
3892
|
|
|
|
|
|
|
} |
3893
|
|
|
|
|
|
|
} |
3894
|
0
|
0
|
|
|
|
|
if ($back) { |
3895
|
0
|
|
|
|
|
|
$$regexp="(" . join("|",@list) . ")"; |
3896
|
|
|
|
|
|
|
} else { |
3897
|
0
|
|
|
|
|
|
$$regexp="(?:" . join("|",@list) . ")"; |
3898
|
|
|
|
|
|
|
} |
3899
|
|
|
|
|
|
|
} |
3900
|
|
|
|
|
|
|
} |
3901
|
|
|
|
|
|
|
|
3902
|
|
|
|
|
|
|
# This is used in Date_Init to fill in regular expressions and lists based |
3903
|
|
|
|
|
|
|
# on international data. This takes a list of strings and returns a regular |
3904
|
|
|
|
|
|
|
# expression (to find any one of them). |
3905
|
|
|
|
|
|
|
# |
3906
|
|
|
|
|
|
|
# IN: |
3907
|
|
|
|
|
|
|
# $data = [ string1 string2 ... ] |
3908
|
|
|
|
|
|
|
# $opts = lc : lowercase the values in the regexp |
3909
|
|
|
|
|
|
|
# sort : sort (by length) the values in the regexp |
3910
|
|
|
|
|
|
|
# back : create a regexp with a back reference |
3911
|
|
|
|
|
|
|
# escape : escape all strings in the regexp |
3912
|
|
|
|
|
|
|
# |
3913
|
|
|
|
|
|
|
# OUT: |
3914
|
|
|
|
|
|
|
# $regexp = '(string1|string2|...)' |
3915
|
|
|
|
|
|
|
|
3916
|
|
|
|
|
|
|
sub _Date_InitStrings { |
3917
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/); |
3918
|
0
|
|
|
|
|
|
my($data,$regexp,$opts)=@_; |
3919
|
0
|
|
|
|
|
|
my(@list)=@{ $data }; |
|
0
|
|
|
|
|
|
|
3920
|
|
|
|
|
|
|
|
3921
|
|
|
|
|
|
|
# Parse the options |
3922
|
0
|
|
|
|
|
|
my($lc,$sort,$back,$escape)=(0,0,0,0); |
3923
|
0
|
0
|
|
|
|
|
$lc=1 if ($opts =~ /lc/i); |
3924
|
0
|
0
|
|
|
|
|
$sort=1 if ($opts =~ /sort/i); |
3925
|
0
|
0
|
|
|
|
|
$back=1 if ($opts =~ /back/i); |
3926
|
0
|
0
|
|
|
|
|
$escape=1 if ($opts =~ /escape/i); |
3927
|
|
|
|
|
|
|
|
3928
|
|
|
|
|
|
|
# Create the regular expression |
3929
|
0
|
|
|
|
|
|
my($ele)=(); |
3930
|
0
|
0
|
|
|
|
|
@list=sort _sortByLength(@list) if ($sort); |
3931
|
0
|
0
|
|
|
|
|
if ($escape) { |
3932
|
0
|
|
|
|
|
|
foreach $ele (@list) { |
3933
|
0
|
|
|
|
|
|
$ele="\Q$ele\E"; |
3934
|
|
|
|
|
|
|
} |
3935
|
|
|
|
|
|
|
} |
3936
|
0
|
0
|
|
|
|
|
if ($back) { |
3937
|
0
|
|
|
|
|
|
$$regexp="(" . join("|",@list) . ")"; |
3938
|
|
|
|
|
|
|
} else { |
3939
|
0
|
|
|
|
|
|
$$regexp="(?:" . join("|",@list) . ")"; |
3940
|
|
|
|
|
|
|
} |
3941
|
0
|
0
|
|
|
|
|
$$regexp=lc($$regexp) if ($lc); |
3942
|
|
|
|
|
|
|
} |
3943
|
|
|
|
|
|
|
|
3944
|
|
|
|
|
|
|
# items is passed in (either as a space separated string, or a reference to |
3945
|
|
|
|
|
|
|
# a list) and a regular expression which matches any one of the items is |
3946
|
|
|
|
|
|
|
# prepared. The regular expression will be of one of the forms: |
3947
|
|
|
|
|
|
|
# "(a|b)" @list not empty, back option included |
3948
|
|
|
|
|
|
|
# "(?:a|b)" @list not empty |
3949
|
|
|
|
|
|
|
# "()" @list empty, back option included |
3950
|
|
|
|
|
|
|
# "" @list empty |
3951
|
|
|
|
|
|
|
# $options is a string which contains any of the following strings: |
3952
|
|
|
|
|
|
|
# back : the regular expression has a backreference |
3953
|
|
|
|
|
|
|
# opt : the regular expression is optional and a "?" is appended in |
3954
|
|
|
|
|
|
|
# the first two forms |
3955
|
|
|
|
|
|
|
# optws : the regular expression is optional and may be replaced by |
3956
|
|
|
|
|
|
|
# whitespace |
3957
|
|
|
|
|
|
|
# optWs : the regular expression is optional, but if not present, must |
3958
|
|
|
|
|
|
|
# be replaced by whitespace |
3959
|
|
|
|
|
|
|
# sort : the items in the list are sorted by length (longest first) |
3960
|
|
|
|
|
|
|
# lc : the string is lowercased |
3961
|
|
|
|
|
|
|
# under : any underscores are converted to spaces |
3962
|
|
|
|
|
|
|
# pre : it may be preceded by whitespace |
3963
|
|
|
|
|
|
|
# Pre : it must be preceded by whitespace |
3964
|
|
|
|
|
|
|
# PRE : it must be preceded by whitespace or the start |
3965
|
|
|
|
|
|
|
# post : it may be followed by whitespace |
3966
|
|
|
|
|
|
|
# Post : it must be followed by whitespace |
3967
|
|
|
|
|
|
|
# POST : it must be followed by whitespace or the end |
3968
|
|
|
|
|
|
|
# Spaces due to pre/post options will not be included in the back reference. |
3969
|
|
|
|
|
|
|
# |
3970
|
|
|
|
|
|
|
# If $array is included, then the elements will also be returned as a list. |
3971
|
|
|
|
|
|
|
# $array is a string which may contain any of the following: |
3972
|
|
|
|
|
|
|
# keys : treat the list as a hash and only the keys go into the regexp |
3973
|
|
|
|
|
|
|
# key0 : treat the list as the values of a hash with keys 0 .. N-1 |
3974
|
|
|
|
|
|
|
# key1 : treat the list as the values of a hash with keys 1 .. N |
3975
|
|
|
|
|
|
|
# val0 : treat the list as the keys of a hash with values 0 .. N-1 |
3976
|
|
|
|
|
|
|
# val1 : treat the list as the keys of a hash with values 1 .. N |
3977
|
|
|
|
|
|
|
|
3978
|
|
|
|
|
|
|
# _Date_InitLists([$lang{"month_name"},$lang{"month_abb"}], |
3979
|
|
|
|
|
|
|
# [\$Month,"lc,sort,back"], |
3980
|
|
|
|
|
|
|
# [\@Month,\@Mon], |
3981
|
|
|
|
|
|
|
# [\%Month,1]); |
3982
|
|
|
|
|
|
|
|
3983
|
|
|
|
|
|
|
# This is used in Date_Init to prepare regular expressions. A list of |
3984
|
|
|
|
|
|
|
# items is passed in (either as a space separated string, or a reference to |
3985
|
|
|
|
|
|
|
# a list) and a regular expression which matches any one of the items is |
3986
|
|
|
|
|
|
|
# prepared. The regular expression will be of one of the forms: |
3987
|
|
|
|
|
|
|
# "(a|b)" @list not empty, back option included |
3988
|
|
|
|
|
|
|
# "(?:a|b)" @list not empty |
3989
|
|
|
|
|
|
|
# "()" @list empty, back option included |
3990
|
|
|
|
|
|
|
# "" @list empty |
3991
|
|
|
|
|
|
|
# $options is a string which contains any of the following strings: |
3992
|
|
|
|
|
|
|
# back : the regular expression has a backreference |
3993
|
|
|
|
|
|
|
# opt : the regular expression is optional and a "?" is appended in |
3994
|
|
|
|
|
|
|
# the first two forms |
3995
|
|
|
|
|
|
|
# optws : the regular expression is optional and may be replaced by |
3996
|
|
|
|
|
|
|
# whitespace |
3997
|
|
|
|
|
|
|
# optWs : the regular expression is optional, but if not present, must |
3998
|
|
|
|
|
|
|
# be replaced by whitespace |
3999
|
|
|
|
|
|
|
# sort : the items in the list are sorted by length (longest first) |
4000
|
|
|
|
|
|
|
# lc : the string is lowercased |
4001
|
|
|
|
|
|
|
# under : any underscores are converted to spaces |
4002
|
|
|
|
|
|
|
# pre : it may be preceded by whitespace |
4003
|
|
|
|
|
|
|
# Pre : it must be preceded by whitespace |
4004
|
|
|
|
|
|
|
# PRE : it must be preceded by whitespace or the start |
4005
|
|
|
|
|
|
|
# post : it may be followed by whitespace |
4006
|
|
|
|
|
|
|
# Post : it must be followed by whitespace |
4007
|
|
|
|
|
|
|
# POST : it must be followed by whitespace or the end |
4008
|
|
|
|
|
|
|
# Spaces due to pre/post options will not be included in the back reference. |
4009
|
|
|
|
|
|
|
# |
4010
|
|
|
|
|
|
|
# If $array is included, then the elements will also be returned as a list. |
4011
|
|
|
|
|
|
|
# $array is a string which may contain any of the following: |
4012
|
|
|
|
|
|
|
# keys : treat the list as a hash and only the keys go into the regexp |
4013
|
|
|
|
|
|
|
# key0 : treat the list as the values of a hash with keys 0 .. N-1 |
4014
|
|
|
|
|
|
|
# key1 : treat the list as the values of a hash with keys 1 .. N |
4015
|
|
|
|
|
|
|
# val0 : treat the list as the keys of a hash with values 0 .. N-1 |
4016
|
|
|
|
|
|
|
# val1 : treat the list as the keys of a hash with values 1 .. N |
4017
|
|
|
|
|
|
|
sub _Date_Regexp { |
4018
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/); |
4019
|
0
|
|
|
|
|
|
my($list,$options,$array)=@_; |
4020
|
0
|
|
|
|
|
|
my(@list,$ret,%hash,$i)=(); |
4021
|
0
|
|
|
|
|
|
local($_)=(); |
4022
|
0
|
0
|
|
|
|
|
$options="" if (! defined $options); |
4023
|
0
|
0
|
|
|
|
|
$array="" if (! defined $array); |
4024
|
|
|
|
|
|
|
|
4025
|
0
|
|
|
|
|
|
my($sort,$lc,$under)=(0,0,0); |
4026
|
0
|
0
|
|
|
|
|
$sort =1 if ($options =~ /sort/i); |
4027
|
0
|
0
|
|
|
|
|
$lc =1 if ($options =~ /lc/i); |
4028
|
0
|
0
|
|
|
|
|
$under=1 if ($options =~ /under/i); |
4029
|
0
|
|
|
|
|
|
my($back,$opt,$pre,$post,$ws)=("?:","","","",""); |
4030
|
0
|
0
|
|
|
|
|
$back ="" if ($options =~ /back/i); |
4031
|
0
|
0
|
|
|
|
|
$opt ="?" if ($options =~ /opt/i); |
4032
|
0
|
0
|
|
|
|
|
$pre ='\s*' if ($options =~ /pre/); |
4033
|
0
|
0
|
|
|
|
|
$pre ='\s+' if ($options =~ /Pre/); |
4034
|
0
|
0
|
|
|
|
|
$pre ='(?:\s+|^)' if ($options =~ /PRE/); |
4035
|
0
|
0
|
|
|
|
|
$post ='\s*' if ($options =~ /post/); |
4036
|
0
|
0
|
|
|
|
|
$post ='\s+' if ($options =~ /Post/); |
4037
|
0
|
0
|
|
|
|
|
$post ='(?:$|\s+)' if ($options =~ /POST/); |
4038
|
0
|
0
|
|
|
|
|
$ws ='\s*' if ($options =~ /optws/); |
4039
|
0
|
0
|
|
|
|
|
$ws ='\s+' if ($options =~ /optws/); |
4040
|
|
|
|
|
|
|
|
4041
|
0
|
|
|
|
|
|
my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0); |
4042
|
0
|
0
|
|
|
|
|
$keys =1 if ($array =~ /keys/i); |
4043
|
0
|
0
|
|
|
|
|
$key0 =1 if ($array =~ /key0/i); |
4044
|
0
|
0
|
|
|
|
|
$key1 =1 if ($array =~ /key1/i); |
4045
|
0
|
0
|
|
|
|
|
$val0 =1 if ($array =~ /val0/i); |
4046
|
0
|
0
|
|
|
|
|
$val1 =1 if ($array =~ /val1/i); |
4047
|
0
|
0
|
0
|
|
|
|
$hash =1 if ($keys or $key0 or $key1 or $val0 or $val1); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
4048
|
|
|
|
|
|
|
|
4049
|
0
|
|
|
|
|
|
my($ref)=ref $list; |
4050
|
0
|
0
|
|
|
|
|
if (! $ref) { |
|
|
0
|
|
|
|
|
|
4051
|
0
|
|
|
|
|
|
$list =~ s/\s*$//; |
4052
|
0
|
|
|
|
|
|
$list =~ s/^\s*//; |
4053
|
0
|
|
|
|
|
|
$list =~ s/\s+/&&&/g; |
4054
|
|
|
|
|
|
|
} elsif ($ref eq "ARRAY") { |
4055
|
0
|
|
|
|
|
|
$list = join("&&&",@$list); |
4056
|
|
|
|
|
|
|
} else { |
4057
|
0
|
|
|
|
|
|
confess "ERROR: _Date_Regexp.\n"; |
4058
|
|
|
|
|
|
|
} |
4059
|
|
|
|
|
|
|
|
4060
|
0
|
0
|
|
|
|
|
if (! $list) { |
4061
|
0
|
0
|
|
|
|
|
if ($back eq "") { |
4062
|
0
|
|
|
|
|
|
return "()"; |
4063
|
|
|
|
|
|
|
} else { |
4064
|
0
|
|
|
|
|
|
return ""; |
4065
|
|
|
|
|
|
|
} |
4066
|
|
|
|
|
|
|
} |
4067
|
|
|
|
|
|
|
|
4068
|
0
|
0
|
|
|
|
|
$list=lc($list) if ($lc); |
4069
|
0
|
0
|
|
|
|
|
$list=~ s/_/ /g if ($under); |
4070
|
0
|
|
|
|
|
|
@list=split(/&&&/,$list); |
4071
|
0
|
0
|
0
|
|
|
|
if ($keys) { |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
4072
|
0
|
|
|
|
|
|
%hash=@list; |
4073
|
0
|
|
|
|
|
|
@list=keys %hash; |
4074
|
|
|
|
|
|
|
} elsif ($key0 or $key1 or $val0 or $val1) { |
4075
|
0
|
|
|
|
|
|
$i=0; |
4076
|
0
|
0
|
0
|
|
|
|
$i=1 if ($key1 or $val1); |
4077
|
0
|
0
|
0
|
|
|
|
if ($key0 or $key1) { |
4078
|
0
|
|
|
|
|
|
%hash= map { $_,$i++ } @list; |
|
0
|
|
|
|
|
|
|
4079
|
|
|
|
|
|
|
} else { |
4080
|
0
|
|
|
|
|
|
%hash= map { $i++,$_ } @list; |
|
0
|
|
|
|
|
|
|
4081
|
|
|
|
|
|
|
} |
4082
|
|
|
|
|
|
|
} |
4083
|
0
|
0
|
|
|
|
|
@list=sort _sortByLength(@list) if ($sort); |
4084
|
|
|
|
|
|
|
|
4085
|
0
|
|
|
|
|
|
$ret="($back" . join("|",@list) . ")"; |
4086
|
0
|
0
|
0
|
|
|
|
$ret="(?:$pre$ret$post)" if ($pre or $post); |
4087
|
0
|
|
|
|
|
|
$ret.=$opt; |
4088
|
0
|
0
|
|
|
|
|
$ret="(?:$ret|$ws)" if ($ws); |
4089
|
|
|
|
|
|
|
|
4090
|
0
|
0
|
0
|
|
|
|
if ($array and $hash) { |
|
|
0
|
|
|
|
|
|
4091
|
0
|
|
|
|
|
|
return ($ret,%hash); |
4092
|
|
|
|
|
|
|
} elsif ($array) { |
4093
|
0
|
|
|
|
|
|
return ($ret,@list); |
4094
|
|
|
|
|
|
|
} else { |
4095
|
0
|
|
|
|
|
|
return $ret; |
4096
|
|
|
|
|
|
|
} |
4097
|
|
|
|
|
|
|
} |
4098
|
|
|
|
|
|
|
|
4099
|
|
|
|
|
|
|
# This will produce a delta with the correct number of signs. At most two |
4100
|
|
|
|
|
|
|
# signs will be in it normally (one before the year, and one in front of |
4101
|
|
|
|
|
|
|
# the day), but if appropriate, signs will be in front of all elements. |
4102
|
|
|
|
|
|
|
# Also, as many of the signs will be equivalent as possible. |
4103
|
|
|
|
|
|
|
sub _Delta_Normalize { |
4104
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/); |
4105
|
0
|
|
|
|
|
|
my($delta,$mode)=@_; |
4106
|
0
|
0
|
|
|
|
|
return "" if (! $delta); |
4107
|
|
|
|
|
|
|
return "+0:+0:+0:+0:+0:+0:+0" |
4108
|
0
|
0
|
0
|
|
|
|
if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"}); |
4109
|
0
|
0
|
|
|
|
|
return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/); |
4110
|
|
|
|
|
|
|
|
4111
|
0
|
|
|
|
|
|
my($tmp,$sign1,$sign2,$len)=(); |
4112
|
|
|
|
|
|
|
|
4113
|
|
|
|
|
|
|
# Calculate the length of the day in minutes |
4114
|
0
|
|
|
|
|
|
$len=24*60; |
4115
|
0
|
0
|
0
|
|
|
|
$len=$Curr{"WDlen"} if ($mode==2 || $mode==3); |
4116
|
|
|
|
|
|
|
|
4117
|
|
|
|
|
|
|
# We have to get the sign of every component explicitely so that a "-0" |
4118
|
|
|
|
|
|
|
# or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must |
4119
|
|
|
|
|
|
|
# be a negative delta). |
4120
|
|
|
|
|
|
|
|
4121
|
0
|
|
|
|
|
|
my($y,$mon,$w,$d,$h,$m,$s)=_Delta_Split($delta); |
4122
|
|
|
|
|
|
|
|
4123
|
0
|
0
|
|
|
|
|
$y = 0 if (! $y); |
4124
|
0
|
0
|
|
|
|
|
$mon = 0 if (! $mon); |
4125
|
0
|
0
|
|
|
|
|
$w = 0 if (! $w); |
4126
|
0
|
0
|
|
|
|
|
$d = 0 if (! $d); |
4127
|
0
|
0
|
|
|
|
|
$h = 0 if (! $h); |
4128
|
0
|
0
|
|
|
|
|
$m = 0 if (! $m); |
4129
|
0
|
0
|
|
|
|
|
$s = 0 if (! $s); |
4130
|
|
|
|
|
|
|
|
4131
|
|
|
|
|
|
|
# We need to make sure that the signs of all parts of a delta are the |
4132
|
|
|
|
|
|
|
# same. The easiest way to do this is to convert all of the large |
4133
|
|
|
|
|
|
|
# components to the smallest ones, then convert the smaller components |
4134
|
|
|
|
|
|
|
# back to the larger ones. |
4135
|
|
|
|
|
|
|
|
4136
|
|
|
|
|
|
|
# Do the year/month part |
4137
|
|
|
|
|
|
|
|
4138
|
0
|
|
|
|
|
|
$mon += $y*12; # convert y to m |
4139
|
0
|
|
|
|
|
|
$sign1="+"; |
4140
|
0
|
0
|
|
|
|
|
if ($mon<0) { |
4141
|
0
|
|
|
|
|
|
$mon *= -1; |
4142
|
0
|
|
|
|
|
|
$sign1="-"; |
4143
|
|
|
|
|
|
|
} |
4144
|
|
|
|
|
|
|
|
4145
|
0
|
|
|
|
|
|
$y = $mon/12; # convert m to y |
4146
|
0
|
|
|
|
|
|
$mon -= $y*12; |
4147
|
|
|
|
|
|
|
|
4148
|
0
|
0
|
|
|
|
|
$y=0 if ($y eq "-0"); # get around silly -0 problem |
4149
|
0
|
0
|
|
|
|
|
$mon=0 if ($mon eq "-0"); |
4150
|
|
|
|
|
|
|
|
4151
|
|
|
|
|
|
|
# Do the wk/day/hour/min/sec part |
4152
|
|
|
|
|
|
|
|
4153
|
|
|
|
|
|
|
{ |
4154
|
|
|
|
|
|
|
# Unfortunately, $s is overflowing for dates more than ~70 years |
4155
|
|
|
|
|
|
|
# apart. |
4156
|
36
|
|
|
36
|
|
87662
|
no integer; |
|
36
|
|
|
|
|
94
|
|
|
36
|
|
|
|
|
177
|
|
|
0
|
|
|
|
|
|
|
4157
|
|
|
|
|
|
|
|
4158
|
0
|
0
|
0
|
|
|
|
if ($mode==3 || $mode==2) { |
4159
|
0
|
|
|
|
|
|
$s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s |
4160
|
|
|
|
|
|
|
} else { |
4161
|
0
|
|
|
|
|
|
$s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s |
4162
|
|
|
|
|
|
|
} |
4163
|
0
|
|
|
|
|
|
$sign2="+"; |
4164
|
0
|
0
|
|
|
|
|
if ($s<0) { |
4165
|
0
|
|
|
|
|
|
$s*=-1; |
4166
|
0
|
|
|
|
|
|
$sign2="-"; |
4167
|
|
|
|
|
|
|
} |
4168
|
|
|
|
|
|
|
|
4169
|
0
|
|
|
|
|
|
$m = int($s/60); # convert s to m |
4170
|
0
|
|
|
|
|
|
$s -= $m*60; |
4171
|
0
|
|
|
|
|
|
$d = int($m/$len); # convert m to d |
4172
|
0
|
|
|
|
|
|
$m -= $d*$len; |
4173
|
|
|
|
|
|
|
|
4174
|
|
|
|
|
|
|
# The rest should be fine. |
4175
|
|
|
|
|
|
|
} |
4176
|
0
|
|
|
|
|
|
$h = $m/60; # convert m to h |
4177
|
0
|
|
|
|
|
|
$m -= $h*60; |
4178
|
0
|
0
|
0
|
|
|
|
if ($mode == 3 || $mode == 2) { |
4179
|
0
|
|
|
|
|
|
$w = $w*1; # get around +0 problem |
4180
|
|
|
|
|
|
|
} else { |
4181
|
0
|
|
|
|
|
|
$w = $d/7; # convert d to w |
4182
|
0
|
|
|
|
|
|
$d -= $w*7; |
4183
|
|
|
|
|
|
|
} |
4184
|
|
|
|
|
|
|
|
4185
|
0
|
0
|
|
|
|
|
$w=0 if ($w eq "-0"); # get around silly -0 problem |
4186
|
0
|
0
|
|
|
|
|
$d=0 if ($d eq "-0"); |
4187
|
0
|
0
|
|
|
|
|
$h=0 if ($h eq "-0"); |
4188
|
0
|
0
|
|
|
|
|
$m=0 if ($m eq "-0"); |
4189
|
0
|
0
|
|
|
|
|
$s=0 if ($s eq "-0"); |
4190
|
|
|
|
|
|
|
|
4191
|
|
|
|
|
|
|
# Only include two signs if necessary |
4192
|
0
|
0
|
0
|
|
|
|
$sign1=$sign2 if ($y==0 and $mon==0); |
4193
|
0
|
0
|
0
|
|
|
|
$sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
4194
|
0
|
0
|
0
|
|
|
|
$sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"}); |
4195
|
|
|
|
|
|
|
|
4196
|
0
|
0
|
|
|
|
|
if ($Cnf{"DeltaSigns"}) { |
4197
|
0
|
|
|
|
|
|
return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s"; |
4198
|
|
|
|
|
|
|
} else { |
4199
|
0
|
|
|
|
|
|
return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s"; |
4200
|
|
|
|
|
|
|
} |
4201
|
|
|
|
|
|
|
} |
4202
|
|
|
|
|
|
|
|
4203
|
|
|
|
|
|
|
# This checks a delta to make sure it is valid. If it is, it splits |
4204
|
|
|
|
|
|
|
# it and returns the elements with a sign on each. The 2nd argument |
4205
|
|
|
|
|
|
|
# specifies the default sign. Blank elements are set to 0. If the |
4206
|
|
|
|
|
|
|
# third element is non-nil, exactly 7 elements must be included. |
4207
|
|
|
|
|
|
|
sub _Delta_Split { |
4208
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Delta_Split\n" if ($Curr{"Debug"} =~ /trace/); |
4209
|
0
|
|
|
|
|
|
my($delta,$sign,$exact)=@_; |
4210
|
0
|
|
|
|
|
|
my(@delta)=split(/:/,$delta); |
4211
|
0
|
0
|
0
|
|
|
|
return () if ($exact and $#delta != 6); |
4212
|
0
|
|
|
|
|
|
my($i)=(); |
4213
|
0
|
0
|
|
|
|
|
$sign="+" if (! defined $sign); |
4214
|
0
|
|
|
|
|
|
for ($i=0; $i<=$#delta; $i++) { |
4215
|
0
|
0
|
|
|
|
|
$delta[$i]="0" if (! $delta[$i]); |
4216
|
0
|
0
|
|
|
|
|
return () if ($delta[$i] !~ /^[+-]?\d+$/); |
4217
|
0
|
0
|
|
|
|
|
$sign = ($delta[$i] =~ s/^([+-])// ? $1 : $sign); |
4218
|
0
|
|
|
|
|
|
$delta[$i] = $sign.$delta[$i]; |
4219
|
|
|
|
|
|
|
} |
4220
|
0
|
|
|
|
|
|
@delta; |
4221
|
|
|
|
|
|
|
} |
4222
|
|
|
|
|
|
|
|
4223
|
|
|
|
|
|
|
# Reads up to 3 arguments. $h may contain the time in any international |
4224
|
|
|
|
|
|
|
# format. Any empty elements are set to 0. |
4225
|
|
|
|
|
|
|
sub _Date_ParseTime { |
4226
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/); |
4227
|
0
|
|
|
|
|
|
my($h,$m,$s)=@_; |
4228
|
0
|
|
|
|
|
|
my($t)=_CheckTime("one"); |
4229
|
|
|
|
|
|
|
|
4230
|
0
|
0
|
0
|
|
|
|
if (defined $h and $h =~ /$t/) { |
4231
|
0
|
|
|
|
|
|
$h=$1; |
4232
|
0
|
|
|
|
|
|
$m=$2; |
4233
|
0
|
0
|
|
|
|
|
$s=$3 if (defined $3); |
4234
|
|
|
|
|
|
|
} |
4235
|
0
|
0
|
|
|
|
|
$h="00" if (! defined $h); |
4236
|
0
|
0
|
|
|
|
|
$m="00" if (! defined $m); |
4237
|
0
|
0
|
|
|
|
|
$s="00" if (! defined $s); |
4238
|
|
|
|
|
|
|
|
4239
|
0
|
|
|
|
|
|
($h,$m,$s); |
4240
|
|
|
|
|
|
|
} |
4241
|
|
|
|
|
|
|
|
4242
|
|
|
|
|
|
|
# Forms a date with the 6 elements passed in (all of which must be defined). |
4243
|
|
|
|
|
|
|
# No check as to validity is made. |
4244
|
|
|
|
|
|
|
sub _Date_Join { |
4245
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Join\n" if ($Curr{"Debug"} =~ /trace/); |
4246
|
0
|
|
|
|
|
|
foreach (0 .. $#_) { |
4247
|
0
|
0
|
|
|
|
|
croak "undefined arg $_ to _Date_Join()" if not defined $_[$_]; |
4248
|
|
|
|
|
|
|
} |
4249
|
0
|
|
|
|
|
|
my($y,$m,$d,$h,$mn,$s)=@_; |
4250
|
0
|
|
|
|
|
|
my($ym,$md,$dh,$hmn,$mns)=(); |
4251
|
|
|
|
|
|
|
|
4252
|
0
|
0
|
|
|
|
|
if ($Cnf{"Internal"} == 0) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4253
|
0
|
|
|
|
|
|
$ym=$md=$dh=""; |
4254
|
0
|
|
|
|
|
|
$hmn=$mns=":"; |
4255
|
|
|
|
|
|
|
|
4256
|
|
|
|
|
|
|
} elsif ($Cnf{"Internal"} == 1) { |
4257
|
0
|
|
|
|
|
|
$ym=$md=$dh=$hmn=$mns=""; |
4258
|
|
|
|
|
|
|
|
4259
|
|
|
|
|
|
|
} elsif ($Cnf{"Internal"} == 2) { |
4260
|
0
|
|
|
|
|
|
$ym=$md="-"; |
4261
|
0
|
|
|
|
|
|
$dh=" "; |
4262
|
0
|
|
|
|
|
|
$hmn=$mns=":"; |
4263
|
|
|
|
|
|
|
|
4264
|
|
|
|
|
|
|
} else { |
4265
|
0
|
|
|
|
|
|
confess "ERROR: Invalid internal format in _Date_Join.\n"; |
4266
|
|
|
|
|
|
|
} |
4267
|
0
|
0
|
|
|
|
|
$m="0$m" if (length($m)==1); |
4268
|
0
|
0
|
|
|
|
|
$d="0$d" if (length($d)==1); |
4269
|
0
|
0
|
|
|
|
|
$h="0$h" if (length($h)==1); |
4270
|
0
|
0
|
|
|
|
|
$mn="0$mn" if (length($mn)==1); |
4271
|
0
|
0
|
|
|
|
|
$s="0$s" if (length($s)==1); |
4272
|
0
|
|
|
|
|
|
"$y$ym$m$md$d$dh$h$hmn$mn$mns$s"; |
4273
|
|
|
|
|
|
|
} |
4274
|
|
|
|
|
|
|
|
4275
|
|
|
|
|
|
|
# This checks a time. If it is valid, it splits it and returns 3 elements. |
4276
|
|
|
|
|
|
|
# If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is |
4277
|
|
|
|
|
|
|
# returned. |
4278
|
|
|
|
|
|
|
sub _CheckTime { |
4279
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _CheckTime\n" if ($Curr{"Debug"} =~ /trace/); |
4280
|
0
|
|
|
|
|
|
my($time)=@_; |
4281
|
0
|
|
|
|
|
|
my($h)='(?:0?[0-9]|1[0-9]|2[0-3])'; |
4282
|
0
|
|
|
|
|
|
my($h2)='(?:0[0-9]|1[0-9]|2[0-3])'; |
4283
|
0
|
|
|
|
|
|
my($m)='[0-5][0-9]'; |
4284
|
0
|
|
|
|
|
|
my($s)=$m; |
4285
|
0
|
|
|
|
|
|
my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)"; |
4286
|
0
|
|
|
|
|
|
my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)"; |
4287
|
0
|
|
|
|
|
|
my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"}; |
4288
|
0
|
|
|
|
|
|
my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$"; |
4289
|
0
|
0
|
|
|
|
|
if ($time eq "one") { |
|
|
0
|
|
|
|
|
|
4290
|
0
|
|
|
|
|
|
return $t; |
4291
|
|
|
|
|
|
|
} elsif ($time eq "two") { |
4292
|
0
|
|
|
|
|
|
$t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$"; |
4293
|
0
|
|
|
|
|
|
return $t; |
4294
|
|
|
|
|
|
|
} |
4295
|
|
|
|
|
|
|
|
4296
|
0
|
0
|
|
|
|
|
if ($time =~ /$t/i) { |
4297
|
0
|
|
|
|
|
|
($h,$m,$s)=($1,$2,$3); |
4298
|
0
|
0
|
|
|
|
|
$h="0$h" if (length($h)<2); |
4299
|
0
|
0
|
|
|
|
|
$m="0$m" if (length($m)<2); |
4300
|
0
|
0
|
|
|
|
|
$s="00" if (! defined $s); |
4301
|
0
|
|
|
|
|
|
return ($h,$m,$s); |
4302
|
|
|
|
|
|
|
} else { |
4303
|
0
|
|
|
|
|
|
return (); |
4304
|
|
|
|
|
|
|
} |
4305
|
|
|
|
|
|
|
} |
4306
|
|
|
|
|
|
|
|
4307
|
|
|
|
|
|
|
# This checks a recurrence. If it is valid, it splits it and returns the |
4308
|
|
|
|
|
|
|
# elements. Otherwise, it returns an empty list. |
4309
|
|
|
|
|
|
|
# ($recur0,$recur1,$flags,$dateb,$date0,$date1)=_Recur_Split($recur); |
4310
|
|
|
|
|
|
|
sub _Recur_Split { |
4311
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Recur_Split\n" if ($Curr{"Debug"} =~ /trace/); |
4312
|
0
|
|
|
|
|
|
my($recur)=@_; |
4313
|
0
|
|
|
|
|
|
my(@ret,@tmp); |
4314
|
|
|
|
|
|
|
|
4315
|
0
|
|
|
|
|
|
my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)'; |
4316
|
0
|
|
|
|
|
|
my($F) = '(?:\*([^*]*))'; |
4317
|
0
|
|
|
|
|
|
my($DB,$D0,$D1); |
4318
|
0
|
|
|
|
|
|
$DB=$D0=$D1=$F; |
4319
|
|
|
|
|
|
|
|
4320
|
0
|
0
|
|
|
|
|
if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) { |
4321
|
0
|
|
|
|
|
|
@ret=($1,$2,$3,$4,$5); |
4322
|
0
|
|
|
|
|
|
@tmp=split(/\*/,shift(@ret)); |
4323
|
0
|
0
|
|
|
|
|
return () if ($#tmp>1); |
4324
|
0
|
0
|
|
|
|
|
return (@tmp,"",@ret) if ($#tmp==0); |
4325
|
0
|
|
|
|
|
|
return (@tmp,@ret); |
4326
|
|
|
|
|
|
|
} |
4327
|
0
|
|
|
|
|
|
return (); |
4328
|
|
|
|
|
|
|
} |
4329
|
|
|
|
|
|
|
|
4330
|
|
|
|
|
|
|
# This checks a date. If it is valid, it splits it and returns the elements. |
4331
|
|
|
|
|
|
|
# |
4332
|
|
|
|
|
|
|
# The optional second argument says 'I really expect this to be a |
4333
|
|
|
|
|
|
|
# valid Date::Manip object, please throw an exception if it is not'. |
4334
|
|
|
|
|
|
|
# Otherwise, if the date passed in is undef or '', a regular |
4335
|
|
|
|
|
|
|
# expression for the date is returned; if the string is nonempty but |
4336
|
|
|
|
|
|
|
# still not valid, () is returned. |
4337
|
|
|
|
|
|
|
# |
4338
|
|
|
|
|
|
|
sub _Date_Split { |
4339
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Split\n" if ($Curr{"Debug"} =~ /trace/); |
4340
|
0
|
|
|
|
|
|
my($date, $definitely_valid)=@_; |
4341
|
0
|
0
|
|
|
|
|
$definitely_valid = 0 if not defined $definitely_valid; |
4342
|
0
|
|
|
|
|
|
my($ym,$md,$dh,$hmn,$mns)=(); |
4343
|
0
|
|
|
|
|
|
my($y)='(\d{4})'; |
4344
|
0
|
|
|
|
|
|
my($m)='(0[1-9]|1[0-2])'; |
4345
|
0
|
|
|
|
|
|
my($d)='(0[1-9]|[1-2][0-9]|3[0-1])'; |
4346
|
0
|
|
|
|
|
|
my($h)='([0-1][0-9]|2[0-3])'; |
4347
|
0
|
|
|
|
|
|
my($mn)='([0-5][0-9])'; |
4348
|
0
|
|
|
|
|
|
my($s)=$mn; |
4349
|
|
|
|
|
|
|
|
4350
|
0
|
0
|
|
|
|
|
if ($Cnf{"Internal"} == 0) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4351
|
0
|
|
|
|
|
|
$ym=$md=$dh=""; |
4352
|
0
|
|
|
|
|
|
$hmn=$mns=":"; |
4353
|
|
|
|
|
|
|
|
4354
|
|
|
|
|
|
|
} elsif ($Cnf{"Internal"} == 1) { |
4355
|
0
|
|
|
|
|
|
$ym=$md=$dh=$hmn=$mns=""; |
4356
|
|
|
|
|
|
|
|
4357
|
|
|
|
|
|
|
} elsif ($Cnf{"Internal"} == 2) { |
4358
|
0
|
|
|
|
|
|
$ym=$md="-"; |
4359
|
0
|
|
|
|
|
|
$dh=" "; |
4360
|
0
|
|
|
|
|
|
$hmn=$mns=":"; |
4361
|
|
|
|
|
|
|
|
4362
|
|
|
|
|
|
|
} else { |
4363
|
0
|
|
|
|
|
|
confess "ERROR: Invalid internal format in _Date_Split.\n"; |
4364
|
|
|
|
|
|
|
} |
4365
|
|
|
|
|
|
|
|
4366
|
0
|
|
|
|
|
|
my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$"; |
4367
|
|
|
|
|
|
|
|
4368
|
0
|
0
|
0
|
|
|
|
if (not defined $date or $date eq '') { |
4369
|
0
|
0
|
|
|
|
|
if ($definitely_valid) { |
4370
|
0
|
|
|
|
|
|
die "bad date '$date'"; |
4371
|
|
|
|
|
|
|
} else { |
4372
|
0
|
|
|
|
|
|
return $t; |
4373
|
|
|
|
|
|
|
} |
4374
|
|
|
|
|
|
|
} |
4375
|
|
|
|
|
|
|
|
4376
|
0
|
0
|
|
|
|
|
if ($date =~ /$t/) { |
4377
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6); |
4378
|
0
|
|
|
|
|
|
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
4379
|
0
|
0
|
|
|
|
|
$d_in_m[2]=29 if (Date_LeapYear($y)); |
4380
|
0
|
0
|
|
|
|
|
if ($d>$d_in_m[$m]) { |
4381
|
0
|
|
|
|
|
|
my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month"; |
4382
|
0
|
0
|
|
|
|
|
if ($definitely_valid) { |
4383
|
0
|
|
|
|
|
|
die $msg; |
4384
|
|
|
|
|
|
|
} |
4385
|
|
|
|
|
|
|
else { |
4386
|
0
|
|
|
|
|
|
warn $msg; |
4387
|
0
|
|
|
|
|
|
return (); |
4388
|
|
|
|
|
|
|
} |
4389
|
|
|
|
|
|
|
} |
4390
|
0
|
|
|
|
|
|
return ($y,$m,$d,$h,$mn,$s); |
4391
|
|
|
|
|
|
|
} |
4392
|
|
|
|
|
|
|
|
4393
|
0
|
0
|
|
|
|
|
if ($definitely_valid) { |
4394
|
0
|
|
|
|
|
|
die "invalid date $date: doesn't match regexp $t"; |
4395
|
|
|
|
|
|
|
} |
4396
|
0
|
|
|
|
|
|
return (); |
4397
|
|
|
|
|
|
|
} |
4398
|
|
|
|
|
|
|
|
4399
|
|
|
|
|
|
|
# This returns the date easter occurs on for a given year as ($month,$day). |
4400
|
|
|
|
|
|
|
# This is from the Calendar FAQ. |
4401
|
|
|
|
|
|
|
sub _Date_Easter { |
4402
|
0
|
|
|
0
|
|
|
my($y)=@_; |
4403
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)==2); |
4404
|
|
|
|
|
|
|
|
4405
|
0
|
|
|
|
|
|
my($c) = $y/100; |
4406
|
0
|
|
|
|
|
|
my($g) = $y % 19; |
4407
|
0
|
|
|
|
|
|
my($k) = ($c-17)/25; |
4408
|
0
|
|
|
|
|
|
my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30; |
4409
|
0
|
|
|
|
|
|
$i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11)); |
4410
|
0
|
|
|
|
|
|
my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7; |
4411
|
0
|
|
|
|
|
|
my($l) = $i-$j; |
4412
|
0
|
|
|
|
|
|
my($m) = 3 + ($l+40)/44; |
4413
|
0
|
|
|
|
|
|
my($d) = $l + 28 - 31*($m/4); |
4414
|
0
|
|
|
|
|
|
return ($m,$d); |
4415
|
|
|
|
|
|
|
} |
4416
|
|
|
|
|
|
|
|
4417
|
|
|
|
|
|
|
# This takes a list of years, months, WeekOfMonth's, and DayOfWeek's, and |
4418
|
|
|
|
|
|
|
# returns a list of dates. Optionally, a list of dates can be passed in as |
4419
|
|
|
|
|
|
|
# the 1st argument (with the 2nd argument the null list) and the year/month |
4420
|
|
|
|
|
|
|
# of these will be used. |
4421
|
|
|
|
|
|
|
sub _Date_Recur_WoM { |
4422
|
0
|
|
|
0
|
|
|
my($y,$m,$w,$d)=@_; |
4423
|
0
|
|
|
|
|
|
my(@y)=@$y; |
4424
|
0
|
|
|
|
|
|
my(@m)=@$m; |
4425
|
0
|
|
|
|
|
|
my(@w)=@$w; |
4426
|
0
|
|
|
|
|
|
my(@d)=@$d; |
4427
|
0
|
|
|
|
|
|
my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=(); |
4428
|
|
|
|
|
|
|
|
4429
|
0
|
0
|
|
|
|
|
if (@m) { |
4430
|
0
|
|
|
|
|
|
foreach $m (@m) { |
4431
|
0
|
0
|
|
|
|
|
return () if (! _IsInt($m,1,12)); |
4432
|
|
|
|
|
|
|
} |
4433
|
|
|
|
|
|
|
|
4434
|
0
|
|
|
|
|
|
@tmp=@tmp2=(); |
4435
|
0
|
|
|
|
|
|
foreach $y (@y) { |
4436
|
0
|
|
|
|
|
|
foreach $m (@m) { |
4437
|
0
|
|
|
|
|
|
push(@tmp,$y); |
4438
|
0
|
|
|
|
|
|
push(@tmp2,$m); |
4439
|
|
|
|
|
|
|
} |
4440
|
|
|
|
|
|
|
} |
4441
|
|
|
|
|
|
|
|
4442
|
0
|
|
|
|
|
|
@y=@tmp; |
4443
|
0
|
|
|
|
|
|
@m=@tmp2; |
4444
|
|
|
|
|
|
|
|
4445
|
|
|
|
|
|
|
} else { |
4446
|
0
|
|
|
|
|
|
foreach $d0 (@y) { |
4447
|
0
|
|
|
|
|
|
@tmp=_Date_Split($d0); |
4448
|
0
|
0
|
|
|
|
|
return () if (! @tmp); |
4449
|
0
|
|
|
|
|
|
push(@tmp2,$tmp[0]); |
4450
|
0
|
|
|
|
|
|
push(@m,$tmp[1]); |
4451
|
|
|
|
|
|
|
} |
4452
|
0
|
|
|
|
|
|
@y=@tmp2; |
4453
|
|
|
|
|
|
|
} |
4454
|
|
|
|
|
|
|
|
4455
|
0
|
0
|
|
|
|
|
return () if (! @w); |
4456
|
0
|
|
|
|
|
|
foreach $w (@w) { |
4457
|
0
|
0
|
0
|
|
|
|
return () if ($w==0 || ! _IsInt($w,-5,5)); |
4458
|
|
|
|
|
|
|
} |
4459
|
|
|
|
|
|
|
|
4460
|
0
|
0
|
|
|
|
|
if (@d) { |
4461
|
0
|
|
|
|
|
|
foreach $d (@d) { |
4462
|
0
|
0
|
0
|
|
|
|
return () if ($d==0 || ! _IsInt($d,-7,7)); |
4463
|
0
|
0
|
|
|
|
|
$d += 8 if ($d < 0); |
4464
|
|
|
|
|
|
|
} |
4465
|
|
|
|
|
|
|
} |
4466
|
|
|
|
|
|
|
|
4467
|
0
|
|
|
|
|
|
@date=(); |
4468
|
0
|
|
|
|
|
|
foreach $y (@y) { |
4469
|
0
|
|
|
|
|
|
$m=shift(@m); |
4470
|
|
|
|
|
|
|
|
4471
|
|
|
|
|
|
|
# Find 1st day of this month and next month |
4472
|
0
|
|
|
|
|
|
$date0=_Date_Join($y,$m,1,0,0,0); |
4473
|
0
|
|
|
|
|
|
$date1=_DateCalc_DateDelta($date0,"+0:1:0:0:0:0:0"); |
4474
|
|
|
|
|
|
|
|
4475
|
0
|
|
|
|
|
|
foreach $d (@d) { |
4476
|
|
|
|
|
|
|
# Find 1st occurrence of DOW (in both months) |
4477
|
0
|
|
|
|
|
|
$d0=Date_GetNext($date0,$d,1); |
4478
|
0
|
|
|
|
|
|
$d1=Date_GetNext($date1,$d,1); |
4479
|
|
|
|
|
|
|
|
4480
|
0
|
|
|
|
|
|
@tmp=(); |
4481
|
0
|
|
|
|
|
|
while (Date_Cmp($d0,$d1)<0) { |
4482
|
0
|
|
|
|
|
|
push(@tmp,$d0); |
4483
|
0
|
|
|
|
|
|
$d0=_DateCalc_DateDelta($d0,"+0:0:1:0:0:0:0"); |
4484
|
|
|
|
|
|
|
} |
4485
|
|
|
|
|
|
|
|
4486
|
0
|
|
|
|
|
|
@tmp2=(); |
4487
|
0
|
|
|
|
|
|
foreach $w (@w) { |
4488
|
0
|
0
|
|
|
|
|
if ($w>0) { |
4489
|
0
|
0
|
|
|
|
|
next if ($w > $#tmp+1); |
4490
|
0
|
|
|
|
|
|
push(@tmp2,$tmp[$w-1]); |
4491
|
|
|
|
|
|
|
} else { |
4492
|
0
|
0
|
|
|
|
|
next if (-$w > $#tmp+1); |
4493
|
0
|
|
|
|
|
|
push(@tmp2,$tmp[$#tmp+1+$w]); |
4494
|
|
|
|
|
|
|
} |
4495
|
|
|
|
|
|
|
} |
4496
|
0
|
|
|
|
|
|
@tmp2=sort { Date_Cmp($a,$b) } @tmp2; |
|
0
|
|
|
|
|
|
|
4497
|
0
|
|
|
|
|
|
push(@date,@tmp2); |
4498
|
|
|
|
|
|
|
} |
4499
|
|
|
|
|
|
|
} |
4500
|
|
|
|
|
|
|
|
4501
|
0
|
|
|
|
|
|
@date; |
4502
|
|
|
|
|
|
|
} |
4503
|
|
|
|
|
|
|
|
4504
|
|
|
|
|
|
|
# This returns a sorted list of dates formed by adding/subtracting |
4505
|
|
|
|
|
|
|
# $delta to $dateb in the range $date0<=$d<$dateb. The first date in |
4506
|
|
|
|
|
|
|
# the list is actually the first date<$date0 and the last date in the |
4507
|
|
|
|
|
|
|
# list is the first date>=$date1 (because sometimes the set part will |
4508
|
|
|
|
|
|
|
# move the date back into the range). |
4509
|
|
|
|
|
|
|
sub _Date_Recur { |
4510
|
0
|
|
|
0
|
|
|
my($date0,$date1,$dateb,$delta)=@_; |
4511
|
0
|
|
|
|
|
|
my(@ret,$d)=(); |
4512
|
|
|
|
|
|
|
|
4513
|
0
|
|
|
|
|
|
while (Date_Cmp($dateb,$date0)<0) { |
4514
|
0
|
|
|
|
|
|
$dateb=_DateCalc_DateDelta($dateb,$delta); |
4515
|
|
|
|
|
|
|
} |
4516
|
0
|
|
|
|
|
|
while (Date_Cmp($dateb,$date1)>=0) { |
4517
|
0
|
|
|
|
|
|
$dateb=_DateCalc_DateDelta($dateb,"-$delta"); |
4518
|
|
|
|
|
|
|
} |
4519
|
|
|
|
|
|
|
|
4520
|
|
|
|
|
|
|
# Add the dates $date0..$dateb |
4521
|
0
|
|
|
|
|
|
$d=$dateb; |
4522
|
0
|
|
|
|
|
|
while (Date_Cmp($d,$date0)>=0) { |
4523
|
0
|
|
|
|
|
|
unshift(@ret,$d); |
4524
|
0
|
|
|
|
|
|
$d=_DateCalc_DateDelta($d,"-$delta"); |
4525
|
|
|
|
|
|
|
} |
4526
|
|
|
|
|
|
|
# Add the first date earler than the range |
4527
|
0
|
|
|
|
|
|
unshift(@ret,$d); |
4528
|
|
|
|
|
|
|
|
4529
|
|
|
|
|
|
|
# Add the dates $dateb..$date1 |
4530
|
0
|
|
|
|
|
|
$d=_DateCalc_DateDelta($dateb,$delta); |
4531
|
0
|
|
|
|
|
|
while (Date_Cmp($d,$date1)<0) { |
4532
|
0
|
|
|
|
|
|
push(@ret,$d); |
4533
|
0
|
|
|
|
|
|
$d=_DateCalc_DateDelta($d,$delta); |
4534
|
|
|
|
|
|
|
} |
4535
|
|
|
|
|
|
|
# Add the first date later than the range |
4536
|
0
|
|
|
|
|
|
push(@ret,$d); |
4537
|
|
|
|
|
|
|
|
4538
|
0
|
|
|
|
|
|
@ret; |
4539
|
|
|
|
|
|
|
} |
4540
|
|
|
|
|
|
|
|
4541
|
|
|
|
|
|
|
# This sets the values in each date of a recurrence. |
4542
|
|
|
|
|
|
|
# |
4543
|
|
|
|
|
|
|
# $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1", |
4544
|
|
|
|
|
|
|
# they are not set (and none of the larger elements are set). |
4545
|
|
|
|
|
|
|
sub _Date_RecurSetTime { |
4546
|
0
|
|
|
0
|
|
|
my($date0,$date1,$dates,$h,$m,$s)=@_; |
4547
|
0
|
|
|
|
|
|
my(@dates)=@$dates; |
4548
|
0
|
|
|
|
|
|
my(@h,@m,@s,$date,@tmp)=(); |
4549
|
|
|
|
|
|
|
|
4550
|
0
|
0
|
|
|
|
|
$m="-1" if ($s eq "-1"); |
4551
|
0
|
0
|
|
|
|
|
$h="-1" if ($m eq "-1"); |
4552
|
|
|
|
|
|
|
|
4553
|
0
|
0
|
|
|
|
|
if ($h ne "-1") { |
4554
|
0
|
|
|
|
|
|
@h=_ReturnList($h); |
4555
|
0
|
0
|
|
|
|
|
return () if ! (@h); |
4556
|
0
|
|
|
|
|
|
@h=sort { $a<=>$b } (@h); |
|
0
|
|
|
|
|
|
|
4557
|
|
|
|
|
|
|
|
4558
|
0
|
|
|
|
|
|
@tmp=(); |
4559
|
0
|
|
|
|
|
|
foreach $date (@dates) { |
4560
|
0
|
|
|
|
|
|
foreach $h (@h) { |
4561
|
0
|
|
|
|
|
|
push(@tmp,Date_SetDateField($date,"h",$h,1)); |
4562
|
|
|
|
|
|
|
} |
4563
|
|
|
|
|
|
|
} |
4564
|
0
|
|
|
|
|
|
@dates=@tmp; |
4565
|
|
|
|
|
|
|
} |
4566
|
|
|
|
|
|
|
|
4567
|
0
|
0
|
|
|
|
|
if ($m ne "-1") { |
4568
|
0
|
|
|
|
|
|
@m=_ReturnList($m); |
4569
|
0
|
0
|
|
|
|
|
return () if ! (@m); |
4570
|
0
|
|
|
|
|
|
@m=sort { $a<=>$b } (@m); |
|
0
|
|
|
|
|
|
|
4571
|
|
|
|
|
|
|
|
4572
|
0
|
|
|
|
|
|
@tmp=(); |
4573
|
0
|
|
|
|
|
|
foreach $date (@dates) { |
4574
|
0
|
|
|
|
|
|
foreach $m (@m) { |
4575
|
0
|
|
|
|
|
|
push(@tmp,Date_SetDateField($date,"mn",$m,1)); |
4576
|
|
|
|
|
|
|
} |
4577
|
|
|
|
|
|
|
} |
4578
|
0
|
|
|
|
|
|
@dates=@tmp; |
4579
|
|
|
|
|
|
|
} |
4580
|
|
|
|
|
|
|
|
4581
|
0
|
0
|
|
|
|
|
if ($s ne "-1") { |
4582
|
0
|
|
|
|
|
|
@s=_ReturnList($s); |
4583
|
0
|
0
|
|
|
|
|
return () if ! (@s); |
4584
|
0
|
|
|
|
|
|
@s=sort { $a<=>$b } (@s); |
|
0
|
|
|
|
|
|
|
4585
|
|
|
|
|
|
|
|
4586
|
0
|
|
|
|
|
|
@tmp=(); |
4587
|
0
|
|
|
|
|
|
foreach $date (@dates) { |
4588
|
0
|
|
|
|
|
|
foreach $s (@s) { |
4589
|
0
|
|
|
|
|
|
push(@tmp,Date_SetDateField($date,"s",$s,1)); |
4590
|
|
|
|
|
|
|
} |
4591
|
|
|
|
|
|
|
} |
4592
|
0
|
|
|
|
|
|
@dates=@tmp; |
4593
|
|
|
|
|
|
|
} |
4594
|
|
|
|
|
|
|
|
4595
|
0
|
|
|
|
|
|
@tmp=(); |
4596
|
0
|
|
|
|
|
|
foreach $date (@dates) { |
4597
|
0
|
0
|
0
|
|
|
|
push(@tmp,$date) if (Date_Cmp($date,$date0)>=0 && |
|
|
|
0
|
|
|
|
|
4598
|
|
|
|
|
|
|
Date_Cmp($date,$date1)<0 && |
4599
|
|
|
|
|
|
|
_Date_Split($date)); |
4600
|
|
|
|
|
|
|
} |
4601
|
|
|
|
|
|
|
|
4602
|
0
|
|
|
|
|
|
@tmp; |
4603
|
|
|
|
|
|
|
} |
4604
|
|
|
|
|
|
|
|
4605
|
|
|
|
|
|
|
sub _DateCalc_DateDate { |
4606
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/); |
4607
|
0
|
|
|
|
|
|
my($D1,$D2,$mode)=@_; |
4608
|
0
|
|
|
|
|
|
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
4609
|
0
|
0
|
|
|
|
|
$mode=0 if (! defined $mode); |
4610
|
|
|
|
|
|
|
|
4611
|
|
|
|
|
|
|
# Exact mode |
4612
|
0
|
0
|
|
|
|
|
if ($mode==0) { |
4613
|
0
|
|
|
|
|
|
my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($D1, 1); |
4614
|
0
|
|
|
|
|
|
my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($D2, 1); |
4615
|
0
|
|
|
|
|
|
my($i,@delta,$d,$delta,$y)=(); |
4616
|
|
|
|
|
|
|
|
4617
|
|
|
|
|
|
|
# form the delta for hour/min/sec |
4618
|
0
|
|
|
|
|
|
$delta[4]=$h2-$h1; |
4619
|
0
|
|
|
|
|
|
$delta[5]=$mn2-$mn1; |
4620
|
0
|
|
|
|
|
|
$delta[6]=$s2-$s1; |
4621
|
|
|
|
|
|
|
|
4622
|
|
|
|
|
|
|
# form the delta for yr/mon/day |
4623
|
0
|
|
|
|
|
|
$delta[0]=$delta[1]=0; |
4624
|
0
|
|
|
|
|
|
$d=0; |
4625
|
0
|
0
|
|
|
|
|
if ($y2>$y1) { |
|
|
0
|
|
|
|
|
|
4626
|
0
|
|
|
|
|
|
$d=Date_DaysInYear($y1) - Date_DayOfYear($m1,$d1,$y1); |
4627
|
0
|
|
|
|
|
|
$d+=Date_DayOfYear($m2,$d2,$y2); |
4628
|
0
|
|
|
|
|
|
for ($y=$y1+1; $y<$y2; $y++) { |
4629
|
0
|
|
|
|
|
|
$d+= Date_DaysInYear($y); |
4630
|
|
|
|
|
|
|
} |
4631
|
|
|
|
|
|
|
} elsif ($y2<$y1) { |
4632
|
0
|
|
|
|
|
|
$d=Date_DaysInYear($y2) - Date_DayOfYear($m2,$d2,$y2); |
4633
|
0
|
|
|
|
|
|
$d+=Date_DayOfYear($m1,$d1,$y1); |
4634
|
0
|
|
|
|
|
|
for ($y=$y2+1; $y<$y1; $y++) { |
4635
|
0
|
|
|
|
|
|
$d+= Date_DaysInYear($y); |
4636
|
|
|
|
|
|
|
} |
4637
|
0
|
|
|
|
|
|
$d *= -1; |
4638
|
|
|
|
|
|
|
} else { |
4639
|
0
|
|
|
|
|
|
$d=Date_DayOfYear($m2,$d2,$y2) - Date_DayOfYear($m1,$d1,$y1); |
4640
|
|
|
|
|
|
|
} |
4641
|
0
|
|
|
|
|
|
$delta[2]=0; |
4642
|
0
|
|
|
|
|
|
$delta[3]=$d; |
4643
|
|
|
|
|
|
|
|
4644
|
0
|
|
|
|
|
|
for ($i=0; $i<7; $i++) { |
4645
|
0
|
0
|
|
|
|
|
$delta[$i]="+".$delta[$i] if ($delta[$i]>=0); |
4646
|
|
|
|
|
|
|
} |
4647
|
|
|
|
|
|
|
|
4648
|
0
|
|
|
|
|
|
$delta=join(":",@delta); |
4649
|
0
|
|
|
|
|
|
$delta=_Delta_Normalize($delta,0); |
4650
|
0
|
|
|
|
|
|
return $delta; |
4651
|
|
|
|
|
|
|
} |
4652
|
|
|
|
|
|
|
|
4653
|
0
|
|
|
|
|
|
my($date1,$date2)=($D1,$D2); |
4654
|
0
|
|
|
|
|
|
my($tmp,$sign,$err,@tmp)=(); |
4655
|
|
|
|
|
|
|
|
4656
|
|
|
|
|
|
|
# make sure both are work days |
4657
|
0
|
0
|
0
|
|
|
|
if ($mode==2 || $mode==3) { |
4658
|
0
|
|
|
|
|
|
$date1=Date_NextWorkDay($date1,0,1); |
4659
|
0
|
|
|
|
|
|
$date2=Date_NextWorkDay($date2,0,1); |
4660
|
|
|
|
|
|
|
} |
4661
|
|
|
|
|
|
|
|
4662
|
|
|
|
|
|
|
# make sure date1 comes before date2 |
4663
|
0
|
0
|
|
|
|
|
if (Date_Cmp($date1,$date2)>0) { |
4664
|
0
|
|
|
|
|
|
$sign="-"; |
4665
|
0
|
|
|
|
|
|
$tmp=$date1; |
4666
|
0
|
|
|
|
|
|
$date1=$date2; |
4667
|
0
|
|
|
|
|
|
$date2=$tmp; |
4668
|
|
|
|
|
|
|
} else { |
4669
|
0
|
|
|
|
|
|
$sign="+"; |
4670
|
|
|
|
|
|
|
} |
4671
|
0
|
0
|
|
|
|
|
if (Date_Cmp($date1,$date2)==0) { |
4672
|
0
|
0
|
|
|
|
|
return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"}); |
4673
|
0
|
|
|
|
|
|
return "+0:0:0:0:0:0:0"; |
4674
|
|
|
|
|
|
|
} |
4675
|
|
|
|
|
|
|
|
4676
|
0
|
|
|
|
|
|
my($y1,$m1,$d1,$h1,$mn1,$s1)=_Date_Split($date1, 1); |
4677
|
0
|
|
|
|
|
|
my($y2,$m2,$d2,$h2,$mn2,$s2)=_Date_Split($date2, 1); |
4678
|
0
|
|
|
|
|
|
my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0); |
4679
|
|
|
|
|
|
|
|
4680
|
0
|
0
|
|
|
|
|
if ($mode != 3) { |
4681
|
|
|
|
|
|
|
|
4682
|
|
|
|
|
|
|
# Do years |
4683
|
0
|
|
|
|
|
|
$dy=$y2-$y1; |
4684
|
0
|
|
|
|
|
|
$dm=0; |
4685
|
0
|
0
|
|
|
|
|
if ($dy>0) { |
4686
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0); |
4687
|
0
|
0
|
|
|
|
|
if (Date_Cmp($tmp,$date2)>0) { |
4688
|
0
|
|
|
|
|
|
$dy--; |
4689
|
0
|
|
|
|
|
|
$tmp=$date1; |
4690
|
0
|
0
|
|
|
|
|
$tmp=_DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0) |
4691
|
|
|
|
|
|
|
if ($dy>0); |
4692
|
0
|
|
|
|
|
|
$dm=12; |
4693
|
|
|
|
|
|
|
} |
4694
|
0
|
|
|
|
|
|
$date1=$tmp; |
4695
|
|
|
|
|
|
|
} |
4696
|
|
|
|
|
|
|
|
4697
|
|
|
|
|
|
|
# Do months |
4698
|
0
|
|
|
|
|
|
$dm+=$m2-$m1; |
4699
|
0
|
0
|
|
|
|
|
if ($dm>0) { |
4700
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0); |
4701
|
0
|
0
|
|
|
|
|
if (Date_Cmp($tmp,$date2)>0) { |
4702
|
0
|
|
|
|
|
|
$dm--; |
4703
|
0
|
|
|
|
|
|
$tmp=$date1; |
4704
|
0
|
0
|
|
|
|
|
$tmp=_DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0) |
4705
|
|
|
|
|
|
|
if ($dm>0); |
4706
|
|
|
|
|
|
|
} |
4707
|
0
|
|
|
|
|
|
$date1=$tmp; |
4708
|
|
|
|
|
|
|
} |
4709
|
|
|
|
|
|
|
|
4710
|
|
|
|
|
|
|
# At this point, check to see that we're on a business day again so that |
4711
|
|
|
|
|
|
|
# Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month |
4712
|
0
|
0
|
|
|
|
|
if ($mode==2) { |
4713
|
0
|
0
|
|
|
|
|
if (! Date_IsWorkDay($date1,0)) { |
4714
|
0
|
|
|
|
|
|
$date1=Date_NextWorkDay($date1,0,1); |
4715
|
|
|
|
|
|
|
} |
4716
|
|
|
|
|
|
|
} |
4717
|
|
|
|
|
|
|
} |
4718
|
|
|
|
|
|
|
|
4719
|
|
|
|
|
|
|
# Do days |
4720
|
0
|
0
|
0
|
|
|
|
if ($mode==2 || $mode==3) { |
4721
|
0
|
|
|
|
|
|
$dd=0; |
4722
|
0
|
|
|
|
|
|
while (1) { |
4723
|
0
|
|
|
|
|
|
$tmp=Date_NextWorkDay($date1,1,1); |
4724
|
0
|
0
|
|
|
|
|
if (Date_Cmp($tmp,$date2)<=0) { |
4725
|
0
|
|
|
|
|
|
$dd++; |
4726
|
0
|
|
|
|
|
|
$date1=$tmp; |
4727
|
|
|
|
|
|
|
} else { |
4728
|
0
|
|
|
|
|
|
last; |
4729
|
|
|
|
|
|
|
} |
4730
|
|
|
|
|
|
|
} |
4731
|
|
|
|
|
|
|
|
4732
|
|
|
|
|
|
|
} else { |
4733
|
0
|
|
|
|
|
|
($y1,$m1,$d1)=( _Date_Split($date1, 1) )[0..2]; |
4734
|
0
|
|
|
|
|
|
$dd=0; |
4735
|
|
|
|
|
|
|
# If we're jumping across months, set $d1 to the first of the next month |
4736
|
|
|
|
|
|
|
# (or possibly the 0th of next month which is equivalent to the last day |
4737
|
|
|
|
|
|
|
# of this month) |
4738
|
0
|
0
|
|
|
|
|
if ($m1!=$m2) { |
4739
|
0
|
0
|
|
|
|
|
$d_in_m[2]=29 if (Date_LeapYear($y1)); |
4740
|
0
|
|
|
|
|
|
$dd=$d_in_m[$m1]-$d1+1; |
4741
|
0
|
|
|
|
|
|
$d1=1; |
4742
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0); |
4743
|
0
|
0
|
|
|
|
|
if (Date_Cmp($tmp,$date2)>0) { |
4744
|
0
|
|
|
|
|
|
$dd--; |
4745
|
0
|
|
|
|
|
|
$d1--; |
4746
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0); |
4747
|
|
|
|
|
|
|
} |
4748
|
0
|
|
|
|
|
|
$date1=$tmp; |
4749
|
|
|
|
|
|
|
} |
4750
|
|
|
|
|
|
|
|
4751
|
0
|
|
|
|
|
|
$ddd=0; |
4752
|
0
|
0
|
|
|
|
|
if ($d1<$d2) { |
4753
|
0
|
|
|
|
|
|
$ddd=$d2-$d1; |
4754
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0); |
4755
|
0
|
0
|
|
|
|
|
if (Date_Cmp($tmp,$date2)>0) { |
4756
|
0
|
|
|
|
|
|
$ddd--; |
4757
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0); |
4758
|
|
|
|
|
|
|
} |
4759
|
0
|
|
|
|
|
|
$date1=$tmp; |
4760
|
|
|
|
|
|
|
} |
4761
|
0
|
|
|
|
|
|
$dd+=$ddd; |
4762
|
|
|
|
|
|
|
} |
4763
|
|
|
|
|
|
|
|
4764
|
|
|
|
|
|
|
# in business mode, make sure h1 comes before h2 (if not find delta between |
4765
|
|
|
|
|
|
|
# now and end of day and move to start of next business day) |
4766
|
0
|
|
|
|
|
|
$d1=( _Date_Split($date1, 1) )[2]; |
4767
|
0
|
|
|
|
|
|
$dh=$dmn=$ds=0; |
4768
|
0
|
0
|
0
|
|
|
|
if ($mode==2 || $mode==3 and $d1 != $d2) { |
|
|
|
0
|
|
|
|
|
4769
|
0
|
|
|
|
|
|
$tmp=Date_SetTime($date1,$Cnf{"WorkDayEnd"}); |
4770
|
|
|
|
|
|
|
$tmp=_DateCalc_DateDelta($tmp,"+0:0:0:0:0:1:0") |
4771
|
0
|
0
|
|
|
|
|
if ($Cnf{"WorkDay24Hr"}); |
4772
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDate($date1,$tmp,0); |
4773
|
0
|
|
|
|
|
|
($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=_Delta_Split($tmp); |
4774
|
0
|
|
|
|
|
|
$date1=Date_NextWorkDay($date1,1,0); |
4775
|
0
|
|
|
|
|
|
$date1=Date_SetTime($date1,$Cnf{"WorkDayBeg"}); |
4776
|
0
|
|
|
|
|
|
$d1=( _Date_Split($date1, 1) )[2]; |
4777
|
0
|
0
|
|
|
|
|
confess "ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2); |
4778
|
|
|
|
|
|
|
} |
4779
|
|
|
|
|
|
|
|
4780
|
|
|
|
|
|
|
# Hours, minutes, seconds |
4781
|
0
|
|
|
|
|
|
$tmp=_DateCalc_DateDate($date1,$date2,0); |
4782
|
0
|
|
|
|
|
|
@tmp=_Delta_Split($tmp); |
4783
|
0
|
|
|
|
|
|
$dh += $tmp[4]; |
4784
|
0
|
|
|
|
|
|
$dmn += $tmp[5]; |
4785
|
0
|
|
|
|
|
|
$ds += $tmp[6]; |
4786
|
|
|
|
|
|
|
|
4787
|
0
|
|
|
|
|
|
$tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds"; |
4788
|
0
|
|
|
|
|
|
_Delta_Normalize($tmp,$mode); |
4789
|
|
|
|
|
|
|
} |
4790
|
|
|
|
|
|
|
|
4791
|
|
|
|
|
|
|
sub _DateCalc_DeltaDelta { |
4792
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/); |
4793
|
0
|
|
|
|
|
|
my($D1,$D2,$mode)=@_; |
4794
|
0
|
|
|
|
|
|
my(@delta1,@delta2,$i,$delta,@delta)=(); |
4795
|
0
|
0
|
|
|
|
|
$mode=0 if (! defined $mode); |
4796
|
|
|
|
|
|
|
|
4797
|
0
|
|
|
|
|
|
@delta1=_Delta_Split($D1); |
4798
|
0
|
|
|
|
|
|
@delta2=_Delta_Split($D2); |
4799
|
0
|
|
|
|
|
|
for ($i=0; $i<7; $i++) { |
4800
|
0
|
|
|
|
|
|
$delta[$i]=$delta1[$i]+$delta2[$i]; |
4801
|
0
|
0
|
|
|
|
|
$delta[$i]="+".$delta[$i] if ($delta[$i]>=0); |
4802
|
|
|
|
|
|
|
} |
4803
|
|
|
|
|
|
|
|
4804
|
0
|
|
|
|
|
|
$delta=join(":",@delta); |
4805
|
0
|
|
|
|
|
|
$delta=_Delta_Normalize($delta,$mode); |
4806
|
0
|
|
|
|
|
|
return $delta; |
4807
|
|
|
|
|
|
|
} |
4808
|
|
|
|
|
|
|
|
4809
|
|
|
|
|
|
|
sub _DateCalc_DateDelta { |
4810
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/); |
4811
|
0
|
|
|
|
|
|
my($D1,$D2,$errref,$mode)=@_; |
4812
|
0
|
|
|
|
|
|
my($date)=(); |
4813
|
0
|
|
|
|
|
|
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
4814
|
0
|
|
|
|
|
|
my($h1,$m1,$h2,$m2,$len,$hh,$mm)=(); |
4815
|
0
|
0
|
|
|
|
|
$mode=0 if (! defined $mode); |
4816
|
|
|
|
|
|
|
|
4817
|
0
|
0
|
0
|
|
|
|
if ($mode==2 || $mode==3) { |
4818
|
0
|
|
|
|
|
|
$h1=$Curr{"WDBh"}; |
4819
|
0
|
|
|
|
|
|
$m1=$Curr{"WDBm"}; |
4820
|
0
|
|
|
|
|
|
$h2=$Curr{"WDEh"}; |
4821
|
0
|
|
|
|
|
|
$m2=$Curr{"WDEm"}; |
4822
|
0
|
|
|
|
|
|
$hh=$h2-$h1; |
4823
|
0
|
|
|
|
|
|
$mm=$m2-$m1; |
4824
|
0
|
0
|
|
|
|
|
if ($mm<0) { |
4825
|
0
|
|
|
|
|
|
$hh--; |
4826
|
0
|
|
|
|
|
|
$mm+=60; |
4827
|
|
|
|
|
|
|
} |
4828
|
|
|
|
|
|
|
} |
4829
|
|
|
|
|
|
|
|
4830
|
|
|
|
|
|
|
# Date, delta |
4831
|
0
|
|
|
|
|
|
my($y,$m,$d,$h,$mn,$s)=_Date_Split($D1, 1); |
4832
|
0
|
|
|
|
|
|
my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=_Delta_Split($D2); |
4833
|
|
|
|
|
|
|
|
4834
|
|
|
|
|
|
|
# do the month/year part |
4835
|
0
|
|
|
|
|
|
$y+=$dy; |
4836
|
0
|
|
|
|
|
|
while (length($y)<4) { |
4837
|
0
|
|
|
|
|
|
$y = "0$y"; |
4838
|
|
|
|
|
|
|
} |
4839
|
0
|
|
|
|
|
|
_ModuloAddition(-12,$dm,\$m,\$y); # -12 means 1-12 instead of 0-11 |
4840
|
0
|
0
|
|
|
|
|
$d_in_m[2]=29 if (Date_LeapYear($y)); |
4841
|
|
|
|
|
|
|
|
4842
|
|
|
|
|
|
|
# if we have gone past the last day of a month, move the date back to |
4843
|
|
|
|
|
|
|
# the last day of the month |
4844
|
0
|
0
|
|
|
|
|
if ($d>$d_in_m[$m]) { |
4845
|
0
|
|
|
|
|
|
$d=$d_in_m[$m]; |
4846
|
|
|
|
|
|
|
} |
4847
|
|
|
|
|
|
|
|
4848
|
|
|
|
|
|
|
# do the week part |
4849
|
0
|
0
|
0
|
|
|
|
if ($mode==0 || $mode==1) { |
4850
|
0
|
|
|
|
|
|
$dd += $dw*7; |
4851
|
|
|
|
|
|
|
} else { |
4852
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta(_Date_Join($y,$m,$d,$h,$mn,$s), |
4853
|
|
|
|
|
|
|
"+0:0:$dw:0:0:0:0",0); |
4854
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1); |
4855
|
|
|
|
|
|
|
} |
4856
|
|
|
|
|
|
|
|
4857
|
|
|
|
|
|
|
# in business mode, set the day to a work day at this point so the h/mn/s |
4858
|
|
|
|
|
|
|
# stuff will work out |
4859
|
0
|
0
|
0
|
|
|
|
if ($mode==2 || $mode==3) { |
4860
|
0
|
0
|
|
|
|
|
$d=$d_in_m[$m] if ($d>$d_in_m[$m]); |
4861
|
0
|
|
|
|
|
|
$date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),0,1); |
4862
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1); |
4863
|
|
|
|
|
|
|
} |
4864
|
|
|
|
|
|
|
|
4865
|
|
|
|
|
|
|
# seconds, minutes, hours |
4866
|
0
|
|
|
|
|
|
_ModuloAddition(60,$ds,\$s,\$mn); |
4867
|
0
|
0
|
0
|
|
|
|
if ($mode==2 || $mode==3) { |
4868
|
0
|
|
|
|
|
|
while (1) { |
4869
|
0
|
|
|
|
|
|
_ModuloAddition(60,$dmn,\$mn,\$h); |
4870
|
0
|
|
|
|
|
|
$dmn=0; |
4871
|
0
|
|
|
|
|
|
$h+= $dh; |
4872
|
|
|
|
|
|
|
|
4873
|
0
|
0
|
0
|
|
|
|
if ($h>$h2 or $h==$h2 && $mn>$m2) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
4874
|
0
|
|
|
|
|
|
$dh=$h-$h2; |
4875
|
0
|
|
|
|
|
|
$dmn=$mn-$m2; |
4876
|
0
|
|
|
|
|
|
$h=$h1; |
4877
|
0
|
|
|
|
|
|
$mn=$m1; |
4878
|
0
|
|
|
|
|
|
$dd++; |
4879
|
|
|
|
|
|
|
|
4880
|
|
|
|
|
|
|
} elsif ($h<$h1 or $h==$h1 && $mn<$m1) { |
4881
|
0
|
|
|
|
|
|
$dh=$h-$h1; |
4882
|
|
|
|
|
|
|
#$dmn=$m1-$mn; |
4883
|
0
|
|
|
|
|
|
$h=$h2; |
4884
|
|
|
|
|
|
|
#$mn=$m2; |
4885
|
0
|
|
|
|
|
|
$dd--; |
4886
|
|
|
|
|
|
|
|
4887
|
|
|
|
|
|
|
} elsif ($h==$h2 && $mn==$m2) { |
4888
|
0
|
|
|
|
|
|
$dd++; |
4889
|
0
|
|
|
|
|
|
$dh=-$hh; |
4890
|
0
|
|
|
|
|
|
$dmn=-$mm; |
4891
|
|
|
|
|
|
|
|
4892
|
|
|
|
|
|
|
} else { |
4893
|
0
|
|
|
|
|
|
last; |
4894
|
|
|
|
|
|
|
} |
4895
|
|
|
|
|
|
|
} |
4896
|
|
|
|
|
|
|
|
4897
|
|
|
|
|
|
|
} else { |
4898
|
0
|
|
|
|
|
|
_ModuloAddition(60,$dmn,\$mn,\$h); |
4899
|
0
|
|
|
|
|
|
_ModuloAddition(24,$dh,\$h,\$d); |
4900
|
|
|
|
|
|
|
} |
4901
|
|
|
|
|
|
|
|
4902
|
|
|
|
|
|
|
# If we have just gone past the last day of the month, we need to make |
4903
|
|
|
|
|
|
|
# up for this: |
4904
|
0
|
0
|
|
|
|
|
if ($d>$d_in_m[$m]) { |
4905
|
0
|
|
|
|
|
|
$dd+= $d-$d_in_m[$m]; |
4906
|
0
|
|
|
|
|
|
$d=$d_in_m[$m]; |
4907
|
|
|
|
|
|
|
} |
4908
|
|
|
|
|
|
|
|
4909
|
|
|
|
|
|
|
# days |
4910
|
0
|
0
|
0
|
|
|
|
if ($mode==2 || $mode==3) { |
4911
|
0
|
0
|
|
|
|
|
if ($dd>=0) { |
4912
|
0
|
|
|
|
|
|
$date=Date_NextWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),$dd,1); |
4913
|
|
|
|
|
|
|
} else { |
4914
|
0
|
|
|
|
|
|
$date=Date_PrevWorkDay(_Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1); |
4915
|
|
|
|
|
|
|
} |
4916
|
0
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s)=_Date_Split($date, 1); |
4917
|
|
|
|
|
|
|
|
4918
|
|
|
|
|
|
|
} else { |
4919
|
0
|
0
|
|
|
|
|
$d_in_m[2]=29 if (Date_LeapYear($y)); |
4920
|
0
|
0
|
|
|
|
|
$d=$d_in_m[$m] if ($d>$d_in_m[$m]); |
4921
|
0
|
|
|
|
|
|
$d += $dd; |
4922
|
0
|
|
|
|
|
|
while ($d<1) { |
4923
|
0
|
|
|
|
|
|
$m--; |
4924
|
0
|
0
|
|
|
|
|
if ($m==0) { |
4925
|
0
|
|
|
|
|
|
$m=12; |
4926
|
0
|
|
|
|
|
|
$y--; |
4927
|
0
|
|
|
|
|
|
while (length($y)<4) { |
4928
|
0
|
|
|
|
|
|
$y="0$y" |
4929
|
|
|
|
|
|
|
} |
4930
|
0
|
0
|
|
|
|
|
if (Date_LeapYear($y)) { |
4931
|
0
|
|
|
|
|
|
$d_in_m[2]=29; |
4932
|
|
|
|
|
|
|
} else { |
4933
|
0
|
|
|
|
|
|
$d_in_m[2]=28; |
4934
|
|
|
|
|
|
|
} |
4935
|
|
|
|
|
|
|
} |
4936
|
0
|
|
|
|
|
|
$d += $d_in_m[$m]; |
4937
|
|
|
|
|
|
|
} |
4938
|
0
|
|
|
|
|
|
while ($d>$d_in_m[$m]) { |
4939
|
0
|
|
|
|
|
|
$d -= $d_in_m[$m]; |
4940
|
0
|
|
|
|
|
|
$m++; |
4941
|
0
|
0
|
|
|
|
|
if ($m==13) { |
4942
|
0
|
|
|
|
|
|
$m=1; |
4943
|
0
|
|
|
|
|
|
$y++; |
4944
|
0
|
|
|
|
|
|
while (length($y)<4) { |
4945
|
0
|
|
|
|
|
|
$y="0$y" |
4946
|
|
|
|
|
|
|
} |
4947
|
0
|
0
|
|
|
|
|
if (Date_LeapYear($y)) { |
4948
|
0
|
|
|
|
|
|
$d_in_m[2]=29; |
4949
|
|
|
|
|
|
|
} else { |
4950
|
0
|
|
|
|
|
|
$d_in_m[2]=28; |
4951
|
|
|
|
|
|
|
} |
4952
|
|
|
|
|
|
|
} |
4953
|
|
|
|
|
|
|
} |
4954
|
|
|
|
|
|
|
} |
4955
|
|
|
|
|
|
|
|
4956
|
0
|
0
|
0
|
|
|
|
if ($y<0 or $y>9999) { |
4957
|
0
|
|
|
|
|
|
$$errref=3; |
4958
|
0
|
|
|
|
|
|
return; |
4959
|
|
|
|
|
|
|
} |
4960
|
0
|
|
|
|
|
|
_Date_Join($y,$m,$d,$h,$mn,$s); |
4961
|
|
|
|
|
|
|
} |
4962
|
|
|
|
|
|
|
|
4963
|
|
|
|
|
|
|
sub _Date_UpdateHolidays { |
4964
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/); |
4965
|
0
|
|
|
|
|
|
my($year)=@_; |
4966
|
0
|
|
|
|
|
|
$Holiday{"year"}=$year; |
4967
|
0
|
|
|
|
|
|
$Holiday{"dates"}{$year}={}; |
4968
|
|
|
|
|
|
|
|
4969
|
0
|
|
|
|
|
|
my($date,$delta,$err)=(); |
4970
|
0
|
|
|
|
|
|
my($key,@tmp,$tmp); |
4971
|
|
|
|
|
|
|
|
4972
|
0
|
|
|
|
|
|
foreach $key (keys %{ $Holiday{"desc"} }) { |
|
0
|
|
|
|
|
|
|
4973
|
0
|
|
|
|
|
|
@tmp=_Recur_Split($key); |
4974
|
0
|
0
|
|
|
|
|
if (@tmp) { |
|
|
0
|
|
|
|
|
|
4975
|
0
|
|
|
|
|
|
$tmp=ParseDateString("${year}010100:00:00"); |
4976
|
0
|
|
|
|
|
|
($date)=ParseRecur($key,$tmp,$tmp,($year+1)."-01-01"); |
4977
|
0
|
0
|
|
|
|
|
next if (! $date); |
4978
|
|
|
|
|
|
|
|
4979
|
|
|
|
|
|
|
} elsif ($key =~ /^(.*)([+-].*)$/) { |
4980
|
|
|
|
|
|
|
# Date +/- Delta |
4981
|
0
|
|
|
|
|
|
($date,$delta)=($1,$2); |
4982
|
0
|
|
|
|
|
|
$tmp=ParseDateString("$date $year"); |
4983
|
0
|
0
|
|
|
|
|
if ($tmp) { |
4984
|
0
|
|
|
|
|
|
$date=$tmp; |
4985
|
|
|
|
|
|
|
} else { |
4986
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
4987
|
0
|
0
|
|
|
|
|
next if ($date !~ /^$year/); |
4988
|
|
|
|
|
|
|
} |
4989
|
0
|
|
|
|
|
|
$date=DateCalc($date,$delta,\$err,0); |
4990
|
|
|
|
|
|
|
|
4991
|
|
|
|
|
|
|
} else { |
4992
|
|
|
|
|
|
|
# Date |
4993
|
0
|
|
|
|
|
|
$date=$key; |
4994
|
0
|
|
|
|
|
|
$tmp=ParseDateString("$date $year"); |
4995
|
0
|
0
|
|
|
|
|
if ($tmp) { |
4996
|
0
|
|
|
|
|
|
$date=$tmp; |
4997
|
|
|
|
|
|
|
} else { |
4998
|
0
|
|
|
|
|
|
$date=ParseDateString($date); |
4999
|
0
|
0
|
|
|
|
|
next if ($date !~ /^$year/); |
5000
|
|
|
|
|
|
|
} |
5001
|
|
|
|
|
|
|
} |
5002
|
0
|
|
|
|
|
|
$Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key}; |
5003
|
|
|
|
|
|
|
} |
5004
|
|
|
|
|
|
|
} |
5005
|
|
|
|
|
|
|
|
5006
|
|
|
|
|
|
|
# This sets a Date::Manip config variable. |
5007
|
|
|
|
|
|
|
sub _Date_SetConfigVariable { |
5008
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/); |
5009
|
0
|
|
|
|
|
|
my($var,$val)=@_; |
5010
|
|
|
|
|
|
|
|
5011
|
|
|
|
|
|
|
# These are most appropriate for command line options instead of in files. |
5012
|
0
|
0
|
|
|
|
|
$Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i); |
5013
|
0
|
0
|
|
|
|
|
$Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i); |
5014
|
0
|
0
|
|
|
|
|
$Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i); |
5015
|
0
|
0
|
|
|
|
|
EraseHolidays(), return if ($var =~ /^EraseHolidays$/i); |
5016
|
0
|
0
|
|
|
|
|
$Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i); |
5017
|
0
|
0
|
|
|
|
|
$Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i); |
5018
|
|
|
|
|
|
|
|
5019
|
|
|
|
|
|
|
$Curr{"InitLang"}=1, |
5020
|
0
|
0
|
|
|
|
|
$Cnf{"Language"}=$val, return if ($var =~ /^Language$/i); |
5021
|
0
|
0
|
|
|
|
|
$Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i); |
5022
|
0
|
0
|
|
|
|
|
$Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i); |
5023
|
0
|
0
|
|
|
|
|
$Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i); |
5024
|
0
|
0
|
|
|
|
|
$Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i); |
5025
|
0
|
0
|
|
|
|
|
$Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i); |
5026
|
0
|
0
|
|
|
|
|
$Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i); |
5027
|
0
|
0
|
|
|
|
|
$Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i); |
5028
|
|
|
|
|
|
|
$Cnf{"WorkDayBeg"}=$val, |
5029
|
0
|
0
|
|
|
|
|
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i); |
5030
|
|
|
|
|
|
|
$Cnf{"WorkDayEnd"}=$val, |
5031
|
0
|
0
|
|
|
|
|
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i); |
5032
|
|
|
|
|
|
|
$Cnf{"WorkDay24Hr"}=$val, |
5033
|
0
|
0
|
|
|
|
|
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i); |
5034
|
0
|
0
|
|
|
|
|
$Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i); |
5035
|
0
|
0
|
|
|
|
|
$Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i); |
5036
|
0
|
0
|
|
|
|
|
$Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i); |
5037
|
0
|
0
|
|
|
|
|
$Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i); |
5038
|
0
|
0
|
|
|
|
|
$Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i); |
5039
|
0
|
0
|
|
|
|
|
$Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i); |
5040
|
0
|
0
|
|
|
|
|
$Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i); |
5041
|
0
|
0
|
|
|
|
|
$Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i); |
5042
|
0
|
0
|
|
|
|
|
$Cnf{"TodayIsMidnight"}=$val, return if ($var =~ /^TodayIsMidnight$/i); |
5043
|
|
|
|
|
|
|
|
5044
|
0
|
|
|
|
|
|
confess "ERROR: Unknown configuration variable $var in Date::Manip.\n"; |
5045
|
|
|
|
|
|
|
} |
5046
|
|
|
|
|
|
|
|
5047
|
|
|
|
|
|
|
sub EraseHolidays { |
5048
|
0
|
0
|
|
0
|
1
|
|
print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/); |
5049
|
|
|
|
|
|
|
|
5050
|
0
|
|
|
|
|
|
$Cnf{"EraseHolidays"}=0; |
5051
|
0
|
|
|
|
|
|
delete $Holiday{"list"}; |
5052
|
0
|
|
|
|
|
|
$Holiday{"list"}={}; |
5053
|
0
|
|
|
|
|
|
delete $Holiday{"desc"}; |
5054
|
0
|
|
|
|
|
|
$Holiday{"desc"}={}; |
5055
|
0
|
|
|
|
|
|
$Holiday{"dates"}={}; |
5056
|
|
|
|
|
|
|
} |
5057
|
|
|
|
|
|
|
|
5058
|
|
|
|
|
|
|
# This returns a pointer to a list of times and events in the format |
5059
|
|
|
|
|
|
|
# [ date [ events ], date, [ events ], ... ] |
5060
|
|
|
|
|
|
|
# where each list of events are events that are in effect at the date |
5061
|
|
|
|
|
|
|
# immediately preceding the list. |
5062
|
|
|
|
|
|
|
# |
5063
|
|
|
|
|
|
|
# This takes either one date or two dates as arguments. |
5064
|
|
|
|
|
|
|
sub _Events_Calc { |
5065
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Events_Calc\n" if ($Curr{"Debug"} =~ /trace/); |
5066
|
|
|
|
|
|
|
|
5067
|
0
|
|
|
|
|
|
my($date0,$date1)=@_; |
5068
|
|
|
|
|
|
|
|
5069
|
0
|
|
|
|
|
|
my($tmp); |
5070
|
0
|
|
|
|
|
|
$date0=ParseDateString($date0); |
5071
|
0
|
0
|
|
|
|
|
return undef if (! $date0); |
5072
|
0
|
0
|
|
|
|
|
if ($date1) { |
5073
|
0
|
|
|
|
|
|
$date1=ParseDateString($date1); |
5074
|
0
|
0
|
|
|
|
|
if (Date_Cmp($date0,$date1)>0) { |
5075
|
0
|
|
|
|
|
|
$tmp=$date1; |
5076
|
0
|
|
|
|
|
|
$date1=$date0; |
5077
|
0
|
|
|
|
|
|
$date0=$tmp; |
5078
|
|
|
|
|
|
|
} |
5079
|
|
|
|
|
|
|
} else { |
5080
|
0
|
|
|
|
|
|
$date1=_DateCalc_DateDelta($date0,"+0:0:0:0:0:0:1"); |
5081
|
|
|
|
|
|
|
} |
5082
|
|
|
|
|
|
|
|
5083
|
|
|
|
|
|
|
# |
5084
|
|
|
|
|
|
|
# [ d0,d1,del,name ] => [ d0, d1+del ) |
5085
|
|
|
|
|
|
|
# [ d0,0,del,name ] => [ d0, d0+del ) |
5086
|
|
|
|
|
|
|
# |
5087
|
0
|
|
|
|
|
|
my(%ret,$d0,$d1,$del,$name,$c0,$c1); |
5088
|
0
|
|
|
|
|
|
my(@tmp)=@{ $Events{"dates"} }; |
|
0
|
|
|
|
|
|
|
5089
|
0
|
|
|
|
|
|
DATE: while (@tmp) { |
5090
|
0
|
|
|
|
|
|
($d0,$d1,$del,$name)=splice(@tmp,0,4); |
5091
|
0
|
|
|
|
|
|
$d0=ParseDateString($d0); |
5092
|
0
|
0
|
|
|
|
|
$d1=ParseDateString($d1) if ($d1); |
5093
|
0
|
0
|
|
|
|
|
$del=ParseDateDelta($del) if ($del); |
5094
|
0
|
0
|
|
|
|
|
if ($d1) { |
5095
|
0
|
0
|
|
|
|
|
if ($del) { |
5096
|
0
|
|
|
|
|
|
$d1=_DateCalc_DateDelta($d1,$del); |
5097
|
|
|
|
|
|
|
} |
5098
|
|
|
|
|
|
|
} else { |
5099
|
0
|
|
|
|
|
|
$d1=_DateCalc_DateDelta($d0,$del); |
5100
|
|
|
|
|
|
|
} |
5101
|
0
|
0
|
|
|
|
|
if (Date_Cmp($d0,$d1)>0) { |
5102
|
0
|
|
|
|
|
|
$tmp=$d1; |
5103
|
0
|
|
|
|
|
|
$d1=$d0; |
5104
|
0
|
|
|
|
|
|
$d0=$tmp; |
5105
|
|
|
|
|
|
|
} |
5106
|
|
|
|
|
|
|
# [ date0,date1 ) |
5107
|
|
|
|
|
|
|
# [ d0,d1 ) OR [ d0,d1 ) |
5108
|
0
|
0
|
0
|
|
|
|
next DATE if (Date_Cmp($d1,$date0)<=0 || |
5109
|
|
|
|
|
|
|
Date_Cmp($d0,$date1)>=0); |
5110
|
|
|
|
|
|
|
# [ date0,date1 ) |
5111
|
|
|
|
|
|
|
# [ d0,d1 ) |
5112
|
|
|
|
|
|
|
# [ d0, d1 ) |
5113
|
0
|
0
|
|
|
|
|
if (Date_Cmp($d0,$date0)<=0) { |
5114
|
0
|
|
|
|
|
|
push @{ $ret{$date0} },$name; |
|
0
|
|
|
|
|
|
|
5115
|
0
|
0
|
|
|
|
|
push @{ $ret{$d1} },"!$name" if (Date_Cmp($d1,$date1)<0); |
|
0
|
|
|
|
|
|
|
5116
|
0
|
|
|
|
|
|
next DATE; |
5117
|
|
|
|
|
|
|
} |
5118
|
|
|
|
|
|
|
# [ date0,date1 ) |
5119
|
|
|
|
|
|
|
# [ d0,d1 ) |
5120
|
0
|
0
|
|
|
|
|
if (Date_Cmp($d1,$date1)>=0) { |
5121
|
0
|
|
|
|
|
|
push @{ $ret{$d0} },$name; |
|
0
|
|
|
|
|
|
|
5122
|
0
|
|
|
|
|
|
next DATE; |
5123
|
|
|
|
|
|
|
} |
5124
|
|
|
|
|
|
|
# [ date0,date1 ) |
5125
|
|
|
|
|
|
|
# [ d0,d1 ) |
5126
|
0
|
|
|
|
|
|
push @{ $ret{$d0} },$name; |
|
0
|
|
|
|
|
|
|
5127
|
0
|
|
|
|
|
|
push @{ $ret{$d1} },"!$name"; |
|
0
|
|
|
|
|
|
|
5128
|
|
|
|
|
|
|
} |
5129
|
|
|
|
|
|
|
|
5130
|
|
|
|
|
|
|
# |
5131
|
|
|
|
|
|
|
# [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} ) |
5132
|
|
|
|
|
|
|
# |
5133
|
0
|
|
|
|
|
|
my($rec,$del0,$del1,@d); |
5134
|
0
|
|
|
|
|
|
@tmp=@{ $Events{"recur"} }; |
|
0
|
|
|
|
|
|
|
5135
|
0
|
|
|
|
|
|
RECUR: while (@tmp) { |
5136
|
0
|
|
|
|
|
|
($rec,$del0,$del1,$name)=splice(@tmp,0,4); |
5137
|
0
|
|
|
|
|
|
@d=(); |
5138
|
|
|
|
|
|
|
|
5139
|
|
|
|
|
|
|
} |
5140
|
|
|
|
|
|
|
|
5141
|
|
|
|
|
|
|
# Sort them AND take into account the "!$name" entries. |
5142
|
0
|
|
|
|
|
|
my(%tmp,$date,@tmp2,@ret); |
5143
|
0
|
|
|
|
|
|
@d=sort { Date_Cmp($a,$b) } keys %ret; |
|
0
|
|
|
|
|
|
|
5144
|
0
|
|
|
|
|
|
foreach $date (@d) { |
5145
|
0
|
|
|
|
|
|
@tmp=@{ $ret{$date} }; |
|
0
|
|
|
|
|
|
|
5146
|
0
|
|
|
|
|
|
@tmp2=(); |
5147
|
0
|
|
|
|
|
|
foreach $tmp (@tmp) { |
5148
|
0
|
0
|
|
|
|
|
push(@tmp2,$tmp), next if ($tmp =~ /^!/); |
5149
|
0
|
|
|
|
|
|
$tmp{$tmp}=1; |
5150
|
|
|
|
|
|
|
} |
5151
|
0
|
|
|
|
|
|
foreach $tmp (@tmp2) { |
5152
|
0
|
|
|
|
|
|
$tmp =~ s/^!//; |
5153
|
0
|
|
|
|
|
|
delete $tmp{$tmp}; |
5154
|
|
|
|
|
|
|
} |
5155
|
0
|
|
|
|
|
|
push(@ret,$date,[ keys %tmp ]); |
5156
|
|
|
|
|
|
|
} |
5157
|
|
|
|
|
|
|
|
5158
|
0
|
|
|
|
|
|
%tmp = @ret; |
5159
|
0
|
|
|
|
|
|
@ret = (); |
5160
|
0
|
|
|
|
|
|
foreach my $d (sort { Date_Cmp($a,$b) } keys %tmp) { |
|
0
|
|
|
|
|
|
|
5161
|
0
|
|
|
|
|
|
my $e = $tmp{$d}; |
5162
|
0
|
|
|
|
|
|
push @ret,($d,[ sort @$e ]); |
5163
|
|
|
|
|
|
|
} |
5164
|
0
|
|
|
|
|
|
return \@ret; |
5165
|
|
|
|
|
|
|
} |
5166
|
|
|
|
|
|
|
|
5167
|
|
|
|
|
|
|
# This parses the raw events list |
5168
|
|
|
|
|
|
|
sub _Events_ParseRaw { |
5169
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/); |
5170
|
|
|
|
|
|
|
|
5171
|
|
|
|
|
|
|
# Only need to be parsed once |
5172
|
0
|
|
|
|
|
|
my($force)=@_; |
5173
|
0
|
0
|
|
|
|
|
$Events{"parsed"}=0 if ($force); |
5174
|
0
|
0
|
|
|
|
|
return if ($Events{"parsed"}); |
5175
|
0
|
|
|
|
|
|
$Events{"parsed"}=1; |
5176
|
|
|
|
|
|
|
|
5177
|
0
|
|
|
|
|
|
my(@events)=@{ $Events{"raw"} }; |
|
0
|
|
|
|
|
|
|
5178
|
0
|
|
|
|
|
|
my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r, |
5179
|
|
|
|
|
|
|
$recur); |
5180
|
0
|
|
|
|
|
|
EVENT: while (@events) { |
5181
|
0
|
|
|
|
|
|
($event,$name)=splice(@events,0,2); |
5182
|
0
|
|
|
|
|
|
@event=split(/\s*;\s*/,$event); |
5183
|
|
|
|
|
|
|
|
5184
|
0
|
0
|
|
|
|
|
if ($#event == 0) { |
|
|
0
|
|
|
|
|
|
5185
|
|
|
|
|
|
|
|
5186
|
0
|
0
|
|
|
|
|
if ($date0=ParseDateString($event[0])) { |
|
|
0
|
|
|
|
|
|
5187
|
|
|
|
|
|
|
# |
5188
|
|
|
|
|
|
|
# date = event |
5189
|
|
|
|
|
|
|
# |
5190
|
0
|
|
|
|
|
|
$tmp=ParseDateString("$event[0] 00:00:00"); |
5191
|
0
|
0
|
0
|
|
|
|
if ($tmp && $tmp eq $date0) { |
5192
|
0
|
|
|
|
|
|
$delta="+0:0:0:1:0:0:0"; |
5193
|
|
|
|
|
|
|
} else { |
5194
|
0
|
|
|
|
|
|
$delta="+0:0:0:0:1:0:0"; |
5195
|
|
|
|
|
|
|
} |
5196
|
0
|
|
|
|
|
|
push @{ $Events{"dates"} },($date0,0,$delta,$name); |
|
0
|
|
|
|
|
|
|
5197
|
|
|
|
|
|
|
|
5198
|
|
|
|
|
|
|
} elsif ($recur=ParseRecur($event[0])) { |
5199
|
|
|
|
|
|
|
# |
5200
|
|
|
|
|
|
|
# recur = event |
5201
|
|
|
|
|
|
|
# |
5202
|
0
|
|
|
|
|
|
($recur0,$recur1)=_Recur_Split($recur); |
5203
|
0
|
0
|
|
|
|
|
if ($recur0) { |
5204
|
0
|
0
|
|
|
|
|
if ($recur1) { |
5205
|
0
|
|
|
|
|
|
$r="$recur0:$recur1"; |
5206
|
|
|
|
|
|
|
} else { |
5207
|
0
|
|
|
|
|
|
$r=$recur0; |
5208
|
|
|
|
|
|
|
} |
5209
|
|
|
|
|
|
|
} else { |
5210
|
0
|
|
|
|
|
|
$r=$recur1; |
5211
|
|
|
|
|
|
|
} |
5212
|
0
|
|
|
|
|
|
(@recur)=split(/:/,$r); |
5213
|
0
|
0
|
0
|
|
|
|
if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) { |
|
|
|
0
|
|
|
|
|
5214
|
0
|
|
|
|
|
|
$delta="+0:0:0:1:0:0:0"; |
5215
|
|
|
|
|
|
|
} else { |
5216
|
0
|
|
|
|
|
|
$delta="+0:0:0:0:1:0:0"; |
5217
|
|
|
|
|
|
|
} |
5218
|
0
|
|
|
|
|
|
push @{ $Events{"recur"} },($recur,0,$delta,$name); |
|
0
|
|
|
|
|
|
|
5219
|
|
|
|
|
|
|
|
5220
|
|
|
|
|
|
|
} else { |
5221
|
|
|
|
|
|
|
# ??? = event |
5222
|
0
|
|
|
|
|
|
warn "WARNING: illegal event ignored [ @event ]\n"; |
5223
|
0
|
|
|
|
|
|
next EVENT; |
5224
|
|
|
|
|
|
|
} |
5225
|
|
|
|
|
|
|
|
5226
|
|
|
|
|
|
|
} elsif ($#event == 1) { |
5227
|
|
|
|
|
|
|
|
5228
|
0
|
0
|
|
|
|
|
if ($date0=ParseDateString($event[0])) { |
|
|
0
|
|
|
|
|
|
5229
|
|
|
|
|
|
|
|
5230
|
0
|
0
|
|
|
|
|
if ($date1=ParseDateString($event[1])) { |
|
|
0
|
|
|
|
|
|
5231
|
|
|
|
|
|
|
# |
5232
|
|
|
|
|
|
|
# date ; date = event |
5233
|
|
|
|
|
|
|
# |
5234
|
0
|
|
|
|
|
|
$tmp=ParseDateString("$event[1] 00:00:00"); |
5235
|
0
|
0
|
0
|
|
|
|
if ($tmp && $tmp eq $date1) { |
5236
|
0
|
|
|
|
|
|
$date1=_DateCalc_DateDelta($date1,"+0:0:0:1:0:0:0"); |
5237
|
|
|
|
|
|
|
} |
5238
|
0
|
|
|
|
|
|
push @{ $Events{"dates"} },($date0,$date1,0,$name); |
|
0
|
|
|
|
|
|
|
5239
|
|
|
|
|
|
|
|
5240
|
|
|
|
|
|
|
} elsif ($delta=ParseDateDelta($event[1])) { |
5241
|
|
|
|
|
|
|
# |
5242
|
|
|
|
|
|
|
# date ; delta = event |
5243
|
|
|
|
|
|
|
# |
5244
|
0
|
|
|
|
|
|
push @{ $Events{"dates"} },($date0,0,$delta,$name); |
|
0
|
|
|
|
|
|
|
5245
|
|
|
|
|
|
|
|
5246
|
|
|
|
|
|
|
} else { |
5247
|
|
|
|
|
|
|
# date ; ??? = event |
5248
|
0
|
|
|
|
|
|
warn "WARNING: illegal event ignored [ @event ]\n"; |
5249
|
0
|
|
|
|
|
|
next EVENT; |
5250
|
|
|
|
|
|
|
} |
5251
|
|
|
|
|
|
|
|
5252
|
|
|
|
|
|
|
} elsif ($recur=ParseRecur($event[0])) { |
5253
|
|
|
|
|
|
|
|
5254
|
0
|
0
|
|
|
|
|
if ($delta=ParseDateDelta($event[1])) { |
5255
|
|
|
|
|
|
|
# |
5256
|
|
|
|
|
|
|
# recur ; delta = event |
5257
|
|
|
|
|
|
|
# |
5258
|
0
|
|
|
|
|
|
push @{ $Events{"recur"} },($recur,0,$delta,$name); |
|
0
|
|
|
|
|
|
|
5259
|
|
|
|
|
|
|
|
5260
|
|
|
|
|
|
|
} else { |
5261
|
|
|
|
|
|
|
# recur ; ??? = event |
5262
|
0
|
|
|
|
|
|
warn "WARNING: illegal event ignored [ @event ]\n"; |
5263
|
0
|
|
|
|
|
|
next EVENT; |
5264
|
|
|
|
|
|
|
} |
5265
|
|
|
|
|
|
|
|
5266
|
|
|
|
|
|
|
} else { |
5267
|
|
|
|
|
|
|
# ??? ; ??? = event |
5268
|
0
|
|
|
|
|
|
warn "WARNING: illegal event ignored [ @event ]\n"; |
5269
|
0
|
|
|
|
|
|
next EVENT; |
5270
|
|
|
|
|
|
|
} |
5271
|
|
|
|
|
|
|
|
5272
|
|
|
|
|
|
|
} else { |
5273
|
|
|
|
|
|
|
# date ; delta0 ; delta1 = event |
5274
|
|
|
|
|
|
|
# recur ; delta0 ; delta1 = event |
5275
|
|
|
|
|
|
|
# ??? ; ??? ; ??? ... = event |
5276
|
0
|
|
|
|
|
|
warn "WARNING: illegal event ignored [ @event ]\n"; |
5277
|
0
|
|
|
|
|
|
next EVENT; |
5278
|
|
|
|
|
|
|
} |
5279
|
|
|
|
|
|
|
} |
5280
|
|
|
|
|
|
|
} |
5281
|
|
|
|
|
|
|
|
5282
|
|
|
|
|
|
|
# This reads an init file. |
5283
|
|
|
|
|
|
|
sub _Date_InitFile { |
5284
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/); |
5285
|
0
|
|
|
|
|
|
my($file)=@_; |
5286
|
0
|
|
|
|
|
|
my($in)=new IO::File; |
5287
|
0
|
|
|
|
|
|
local($_)=(); |
5288
|
0
|
|
|
|
|
|
my($section)="vars"; |
5289
|
0
|
|
|
|
|
|
my($var,$val,$recur,$name)=(); |
5290
|
|
|
|
|
|
|
|
5291
|
0
|
0
|
|
|
|
|
$in->open($file) || return; |
5292
|
0
|
|
|
|
|
|
while(defined ($_=<$in>)) { |
5293
|
0
|
|
|
|
|
|
chomp; |
5294
|
0
|
|
|
|
|
|
s/^\s+//; |
5295
|
0
|
|
|
|
|
|
s/\s+$//; |
5296
|
0
|
0
|
0
|
|
|
|
next if ($_ eq '' or /^\#/); |
5297
|
|
|
|
|
|
|
|
5298
|
0
|
0
|
|
|
|
|
if (/^\*holiday/i) { |
|
|
0
|
|
|
|
|
|
5299
|
0
|
|
|
|
|
|
$section="holiday"; |
5300
|
0
|
0
|
0
|
|
|
|
EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"}); |
5301
|
0
|
|
|
|
|
|
next; |
5302
|
|
|
|
|
|
|
} elsif (/^\*events/i) { |
5303
|
0
|
|
|
|
|
|
$section="events"; |
5304
|
0
|
|
|
|
|
|
next; |
5305
|
|
|
|
|
|
|
} |
5306
|
|
|
|
|
|
|
|
5307
|
0
|
0
|
|
|
|
|
if ($section =~ /var/i) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5308
|
0
|
0
|
|
|
|
|
confess "ERROR: invalid Date::Manip config file line.\n $_\n" |
5309
|
|
|
|
|
|
|
if (! /(.*\S)\s*=\s*(.*)$/); |
5310
|
0
|
|
|
|
|
|
($var,$val)=($1,$2); |
5311
|
0
|
|
|
|
|
|
_Date_SetConfigVariable($var,$val); |
5312
|
|
|
|
|
|
|
|
5313
|
|
|
|
|
|
|
} elsif ($section =~ /holiday/i) { |
5314
|
0
|
0
|
|
|
|
|
confess "ERROR: invalid Date::Manip config file line.\n $_\n" |
5315
|
|
|
|
|
|
|
if (! /(.*\S)\s*=\s*(.*)$/); |
5316
|
0
|
|
|
|
|
|
($recur,$name)=($1,$2); |
5317
|
0
|
0
|
|
|
|
|
$name="" if (! defined $name); |
5318
|
0
|
|
|
|
|
|
$Holiday{"desc"}{$recur}=$name; |
5319
|
|
|
|
|
|
|
|
5320
|
|
|
|
|
|
|
} elsif ($section =~ /events/i) { |
5321
|
0
|
0
|
|
|
|
|
confess "ERROR: invalid Date::Manip config file line.\n $_\n" |
5322
|
|
|
|
|
|
|
if (! /(.*\S)\s*=\s*(.*)$/); |
5323
|
0
|
|
|
|
|
|
($val,$var)=($1,$2); |
5324
|
0
|
|
|
|
|
|
push @{ $Events{"raw"} },($val,$var); |
|
0
|
|
|
|
|
|
|
5325
|
|
|
|
|
|
|
|
5326
|
|
|
|
|
|
|
} else { |
5327
|
|
|
|
|
|
|
# A section not currently used by Date::Manip (but may be |
5328
|
|
|
|
|
|
|
# used by some extension to it). |
5329
|
0
|
|
|
|
|
|
next; |
5330
|
|
|
|
|
|
|
} |
5331
|
|
|
|
|
|
|
} |
5332
|
0
|
|
|
|
|
|
close($in); |
5333
|
|
|
|
|
|
|
} |
5334
|
|
|
|
|
|
|
|
5335
|
|
|
|
|
|
|
# $flag=_Date_TimeCheck(\$h,\$mn,\$s,\$ampm); |
5336
|
|
|
|
|
|
|
# Returns 1 if any of the fields are bad. All fields are optional, and |
5337
|
|
|
|
|
|
|
# all possible checks are done on the data. If a field is not passed in, |
5338
|
|
|
|
|
|
|
# it is set to default values. If data is missing, appropriate defaults |
5339
|
|
|
|
|
|
|
# are supplied. |
5340
|
|
|
|
|
|
|
sub _Date_TimeCheck { |
5341
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/); |
5342
|
0
|
|
|
|
|
|
my($h,$mn,$s,$ampm)=@_; |
5343
|
0
|
|
|
|
|
|
my($tmp1,$tmp2,$tmp3)=(); |
5344
|
|
|
|
|
|
|
|
5345
|
0
|
0
|
|
|
|
|
$$h="" if (! defined $$h); |
5346
|
0
|
0
|
|
|
|
|
$$mn="" if (! defined $$mn); |
5347
|
0
|
0
|
|
|
|
|
$$s="" if (! defined $$s); |
5348
|
0
|
0
|
|
|
|
|
$$ampm="" if (! defined $$ampm); |
5349
|
0
|
0
|
|
|
|
|
$$ampm=uc($$ampm) if ($$ampm); |
5350
|
|
|
|
|
|
|
|
5351
|
|
|
|
|
|
|
# Check hour |
5352
|
0
|
|
|
|
|
|
$tmp1=$Lang{$Cnf{"Language"}}{"AmPm"}; |
5353
|
0
|
|
|
|
|
|
$tmp2=""; |
5354
|
0
|
0
|
|
|
|
|
if ($$ampm =~ /^$tmp1$/i) { |
|
|
0
|
|
|
|
|
|
5355
|
0
|
|
|
|
|
|
$tmp3=$Lang{$Cnf{"Language"}}{"AM"}; |
5356
|
0
|
0
|
|
|
|
|
$tmp2="AM" if ($$ampm =~ /^$tmp3$/i); |
5357
|
0
|
|
|
|
|
|
$tmp3=$Lang{$Cnf{"Language"}}{"PM"}; |
5358
|
0
|
0
|
|
|
|
|
$tmp2="PM" if ($$ampm =~ /^$tmp3$/i); |
5359
|
|
|
|
|
|
|
} elsif ($$ampm) { |
5360
|
0
|
|
|
|
|
|
return 1; |
5361
|
|
|
|
|
|
|
} |
5362
|
0
|
0
|
0
|
|
|
|
if ($tmp2 eq "AM" || $tmp2 eq "PM") { |
5363
|
0
|
0
|
|
|
|
|
$$h="0$$h" if (length($$h)==1); |
5364
|
0
|
0
|
0
|
|
|
|
return 1 if ($$h<1 || $$h>12); |
5365
|
0
|
0
|
0
|
|
|
|
$$h="00" if ($tmp2 eq "AM" and $$h==12); |
5366
|
0
|
0
|
0
|
|
|
|
$$h += 12 if ($tmp2 eq "PM" and $$h!=12); |
5367
|
|
|
|
|
|
|
} else { |
5368
|
0
|
0
|
|
|
|
|
$$h="00" if ($$h eq ""); |
5369
|
0
|
0
|
|
|
|
|
$$h="0$$h" if (length($$h)==1); |
5370
|
0
|
0
|
|
|
|
|
return 1 if (! _IsInt($$h,0,23)); |
5371
|
0
|
0
|
|
|
|
|
$tmp2="AM" if ($$h<12); |
5372
|
0
|
0
|
|
|
|
|
$tmp2="PM" if ($$h>=12); |
5373
|
|
|
|
|
|
|
} |
5374
|
0
|
|
|
|
|
|
$$ampm=$Lang{$Cnf{"Language"}}{"AMstr"}; |
5375
|
0
|
0
|
|
|
|
|
$$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM"); |
5376
|
|
|
|
|
|
|
|
5377
|
|
|
|
|
|
|
# Check minutes |
5378
|
0
|
0
|
|
|
|
|
$$mn="00" if ($$mn eq ""); |
5379
|
0
|
0
|
|
|
|
|
$$mn="0$$mn" if (length($$mn)==1); |
5380
|
0
|
0
|
|
|
|
|
return 1 if (! _IsInt($$mn,0,59)); |
5381
|
|
|
|
|
|
|
|
5382
|
|
|
|
|
|
|
# Check seconds |
5383
|
0
|
0
|
|
|
|
|
$$s="00" if ($$s eq ""); |
5384
|
0
|
0
|
|
|
|
|
$$s="0$$s" if (length($$s)==1); |
5385
|
0
|
0
|
|
|
|
|
return 1 if (! _IsInt($$s,0,59)); |
5386
|
|
|
|
|
|
|
|
5387
|
0
|
|
|
|
|
|
return 0; |
5388
|
|
|
|
|
|
|
} |
5389
|
|
|
|
|
|
|
|
5390
|
|
|
|
|
|
|
# $flag=_Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk); |
5391
|
|
|
|
|
|
|
# Returns 1 if any of the fields are bad. All fields are optional, and |
5392
|
|
|
|
|
|
|
# all possible checks are done on the data. If a field is not passed in, |
5393
|
|
|
|
|
|
|
# it is set to default values. If data is missing, appropriate defaults |
5394
|
|
|
|
|
|
|
# are supplied. |
5395
|
|
|
|
|
|
|
# |
5396
|
|
|
|
|
|
|
# If the flag UpdateHolidays is set, the year is set to |
5397
|
|
|
|
|
|
|
# CurrHolidayYear. |
5398
|
|
|
|
|
|
|
sub _Date_DateCheck { |
5399
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/); |
5400
|
0
|
|
|
|
|
|
my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_; |
5401
|
0
|
|
|
|
|
|
my($tmp1,$tmp2,$tmp3)=(); |
5402
|
|
|
|
|
|
|
|
5403
|
0
|
|
|
|
|
|
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31); |
5404
|
0
|
|
|
|
|
|
my($curr_y)=$Curr{"Y"}; |
5405
|
0
|
|
|
|
|
|
my($curr_m)=$Curr{"M"}; |
5406
|
0
|
|
|
|
|
|
my($curr_d)=$Curr{"D"}; |
5407
|
0
|
0
|
0
|
|
|
|
$$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d); |
|
|
|
0
|
|
|
|
|
5408
|
0
|
0
|
|
|
|
|
$$y="" if (! defined $$y); |
5409
|
0
|
0
|
|
|
|
|
$$m="" if (! defined $$m); |
5410
|
0
|
0
|
|
|
|
|
$$d="" if (! defined $$d); |
5411
|
0
|
0
|
|
|
|
|
$$wk="" if (! defined $$wk); |
5412
|
0
|
0
|
0
|
|
|
|
$$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq ""); |
|
|
|
0
|
|
|
|
|
5413
|
|
|
|
|
|
|
|
5414
|
|
|
|
|
|
|
# Check year. |
5415
|
0
|
0
|
|
|
|
|
$$y=$curr_y if ($$y eq ""); |
5416
|
0
|
0
|
|
|
|
|
$$y=_Date_FixYear($$y) if (length($$y)<4); |
5417
|
0
|
0
|
|
|
|
|
return 1 if (! _IsInt($$y,0,9999)); |
5418
|
0
|
0
|
|
|
|
|
$d_in_m[2]=29 if (Date_LeapYear($$y)); |
5419
|
|
|
|
|
|
|
|
5420
|
|
|
|
|
|
|
# Check month |
5421
|
0
|
0
|
|
|
|
|
$$m=$curr_m if ($$m eq ""); |
5422
|
|
|
|
|
|
|
$$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)} |
5423
|
0
|
0
|
|
|
|
|
if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}); |
5424
|
0
|
0
|
|
|
|
|
$$m="0$$m" if (length($$m)==1); |
5425
|
0
|
0
|
|
|
|
|
return 1 if (! _IsInt($$m,1,12)); |
5426
|
|
|
|
|
|
|
|
5427
|
|
|
|
|
|
|
# Check day |
5428
|
0
|
0
|
|
|
|
|
$$d="01" if ($$d eq ""); |
5429
|
0
|
0
|
|
|
|
|
$$d="0$$d" if (length($$d)==1); |
5430
|
0
|
0
|
|
|
|
|
return 1 if (! _IsInt($$d,1,$d_in_m[$$m])); |
5431
|
0
|
0
|
|
|
|
|
if ($$wk) { |
5432
|
0
|
|
|
|
|
|
$tmp1=Date_DayOfWeek($$m,$$d,$$y); |
5433
|
|
|
|
|
|
|
$tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)} |
5434
|
0
|
0
|
|
|
|
|
if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}); |
5435
|
0
|
0
|
|
|
|
|
return 1 if ($tmp1 != $tmp2); |
5436
|
|
|
|
|
|
|
} |
5437
|
|
|
|
|
|
|
|
5438
|
0
|
|
|
|
|
|
return _Date_TimeCheck($h,$mn,$s,$ampm); |
5439
|
|
|
|
|
|
|
} |
5440
|
|
|
|
|
|
|
|
5441
|
|
|
|
|
|
|
# Takes a year in 2 digit form and returns it in 4 digit form |
5442
|
|
|
|
|
|
|
sub _Date_FixYear { |
5443
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/); |
5444
|
0
|
|
|
|
|
|
my($y)=@_; |
5445
|
0
|
|
|
|
|
|
my($curr_y)=$Curr{"Y"}; |
5446
|
0
|
0
|
0
|
|
|
|
$y=$curr_y if (! defined $y or ! $y); |
5447
|
0
|
0
|
|
|
|
|
return $y if (length($y)==4); |
5448
|
0
|
0
|
|
|
|
|
confess "ERROR: Invalid year ($y)\n" if (length($y)!=2); |
5449
|
0
|
|
|
|
|
|
my($y1,$y2)=(); |
5450
|
|
|
|
|
|
|
|
5451
|
0
|
0
|
|
|
|
|
if (lc($Cnf{"YYtoYYYY"}) eq "c") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5452
|
0
|
|
|
|
|
|
$y1=substr($y,0,2); |
5453
|
0
|
|
|
|
|
|
$y="$y1$y"; |
5454
|
|
|
|
|
|
|
|
5455
|
|
|
|
|
|
|
} elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) { |
5456
|
0
|
|
|
|
|
|
$y1=$1; |
5457
|
0
|
|
|
|
|
|
$y="$y1$y"; |
5458
|
|
|
|
|
|
|
|
5459
|
|
|
|
|
|
|
} elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) { |
5460
|
0
|
|
|
|
|
|
$y1="$1$2"; |
5461
|
0
|
|
|
|
|
|
$y ="$1$y"; |
5462
|
0
|
0
|
|
|
|
|
$y += 100 if ($y<$y1); |
5463
|
|
|
|
|
|
|
|
5464
|
|
|
|
|
|
|
} else { |
5465
|
0
|
|
|
|
|
|
$y1=$curr_y-$Cnf{"YYtoYYYY"}; |
5466
|
0
|
|
|
|
|
|
$y2=$y1+99; |
5467
|
0
|
|
|
|
|
|
$y="19$y"; |
5468
|
0
|
|
|
|
|
|
while ($y<$y1) { |
5469
|
0
|
|
|
|
|
|
$y+=100; |
5470
|
|
|
|
|
|
|
} |
5471
|
0
|
|
|
|
|
|
while ($y>$y2) { |
5472
|
0
|
|
|
|
|
|
$y-=100; |
5473
|
|
|
|
|
|
|
} |
5474
|
|
|
|
|
|
|
} |
5475
|
0
|
|
|
|
|
|
$y; |
5476
|
|
|
|
|
|
|
} |
5477
|
|
|
|
|
|
|
|
5478
|
|
|
|
|
|
|
# _Date_NthWeekOfYear($y,$n); |
5479
|
|
|
|
|
|
|
# Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the |
5480
|
|
|
|
|
|
|
# year. |
5481
|
|
|
|
|
|
|
# _Date_NthWeekOfYear($y,$n,$dow,$flag); |
5482
|
|
|
|
|
|
|
# Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag |
5483
|
|
|
|
|
|
|
# is nil, the first DoW of the year may actually be in the previous |
5484
|
|
|
|
|
|
|
# year (since the 1st week may include days from the previous year). |
5485
|
|
|
|
|
|
|
# If flag is non-nil, the 1st DoW of the year refers to the 1st one |
5486
|
|
|
|
|
|
|
# actually in the year |
5487
|
|
|
|
|
|
|
sub _Date_NthWeekOfYear { |
5488
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/); |
5489
|
0
|
|
|
|
|
|
my($y,$n,$dow,$flag)=@_; |
5490
|
0
|
|
|
|
|
|
my($m,$d,$err,$tmp,$date,%dow)=(); |
5491
|
0
|
0
|
0
|
|
|
|
$y=$Curr{"Y"} if (! defined $y or ! $y); |
5492
|
0
|
0
|
0
|
|
|
|
$n=1 if (! defined $n or $n eq ""); |
5493
|
0
|
0
|
0
|
|
|
|
return () if ($n<0 || $n>53); |
5494
|
0
|
0
|
|
|
|
|
if (defined $dow) { |
5495
|
0
|
|
|
|
|
|
$dow=lc($dow); |
5496
|
0
|
|
|
|
|
|
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; |
|
0
|
|
|
|
|
|
|
5497
|
0
|
0
|
|
|
|
|
$dow=$dow{$dow} if (exists $dow{$dow}); |
5498
|
0
|
0
|
0
|
|
|
|
return () if ($dow<1 || $dow>7); |
5499
|
0
|
0
|
|
|
|
|
$flag="" if (! defined $flag); |
5500
|
|
|
|
|
|
|
} else { |
5501
|
0
|
|
|
|
|
|
$dow=""; |
5502
|
0
|
|
|
|
|
|
$flag=""; |
5503
|
|
|
|
|
|
|
} |
5504
|
|
|
|
|
|
|
|
5505
|
0
|
0
|
|
|
|
|
$y=_Date_FixYear($y) if (length($y)<4); |
5506
|
0
|
0
|
|
|
|
|
if ($Cnf{"Jan1Week1"}) { |
5507
|
0
|
|
|
|
|
|
$date=_Date_Join($y,1,1,0,0,0); |
5508
|
|
|
|
|
|
|
} else { |
5509
|
0
|
|
|
|
|
|
$date=_Date_Join($y,1,4,0,0,0); |
5510
|
|
|
|
|
|
|
} |
5511
|
0
|
|
|
|
|
|
$date=Date_GetPrev($date,$Cnf{"FirstDay"},1); |
5512
|
0
|
0
|
|
|
|
|
$date=Date_GetNext($date,$dow,1) if ($dow ne ""); |
5513
|
|
|
|
|
|
|
|
5514
|
0
|
0
|
|
|
|
|
if ($flag) { |
5515
|
0
|
|
|
|
|
|
($tmp)=_Date_Split($date, 1); |
5516
|
0
|
0
|
|
|
|
|
$n++ if ($tmp != $y); |
5517
|
|
|
|
|
|
|
} |
5518
|
|
|
|
|
|
|
|
5519
|
0
|
0
|
|
|
|
|
if ($n>1) { |
|
|
0
|
|
|
|
|
|
5520
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0); |
5521
|
|
|
|
|
|
|
} elsif ($n==0) { |
5522
|
0
|
|
|
|
|
|
$date=_DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0); |
5523
|
|
|
|
|
|
|
} |
5524
|
0
|
|
|
|
|
|
($y,$m,$d)=_Date_Split($date, 1); |
5525
|
0
|
|
|
|
|
|
($y,$m,$d); |
5526
|
|
|
|
|
|
|
} |
5527
|
|
|
|
|
|
|
|
5528
|
|
|
|
|
|
|
######################################################################## |
5529
|
|
|
|
|
|
|
# LANGUAGE INITIALIZATION |
5530
|
|
|
|
|
|
|
######################################################################## |
5531
|
|
|
|
|
|
|
|
5532
|
|
|
|
|
|
|
# 8-bit international characters can be gotten by "\xXX". I don't know |
5533
|
|
|
|
|
|
|
# how to get 16-bit characters. I've got to read up on perllocale. |
5534
|
|
|
|
|
|
|
sub _Char_8Bit { |
5535
|
0
|
|
|
0
|
|
|
my($hash)=@_; |
5536
|
|
|
|
|
|
|
|
5537
|
|
|
|
|
|
|
# grave ` |
5538
|
|
|
|
|
|
|
# A` 00c0 a` 00e0 |
5539
|
|
|
|
|
|
|
# E` 00c8 e` 00e8 |
5540
|
|
|
|
|
|
|
# I` 00cc i` 00ec |
5541
|
|
|
|
|
|
|
# O` 00d2 o` 00f2 |
5542
|
|
|
|
|
|
|
# U` 00d9 u` 00f9 |
5543
|
|
|
|
|
|
|
# W` 1e80 w` 1e81 |
5544
|
|
|
|
|
|
|
# Y` 1ef2 y` 1ef3 |
5545
|
|
|
|
|
|
|
|
5546
|
0
|
|
|
|
|
|
$$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE |
5547
|
0
|
|
|
|
|
|
$$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE |
5548
|
0
|
|
|
|
|
|
$$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE |
5549
|
0
|
|
|
|
|
|
$$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE |
5550
|
0
|
|
|
|
|
|
$$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE |
5551
|
0
|
|
|
|
|
|
$$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE |
5552
|
0
|
|
|
|
|
|
$$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE |
5553
|
0
|
|
|
|
|
|
$$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE |
5554
|
0
|
|
|
|
|
|
$$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE |
5555
|
0
|
|
|
|
|
|
$$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE |
5556
|
|
|
|
|
|
|
|
5557
|
|
|
|
|
|
|
# acute ' |
5558
|
|
|
|
|
|
|
# A' 00c1 a' 00e1 |
5559
|
|
|
|
|
|
|
# C' 0106 c' 0107 |
5560
|
|
|
|
|
|
|
# E' 00c9 e' 00e9 |
5561
|
|
|
|
|
|
|
# I' 00cd i' 00ed |
5562
|
|
|
|
|
|
|
# L' 0139 l' 013a |
5563
|
|
|
|
|
|
|
# N' 0143 n' 0144 |
5564
|
|
|
|
|
|
|
# O' 00d3 o' 00f3 |
5565
|
|
|
|
|
|
|
# R' 0154 r' 0155 |
5566
|
|
|
|
|
|
|
# S' 015a s' 015b |
5567
|
|
|
|
|
|
|
# U' 00da u' 00fa |
5568
|
|
|
|
|
|
|
# W' 1e82 w' 1e83 |
5569
|
|
|
|
|
|
|
# Y' 00dd y' 00fd |
5570
|
|
|
|
|
|
|
# Z' 0179 z' 017a |
5571
|
|
|
|
|
|
|
|
5572
|
0
|
|
|
|
|
|
$$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE |
5573
|
0
|
|
|
|
|
|
$$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE |
5574
|
0
|
|
|
|
|
|
$$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE |
5575
|
0
|
|
|
|
|
|
$$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE |
5576
|
0
|
|
|
|
|
|
$$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE |
5577
|
0
|
|
|
|
|
|
$$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE |
5578
|
0
|
|
|
|
|
|
$$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE |
5579
|
0
|
|
|
|
|
|
$$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE |
5580
|
0
|
|
|
|
|
|
$$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE |
5581
|
0
|
|
|
|
|
|
$$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE |
5582
|
0
|
|
|
|
|
|
$$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE |
5583
|
0
|
|
|
|
|
|
$$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE |
5584
|
|
|
|
|
|
|
|
5585
|
|
|
|
|
|
|
# double acute " " |
5586
|
|
|
|
|
|
|
# O" 0150 o" 0151 |
5587
|
|
|
|
|
|
|
# U" 0170 u" 0171 |
5588
|
|
|
|
|
|
|
|
5589
|
|
|
|
|
|
|
# circumflex ^ |
5590
|
|
|
|
|
|
|
# A^ 00c2 a^ 00e2 |
5591
|
|
|
|
|
|
|
# C^ 0108 c^ 0109 |
5592
|
|
|
|
|
|
|
# E^ 00ca e^ 00ea |
5593
|
|
|
|
|
|
|
# G^ 011c g^ 011d |
5594
|
|
|
|
|
|
|
# H^ 0124 h^ 0125 |
5595
|
|
|
|
|
|
|
# I^ 00ce i^ 00ee |
5596
|
|
|
|
|
|
|
# J^ 0134 j^ 0135 |
5597
|
|
|
|
|
|
|
# O^ 00d4 o^ 00f4 |
5598
|
|
|
|
|
|
|
# S^ 015c s^ 015d |
5599
|
|
|
|
|
|
|
# U^ 00db u^ 00fb |
5600
|
|
|
|
|
|
|
# W^ 0174 w^ 0175 |
5601
|
|
|
|
|
|
|
# Y^ 0176 y^ 0177 |
5602
|
|
|
|
|
|
|
|
5603
|
0
|
|
|
|
|
|
$$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX |
5604
|
0
|
|
|
|
|
|
$$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX |
5605
|
0
|
|
|
|
|
|
$$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX |
5606
|
0
|
|
|
|
|
|
$$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX |
5607
|
0
|
|
|
|
|
|
$$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX |
5608
|
0
|
|
|
|
|
|
$$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX |
5609
|
0
|
|
|
|
|
|
$$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX |
5610
|
0
|
|
|
|
|
|
$$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX |
5611
|
0
|
|
|
|
|
|
$$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX |
5612
|
0
|
|
|
|
|
|
$$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX |
5613
|
|
|
|
|
|
|
|
5614
|
|
|
|
|
|
|
# tilde ~ |
5615
|
|
|
|
|
|
|
# A~ 00c3 a~ 00e3 |
5616
|
|
|
|
|
|
|
# I~ 0128 i~ 0129 |
5617
|
|
|
|
|
|
|
# N~ 00d1 n~ 00f1 |
5618
|
|
|
|
|
|
|
# O~ 00d5 o~ 00f5 |
5619
|
|
|
|
|
|
|
# U~ 0168 u~ 0169 |
5620
|
|
|
|
|
|
|
|
5621
|
0
|
|
|
|
|
|
$$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE |
5622
|
0
|
|
|
|
|
|
$$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE |
5623
|
0
|
|
|
|
|
|
$$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE |
5624
|
0
|
|
|
|
|
|
$$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE |
5625
|
0
|
|
|
|
|
|
$$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE |
5626
|
0
|
|
|
|
|
|
$$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE |
5627
|
|
|
|
|
|
|
|
5628
|
|
|
|
|
|
|
# macron - |
5629
|
|
|
|
|
|
|
# A- 0100 a- 0101 |
5630
|
|
|
|
|
|
|
# E- 0112 e- 0113 |
5631
|
|
|
|
|
|
|
# I- 012a i- 012b |
5632
|
|
|
|
|
|
|
# O- 014c o- 014d |
5633
|
|
|
|
|
|
|
# U- 016a u- 016b |
5634
|
|
|
|
|
|
|
|
5635
|
|
|
|
|
|
|
# breve ( [half circle up] |
5636
|
|
|
|
|
|
|
# A( 0102 a( 0103 |
5637
|
|
|
|
|
|
|
# G( 011e g( 011f |
5638
|
|
|
|
|
|
|
# U( 016c u( 016d |
5639
|
|
|
|
|
|
|
|
5640
|
|
|
|
|
|
|
# dot . |
5641
|
|
|
|
|
|
|
# C. 010a c. 010b |
5642
|
|
|
|
|
|
|
# E. 0116 e. 0117 |
5643
|
|
|
|
|
|
|
# G. 0120 g. 0121 |
5644
|
|
|
|
|
|
|
# I. 0130 |
5645
|
|
|
|
|
|
|
# Z. 017b z. 017c |
5646
|
|
|
|
|
|
|
|
5647
|
|
|
|
|
|
|
# diaeresis : [side by side dots] |
5648
|
|
|
|
|
|
|
# A: 00c4 a: 00e4 |
5649
|
|
|
|
|
|
|
# E: 00cb e: 00eb |
5650
|
|
|
|
|
|
|
# I: 00cf i: 00ef |
5651
|
|
|
|
|
|
|
# O: 00d6 o: 00f6 |
5652
|
|
|
|
|
|
|
# U: 00dc u: 00fc |
5653
|
|
|
|
|
|
|
# W: 1e84 w: 1e85 |
5654
|
|
|
|
|
|
|
# Y: 0178 y: 00ff |
5655
|
|
|
|
|
|
|
|
5656
|
0
|
|
|
|
|
|
$$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS |
5657
|
0
|
|
|
|
|
|
$$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS |
5658
|
0
|
|
|
|
|
|
$$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS |
5659
|
0
|
|
|
|
|
|
$$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS |
5660
|
0
|
|
|
|
|
|
$$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS |
5661
|
0
|
|
|
|
|
|
$$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS |
5662
|
0
|
|
|
|
|
|
$$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS |
5663
|
0
|
|
|
|
|
|
$$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS |
5664
|
0
|
|
|
|
|
|
$$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS |
5665
|
0
|
|
|
|
|
|
$$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS |
5666
|
0
|
|
|
|
|
|
$$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS |
5667
|
|
|
|
|
|
|
|
5668
|
|
|
|
|
|
|
# ring o |
5669
|
|
|
|
|
|
|
# U0 016e u0 016f |
5670
|
|
|
|
|
|
|
|
5671
|
|
|
|
|
|
|
# cedilla , [squiggle down and left below the letter] |
5672
|
|
|
|
|
|
|
# ,C 00c7 ,c 00e7 |
5673
|
|
|
|
|
|
|
# ,G 0122 ,g 0123 |
5674
|
|
|
|
|
|
|
# ,K 0136 ,k 0137 |
5675
|
|
|
|
|
|
|
# ,L 013b ,l 013c |
5676
|
|
|
|
|
|
|
# ,N 0145 ,n 0146 |
5677
|
|
|
|
|
|
|
# ,R 0156 ,r 0157 |
5678
|
|
|
|
|
|
|
# ,S 015e ,s 015f |
5679
|
|
|
|
|
|
|
# ,T 0162 ,t 0163 |
5680
|
|
|
|
|
|
|
|
5681
|
0
|
|
|
|
|
|
$$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA |
5682
|
0
|
|
|
|
|
|
$$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA |
5683
|
|
|
|
|
|
|
|
5684
|
|
|
|
|
|
|
# ogonek ; [squiggle down and right below the letter] |
5685
|
|
|
|
|
|
|
# A; 0104 a; 0105 |
5686
|
|
|
|
|
|
|
# E; 0118 e; 0119 |
5687
|
|
|
|
|
|
|
# I; 012e i; 012f |
5688
|
|
|
|
|
|
|
# U; 0172 u; 0173 |
5689
|
|
|
|
|
|
|
|
5690
|
|
|
|
|
|
|
# caron < [little v on top] |
5691
|
|
|
|
|
|
|
# A< 01cd a< 01ce |
5692
|
|
|
|
|
|
|
# C< 010c c< 010d |
5693
|
|
|
|
|
|
|
# D< 010e d< 010f |
5694
|
|
|
|
|
|
|
# E< 011a e< 011b |
5695
|
|
|
|
|
|
|
# L< 013d l< 013e |
5696
|
|
|
|
|
|
|
# N< 0147 n< 0148 |
5697
|
|
|
|
|
|
|
# R< 0158 r< 0159 |
5698
|
|
|
|
|
|
|
# S< 0160 s< 0161 |
5699
|
|
|
|
|
|
|
# T< 0164 t< 0165 |
5700
|
|
|
|
|
|
|
# Z< 017d z< 017e |
5701
|
|
|
|
|
|
|
|
5702
|
|
|
|
|
|
|
|
5703
|
|
|
|
|
|
|
# Other characters |
5704
|
|
|
|
|
|
|
|
5705
|
|
|
|
|
|
|
# First character is below, 2nd character is above |
5706
|
0
|
|
|
|
|
|
$$hash{"||"} = "\xa6"; # BROKEN BAR |
5707
|
0
|
|
|
|
|
|
$$hash{" :"} = "\xa8"; # DIAERESIS |
5708
|
0
|
|
|
|
|
|
$$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR |
5709
|
|
|
|
|
|
|
#$$hash{" -"}= "\xaf"; # MACRON (narrow bar) |
5710
|
0
|
|
|
|
|
|
$$hash{" -"} = "\xad"; # HYPHEN (wide bar) |
5711
|
0
|
|
|
|
|
|
$$hash{" o"} = "\xb0"; # DEGREE SIGN |
5712
|
0
|
|
|
|
|
|
$$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN |
5713
|
0
|
|
|
|
|
|
$$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE |
5714
|
0
|
|
|
|
|
|
$$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO |
5715
|
0
|
|
|
|
|
|
$$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE |
5716
|
0
|
|
|
|
|
|
$$hash{" '"} = "\xb4"; # ACUTE ACCENT |
5717
|
0
|
|
|
|
|
|
$$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR |
5718
|
0
|
|
|
|
|
|
$$hash{" ."} = "\xb7"; # MIDDLE DOT |
5719
|
0
|
|
|
|
|
|
$$hash{", "} = "\xb8"; # CEDILLA |
5720
|
0
|
|
|
|
|
|
$$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE |
5721
|
0
|
|
|
|
|
|
$$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE |
5722
|
0
|
|
|
|
|
|
$$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH |
5723
|
|
|
|
|
|
|
|
5724
|
|
|
|
|
|
|
# upside down characters |
5725
|
|
|
|
|
|
|
|
5726
|
0
|
|
|
|
|
|
$$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK |
5727
|
0
|
|
|
|
|
|
$$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK |
5728
|
|
|
|
|
|
|
|
5729
|
|
|
|
|
|
|
# overlay characters |
5730
|
|
|
|
|
|
|
|
5731
|
0
|
|
|
|
|
|
$$hash{"X o"} = "\xa4"; # CURRENCY SIGN |
5732
|
0
|
|
|
|
|
|
$$hash{"Y ="} = "\xa5"; # YEN SIGN |
5733
|
0
|
|
|
|
|
|
$$hash{"S o"} = "\xa7"; # SECTION SIGN |
5734
|
0
|
|
|
|
|
|
$$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright |
5735
|
0
|
|
|
|
|
|
$$hash{"O R"} = "\xae"; # REGISTERED SIGN |
5736
|
0
|
|
|
|
|
|
$$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH |
5737
|
0
|
|
|
|
|
|
$$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE |
5738
|
0
|
|
|
|
|
|
$$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE |
5739
|
|
|
|
|
|
|
|
5740
|
|
|
|
|
|
|
# special names |
5741
|
|
|
|
|
|
|
|
5742
|
0
|
|
|
|
|
|
$$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER |
5743
|
0
|
|
|
|
|
|
$$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF |
5744
|
0
|
|
|
|
|
|
$$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS |
5745
|
0
|
|
|
|
|
|
$$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK |
5746
|
0
|
|
|
|
|
|
$$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK |
5747
|
0
|
|
|
|
|
|
$$hash{"cent"}= "\xa2"; # CENT SIGN |
5748
|
0
|
|
|
|
|
|
$$hash{"lb"} = "\xa3"; # POUND SIGN |
5749
|
0
|
|
|
|
|
|
$$hash{"mu"} = "\xb5"; # MICRO SIGN |
5750
|
0
|
|
|
|
|
|
$$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S |
5751
|
0
|
|
|
|
|
|
$$hash{"para"}= "\xb6"; # PILCROW SIGN |
5752
|
0
|
|
|
|
|
|
$$hash{"-|"} = "\xac"; # NOT SIGN |
5753
|
0
|
|
|
|
|
|
$$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE |
5754
|
0
|
|
|
|
|
|
$$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE |
5755
|
0
|
|
|
|
|
|
$$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN |
5756
|
0
|
|
|
|
|
|
$$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN |
5757
|
0
|
|
|
|
|
|
$$hash{"/"} = "\xf7"; # DIVISION SIGN |
5758
|
0
|
|
|
|
|
|
$$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN |
5759
|
|
|
|
|
|
|
} |
5760
|
|
|
|
|
|
|
|
5761
|
|
|
|
|
|
|
# $hashref = _Date_Init_LANGUAGE; |
5762
|
|
|
|
|
|
|
# This returns a hash containing all of the initialization for a |
5763
|
|
|
|
|
|
|
# specific language. The hash elements are: |
5764
|
|
|
|
|
|
|
# |
5765
|
|
|
|
|
|
|
# @ month_name full month names January February ... |
5766
|
|
|
|
|
|
|
# @ month_abb month abbreviations Jan Feb ... |
5767
|
|
|
|
|
|
|
# @ day_name day names Monday Tuesday ... |
5768
|
|
|
|
|
|
|
# @ day_abb day abbreviations Mon Tue ... |
5769
|
|
|
|
|
|
|
# @ day_char day character abbrevs M T ... |
5770
|
|
|
|
|
|
|
# @ am AM notations |
5771
|
|
|
|
|
|
|
# @ pm PM notations |
5772
|
|
|
|
|
|
|
# |
5773
|
|
|
|
|
|
|
# @ num_suff number with suffix 1st 2nd ... |
5774
|
|
|
|
|
|
|
# @ num_word numbers spelled out first second ... |
5775
|
|
|
|
|
|
|
# |
5776
|
|
|
|
|
|
|
# $ now words which mean now now ... |
5777
|
|
|
|
|
|
|
# $ today words which mean today today ... |
5778
|
|
|
|
|
|
|
# $ last words which mean last last final ... |
5779
|
|
|
|
|
|
|
# $ each words which mean each each every ... |
5780
|
|
|
|
|
|
|
# $ of of (as in a member of) in of ... |
5781
|
|
|
|
|
|
|
# ex. 4th day OF June |
5782
|
|
|
|
|
|
|
# $ at at 4:00 at |
5783
|
|
|
|
|
|
|
# $ on on Sunday on |
5784
|
|
|
|
|
|
|
# $ future in the future in |
5785
|
|
|
|
|
|
|
# $ past in the past ago |
5786
|
|
|
|
|
|
|
# $ next next item next |
5787
|
|
|
|
|
|
|
# $ prev previous item last previous |
5788
|
|
|
|
|
|
|
# $ later 2 hours later |
5789
|
|
|
|
|
|
|
# |
5790
|
|
|
|
|
|
|
# % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 } |
5791
|
|
|
|
|
|
|
# % times a hash of times { noon->12:00:00 ... } |
5792
|
|
|
|
|
|
|
# |
5793
|
|
|
|
|
|
|
# $ years words for year y yr year ... |
5794
|
|
|
|
|
|
|
# $ months words for month |
5795
|
|
|
|
|
|
|
# $ weeks words for week |
5796
|
|
|
|
|
|
|
# $ days words for day |
5797
|
|
|
|
|
|
|
# $ hours words for hour |
5798
|
|
|
|
|
|
|
# $ minutes words for minute |
5799
|
|
|
|
|
|
|
# $ seconds words for second |
5800
|
|
|
|
|
|
|
# % replace |
5801
|
|
|
|
|
|
|
# The replace element is quite important, but a bit tricky. In |
5802
|
|
|
|
|
|
|
# English (and probably other languages), one of the abbreviations |
5803
|
|
|
|
|
|
|
# for the word month that would be nice is "m". The problem is that |
5804
|
|
|
|
|
|
|
# "m" matches the "m" in "minute" which causes the string to be |
5805
|
|
|
|
|
|
|
# improperly matched in some cases. Hence, the list of abbreviations |
5806
|
|
|
|
|
|
|
# for month is given as: |
5807
|
|
|
|
|
|
|
# "mon month months" |
5808
|
|
|
|
|
|
|
# In order to allow you to enter "m", replacements can be done. |
5809
|
|
|
|
|
|
|
# $replace is a list of pairs of words which are matched and replaced |
5810
|
|
|
|
|
|
|
# AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that |
5811
|
|
|
|
|
|
|
# the entire word "m" will be replaced with "month". This allows the |
5812
|
|
|
|
|
|
|
# desired abbreviation to be used. Make sure that replace contains |
5813
|
|
|
|
|
|
|
# an even number of words (i.e. all must be pairs). Any time a |
5814
|
|
|
|
|
|
|
# desired abbreviation matches the start of any other, it has to go |
5815
|
|
|
|
|
|
|
# here. |
5816
|
|
|
|
|
|
|
# |
5817
|
|
|
|
|
|
|
# $ exact exact mode exactly |
5818
|
|
|
|
|
|
|
# $ approx approximate mode approximately |
5819
|
|
|
|
|
|
|
# $ business business mode business |
5820
|
|
|
|
|
|
|
# |
5821
|
|
|
|
|
|
|
# r sephm hour/minute separator (?::) |
5822
|
|
|
|
|
|
|
# r sepms minute/second separator (?::) |
5823
|
|
|
|
|
|
|
# r sepss second/fraction separator (?:[.:]) |
5824
|
|
|
|
|
|
|
# |
5825
|
|
|
|
|
|
|
# Elements marked with an asterix (@) are returned as a set of lists. |
5826
|
|
|
|
|
|
|
# Each list contains the strings for each element. The first set is used |
5827
|
|
|
|
|
|
|
# when the 7-bit ASCII (US) character set is wanted. The 2nd set is used |
5828
|
|
|
|
|
|
|
# when an international character set is available. Both of the 1st two |
5829
|
|
|
|
|
|
|
# sets should be complete (but the 2nd list can be left empty to force the |
5830
|
|
|
|
|
|
|
# first set to be used always). The 3rd set and later can be partial sets |
5831
|
|
|
|
|
|
|
# if desired. |
5832
|
|
|
|
|
|
|
# |
5833
|
|
|
|
|
|
|
# Elements marked with a dollar ($) are returned as a simple list of words. |
5834
|
|
|
|
|
|
|
# |
5835
|
|
|
|
|
|
|
# Elements marked with a percent (%) are returned as a hash list. |
5836
|
|
|
|
|
|
|
# |
5837
|
|
|
|
|
|
|
# Elements marked with (r) are regular expression elements which must not |
5838
|
|
|
|
|
|
|
# create a back reference. |
5839
|
|
|
|
|
|
|
# |
5840
|
|
|
|
|
|
|
# ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in |
5841
|
|
|
|
|
|
|
# every language. |
5842
|
|
|
|
|
|
|
|
5843
|
|
|
|
|
|
|
sub _Date_Init_English { |
5844
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/); |
5845
|
0
|
|
|
|
|
|
my($d)=@_; |
5846
|
|
|
|
|
|
|
|
5847
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
5848
|
|
|
|
|
|
|
[["January","February","March","April","May","June", |
5849
|
|
|
|
|
|
|
"July","August","September","October","November","December"]]; |
5850
|
|
|
|
|
|
|
|
5851
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
5852
|
|
|
|
|
|
|
[["Jan","Feb","Mar","Apr","May","Jun", |
5853
|
|
|
|
|
|
|
"Jul","Aug","Sep","Oct","Nov","Dec"], |
5854
|
|
|
|
|
|
|
[], |
5855
|
|
|
|
|
|
|
["","","","","","","","","Sept"]]; |
5856
|
|
|
|
|
|
|
|
5857
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
5858
|
|
|
|
|
|
|
[["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]]; |
5859
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
5860
|
|
|
|
|
|
|
[["Mon","Tue","Wed","Thu","Fri","Sat","Sun"], |
5861
|
|
|
|
|
|
|
["", "Tues","", "Thur","", "", ""]]; |
5862
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
5863
|
|
|
|
|
|
|
[["M","T","W","Th","F","Sa","S"]]; |
5864
|
|
|
|
|
|
|
|
5865
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
5866
|
|
|
|
|
|
|
[["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th", |
5867
|
|
|
|
|
|
|
"11th","12th","13th","14th","15th","16th","17th","18th","19th","20th", |
5868
|
|
|
|
|
|
|
"21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th", |
5869
|
|
|
|
|
|
|
"31st"]]; |
5870
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
5871
|
|
|
|
|
|
|
[["first","second","third","fourth","fifth","sixth","seventh","eighth", |
5872
|
|
|
|
|
|
|
"ninth","tenth","eleventh","twelfth","thirteenth","fourteenth", |
5873
|
|
|
|
|
|
|
"fifteenth","sixteenth","seventeenth","eighteenth","nineteenth", |
5874
|
|
|
|
|
|
|
"twentieth","twenty-first","twenty-second","twenty-third", |
5875
|
|
|
|
|
|
|
"twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh", |
5876
|
|
|
|
|
|
|
"twenty-eighth","twenty-ninth","thirtieth","thirty-first"]]; |
5877
|
|
|
|
|
|
|
|
5878
|
0
|
|
|
|
|
|
$$d{"now"} =["now"]; |
5879
|
0
|
|
|
|
|
|
$$d{"today"} =["today"]; |
5880
|
0
|
|
|
|
|
|
$$d{"last"} =["last","final"]; |
5881
|
0
|
|
|
|
|
|
$$d{"each"} =["each","every"]; |
5882
|
0
|
|
|
|
|
|
$$d{"of"} =["in","of"]; |
5883
|
0
|
|
|
|
|
|
$$d{"at"} =["at"]; |
5884
|
0
|
|
|
|
|
|
$$d{"on"} =["on"]; |
5885
|
0
|
|
|
|
|
|
$$d{"future"} =["in"]; |
5886
|
0
|
|
|
|
|
|
$$d{"past"} =["ago"]; |
5887
|
0
|
|
|
|
|
|
$$d{"next"} =["next"]; |
5888
|
0
|
|
|
|
|
|
$$d{"prev"} =["previous","last"]; |
5889
|
0
|
|
|
|
|
|
$$d{"later"} =["later"]; |
5890
|
|
|
|
|
|
|
|
5891
|
0
|
|
|
|
|
|
$$d{"exact"} =["exactly"]; |
5892
|
0
|
|
|
|
|
|
$$d{"approx"} =["approximately"]; |
5893
|
0
|
|
|
|
|
|
$$d{"business"}=["business"]; |
5894
|
|
|
|
|
|
|
|
5895
|
0
|
|
|
|
|
|
$$d{"offset"} =["yesterday","-0:0:0:1:0:0:0","tomorrow","+0:0:0:1:0:0:0","overmorrow","+0:0:0:2:0:0:0","ereyesterday","-0:0:0:2:0:0:0"]; |
5896
|
0
|
|
|
|
|
|
$$d{"times"} =["noon","12:00:00","midnight","00:00:00"]; |
5897
|
|
|
|
|
|
|
|
5898
|
0
|
|
|
|
|
|
$$d{"years"} =["y","yr","year","yrs","years"]; |
5899
|
0
|
|
|
|
|
|
$$d{"months"} =["mon","month","months"]; |
5900
|
0
|
|
|
|
|
|
$$d{"weeks"} =["w","wk","wks","week","weeks"]; |
5901
|
0
|
|
|
|
|
|
$$d{"days"} =["d","day","days"]; |
5902
|
0
|
|
|
|
|
|
$$d{"hours"} =["h","hr","hrs","hour","hours"]; |
5903
|
0
|
|
|
|
|
|
$$d{"minutes"} =["mn","min","minute","minutes"]; |
5904
|
0
|
|
|
|
|
|
$$d{"seconds"} =["s","sec","second","seconds"]; |
5905
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","month"]; |
5906
|
|
|
|
|
|
|
|
5907
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
5908
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
5909
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
5910
|
|
|
|
|
|
|
|
5911
|
0
|
|
|
|
|
|
$$d{"am"} = ["AM","A.M."]; |
5912
|
0
|
|
|
|
|
|
$$d{"pm"} = ["PM","P.M."]; |
5913
|
|
|
|
|
|
|
} |
5914
|
|
|
|
|
|
|
|
5915
|
|
|
|
|
|
|
sub _Date_Init_Italian { |
5916
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/); |
5917
|
0
|
|
|
|
|
|
my($d)=@_; |
5918
|
0
|
|
|
|
|
|
my(%h)=(); |
5919
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
5920
|
0
|
|
|
|
|
|
my($i)=$h{"i`"}; |
5921
|
|
|
|
|
|
|
|
5922
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
5923
|
|
|
|
|
|
|
[[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno |
5924
|
|
|
|
|
|
|
Luglio Agosto Settembre Ottobre Novembre Dicembre)]]; |
5925
|
|
|
|
|
|
|
|
5926
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
5927
|
|
|
|
|
|
|
[[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]]; |
5928
|
|
|
|
|
|
|
|
5929
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
5930
|
|
|
|
|
|
|
[[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)], |
5931
|
|
|
|
|
|
|
[qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]]; |
5932
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
5933
|
|
|
|
|
|
|
[[qw(Lun Mar Mer Gio Ven Sab Dom)]]; |
5934
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
5935
|
|
|
|
|
|
|
[[qw(L Ma Me G V S D)]]; |
5936
|
|
|
|
|
|
|
|
5937
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
5938
|
|
|
|
|
|
|
[[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo |
5939
|
|
|
|
|
|
|
16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo |
5940
|
|
|
|
|
|
|
29mo 3mo 31mo)]]; |
5941
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
5942
|
|
|
|
|
|
|
[[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo |
5943
|
|
|
|
|
|
|
undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo |
5944
|
|
|
|
|
|
|
sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo |
5945
|
|
|
|
|
|
|
ventunesimo ventiduesimo ventitreesimo ventiquattresimo |
5946
|
|
|
|
|
|
|
venticinquesimo ventiseiesimo ventisettesimo ventottesimo |
5947
|
|
|
|
|
|
|
ventinovesimo trentesimo trentunesimo)]]; |
5948
|
|
|
|
|
|
|
|
5949
|
0
|
|
|
|
|
|
$$d{"now"} =[qw(adesso)]; |
5950
|
0
|
|
|
|
|
|
$$d{"today"} =[qw(oggi)]; |
5951
|
0
|
|
|
|
|
|
$$d{"last"} =[qw(ultimo)]; |
5952
|
0
|
|
|
|
|
|
$$d{"each"} =[qw(ogni)]; |
5953
|
0
|
|
|
|
|
|
$$d{"of"} =[qw(della del)]; |
5954
|
0
|
|
|
|
|
|
$$d{"at"} =[qw(alle)]; |
5955
|
0
|
|
|
|
|
|
$$d{"on"} =[qw(di)]; |
5956
|
0
|
|
|
|
|
|
$$d{"future"} =[qw(fra)]; |
5957
|
0
|
|
|
|
|
|
$$d{"past"} =[qw(fa)]; |
5958
|
0
|
|
|
|
|
|
$$d{"next"} =[qw(prossimo)]; |
5959
|
0
|
|
|
|
|
|
$$d{"prev"} =[qw(ultimo)]; |
5960
|
0
|
|
|
|
|
|
$$d{"later"} =[qw(dopo)]; |
5961
|
|
|
|
|
|
|
|
5962
|
0
|
|
|
|
|
|
$$d{"exact"} =[qw(esattamente)]; |
5963
|
0
|
|
|
|
|
|
$$d{"approx"} =[qw(circa)]; |
5964
|
0
|
|
|
|
|
|
$$d{"business"}=[qw(lavorativi lavorativo)]; |
5965
|
|
|
|
|
|
|
|
5966
|
0
|
|
|
|
|
|
$$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)]; |
5967
|
0
|
|
|
|
|
|
$$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)]; |
5968
|
|
|
|
|
|
|
|
5969
|
0
|
|
|
|
|
|
$$d{"years"} =[qw(anni anno a)]; |
5970
|
0
|
|
|
|
|
|
$$d{"months"} =[qw(mesi mese mes)]; |
5971
|
0
|
|
|
|
|
|
$$d{"weeks"} =[qw(settimane settimana sett)]; |
5972
|
0
|
|
|
|
|
|
$$d{"days"} =[qw(giorni giorno g)]; |
5973
|
0
|
|
|
|
|
|
$$d{"hours"} =[qw(ore ora h)]; |
5974
|
0
|
|
|
|
|
|
$$d{"minutes"} =[qw(minuti minuto min)]; |
5975
|
0
|
|
|
|
|
|
$$d{"seconds"} =[qw(secondi secondo sec)]; |
5976
|
0
|
|
|
|
|
|
$$d{"replace"} =[qw(s sec m mes)]; |
5977
|
|
|
|
|
|
|
|
5978
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
5979
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
5980
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
5981
|
|
|
|
|
|
|
|
5982
|
0
|
|
|
|
|
|
$$d{"am"} = [qw(AM)]; |
5983
|
0
|
|
|
|
|
|
$$d{"pm"} = [qw(PM)]; |
5984
|
|
|
|
|
|
|
} |
5985
|
|
|
|
|
|
|
|
5986
|
|
|
|
|
|
|
sub _Date_Init_French { |
5987
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/); |
5988
|
0
|
|
|
|
|
|
my($d)=@_; |
5989
|
0
|
|
|
|
|
|
my(%h)=(); |
5990
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
5991
|
0
|
|
|
|
|
|
my($e)=$h{"e'"}; |
5992
|
0
|
|
|
|
|
|
my($u)=$h{"u^"}; |
5993
|
0
|
|
|
|
|
|
my($a)=$h{"a'"}; |
5994
|
|
|
|
|
|
|
|
5995
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
5996
|
|
|
|
|
|
|
[["janvier","fevrier","mars","avril","mai","juin", |
5997
|
|
|
|
|
|
|
"juillet","aout","septembre","octobre","novembre","decembre"], |
5998
|
|
|
|
|
|
|
["janvier","f${e}vrier","mars","avril","mai","juin", |
5999
|
|
|
|
|
|
|
"juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]]; |
6000
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6001
|
|
|
|
|
|
|
[["jan","fev","mar","avr","mai","juin", |
6002
|
|
|
|
|
|
|
"juil","aout","sept","oct","nov","dec"], |
6003
|
|
|
|
|
|
|
["jan","f${e}v","mar","avr","mai","juin", |
6004
|
|
|
|
|
|
|
"juil","ao${u}t","sept","oct","nov","d${e}c"]]; |
6005
|
|
|
|
|
|
|
|
6006
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6007
|
|
|
|
|
|
|
[["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]]; |
6008
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6009
|
|
|
|
|
|
|
[["lun","mar","mer","jeu","ven","sam","dim"]]; |
6010
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6011
|
|
|
|
|
|
|
[["l","ma","me","j","v","s","d"]]; |
6012
|
|
|
|
|
|
|
|
6013
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6014
|
|
|
|
|
|
|
[["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e", |
6015
|
|
|
|
|
|
|
"11e","12e","13e","14e","15e","16e","17e","18e","19e","20e", |
6016
|
|
|
|
|
|
|
"21e","22e","23e","24e","25e","26e","27e","28e","29e","30e", |
6017
|
|
|
|
|
|
|
"31e"]]; |
6018
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6019
|
|
|
|
|
|
|
[["premier","deux","trois","quatre","cinq","six","sept","huit","neuf", |
6020
|
|
|
|
|
|
|
"dix","onze","douze","treize","quatorze","quinze","seize","dix-sept", |
6021
|
|
|
|
|
|
|
"dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois", |
6022
|
|
|
|
|
|
|
"vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit", |
6023
|
|
|
|
|
|
|
"vingt-neuf","trente","trente et un"], |
6024
|
|
|
|
|
|
|
["1re"]]; |
6025
|
|
|
|
|
|
|
|
6026
|
0
|
|
|
|
|
|
$$d{"now"} =["maintenant"]; |
6027
|
0
|
|
|
|
|
|
$$d{"today"} =["aujourd'hui"]; |
6028
|
0
|
|
|
|
|
|
$$d{"last"} =["dernier"]; |
6029
|
0
|
|
|
|
|
|
$$d{"each"} =["chaque","tous les","toutes les"]; |
6030
|
0
|
|
|
|
|
|
$$d{"of"} =["en","de"]; |
6031
|
0
|
|
|
|
|
|
$$d{"at"} =["a","${a}0"]; |
6032
|
0
|
|
|
|
|
|
$$d{"on"} =["sur"]; |
6033
|
0
|
|
|
|
|
|
$$d{"future"} =["en"]; |
6034
|
0
|
|
|
|
|
|
$$d{"past"} =["il y a"]; |
6035
|
0
|
|
|
|
|
|
$$d{"next"} =["suivant"]; |
6036
|
0
|
|
|
|
|
|
$$d{"prev"} =["precedent","pr${e}c${e}dent"]; |
6037
|
0
|
|
|
|
|
|
$$d{"later"} =["plus tard"]; |
6038
|
|
|
|
|
|
|
|
6039
|
0
|
|
|
|
|
|
$$d{"exact"} =["exactement"]; |
6040
|
0
|
|
|
|
|
|
$$d{"approx"} =["approximativement"]; |
6041
|
0
|
|
|
|
|
|
$$d{"business"}=["professionel"]; |
6042
|
|
|
|
|
|
|
|
6043
|
0
|
|
|
|
|
|
$$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"]; |
6044
|
0
|
|
|
|
|
|
$$d{"times"} =["midi","12:00:00","minuit","00:00:00"]; |
6045
|
|
|
|
|
|
|
|
6046
|
0
|
|
|
|
|
|
$$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"]; |
6047
|
0
|
|
|
|
|
|
$$d{"months"} =["mois"]; |
6048
|
0
|
|
|
|
|
|
$$d{"weeks"} =["sem","semaine"]; |
6049
|
0
|
|
|
|
|
|
$$d{"days"} =["j","jour","jours"]; |
6050
|
0
|
|
|
|
|
|
$$d{"hours"} =["h","heure","heures"]; |
6051
|
0
|
|
|
|
|
|
$$d{"minutes"} =["mn","min","minute","minutes"]; |
6052
|
0
|
|
|
|
|
|
$$d{"seconds"} =["s","sec","seconde","secondes"]; |
6053
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","mois"]; |
6054
|
|
|
|
|
|
|
|
6055
|
0
|
|
|
|
|
|
$$d{"sephm"} ='[h:]'; |
6056
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
6057
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:,]'; |
6058
|
|
|
|
|
|
|
|
6059
|
0
|
|
|
|
|
|
$$d{"am"} = ["du matin"]; |
6060
|
0
|
|
|
|
|
|
$$d{"pm"} = ["du soir"]; |
6061
|
|
|
|
|
|
|
} |
6062
|
|
|
|
|
|
|
|
6063
|
|
|
|
|
|
|
sub _Date_Init_Romanian { |
6064
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/); |
6065
|
0
|
|
|
|
|
|
my($d)=@_; |
6066
|
0
|
|
|
|
|
|
my(%h)=(); |
6067
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
6068
|
0
|
|
|
|
|
|
my($p)=$h{"p"}; |
6069
|
0
|
|
|
|
|
|
my($i)=$h{"i^"}; |
6070
|
0
|
|
|
|
|
|
my($a)=$h{"a~"}; |
6071
|
0
|
|
|
|
|
|
my($o)=$h{"-o"}; |
6072
|
|
|
|
|
|
|
|
6073
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6074
|
|
|
|
|
|
|
[["ianuarie","februarie","martie","aprilie","mai","iunie", |
6075
|
|
|
|
|
|
|
"iulie","august","septembrie","octombrie","noiembrie","decembrie"]]; |
6076
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6077
|
|
|
|
|
|
|
[["ian","febr","mart","apr","mai","iun", |
6078
|
|
|
|
|
|
|
"iul","aug","sept","oct","nov","dec"], |
6079
|
|
|
|
|
|
|
["","feb"]]; |
6080
|
|
|
|
|
|
|
|
6081
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6082
|
|
|
|
|
|
|
[["luni","marti","miercuri","joi","vineri","simbata","duminica"], |
6083
|
|
|
|
|
|
|
["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}", |
6084
|
|
|
|
|
|
|
"duminic${a}"]]; |
6085
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6086
|
|
|
|
|
|
|
[["lun","mar","mie","joi","vin","sim","dum"], |
6087
|
|
|
|
|
|
|
["lun","mar","mie","joi","vin","s${i}m","dum"]]; |
6088
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6089
|
|
|
|
|
|
|
[["L","Ma","Mi","J","V","S","D"]]; |
6090
|
|
|
|
|
|
|
|
6091
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6092
|
|
|
|
|
|
|
[["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a", |
6093
|
|
|
|
|
|
|
"a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a", |
6094
|
|
|
|
|
|
|
"a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a", |
6095
|
|
|
|
|
|
|
"a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a", |
6096
|
|
|
|
|
|
|
"a 30-a","a 31-a"]]; |
6097
|
|
|
|
|
|
|
|
6098
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6099
|
|
|
|
|
|
|
[["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea", |
6100
|
|
|
|
|
|
|
"a opta","a noua","a zecea","a unsprezecea","a doisprezecea", |
6101
|
|
|
|
|
|
|
"a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea", |
6102
|
|
|
|
|
|
|
"a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea", |
6103
|
|
|
|
|
|
|
"a douazecisiuna","a douazecisidoua","a douazecisitreia", |
6104
|
|
|
|
|
|
|
"a douazecisipatra","a douazecisicincea","a douazecisisasea", |
6105
|
|
|
|
|
|
|
"a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea", |
6106
|
|
|
|
|
|
|
"a treizecisiuna"], |
6107
|
|
|
|
|
|
|
["prima","a doua","a treia","a patra","a cincea","a ${o}asea", |
6108
|
|
|
|
|
|
|
"a ${o}aptea","a opta","a noua","a zecea","a unsprezecea", |
6109
|
|
|
|
|
|
|
"a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea", |
6110
|
|
|
|
|
|
|
"a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea", |
6111
|
|
|
|
|
|
|
"a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna", |
6112
|
|
|
|
|
|
|
"a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia", |
6113
|
|
|
|
|
|
|
"a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea", |
6114
|
|
|
|
|
|
|
"a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea", |
6115
|
|
|
|
|
|
|
"a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea", |
6116
|
|
|
|
|
|
|
"a treizeci${o}iuna"], |
6117
|
|
|
|
|
|
|
["intii", "doi", "trei", "patru", "cinci", "sase", "sapte", |
6118
|
|
|
|
|
|
|
"opt","noua","zece","unsprezece","doisprezece", |
6119
|
|
|
|
|
|
|
"treisprezece","patrusprezece","cincisprezece","saiprezece", |
6120
|
|
|
|
|
|
|
"saptesprezece","optsprezece","nouasprezece","douazeci", |
6121
|
|
|
|
|
|
|
"douazecisiunu","douazecisidoi","douazecisitrei", |
6122
|
|
|
|
|
|
|
"douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte", |
6123
|
|
|
|
|
|
|
"douazecisiopt","douazecisinoua","treizeci","treizecisiunu"], |
6124
|
|
|
|
|
|
|
["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte", |
6125
|
|
|
|
|
|
|
"opt","nou${a}","zece","unsprezece","doisprezece", |
6126
|
|
|
|
|
|
|
"treisprezece","patrusprezece","cincisprezece","${o}aiprezece", |
6127
|
|
|
|
|
|
|
"${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci", |
6128
|
|
|
|
|
|
|
"dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei", |
6129
|
|
|
|
|
|
|
"dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase", |
6130
|
|
|
|
|
|
|
"dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt", |
6131
|
|
|
|
|
|
|
"dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]]; |
6132
|
|
|
|
|
|
|
|
6133
|
0
|
|
|
|
|
|
$$d{"now"} =["acum"]; |
6134
|
0
|
|
|
|
|
|
$$d{"today"} =["azi","astazi","ast${a}zi"]; |
6135
|
0
|
|
|
|
|
|
$$d{"last"} =["ultima"]; |
6136
|
0
|
|
|
|
|
|
$$d{"each"} =["fiecare"]; |
6137
|
0
|
|
|
|
|
|
$$d{"of"} =["din","in","n"]; |
6138
|
0
|
|
|
|
|
|
$$d{"at"} =["la"]; |
6139
|
0
|
|
|
|
|
|
$$d{"on"} =["on"]; |
6140
|
0
|
|
|
|
|
|
$$d{"future"} =["in","${i}n"]; |
6141
|
0
|
|
|
|
|
|
$$d{"past"} =["in urma", "${i}n urm${a}"]; |
6142
|
0
|
|
|
|
|
|
$$d{"next"} =["urmatoarea","urm${a}toarea"]; |
6143
|
0
|
|
|
|
|
|
$$d{"prev"} =["precedenta","ultima"]; |
6144
|
0
|
|
|
|
|
|
$$d{"later"} =["mai tirziu", "mai t${i}rziu"]; |
6145
|
|
|
|
|
|
|
|
6146
|
0
|
|
|
|
|
|
$$d{"exact"} =["exact"]; |
6147
|
0
|
|
|
|
|
|
$$d{"approx"} =["aproximativ"]; |
6148
|
0
|
|
|
|
|
|
$$d{"business"}=["de lucru","lucratoare","lucr${a}toare"]; |
6149
|
|
|
|
|
|
|
|
6150
|
0
|
|
|
|
|
|
$$d{"offset"} =["ieri","-0:0:0:1:0:0:0", |
6151
|
|
|
|
|
|
|
"alaltaieri", "-0:0:0:2:0:0:0", |
6152
|
|
|
|
|
|
|
"alalt${a}ieri","-0:0:0:2:0:0:0", |
6153
|
|
|
|
|
|
|
"miine","+0:0:0:1:0:0:0", |
6154
|
|
|
|
|
|
|
"m${i}ine","+0:0:0:1:0:0:0", |
6155
|
|
|
|
|
|
|
"poimiine","+0:0:0:2:0:0:0", |
6156
|
|
|
|
|
|
|
"poim${i}ine","+0:0:0:2:0:0:0"]; |
6157
|
0
|
|
|
|
|
|
$$d{"times"} =["amiaza","12:00:00", |
6158
|
|
|
|
|
|
|
"amiaz${a}","12:00:00", |
6159
|
|
|
|
|
|
|
"miezul noptii","00:00:00", |
6160
|
|
|
|
|
|
|
"miezul nop${p}ii","00:00:00"]; |
6161
|
|
|
|
|
|
|
|
6162
|
0
|
|
|
|
|
|
$$d{"years"} =["ani","an","a"]; |
6163
|
0
|
|
|
|
|
|
$$d{"months"} =["luni","luna","lun${a}","l"]; |
6164
|
0
|
|
|
|
|
|
$$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina", |
6165
|
|
|
|
|
|
|
"s${a}pt${a}m${i}na","sapt","s${a}pt"]; |
6166
|
0
|
|
|
|
|
|
$$d{"days"} =["zile","zi","z"]; |
6167
|
0
|
|
|
|
|
|
$$d{"hours"} =["ore", "ora", "or${a}", "h"]; |
6168
|
0
|
|
|
|
|
|
$$d{"minutes"} =["minute","min","m"]; |
6169
|
0
|
|
|
|
|
|
$$d{"seconds"} =["secunde","sec",]; |
6170
|
0
|
|
|
|
|
|
$$d{"replace"} =["s","secunde"]; |
6171
|
|
|
|
|
|
|
|
6172
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
6173
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
6174
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:,]'; |
6175
|
|
|
|
|
|
|
|
6176
|
0
|
|
|
|
|
|
$$d{"am"} = ["AM","A.M."]; |
6177
|
0
|
|
|
|
|
|
$$d{"pm"} = ["PM","P.M."]; |
6178
|
|
|
|
|
|
|
} |
6179
|
|
|
|
|
|
|
|
6180
|
|
|
|
|
|
|
sub _Date_Init_Swedish { |
6181
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/); |
6182
|
0
|
|
|
|
|
|
my($d)=@_; |
6183
|
0
|
|
|
|
|
|
my(%h)=(); |
6184
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
6185
|
0
|
|
|
|
|
|
my($ao)=$h{"ao"}; |
6186
|
0
|
|
|
|
|
|
my($o) =$h{"o:"}; |
6187
|
0
|
|
|
|
|
|
my($a) =$h{"a:"}; |
6188
|
|
|
|
|
|
|
|
6189
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6190
|
|
|
|
|
|
|
[["Januari","Februari","Mars","April","Maj","Juni", |
6191
|
|
|
|
|
|
|
"Juli","Augusti","September","Oktober","November","December"]]; |
6192
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6193
|
|
|
|
|
|
|
[["Jan","Feb","Mar","Apr","Maj","Jun", |
6194
|
|
|
|
|
|
|
"Jul","Aug","Sep","Okt","Nov","Dec"]]; |
6195
|
|
|
|
|
|
|
|
6196
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6197
|
|
|
|
|
|
|
[["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"], |
6198
|
|
|
|
|
|
|
["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag", |
6199
|
|
|
|
|
|
|
"S${o}ndag"]]; |
6200
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6201
|
|
|
|
|
|
|
[["Man","Tis","Ons","Tor","Fre","Lor","Son"], |
6202
|
|
|
|
|
|
|
["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]]; |
6203
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6204
|
|
|
|
|
|
|
[["M","Ti","O","To","F","L","S"]]; |
6205
|
|
|
|
|
|
|
|
6206
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6207
|
|
|
|
|
|
|
[["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e", |
6208
|
|
|
|
|
|
|
"11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e", |
6209
|
|
|
|
|
|
|
"21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e", |
6210
|
|
|
|
|
|
|
"31:a"]]; |
6211
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6212
|
|
|
|
|
|
|
[["forsta","andra","tredje","fjarde","femte","sjatte","sjunde", |
6213
|
|
|
|
|
|
|
"attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde", |
6214
|
|
|
|
|
|
|
"femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde", |
6215
|
|
|
|
|
|
|
"tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte", |
6216
|
|
|
|
|
|
|
"tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde", |
6217
|
|
|
|
|
|
|
"trettionde","trettioforsta"], |
6218
|
|
|
|
|
|
|
["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde", |
6219
|
|
|
|
|
|
|
"${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde", |
6220
|
|
|
|
|
|
|
"femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde", |
6221
|
|
|
|
|
|
|
"tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte", |
6222
|
|
|
|
|
|
|
"tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde", |
6223
|
|
|
|
|
|
|
"trettionde","trettiof${o}rsta"]]; |
6224
|
|
|
|
|
|
|
|
6225
|
0
|
|
|
|
|
|
$$d{"now"} =["nu"]; |
6226
|
0
|
|
|
|
|
|
$$d{"today"} =["idag"]; |
6227
|
0
|
|
|
|
|
|
$$d{"last"} =["forra","f${o}rra","senaste"]; |
6228
|
0
|
|
|
|
|
|
$$d{"each"} =["varje"]; |
6229
|
0
|
|
|
|
|
|
$$d{"of"} =["om"]; |
6230
|
0
|
|
|
|
|
|
$$d{"at"} =["kl","kl.","klockan"]; |
6231
|
0
|
|
|
|
|
|
$$d{"on"} =["pa","p${ao}"]; |
6232
|
0
|
|
|
|
|
|
$$d{"future"} =["om"]; |
6233
|
0
|
|
|
|
|
|
$$d{"past"} =["sedan"]; |
6234
|
0
|
|
|
|
|
|
$$d{"next"} =["nasta","n${a}sta"]; |
6235
|
0
|
|
|
|
|
|
$$d{"prev"} =["forra","f${o}rra"]; |
6236
|
0
|
|
|
|
|
|
$$d{"later"} =["senare"]; |
6237
|
|
|
|
|
|
|
|
6238
|
0
|
|
|
|
|
|
$$d{"exact"} =["exakt"]; |
6239
|
0
|
|
|
|
|
|
$$d{"approx"} =["ungefar","ungef${a}r"]; |
6240
|
0
|
|
|
|
|
|
$$d{"business"}=["arbetsdag","arbetsdagar"]; |
6241
|
|
|
|
|
|
|
|
6242
|
0
|
|
|
|
|
|
$$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0", |
6243
|
|
|
|
|
|
|
"imorgon","+0:0:0:1:0:0:0"]; |
6244
|
0
|
|
|
|
|
|
$$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00", |
6245
|
|
|
|
|
|
|
"midnatt","00:00:00"]; |
6246
|
|
|
|
|
|
|
|
6247
|
0
|
|
|
|
|
|
$$d{"years"} =["ar","${ao}r"]; |
6248
|
0
|
|
|
|
|
|
$$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"]; |
6249
|
0
|
|
|
|
|
|
$$d{"weeks"} =["v","vecka","veckor"]; |
6250
|
0
|
|
|
|
|
|
$$d{"days"} =["d","dag","dagar"]; |
6251
|
0
|
|
|
|
|
|
$$d{"hours"} =["t","tim","timme","timmar"]; |
6252
|
0
|
|
|
|
|
|
$$d{"minutes"} =["min","minut","minuter"]; |
6253
|
0
|
|
|
|
|
|
$$d{"seconds"} =["s","sek","sekund","sekunder"]; |
6254
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","minut"]; |
6255
|
|
|
|
|
|
|
|
6256
|
0
|
|
|
|
|
|
$$d{"sephm"} ='[.:]'; |
6257
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
6258
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
6259
|
|
|
|
|
|
|
|
6260
|
0
|
|
|
|
|
|
$$d{"am"} = ["FM"]; |
6261
|
0
|
|
|
|
|
|
$$d{"pm"} = ["EM"]; |
6262
|
|
|
|
|
|
|
} |
6263
|
|
|
|
|
|
|
|
6264
|
|
|
|
|
|
|
sub _Date_Init_German { |
6265
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/); |
6266
|
0
|
|
|
|
|
|
my($d)=@_; |
6267
|
0
|
|
|
|
|
|
my(%h)=(); |
6268
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
6269
|
0
|
|
|
|
|
|
my($a)=$h{"a:"}; |
6270
|
0
|
|
|
|
|
|
my($u)=$h{"u:"}; |
6271
|
0
|
|
|
|
|
|
my($o)=$h{"o:"}; |
6272
|
0
|
|
|
|
|
|
my($b)=$h{"beta"}; |
6273
|
|
|
|
|
|
|
|
6274
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6275
|
|
|
|
|
|
|
[["Januar","Februar","Maerz","April","Mai","Juni", |
6276
|
|
|
|
|
|
|
"Juli","August","September","Oktober","November","Dezember"], |
6277
|
|
|
|
|
|
|
["J${a}nner","Februar","M${a}rz","April","Mai","Juni", |
6278
|
|
|
|
|
|
|
"Juli","August","September","Oktober","November","Dezember"]]; |
6279
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6280
|
|
|
|
|
|
|
[["Jan","Feb","Mar","Apr","Mai","Jun", |
6281
|
|
|
|
|
|
|
"Jul","Aug","Sep","Okt","Nov","Dez"], |
6282
|
|
|
|
|
|
|
["J${a}n","Feb","M${a}r","Apr","Mai","Jun", |
6283
|
|
|
|
|
|
|
"Jul","Aug","Sep","Okt","Nov","Dez"]]; |
6284
|
|
|
|
|
|
|
|
6285
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6286
|
|
|
|
|
|
|
[["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag", |
6287
|
|
|
|
|
|
|
"Sonntag"]]; |
6288
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6289
|
|
|
|
|
|
|
[["Mo","Di","Mi","Do","Fr","Sa","So"]]; |
6290
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6291
|
|
|
|
|
|
|
[["M","Di","Mi","Do","F","Sa","So"]]; |
6292
|
|
|
|
|
|
|
|
6293
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6294
|
|
|
|
|
|
|
[["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.", |
6295
|
|
|
|
|
|
|
"11.","12.","13.","14.","15.","16.","17.","18.","19.","20.", |
6296
|
|
|
|
|
|
|
"21.","22.","23.","24.","25.","26.","27.","28.","29.","30.", |
6297
|
|
|
|
|
|
|
"31."]]; |
6298
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6299
|
|
|
|
|
|
|
[ |
6300
|
|
|
|
|
|
|
["erste","zweite","dritte","vierte","funfte","sechste","siebente", |
6301
|
|
|
|
|
|
|
"achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte", |
6302
|
|
|
|
|
|
|
"funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte", |
6303
|
|
|
|
|
|
|
"zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste", |
6304
|
|
|
|
|
|
|
"vierundzwanzigste","funfundzwanzigste","sechundzwanzigste", |
6305
|
|
|
|
|
|
|
"siebundzwanzigste","achtundzwanzigste","neunundzwanzigste", |
6306
|
|
|
|
|
|
|
"dreibigste","einunddreibigste"], |
6307
|
|
|
|
|
|
|
["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente", |
6308
|
|
|
|
|
|
|
"achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte", |
6309
|
|
|
|
|
|
|
"vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte", |
6310
|
|
|
|
|
|
|
"neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste", |
6311
|
|
|
|
|
|
|
"dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste", |
6312
|
|
|
|
|
|
|
"sechundzwanzigste","siebundzwanzigste","achtundzwanzigste", |
6313
|
|
|
|
|
|
|
"neunundzwanzigste","drei${b}igste","einunddrei${b}igste"], |
6314
|
|
|
|
|
|
|
["erster"]]; |
6315
|
|
|
|
|
|
|
|
6316
|
0
|
|
|
|
|
|
$$d{"now"} =["jetzt"]; |
6317
|
0
|
|
|
|
|
|
$$d{"today"} =["heute"]; |
6318
|
0
|
|
|
|
|
|
$$d{"last"} =["letzte","letzten"]; |
6319
|
0
|
|
|
|
|
|
$$d{"each"} =["jeden"]; |
6320
|
0
|
|
|
|
|
|
$$d{"of"} =["der","im","des"]; |
6321
|
0
|
|
|
|
|
|
$$d{"at"} =["um"]; |
6322
|
0
|
|
|
|
|
|
$$d{"on"} =["am"]; |
6323
|
0
|
|
|
|
|
|
$$d{"future"} =["in"]; |
6324
|
0
|
|
|
|
|
|
$$d{"past"} =["vor"]; |
6325
|
0
|
|
|
|
|
|
$$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"]; |
6326
|
0
|
|
|
|
|
|
$$d{"prev"} =["vorherigen","vorherige","letzte","letzten"]; |
6327
|
0
|
|
|
|
|
|
$$d{"later"} =["spater","sp${a}ter"]; |
6328
|
|
|
|
|
|
|
|
6329
|
0
|
|
|
|
|
|
$$d{"exact"} =["genau"]; |
6330
|
0
|
|
|
|
|
|
$$d{"approx"} =["ungefahr","ungef${a}hr"]; |
6331
|
0
|
|
|
|
|
|
$$d{"business"}=["Arbeitstag"]; |
6332
|
|
|
|
|
|
|
|
6333
|
0
|
|
|
|
|
|
$$d{"offset"} =["gestern","-0:0:0:1:0:0:0","morgen","+0:0:0:1:0:0:0","${u}bermorgen","+0:0:0:2:0:0:0"]; |
6334
|
0
|
|
|
|
|
|
$$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"]; |
6335
|
|
|
|
|
|
|
|
6336
|
0
|
|
|
|
|
|
$$d{"years"} =["j","Jahr","Jahre","Jahren"]; |
6337
|
0
|
|
|
|
|
|
$$d{"months"} =["Monat","Monate","Monaten"]; |
6338
|
0
|
|
|
|
|
|
$$d{"weeks"} =["w","Woche","Wochen"]; |
6339
|
0
|
|
|
|
|
|
$$d{"days"} =["t","Tag","Tage","Tagen"]; |
6340
|
0
|
|
|
|
|
|
$$d{"hours"} =["h","std","Stunde","Stunden"]; |
6341
|
0
|
|
|
|
|
|
$$d{"minutes"} =["min","Minute","Minuten"]; |
6342
|
0
|
|
|
|
|
|
$$d{"seconds"} =["s","sek","Sekunde","Sekunden"]; |
6343
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","Monat"]; |
6344
|
|
|
|
|
|
|
|
6345
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
6346
|
0
|
|
|
|
|
|
$$d{"sepms"} ='[: ]'; |
6347
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
6348
|
|
|
|
|
|
|
|
6349
|
0
|
|
|
|
|
|
$$d{"am"} = ["FM"]; |
6350
|
0
|
|
|
|
|
|
$$d{"pm"} = ["EM"]; |
6351
|
|
|
|
|
|
|
} |
6352
|
|
|
|
|
|
|
|
6353
|
|
|
|
|
|
|
sub _Date_Init_Dutch { |
6354
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/); |
6355
|
0
|
|
|
|
|
|
my($d)=@_; |
6356
|
0
|
|
|
|
|
|
my(%h)=(); |
6357
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
6358
|
|
|
|
|
|
|
|
6359
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6360
|
|
|
|
|
|
|
[["januari","februari","maart","april","mei","juni","juli","augustus", |
6361
|
|
|
|
|
|
|
"september","october","november","december"], |
6362
|
|
|
|
|
|
|
["","","","","","","","","","oktober"]]; |
6363
|
|
|
|
|
|
|
|
6364
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6365
|
|
|
|
|
|
|
[["jan","feb","maa","apr","mei","jun","jul", |
6366
|
|
|
|
|
|
|
"aug","sep","oct","nov","dec"], |
6367
|
|
|
|
|
|
|
["","","mrt","","","","","","","okt"]]; |
6368
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6369
|
|
|
|
|
|
|
[["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag", |
6370
|
|
|
|
|
|
|
"zondag"]]; |
6371
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6372
|
|
|
|
|
|
|
[["ma","di","wo","do","vr","zat","zon"], |
6373
|
|
|
|
|
|
|
["","","","","","za","zo"]]; |
6374
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6375
|
|
|
|
|
|
|
[["M","D","W","D","V","Za","Zo"]]; |
6376
|
|
|
|
|
|
|
|
6377
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6378
|
|
|
|
|
|
|
[["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de", |
6379
|
|
|
|
|
|
|
"11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste", |
6380
|
|
|
|
|
|
|
"21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste", |
6381
|
|
|
|
|
|
|
"30ste","31ste"]]; |
6382
|
|
|
|
|
|
|
$$d{"num_word"}= |
6383
|
|
|
|
|
|
|
[["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste", |
6384
|
|
|
|
|
|
|
"negende","tiende","elfde","twaalfde", |
6385
|
0
|
|
|
|
|
|
map {"${_}tiende";} qw (der veer vijf zes zeven acht negen), |
6386
|
|
|
|
|
|
|
"twintigste", |
6387
|
0
|
|
|
|
|
|
map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht |
6388
|
|
|
|
|
|
|
negen), |
6389
|
|
|
|
|
|
|
"dertigste","eenendertigste"], |
6390
|
|
|
|
|
|
|
["","","","","","","","","","","","","","","","","","","","", |
6391
|
0
|
|
|
|
|
|
map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht |
6392
|
|
|
|
|
|
|
negen), |
6393
|
|
|
|
|
|
|
"dertigste","een-en-dertigste"], |
6394
|
|
|
|
|
|
|
["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien", |
6395
|
|
|
|
|
|
|
"elf","twaalf", |
6396
|
0
|
|
|
|
|
|
map {"${_}tien"} qw (der veer vijf zes zeven acht negen), |
6397
|
|
|
|
|
|
|
"twintig", |
6398
|
0
|
|
|
|
|
|
map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen), |
6399
|
|
|
|
|
|
|
"dertig","eenendertig"], |
6400
|
|
|
|
|
|
|
["","","","","","","","","","","","","","","","","","","","", |
6401
|
0
|
|
|
|
|
|
map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht |
|
0
|
|
|
|
|
|
|
6402
|
|
|
|
|
|
|
negen), |
6403
|
|
|
|
|
|
|
"dertig","een-en-dertig"]]; |
6404
|
|
|
|
|
|
|
|
6405
|
0
|
|
|
|
|
|
$$d{"now"} =["nu","nou"]; |
6406
|
0
|
|
|
|
|
|
$$d{"today"} =["vandaag"]; |
6407
|
0
|
|
|
|
|
|
$$d{"last"} =["laatste"]; |
6408
|
0
|
|
|
|
|
|
$$d{"each"} =["elke","elk"]; |
6409
|
0
|
|
|
|
|
|
$$d{"of"} =["in","van"]; |
6410
|
0
|
|
|
|
|
|
$$d{"at"} =["om"]; |
6411
|
0
|
|
|
|
|
|
$$d{"on"} =["op"]; |
6412
|
0
|
|
|
|
|
|
$$d{"future"} =["over"]; |
6413
|
0
|
|
|
|
|
|
$$d{"past"} =["geleden","vroeger","eerder"]; |
6414
|
0
|
|
|
|
|
|
$$d{"next"} =["volgende","volgend"]; |
6415
|
0
|
|
|
|
|
|
$$d{"prev"} =["voorgaande","voorgaand"]; |
6416
|
0
|
|
|
|
|
|
$$d{"later"} =["later"]; |
6417
|
|
|
|
|
|
|
|
6418
|
0
|
|
|
|
|
|
$$d{"exact"} =["exact","precies","nauwkeurig"]; |
6419
|
0
|
|
|
|
|
|
$$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.']; |
6420
|
0
|
|
|
|
|
|
$$d{"business"}=["werk","zakelijke","zakelijk"]; |
6421
|
|
|
|
|
|
|
|
6422
|
0
|
|
|
|
|
|
$$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0", |
6423
|
|
|
|
|
|
|
"gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"]; |
6424
|
0
|
|
|
|
|
|
$$d{"times"} =["noen","12:00:00","middernacht","00:00:00"]; |
6425
|
|
|
|
|
|
|
|
6426
|
0
|
|
|
|
|
|
$$d{"years"} =["jaar","jaren","ja","j"]; |
6427
|
0
|
|
|
|
|
|
$$d{"months"} =["maand","maanden","mnd"]; |
6428
|
0
|
|
|
|
|
|
$$d{"weeks"} =["week","weken","w"]; |
6429
|
0
|
|
|
|
|
|
$$d{"days"} =["dag","dagen","d"]; |
6430
|
0
|
|
|
|
|
|
$$d{"hours"} =["uur","uren","u","h"]; |
6431
|
0
|
|
|
|
|
|
$$d{"minutes"} =["minuut","minuten","min"]; |
6432
|
0
|
|
|
|
|
|
$$d{"seconds"} =["seconde","seconden","sec","s"]; |
6433
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","minuten"]; |
6434
|
|
|
|
|
|
|
|
6435
|
0
|
|
|
|
|
|
$$d{"sephm"} ='[:.uh]'; |
6436
|
0
|
|
|
|
|
|
$$d{"sepms"} ='[:.m]'; |
6437
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
6438
|
|
|
|
|
|
|
|
6439
|
0
|
|
|
|
|
|
$$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends", |
6440
|
|
|
|
|
|
|
"ochtend","'s_nachts","nacht"]; |
6441
|
0
|
|
|
|
|
|
$$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag", |
6442
|
|
|
|
|
|
|
"'s_avonds","avond"]; |
6443
|
|
|
|
|
|
|
} |
6444
|
|
|
|
|
|
|
|
6445
|
|
|
|
|
|
|
sub _Date_Init_Polish { |
6446
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/); |
6447
|
0
|
|
|
|
|
|
my($d)=@_; |
6448
|
|
|
|
|
|
|
|
6449
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6450
|
|
|
|
|
|
|
[["stycznia","luty","marca","kwietnia","maja","czerwca", |
6451
|
|
|
|
|
|
|
"lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"], |
6452
|
|
|
|
|
|
|
["stycznia","luty","marca","kwietnia","maja","czerwca","lipca", |
6453
|
|
|
|
|
|
|
"sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]]; |
6454
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6455
|
|
|
|
|
|
|
[["sty.","lut.","mar.","kwi.","maj","cze.", |
6456
|
|
|
|
|
|
|
"lip.","sie.","wrz.","paz.","lis.","gru."], |
6457
|
|
|
|
|
|
|
["sty.","lut.","mar.","kwi.","maj","cze.", |
6458
|
|
|
|
|
|
|
"lip.","sie.","wrz.","pa\x9f.","lis.","gru."]]; |
6459
|
|
|
|
|
|
|
|
6460
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6461
|
|
|
|
|
|
|
[["poniedzialek","wtorek","sroda","czwartek","piatek","sobota", |
6462
|
|
|
|
|
|
|
"niedziela"], |
6463
|
|
|
|
|
|
|
["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek", |
6464
|
|
|
|
|
|
|
"sobota","niedziela"]]; |
6465
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6466
|
|
|
|
|
|
|
[["po.","wt.","sr.","cz.","pi.","so.","ni."], |
6467
|
|
|
|
|
|
|
["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]]; |
6468
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6469
|
|
|
|
|
|
|
[["p","w","e","c","p","s","n"], |
6470
|
|
|
|
|
|
|
["p","w","\x9c.","c","p","s","n"]]; |
6471
|
|
|
|
|
|
|
|
6472
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6473
|
|
|
|
|
|
|
[["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.", |
6474
|
|
|
|
|
|
|
"11.","12.","13.","14.","15.","16.","17.","18.","19.","20.", |
6475
|
|
|
|
|
|
|
"21.","22.","23.","24.","25.","26.","27.","28.","29.","30.", |
6476
|
|
|
|
|
|
|
"31."]]; |
6477
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6478
|
|
|
|
|
|
|
[["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego", |
6479
|
|
|
|
|
|
|
"siodmego","osmego","dziewiatego","dziesiatego", |
6480
|
|
|
|
|
|
|
"jedenastego","dwunastego","trzynastego","czternastego","pietnastego", |
6481
|
|
|
|
|
|
|
"szestnastego","siedemnastego","osiemnastego","dziewietnastego", |
6482
|
|
|
|
|
|
|
"dwudziestego", |
6483
|
|
|
|
|
|
|
"dwudziestego pierwszego","dwudziestego drugiego", |
6484
|
|
|
|
|
|
|
"dwudziestego trzeczego","dwudziestego czwartego", |
6485
|
|
|
|
|
|
|
"dwudziestego piatego","dwudziestego szostego", |
6486
|
|
|
|
|
|
|
"dwudziestego siodmego","dwudziestego osmego", |
6487
|
|
|
|
|
|
|
"dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"], |
6488
|
|
|
|
|
|
|
["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego", |
6489
|
|
|
|
|
|
|
"sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego", |
6490
|
|
|
|
|
|
|
"dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego", |
6491
|
|
|
|
|
|
|
"czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego", |
6492
|
|
|
|
|
|
|
"osiemnastego","dziewietnastego","dwudziestego", |
6493
|
|
|
|
|
|
|
"dwudziestego pierwszego","dwudziestego drugiego", |
6494
|
|
|
|
|
|
|
"dwudziestego trzeczego","dwudziestego czwartego", |
6495
|
|
|
|
|
|
|
"dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego", |
6496
|
|
|
|
|
|
|
"dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego", |
6497
|
|
|
|
|
|
|
"dwudziestego dziewi\x81\xb9tego","trzydziestego", |
6498
|
|
|
|
|
|
|
"trzydziestego pierwszego"]]; |
6499
|
|
|
|
|
|
|
|
6500
|
0
|
|
|
|
|
|
$$d{"now"} =["teraz"]; |
6501
|
0
|
|
|
|
|
|
$$d{"today"} =["dzisaj"]; |
6502
|
0
|
|
|
|
|
|
$$d{"last"} =["ostatni","ostatna"]; |
6503
|
0
|
|
|
|
|
|
$$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"]; |
6504
|
0
|
|
|
|
|
|
$$d{"of"} =["w","z"]; |
6505
|
0
|
|
|
|
|
|
$$d{"at"} =["o","u"]; |
6506
|
0
|
|
|
|
|
|
$$d{"on"} =["na"]; |
6507
|
0
|
|
|
|
|
|
$$d{"future"} =["za"]; |
6508
|
0
|
|
|
|
|
|
$$d{"past"} =["temu"]; |
6509
|
0
|
|
|
|
|
|
$$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym", |
6510
|
|
|
|
|
|
|
"przyszly","przysz\x81\xb3y","przyszlym", |
6511
|
|
|
|
|
|
|
"przysz\x81\xb3ym"]; |
6512
|
0
|
|
|
|
|
|
$$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"]; |
6513
|
0
|
|
|
|
|
|
$$d{"later"} =["later"]; |
6514
|
|
|
|
|
|
|
|
6515
|
0
|
|
|
|
|
|
$$d{"exact"} =["doklandnie","dok\x81\xb3andnie"]; |
6516
|
0
|
|
|
|
|
|
$$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej", |
6517
|
|
|
|
|
|
|
"mniej wi\x81\xeacej","okolo","oko\x81\xb3o"]; |
6518
|
0
|
|
|
|
|
|
$$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym", |
6519
|
|
|
|
|
|
|
"s\x81\xb3u\x81\xbfbowym"]; |
6520
|
|
|
|
|
|
|
|
6521
|
0
|
|
|
|
|
|
$$d{"times"} =["po\x81\xb3udnie","12:00:00", |
6522
|
|
|
|
|
|
|
"p\x81\xf3\x81\xb3noc","00:00:00", |
6523
|
|
|
|
|
|
|
"poludnie","12:00:00","polnoc","00:00:00"]; |
6524
|
0
|
|
|
|
|
|
$$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"]; |
6525
|
|
|
|
|
|
|
|
6526
|
0
|
|
|
|
|
|
$$d{"years"} =["rok","lat","lata","latach"]; |
6527
|
0
|
|
|
|
|
|
$$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy", |
6528
|
|
|
|
|
|
|
"miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"]; |
6529
|
0
|
|
|
|
|
|
$$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"]; |
6530
|
0
|
|
|
|
|
|
$$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"]; |
6531
|
0
|
|
|
|
|
|
$$d{"hours"} =["g.","godzina","godziny","godzinie"]; |
6532
|
0
|
|
|
|
|
|
$$d{"minutes"} =["mn.","min.","minut","minuty"]; |
6533
|
0
|
|
|
|
|
|
$$d{"seconds"} =["s.","sekund","sekundy"]; |
6534
|
0
|
|
|
|
|
|
$$d{"replace"} =["m.","miesiac"]; |
6535
|
|
|
|
|
|
|
|
6536
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
6537
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
6538
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
6539
|
|
|
|
|
|
|
|
6540
|
0
|
|
|
|
|
|
$$d{"am"} = ["AM","A.M."]; |
6541
|
0
|
|
|
|
|
|
$$d{"pm"} = ["PM","P.M."]; |
6542
|
|
|
|
|
|
|
} |
6543
|
|
|
|
|
|
|
|
6544
|
|
|
|
|
|
|
sub _Date_Init_Spanish { |
6545
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/); |
6546
|
0
|
|
|
|
|
|
my($d)=@_; |
6547
|
0
|
|
|
|
|
|
my(%h)=(); |
6548
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
6549
|
|
|
|
|
|
|
|
6550
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6551
|
|
|
|
|
|
|
[["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto", |
6552
|
|
|
|
|
|
|
"Septiembre","Octubre","Noviembre","Diciembre"]]; |
6553
|
|
|
|
|
|
|
|
6554
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6555
|
|
|
|
|
|
|
[["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct", |
6556
|
|
|
|
|
|
|
"Nov","Dic"]]; |
6557
|
|
|
|
|
|
|
|
6558
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6559
|
|
|
|
|
|
|
[["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]]; |
6560
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6561
|
|
|
|
|
|
|
[["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]]; |
6562
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6563
|
|
|
|
|
|
|
[["L","Ma","Mi","J","V","S","D"]]; |
6564
|
|
|
|
|
|
|
|
6565
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6566
|
|
|
|
|
|
|
[["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o", |
6567
|
|
|
|
|
|
|
"11o","12o","13o","14o","15o","16o","17o","18o","19o","20o", |
6568
|
|
|
|
|
|
|
"21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"], |
6569
|
|
|
|
|
|
|
["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a", |
6570
|
|
|
|
|
|
|
"11a","12a","13a","14a","15a","16a","17a","18a","19a","20a", |
6571
|
|
|
|
|
|
|
"21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]]; |
6572
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6573
|
|
|
|
|
|
|
[["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo", |
6574
|
|
|
|
|
|
|
"Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo", |
6575
|
|
|
|
|
|
|
"Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto", |
6576
|
|
|
|
|
|
|
"Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo", |
6577
|
|
|
|
|
|
|
"Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero", |
6578
|
|
|
|
|
|
|
"Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto", |
6579
|
|
|
|
|
|
|
"Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo", |
6580
|
|
|
|
|
|
|
"Trigesimo Primero"], |
6581
|
|
|
|
|
|
|
["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima", |
6582
|
|
|
|
|
|
|
"Octava","Novena","Decima","Decimo Primera","Decimo Segunda", |
6583
|
|
|
|
|
|
|
"Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta", |
6584
|
|
|
|
|
|
|
"Decimo Septima","Decimo Octava","Decimo Novena","Vigesima", |
6585
|
|
|
|
|
|
|
"Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera", |
6586
|
|
|
|
|
|
|
"Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta", |
6587
|
|
|
|
|
|
|
"Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima", |
6588
|
|
|
|
|
|
|
"Trigesimo Primera"]]; |
6589
|
|
|
|
|
|
|
|
6590
|
0
|
|
|
|
|
|
$$d{"now"} =["Ahora"]; |
6591
|
0
|
|
|
|
|
|
$$d{"today"} =["Hoy"]; |
6592
|
0
|
|
|
|
|
|
$$d{"last"} =["ultimo"]; |
6593
|
0
|
|
|
|
|
|
$$d{"each"} =["cada"]; |
6594
|
0
|
|
|
|
|
|
$$d{"of"} =["en","de"]; |
6595
|
0
|
|
|
|
|
|
$$d{"at"} =["a"]; |
6596
|
0
|
|
|
|
|
|
$$d{"on"} =["el"]; |
6597
|
0
|
|
|
|
|
|
$$d{"future"} =["en"]; |
6598
|
0
|
|
|
|
|
|
$$d{"past"} =["hace"]; |
6599
|
0
|
|
|
|
|
|
$$d{"next"} =["siguiente"]; |
6600
|
0
|
|
|
|
|
|
$$d{"prev"} =["anterior"]; |
6601
|
0
|
|
|
|
|
|
$$d{"later"} =["later"]; |
6602
|
|
|
|
|
|
|
|
6603
|
0
|
|
|
|
|
|
$$d{"exact"} =["exactamente"]; |
6604
|
0
|
|
|
|
|
|
$$d{"approx"} =["aproximadamente"]; |
6605
|
0
|
|
|
|
|
|
$$d{"business"}=["laborales"]; |
6606
|
|
|
|
|
|
|
|
6607
|
0
|
|
|
|
|
|
$$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"]; |
6608
|
0
|
|
|
|
|
|
$$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"]; |
6609
|
|
|
|
|
|
|
|
6610
|
0
|
|
|
|
|
|
$$d{"years"} =["a","ano","ano","anos","anos"]; |
6611
|
0
|
|
|
|
|
|
$$d{"months"} =["m","mes","mes","meses"]; |
6612
|
0
|
|
|
|
|
|
$$d{"weeks"} =["sem","semana","semana","semanas"]; |
6613
|
0
|
|
|
|
|
|
$$d{"days"} =["d","dia","dias"]; |
6614
|
0
|
|
|
|
|
|
$$d{"hours"} =["hr","hrs","hora","horas"]; |
6615
|
0
|
|
|
|
|
|
$$d{"minutes"} =["min","min","minuto","minutos"]; |
6616
|
0
|
|
|
|
|
|
$$d{"seconds"} =["s","seg","segundo","segundos"]; |
6617
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","mes"]; |
6618
|
|
|
|
|
|
|
|
6619
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
6620
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
6621
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
6622
|
|
|
|
|
|
|
|
6623
|
0
|
|
|
|
|
|
$$d{"am"} = ["AM","A.M."]; |
6624
|
0
|
|
|
|
|
|
$$d{"pm"} = ["PM","P.M."]; |
6625
|
|
|
|
|
|
|
} |
6626
|
|
|
|
|
|
|
|
6627
|
|
|
|
|
|
|
sub _Date_Init_Portuguese { |
6628
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/); |
6629
|
0
|
|
|
|
|
|
my($d)=@_; |
6630
|
0
|
|
|
|
|
|
my(%h)=(); |
6631
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
6632
|
0
|
|
|
|
|
|
my($o) = $h{"-o"}; |
6633
|
0
|
|
|
|
|
|
my($c) = $h{",c"}; |
6634
|
0
|
|
|
|
|
|
my($a) = $h{"a'"}; |
6635
|
0
|
|
|
|
|
|
my($e) = $h{"e'"}; |
6636
|
0
|
|
|
|
|
|
my($u) = $h{"u'"}; |
6637
|
0
|
|
|
|
|
|
my($o2)= $h{"o'"}; |
6638
|
0
|
|
|
|
|
|
my($a2)= $h{"a`"}; |
6639
|
0
|
|
|
|
|
|
my($a3)= $h{"a~"}; |
6640
|
0
|
|
|
|
|
|
my($e2)= $h{"e^"}; |
6641
|
|
|
|
|
|
|
|
6642
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6643
|
|
|
|
|
|
|
[["Janeiro","Fevereiro","Marco","Abril","Maio","Junho", |
6644
|
|
|
|
|
|
|
"Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"], |
6645
|
|
|
|
|
|
|
["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho", |
6646
|
|
|
|
|
|
|
"Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]]; |
6647
|
|
|
|
|
|
|
|
6648
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6649
|
|
|
|
|
|
|
[["Jan","Fev","Mar","Abr","Mai","Jun", |
6650
|
|
|
|
|
|
|
"Jul","Ago","Set","Out","Nov","Dez"]]; |
6651
|
|
|
|
|
|
|
|
6652
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6653
|
|
|
|
|
|
|
[["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"], |
6654
|
|
|
|
|
|
|
["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]]; |
6655
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6656
|
|
|
|
|
|
|
[["Seg","Ter","Qua","Qui","Sex","Sab","Dom"], |
6657
|
|
|
|
|
|
|
["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]]; |
6658
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6659
|
|
|
|
|
|
|
[["Sg","T","Qa","Qi","Sx","Sb","D"]]; |
6660
|
|
|
|
|
|
|
|
6661
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6662
|
|
|
|
|
|
|
[["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}", |
6663
|
|
|
|
|
|
|
"9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}", |
6664
|
|
|
|
|
|
|
"16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}", |
6665
|
|
|
|
|
|
|
"23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}", |
6666
|
|
|
|
|
|
|
"30${o}","31${o}"]]; |
6667
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6668
|
|
|
|
|
|
|
[["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo", |
6669
|
|
|
|
|
|
|
"oitavo","nono","decimo","decimo primeiro","decimo segundo", |
6670
|
|
|
|
|
|
|
"decimo terceiro","decimo quarto","decimo quinto","decimo sexto", |
6671
|
|
|
|
|
|
|
"decimo setimo","decimo oitavo","decimo nono","vigesimo", |
6672
|
|
|
|
|
|
|
"vigesimo primeiro","vigesimo segundo","vigesimo terceiro", |
6673
|
|
|
|
|
|
|
"vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo", |
6674
|
|
|
|
|
|
|
"vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"], |
6675
|
|
|
|
|
|
|
["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo", |
6676
|
|
|
|
|
|
|
"oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo", |
6677
|
|
|
|
|
|
|
"d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto", |
6678
|
|
|
|
|
|
|
"d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo", |
6679
|
|
|
|
|
|
|
"d${e}cimo nono","vig${e}simo","vig${e}simo primeiro", |
6680
|
|
|
|
|
|
|
"vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto", |
6681
|
|
|
|
|
|
|
"vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo", |
6682
|
|
|
|
|
|
|
"vig${e}simo oitavo","vig${e}simo nono","trig${e}simo", |
6683
|
|
|
|
|
|
|
"trig${e}simo primeiro"]]; |
6684
|
|
|
|
|
|
|
|
6685
|
0
|
|
|
|
|
|
$$d{"now"} =["agora"]; |
6686
|
0
|
|
|
|
|
|
$$d{"today"} =["hoje"]; |
6687
|
0
|
|
|
|
|
|
$$d{"last"} =["${u}ltimo","ultimo"]; |
6688
|
0
|
|
|
|
|
|
$$d{"each"} =["cada"]; |
6689
|
0
|
|
|
|
|
|
$$d{"of"} =["da","do"]; |
6690
|
0
|
|
|
|
|
|
$$d{"at"} =["as","${a2}s"]; |
6691
|
0
|
|
|
|
|
|
$$d{"on"} =["na","no"]; |
6692
|
0
|
|
|
|
|
|
$$d{"future"} =["em"]; |
6693
|
0
|
|
|
|
|
|
$$d{"past"} =["a","${a2}"]; |
6694
|
0
|
|
|
|
|
|
$$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"]; |
6695
|
0
|
|
|
|
|
|
$$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"]; |
6696
|
0
|
|
|
|
|
|
$$d{"later"} =["passadas","passados"]; |
6697
|
|
|
|
|
|
|
|
6698
|
0
|
|
|
|
|
|
$$d{"exact"} =["exactamente"]; |
6699
|
0
|
|
|
|
|
|
$$d{"approx"} =["aproximadamente"]; |
6700
|
0
|
|
|
|
|
|
$$d{"business"}=["util","uteis"]; |
6701
|
|
|
|
|
|
|
|
6702
|
0
|
|
|
|
|
|
$$d{"offset"} =["ontem","-0:0:0:1:0:0:0", |
6703
|
|
|
|
|
|
|
"amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"]; |
6704
|
0
|
|
|
|
|
|
$$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"]; |
6705
|
|
|
|
|
|
|
|
6706
|
0
|
|
|
|
|
|
$$d{"years"} =["anos","ano","ans","an","a"]; |
6707
|
0
|
|
|
|
|
|
$$d{"months"} =["meses","m${e2}s","mes","m"]; |
6708
|
0
|
|
|
|
|
|
$$d{"weeks"} =["semanas","semana","sem","sems","s"]; |
6709
|
0
|
|
|
|
|
|
$$d{"days"} =["dias","dia","d"]; |
6710
|
0
|
|
|
|
|
|
$$d{"hours"} =["horas","hora","hr","hrs"]; |
6711
|
0
|
|
|
|
|
|
$$d{"minutes"} =["minutos","minuto","min","mn"]; |
6712
|
0
|
|
|
|
|
|
$$d{"seconds"} =["segundos","segundo","seg","sg"]; |
6713
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","mes","s","sems"]; |
6714
|
|
|
|
|
|
|
|
6715
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
6716
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
6717
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[,]'; |
6718
|
|
|
|
|
|
|
|
6719
|
0
|
|
|
|
|
|
$$d{"am"} = ["AM","A.M."]; |
6720
|
0
|
|
|
|
|
|
$$d{"pm"} = ["PM","P.M."]; |
6721
|
|
|
|
|
|
|
} |
6722
|
|
|
|
|
|
|
|
6723
|
|
|
|
|
|
|
sub _Date_Init_Russian { |
6724
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/); |
6725
|
0
|
|
|
|
|
|
my($d)=@_; |
6726
|
0
|
|
|
|
|
|
my(%h)=(); |
6727
|
0
|
|
|
|
|
|
_Char_8Bit(\%h); |
6728
|
0
|
|
|
|
|
|
my($a) =$h{"a:"}; |
6729
|
|
|
|
|
|
|
|
6730
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6731
|
|
|
|
|
|
|
[ |
6732
|
|
|
|
|
|
|
["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1", |
6733
|
|
|
|
|
|
|
"\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1", |
6734
|
|
|
|
|
|
|
"\xc9\xc0\xce\xd1", |
6735
|
|
|
|
|
|
|
"\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1", |
6736
|
|
|
|
|
|
|
"\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1", |
6737
|
|
|
|
|
|
|
"\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"], |
6738
|
|
|
|
|
|
|
["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8", |
6739
|
|
|
|
|
|
|
"\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca", |
6740
|
|
|
|
|
|
|
"\xc9\xc0\xce\xd8", |
6741
|
|
|
|
|
|
|
"\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4", |
6742
|
|
|
|
|
|
|
"\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8", |
6743
|
|
|
|
|
|
|
"\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"] |
6744
|
|
|
|
|
|
|
]; |
6745
|
|
|
|
|
|
|
|
6746
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6747
|
|
|
|
|
|
|
[["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2", |
6748
|
|
|
|
|
|
|
"\xcd\xc1\xca","\xc9\xc0\xce", |
6749
|
|
|
|
|
|
|
"\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4", |
6750
|
|
|
|
|
|
|
"\xce\xcf\xd1\xc2","\xc4\xc5\xcb"], |
6751
|
|
|
|
|
|
|
["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","", |
6752
|
|
|
|
|
|
|
"","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]]; |
6753
|
|
|
|
|
|
|
|
6754
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6755
|
|
|
|
|
|
|
[["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb", |
6756
|
|
|
|
|
|
|
"\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1", |
6757
|
|
|
|
|
|
|
"\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1", |
6758
|
|
|
|
|
|
|
"\xd3\xd5\xc2\xc2\xcf\xd4\xc1", |
6759
|
|
|
|
|
|
|
"\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]]; |
6760
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6761
|
|
|
|
|
|
|
[["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7", |
6762
|
|
|
|
|
|
|
"\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"], |
6763
|
|
|
|
|
|
|
["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4", |
6764
|
|
|
|
|
|
|
"\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]]; |
6765
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6766
|
|
|
|
|
|
|
[["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2", |
6767
|
|
|
|
|
|
|
"\xd7\xd3"]]; |
6768
|
|
|
|
|
|
|
|
6769
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6770
|
|
|
|
|
|
|
[["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ", |
6771
|
|
|
|
|
|
|
"11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ", |
6772
|
|
|
|
|
|
|
"21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ", |
6773
|
|
|
|
|
|
|
"31 "]]; |
6774
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6775
|
|
|
|
|
|
|
[["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca", |
6776
|
|
|
|
|
|
|
"\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca", |
6777
|
|
|
|
|
|
|
"\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca", |
6778
|
|
|
|
|
|
|
"\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca", |
6779
|
|
|
|
|
|
|
"\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca", |
6780
|
|
|
|
|
|
|
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6781
|
|
|
|
|
|
|
"\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca", |
6782
|
|
|
|
|
|
|
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6783
|
|
|
|
|
|
|
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6784
|
|
|
|
|
|
|
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6785
|
|
|
|
|
|
|
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6786
|
|
|
|
|
|
|
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6787
|
|
|
|
|
|
|
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6788
|
|
|
|
|
|
|
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6789
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca", |
6790
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca", |
6791
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca", |
6792
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca", |
6793
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca", |
6794
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca", |
6795
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca", |
6796
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca", |
6797
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca", |
6798
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca", |
6799
|
|
|
|
|
|
|
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca", |
6800
|
|
|
|
|
|
|
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"], |
6801
|
|
|
|
|
|
|
|
6802
|
|
|
|
|
|
|
["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5", |
6803
|
|
|
|
|
|
|
"\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5", |
6804
|
|
|
|
|
|
|
"\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5", |
6805
|
|
|
|
|
|
|
"\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5", |
6806
|
|
|
|
|
|
|
"\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5", |
6807
|
|
|
|
|
|
|
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6808
|
|
|
|
|
|
|
"\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6809
|
|
|
|
|
|
|
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6810
|
|
|
|
|
|
|
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6811
|
|
|
|
|
|
|
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6812
|
|
|
|
|
|
|
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6813
|
|
|
|
|
|
|
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6814
|
|
|
|
|
|
|
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6815
|
|
|
|
|
|
|
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6816
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5", |
6817
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5", |
6818
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5", |
6819
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5", |
6820
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5", |
6821
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5", |
6822
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5", |
6823
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5", |
6824
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5", |
6825
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5", |
6826
|
|
|
|
|
|
|
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5", |
6827
|
|
|
|
|
|
|
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"], |
6828
|
|
|
|
|
|
|
|
6829
|
|
|
|
|
|
|
["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf", |
6830
|
|
|
|
|
|
|
"\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf", |
6831
|
|
|
|
|
|
|
"\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf", |
6832
|
|
|
|
|
|
|
"\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf", |
6833
|
|
|
|
|
|
|
"\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf", |
6834
|
|
|
|
|
|
|
"\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf", |
6835
|
|
|
|
|
|
|
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6836
|
|
|
|
|
|
|
"\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6837
|
|
|
|
|
|
|
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6838
|
|
|
|
|
|
|
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6839
|
|
|
|
|
|
|
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6840
|
|
|
|
|
|
|
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6841
|
|
|
|
|
|
|
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6842
|
|
|
|
|
|
|
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6843
|
|
|
|
|
|
|
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6844
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6845
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf", |
6846
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5", |
6847
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf", |
6848
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf", |
6849
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf", |
6850
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf", |
6851
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf", |
6852
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf", |
6853
|
|
|
|
|
|
|
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf", |
6854
|
|
|
|
|
|
|
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf", |
6855
|
|
|
|
|
|
|
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]]; |
6856
|
|
|
|
|
|
|
|
6857
|
0
|
|
|
|
|
|
$$d{"now"} =["\xd3\xc5\xca\xde\xc1\xd3"]; |
6858
|
0
|
|
|
|
|
|
$$d{"today"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1"]; |
6859
|
0
|
|
|
|
|
|
$$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"]; |
6860
|
0
|
|
|
|
|
|
$$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"]; |
6861
|
0
|
|
|
|
|
|
$$d{"of"} =[" "]; |
6862
|
0
|
|
|
|
|
|
$$d{"at"} =["\xd7"]; |
6863
|
0
|
|
|
|
|
|
$$d{"on"} =["\xd7"]; |
6864
|
0
|
|
|
|
|
|
$$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"]; |
6865
|
0
|
|
|
|
|
|
$$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "]; |
6866
|
0
|
|
|
|
|
|
$$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"]; |
6867
|
0
|
|
|
|
|
|
$$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"]; |
6868
|
0
|
|
|
|
|
|
$$d{"later"} =["\xd0\xcf\xda\xd6\xc5"]; |
6869
|
|
|
|
|
|
|
|
6870
|
0
|
|
|
|
|
|
$$d{"exact"} =["\xd4\xcf\xde\xce\xcf"]; |
6871
|
0
|
|
|
|
|
|
$$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"]; |
6872
|
0
|
|
|
|
|
|
$$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"]; |
6873
|
|
|
|
|
|
|
|
6874
|
0
|
|
|
|
|
|
$$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0", |
6875
|
|
|
|
|
|
|
"\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0", |
6876
|
|
|
|
|
|
|
"\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0", |
6877
|
|
|
|
|
|
|
"\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1", |
6878
|
|
|
|
|
|
|
"+0:0:0:2:0:0:0"]; |
6879
|
0
|
|
|
|
|
|
$$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00", |
6880
|
|
|
|
|
|
|
"\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"]; |
6881
|
|
|
|
|
|
|
|
6882
|
0
|
|
|
|
|
|
$$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4", |
6883
|
|
|
|
|
|
|
"\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"]; |
6884
|
0
|
|
|
|
|
|
$$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3", |
6885
|
|
|
|
|
|
|
"\xcd\xc5\xd3\xd1\xc3\xc5\xd7"]; |
6886
|
0
|
|
|
|
|
|
$$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8", |
6887
|
|
|
|
|
|
|
"\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"]; |
6888
|
0
|
|
|
|
|
|
$$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca", |
6889
|
|
|
|
|
|
|
"\xc4\xce\xd1"]; |
6890
|
0
|
|
|
|
|
|
$$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3", |
6891
|
|
|
|
|
|
|
"\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"]; |
6892
|
0
|
|
|
|
|
|
$$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1", |
6893
|
|
|
|
|
|
|
"\xcd\xc9\xce\xd5\xd4"]; |
6894
|
0
|
|
|
|
|
|
$$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1", |
6895
|
|
|
|
|
|
|
"\xd3\xc5\xcb\xd5\xce\xc4"]; |
6896
|
0
|
|
|
|
|
|
$$d{"replace"} =[]; |
6897
|
|
|
|
|
|
|
|
6898
|
0
|
|
|
|
|
|
$$d{"sephm"} ="[:\xde]"; |
6899
|
0
|
|
|
|
|
|
$$d{"sepms"} ="[:\xcd]"; |
6900
|
0
|
|
|
|
|
|
$$d{"sepss"} ="[:.\xd3]"; |
6901
|
|
|
|
|
|
|
|
6902
|
0
|
|
|
|
|
|
$$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9", |
6903
|
|
|
|
|
|
|
"\xd5\xd4\xd2\xc1", |
6904
|
|
|
|
|
|
|
"\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"]; |
6905
|
0
|
|
|
|
|
|
$$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1", |
6906
|
|
|
|
|
|
|
"\xd7\xc5\xde\xc5\xd2\xc1", |
6907
|
|
|
|
|
|
|
"\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1", |
6908
|
|
|
|
|
|
|
"\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"]; |
6909
|
|
|
|
|
|
|
} |
6910
|
|
|
|
|
|
|
|
6911
|
|
|
|
|
|
|
sub _Date_Init_Turkish { |
6912
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/); |
6913
|
0
|
|
|
|
|
|
my($d)=@_; |
6914
|
|
|
|
|
|
|
|
6915
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
6916
|
|
|
|
|
|
|
[ |
6917
|
|
|
|
|
|
|
["ocak","subat","mart","nisan","mayis","haziran", |
6918
|
|
|
|
|
|
|
"temmuz","agustos","eylul","ekim","kasim","aralik"], |
6919
|
|
|
|
|
|
|
["ocak","\xfeubat","mart","nisan","may\xfds","haziran", |
6920
|
|
|
|
|
|
|
"temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"] |
6921
|
|
|
|
|
|
|
]; |
6922
|
|
|
|
|
|
|
|
6923
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
6924
|
|
|
|
|
|
|
[ |
6925
|
|
|
|
|
|
|
["oca","sub","mar","nis","may","haz", |
6926
|
|
|
|
|
|
|
"tem","agu","eyl","eki","kas","ara"], |
6927
|
|
|
|
|
|
|
["oca","\xfeub","mar","nis","may","haz", |
6928
|
|
|
|
|
|
|
"tem","a\xf0u","eyl","eki","kas","ara"] |
6929
|
|
|
|
|
|
|
]; |
6930
|
|
|
|
|
|
|
|
6931
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
6932
|
|
|
|
|
|
|
[ |
6933
|
|
|
|
|
|
|
["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"], |
6934
|
|
|
|
|
|
|
["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma", |
6935
|
|
|
|
|
|
|
"cumartesi","pazar"], |
6936
|
|
|
|
|
|
|
]; |
6937
|
|
|
|
|
|
|
|
6938
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
6939
|
|
|
|
|
|
|
[ |
6940
|
|
|
|
|
|
|
["pzt","sal","car","per","cum","cts","paz"], |
6941
|
|
|
|
|
|
|
["pzt","sal","\xe7ar","per","cum","cts","paz"], |
6942
|
|
|
|
|
|
|
]; |
6943
|
|
|
|
|
|
|
|
6944
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
6945
|
|
|
|
|
|
|
[["Pt","S","Cr","Pr","C","Ct","P"], |
6946
|
|
|
|
|
|
|
["Pt","S","\xc7","Pr","C","Ct","P"]]; |
6947
|
|
|
|
|
|
|
|
6948
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
6949
|
|
|
|
|
|
|
[[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.", |
6950
|
|
|
|
|
|
|
"11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.", |
6951
|
|
|
|
|
|
|
"21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.", |
6952
|
|
|
|
|
|
|
"31."]]; |
6953
|
|
|
|
|
|
|
|
6954
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
6955
|
|
|
|
|
|
|
[ |
6956
|
|
|
|
|
|
|
["birinci","ikinci","ucuncu","dorduncu", |
6957
|
|
|
|
|
|
|
"besinci","altinci","yedinci","sekizinci", |
6958
|
|
|
|
|
|
|
"dokuzuncu","onuncu","onbirinci","onikinci", |
6959
|
|
|
|
|
|
|
"onucuncu","ondordoncu", |
6960
|
|
|
|
|
|
|
"onbesinci","onaltinci","onyedinci","onsekizinci", |
6961
|
|
|
|
|
|
|
"ondokuzuncu","yirminci","yirmibirinci","yirmikinci", |
6962
|
|
|
|
|
|
|
"yirmiucuncu","yirmidorduncu", |
6963
|
|
|
|
|
|
|
"yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci", |
6964
|
|
|
|
|
|
|
"yirmidokuzuncu","otuzuncu","otuzbirinci"], |
6965
|
|
|
|
|
|
|
["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc", |
6966
|
|
|
|
|
|
|
"be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci", |
6967
|
|
|
|
|
|
|
"dokuzuncu","onuncu","onbirinci","onikinci", |
6968
|
|
|
|
|
|
|
"on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc", |
6969
|
|
|
|
|
|
|
"onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci", |
6970
|
|
|
|
|
|
|
"ondokuzuncu","yirminci","yirmibirinci","yirmikinci", |
6971
|
|
|
|
|
|
|
"yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc", |
6972
|
|
|
|
|
|
|
"yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci", |
6973
|
|
|
|
|
|
|
"yirmidokuzuncu","otuzuncu","otuzbirinci"] |
6974
|
|
|
|
|
|
|
]; |
6975
|
|
|
|
|
|
|
|
6976
|
0
|
|
|
|
|
|
$$d{"now"} =["\xfeimdi", "simdi"]; |
6977
|
0
|
|
|
|
|
|
$$d{"today"} =["bugun", "bug\xfcn"]; |
6978
|
0
|
|
|
|
|
|
$$d{"last"} =["son", "sonuncu"]; |
6979
|
0
|
|
|
|
|
|
$$d{"each"} =["her"]; |
6980
|
0
|
|
|
|
|
|
$$d{"of"} =["of"]; |
6981
|
0
|
|
|
|
|
|
$$d{"at"} =["saat"]; |
6982
|
0
|
|
|
|
|
|
$$d{"on"} =["on"]; |
6983
|
0
|
|
|
|
|
|
$$d{"future"} =["gelecek"]; |
6984
|
0
|
|
|
|
|
|
$$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"]; |
6985
|
0
|
|
|
|
|
|
$$d{"next"} =["gelecek","sonraki"]; |
6986
|
0
|
|
|
|
|
|
$$d{"prev"} =["onceki","\xf6nceki"]; |
6987
|
0
|
|
|
|
|
|
$$d{"later"} =["sonra"]; |
6988
|
|
|
|
|
|
|
|
6989
|
0
|
|
|
|
|
|
$$d{"exact"} =["tam"]; |
6990
|
0
|
|
|
|
|
|
$$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"]; |
6991
|
0
|
|
|
|
|
|
$$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"]; |
6992
|
|
|
|
|
|
|
|
6993
|
0
|
|
|
|
|
|
$$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0", |
6994
|
|
|
|
|
|
|
"dun", "-0:0:0:1:0:0:0", |
6995
|
|
|
|
|
|
|
"yar\xfdn","+0:0:0:1:0:0:0", |
6996
|
|
|
|
|
|
|
"yarin","+0:0:0:1:0:0:0"]; |
6997
|
|
|
|
|
|
|
|
6998
|
0
|
|
|
|
|
|
$$d{"times"} =["\xf6\xf0len","12:00:00", |
6999
|
|
|
|
|
|
|
"oglen","12:00:00", |
7000
|
|
|
|
|
|
|
"yarim","12:300:00", |
7001
|
|
|
|
|
|
|
"yar\xfdm","12:30:00", |
7002
|
|
|
|
|
|
|
"gece yar\xfds\xfd","00:00:00", |
7003
|
|
|
|
|
|
|
"gece yarisi","00:00:00"]; |
7004
|
|
|
|
|
|
|
|
7005
|
0
|
|
|
|
|
|
$$d{"years"} =["yil","y"]; |
7006
|
0
|
|
|
|
|
|
$$d{"months"} =["ay","a"]; |
7007
|
0
|
|
|
|
|
|
$$d{"weeks"} =["hafta", "h"]; |
7008
|
0
|
|
|
|
|
|
$$d{"days"} =["gun","g"]; |
7009
|
0
|
|
|
|
|
|
$$d{"hours"} =["saat"]; |
7010
|
0
|
|
|
|
|
|
$$d{"minutes"} =["dakika","dak","d"]; |
7011
|
0
|
|
|
|
|
|
$$d{"seconds"} =["saniye","sn",]; |
7012
|
0
|
|
|
|
|
|
$$d{"replace"} =["s","saat"]; |
7013
|
|
|
|
|
|
|
|
7014
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
7015
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
7016
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:,]'; |
7017
|
|
|
|
|
|
|
|
7018
|
0
|
|
|
|
|
|
$$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"]; |
7019
|
0
|
|
|
|
|
|
$$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"]; |
7020
|
|
|
|
|
|
|
} |
7021
|
|
|
|
|
|
|
|
7022
|
|
|
|
|
|
|
sub _Date_Init_Danish { |
7023
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/); |
7024
|
0
|
|
|
|
|
|
my($d)=@_; |
7025
|
|
|
|
|
|
|
|
7026
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
7027
|
|
|
|
|
|
|
[["Januar","Februar","Marts","April","Maj","Juni", |
7028
|
|
|
|
|
|
|
"Juli","August","September","Oktober","November","December"]]; |
7029
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
7030
|
|
|
|
|
|
|
[["Jan","Feb","Mar","Apr","Maj","Jun", |
7031
|
|
|
|
|
|
|
"Jul","Aug","Sep","Okt","Nov","Dec"]]; |
7032
|
|
|
|
|
|
|
|
7033
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
7034
|
|
|
|
|
|
|
[["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"], |
7035
|
|
|
|
|
|
|
["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]]; |
7036
|
|
|
|
|
|
|
|
7037
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
7038
|
|
|
|
|
|
|
[["Man","Tir","Ons","Tor","Fre","Lor","Son"], |
7039
|
|
|
|
|
|
|
["Man","Tir","Ons","Tor","Fre","L\xf8r","S\xf8n"]]; |
7040
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
7041
|
|
|
|
|
|
|
[["M","Ti","O","To","F","L","S"]]; |
7042
|
|
|
|
|
|
|
|
7043
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
7044
|
|
|
|
|
|
|
[["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e", |
7045
|
|
|
|
|
|
|
"11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e", |
7046
|
|
|
|
|
|
|
"21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e", |
7047
|
|
|
|
|
|
|
"31:e"]]; |
7048
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
7049
|
|
|
|
|
|
|
[["forste","anden","tredie","fjerde","femte","sjette","syvende", |
7050
|
|
|
|
|
|
|
"ottende","niende","tiende","elfte","tolvte","trettende","fjortende", |
7051
|
|
|
|
|
|
|
"femtende","sekstende","syttende","attende","nittende","tyvende", |
7052
|
|
|
|
|
|
|
"enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende", |
7053
|
|
|
|
|
|
|
"seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende", |
7054
|
|
|
|
|
|
|
"tredivte","enogtredivte"], |
7055
|
|
|
|
|
|
|
["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende", |
7056
|
|
|
|
|
|
|
"ottende","niende","tiende","elfte","tolvte","trettende","fjortende", |
7057
|
|
|
|
|
|
|
"femtende","sekstende","syttende","attende","nittende","tyvende", |
7058
|
|
|
|
|
|
|
"enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende", |
7059
|
|
|
|
|
|
|
"seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende", |
7060
|
|
|
|
|
|
|
"tredivte","enogtredivte"]]; |
7061
|
|
|
|
|
|
|
|
7062
|
0
|
|
|
|
|
|
$$d{"now"} =["nu"]; |
7063
|
0
|
|
|
|
|
|
$$d{"today"} =["idag"]; |
7064
|
0
|
|
|
|
|
|
$$d{"last"} =["forrige","sidste","nyeste"]; |
7065
|
0
|
|
|
|
|
|
$$d{"each"} =["hver"]; |
7066
|
0
|
|
|
|
|
|
$$d{"of"} =["om"]; |
7067
|
0
|
|
|
|
|
|
$$d{"at"} =["kl","kl.","klokken"]; |
7068
|
0
|
|
|
|
|
|
$$d{"on"} =["pa","p\xe5"]; |
7069
|
0
|
|
|
|
|
|
$$d{"future"} =["om"]; |
7070
|
0
|
|
|
|
|
|
$$d{"past"} =["siden"]; |
7071
|
0
|
|
|
|
|
|
$$d{"next"} =["nasta","n\xe6ste"]; |
7072
|
0
|
|
|
|
|
|
$$d{"prev"} =["forrige"]; |
7073
|
0
|
|
|
|
|
|
$$d{"later"} =["senere"]; |
7074
|
|
|
|
|
|
|
|
7075
|
0
|
|
|
|
|
|
$$d{"exact"} =["pracist","pr\xe6cist"]; |
7076
|
0
|
|
|
|
|
|
$$d{"approx"} =["circa"]; |
7077
|
0
|
|
|
|
|
|
$$d{"business"}=["arbejdsdag","arbejdsdage"]; |
7078
|
|
|
|
|
|
|
|
7079
|
0
|
|
|
|
|
|
$$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0", |
7080
|
|
|
|
|
|
|
"imorgen","+0:0:0:1:0:0:0"]; |
7081
|
0
|
|
|
|
|
|
$$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00", |
7082
|
|
|
|
|
|
|
"midnat","00:00:00"]; |
7083
|
|
|
|
|
|
|
|
7084
|
0
|
|
|
|
|
|
$$d{"years"} =["ar","\xe5r"]; |
7085
|
0
|
|
|
|
|
|
$$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"]; |
7086
|
0
|
|
|
|
|
|
$$d{"weeks"} =["u","uge","uger"]; |
7087
|
0
|
|
|
|
|
|
$$d{"days"} =["d","dag","dage"]; |
7088
|
0
|
|
|
|
|
|
$$d{"hours"} =["t","tim","time","timer"]; |
7089
|
0
|
|
|
|
|
|
$$d{"minutes"} =["min","minut","minutter"]; |
7090
|
0
|
|
|
|
|
|
$$d{"seconds"} =["s","sek","sekund","sekunder"]; |
7091
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","minut"]; |
7092
|
|
|
|
|
|
|
|
7093
|
0
|
|
|
|
|
|
$$d{"sephm"} ='[.:]'; |
7094
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
7095
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
7096
|
|
|
|
|
|
|
|
7097
|
0
|
|
|
|
|
|
$$d{"am"} = ["FM"]; |
7098
|
0
|
|
|
|
|
|
$$d{"pm"} = ["EM"]; |
7099
|
|
|
|
|
|
|
} |
7100
|
|
|
|
|
|
|
|
7101
|
|
|
|
|
|
|
sub _Date_Init_Catalan { |
7102
|
0
|
0
|
|
0
|
|
|
print "DEBUG: _Date_Init_Catalan\n" if ($Curr{"Debug"} =~ /trace/); |
7103
|
0
|
|
|
|
|
|
my($d)=@_; |
7104
|
|
|
|
|
|
|
|
7105
|
0
|
|
|
|
|
|
$$d{"month_name"}= |
7106
|
|
|
|
|
|
|
[["Gener","Febrer","Marc","Abril","Maig","Juny", |
7107
|
|
|
|
|
|
|
"Juliol","Agost","Setembre","Octubre","Novembre","Desembre"], |
7108
|
|
|
|
|
|
|
["Gener","Febrer","Mar?","Abril","Maig","Juny", |
7109
|
|
|
|
|
|
|
"Juliol","Agost","Setembre","Octubre","Novembre","Desembre"], |
7110
|
|
|
|
|
|
|
["Gener","Febrer","Marc,","Abril","Maig","Juny", |
7111
|
|
|
|
|
|
|
"Juliol","Agost","Setembre","Octubre","Novembre","Desembre"]]; |
7112
|
|
|
|
|
|
|
|
7113
|
0
|
|
|
|
|
|
$$d{"month_abb"}= |
7114
|
|
|
|
|
|
|
[["Gen","Feb","Mar","Abr","Mai","Jun", |
7115
|
|
|
|
|
|
|
"Jul","Ago","Set","Oct","Nov","Des"], |
7116
|
|
|
|
|
|
|
[], |
7117
|
|
|
|
|
|
|
["","","","","","", |
7118
|
|
|
|
|
|
|
"","","","","","Dec"] #common mistake |
7119
|
|
|
|
|
|
|
]; |
7120
|
|
|
|
|
|
|
|
7121
|
0
|
|
|
|
|
|
$$d{"day_name"}= |
7122
|
|
|
|
|
|
|
[["Dilluns","Dimarts","Dimecres","Dijous","Divendres","Dissabte","Diumenge"]]; |
7123
|
0
|
|
|
|
|
|
$$d{"day_abb"}= |
7124
|
|
|
|
|
|
|
[["Dll","Dmt","Dmc","Dij","Div","Dis","Diu"], |
7125
|
|
|
|
|
|
|
["","Dim","","","","",""], |
7126
|
|
|
|
|
|
|
["","","Dic","","","",""] |
7127
|
|
|
|
|
|
|
]; |
7128
|
0
|
|
|
|
|
|
$$d{"day_char"}= |
7129
|
|
|
|
|
|
|
[["Dl","Dm","Dc","Dj","Dv","Ds","Du"] , |
7130
|
|
|
|
|
|
|
["L","M","X","J","V","S","U"]]; |
7131
|
|
|
|
|
|
|
|
7132
|
0
|
|
|
|
|
|
$$d{"num_suff"}= |
7133
|
|
|
|
|
|
|
[["1er","2n","3r","4t","5e","6e","7e","8e","9e","10e", |
7134
|
|
|
|
|
|
|
"11e","12e","13e","14e","15e","16e","17e","18e","19e","20e", |
7135
|
|
|
|
|
|
|
"21e","22e","23e","24e","25e","26e","27e","28e","29e","30e", |
7136
|
|
|
|
|
|
|
"31e"], |
7137
|
|
|
|
|
|
|
["1er","2n","3r","4t","5?","6?","7?","8?","9?","10?", |
7138
|
|
|
|
|
|
|
"11?","12?","13?","14?","15?","16?","17?","18?","19?","20?", |
7139
|
|
|
|
|
|
|
"21?","22?","23?","24?","25?","26?","27?","28?","29?","30?", |
7140
|
|
|
|
|
|
|
"31?"]]; |
7141
|
0
|
|
|
|
|
|
$$d{"num_word"}= |
7142
|
|
|
|
|
|
|
[["primer","segon","tercer","quart","cinque","sise","sete","vuite", |
7143
|
|
|
|
|
|
|
"nove","dese","onze","dotze","tretze","catorze", |
7144
|
|
|
|
|
|
|
"quinze","setze","dissete","divuite","dinove", |
7145
|
|
|
|
|
|
|
"vinte","vint-i-une","vint-i-dose","vint-i-trese", |
7146
|
|
|
|
|
|
|
"vint-i-quatre","vint-i-cinque","vint-i-sise","vint-i-sete", |
7147
|
|
|
|
|
|
|
"vint-i-vuite","vint-i-nove","trente","trenta-une"], |
7148
|
|
|
|
|
|
|
["primer","segon","tercer","quart","cinqu?","sis?","set?","vuit?", |
7149
|
|
|
|
|
|
|
"nov?","des?","onz?","dotz?","tretz?","catorz?", |
7150
|
|
|
|
|
|
|
"quinz?","setz?","disset?","divuit?","dinov?", |
7151
|
|
|
|
|
|
|
"vint?","vint-i-un?","vint-i-dos?","vint-i-tres?", |
7152
|
|
|
|
|
|
|
"vint-i-quatr?","vint-i-cinqu?","vint-i-sis?","vint-i-set?", |
7153
|
|
|
|
|
|
|
"vint-i-vuit?","vint-i-nov?","trent?","trenta-un?"]]; |
7154
|
|
|
|
|
|
|
|
7155
|
0
|
|
|
|
|
|
$$d{"now"} =["avui","ara"]; |
7156
|
0
|
|
|
|
|
|
$$d{"last"} =["darrer","?ltim","darrera","?ltima"]; |
7157
|
0
|
|
|
|
|
|
$$d{"each"} =["cada","cadascun","cadascuna"]; |
7158
|
0
|
|
|
|
|
|
$$d{"of"} =["de","d'"]; |
7159
|
0
|
|
|
|
|
|
$$d{"at"} =["a les","a","al"]; |
7160
|
0
|
|
|
|
|
|
$$d{"on"} =["el"]; |
7161
|
0
|
|
|
|
|
|
$$d{"future"} =["d'aqu? a"]; |
7162
|
0
|
|
|
|
|
|
$$d{"past"} =["fa"]; |
7163
|
0
|
|
|
|
|
|
$$d{"next"} =["proper"]; |
7164
|
0
|
|
|
|
|
|
$$d{"prev"} =["passat","proppassat","anterior"]; |
7165
|
0
|
|
|
|
|
|
$$d{"later"} =["m?s tard"]; |
7166
|
|
|
|
|
|
|
|
7167
|
0
|
|
|
|
|
|
$$d{"exact"} =["exactament"]; |
7168
|
0
|
|
|
|
|
|
$$d{"approx"} =["approximadament"]; |
7169
|
0
|
|
|
|
|
|
$$d{"business"}=["empresa"]; |
7170
|
|
|
|
|
|
|
|
7171
|
0
|
|
|
|
|
|
$$d{"offset"} =["ahir","-0:0:0:1:0:0:0","dem?","+0:0:0:1:0:0:0","abans d'ahir","-0:0:0:2:0:0:0","dem? passat","+0:0:0:2:0:0:0",]; |
7172
|
0
|
|
|
|
|
|
$$d{"times"} =["migdia","12:00:00","mitjanit","00:00:00"]; |
7173
|
|
|
|
|
|
|
|
7174
|
0
|
|
|
|
|
|
$$d{"years"} =["a","an","any","anys"]; |
7175
|
0
|
|
|
|
|
|
$$d{"months"} =["mes","me","ms"]; |
7176
|
0
|
|
|
|
|
|
$$d{"weeks"} =["se","set","setm","setmana","setmanes"]; |
7177
|
0
|
|
|
|
|
|
$$d{"days"} =["d","dia","dies"]; |
7178
|
0
|
|
|
|
|
|
$$d{"hours"} =["h","ho","hores","hora"]; |
7179
|
0
|
|
|
|
|
|
$$d{"minutes"} =["mn","min","minut","minuts"]; |
7180
|
0
|
|
|
|
|
|
$$d{"seconds"} =["s","seg","segon","segons"]; |
7181
|
0
|
|
|
|
|
|
$$d{"replace"} =["m","mes","s","setmana"]; |
7182
|
|
|
|
|
|
|
|
7183
|
0
|
|
|
|
|
|
$$d{"sephm"} =':'; |
7184
|
0
|
|
|
|
|
|
$$d{"sepms"} =':'; |
7185
|
0
|
|
|
|
|
|
$$d{"sepss"} ='[.:]'; |
7186
|
|
|
|
|
|
|
|
7187
|
0
|
|
|
|
|
|
$$d{"am"} = ["AM","A.M."]; |
7188
|
0
|
|
|
|
|
|
$$d{"pm"} = ["PM","P.M."]; |
7189
|
|
|
|
|
|
|
} |
7190
|
|
|
|
|
|
|
|
7191
|
|
|
|
|
|
|
######################################################################## |
7192
|
|
|
|
|
|
|
# FROM MY PERSONAL LIBRARIES |
7193
|
|
|
|
|
|
|
######################################################################## |
7194
|
|
|
|
|
|
|
|
7195
|
36
|
|
|
36
|
|
771989
|
no integer; |
|
36
|
|
|
|
|
108
|
|
|
36
|
|
|
|
|
271
|
|
7196
|
|
|
|
|
|
|
|
7197
|
|
|
|
|
|
|
# _ModuloAddition($N,$add,\$val,\$rem); |
7198
|
|
|
|
|
|
|
# This calculates $val=$val+$add and forces $val to be in a certain range. |
7199
|
|
|
|
|
|
|
# This is useful for adding numbers for which only a certain range is |
7200
|
|
|
|
|
|
|
# allowed (for example, minutes can be between 0 and 59 or months can be |
7201
|
|
|
|
|
|
|
# between 1 and 12). The absolute value of $N determines the range and |
7202
|
|
|
|
|
|
|
# the sign of $N determines whether the range is 0 to N-1 (if N>0) or |
7203
|
|
|
|
|
|
|
# 1 to N (N<0). The remainder (as modulo N) is added to $rem. |
7204
|
|
|
|
|
|
|
# Example: |
7205
|
|
|
|
|
|
|
# To add 2 hours together (with the excess returned in days) use: |
7206
|
|
|
|
|
|
|
# _ModuloAddition(60,$s1,\$s,\$day); |
7207
|
|
|
|
|
|
|
sub _ModuloAddition { |
7208
|
0
|
|
|
0
|
|
|
my($N,$add,$val,$rem)=@_; |
7209
|
0
|
0
|
|
|
|
|
return if ($N==0); |
7210
|
0
|
|
|
|
|
|
$$val+=$add; |
7211
|
0
|
0
|
|
|
|
|
if ($N<0) { |
7212
|
|
|
|
|
|
|
# 1 to N |
7213
|
0
|
|
|
|
|
|
$N = -$N; |
7214
|
0
|
0
|
|
|
|
|
if ($$val>$N) { |
|
|
0
|
|
|
|
|
|
7215
|
0
|
|
|
|
|
|
$$rem+= int(($$val-1)/$N); |
7216
|
0
|
|
|
|
|
|
$$val = ($$val-1)%$N +1; |
7217
|
|
|
|
|
|
|
} elsif ($$val<1) { |
7218
|
0
|
|
|
|
|
|
$$rem-= int(-$$val/$N)+1; |
7219
|
0
|
|
|
|
|
|
$$val = $N-(-$$val % $N); |
7220
|
|
|
|
|
|
|
} |
7221
|
|
|
|
|
|
|
|
7222
|
|
|
|
|
|
|
} else { |
7223
|
|
|
|
|
|
|
# 0 to N-1 |
7224
|
0
|
0
|
|
|
|
|
if ($$val>($N-1)) { |
|
|
0
|
|
|
|
|
|
7225
|
0
|
|
|
|
|
|
$$rem+= int($$val/$N); |
7226
|
0
|
|
|
|
|
|
$$val = $$val%$N; |
7227
|
|
|
|
|
|
|
} elsif ($$val<0) { |
7228
|
0
|
|
|
|
|
|
$$rem-= int(-($$val+1)/$N)+1; |
7229
|
0
|
|
|
|
|
|
$$val = ($N-1)-(-($$val+1)%$N); |
7230
|
|
|
|
|
|
|
} |
7231
|
|
|
|
|
|
|
} |
7232
|
|
|
|
|
|
|
} |
7233
|
|
|
|
|
|
|
|
7234
|
|
|
|
|
|
|
# $Flag=_IsInt($String [,$low, $high]); |
7235
|
|
|
|
|
|
|
# Returns 1 if $String is a valid integer, 0 otherwise. If $low is |
7236
|
|
|
|
|
|
|
# entered, $String must be >= $low. If $high is entered, $String must |
7237
|
|
|
|
|
|
|
# be <= $high. It is valid to check only one of the bounds. |
7238
|
|
|
|
|
|
|
sub _IsInt { |
7239
|
0
|
|
|
0
|
|
|
my($N,$low,$high)=@_; |
7240
|
0
|
0
|
0
|
|
|
|
return 0 if (! defined $N or |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
7241
|
|
|
|
|
|
|
$N !~ /^\s*[-+]?\d+\s*$/ or |
7242
|
|
|
|
|
|
|
defined $low && $N<$low or |
7243
|
|
|
|
|
|
|
defined $high && $N>$high); |
7244
|
0
|
|
|
|
|
|
return 1; |
7245
|
|
|
|
|
|
|
} |
7246
|
|
|
|
|
|
|
|
7247
|
|
|
|
|
|
|
# $File=_CleanFile($file); |
7248
|
|
|
|
|
|
|
# This cleans up a path to remove the following things: |
7249
|
|
|
|
|
|
|
# double slash /a//b -> /a/b |
7250
|
|
|
|
|
|
|
# trailing dot /a/. -> /a |
7251
|
|
|
|
|
|
|
# leading dot ./a -> a |
7252
|
|
|
|
|
|
|
# trailing slash a/ -> a |
7253
|
|
|
|
|
|
|
sub _CleanFile { |
7254
|
0
|
|
|
0
|
|
|
my($file)=@_; |
7255
|
0
|
|
|
|
|
|
$file =~ s/\s*$//; |
7256
|
0
|
|
|
|
|
|
$file =~ s/^\s*//; |
7257
|
0
|
|
|
|
|
|
$file =~ s|//+|/|g; # multiple slash |
7258
|
0
|
|
|
|
|
|
$file =~ s|/\.$|/|; # trailing /. (leaves trailing slash) |
7259
|
0
|
0
|
|
|
|
|
$file =~ s|^\./|| # leading ./ |
7260
|
|
|
|
|
|
|
if ($file ne "./"); |
7261
|
0
|
0
|
|
|
|
|
$file =~ s|/$|| # trailing slash |
7262
|
|
|
|
|
|
|
if ($file ne "/"); |
7263
|
0
|
|
|
|
|
|
return $file; |
7264
|
|
|
|
|
|
|
} |
7265
|
|
|
|
|
|
|
|
7266
|
|
|
|
|
|
|
# $File=_ExpandTilde($file); |
7267
|
|
|
|
|
|
|
# This checks to see if a "~" appears as the first character in a path. |
7268
|
|
|
|
|
|
|
# If it does, the "~" expansion is interpreted (if possible) and the full |
7269
|
|
|
|
|
|
|
# path is returned. If a "~" expansion is used but cannot be |
7270
|
|
|
|
|
|
|
# interpreted, an empty string is returned. |
7271
|
|
|
|
|
|
|
# |
7272
|
|
|
|
|
|
|
# This is Windows/Mac friendly. |
7273
|
|
|
|
|
|
|
# This is efficient. |
7274
|
|
|
|
|
|
|
sub _ExpandTilde { |
7275
|
0
|
|
|
0
|
|
|
my($file)=shift; |
7276
|
0
|
|
|
|
|
|
my($user,$home)=(); |
7277
|
|
|
|
|
|
|
# ~aaa/bbb= ~ aaa /bbb |
7278
|
0
|
0
|
|
|
|
|
if ($file =~ s|^~([^/]*)||) { |
7279
|
0
|
|
|
|
|
|
$user=$1; |
7280
|
|
|
|
|
|
|
# Single user operating systems (Mac, MSWindows) don't have the getpwnam |
7281
|
|
|
|
|
|
|
# and getpwuid routines defined. Try to catch various different ways |
7282
|
|
|
|
|
|
|
# of knowing we are on one of these systems: |
7283
|
0
|
0
|
0
|
|
|
|
return "" if ($OS eq "Windows" or |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
7284
|
|
|
|
|
|
|
$OS eq "Mac" or |
7285
|
|
|
|
|
|
|
$OS eq "Netware" or |
7286
|
|
|
|
|
|
|
$OS eq "MPE"); |
7287
|
0
|
0
|
|
|
|
|
$user="" if (! defined $user); |
7288
|
|
|
|
|
|
|
|
7289
|
0
|
0
|
|
|
|
|
if ($user) { |
7290
|
0
|
|
|
|
|
|
$home= (getpwnam($user))[7]; |
7291
|
|
|
|
|
|
|
} else { |
7292
|
0
|
|
|
|
|
|
$home= (getpwuid($<))[7]; |
7293
|
|
|
|
|
|
|
} |
7294
|
0
|
0
|
|
|
|
|
$home = VMS::Filespec::unixpath($home) if ($OS eq "VMS"); |
7295
|
0
|
0
|
|
|
|
|
return "" if (! defined $home); |
7296
|
0
|
|
|
|
|
|
$file="$home/$file"; |
7297
|
|
|
|
|
|
|
} |
7298
|
0
|
|
|
|
|
|
$file; |
7299
|
|
|
|
|
|
|
} |
7300
|
|
|
|
|
|
|
|
7301
|
|
|
|
|
|
|
# $File=_FullFilePath($file); |
7302
|
|
|
|
|
|
|
# Returns the full or relative path to $file (expanding "~" if necessary). |
7303
|
|
|
|
|
|
|
# Returns an empty string if a "~" expansion cannot be interpreted. The |
7304
|
|
|
|
|
|
|
# path does not need to exist. _CleanFile is called. |
7305
|
|
|
|
|
|
|
sub _FullFilePath { |
7306
|
0
|
|
|
0
|
|
|
my($file)=shift; |
7307
|
0
|
|
|
|
|
|
my($rootpat) = '^/'; #default pattern to match absolute path |
7308
|
0
|
0
|
|
|
|
|
$rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows'); |
7309
|
0
|
|
|
|
|
|
$file=_ExpandTilde($file); |
7310
|
0
|
0
|
|
|
|
|
return "" if (! defined $file); |
7311
|
0
|
|
|
|
|
|
return _CleanFile($file); |
7312
|
|
|
|
|
|
|
} |
7313
|
|
|
|
|
|
|
|
7314
|
|
|
|
|
|
|
# $Flag=_CheckFilePath($file [,$mode]); |
7315
|
|
|
|
|
|
|
# Checks to see if $file exists, to see what type it is, and whether |
7316
|
|
|
|
|
|
|
# the script can access it. If it exists and has the correct mode, 1 |
7317
|
|
|
|
|
|
|
# is returned. |
7318
|
|
|
|
|
|
|
# |
7319
|
|
|
|
|
|
|
# $mode is a string which may contain any of the valid file test operator |
7320
|
|
|
|
|
|
|
# characters except t, M, A, C. The appropriate test is run for each |
7321
|
|
|
|
|
|
|
# character. For example, if $mode is "re" the -r and -e tests are both |
7322
|
|
|
|
|
|
|
# run. |
7323
|
|
|
|
|
|
|
# |
7324
|
|
|
|
|
|
|
# An empty string is returned if the file doesn't exist. A 0 is returned |
7325
|
|
|
|
|
|
|
# if the file exists but any test fails. |
7326
|
|
|
|
|
|
|
# |
7327
|
|
|
|
|
|
|
# All characters in $mode which do not correspond to valid tests are |
7328
|
|
|
|
|
|
|
# ignored. |
7329
|
|
|
|
|
|
|
sub _CheckFilePath { |
7330
|
0
|
|
|
0
|
|
|
my($file,$mode)=@_; |
7331
|
0
|
|
|
|
|
|
my($test)=(); |
7332
|
0
|
|
|
|
|
|
$file=_FullFilePath($file); |
7333
|
0
|
0
|
|
|
|
|
$mode = "" if (! defined $mode); |
7334
|
|
|
|
|
|
|
|
7335
|
|
|
|
|
|
|
# Run tests |
7336
|
0
|
0
|
0
|
|
|
|
return 0 if (! defined $file or ! $file); |
7337
|
0
|
0
|
0
|
|
|
|
return 0 if (( ! -e $file) or |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
7338
|
|
|
|
|
|
|
($mode =~ /r/ && ! -r $file) or |
7339
|
|
|
|
|
|
|
($mode =~ /w/ && ! -w $file) or |
7340
|
|
|
|
|
|
|
($mode =~ /x/ && ! -x $file) or |
7341
|
|
|
|
|
|
|
($mode =~ /R/ && ! -R $file) or |
7342
|
|
|
|
|
|
|
($mode =~ /W/ && ! -W $file) or |
7343
|
|
|
|
|
|
|
($mode =~ /X/ && ! -X $file) or |
7344
|
|
|
|
|
|
|
($mode =~ /o/ && ! -o $file) or |
7345
|
|
|
|
|
|
|
($mode =~ /O/ && ! -O $file) or |
7346
|
|
|
|
|
|
|
($mode =~ /z/ && ! -z $file) or |
7347
|
|
|
|
|
|
|
($mode =~ /s/ && ! -s $file) or |
7348
|
|
|
|
|
|
|
($mode =~ /f/ && ! -f $file) or |
7349
|
|
|
|
|
|
|
($mode =~ /d/ && ! -d $file) or |
7350
|
|
|
|
|
|
|
($mode =~ /l/ && ! -l $file) or |
7351
|
|
|
|
|
|
|
($mode =~ /s/ && ! -s $file) or |
7352
|
|
|
|
|
|
|
($mode =~ /p/ && ! -p $file) or |
7353
|
|
|
|
|
|
|
($mode =~ /b/ && ! -b $file) or |
7354
|
|
|
|
|
|
|
($mode =~ /c/ && ! -c $file) or |
7355
|
|
|
|
|
|
|
($mode =~ /u/ && ! -u $file) or |
7356
|
|
|
|
|
|
|
($mode =~ /g/ && ! -g $file) or |
7357
|
|
|
|
|
|
|
($mode =~ /k/ && ! -k $file) or |
7358
|
|
|
|
|
|
|
($mode =~ /T/ && ! -T $file) or |
7359
|
|
|
|
|
|
|
($mode =~ /B/ && ! -B $file)); |
7360
|
0
|
|
|
|
|
|
return 1; |
7361
|
|
|
|
|
|
|
} |
7362
|
|
|
|
|
|
|
#&& |
7363
|
|
|
|
|
|
|
|
7364
|
|
|
|
|
|
|
# $Path=_FixPath($path [,$full] [,$mode] [,$error]); |
7365
|
|
|
|
|
|
|
# Makes sure that every directory in $path (a colon separated list of |
7366
|
|
|
|
|
|
|
# directories) appears as a full path or relative path. All "~" |
7367
|
|
|
|
|
|
|
# expansions are removed. All trailing slashes are removed also. If |
7368
|
|
|
|
|
|
|
# $full is non-nil, relative paths are expanded to full paths as well. |
7369
|
|
|
|
|
|
|
# |
7370
|
|
|
|
|
|
|
# If $mode is given, it may be either "e", "r", or "w". In this case, |
7371
|
|
|
|
|
|
|
# additional checking is done to each directory. If $mode is "e", it |
7372
|
|
|
|
|
|
|
# need ony exist to pass the check. If $mode is "r", it must have have |
7373
|
|
|
|
|
|
|
# read and execute permission. If $mode is "w", it must have read, |
7374
|
|
|
|
|
|
|
# write, and execute permission. |
7375
|
|
|
|
|
|
|
# |
7376
|
|
|
|
|
|
|
# The value of $error determines what happens if the directory does not |
7377
|
|
|
|
|
|
|
# pass the test. If it is non-nil, if any directory does not pass the |
7378
|
|
|
|
|
|
|
# test, the subroutine returns the empty string. Otherwise, it is simply |
7379
|
|
|
|
|
|
|
# removed from $path. |
7380
|
|
|
|
|
|
|
# |
7381
|
|
|
|
|
|
|
# The corrected path is returned. |
7382
|
|
|
|
|
|
|
sub _FixPath { |
7383
|
0
|
|
|
0
|
|
|
my($path,$full,$mode,$err)=@_; |
7384
|
0
|
|
|
|
|
|
local($_)=""; |
7385
|
0
|
|
|
|
|
|
my(@dir)=split(/$Cnf{"PathSep"}/,$path); |
7386
|
0
|
0
|
|
|
|
|
$full=0 if (! defined $full); |
7387
|
0
|
0
|
|
|
|
|
$mode="" if (! defined $mode); |
7388
|
0
|
0
|
|
|
|
|
$err=0 if (! defined $err); |
7389
|
0
|
|
|
|
|
|
$path=""; |
7390
|
0
|
0
|
|
|
|
|
if ($mode eq "e") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
7391
|
0
|
|
|
|
|
|
$mode="de"; |
7392
|
|
|
|
|
|
|
} elsif ($mode eq "r") { |
7393
|
0
|
|
|
|
|
|
$mode="derx"; |
7394
|
|
|
|
|
|
|
} elsif ($mode eq "w") { |
7395
|
0
|
|
|
|
|
|
$mode="derwx"; |
7396
|
|
|
|
|
|
|
} |
7397
|
|
|
|
|
|
|
|
7398
|
0
|
|
|
|
|
|
foreach (@dir) { |
7399
|
|
|
|
|
|
|
|
7400
|
|
|
|
|
|
|
# Expand path |
7401
|
0
|
0
|
|
|
|
|
if ($full) { |
7402
|
0
|
|
|
|
|
|
$_=_FullFilePath($_); |
7403
|
|
|
|
|
|
|
} else { |
7404
|
0
|
|
|
|
|
|
$_=_ExpandTilde($_); |
7405
|
|
|
|
|
|
|
} |
7406
|
0
|
0
|
|
|
|
|
if (! defined $_) { |
7407
|
0
|
0
|
|
|
|
|
return "" if ($err); |
7408
|
0
|
|
|
|
|
|
next; |
7409
|
|
|
|
|
|
|
} |
7410
|
|
|
|
|
|
|
|
7411
|
|
|
|
|
|
|
# Check mode |
7412
|
0
|
0
|
0
|
|
|
|
if (! defined $mode or _CheckFilePath($_,$mode)) { |
7413
|
0
|
|
|
|
|
|
$path .= $Cnf{"PathSep"} . $_; |
7414
|
|
|
|
|
|
|
} else { |
7415
|
0
|
0
|
|
|
|
|
return "" if ($err); |
7416
|
|
|
|
|
|
|
} |
7417
|
|
|
|
|
|
|
} |
7418
|
0
|
|
|
|
|
|
$path =~ s/^$Cnf{"PathSep"}//; |
7419
|
0
|
|
|
|
|
|
return $path; |
7420
|
|
|
|
|
|
|
} |
7421
|
|
|
|
|
|
|
#&& |
7422
|
|
|
|
|
|
|
|
7423
|
|
|
|
|
|
|
# $File=_SearchPath($file,$path [,$mode] [,@suffixes]); |
7424
|
|
|
|
|
|
|
# Searches through directories in $path for a file named $file. The |
7425
|
|
|
|
|
|
|
# full path is returned if one is found, or an empty string otherwise. |
7426
|
|
|
|
|
|
|
# The file may exist with one of the @suffixes. The mode is checked |
7427
|
|
|
|
|
|
|
# similar to _CheckFilePath. |
7428
|
|
|
|
|
|
|
# |
7429
|
|
|
|
|
|
|
# The first full path that matches the name and mode is returned. If none |
7430
|
|
|
|
|
|
|
# is found, an empty string is returned. |
7431
|
|
|
|
|
|
|
sub _SearchPath { |
7432
|
0
|
|
|
0
|
|
|
my($file,$path,$mode,@suff)=@_; |
7433
|
0
|
|
|
|
|
|
my($f,$s,$d,@dir,$fs)=(); |
7434
|
0
|
|
|
|
|
|
$path=_FixPath($path,1,"r"); |
7435
|
0
|
|
|
|
|
|
@dir=split(/$Cnf{"PathSep"}/,$path); |
7436
|
0
|
|
|
|
|
|
foreach $d (@dir) { |
7437
|
0
|
|
|
|
|
|
$f="$d/$file"; |
7438
|
0
|
|
|
|
|
|
$f=~ s|//|/|g; |
7439
|
0
|
0
|
|
|
|
|
return $f if (_CheckFilePath($f,$mode)); |
7440
|
0
|
|
|
|
|
|
foreach $s (@suff) { |
7441
|
0
|
|
|
|
|
|
$fs="$f.$s"; |
7442
|
0
|
0
|
|
|
|
|
return $fs if (_CheckFilePath($fs,$mode)); |
7443
|
|
|
|
|
|
|
} |
7444
|
|
|
|
|
|
|
} |
7445
|
0
|
|
|
|
|
|
return ""; |
7446
|
|
|
|
|
|
|
} |
7447
|
|
|
|
|
|
|
|
7448
|
|
|
|
|
|
|
# @list=_ReturnList($str); |
7449
|
|
|
|
|
|
|
# This takes a string which should be a comma separated list of integers |
7450
|
|
|
|
|
|
|
# or ranges (5-7). It returns a sorted list of all integers referred to |
7451
|
|
|
|
|
|
|
# by the string, or () if there is an invalid element. |
7452
|
|
|
|
|
|
|
# |
7453
|
|
|
|
|
|
|
# Negative integers are also handled. "-2--1" is equivalent to "-2,-1". |
7454
|
|
|
|
|
|
|
sub _ReturnList { |
7455
|
0
|
|
|
0
|
|
|
my($str)=@_; |
7456
|
0
|
|
|
|
|
|
my(@ret,@str,$from,$to,$tmp)=(); |
7457
|
0
|
|
|
|
|
|
@str=split(/,/,$str); |
7458
|
0
|
|
|
|
|
|
foreach $str (@str) { |
7459
|
0
|
0
|
|
|
|
|
if ($str =~ /^[-+]?\d+$/) { |
|
|
0
|
|
|
|
|
|
7460
|
0
|
|
|
|
|
|
push(@ret,$str); |
7461
|
|
|
|
|
|
|
} elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) { |
7462
|
0
|
|
|
|
|
|
($from,$to)=($1,$2); |
7463
|
0
|
0
|
|
|
|
|
if ($from>$to) { |
7464
|
0
|
|
|
|
|
|
$tmp=$from; |
7465
|
0
|
|
|
|
|
|
$from=$to; |
7466
|
0
|
|
|
|
|
|
$to=$tmp; |
7467
|
|
|
|
|
|
|
} |
7468
|
0
|
|
|
|
|
|
push(@ret,$from..$to); |
7469
|
|
|
|
|
|
|
} else { |
7470
|
0
|
|
|
|
|
|
return (); |
7471
|
|
|
|
|
|
|
} |
7472
|
|
|
|
|
|
|
} |
7473
|
0
|
|
|
|
|
|
@ret; |
7474
|
|
|
|
|
|
|
} |
7475
|
|
|
|
|
|
|
|
7476
|
|
|
|
|
|
|
1; |
7477
|
|
|
|
|
|
|
# Local Variables: |
7478
|
|
|
|
|
|
|
# mode: cperl |
7479
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
7480
|
|
|
|
|
|
|
# cperl-indent-level: 3 |
7481
|
|
|
|
|
|
|
# cperl-continued-statement-offset: 2 |
7482
|
|
|
|
|
|
|
# cperl-continued-brace-offset: 0 |
7483
|
|
|
|
|
|
|
# cperl-brace-offset: 0 |
7484
|
|
|
|
|
|
|
# cperl-brace-imaginary-offset: 0 |
7485
|
|
|
|
|
|
|
# cperl-label-offset: 0 |
7486
|
|
|
|
|
|
|
# End: |