Manip.pm

Revision 53, 235.4 kB (checked in by bkuhn, 10 months ago)
Added SFLC's internally developed tim bot released under AGPLv3

Line
1	package Date::Manip;
2	# Copyright (c) 1995-2005 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
10	use vars qw($OS %Lang %Holiday %Events %Curr %Cnf %Zone $VERSION @ISA @EXPORT);
11
12	# Determine the type of OS...
13	$OS="Unix";
14	$OS="Windows" if ((defined $^O and
15	$^O =~ /MSWin32/i \|\|
16	$^O =~ /Windows_95/i \|\|
17	$^O =~ /Windows_NT/i) \|\|
18	(defined $ENV{OS} and
19	$ENV{OS} =~ /MSWin32/i \|\|
20	$ENV{OS} =~ /Windows_95/i \|\|
21	$ENV{OS} =~ /Windows_NT/i));
22	$OS="Unix" if (defined $^O and
23	$^O =~ /cygwin/i);
24	$OS="Netware" if (defined $^O and
25	$^O =~ /NetWare/i);
26	$OS="Mac" if ((defined $^O and
27	$^O =~ /MacOS/i) \|\|
28	(defined $ENV{OS} and
29	$ENV{OS} =~ /MacOS/i));
30	$OS="MPE" if (defined $^O and
31	$^O =~ /MPE/i);
32	$OS="OS2" if (defined $^O and
33	$^O =~ /os2/i);
34	$OS="VMS" if (defined $^O and
35	$^O =~ /VMS/i);
36
37	# Determine if we're doing taint checking
38	$Date::Manip::NoTaint = eval { local $^W=0; eval("#" . substr($^X, 0, 0)); 1 };
39
40	###########################################################################
41	# CUSTOMIZATION
42	###########################################################################
43	#
44	# See the section of the POD documentation section CUSTOMIZING DATE::MANIP
45	# below for a complete description of each of these variables.
46
47
48	# Location of a the global config file. Tilde (~) expansions are allowed.
49	# This should be set in Date_Init arguments.
50	$Cnf{"GlobalCnf"}="/etc/DateManip.cnf";
51	$Cnf{"IgnoreGlobalCnf"}="";
52
53	# Name of a personal config file and the path to search for it. Tilde (~)
54	# expansions are allowed. This should be set in Date_Init arguments or in
55	# the global config file.
56
57	@Date::Manip::DatePath=();
58	if ($OS eq "Windows") {
59	$Cnf{"PathSep"} = ";";
60	$Cnf{"PersonalCnf"} = "Manip.cnf";
61	$Cnf{"PersonalCnfPath"} = ".";
62
63	} elsif ($OS eq "Netware") {
64	$Cnf{"PathSep"} = ";";
65	$Cnf{"PersonalCnf"} = "Manip.cnf";
66	$Cnf{"PersonalCnfPath"} = ".";
67
68	} elsif ($OS eq "MPE") {
69	$Cnf{"PathSep"} = ":";
70	$Cnf{"PersonalCnf"} = "Manip.cnf";
71	$Cnf{"PersonalCnfPath"} = ".";
72
73	} elsif ($OS eq "OS2") {
74	$Cnf{"PathSep"} = ":";
75	$Cnf{"PersonalCnf"} = "Manip.cnf";
76	$Cnf{"PersonalCnfPath"} = ".";
77
78	} elsif ($OS eq "Mac") {
79	$Cnf{"PathSep"} = ":";
80	$Cnf{"PersonalCnf"} = "Manip.cnf";
81	$Cnf{"PersonalCnfPath"} = ".";
82
83	} elsif ($OS eq "VMS") {
84	# VMS doesn't like files starting with "."
85	$Cnf{"PathSep"} = ",";
86	$Cnf{"PersonalCnf"} = "Manip.cnf";
87	$Cnf{"PersonalCnfPath"} = "/sys\$login";
88
89	} else {
90	# Unix
91	$Cnf{"PathSep"} = ":";
92	$Cnf{"PersonalCnf"} = ".DateManip.cnf";
93	$Cnf{"PersonalCnfPath"} = ".:~";
94	@Date::Manip::DatePath=qw(/bin /usr/bin /usr/local/bin);
95	}
96
97	### Date::Manip variables set in the global or personal config file
98
99	# Which language to use when parsing dates.
100	$Cnf{"Language"}="English";
101
102	# 12/10 = Dec 10 (US) or Oct 12 (anything else)
103	$Cnf{"DateFormat"}="US";
104
105	# Local timezone
106	$Cnf{"TZ"}="";
107
108	# Timezone to work in (""=local, "IGNORE", or a timezone)
109	$Cnf{"ConvTZ"}="";
110
111	# Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
112	$Cnf{"Internal"}=0;
113
114	# First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
115	$Cnf{"FirstDay"}=1;
116
117	# First and last day of the work week (1=monday, 7=sunday)
118	$Cnf{"WorkWeekBeg"}=1;
119	$Cnf{"WorkWeekEnd"}=5;
120
121	# If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
122	# ignored)
123	$Cnf{"WorkDay24Hr"}=0;
124
125	# Start and end time of the work day (any time format allowed, seconds
126	# ignored)
127	$Cnf{"WorkDayBeg"}="08:00";
128	$Cnf{"WorkDayEnd"}="17:00";
129
130	# If "today" is a holiday, we look either to "tomorrow" or "yesterday" for
131	# the nearest business day. By default, we'll always look "tomorrow"
132	# first.
133	$Cnf{"TomorrowFirst"}=1;
134
135	# Erase the old holidays
136	$Cnf{"EraseHolidays"}="";
137
138	# Set this to non-zero to be produce completely backwards compatible deltas
139	$Cnf{"DeltaSigns"}=0;
140
141	# If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
142	# make week 1 contain Jan 1.
143	$Cnf{"Jan1Week1"}=0;
144
145	# 2 digit years fall into the 100 year period given by [ CURR-N,
146	# CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful
147	# numbers might be 0 (forced to be this year or later) and 99 (forced to be
148	# this year or earlier). It can also be set to "c" (current century) or
149	# "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the
150	# form cNNNN to give the 100 year period NNNN to NNNN+99.
151	$Cnf{"YYtoYYYY"}=89;
152
153	# Set this to 1 if you want a long-running script to always update the
154	# timezone. This will slow Date::Manip down. Read the POD documentation.
155	$Cnf{"UpdateCurrTZ"}=0;
156
157	# Use an international character set.
158	$Cnf{"IntCharSet"}=0;
159
160	# Use this to force the current date to be set to this:
161	$Cnf{"ForceDate"}="";
162
163	# Use this to make "today" mean "today at midnight".
164	$Cnf{"TodayIsMidnight"}=0;
165
166	###########################################################################
167
168	require 5.000;
169	require Exporter;
170	@ISA = qw(Exporter);
171	@EXPORT = qw(
172	DateManipVersion
173	Date_Init
174	ParseDateString
175	ParseDate
176	ParseRecur
177	Date_Cmp
178	DateCalc
179	ParseDateDelta
180	UnixDate
181	Delta_Format
182	Date_GetPrev
183	Date_GetNext
184	Date_SetTime
185	Date_SetDateField
186	Date_IsHoliday
187	Events_List
188
189	Date_DaysInMonth
190	Date_DayOfWeek
191	Date_SecsSince1970
192	Date_SecsSince1970GMT
193	Date_DaysSince1BC
194	Date_DayOfYear
195	Date_DaysInYear
196	Date_WeekOfYear
197	Date_LeapYear
198	Date_DaySuffix
199	Date_ConvTZ
200	Date_TimeZone
201	Date_IsWorkDay
202	Date_NextWorkDay
203	Date_PrevWorkDay
204	Date_NearestWorkDay
205	Date_NthDayOfYear
206	);
207	use strict;
208	use integer;
209	use Carp;
210
211	use IO::File;
212
213	$VERSION="5.44";
214
215	########################################################################
216	########################################################################
217
218	$Curr{"InitLang"} = 1; # Whether a language is being init'ed
219	$Curr{"InitDone"} = 0; # Whether Init_Date has been called
220	$Curr{"InitFilesRead"} = 0;
221	$Curr{"ResetWorkDay"} = 1;
222	$Curr{"Debug"} = "";
223	$Curr{"DebugVal"} = "";
224
225	$Holiday{"year"} = 0;
226	$Holiday{"dates"} = {};
227	$Holiday{"desc"} = {};
228
229	$Events{"raw"} = [];
230	$Events{"parsed"} = 0;
231	$Events{"dates"} = [];
232	$Events{"recur"} = [];
233
234	########################################################################
235	########################################################################
236	# THESE ARE THE MAIN ROUTINES
237	########################################################################
238	########################################################################
239
240	# Get rid of a problem with old versions of perl
241	no strict "vars";
242	# This sorts from longest to shortest element
243	sub sortByLength {
244	return (length $b <=> length $a);
245	}
246	use strict "vars";
247
248	sub DateManipVersion {
249	print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
250	return "bkuhn-" . $VERSION;
251	}
252
253	sub Date_Init {
254	print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
255	$Curr{"Debug"}="";
256
257	my(@args)=@_;
258	$Curr{"InitDone"}=1;
259	local($_)=();
260	my($internal,$firstday)=();
261	my($var,$val,$file,@tmp)=();
262
263	# InitFilesRead = 0 : no conf files read yet
264	# 1 : global read, no personal read
265	# 2 : personal read
266
267	$Cnf{"EraseHolidays"}=0;
268	foreach (@args) {
269	s/\s*$//;
270	s/^\s*//;
271	/^(\S+) \s* = \s* (.*)$/x;
272	($var,$val)=($1,$2);
273	if ($var =~ /^GlobalCnf$/i) {
274	$Cnf{"GlobalCnf"}=$val;
275	if ($val) {
276	$Curr{"InitFilesRead"}=0;
277	&EraseHolidays();
278	}
279	} elsif ($var =~ /^PathSep$/i) {
280	$Cnf{"PathSep"}=$val;
281	} elsif ($var =~ /^PersonalCnf$/i) {
282	$Cnf{"PersonalCnf"}=$val;
283	$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
284	} elsif ($var =~ /^PersonalCnfPath$/i) {
285	$Cnf{"PersonalCnfPath"}=$val;
286	$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
287	} elsif ($var =~ /^IgnoreGlobalCnf$/i) {
288	$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0);
289	$Cnf{"IgnoreGlobalCnf"}=1;
290	} elsif ($var =~ /^EraseHolidays$/i) {
291	&EraseHolidays();
292	} else {
293	push(@tmp,$_);
294	}
295	}
296	@args=@tmp;
297
298	# Read global config file
299	if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
300	$Curr{"InitFilesRead"}=1;
301
302	if ($Cnf{"GlobalCnf"}) {
303	$file=&ExpandTilde($Cnf{"GlobalCnf"});
304	&Date_InitFile($file) if ($file);
305	}
306	}
307
308	# Read personal config file
309	if ($Curr{"InitFilesRead"}<2) {
310	$Curr{"InitFilesRead"}=2;
311
312	if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) {
313	$file=&SearchPath($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r");
314	&Date_InitFile($file) if ($file);
315	}
316	}
317
318	foreach (@args) {
319	s/\s*$//;
320	s/^\s*//;
321	/^(\S+) \s* = \s* (.*)$/x;
322	($var,$val)=($1,$2);
323	$val="" if (! defined $val);
324	&Date_SetConfigVariable($var,$val);
325	}
326
327	confess "ERROR: Unknown FirstDay in Date::Manip.\n"
328	if (! &IsInt($Cnf{"FirstDay"},1,7));
329	confess "ERROR: Unknown WorkWeekBeg in Date::Manip.\n"
330	if (! &IsInt($Cnf{"WorkWeekBeg"},1,7));
331	confess "ERROR: Unknown WorkWeekEnd in Date::Manip.\n"
332	if (! &IsInt($Cnf{"WorkWeekEnd"},1,7));
333	confess "ERROR: Invalid WorkWeek in Date::Manip.\n"
334	if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"});
335
336	my(%lang,
337	$tmp,%tmp,$tmp2,@tmp2,
338	$i,$j,@tmp3,
339	$zonesrfc,@zones)=();
340
341	my($L)=$Cnf{"Language"};
342
343	if ($Curr{"InitLang"}) {
344	$Curr{"InitLang"}=0;
345
346	if ($L eq "English") {
347	&Date_Init_English(\%lang);
348
349	} elsif ($L eq "French") {
350	&Date_Init_French(\%lang);
351
352	} elsif ($L eq "Swedish") {
353	&Date_Init_Swedish(\%lang);
354
355	} elsif ($L eq "German") {
356	&Date_Init_German(\%lang);
357
358	} elsif ($L eq "Polish") {
359	&Date_Init_Polish(\%lang);
360
361	} elsif ($L eq "Dutch" \|\|
362	$L eq "Nederlands") {
363	&Date_Init_Dutch(\%lang);
364
365	} elsif ($L eq "Spanish") {
366	&Date_Init_Spanish(\%lang);
367
368	} elsif ($L eq "Portuguese") {
369	&Date_Init_Portuguese(\%lang);
370
371	} elsif ($L eq "Romanian") {
372	&Date_Init_Romanian(\%lang);
373
374	} elsif ($L eq "Italian") {
375	&Date_Init_Italian(\%lang);
376
377	} elsif ($L eq "Russian") {
378	&Date_Init_Russian(\%lang);
379
380	} elsif ($L eq "Turkish") {
381	&Date_Init_Turkish(\%lang);
382
383	} elsif ($L eq "Danish") {
384	&Date_Init_Danish(\%lang);
385
386	} elsif ($L eq "Catalan") {
387	&Date_Init_Catalan(\%lang);
388
389	} else {
390	confess "ERROR: Unknown language in Date::Manip.\n";
391	}
392
393	# variables for months
394	# Month = "(jan\|january\|feb\|february ... )"
395	# MonL = [ "Jan","Feb",... ]
396	# MonthL = [ "January","February", ... ]
397	# MonthH = { "january"=>1, "jan"=>1, ... }
398
399	$Lang{$L}{"MonthH"}={};
400	$Lang{$L}{"MonthL"}=[];
401	$Lang{$L}{"MonL"}=[];
402	&Date_InitLists([$lang{"month_name"},
403	$lang{"month_abb"}],
404	\$Lang{$L}{"Month"},"lc,sort,back",
405	[$Lang{$L}{"MonthL"},
406	$Lang{$L}{"MonL"}],
407	[$Lang{$L}{"MonthH"},1]);
408
409	# variables for day of week
410	# Week = "(mon\|monday\|tue\|tuesday ... )"
411	# WL = [ "M","T",... ]
412	# WkL = [ "Mon","Tue",... ]
413	# WeekL = [ "Monday","Tudesday",... ]
414	# WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
415
416	$Lang{$L}{"WeekH"}={};
417	$Lang{$L}{"WeekL"}=[];
418	$Lang{$L}{"WkL"}=[];
419	$Lang{$L}{"WL"}=[];
420	&Date_InitLists([$lang{"day_name"},
421	$lang{"day_abb"}],
422	\$Lang{$L}{"Week"},"lc,sort,back",
423	[$Lang{$L}{"WeekL"},
424	$Lang{$L}{"WkL"}],
425	[$Lang{$L}{"WeekH"},1]);
426	&Date_InitLists([$lang{"day_char"}],
427	"","lc",
428	[$Lang{$L}{"WL"}],
429	[\%tmp,1]);
430	%{ $Lang{$L}{"WeekH"} } =
431	(%{ $Lang{$L}{"WeekH"} },%tmp);
432
433	# variables for last
434	# Last = "(last)"
435	# LastL = [ "last" ]
436	# Each = "(each)"
437	# EachL = [ "each" ]
438	# variables for day of month
439	# DoM = "(1st\|first ... 31st)"
440	# DoML = [ "1st","2nd",... "31st" ]
441	# DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 }
442	# variables for week of month
443	# WoM = "(1st\|first\| ... 5th\|last)"
444	# WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 }
445
446	$Lang{$L}{"LastL"}=$lang{"last"};
447	&Date_InitStrings($lang{"last"},
448	\$Lang{$L}{"Last"},"lc,sort");
449
450	$Lang{$L}{"EachL"}=$lang{"each"};
451	&Date_InitStrings($lang{"each"},
452	\$Lang{$L}{"Each"},"lc,sort");
453
454	$Lang{$L}{"DoMH"}={};
455	$Lang{$L}{"DoML"}=[];
456	&Date_InitLists([$lang{"num_suff"},
457	$lang{"num_word"}],
458	\$Lang{$L}{"DoM"},"lc,sort,back,escape",
459	[$Lang{$L}{"DoML"},
460	\@tmp],
461	[$Lang{$L}{"DoMH"},1]);
462
463	@tmp=();
464	foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
465	$tmp2=$Lang{$L}{"DoMH"}{$tmp};
466	if ($tmp2<6) {
467	$Lang{$L}{"WoMH"}{$tmp} = $tmp2;
468	push(@tmp,$tmp);
469	}
470	}
471	foreach $tmp (@{ $Lang{$L}{"LastL"} }) {
472	$Lang{$L}{"WoMH"}{$tmp} = -1;
473	push(@tmp,$tmp);
474	}
475	&Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"},
476	"lc,sort,back,escape");
477
478	# variables for AM or PM
479	# AM = "(am)"
480	# PM = "(pm)"
481	# AmPm = "(am\|pm)"
482	# AMstr = "AM"
483	# PMstr = "PM"
484
485	&Date_InitStrings($lang{"am"},\$Lang{$L}{"AM"},"lc,sort,escape");
486	&Date_InitStrings($lang{"pm"},\$Lang{$L}{"PM"},"lc,sort,escape");
487	&Date_InitStrings([ @{$lang{"am"}},@{$lang{"pm"}} ],\$Lang{$L}{"AmPm"},
488	"lc,back,sort,escape");
489	$Lang{$L}{"AMstr"}=$lang{"am"}[0];
490	$Lang{$L}{"PMstr"}=$lang{"pm"}[0];
491
492	# variables for expressions used in parsing deltas
493	# Yabb = "(?:y\|yr\|year\|years)"
494	# Mabb = similar for months
495	# Wabb = similar for weeks
496	# Dabb = similar for days
497	# Habb = similar for hours
498	# MNabb = similar for minutes
499	# Sabb = similar for seconds
500	# Repl = { "abb"=>"replacement" }
501	# Whenever an abbreviation could potentially refer to two different
502	# strings (M standing for Minutes or Months), the abbreviation must
503	# be listed in Repl instead of in the appropriate Xabb values. This
504	# only applies to abbreviations which are substrings of other values
505	# (so there is no confusion between Mn and Month).
506
507	&Date_InitStrings($lang{"years"} ,\$Lang{$L}{"Yabb"}, "lc,sort");
508	&Date_InitStrings($lang{"months"} ,\$Lang{$L}{"Mabb"}, "lc,sort");
509	&Date_InitStrings($lang{"weeks"} ,\$Lang{$L}{"Wabb"}, "lc,sort");
510	&Date_InitStrings($lang{"days"} ,\$Lang{$L}{"Dabb"}, "lc,sort");
511	&Date_InitStrings($lang{"hours"} ,\$Lang{$L}{"Habb"}, "lc,sort");
512	&Date_InitStrings($lang{"minutes"},\$Lang{$L}{"MNabb"},"lc,sort");
513	&Date_InitStrings($lang{"seconds"},\$Lang{$L}{"Sabb"}, "lc,sort");
514	$Lang{$L}{"Repl"}={};
515	&Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
516
517	# variables for special dates that are offsets from now
518	# Now = "now"
519	# Today = "today"
520	# Offset = "(yesterday\|tomorrow)"
521	# OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ]
522	# Times = "(noon\|midnight)"
523	# TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" }
524	# SepHM = hour/minute separator
525	# SepMS = minute/second separator
526	# SepSS = second/fraction separator
527
528	$Lang{$L}{"TimesH"}={};
529	&Date_InitHash($lang{"times"},
530	\$Lang{$L}{"Times"},"lc,sort,back",
531	$Lang{$L}{"TimesH"});
532	&Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort");
533	&Date_InitStrings($lang{"today"},\$Lang{$L}{"Today"},"lc,sort");
534	$Lang{$L}{"OffsetH"}={};
535	&Date_InitHash($lang{"offset"},
536	\$Lang{$L}{"Offset"},"lc,sort,back",
537	$Lang{$L}{"OffsetH"});
538	$Lang{$L}{"SepHM"}=$lang{"sephm"};
539	$Lang{$L}{"SepMS"}=$lang{"sepms"};
540	$Lang{$L}{"SepSS"}=$lang{"sepss"};
541
542	# variables for time zones
543	# zones = regular expression with all zone names (EST)
544	# n2o = a hash of all parsable zone names with their offsets
545	# tzones = reguar expression with all tzdata timezones (US/Eastern)
546	# tz2z = hash of all tzdata timezones to full timezone (EST#EDT)
547
548	$zonesrfc=
549	"idlw -1200 ". # International Date Line West
550	"nt -1100 ". # Nome
551	"hst -1000 ". # Hawaii Standard
552	"cat -1000 ". # Central Alaska
553	"ahst -1000 ". # Alaska-Hawaii Standard
554	"akst -0900 ". # Alaska Standard
555	"yst -0900 ". # Yukon Standard
556	"hdt -0900 ". # Hawaii Daylight
557	"akdt -0800 ". # Alaska Daylight
558	"ydt -0800 ". # Yukon Daylight
559	"pst -0800 ". # Pacific Standard
560	"pdt -0700 ". # Pacific Daylight
561	"mst -0700 ". # Mountain Standard
562	"mdt -0600 ". # Mountain Daylight
563	"cst -0600 ". # Central Standard
564	"cdt -0500 ". # Central Daylight
565	"est -0500 ". # Eastern Standard
566	"act -0500 ". # Brazil, Acre
567	"sat -0400 ". # Chile
568	"clst -0400 ". # Chile Standard
569	"bot -0400 ". # Bolivia
570	"amt -0400 ". # Brazil, Amazon
571	"acst -0400 ". # Brazil, Acre Daylight
572	"edt -0400 ". # Eastern Daylight
573	"ast -0400 ". # Atlantic Standard
574	#"nst -0330 ". # Newfoundland Standard nst=North Sumatra +0630
575	"nft -0330 ". # Newfoundland
576	#"gst -0300 ". # Greenland Standard gst=Guam Standard +1000
577	"cldt -0300 ". # Chile Daylight
578	#"bst -0300 ". # Brazil Standard bst=British Summer +0100
579	"brt -0300 ". # Brazil Standard (official time)
580	#"brst -0300 ". # Brazil Standard
581	"adt -0300 ". # Atlantic Daylight
582	"art -0300 ". # Argentina
583	"amst -0300 ". # Brazil, Amazon Daylight
584	"uyt -0300 ". # Uruguay
585	"ndt -0230 ". # Newfoundland Daylight
586	"brst -0200 ". # Brazil Daylight (official time)
587	"fnt -0200 ". # Brazil, Fernando de Noronha
588	"at -0200 ". # Azores
589	"wat -0100 ". # West Africa
590	"fnst -0100 ". # Brazil, Fernando de Noronha Daylight
591	"gmt +0000 ". # Greenwich Mean
592	"ut +0000 ". # Universal
593	"utc +0000 ". # Universal (Coordinated)
594	"wet +0000 ". # Western European
595	"cet +0100 ". # Central European
596	"fwt +0100 ". # French Winter
597	"met +0100 ". # Middle European
598	"mez +0100 ". # Middle European
599	"mewt +0100 ". # Middle European Winter
600	"swt +0100 ". # Swedish Winter
601	"bst +0100 ". # British Summer bst=Brazil standard -0300
602	"gb +0100 ". # GMT with daylight savings
603	"west +0000 ". # Western European Daylight
604	"eet +0200 ". # Eastern Europe, USSR Zone 1
605	"cest +0200 ". # Central European Summer
606	"fst +0200 ". # French Summer
607	"ist +0200 ". # Israel standard
608	"mest +0200 ". # Middle European Summer
609	"mesz +0200 ". # Middle European Summer
610	"metdst +0200 ". # An alias for mest used by HP-UX
611	"sast +0200 ". # South African Standard
612	"sst +0200 ". # Swedish Summer sst=South Sumatra +0700
613	"bt +0300 ". # Baghdad, USSR Zone 2
614	"eest +0300 ". # Eastern Europe Summer
615	"eetedt +0300 ". # Eastern Europe, USSR Zone 1
616	"idt +0300 ". # Israel Daylight
617	"msk +0300 ". # Moscow
618	"eat +0300 ". # East Africa
619	"it +0330 ". # Iran
620	"zp4 +0400 ". # USSR Zone 3
621	"msd +0400 ". # Moscow Daylight
622	"zp5 +0500 ". # USSR Zone 4
623	"ist +0530 ". # Indian Standard
624	"zp6 +0600 ". # USSR Zone 5
625	"novst +0600 ". # Novosibirsk time zone, Russia
626	"nst +0630 ". # North Sumatra nst=Newfoundland Std -0330
627	#"sst +0700 ". # South Sumatra, USSR Zone 6 sst=Swedish Summer +0200
628	"javt +0700 ". # Java
629	"ict +0700 ". # Indo China Time
630	"hkt +0800 ". # Hong Kong
631	"sgt +0800 ". # Singapore
632	"cct +0800 ". # China Coast, USSR Zone 7
633	"awst +0800 ". # Australian Western Standard
634	"wst +0800 ". # West Australian Standard
635	"pht +0800 ". # Asia Manila
636	"kst +0900 ". # Republic of Korea
637	"jst +0900 ". # Japan Standard, USSR Zone 8
638	"rok +0900 ". # Republic of Korea
639	"acst +0930 ". # Australian Central Standard
640	"cast +0930 ". # Central Australian Standard
641	"aest +1000 ". # Australian Eastern Standard
642	"east +1000 ". # Eastern Australian Standard
643	"gst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
644	"chst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
645	"acdt +1030 ". # Australian Central Daylight
646	"cadt +1030 ". # Central Australian Daylight
647	"aedt +1100 ". # Australian Eastern Daylight
648	"eadt +1100 ". # Eastern Australian Daylight
649	"idle +1200 ". # International Date Line East
650	"nzst +1200 ". # New Zealand Standard
651	"nzt +1200 ". # New Zealand
652	"nzdt +1300 ". # New Zealand Daylight
653	"z +0000 ".
654	"a +0100 b +0200 c +0300 d +0400 e +0500 f +0600 g +0700 h +0800 ".
655	"i +0900 k +1000 l +1100 m +1200 ".
656	"n -0100 o -0200 p -0300 q -0400 r -0500 s -0600 t -0700 u -0800 ".
657	"v -0900 w -1000 x -1100 y -1200";
658
659	$Zone{"n2o"} = {};
660	($Zone{"zones"},%{ $Zone{"n2o"} })=
661	&Date_Regexp($zonesrfc,"sort,lc,under,back",
662	"keys");
663
664	$tmp=
665	"US/Pacific PST8PDT ".
666	"US/Mountain MST7MDT ".
667	"US/Central CST6CDT ".
668	"US/Eastern EST5EDT ".
669	"Canada/Pacific PST8PDT ".
670	"Canada/Mountain MST7MDT ".
671	"Canada/Central CST6CDT ".
672	"Canada/Eastern EST5EDT";
673
674	$Zone{"tz2z"} = {};
675	($Zone{"tzones"},%{ $Zone{"tz2z"} })=
676	&Date_Regexp($tmp,"lc,under,back","keys");
677	$Cnf{"TZ"}=&Date_TimeZone;
678
679	# misc. variables
680	# At = "(?:at)"
681	# Of = "(?:in\|of)"
682	# On = "(?:on)"
683	# Future = "(?:in)"
684	# Later = "(?:later)"
685	# Past = "(?:ago)"
686	# Next = "(?:next)"
687	# Prev = "(?:last\|previous)"
688
689	&Date_InitStrings($lang{"at"}, \$Lang{$L}{"At"}, "lc,sort");
690	&Date_InitStrings($lang{"on"}, \$Lang{$L}{"On"}, "lc,sort");
691	&Date_InitStrings($lang{"future"},\$Lang{$L}{"Future"}, "lc,sort");
692	&Date_InitStrings($lang{"later"}, \$Lang{$L}{"Later"}, "lc,sort");
693	&Date_InitStrings($lang{"past"}, \$Lang{$L}{"Past"}, "lc,sort");
694	&Date_InitStrings($lang{"next"}, \$Lang{$L}{"Next"}, "lc,sort");
695	&Date_InitStrings($lang{"prev"}, \$Lang{$L}{"Prev"}, "lc,sort");
696	&Date_InitStrings($lang{"of"}, \$Lang{$L}{"Of"}, "lc,sort");
697
698	# calc mode variables
699	# Approx = "(?:approximately)"
700	# Exact = "(?:exactly)"
701	# Business = "(?:business)"
702
703	&Date_InitStrings($lang{"exact"}, \$Lang{$L}{"Exact"}, "lc,sort");
704	&Date_InitStrings($lang{"approx"}, \$Lang{$L}{"Approx"}, "lc,sort");
705	&Date_InitStrings($lang{"business"},\$Lang{$L}{"Business"},"lc,sort");
706
707	############### END OF LANGUAGE INITIALIZATION
708	}
709
710	if ($Curr{"ResetWorkDay"}) {
711	my($h1,$m1,$h2,$m2)=();
712	if ($Cnf{"WorkDay24Hr"}) {
713	($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
714	($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
715	$Curr{"WDlen"}=24*60;
716	$Cnf{"WorkDayBeg"}="00:00";
717	$Cnf{"WorkDayEnd"}="23:59";
718
719	} else {
720	confess "ERROR: Invalid WorkDayBeg in Date::Manip.\n"
721	if (! (($h1,$m1)=&CheckTime($Cnf{"WorkDayBeg"})));
722	$Cnf{"WorkDayBeg"}="$h1:$m1";
723	confess "ERROR: Invalid WorkDayEnd in Date::Manip.\n"
724	if (! (($h2,$m2)=&CheckTime($Cnf{"WorkDayEnd"})));
725	$Cnf{"WorkDayEnd"}="$h2:$m2";
726
727	($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
728	($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
729
730	# Work day length = h1:m1 or 0:len (len minutes)
731	$h1=$h2-$h1;
732	$m1=$m2-$m1;
733	if ($m1<0) {
734	$h1--;
735	$m1+=60;
736	}
737	$Curr{"WDlen"}=$h1*60+$m1;
738	}
739	$Curr{"ResetWorkDay"}=0;
740	}
741
742	# current time
743	my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
744	if ($Cnf{"ForceDate"}=~
745	/^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
746	($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
747	} else {
748	($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
749	$y+=1900;
750	$m++;
751	}
752	&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
753	$Curr{"Y"}=$y;
754	$Curr{"M"}=$m;
755	$Curr{"D"}=$d;
756	$Curr{"H"}=$h;
757	$Curr{"Mn"}=$mn;
758	$Curr{"S"}=$s;
759	$Curr{"AmPm"}=$ampm;
760	$Curr{"Now"}=&Date_Join($y,$m,$d,$h,$mn,$s);
761	if ($Cnf{"TodayIsMidnight"}) {
762	$Curr{"Today"}=&Date_Join($y,$m,$d,0,0,0);
763	} else {
764	$Curr{"Today"}=$Curr{"Now"};
765	}
766
767	$Curr{"Debug"}=$Curr{"DebugVal"};
768
769	# If we're in array context, let's return a list of config variables
770	# that could be passed to Date_Init to get the same state as we're
771	# currently in.
772	if (wantarray) {
773	# Some special variables that have to be in a specific order
774	my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
775	my(%tmp)=map { $_,1 } @special;
776	my(@tmp,$key,$val);
777	foreach $key (@special) {
778	$val=$Cnf{$key};
779	push(@tmp,"$key=$val");
780	}
781	foreach $key (keys %Cnf) {
782	next if (exists $tmp{$key});
783	$val=$Cnf{$key};
784	push(@tmp,"$key=$val");
785	}
786	return @tmp;
787	}
788	return ();
789	}
790
791	sub ParseDateString {
792	print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
793	local($_)=@_;
794	return "" if (! $_);
795
796	my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
797	my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
798
799	# We only need to reinitialize if we have to determine what NOW is.
800	&Date_Init() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
801
802	my($L)=$Cnf{"Language"};
803	my($type)=$Cnf{"DateFormat"};
804
805	# Mode is set in DateCalc. ParseDate only overrides it if the string
806	# contains a mode.
807	if ($Lang{$L}{"Exact"} &&
808	s/$Lang{$L}{"Exact"}//) {
809	$Curr{"Mode"}=0;
810	} elsif ($Lang{$L}{"Approx"} &&
811	s/$Lang{$L}{"Approx"}//) {
812	$Curr{"Mode"}=1;
813	} elsif ($Lang{$L}{"Business"} &&
814	s/$Lang{$L}{"Business"}//) {
815	$Curr{"Mode"}=2;
816	} elsif (! exists $Curr{"Mode"}) {
817	$Curr{"Mode"}=0;
818	}
819
820	# Unfortunately, some deltas can be parsed as dates. An example is
821	# 1 second == 1 2nd == 1 2
822	# But, some dates can be parsed as deltas. The most important being:
823	# 1998010101:00:00
824	#
825	# We'll check to see if a "date" can be parsed as a delta. If so, we'll
826	# assume that it is a delta (since they are much simpler, it is much
827	# less likely that we'll mistake a delta for a date than vice versa)
828	# unless it is an ISO-8601 date.
829	#
830	# This is important because we are using DateCalc to test whether a
831	# string is a date or a delta. Dates are tested first, so we need to
832	# be able to pass a delta into this routine and have it correctly NOT
833	# interpreted as a date.
834	#
835	# We will insist that the string contain something other than digits and
836	# colons so that the following will get correctly interpreted as a date
837	# rather than a delta:
838	# 12:30
839	# 19980101
840
841	$delta="";
842	$delta=&ParseDateDelta($_) if (/[^:0-9]/);
843
844	# Put parse in a simple loop for an easy exit.
845	PARSE: {
846	my(@tmp)=&Date_Split($_);
847	if (@tmp) {
848	($y,$m,$d,$h,$mn,$s)=@tmp;
849	last PARSE;
850	}
851
852	# Fundamental regular expressions
853
854	my($month)=$Lang{$L}{"Month"}; # (jan\|january\|...)
855	my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
856	my($week)=$Lang{$L}{"Week"}; # (mon\|monday\|...)
857	my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
858	my($wom)=$Lang{$L}{"WoM"}; # (1st\|...\|fifth\|last)
859	my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
860	my($dom)=$Lang{$L}{"DoM"}; # (1st\|first\|...31st)
861	my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
862	my($ampmexp)=$Lang{$L}{"AmPm"}; # (am\|pm)
863	my($timeexp)=$Lang{$L}{"Times"}; # (noon\|midnight)
864	my($now)=$Lang{$L}{"Now"}; # now
865	my($today)=$Lang{$L}{"Today"}; # today
866	my($offset)=$Lang{$L}{"Offset"}; # (yesterday\|tomorrow)
867	my($zone)=$Zone{"zones"}; # (edt\|est\|...)
868	my($day)='\s'.$Lang{$L}{"Dabb"}; # \s(?:d\|day\|days)
869	my($mabb)='\s'.$Lang{$L}{"Mabb"}; # \s(?:mon\|month\|months)
870	my($wkabb)='\s'.$Lang{$L}{"Wabb"}; # \s(?:w\|wk\|week\|weeks)
871	my($next)='\s'.$Lang{$L}{"Next"}; # \s(?:next)
872	my($prev)='\s'.$Lang{$L}{"Prev"}; # \s(?:last\|previous)
873	my($past)='\s'.$Lang{$L}{"Past"}; # \s(?:ago)
874	my($future)='\s'.$Lang{$L}{"Future"}; # \s(?:in)
875	my($later)='\s'.$Lang{$L}{"Later"}; # \s(?:later)
876	my($at)=$Lang{$L}{"At"}; # (?:at)
877	my($of)='\s'.$Lang{$L}{"Of"}; # \s(?:in\|of)
878	my($on)='(?:\s'.$Lang{$L}{"On"}.'\s\|\s+)';
879	# \s(?:on)\s or \s+
880	my($last)='\s'.$Lang{$L}{"Last"}; # \s(?:last)
881	my($hm)=$Lang{$L}{"SepHM"}; # :
882	my($ms)=$Lang{$L}{"SepMS"}; # :
883	my($ss)=$Lang{$L}{"SepSS"}; # .
884
885	# Other regular expressions
886
887	my($D4)='(\d{4})'; # 4 digits (yr)
888	my($YY)='(\d{4}\|\d{2})'; # 2 or 4 digits (yr)
889	my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
890	my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
891	my($FS)="(?:$ss\\d+)?"; # fractional secs
892	my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
893	# absolute time zone +0700 (GMT)
894	my($hzone)='(?:[0-1][0-9]\|2[0-3])'; # 00 - 23
895	my($mzone)='(?:[0-5][0-9])'; # 00 - 59
896	my($zone2)='(?:\s*([+-](?:'."$hzone$mzone\|$hzone:$mzone\|$hzone))".
897	# +0700 +07:00 -07
898	'(?:\s*$[^)]+$)?)'; # (GMT)
899
900	# A regular expression for the time EXCEPT for the hour part
901	my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
902
903	# A special regular expression for /YYYY:HH:MN:SS used by Apache
904	my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
905
906	my($time)="";
907	$ampm="";
908	$date="";
909
910	# Substitute all special time expressions.
911	if (/(^\|[^a-z])$timeexp($\|[^a-z])/i) {
912	$tmp=$2;
913	$tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
914	s/(^\|[^a-z])$timeexp($\|[^a-z])/$1 $tmp $3/i;
915	}
916
917	# Remove some punctuation
918	s/[,]/ /g;
919
920	# When we have a digit followed immediately by a timezone (7EST), we
921	# will put a space between the digit, EXCEPT in the case of a single
922	# character military timezone. If the single character is followed
923	# by anything, no space is added.
924	$tmp = "";
925	while ( s/^(.*?\d)$zone(\s\|$\|[0-9])/$3/i ) {
926	my($bef,$z,$aft) = ($1,$2,$3);
927	if (length($z) != 1 \|\| length($aft) == 0) {
928	$tmp .= "$bef $z";
929	} else {
930	$tmp .= "$bef$z";
931	}
932	}
933	$_ = "$tmp$_";
934	$zone = '\s+' . $zone . '(?:\s+\|$)';
935
936	# Remove the time
937	$iso=1;
938	$midnight=0;
939	$from="24${hm}00(?:${ms}00)?";
940	$falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
941	$to="00${hm}00${ms}00";
942	$midnight=1 if (!/$falsefrom/ && s/$from/$to/);
943
944	$h=$mn=$s=0;
945	if (/$D$mnsec/i \|\| /$ampmexp/i) {
946	$iso=0;
947	$tmp=0;
948	$tmp=1 if (/$mnsec$zone2?\s$/i or /$mnsec$zone\s$/i);
949	$tmp=0 if (/$ampmexp/i);
950	if (s/$apachetime$zone()/$1 /i \|\|
951	s/$apachetime$zone2?/$1 /i \|\|
952	s/(^\|[^a-z])$at\s*$D$mnsec$zone()/$1 /i \|\|
953	s/(^\|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i \|\|
954	s/(^\|[^0-9])(\d)$mnsec$zone()/$1 /i \|\|
955	s/(^\|[^0-9])(\d)$mnsec$zone2?/$1 /i \|\|
956	(s/(t)$D$mnsec$zone()/$1 /i and (($iso=$tmp) \|\| 1)) \|\|
957	(s/(t)$D$mnsec$zone2?/$1 /i and (($iso=$tmp) \|\| 1)) \|\|
958	(s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) \|\| 1)) \|\|
959	(s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) \|\| 1)) \|\|
960	s/(^\|$at\s\|\s+)$D()()\s$ampmexp$zone()/ /i \|\|
961	s/(^\|$at\s\|\s+)$D()()\s$ampmexp$zone2?/ /i \|\|
962	0
963	) {
964	($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
965	if (defined ($z)) {
966	if ($z =~ /^[+-]\d{2}:\d{2}$/) {
967	$z=~ s/://;
968	} elsif ($z =~ /^[+-]\d{2}$/) {
969	$z .= "00";
970	}
971	}
972	$time=1;
973	&Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
974	$y=$m=$d="";
975	# We're going to be calling TimeCheck again below (when we check the
976	# final date), so get rid of $ampm so that we don't have an error
977	# due to "15:30:00 PM". It'll get reset below.
978	$ampm="";
979	if (/^\s*$/) {
980	&Date_Init() if (! $Cnf{"UpdateCurrTZ"});
981	last PARSE;
982	}
983	}
984	}
985	$time=0 if ($time ne "1");
986	s/\s+$//;
987	s/^\s+//;
988
989	# if a zone was found, get rid of the regexps
990	if ($z) {
991	$zone="";
992	$zone2="";
993	}
994
995	# dateTtime ISO 8601 formats
996	my($orig)=$_;
997
998	# Parse ISO 8601 dates now (which may still have a zone stuck to it).
999	if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) \|\|
1000	($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) \|\|
1001	($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) \|\|
1002	($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) \|\|
1003	($iso && /^([0-9-]+T)$zone?$/i) \|\|
1004	($iso && /^([0-9-]+T)$zone2?$/i) \|\|
1005	0) {
1006
1007	# If we already got a timezone, don't get another one.
1008	my(@z);
1009	if ($z) {
1010	@z=($z,$z2);
1011	$z="";
1012	}
1013	($_,$z,$z2) = ($1,$2,$3);
1014	($z,$z2)=@z if (@z);
1015
1016	s,([0-9])\s*-,$1 ,g; # Change all ISO8601 seps to spaces
1017	s/^\s+//;
1018	s/\s+$//;
1019
1020	if (/^$D4\s$DD\s$DD\st?$DD(?:$DD(?:$DD(\d))?)?$/i \|\|
1021	/^$DD\s+$DD\s$DD\st?$DD(?:$DD(?:$DD(\d*))?)?$/i \|\|
1022	0
1023	) {
1024	# ISO 8601 Dates with times
1025	# YYYYMMDDtHHMNSSFFFF...
1026	# YYYYMMDDtHHMNSS
1027	# YYYYMMDDtHHMN
1028	# YYYYMMDDtHH
1029	# YY MMDDtHHMNSSFFFF...
1030	# YY MMDDtHHMNSS
1031	# YY MMDDtHHMN
1032	# YY MMDDtHH
1033	# The t is an optional letter "t".
1034	($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
1035	if ($h==24 && (! defined $mn \|\| $mn==0) && (! defined $s \|\| $s==0)) {
1036	$h=0;
1037	$midnight=1;
1038	}
1039	$z = "" if (! defined $h);
1040	return "" if ($time && defined $h);
1041	last PARSE;
1042
1043	} elsif (/^$D4(?:\s$DD(?:\s$DD)?)?$/ \|\|
1044	/^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
1045	# ISO 8601 Dates
1046	# YYYYMMDD
1047	# YYYYMM
1048	# YYYY
1049	# YY MMDD
1050	# YY MM
1051	# YY
1052	($y,$m,$d)=($1,$2,$3);
1053	last PARSE;
1054
1055	} elsif (/^$YY\s+$D\s+$D/) {
1056	# YY-M-D
1057	($y,$m,$d)=($1,$2,$3);
1058	last PARSE;
1059
1060	} elsif (/^$YY\sW$DD\s(\d)?$/i) {
1061	# YY-W##-D
1062	($y,$wofm,$dofw)=($1,$2,$3);
1063	($y,$m,$d)=&Date_NthWeekOfYear($y,$wofm,$dofw);
1064	last PARSE;
1065
1066	} elsif (/^$D4\s*(\d{3})$/

Software Freedom Law Center

Loblaw

root/trunk/antimatter/tim/Modules/Date/Manip.pm