Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | |
2 | ############################################################################### | |
3 | ## ## | |
4 | ## Copyright (c) 1995 - 2002 by Steffen Beyer. ## | |
5 | ## All rights reserved. ## | |
6 | ## ## | |
7 | ## This package is free software; you can redistribute it ## | |
8 | ## and/or modify it under the same terms as Perl itself. ## | |
9 | ## ## | |
10 | ############################################################################### | |
11 | ||
12 | package Date::Calc; | |
13 | ||
14 | use strict; | |
15 | use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); | |
16 | ||
17 | require Exporter; | |
18 | require DynaLoader; | |
19 | ||
20 | @ISA = qw(Exporter DynaLoader); | |
21 | ||
22 | @EXPORT = qw(); | |
23 | ||
24 | @EXPORT_OK = qw( | |
25 | Days_in_Year | |
26 | Days_in_Month | |
27 | Weeks_in_Year | |
28 | leap_year | |
29 | check_date | |
30 | check_time | |
31 | check_business_date | |
32 | Day_of_Year | |
33 | Date_to_Days | |
34 | Day_of_Week | |
35 | Week_Number | |
36 | Week_of_Year | |
37 | Monday_of_Week | |
38 | Nth_Weekday_of_Month_Year | |
39 | Standard_to_Business | |
40 | Business_to_Standard | |
41 | Delta_Days | |
42 | Delta_DHMS | |
43 | Delta_YMD | |
44 | Delta_YMDHMS | |
45 | Normalize_DHMS | |
46 | Add_Delta_Days | |
47 | Add_Delta_DHMS | |
48 | Add_Delta_YM | |
49 | Add_Delta_YMD | |
50 | Add_Delta_YMDHMS | |
51 | System_Clock | |
52 | Today | |
53 | Now | |
54 | Today_and_Now | |
55 | This_Year | |
56 | Gmtime | |
57 | Localtime | |
58 | Mktime | |
59 | Timezone | |
60 | Date_to_Time | |
61 | Time_to_Date | |
62 | Easter_Sunday | |
63 | Decode_Month | |
64 | Decode_Day_of_Week | |
65 | Decode_Language | |
66 | Decode_Date_EU | |
67 | Decode_Date_US | |
68 | Fixed_Window | |
69 | Moving_Window | |
70 | Compress | |
71 | Uncompress | |
72 | check_compressed | |
73 | Compressed_to_Text | |
74 | Date_to_Text | |
75 | Date_to_Text_Long | |
76 | English_Ordinal | |
77 | Calendar | |
78 | Month_to_Text | |
79 | Day_of_Week_to_Text | |
80 | Day_of_Week_Abbreviation | |
81 | Language_to_Text | |
82 | Language | |
83 | Languages | |
84 | Decode_Date_EU2 | |
85 | Decode_Date_US2 | |
86 | Parse_Date | |
87 | ISO_LC | |
88 | ISO_UC | |
89 | ); | |
90 | ||
91 | %EXPORT_TAGS = (all => [@EXPORT_OK]); | |
92 | ||
93 | ################################################## | |
94 | ## ## | |
95 | ## "Version()" is available but not exported ## | |
96 | ## in order to avoid possible name clashes. ## | |
97 | ## Call with "Date::Calc::Version()" instead! ## | |
98 | ## ## | |
99 | ################################################## | |
100 | ||
101 | $VERSION = '5.3'; | |
102 | ||
103 | bootstrap Date::Calc $VERSION; | |
104 | ||
105 | sub Decode_Date_EU2 | |
106 | { | |
107 | die "Usage: (\$year,\$month,\$day) = Decode_Date_EU2(\$date);\n" | |
108 | if (@_ != 1); | |
109 | ||
110 | my($buffer) = @_; | |
111 | my($year,$month,$day,$length); | |
112 | ||
113 | if ($buffer =~ /^\D* (\d+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* (\d+) \D*$/x) | |
114 | { | |
115 | ($day,$month,$year) = ($1,$2,$3); | |
116 | $month = Decode_Month($month); | |
117 | unless ($month > 0) | |
118 | { | |
119 | return(); # can't decode month! | |
120 | } | |
121 | } | |
122 | elsif ($buffer =~ /^\D* 0*(\d+) \D*$/x) | |
123 | { | |
124 | $buffer = $1; | |
125 | $length = length($buffer); | |
126 | if ($length == 3) | |
127 | { | |
128 | $day = substr($buffer,0,1); | |
129 | $month = substr($buffer,1,1); | |
130 | $year = substr($buffer,2,1); | |
131 | } | |
132 | elsif ($length == 4) | |
133 | { | |
134 | $day = substr($buffer,0,1); | |
135 | $month = substr($buffer,1,1); | |
136 | $year = substr($buffer,2,2); | |
137 | } | |
138 | elsif ($length == 5) | |
139 | { | |
140 | $day = substr($buffer,0,1); | |
141 | $month = substr($buffer,1,2); | |
142 | $year = substr($buffer,3,2); | |
143 | } | |
144 | elsif ($length == 6) | |
145 | { | |
146 | $day = substr($buffer,0,2); | |
147 | $month = substr($buffer,2,2); | |
148 | $year = substr($buffer,4,2); | |
149 | } | |
150 | elsif ($length == 7) | |
151 | { | |
152 | $day = substr($buffer,0,1); | |
153 | $month = substr($buffer,1,2); | |
154 | $year = substr($buffer,3,4); | |
155 | } | |
156 | elsif ($length == 8) | |
157 | { | |
158 | $day = substr($buffer,0,2); | |
159 | $month = substr($buffer,2,2); | |
160 | $year = substr($buffer,4,4); | |
161 | } | |
162 | else { return(); } # wrong number of digits! | |
163 | } | |
164 | elsif ($buffer =~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x) | |
165 | { | |
166 | ($day,$month,$year) = ($1,$2,$3); | |
167 | } | |
168 | else { return(); } # no match at all! | |
169 | $year = Moving_Window($year); | |
170 | if (check_date($year,$month,$day)) | |
171 | { | |
172 | return($year,$month,$day); | |
173 | } | |
174 | else { return(); } # not a valid date! | |
175 | } | |
176 | ||
177 | sub Decode_Date_US2 | |
178 | { | |
179 | die "Usage: (\$year,\$month,\$day) = Decode_Date_US2(\$date);\n" | |
180 | if (@_ != 1); | |
181 | ||
182 | my($buffer) = @_; | |
183 | my($year,$month,$day,$length); | |
184 | ||
185 | if ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* 0*(\d+) \D*$/x) | |
186 | { | |
187 | ($month,$buffer) = ($1,$2); | |
188 | $month = Decode_Month($month); | |
189 | unless ($month > 0) | |
190 | { | |
191 | return(); # can't decode month! | |
192 | } | |
193 | $length = length($buffer); | |
194 | if ($length == 2) | |
195 | { | |
196 | $day = substr($buffer,0,1); | |
197 | $year = substr($buffer,1,1); | |
198 | } | |
199 | elsif ($length == 3) | |
200 | { | |
201 | $day = substr($buffer,0,1); | |
202 | $year = substr($buffer,1,2); | |
203 | } | |
204 | elsif ($length == 4) | |
205 | { | |
206 | $day = substr($buffer,0,2); | |
207 | $year = substr($buffer,2,2); | |
208 | } | |
209 | elsif ($length == 5) | |
210 | { | |
211 | $day = substr($buffer,0,1); | |
212 | $year = substr($buffer,1,4); | |
213 | } | |
214 | elsif ($length == 6) | |
215 | { | |
216 | $day = substr($buffer,0,2); | |
217 | $year = substr($buffer,2,4); | |
218 | } | |
219 | else { return(); } # wrong number of digits! | |
220 | } | |
221 | elsif ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* (\d+) \D+ (\d+) \D*$/x) | |
222 | { | |
223 | ($month,$day,$year) = ($1,$2,$3); | |
224 | $month = Decode_Month($month); | |
225 | unless ($month > 0) | |
226 | { | |
227 | return(); # can't decode month! | |
228 | } | |
229 | } | |
230 | elsif ($buffer =~ /^\D* 0*(\d+) \D*$/x) | |
231 | { | |
232 | $buffer = $1; | |
233 | $length = length($buffer); | |
234 | if ($length == 3) | |
235 | { | |
236 | $month = substr($buffer,0,1); | |
237 | $day = substr($buffer,1,1); | |
238 | $year = substr($buffer,2,1); | |
239 | } | |
240 | elsif ($length == 4) | |
241 | { | |
242 | $month = substr($buffer,0,1); | |
243 | $day = substr($buffer,1,1); | |
244 | $year = substr($buffer,2,2); | |
245 | } | |
246 | elsif ($length == 5) | |
247 | { | |
248 | $month = substr($buffer,0,1); | |
249 | $day = substr($buffer,1,2); | |
250 | $year = substr($buffer,3,2); | |
251 | } | |
252 | elsif ($length == 6) | |
253 | { | |
254 | $month = substr($buffer,0,2); | |
255 | $day = substr($buffer,2,2); | |
256 | $year = substr($buffer,4,2); | |
257 | } | |
258 | elsif ($length == 7) | |
259 | { | |
260 | $month = substr($buffer,0,1); | |
261 | $day = substr($buffer,1,2); | |
262 | $year = substr($buffer,3,4); | |
263 | } | |
264 | elsif ($length == 8) | |
265 | { | |
266 | $month = substr($buffer,0,2); | |
267 | $day = substr($buffer,2,2); | |
268 | $year = substr($buffer,4,4); | |
269 | } | |
270 | else { return(); } # wrong number of digits! | |
271 | } | |
272 | elsif ($buffer =~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x) | |
273 | { | |
274 | ($month,$day,$year) = ($1,$2,$3); | |
275 | } | |
276 | else { return(); } # no match at all! | |
277 | $year = Moving_Window($year); | |
278 | if (check_date($year,$month,$day)) | |
279 | { | |
280 | return($year,$month,$day); | |
281 | } | |
282 | else { return(); } # not a valid date! | |
283 | } | |
284 | ||
285 | sub Parse_Date | |
286 | { | |
287 | die "Usage: (\$year,\$month,\$day) = Parse_Date(\$date);\n" | |
288 | if (@_ != 1); | |
289 | ||
290 | my($date) = @_; | |
291 | my($year,$month,$day); | |
292 | unless ($date =~ /\b([JFMASOND][aepuco][nbrynlgptvc])\s+([0123]??\d)\b/) | |
293 | { | |
294 | return(); | |
295 | } | |
296 | $month = $1; | |
297 | $day = $2; | |
298 | unless ($date =~ /\b(19\d\d|20\d\d)\b/) | |
299 | { | |
300 | return(); | |
301 | } | |
302 | $year = $1; | |
303 | $month = Decode_Month($month); | |
304 | unless ($month > 0) | |
305 | { | |
306 | return(); | |
307 | } | |
308 | unless (check_date($year,$month,$day)) | |
309 | { | |
310 | return(); | |
311 | } | |
312 | return($year,$month,$day); | |
313 | } | |
314 | ||
315 | 1; | |
316 | ||
317 | __END__ | |
318 |