# Copyright (c) 1995-2003 Sullivan Beck. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
###########################################################################
###########################################################################
use vars
qw($OS %Lang %Holiday %Events %Curr %Cnf %Zone $VERSION @ISA @EXPORT);
# Determine the type of OS...
$OS="Windows" if ((defined $^O and
$ENV{OS} =~ /MSWin32/i ||
$ENV{OS} =~ /Windows_95/i ||
$ENV{OS} =~ /Windows_NT/i));
$OS="Netware" if (defined $^O and
$OS="Mac" if ((defined $^O and
$OS="MPE" if (defined $^O and
$OS="OS2" if (defined $^O and
$OS="VMS" if (defined $^O and
# Determine if we're doing taint checking
$Date::Manip::NoTaint = eval { local $^W; unlink "$^X$^T"; 1 };
###########################################################################
###########################################################################
# See the section of the POD documentation section CUSTOMIZING DATE::MANIP
# below for a complete description of each of these variables.
# Location of a the global config file. Tilde (~) expansions are allowed.
# This should be set in Date_Init arguments.
$Cnf{"IgnoreGlobalCnf"}="";
# Name of a personal config file and the path to search for it. Tilde (~)
# expansions are allowed. This should be set in Date_Init arguments or in
# the global config file.
@Date::Manip::DatePath=();
$Cnf{"PersonalCnf"} = "Manip.cnf";
$Cnf{"PersonalCnfPath"} = ".";
} elsif ($OS eq "Netware") {
$Cnf{"PersonalCnf"} = "Manip.cnf";
$Cnf{"PersonalCnfPath"} = ".";
$Cnf{"PersonalCnf"} = "Manip.cnf";
$Cnf{"PersonalCnfPath"} = ".";
$Cnf{"PersonalCnf"} = "Manip.cnf";
$Cnf{"PersonalCnfPath"} = ".";
$Cnf{"PersonalCnf"} = "Manip.cnf";
$Cnf{"PersonalCnfPath"} = ".";
# VMS doesn't like files starting with "."
$Cnf{"PersonalCnf"} = "Manip.cnf";
$Cnf{"PersonalCnfPath"} = ".\n~";
$Cnf{"PersonalCnf"} = ".DateManip.cnf";
$Cnf{"PersonalCnfPath"} = ".:~";
@Date::Manip::DatePath=qw(/bin /usr/bin /usr/local/bin);
### Date::Manip variables set in the global or personal config file
# Which language to use when parsing dates.
$Cnf{"Language"}="English";
# 12/10 = Dec 10 (US) or Oct 12 (anything else)
# Timezone to work in (""=local, "IGNORE", or a timezone)
# Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
# First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
# First and last day of the work week (1=monday, 7=sunday)
# If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
# Start and end time of the work day (any time format allowed, seconds
$Cnf{"WorkDayBeg"}="08:00";
$Cnf{"WorkDayEnd"}="17:00";
# If "today" is a holiday, we look either to "tomorrow" or "yesterday" for
# the nearest business day. By default, we'll always look "tomorrow"
$Cnf{"EraseHolidays"}="";
# Set this to non-zero to be produce completely backwards compatible deltas
# If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
# make week 1 contain Jan 1.
# 2 digit years fall into the 100 year period given by [ CURR-N,
# CURR+(99-N) ] where N is 0-99. Default behavior is 89, but other useful
# numbers might be 0 (forced to be this year or later) and 99 (forced to be
# this year or earlier). It can also be set to "c" (current century) or
# "cNN" (i.e. c18 forces the year to bet 1800-1899). Also accepts the
# form cNNNN to give the 100 year period NNNN to NNNN+99.
# Set this to 1 if you want a long-running script to always update the
# timezone. This will slow Date::Manip down. Read the POD documentation.
# Use an international character set.
# Use this to force the current date to be set to this:
###########################################################################
########################################################################
########################################################################
$Curr{"InitLang"} = 1; # Whether a language is being init'ed
$Curr{"InitDone"} = 0; # Whether Init_Date has been called
$Curr{"InitFilesRead"} = 0;
$Curr{"ResetWorkDay"} = 1;
########################################################################
########################################################################
# THESE ARE THE MAIN ROUTINES
########################################################################
########################################################################
# Get rid of a problem with old versions of perl
# This sorts from longest to shortest element
return (length $b <=> length $a);
print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
my($internal,$firstday)=();
my($var,$val,$file,@tmp)=();
# InitFilesRead = 0 : no conf files read yet
# 1 : global read, no personal read
/^(\S+) \s* = \s* (.+)$/x;
if ($var =~ /^GlobalCnf$/i) {
$Curr{"InitFilesRead"}=0;
} elsif ($var =~ /^PathSep$/i) {
} elsif ($var =~ /^PersonalCnf$/i) {
$Cnf{"PersonalCnf"}=$val;
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
} elsif ($var =~ /^PersonalCnfPath$/i) {
$Cnf{"PersonalCnfPath"}=$val;
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==2);
} elsif ($var =~ /^IgnoreGlobalCnf$/i) {
$Curr{"InitFilesRead"}=1 if ($Curr{"InitFilesRead"}==0);
$Cnf{"IgnoreGlobalCnf"}=1;
} elsif ($var =~ /^EraseHolidays$/i) {
# Read global config file
if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
$Curr{"InitFilesRead"}=1;
$file=&ExpandTilde
($Cnf{"GlobalCnf"});
&Date_InitFile
($file) if ($file);
# Read personal config file
if ($Curr{"InitFilesRead"}<2) {
$Curr{"InitFilesRead"}=2;
if ($Cnf{"PersonalCnf"} and $Cnf{"PersonalCnfPath"}) {
$file=&SearchPath
($Cnf{"PersonalCnf"},$Cnf{"PersonalCnfPath"},"r");
&Date_InitFile
($file) if ($file);
/^(\S+) \s* = \s* (.*)$/x;
$val="" if (! defined $val);
&Date_SetConfigVariable
($var,$val);
confess
"ERROR: Unknown FirstDay in Date::Manip.\n"
if (! &IsInt
($Cnf{"FirstDay"},1,7));
confess
"ERROR: Unknown WorkWeekBeg in Date::Manip.\n"
if (! &IsInt
($Cnf{"WorkWeekBeg"},1,7));
confess
"ERROR: Unknown WorkWeekEnd in Date::Manip.\n"
if (! &IsInt
($Cnf{"WorkWeekEnd"},1,7));
confess
"ERROR: Invalid WorkWeek in Date::Manip.\n"
if ($Cnf{"WorkWeekEnd"} <= $Cnf{"WorkWeekBeg"});
&Date_Init_English
(\
%lang);
} elsif ($L eq "French") {
&Date_Init_French
(\
%lang);
} elsif ($L eq "Swedish") {
&Date_Init_Swedish
(\
%lang);
} elsif ($L eq "German") {
&Date_Init_German
(\
%lang);
} elsif ($L eq "Polish") {
&Date_Init_Polish
(\
%lang);
} elsif ($L eq "Dutch" ||
&Date_Init_Dutch
(\
%lang);
} elsif ($L eq "Spanish") {
&Date_Init_Spanish
(\
%lang);
} elsif ($L eq "Portuguese") {
&Date_Init_Portuguese
(\
%lang);
} elsif ($L eq "Romanian") {
&Date_Init_Romanian
(\
%lang);
} elsif ($L eq "Italian") {
&Date_Init_Italian
(\
%lang);
} elsif ($L eq "Russian") {
&Date_Init_Russian
(\
%lang);
} elsif ($L eq "Turkish") {
&Date_Init_Turkish
(\
%lang);
} elsif ($L eq "Danish") {
&Date_Init_Danish
(\
%lang);
confess
"ERROR: Unknown language in Date::Manip.\n";
# Month = "(jan|january|feb|february ... )"
# MonL = [ "Jan","Feb",... ]
# MonthL = [ "January","February", ... ]
# MonthH = { "january"=>1, "jan"=>1, ... }
&Date_InitLists
([$lang{"month_name"},
\
$Lang{$L}{"Month"},"lc,sort,back",
[$Lang{$L}{"MonthH"},1]);
# variables for day of week
# Week = "(mon|monday|tue|tuesday ... )"
# WkL = [ "Mon","Tue",... ]
# WeekL = [ "Monday","Tudesday",... ]
# WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
&Date_InitLists
([$lang{"day_name"},
\
$Lang{$L}{"Week"},"lc,sort,back",
&Date_InitLists
([$lang{"day_char"}],
%{ $Lang{$L}{"WeekH"} } =
(%{ $Lang{$L}{"WeekH"} },%tmp);
# variables for day of month
# DoM = "(1st|first ... 31st)"
# DoML = [ "1st","2nd",... "31st" ]
# DoMH = { "1st"=>1,"first"=>1, ... "31st"=>31 }
# variables for week of month
# WoM = "(1st|first| ... 5th|last)"
# WoMH = { "1st"=>1, ... "5th"=>5,"last"=>-1 }
$Lang{$L}{"LastL"}=$lang{"last"};
&Date_InitStrings
($lang{"last"},
\
$Lang{$L}{"Last"},"lc,sort");
$Lang{$L}{"EachL"}=$lang{"each"};
&Date_InitStrings
($lang{"each"},
\
$Lang{$L}{"Each"},"lc,sort");
&Date_InitLists
([$lang{"num_suff"},
\
$Lang{$L}{"DoM"},"lc,sort,back,escape",
foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
$tmp2=$Lang{$L}{"DoMH"}{$tmp};
$Lang{$L}{"WoMH"}{$tmp} = $tmp2;
foreach $tmp (@
{ $Lang{$L}{"LastL"} }) {
$Lang{$L}{"WoMH"}{$tmp} = -1;
&Date_InitStrings
(\
@tmp,\
$Lang{$L}{"WoM"},
&Date_InitStrings
($lang{"am"},\
$Lang{$L}{"AM"},"lc,sort,escape");
&Date_InitStrings
($lang{"pm"},\
$Lang{$L}{"PM"},"lc,sort,escape");
&Date_InitStrings
([ @
{$lang{"am"}},@
{$lang{"pm"}} ],\
$Lang{$L}{"AmPm"},
$Lang{$L}{"AMstr"}=$lang{"am"}[0];
$Lang{$L}{"PMstr"}=$lang{"pm"}[0];
# variables for expressions used in parsing deltas
# Yabb = "(?:y|yr|year|years)"
# Mabb = similar for months
# Wabb = similar for weeks
# Dabb = similar for days
# Habb = similar for hours
# MNabb = similar for minutes
# Sabb = similar for seconds
# Repl = { "abb"=>"replacement" }
# Whenever an abbreviation could potentially refer to two different
# strings (M standing for Minutes or Months), the abbreviation must
# be listed in Repl instead of in the appropriate Xabb values. This
# only applies to abbreviations which are substrings of other values
# (so there is no confusion between Mn and Month).
&Date_InitStrings
($lang{"years"} ,\
$Lang{$L}{"Yabb"}, "lc,sort");
&Date_InitStrings
($lang{"months"} ,\
$Lang{$L}{"Mabb"}, "lc,sort");
&Date_InitStrings
($lang{"weeks"} ,\
$Lang{$L}{"Wabb"}, "lc,sort");
&Date_InitStrings
($lang{"days"} ,\
$Lang{$L}{"Dabb"}, "lc,sort");
&Date_InitStrings
($lang{"hours"} ,\
$Lang{$L}{"Habb"}, "lc,sort");
&Date_InitStrings
($lang{"minutes"},\
$Lang{$L}{"MNabb"},"lc,sort");
&Date_InitStrings
($lang{"seconds"},\
$Lang{$L}{"Sabb"}, "lc,sort");
&Date_InitHash
($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
# variables for special dates that are offsets from now
# Offset = "(yesterday|tomorrow)"
# OffsetH = { "yesterday"=>"-0:0:0:1:0:0:0",... ]
# Times = "(noon|midnight)"
# TimesH = { "noon"=>"12:00:00","midnight"=>"00:00:00" }
# SepHM = hour/minute separator
# SepMS = minute/second separator
# SepSS = second/fraction separator
&Date_InitHash
($lang{"times"},
\
$Lang{$L}{"Times"},"lc,sort,back",
&Date_InitStrings
($lang{"now"},\
$Lang{$L}{"Now"},"lc,sort");
&Date_InitHash
($lang{"offset"},
\
$Lang{$L}{"Offset"},"lc,sort,back",
$Lang{$L}{"SepHM"}=$lang{"sephm"};
$Lang{$L}{"SepMS"}=$lang{"sepms"};
$Lang{$L}{"SepSS"}=$lang{"sepss"};
# variables for time zones
# zones = regular expression with all zone names (EST)
# n2o = a hash of all parsable zone names with their offsets
# tzones = reguar expression with all tzdata timezones (US/Eastern)
# tz2z = hash of all tzdata timezones to full timezone (EST#EDT)
"idlw -1200 ". # International Date Line West
"hst -1000 ". # Hawaii Standard
"cat -1000 ". # Central Alaska
"ahst -1000 ". # Alaska-Hawaii Standard
"akst -0900 ". # Alaska Standard
"yst -0900 ". # Yukon Standard
"hdt -0900 ". # Hawaii Daylight
"akdt -0800 ". # Alaska Daylight
"ydt -0800 ". # Yukon Daylight
"pst -0800 ". # Pacific Standard
"pdt -0700 ". # Pacific Daylight
"mst -0700 ". # Mountain Standard
"mdt -0600 ". # Mountain Daylight
"cst -0600 ". # Central Standard
"cdt -0500 ". # Central Daylight
"est -0500 ". # Eastern Standard
"act -0500 ". # Brazil, Acre
"amt -0400 ". # Brazil, Amazon
"acst -0400 ". # Brazil, Acre Daylight
"edt -0400 ". # Eastern Daylight
"ast -0400 ". # Atlantic Standard
#"nst -0330 ". # Newfoundland Standard nst=North Sumatra +0630
"nft -0330 ". # Newfoundland
#"gst -0300 ". # Greenland Standard gst=Guam Standard +1000
#"bst -0300 ". # Brazil Standard bst=British Summer +0100
"brt -0300 ". # Brazil Standard (official time)
"brst -0300 ". # Brazil Standard
"adt -0300 ". # Atlantic Daylight
"art -0300 ". # Argentina
"amst -0300 ". # Brazil, Amazon Daylight
"ndt -0230 ". # Newfoundland Daylight
"brst -0200 ". # Brazil Daylight (official time)
"fnt -0200 ". # Brazil, Fernando de Noronha
"wat -0100 ". # West Africa
"fnst -0100 ". # Brazil, Fernando de Noronha Daylight
"gmt +0000 ". # Greenwich Mean
"utc +0000 ". # Universal (Coordinated)
"wet +0000 ". # Western European
"cet +0100 ". # Central European
"fwt +0100 ". # French Winter
"met +0100 ". # Middle European
"mez +0100 ". # Middle European
"mewt +0100 ". # Middle European Winter
"swt +0100 ". # Swedish Winter
"bst +0100 ". # British Summer bst=Brazil standard -0300
"gb +0100 ". # GMT with daylight savings
"west +0000 ". # Western European Daylight
"eet +0200 ". # Eastern Europe, USSR Zone 1
"cest +0200 ". # Central European Summer
"fst +0200 ". # French Summer
"ist +0200 ". # Israel standard
"mest +0200 ". # Middle European Summer
"mesz +0200 ". # Middle European Summer
"metdst +0200 ". # An alias for mest used by HP-UX
"sast +0200 ". # South African Standard
"sst +0200 ". # Swedish Summer sst=South Sumatra +0700
"bt +0300 ". # Baghdad, USSR Zone 2
"eest +0300 ". # Eastern Europe Summer
"eetedt +0300 ". # Eastern Europe, USSR Zone 1
"idt +0300 ". # Israel Daylight
"eat +0300 ". # East Africa
"zp4 +0400 ". # USSR Zone 3
"msd +0400 ". # Moscow Daylight
"zp5 +0500 ". # USSR Zone 4
"ist +0530 ". # Indian Standard
"zp6 +0600 ". # USSR Zone 5
"novst +0600 ". # Novosibirsk time zone, Russia
"nst +0630 ". # North Sumatra nst=Newfoundland Std -0330
#"sst +0700 ". # South Sumatra, USSR Zone 6 sst=Swedish Summer +0200
"hkt +0800 ". # Hong Kong
"sgt +0800 ". # Singapore
"cct +0800 ". # China Coast, USSR Zone 7
"awst +0800 ". # Australian Western Standard
"wst +0800 ". # West Australian Standard
"pht +0800 ". # Asia Manila
"kst +0900 ". # Republic of Korea
"jst +0900 ". # Japan Standard, USSR Zone 8
"rok +0900 ". # Republic of Korea
"acst +0930 ". # Australian Central Standard
"cast +0930 ". # Central Australian Standard
"aest +1000 ". # Australian Eastern Standard
"east +1000 ". # Eastern Australian Standard
"gst +1000 ". # Guam Standard, USSR Zone 9 gst=Greenland Std -0300
"acdt +1030 ". # Australian Central Daylight
"cadt +1030 ". # Central Australian Daylight
"aedt +1100 ". # Australian Eastern Daylight
"eadt +1100 ". # Eastern Australian Daylight
"idle +1200 ". # International Date Line East
"nzst +1200 ". # New Zealand Standard
"nzt +1200 ". # New Zealand
"nzdt +1300 ". # New Zealand Daylight
"a +0100 b +0200 c +0300 d +0400 e +0500 f +0600 g +0700 h +0800 ".
"i +0900 k +1000 l +1100 m +1200 ".
"n -0100 o -0200 p -0300 q -0400 r -0500 s -0600 t -0700 u -0800 ".
"v -0900 w -1000 x -1100 y -1200";
($Zone{"zones"},%{ $Zone{"n2o"} })=
&Date_Regexp
($zonesrfc,"sort,lc,under,back",
"Canada/Pacific PST8PDT ".
"Canada/Mountain MST7MDT ".
"Canada/Central CST6CDT ".
"Canada/Eastern EST5EDT";
($Zone{"tzones"},%{ $Zone{"tz2z"} })=
&Date_Regexp
($tmp,"lc,under,back","keys");
$Cnf{"TZ"}=&Date_TimeZone
;
# Prev = "(?:last|previous)"
&Date_InitStrings
($lang{"at"}, \
$Lang{$L}{"At"}, "lc,sort");
&Date_InitStrings
($lang{"on"}, \
$Lang{$L}{"On"}, "lc,sort");
&Date_InitStrings
($lang{"future"},\
$Lang{$L}{"Future"}, "lc,sort");
&Date_InitStrings
($lang{"later"}, \
$Lang{$L}{"Later"}, "lc,sort");
&Date_InitStrings
($lang{"past"}, \
$Lang{$L}{"Past"}, "lc,sort");
&Date_InitStrings
($lang{"next"}, \
$Lang{$L}{"Next"}, "lc,sort");
&Date_InitStrings
($lang{"prev"}, \
$Lang{$L}{"Prev"}, "lc,sort");
&Date_InitStrings
($lang{"of"}, \
$Lang{$L}{"Of"}, "lc,sort");
# Approx = "(?:approximately)"
# Business = "(?:business)"
&Date_InitStrings
($lang{"exact"}, \
$Lang{$L}{"Exact"}, "lc,sort");
&Date_InitStrings
($lang{"approx"}, \
$Lang{$L}{"Approx"}, "lc,sort");
&Date_InitStrings
($lang{"business"},\
$Lang{$L}{"Business"},"lc,sort");
############### END OF LANGUAGE INITIALIZATION
if ($Curr{"ResetWorkDay"}) {
if ($Cnf{"WorkDay24Hr"}) {
($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
$Cnf{"WorkDayBeg"}="00:00";
$Cnf{"WorkDayEnd"}="23:59";
confess
"ERROR: Invalid WorkDayBeg in Date::Manip.\n"
if (! (($h1,$m1)=&CheckTime
($Cnf{"WorkDayBeg"})));
$Cnf{"WorkDayBeg"}="$h1:$m1";
confess
"ERROR: Invalid WorkDayEnd in Date::Manip.\n"
if (! (($h2,$m2)=&CheckTime
($Cnf{"WorkDayEnd"})));
$Cnf{"WorkDayEnd"}="$h2:$m2";
($Curr{"WDBh"},$Curr{"WDBm"})=($h1,$m1);
($Curr{"WDEh"},$Curr{"WDEm"})=($h2,$m2);
# Work day length = h1:m1 or 0:len (len minutes)
$Curr{"WDlen"}=$h1*60+$m1;
my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
/^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
&Date_DateCheck
(\
$y,\
$m,\
$d,\
$h,\
$mn,\
$s,\
$ampm,\
$wk);
$Curr{"Now"}=&Date_Join
($y,$m,$d,$h,$mn,$s);
$Curr{"Debug"}=$Curr{"DebugVal"};
# If we're in array context, let's return a list of config variables
# that could be passed to Date_Init to get the same state as we're
# Some special variables that have to be in a specific order
my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
my(%tmp)=map { $_,1 } @special;
foreach $key (@special) {
foreach $key (keys %Cnf) {
next if (exists $tmp{$key});
print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
my($y,$m,$d,$h,$mn,$s,$i,$wofm,$dofw,$wk,$tmp,$z,$num,$err,$iso,$ampm)=();
my($date,$z2,$delta,$from,$falsefrom,$to,$which,$midnight)=();
# We only need to reinitialize if we have to determine what NOW is.
&Date_Init
() if (! $Curr{"InitDone"} or $Cnf{"UpdateCurrTZ"});
my($type)=$Cnf{"DateFormat"};
# Mode is set in DateCalc. ParseDate only overrides it if the string
if ($Lang{$L}{"Exact"} &&
s/$Lang{$L}{"Exact"}//) {
} elsif ($Lang{$L}{"Approx"} &&
s/$Lang{$L}{"Approx"}//) {
} elsif ($Lang{$L}{"Business"} &&
s/$Lang{$L}{"Business"}//) {
} elsif (! exists $Curr{"Mode"}) {
# Unfortunately, some deltas can be parsed as dates. An example is
# 1 second == 1 2nd == 1 2
# But, some dates can be parsed as deltas. The most important being:
# We'll check to see if a "date" can be parsed as a delta. If so, we'll
# assume that it is a delta (since they are much simpler, it is much
# less likely that we'll mistake a delta for a date than vice versa)
# unless it is an ISO-8601 date.
# This is important because we are using DateCalc to test whether a
# string is a date or a delta. Dates are tested first, so we need to
# be able to pass a delta into this routine and have it correctly NOT
# We will insist that the string contain something other than digits and
# colons so that the following will get correctly interpreted as a date
$delta=&ParseDateDelta
($_) if (/[^:0-9]/);
# Put parse in a simple loop for an easy exit.
my(@tmp)=&Date_Split
($_);
($y,$m,$d,$h,$mn,$s)=@tmp;
# Fundamental regular expressions
my($month)=$Lang{$L}{"Month"}; # (jan|january|...)
my(%month)=%{ $Lang{$L}{"MonthH"} }; # { jan=>1, ... }
my($week)=$Lang{$L}{"Week"}; # (mon|monday|...)
my(%week)=%{ $Lang{$L}{"WeekH"} }; # { mon=>1, monday=>1, ... }
my($wom)=$Lang{$L}{"WoM"}; # (1st|...|fifth|last)
my(%wom)=%{ $Lang{$L}{"WoMH"} }; # { 1st=>1,... fifth=>5,last=>-1 }
my($dom)=$Lang{$L}{"DoM"}; # (1st|first|...31st)
my(%dom)=%{ $Lang{$L}{"DoMH"} }; # { 1st=>1, first=>1, ... }
my($ampmexp)=$Lang{$L}{"AmPm"}; # (am|pm)
my($timeexp)=$Lang{$L}{"Times"}; # (noon|midnight)
my($now)=$Lang{$L}{"Now"}; # (now|today)
my($offset)=$Lang{$L}{"Offset"}; # (yesterday|tomorrow)
my($zone)=$Zone{"zones"} . '(?:\s+|$)'; # (edt|est|...)\s+
my($day)='\s*'.$Lang{$L}{"Dabb"}; # \s*(?:d|day|days)
my($mabb)='\s*'.$Lang{$L}{"Mabb"}; # \s*(?:mon|month|months)
my($wkabb)='\s*'.$Lang{$L}{"Wabb"}; # \s*(?:w|wk|week|weeks)
my($next)='\s*'.$Lang{$L}{"Next"}; # \s*(?:next)
my($prev)='\s*'.$Lang{$L}{"Prev"}; # \s*(?:last|previous)
my($past)='\s*'.$Lang{$L}{"Past"}; # \s*(?:ago)
my($future)='\s*'.$Lang{$L}{"Future"}; # \s*(?:in)
my($later)='\s*'.$Lang{$L}{"Later"}; # \s*(?:later)
my($at)=$Lang{$L}{"At"}; # (?:at)
my($of)='\s*'.$Lang{$L}{"Of"}; # \s*(?:in|of)
my($on)='(?:\s*'.$Lang{$L}{"On"}.'\s*|\s+)';
my($last)='\s*'.$Lang{$L}{"Last"}; # \s*(?:last)
my($hm)=$Lang{$L}{"SepHM"}; # :
my($ms)=$Lang{$L}{"SepMS"}; # :
my($ss)=$Lang{$L}{"SepSS"}; # .
# Other regular expressions
my($D4)='(\d{4})'; # 4 digits (yr)
my($YY)='(\d{4}|\d{2})'; # 2 or 4 digits (yr)
my($DD)='(\d{2})'; # 2 digits (mon/day/hr/min/sec)
my($D) ='(\d{1,2})'; # 1 or 2 digit (mon/day/hr)
my($FS)="(?:$ss\\d+)?"; # fractional secs
my($sep)='[\/.-]'; # non-ISO8601 m/d/yy separators
# absolute time zone +0700 (GMT)
my($hzone)='(?:[0-1][0-9]|2[0-3])'; # 00 - 23
my($mzone)='(?:[0-5][0-9])'; # 00 - 59
my($zone2)='(?:\s*([+-](?:'."$hzone$mzone|$hzone:$mzone|$hzone))".
'(?:\s*\([^)]+\))?)'; # (GMT)
# A regular expression for the time EXCEPT for the hour part
my($mnsec)="$hm$DD(?:$ms$DD$FS)?(?:\\s*$ampmexp)?";
# A special regular expression for /YYYY:HH:MN:SS used by Apache
my($apachetime)='(/\d{4}):' . "$DD$hm$DD$ms$DD";
# Substitute all special time expressions.
if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
$tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
# Remove some punctuation
# Make sure that ...7EST works (i.e. a timezone immediately following
s/(\d)$zone(\s+|$|[0-9])/$1 $2$3/i;
$from="24${hm}00(?:${ms}00)?";
$falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
$midnight=1 if (!/$falsefrom/ && s/$from/$to/);
if (/$D$mnsec/i || /$ampmexp/i) {
$tmp=1 if (/$mnsec$zone2?\s*$/i); # or /$mnsec$zone/ ??
if (s/$apachetime$zone()/$1 /i ||
s/$apachetime$zone2?/$1 /i ||
s/(^|[^a-z])$at\s*$D$mnsec$zone()/$1 /i ||
s/(^|[^a-z])$at\s*$D$mnsec$zone2?/$1 /i ||
s/(^|[^0-9])(\d)$mnsec$zone()/$1 /i ||
s/(^|[^0-9])(\d)$mnsec$zone2?/$1 /i ||
(s/(t)$D$mnsec$zone()/$1 /i and (($iso=-$tmp) || 1)) ||
(s/(t)$D$mnsec$zone2?/$1 /i and (($iso=-$tmp) || 1)) ||
(s/()$DD$mnsec$zone()/ /i and (($iso=$tmp) || 1)) ||
(s/()$DD$mnsec$zone2?/ /i and (($iso=$tmp) || 1)) ||
s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone()/ /i ||
s/(^|$at\s*|\s+)$D()()\s*$ampmexp$zone2?/ /i ||
($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
if ($z =~ /^[+-]\d{2}:\d{2}$/) {
} elsif ($z =~ /^[+-]\d{2}$/) {
&Date_TimeCheck
(\
$h,\
$mn,\
$s,\
$ampm);
# We're going to be calling TimeCheck again below (when we check the
# final date), so get rid of $ampm so that we don't have an error
# due to "15:30:00 PM". It'll get reset below.
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$time=0 if ($time ne "1");
# dateTtime ISO 8601 formats
# Parse ISO 8601 dates now (which may still have a zone stuck to it).
if ( ($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone?$/i) ||
($iso && /^([0-9-]+(?:W[0-9-]+)?)$zone2?$/i) ||
($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone?$/i) ||
($iso && /^([0-9-]+(?:T[0-9-]+)?)$zone2?$/i) ||
s
,-, ,g
; # Change all ISO8601 seps to spaces
if (/^$D4\s*$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
/^$DD\s+$DD\s*$DD\s*t?$DD(?:$DD(?:$DD(\d*))?)?$/i ||
# ISO 8601 Dates with times
($y,$m,$d,$h,$mn,$s,$tmp)=($1,$2,$3,$4,$5,$6,$7);
if ($h==24 && (! defined $mn || $mn==0) && (! defined $s || $s==0)) {
$z = "" if (! defined $h);
return "" if ($time && defined $h);
} elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
/^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
} elsif (/^$YY\s+$D\s+$D/) {
} elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
($y,$wofm,$dofw)=($1,$2,$3);
($y,$m,$d)=&Date_NthWeekOfYear
($y,$wofm,$dofw);
} elsif (/^$D4\s*(\d{3})$/ ||
($y,$m,$d)=&Date_NthDayOfYear
($y,$which);
# We confused something like 1999/August12:00:00
# with a dateTtime format
# All deltas that are not ISO-8601 dates are NOT dates.
return "" if ($Curr{"InCalc"} && $delta);
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
return &DateCalc_DateDelta
($Curr{"Now"},$delta);
# Check for some special types of dates (next, prev)
foreach $from (keys %{ $Lang{$L}{"Repl"} }) {
$to=$Lang{$L}{"Repl"}{$from};
s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
if (/$wom/i || /$future/i || /$later/i || /$past/i ||
/$next/i || /$prev/i || /^$week$/i || /$wkabb/i) {
if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
# last friday in October 95
($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
return "" if (&Date_DateCheck
(\
$y,\
$m,\
$d,\
$h,\
$mn,\
$s,\
$ampm,\
$wk));
# Get the first day of the month
$date=&Date_Join
($y,$m,1,$h,$mn,$s);
$date=&DateCalc_DateDelta
($date,"+0:1:0:0:0:0:0",\
$err,0);
$date=&Date_GetPrev
($date,$dofw,0);
for ($i=0; $i<$wofm; $i++) {
$date=&Date_GetNext
($date,$dofw,1);
$date=&Date_GetNext
($date,$dofw,0);
} elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$y=&Date_FixYear
($y) if (! defined $y or length($y)<4);
$d=&Date_DaysInMonth
($m,$y);
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&Date_GetPrev
($Curr{"Now"},$Cnf{"FirstDay"},1);
$date=&Date_GetNext
($date,$dofw,1,$h,$mn,$s);
} elsif (/^$next\s*$week$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&Date_GetNext
($Curr{"Now"},$dofw,0,$h,$mn,$s);
} elsif (/^$prev\s*$week$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&Date_GetPrev
($Curr{"Now"},$dofw,0,$h,$mn,$s);
} elsif (/^$next$wkabb$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"+0:0:1:0:0:0:0",\
$err,0);
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^$prev$wkabb$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"-0:0:1:0:0:0:0",\
$err,0);
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^$next$mabb$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"+0:1:0:0:0:0:0",\
$err,0);
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^$prev$mabb$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"-0:1:0:0:0:0:0",\
$err,0);
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^$future\s*(\d+)$day$/i ||
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"+0:0:0:$num:0:0:0",
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^(\d+)$day$past$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"-0:0:0:$num:0:0:0",
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^$future\s*(\d+)$wkabb$/i ||
/^(\d+)$wkabb$later$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"+0:0:$num:0:0:0:0",
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^(\d+)$wkabb$past$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"-0:0:$num:0:0:0:0",
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^$future\s*(\d+)$mabb$/i ||
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"+0:$num:0:0:0:0:0",
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^(\d+)$mabb$past$/i) {
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"-0:$num:0:0:0:0:0",
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^$week$future\s*(\d+)$wkabb$/i ||
/^$week\s*(\d+)$wkabb$later$/i) {
} elsif (/^$week\s*(\d+)$wkabb$past$/i) {
} elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
/^(\d+)$wkabb$later$on$week$/i) {
# 2 weeks later on friday
} elsif (/^(\d+)$wkabb$past$on$week$/i) {
} elsif (/^$week\s*$wkabb$/i) {
# monday week (British date: in 1 week on monday)
} elsif (/^$now\s*$wkabb$/i) {
# today week (British date: 1 week from today)
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},"+0:0:1:0:0:0:0",\
$err,0);
$date=&Date_SetTime
($date,$h,$mn,$s) if (defined $h);
} elsif (/^$offset\s*$wkabb$/i) {
# tomorrow week (British date: 1 week from tomorrow)
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$offset=$Lang{$L}{"OffsetH"}{lc($offset)};
$date=&DateCalc_DateDelta
($Curr{"Now"},$offset,\
$err,0);
$date=&DateCalc_DateDelta
($date,"+0:0:1:0:0:0:0",\
$err,0);
if (&Date_DateCheck
(\
$y,\
$m,\
$d,\
$h,\
$mn,\
$s,\
$ampm,\
$wk));
$date=&Date_SetTime
($date,$h,$mn,$s);
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$date=&DateCalc_DateDelta
($Curr{"Now"},
$tmp . "0:0:$num:0:0:0:0",\
$err,0);
$date=&Date_GetPrev
($date,$Cnf{"FirstDay"},1);
$date=&Date_GetNext
($date,$dofw,1,$h,$mn,$s);
# Change (2nd, second) to 2
if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
my $to = $dom{ lc($from) };
s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
# Another set of special dates (Nth week)
if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
($which,$dofw,$y)=($1,$2,$3);
$tmp=&Date_GetNext
("$y-12-31",$dofw,0);
$tmp=&DateCalc_DateDelta
($tmp,"+0:0:".($which-1).":0:0:0:0",\
$err,0);
($y,$m,$d)=(&Date_Split
($tmp, 1))[0..2];
} elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
/^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
# sunday 22nd week in 1996
($dofw,$which,$y)=($1,$2,$3);
($y,$m,$d)=&Date_NthWeekOfYear
($y,$which,$dofw);
if (/(^|[^a-z])$week($|[^a-z])/i) {
(s/(^|[^a-z])$week,/$1 /i) ||
s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
# So that we can handle negative epoch times, let's convert
# things like "epoch -" to "epochNEGATIVE " before we strip out
# the $sep chars, which include '-'.
s
,epoch\s
*-,epochNEGATIVE
,g
;
s
,\s
*$sep\s
*, ,g
; # change all non-ISO8601 seps to spaces
s
,^\s
*,,; # remove leading/trailing space
if (/^$D\s+$D(?:\s+$YY)?$/) {
# MM DD YY (DD MM YY non-US)
($m,$d)=($d,$m) if ($type ne "US");
} elsif (/^$D4\s*$D\s*$D$/) {
} elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
if (/^\s*$D(?:\s+$YY)?\s*$/) {
} elsif (/^\s*$D$D4\s*$/) {
} elsif (/^\s*$D4\s*$D\s*$/) {
} elsif (/^\s*$D4\s*$/) {
} elsif (/^epochNEGATIVE (\d+)$/) {
$date=&DateCalc
("1970-01-01 00:00 GMT","-0:0:$s");
} elsif (/^epoch\s*(\d+)$/i) {
$date=&DateCalc
("1970-01-01 00:00 GMT","+0:0:$s");
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
if (&Date_DateCheck
(\
$y,\
$m,\
$d,\
$h,\
$mn,\
$s,\
$ampm,\
$wk));
$date=&Date_SetTime
($date,$h,$mn,$s);
&Date_Init
() if (! $Cnf{"UpdateCurrTZ"});
$offset=$Lang{$L}{"OffsetH"}{lc($offset)};
$date=&DateCalc_DateDelta
($Curr{"Now"},$offset,\
$err,0);
if (&Date_DateCheck
(\
$y,\
$m,\
$d,\
$h,\
$mn,\
$s,\
$ampm,\
$wk));
$date=&Date_SetTime
($date,$h,$mn,$s);
return "" if (&Date_DateCheck
(\
$y,\
$m,\
$d,\
$h,\
$mn,\
$s,\
$ampm,\
$wk));
$date=&Date_Join
($y,$m,$d,$h,$mn,$s);
$date=&Date_ConvTZ
($date,$z);
$date=&DateCalc_DateDelta
($date,"+0:0:0:1:0:0:0");
print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
my($args,@args,@a,$ref,$date)=();
# @a : is the list of args to ParseDate. Currently, only one argument
# is allowed and it must be a scalar (or a reference to a scalar)
# or a reference to an array.
print "ERROR: Invalid number of arguments to ParseDate.\n";
return $args if (&Date_Split
($args));
} elsif ($ref eq "ARRAY") {
} elsif ($ref eq "SCALAR") {
return $$args if (&Date_Split
($$args));
print "ERROR: Invalid arguments to ParseDate.\n";
# @args : a list containing all the arguments (dereferenced if appropriate)
# @a : a list containing all the arguments currently being examined
# $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
# reference to a scalar, or a reference to an array was passed in
# $args : the scalar or refererence passed in
$date=&ParseDateString
($date);
@
$args= @args if (defined $ref and $ref eq "ARRAY");
my($date1)=&ParseDateString
($D1);
my($date2)=&ParseDateString
($D2);
return $date1 cmp $date2;
# The calc routines all call parse routines, so it is never necessary to
# call Date_Init in the calc routines.
print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
my($ref,$err,$errref,$mode)=();
my(@date,@delta,$ret,$tmp,$old)=();
if (defined $mode and $mode>=0 and $mode<=3) {
if ($tmp=&ParseDateString
($D1)) {
# If we've already parsed the date, we don't want to do it a second
# time (so we don't convert timezones twice).
} elsif ($tmp=&ParseDateDelta
($D1)) {
if ($tmp=&ParseDateString
($D2)) {
} elsif ($tmp=&ParseDateDelta
($D2)) {
$ret=&DateCalc_DateDate
(@date,$mode);
$ret=&DateCalc_DateDelta
(@date,@delta,\
$err,$mode);
$ret=&DateCalc_DeltaDelta
(@delta,$mode);
print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
my($args,@args,@a,$ref)=();
# @a : is the list of args to ParseDateDelta. Currently, only one argument
# is allowed and it must be a scalar (or a reference to a scalar)
# or a reference to an array.
print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
} elsif ($ref eq "ARRAY") {
} elsif ($ref eq "SCALAR") {
print "ERROR: Invalid arguments to ParseDateDelta.\n";
# @args : a list containing all the arguments (dereferenced if appropriate)
# @a : a list containing all the arguments currently being examined
# $ref : nil, "SCALAR", or "ARRAY" depending on whether a scalar, a
# reference to a scalar, or a reference to an array was passed in
# $args : the scalar or refererence passed in
my(@colon,@delta,$delta,$dir,$colon,$sign,$val)=();
my($len,$tmp,$tmp2,$tmpl)=();
my($workweek)=$Cnf{"WorkWeekEnd"}-$Cnf{"WorkWeekBeg"}+1;
&Date_Init
() if (! $Curr{"InitDone"});
# A sign can be a sequence of zero or more + and - signs, this
# allows for deltas like '+ -2 days'.
my($signexp)='((?:[+-]\s*)*)';
my($exp1)="(?: \\s* $signexp \\s* $numexp \\s*)";
my($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp,$i)=();
$yexp=$mexp=$wexp=$dexp=$hexp=$mnexp=$sexp="()()";
$yexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Yabb"} .")?";
$mexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Mabb"} .")?";
$wexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Wabb"} .")?";
$dexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Dabb"} .")?";
$hexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Habb"} .")?";
$mnexp="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"MNabb"}.")?";
$sexp ="(?: $exp1 ". $Lang{$Cnf{"Language"}}{"Sabb"} ."?)?";
my($future)=$Lang{$Cnf{"Language"}}{"Future"};
my($later)=$Lang{$Cnf{"Language"}}{"Later"};
my($past)=$Lang{$Cnf{"Language"}}{"Past"};
$_ = join(" ", grep {defined;} @a);
# Mode is set in DateCalc. ParseDateDelta only overrides it if the
# string contains a mode.
if ($Lang{$Cnf{"Language"}}{"Exact"} &&
s/$Lang{$Cnf{"Language"}}{"Exact"}//) {
} elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
} elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
s/$Lang{$Cnf{"Language"}}{"Business"}//) {
} elsif (! exists $Curr{"Mode"}) {
$workweek=7 if ($Curr{"Mode"} != 2);
foreach $from (keys %{ $Lang{$Cnf{"Language"}}{"Repl"} }) {
$to=$Lang{$Cnf{"Language"}}{"Repl"}{$from};
s/(^|[^a-z])$from($|[^a-z])/$1$to$2/i;
# We need to make sure that $later, $future, and $past don't contain each
# other... Romanian pointed this out where $past is "in urma" and $future
# is "in". When they do, we have to take this into account.
# $len length of best match (greatest wins)
# $tmp string after best match
# $dir direction (prior, after) of best match
# $tmp2 string before/after current match
# $tmpl length of current match
if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
# the colon part of the delta
if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
@colon=split(/:/,$colon);
# the non-colon part of the delta
foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
# Collapse a sign like '+ -' into a single character like '-',
# by counting the occurrences of '-'.
my $count = ($sign =~ tr/-//d);
die "bad characters in sign: $sign" if length $sign;
$sign = $count % 2 ?
'-' : '+';
push(@delta,"$sign$val");
# make sure that the colon part has a sign
for ($i=0; $i<=$#colon; $i++) {
if ($colon[$i] =~ /^$signexp$numexp?/) {
$colon[$i] = "$sign$val";
for ($i=0; $i<=$#delta; $i++) {
# form the delta and shift off the valid part
@
$args=@args if (defined $ref and $ref eq "ARRAY");
$delta=&Delta_Normalize
($delta,$Curr{"Mode"});
print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
$date=&ParseDateString
($date);
my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
$f{"y"}=substr $f{"Y"},2;
&Date_Init
() if (! $Curr{"InitDone"});
$format=join(" ",@format);
$f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
$f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
$f{"U"}=&Date_WeekOfYear
($m,$d,$y,7);
$f{"W"}=&Date_WeekOfYear
($m,$d,$y,1);
if ($f{"W"}>=52 || $f{"U"}>=52) {
my($dd,$mm,$yy)=($d,$m,$y);
if (&Date_WeekOfYear
($mm,$dd,$yy,1)==2) {
if (&Date_WeekOfYear
($mm,$dd,$yy,7)==2) {
my($dd,$mm,$yy)=($d,$m,$y);
$f{"W"}=&Date_WeekOfYear
($mm,$dd,$yy,1)+1;
my($dd,$mm,$yy)=($d,$m,$y);
$f{"U"}=&Date_WeekOfYear
($mm,$dd,$yy,7)+1;
$f{"U"}="0".$f{"U"} if (length $f{"U"} < 2);
$f{"W"}="0".$f{"W"} if (length $f{"W"} < 2);
$f{"j"}=&Date_DayOfYear
($m,$d,$y);
$f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
$f{"w"}=&Date_DayOfWeek
($m,$d,$y);
$f{"v"}=$Lang{$Cnf{"Language"}}{"WL"}[$f{"w"}-1];
$f{"v"}=" ".$f{"v"} if (length $f{"v"} < 2);
$f{"a"}=$Lang{$Cnf{"Language"}}{"WkL"}[$f{"w"}-1];
$f{"A"}=$Lang{$Cnf{"Language"}}{"WeekL"}[$f{"w"}-1];
$f{"E"}=&Date_DaySuffix
($f{"e"});
$f{"i"}=12 if ($f{"k"}==0);
$f{"i"}=$f{"k"}-12 if ($f{"k"}>12);
$f{"i"}=$f{"i"}-12 if ($f{"i"}>12);
$f{"i"}=" ".$f{"i"} if (length($f{"i"})<2);
$f{"p"}=$Lang{$Cnf{"Language"}}{"AMstr"};
$f{"p"}=$Lang{$Cnf{"Language"}}{"PMstr"} if ($f{"k"}>11);
# minute, second, timezone
$f{"o"}=&Date_SecsSince1970
($m,$d,$y,$h,$mn,$s);
$f{"s"}=&Date_SecsSince1970GMT
($m,$d,$y,$h,$mn,$s);
$f{"Z"}=($Cnf{"ConvTZ"} eq "IGNORE" or $Cnf{"ConvTZ"} eq "") ?
$Cnf{"TZ"} : $Cnf{"ConvTZ"};
$f{"z"}=($f{"Z"}=~/^[+-]\d{4}/) ?
$f{"Z"} : ($Zone{"n2o"}{lc $f{"Z"}} || "");
$f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $f{"z"} $y|;
$f{"g"}=qq|$f{"a"}, $d $f{"b"} $y $h:$mn:$s $f{"z"}|;
$f{"D"}=$f{"x"}=qq|$m/$d/$f{"y"}|;
$f{"r"}=qq|$f{"I"}:$mn:$s $f{"p"}|;
$f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
$f{"V"}=qq|$m$d$h$mn$f{"y"}|;
$f{"q"}=qq|$y$m$d$h$mn$s|;
$f{"P"}=qq|$y$m$d$h:$mn:$s|;
$f{"F"}=qq|$f{"A"}, $f{"B"} $f{"e"}, $f{"Y"}|;
$tmp=&Date_WeekOfYear
(12,31,$y,1);
$tmp="0$tmp" if (length($tmp) < 2);
$f{"J"}=qq|$y-W
$tmp-$f{"w"}|;
$f{"J"}=qq|$f{"G"}-W
$f{"W"}-$f{"w"}|;
# %l is a special case. Since it requires the use of the calculator
# which requires this routine, an infinite recursion results. To get
# around this, %l is NOT determined every time this is called so the
foreach $format (@format) {
$format=reverse($format);
$date1=&DateCalc_DateDelta
($Curr{"Now"},"-0:6:0:0:0:0:0");
$date2=&DateCalc_DateDelta
($Curr{"Now"},"+0:6:0:0:0:0:0");
if (&Date_Cmp
($date,$date1)>=0 && &Date_Cmp
($date,$date2)<=0) {
$f{"l"}=qq|$f{"b"} $f{"e"} $h:$mn|;
$f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
} elsif (exists $f{"$c"}) {
# Can't be in "use integer" because we're doing decimal arithmatic
print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
my($delta,$dec,@format)=@_;
$delta=&ParseDateDelta
($delta);
my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
my($y,$M,$w,$d,$h,$m,$s)=&Delta_Split
($delta);
# Get rid of positive signs.
($y,$M,$w,$d,$h,$m,$s)=map { 1*$_; }($y,$M,$w,$d,$h,$m,$s);
if (defined $dec && $dec>0) {
$dec="%." . ($dec*1) . "f";
$format=join(" ",@format);
# Length of each unit in seconds
my($sl,$ml,$hl,$dl,$wl,$yl)=();
# The decimal amount of each unit contained in all smaller units
my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
$yd = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
$wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
$dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
$hd = ($m*$ml + $s*$sl)/$hl;
# The amount of each unit contained in higher units.
my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
$dh = ($yh+$y)*365.25 + $w*7;
$f{"yd"} = sprintf($dec,$y+$yd);
$f{"Md"} = sprintf($dec,$M+$Md);
$f{"wd"} = sprintf($dec,$w+$wd);
$f{"dd"} = sprintf($dec,$d+$dd);
$f{"hd"} = sprintf($dec,$h+$hd);
$f{"md"} = sprintf($dec,$m+$md);
$f{"sd"} = sprintf($dec,$s+$sd);
$f{"yt"} = sprintf($dec,$yh+$y+$yd);
$f{"Mt"} = sprintf($dec,$Mh+$M+$Md);
$f{"wt"} = sprintf($dec,$wh+$w+$wd);
$f{"dt"} = sprintf($dec,$dh+$d+$dd);
$f{"ht"} = sprintf($dec,$hh+$h+$hd);
$f{"mt"} = sprintf($dec,$mh+$m+$md);
$f{"st"} = sprintf($dec,$sh+$s+$sd);
foreach $format (@format) {
$format=reverse($format);
if (exists($f{"$c1$c2"})) {
print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
my($recur,$dateb,$date0,$date1,$flag)=@_;
my($recur_0,$recur_1,@recur0,@recur1)=();
my(@tmp,$tmp,$each,$num,$y,$m,$d,$w,$h,$mn,$s,$delta,$y0,$y1,$yb)=();
my($yy,$n,$dd,@d,@tmp2,$date,@date,@w,@tmp3,@m,@y,$tmp2,$d2,@flags)=();
# $date0, $date1, $dateb, $flag : passed in (these are always the final say
# in determining whether a date matches a
# recurrence IF they are present.
# $date_b, $date_0, $date_1 : if a value can be determined from the
# $flag_t recurrence, they are stored here.
# If values can be determined from the recurrence AND are passed in, the
# max($date0,$date_0) i.e. the later of the two dates
# min($date1,$date_1) i.e. the earlier of the two dates
# The base date that is used is the first one defined from
# The base date is only used if necessary (as determined by the recur).
# For example, "every other friday" requires a base date, but "2nd
# friday of every month" doesn't.
my($date_b,$date_0,$date_1,$flag_t);
# Check the arguments passed in.
$date0="" if (! defined $date0);
$date1="" if (! defined $date1);
$dateb="" if (! defined $dateb);
$flag ="" if (! defined $flag);
$dateb=&ParseDateString
($dateb);
$date0=&ParseDateString
($date0);
$date1=&ParseDateString
($date1);
# Parse the recur. $date_b, $date_0, and $date_e are values obtained
($recur_0,$recur_1,$flag_t,$date_b,$date_0,$date_1)=@tmp;
$recur_0 = "" if (! defined $recur_0);
$recur_1 = "" if (! defined $recur_1);
$flag_t = "" if (! defined $flag_t);
$date_b = "" if (! defined $date_b);
$date_0 = "" if (! defined $date_0);
$date_1 = "" if (! defined $date_1);
@recur0 = split(/:/,$recur_0);
@recur1 = split(/:/,$recur_1);
return "" if ($#recur0 + $#recur1 + 2 != 7);
$date_b=&ParseDateString
($date_b);
return "" if (! $date_b);
$date_0=&ParseDateString
($date_0);
return "" if (! $date_0);
$date_1=&ParseDateString
($date_1);
return "" if (! $date_1);
my($mmm)='\s*'.$Lang{$Cnf{"Language"}}{"Month"}; # \s*(jan|january|...)
my(%mmm)=%{ $Lang{$Cnf{"Language"}}{"MonthH"} }; # { jan=>1, ... }
my($wkexp)='\s*'.$Lang{$Cnf{"Language"}}{"Week"}; # \s*(mon|monday|...)
my(%week)=%{ $Lang{$Cnf{"Language"}}{"WeekH"} }; # { monday=>1, ... }
my($day)='\s*'.$Lang{$Cnf{"Language"}}{"Dabb"}; # \s*(?:d|day|days)
my($month)='\s*'.$Lang{$Cnf{"Language"}}{"Mabb"}; # \s*(?:mon|month|months)
my($week)='\s*'.$Lang{$Cnf{"Language"}}{"Wabb"}; # \s*(?:w|wk|week|weeks)
my($daysexp)=$Lang{$Cnf{"Language"}}{"DoM"}; # (1st|first|...31st)
my(%dayshash)=%{ $Lang{$Cnf{"Language"}}{"DoMH"} };
my($of)='\s*'.$Lang{$Cnf{"Language"}}{"Of"}; # \s*(?:in|of)
my($lastexp)=$Lang{$Cnf{"Language"}}{"Last"}; # (?:last)
my($each)=$Lang{$Cnf{"Language"}}{"Each"}; # (?:each|every)
my($Y)='\s*(\d{4}|\d{2})';
if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
if (/(^|[^a-z])$each($|[^a-z])/i) {
s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
/^$D?$day(?:$of$mmm())?$/i) {
# every [2nd] day in [june] 1997
# every [2nd] day [in june]
$num=1 if (! defined $num);
$date_0=&Date_Join
($y,$m,1,0,0,0);
$date_1=&DateCalc_DateDelta
($date_0,"+0:1:0:0:0:0:0",0);
$date_0=&Date_Join
($y, 1,1,0,0,0);
$date_1=&Date_Join
($y+1,1,1,0,0,0);
$date_b=&DateCalc
($date_0,"-0:0:0:1:0:0:0",0);
@recur0=(0,0,0,$num,0,0,0);
} elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
# 2nd [day] of every month [in 1997]
$date_0=&Date_Join
($y, 1,1,0,0,0);
$date_1=&Date_Join
($y+1,1,1,0,0,0);
} elsif (/^$D$wkexp$of$month(?:$of?$Y)?$/ ||
/^($lastexp)$wkexp$of$month(?:$of?$Y)?$/) {
# 2nd tuesday of every month [in 1997]
# last tuesday of every month [in 1997]
$num=-1 if ($num !~ /^$D$/);
$date_0=&Date_Join
($y,1,1,0,0,0);
$date_1=&Date_Join
($y+1,1,1,0,0,0);
} elsif (/^$D?$wkexp(?:$of$mmm?$Y)?$/i ||
/^$D?$wkexp(?:$of$mmm())?$/i) {
# every tuesday in june 1997
# every 2nd tuesday in june 1997
($num,$d,$m,$y)=($1,$2,$3,$4);
$num=1 if (! defined $num);
$date_0=&Date_Join
($y,$m,1,0,0,0);
$date_1=&DateCalc_DateDelta
($date_0,"+0:1:0:0:0:0:0",0);
$date_0=&Date_Join
($y,1,1,0,0,0);
$date_1=&Date_Join
($y+1,1,1,0,0,0);
$date_b=&DateCalc
($date_0,"-0:0:0:1:0:0:0",0);
# Override with any values passed in
$date0=( &Date_Cmp
($date0,$date_0) > 1 ?
$date0 : $date_0);
$date1=( &Date_Cmp
($date1,$date_1) > 1 ?
$date_1 : $date1);
$dateb=$date_b if (! $dateb);
$flag =$flag_t if (! $flag && $flag_t);
$tmp = join(":",@recur0);
$tmp .= "*" . join(":",@recur1) if (@recur1);
$tmp .= "*$flag*$dateb*$date0*$date1";
return () if (! $date0 || ! $date1); # dateb is NOT required in all case
# Some flags affect parsing.
@flags = split(/,/,$flag);
if ($f =~ /^MW([1-7])$/i) {
} elsif ($f =~ /^MD([1-7])$/i) {
} elsif ($f =~ /^EASTER$/i) {
($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
# We want something that will return Jan 1 for the given years.
@recur1=($y,1,0,1,$h,$mn,$s);
@recur0=($y,0,0,0,0,0,0);
# Determine the dates referenced by the recur. Also, fix the base date
# as necessary for the recurrences which require it.
($y,$m,$w,$d,$h,$mn,$s)=(@recur0,@recur1);
$y=&Date_FixYear
($y) if (length($y)==2);
return () if (length($y)!=4 || ! &IsInt
($y));
$date0=&ParseDate
("0000-01-01") if (! $date0);
$date1=&ParseDate
("9999-12-31 23:59:59") if (! $date1);
if ($m eq "0" and $w eq "0") {
return () if (! &IsInt
($d,1,366));
@d=sort { $a<=>$b } (@d);
($y,$m,$dd)=&Date_NthDayOfYear
($yy,$d);
push(@date, &Date_Join
($y,$m,$dd,0,0,0));
return () if (! &IsInt
($m,1,12));
@m=sort { $a<=>$b } (@m);
return () if (! &IsInt
($d,1,31));
@d=sort { $a<=>$b } (@d);
$date=&Date_Join
($y,$m,$d,0,0,0);
push(@date,$date) if ($d<29 || &Date_Split
($date));
return () if (! &IsInt
($w,1,53));
return () if (! &IsInt
($d,1,7));
@d=sort { $a<=>$b } (@d);
$w="0$w" if (length($w)==1);
$date=&ParseDateString
("$y-W$w-$d");
return () if (! &IsInt
($m,1,12));
@m=sort { $a<=>$b } (@m);
@date=&Date_Recur_WoM
(\
@y,\
@m,\
@w,\
@d,$MWn,$MDn);
return () if (! &IsInt
($m,1,12));
@m=sort { $a<=>$b } (@m);
# Y * 0-W-D-H-MN-S (equiv to Y-0 * W-D-H-MN-S)
return () if (! &IsInt
($d,1,31));
@d=sort { $a<=>$b } (@d);
# We need to find years that are a multiple of $n from $y(base)
($y0)=( &Date_Split
($date0, 1) )[0];
($y1)=( &Date_Split
($date1, 1) )[0];
($yb)=( &Date_Split
($dateb, 1) )[0];
for ($yy=$y0; $yy<=$y1; $yy++) {
$date=&Date_Join
($yy,$m,$d,0,0,0);
push(@date,$date) if ($d<29 || &Date_Split
($date));
($y0)=( &Date_Split
($date0, 1) )[0];
($y1)=( &Date_Split
($date1, 1) )[0];
($yb)=( &Date_Split
($dateb, 1) )[0];
for ($yy=$y0; $yy<=$y1; $yy++) {
@date=&Date_Recur_WoM
(\
@y,\
@m,\
@w,\
@d,$MWn,$MDn);
# Y-M * 0-D-H-MN-S (equiv to Y-M-0 * D-H-MN-S)
return () if (! &IsInt
($w,1,53));
return () if (! &IsInt
($d,1,7));
@d=sort { $a<=>$b } (@d);
# We need to find years that are a multiple of $n from $y(base)
($y0)=( &Date_Split
($date0, 1) )[0];
($y1)=( &Date_Split
($date1, 1) )[0];
($yb)=( &Date_Split
($dateb, 1) )[0];
for ($yy=$y0; $yy<=$y1; $yy++) {
$w="0$w" if (length($w)==1);
$date=&ParseDateString
("$yy-W$w-$tmp");
push(@tmp,0) while ($#tmp<6);
@tmp=&Date_Recur
($date0,$date1,$dateb,$delta);
@date=&Date_Recur_WoM
(\
@tmp,\
@m,\
@w,\
@d,$MWn,$MDn);
$y=1 if ($y==0 && $m==0 && $w==0);
$delta="$y:$m:$w:0:0:0:0";
@date=&Date_Recur
($date0,$date1,$dateb,$delta);
} elsif ($m==0 && $w==0) {
return () if (! $dateb && $y!=1);
return () if (! &IsInt
($d,1,366));
@d=sort { $a<=>$b } (@d);
# We need to find years that are a multiple of $n from $y(base)
($y0)=( &Date_Split
($date0, 1) )[0];
($y1)=( &Date_Split
($date1, 1) )[0];
($yb)=( &Date_Split
($dateb, 1) )[0];
for ($yy=$y0; $yy<=$y1; $yy++) {
($y,$m,$dd)=&Date_NthDayOfYear
($yy,$d);
push(@date, &Date_Join
($y,$m,$dd,0,0,0));
push(@tmp,0) while ($#tmp<6);
return () if (! &IsInt
($d,1,7));
# Find out what DofW the basedate is.
@tmp2=&Date_Split
($dateb, 1);
$tmp=&Date_DayOfWeek
($tmp2[1],$tmp2[2],$tmp2[0]);
if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
($tmp<$d && $d<$Cnf{"FirstDay"})) {
$date_b=&Date_GetNext
($date_b,$d);
$date_b=&Date_GetPrev
($date_b,$d);
push(@date,&Date_Recur
($date0,$date1,$date_b,$delta));
push(@tmp,0) while ($#tmp<6);
return () if (! &IsInt
($d,-31,31) || $d==0);
@d=sort { $a<=>$b } (@d);
@tmp2=&Date_Recur
($date0,$date1,$dateb,$delta);
($y,$m)=( &Date_Split
($date, 1) )[0..1];
$tmp2=&Date_DaysInMonth
($m,$y);
$d2=$tmp2+1+$d if ($d<0);
push(@date,&Date_Join
($y,$m,$d2,0,0,0)) if ($d2<=$tmp2);
push(@tmp,0) while ($#tmp<6);
return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
@date=&Date_Recur
($date0,$date1,$dateb,$delta);
unshift(@recur1,-1) while ($#recur1<2);
@date=&Date_RecurSetTime
($date0,$date1,\
@date,@time) if (@time);
# We've got a list of dates. Operate on them with the flags.
my($sign,$forw,$today,$df,$db,$work,$i);
FLAG
: foreach $f (@flags) {
if ($f =~ /^(P|N)(D|T)([1-7])$/) {
$forw =($tmp[0] eq "P" ?
0 : 1);
$today=($tmp[1] eq "D" ?
0 : 1);
push(@tmp, &Date_GetNext
($date,$d,$today));
push(@tmp, &Date_GetPrev
($date,$d,$today));
# We want to go forward exact amounts of time instead of
# business mode calculations so that we don't change the time
# (which may have been set in the recur).
if ($f =~ /^(F|B)(D|W)(\d+)$/) {
$sign="-" if ($tmp[0] eq "B");
$work=1 if ($tmp[1] eq "W");
for ($i=1; $i<=$n; $i++) {
$date=&DateCalc
($date,"${sign}0:0:0:1:0:0:0");
last if (! $work || &Date_IsWorkDay
($date,0));
if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
DATE
: foreach $date (@date) {
if (&Date_IsWorkDay
($date)) {
$d=$df=&DateCalc
($df,"+0:0:0:1:0:0:0");
$d=$db=&DateCalc
($db,"-0:0:0:1:0:0:0");
if (&Date_IsWorkDay
($d)) {
$forw=1-$forw if (! $noalt);
($y,$m,$d,$h,$mn,$s)=&Date_Split
($date, 1);
($m,$d)=&Date_Easter
($y);
$date=&Date_Join
($y,$m,$d,$h,$mn,$s);
next if (&Date_Cmp
($date,$date0)<0 ||
&Date_Cmp
($date,$date1)>0);
print "DEBUG: Date_GetPrev\n" if ($Curr{"Debug"} =~ /trace/);
my($date,$dow,$today,$hr,$min,$sec)=@_;
&Date_Init
() if (! $Curr{"InitDone"});
my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
$hr="00" if (defined $hr && $hr eq "0");
$min="00" if (defined $min && $min eq "0");
$sec="00" if (defined $sec && $sec eq "0");
if (! &Date_Split
($date)) {
$date=&ParseDateString
($date);
($y,$m,$d)=( &Date_Split
($date, 1) )[0..2];
$curr_dow=&Date_DayOfWeek
($m,$d,$y);
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
return "" if ($dow<1 || $dow>7);
return "" if (! exists $dow{lc($dow)});
$date=&DateCalc_DateDelta
($date,"-0:0:1:0:0:0:0",\
$err,0) if (! $today);
$adjust=1 if ($today==2);
$dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
$date=&DateCalc_DateDelta
($date,"-0:0:0:$num:0:0:0",\
$err,0);
$date=&Date_SetTime
($date,$hr,$min,$sec) if (defined $hr);
$date=&DateCalc_DateDelta
($date,"-0:0:1:0:0:0:0",\
$err,0)
if ($adjust && &Date_Cmp
($date,$curr)>0);
($h,$mn,$s)=( &Date_Split
($date, 1) )[3..5];
($th,$tm,$ts)=&Date_ParseTime
($hr,$min,$sec);
($hr,$min,$sec)=($th,$tm,$ts);
($hr,$min,$sec)=($h,$tm,$ts);
($hr,$min,$sec)=($h,$mn,$ts);
confess
"ERROR: invalid arguments in Date_GetPrev.\n";
$d=&Date_SetTime
($date,$hr,$min,$sec);
$d=&DateCalc_DateDelta
($d,$delta,\
$err,0) if (&Date_Cmp
($d,$date)>0);
$d=&DateCalc_DateDelta
($d,$delta,\
$err,0) if (&Date_Cmp
($d,$date)>=0);
print "DEBUG: Date_GetNext\n" if ($Curr{"Debug"} =~ /trace/);
my($date,$dow,$today,$hr,$min,$sec)=@_;
&Date_Init
() if (! $Curr{"InitDone"});
my($y,$m,$d,$h,$mn,$s,$err,$curr_dow,%dow,$num,$delta,$th,$tm,$ts,
$hr="00" if (defined $hr && $hr eq "0");
$min="00" if (defined $min && $min eq "0");
$sec="00" if (defined $sec && $sec eq "0");
if (! &Date_Split
($date)) {
$date=&ParseDateString
($date);
($y,$m,$d)=( &Date_Split
($date, 1) )[0..2];
$curr_dow=&Date_DayOfWeek
($m,$d,$y);
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
return "" if ($dow<1 || $dow>7);
return "" if (! exists $dow{lc($dow)});
$date=&DateCalc_DateDelta
($date,"+0:0:1:0:0:0:0",\
$err,0) if (! $today);
$adjust=1 if ($today==2);
$curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
$date=&DateCalc_DateDelta
($date,"+0:0:0:$num:0:0:0",\
$err,0);
$date=&Date_SetTime
($date,$hr,$min,$sec) if (defined $hr);
$date=&DateCalc_DateDelta
($date,"+0:0:1:0:0:0:0",\
$err,0)
if ($adjust && &Date_Cmp
($date,$curr)<0);
($h,$mn,$s)=( &Date_Split
($date, 1) )[3..5];
($th,$tm,$ts)=&Date_ParseTime
($hr,$min,$sec);
($hr,$min,$sec)=($th,$tm,$ts);
($hr,$min,$sec)=($h,$tm,$ts);
($hr,$min,$sec)=($h,$mn,$ts);
confess
"ERROR: invalid arguments in Date_GetNext.\n";
$d=&Date_SetTime
($date,$hr,$min,$sec);
$d=&DateCalc_DateDelta
($d,$delta,\
$err,0) if (&Date_Cmp
($d,$date)<0);
$d=&DateCalc_DateDelta
($d,$delta,\
$err,0) if (&Date_Cmp
($d,$date)<1);
print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
$date=&ParseDateString
($date);
return undef if (! $date);
$date=&Date_SetTime
($date,0,0,0);
my($y)=(&Date_Split
($date, 1))[0];
&Date_UpdateHolidays
($y) if (! exists $Holiday{"dates"}{$y});
return undef if (! exists $Holiday{"dates"}{$y}{$date});
my($name)=$Holiday{"dates"}{$y}{$date};
print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
my($tmp,$date0,$date1,$flag);
$date0=&ParseDateString
($args[0]);
warn "Invalid date $args[0]", return undef if (! $date0);
return &Events_Calc
($date0);
$date1=&ParseDateString
($args[1]);
warn "Invalid date $args[1]\n", return undef if (! $date1);
if (&Date_Cmp
($date0,$date1)>0) {
$date0=&Date_SetTime
($date0,"00:00:00");
$date1=&DateCalc_DateDelta
($date0,"+0:0:0:1:0:0:0");
$tmp=&Events_Calc
($date0,$date1);
return $tmp if (! $flag);
($date0,$tmp)=splice(@tmp,0,2);
$delta=&DateCalc_DateDate
($date0,$date1);
if (exists $ret{$flag}) {
$ret{$flag}=&DateCalc_DeltaDelta
($ret{$flag},$delta);
($date0,$tmp)=splice(@tmp,0,2);
$delta=&DateCalc_DateDate
($date0,$date1);
$flag=join("+",sort @
$tmp);
if (exists $ret{$flag}) {
$ret{$flag}=&DateCalc_DeltaDelta
($ret{$flag},$delta);
warn "Invalid flag $flag\n";
# NOTE: The following routines may be called in the routines below with very
print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
if (! &Date_Split
($date)) {
$date=&ParseDateString
($date);
($y,$m,$d)=( &Date_Split
($date, 1) )[0..2];
($h,$mn,$s)=&Date_ParseTime
($h,$mn,$s);
return "" if (&Date_DateCheck
(\
$y,\
$m,\
$d,\
$h,\
$mn,\
$s,\
$ampm,\
$wk));
&Date_Join
($y,$m,$d,$h,$mn,$s);
print "DEBUG: Date_SetDateField\n" if ($Curr{"Debug"} =~ /trace/);
my($date,$field,$val,$nocheck)=@_;
my($y,$m,$d,$h,$mn,$s)=();
$nocheck=0 if (! defined $nocheck);
($y,$m,$d,$h,$mn,$s)=&Date_Split
($date);
$date=&ParseDateString
($date);
($y,$m,$d,$h,$mn,$s)=&Date_Split
($date, 1);
} elsif (lc($field) eq "m") {
} elsif (lc($field) eq "d") {
} elsif (lc($field) eq "h") {
} elsif (lc($field) eq "mn") {
} elsif (lc($field) eq "s") {
confess
"ERROR: Date_SetDateField: invalid field: $field\n";
$date=&Date_Join
($y,$m,$d,$h,$mn,$s);
return $date if ($nocheck || &Date_Split
($date));
########################################################################
########################################################################
# NOTE: These routines should not call any of the routines above as
# there will be a severe time penalty (and the possibility of
# infinite recursion). The last couple routines above are
# NOTE: Date_Init is a special case. It should be called (conditionally)
# in every routine that uses any variable from the Date::Manip
########################################################################
print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
$y=&Date_FixYear
($y) if (length($y)!=4);
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
$d_in_m[2]=29 if (&Date_LeapYear
($y));
print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
$y=&Date_FixYear
($y) if (length($y)!=4);
my($dayofweek,$dec31)=();
$dec31=5; # Dec 31, 1BC was Friday
$dayofweek=(&Date_DaysSince1BC
($m,$d,$y)+$dec31) % 7;
$dayofweek=7 if ($dayofweek==0);
# Can't be in "use integer" because the numbers are too big.
print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
my($m,$d,$y,$h,$mn,$s)=@_;
$y=&Date_FixYear
($y) if (length($y)!=4);
$sec_now=(&Date_DaysSince1BC
($m,$d,$y)-1)*24*3600 + $h*3600 + $mn*60 + $s;
# $sec_70 =(&Date_DaysSince1BC(1,1,1970)-1)*24*3600;
return ($sec_now-$sec_70);
sub Date_SecsSince1970GMT
{
print "DEBUG: Date_SecsSince1970GMT\n" if ($Curr{"Debug"} =~ /trace/);
my($m,$d,$y,$h,$mn,$s)=@_;
&Date_Init
() if (! $Curr{"InitDone"});
$y=&Date_FixYear
($y) if (length($y)!=4);
my($sec)=&Date_SecsSince1970
($m,$d,$y,$h,$mn,$s);
return $sec if ($Cnf{"ConvTZ"} eq "IGNORE");
$tz=$Cnf{"TZ"} if (! $tz);
$tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
$sec - $tzs*($tzh*3600+$tzm*60);
print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
$y=&Date_FixYear
($y) if (length($y)!=4);
my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
# Number of full years since Dec 31, 1BC (counting the year 0000).
# Number of full 4th years (incl. 0000) since Dec 31, 1BC
# Number of full 100th years (incl. 0000)
# Number of full 400th years (incl. 0000)
$dayofyear=&Date_DayOfYear
($m,$d,$y);
$days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
$y=&Date_FixYear
($y) if (length($y)!=4);
# DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
my(@days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
$ly=1 if ($m>2 && &Date_LeapYear
($y));
return ($days[$m-1]+$d+$ly);
print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
$y=&Date_FixYear
($y) if (length($y)!=4);
return 366 if (&Date_LeapYear
($y));
print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
$y=&Date_FixYear
($y) if (length($y)!=4);
$doy=&Date_DayOfYear
($m,$d,$y);
# The current DayOfYear and DayOfWeek
$dow=&Date_DayOfWeek
(1,$day,$y);
# Move back to the first day of week 1.
return 0 if ($day>$doy); # Day is in last week of previous year
return (($doy-$day)/7 + 1);
print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
$y=&Date_FixYear
($y) if (length($y)!=4);
return 0 unless $y % 4 == 0;
return 1 unless $y % 100 == 0;
return 0 unless $y % 400 == 0;
print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
if (not Date_Split
($date)) {
croak
"date passed in ('$date') is not a Date::Manip object";
&Date_Init
() if (! $Curr{"InitDone"});
return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
$from=$Cnf{"TZ"} if (! $from);
return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
$to=$Cnf{"TZ"} if (! $to);
$to=$Zone{"n2o"}{lc($to)}
if (exists $Zone{"n2o"}{lc($to)});
$from=$Zone{"n2o"}{lc($from)}
if (exists $Zone{"n2o"}{lc($from)});
$gmt=$Zone{"n2o"}{"gmt"};
return $date if ($from !~ /^[+-]\d{4}$/ or $to !~ /^[+-]\d{4}$/);
return $date if ($from eq $to);
my($s1,$h1,$m1,$s2,$h2,$m2,$d,$h,$m,$sign,$delta,$err,$yr,$mon,$sec)=();
# We're going to try to do the calculation without calling DateCalc.
($yr,$mon,$d,$h,$m,$sec)=&Date_Split
($date, 1);
# Convert $date from $from to GMT
$from=~/([+-])(\d{2})(\d{2})/;
($s1,$h1,$m1)=($1,$2,$3);
$s1= ($s1 eq "-" ?
"+" : "-"); # switch sign
$sign=$s1 . "1"; # + or - 1
$to=~/([+-])(\d{2})(\d{2})/;
($s2,$h2,$m2)=($1,$2,$3);
$sign=($s2 eq "-" ?
+1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
if (($d + $delta) > 28) {
$date=&Date_Join
($yr,$mon,$d,$h,$m,$sec);
return &DateCalc_DateDelta
($date,"+0:0:0:$delta:0:0:0",\
$err,0);
$date=&Date_Join
($yr,$mon,$d,$h,$m,$sec);
return &DateCalc_DateDelta
($date,"-0:0:0:$delta:0:0:0",\
$err,0);
return &Date_Join
($yr,$mon,$d,$h,$m,$sec);
print "DEBUG: Date_TimeZone\n" if ($Curr{"Debug"} =~ /trace/);
my($null,$tz,@tz,$std,$dst,$time,$isdst,$tmp,$in)=();
&Date_Init
() if (! $Curr{"InitDone"});
# Get timezones from all of the relevant places
push(@tz,$Cnf{"TZ"}) if (defined $Cnf{"TZ"}); # TZ config var
push(@tz,$ENV{"TZ"}) if (defined $ENV{"TZ"}); # TZ environ var
push(@tz,$ENV{'SYS$TIMEZONE_RULE'})
if defined $ENV{'SYS$TIMEZONE_RULE'}; # VMS TZ environ var
push(@tz,$ENV{'SYS$TIMEZONE_NAME'})
if defined $ENV{'SYS$TIMEZONE_NAME'}; # VMS TZ name environ var
if defined $ENV{'UCX$TZ'}; # VMS TZ environ var
push(@tz,$ENV{'TCPIP$TZ'})
if defined $ENV{'TCPIP$TZ'}; # VMS TZ environ var
# The `date` command... if we're doing taint checking, we need to
# always call it with a full path... otherwise, use the user's path.
# Microsoft operating systems don't have a date command built in. Try
# to trap all the various ways of knowing we are on one of these systems.
# We'll try `date +%Z` first, and if that fails, we'll take just the
# `date` program and assume the output is of the format:
# Thu Aug 31 14:57:46 EDT 2000
unless (($^X
=~ /perl\.exe$/i) or
if ($Date::Manip
::NoTaint
) {
$tz=$ENV{'SYS$TIMEZONE_NAME'};
$tz=$ENV{'MULTINET_TIMEZONE'};
$tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
$tz=`date +%Z 2> /dev/null`;
$tz=(split(/\s+/,$tz))[4];
# We need to satisfy taint checking, but also look in all the
# directories in @DatePath.
local $ENV{PATH
} = join(':', @Date::Manip
::DatePath
);
local $ENV{BASH_ENV
} = '';
$tz=`date +%Z 2> /dev/null`;
$tz=(split(/\s+/,$tz))[4];
push(@tz,$main::TZ
) if (defined $main::TZ
); # $main::TZ
if (-s
"/etc/TIMEZONE") { # /etc/TIMEZONE
$in->open("/etc/TIMEZONE","r");
if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
if (-s
"/etc/timezone") { # /etc/timezone
$in->open("/etc/timezone","r");
next if ($tmp =~ /^\s*\043/);
if ($tmp =~ /^\s*(.*?)\s*$/) {
# Now parse each one to find the first valid one.
if (defined $Zone{"n2o"}{lc($tz)});
if ($tz =~ /^[+-]\d{4}$/) {
} elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
# Handle US/Eastern format
if ($tz =~ /^$Zone{"tzones"}$/i) {
# Handle STD#DST# format (and STD-#DST-# formats)
if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
next if (! defined $Zone{"n2o"}{lc($std)} or
! defined $Zone{"n2o"}{lc($dst)});
($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
return uc($dst) if ($isdst);
confess
"ERROR: Date::Manip unable to determine TimeZone.\n";
# Returns 1 if $date is a work day. If $time is non-zero, the time is
# also checked to see if it falls within work hours. Returns "" if
# an invalid date is passed in.
print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
$date=&ParseDateString
($date);
$d=&Date_SetTime
($date,$Cnf{"WorkDayBeg"}) if (! $time);
my($y,$mon,$day,$tmp,$h,$m,$dow)=();
($y,$mon,$day,$h,$m,$tmp)=&Date_Split
($d, 1);
$dow=&Date_DayOfWeek
($mon,$day,$y);
return 0 if ($dow<$Cnf{"WorkWeekBeg"} or
$dow>$Cnf{"WorkWeekEnd"} or
"$h:$m" lt $Cnf{"WorkDayBeg"} or
"$h:$m" gt $Cnf{"WorkDayEnd"});
if (! exists $Holiday{"dates"}{$y}) {
# There will be recursion problems if we ever end up here twice.
$Holiday{"dates"}{$y}={};
$d=&Date_SetTime
($date,"00:00:00");
return 0 if (exists $Holiday{"dates"}{$y}{$d});
# Finds the day $off work days from now. If $time is passed in, we must
# also take into account the time of day.
# If $time is not passed in, day 0 is today (if today is a workday) or the
# next work day if it isn't. In any case, the time of day is unaffected.
# If $time is passed in, day 0 is now (if now is part of a workday) or the
# start of the very next work day.
print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
$date=&ParseDateString
($date);
if (! &Date_IsWorkDay
($date,$time)) {
$date=&Date_GetNext
($date,undef,0,$Cnf{"WorkDayBeg"});
last if (&Date_IsWorkDay
($date,$time));
$date=&DateCalc_DateDelta
($date,"+0:0:0:1:0:0:0",\
$err,0);
last if (&Date_IsWorkDay
($date,$time));
$date=&DateCalc_DateDelta
($date,"+0:0:0:1:0:0:0",\
$err,0);
last if (&Date_IsWorkDay
($date,$time));
# Finds the day $off work days before now. If $time is passed in, we must
# also take into account the time of day.
# If $time is not passed in, day 0 is today (if today is a workday) or the
# previous work day if it isn't. In any case, the time of day is unaffected.
# If $time is passed in, day 0 is now (if now is part of a workday) or the
# end of the previous work period. Note that since the end of a work day
# will automatically be turned into the start of the next one, this time
# may actually be treated as AFTER the current time.
print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
$date=&ParseDateString
($date);
if (! &Date_IsWorkDay
($date,$time)) {
$date=&Date_GetPrev
($date,undef,0,$Cnf{"WorkDayEnd"});
last if (&Date_IsWorkDay
($date,$time));
$date=&Date_GetNext
($date,undef,0,$Cnf{"WorkDayBeg"});
last if (&Date_IsWorkDay
($date,$time));
$date=&DateCalc_DateDelta
($date,"-0:0:0:1:0:0:0",\
$err,0);
last if (&Date_IsWorkDay
($date,$time));
$date=&DateCalc_DateDelta
($date,"-0:0:0:1:0:0:0",\
$err,0);
last if (&Date_IsWorkDay
($date,$time));
# This finds the nearest workday to $date. If $date is a workday, it
sub Date_NearestWorkDay
{
print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
&Date_Init
() if (! $Curr{"InitDone"});
$date=&ParseDateString
($date);
my($a,$b,$dela,$delb,$err)=();
$tomorrow=$Cnf{"TomorrowFirst"} if (! defined $tomorrow);
return $date if (&Date_IsWorkDay
($date));
$a=&DateCalc_DateDelta
($a,$dela,\
$err);
return $a if (&Date_IsWorkDay
($a));
$b=&DateCalc_DateDelta
($b,$delb,\
$err);
return $b if (&Date_IsWorkDay
($b));
# &Date_NthDayOfYear($y,$n);
# Returns a list of (YYYY,MM,DD,HH,MM,SS) for the Nth day of the year.
print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
$n=1 if (! defined $n or $n eq "");
$n+=0; # to turn 023 into 23
$y=&Date_FixYear
($y) if (length($y)<4);
my $leap=&Date_LeapYear
($y);
return () if ($n >= ($leap ?
367 : 366));
my(@d_in_m)=(31,28,31,30,31,30,31,31,30,31,30,31);
$d_in_m[1]=29 if ($leap);
# Calculate the hours, minutes, and seconds into the day.
my $remain=($n - int($n))*24;
$remain=($remain - $h)*60;
$remain=($remain - $mn)*60;
# Calculate the month and the day.
########################################################################
########################################################################
# This is used in Date_Init to fill in a hash based on international
# data. It takes a list of keys and values and returns both a hash
# with these values and a regular expression of keys.
# $data = [ key1 val1 key2 val2 ... ]
# $opts = lc : lowercase the keys in the regexp
# sort : sort (by length) the keys in the regexp
# back : create a regexp with a back reference
# escape : escape all strings in the regexp
# $regexp = '(?:key1|key2|...)'
# $hash = { key1=>val1 key2=>val2 ... }
print "DEBUG: Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
my($data,$regexp,$opts,$hash)=@_;
my($lc,$sort,$back,$escape)=(0,0,0,0);
$lc=1 if ($opts =~ /lc/i);
$sort=1 if ($opts =~ /sort/i);
$back=1 if ($opts =~ /back/i);
$escape=1 if ($opts =~ /escape/i);
# Create the regular expression
@list=sort sortByLength
(@list) if ($sort);
$$regexp="(" . join("|",@list) . ")";
$$regexp="(?:" . join("|",@list) . ")";
# This is used in Date_Init to fill in regular expressions, lists, and
# hashes based on international data. It takes a list of lists which have
# to be stored as regular expressions (to find any element in the list),
# lists, and hashes (indicating the location in the lists).
# $data = [ [ [ valA1 valA2 ... ][ valA1' valA2' ... ] ... ]
# [ [ valB1 valB2 ... ][ valB1' valB2' ... ] ... ]
# [ [ valZ1 valZ2 ... ] [valZ1' valZ1' ... ] ... ] ]
# $lists = [ \@listA \@listB ... \@listZ ]
# $opts = lc : lowercase the values in the regexp
# sort : sort (by length) the values in the regexp
# back : create a regexp with a back reference
# escape : escape all strings in the regexp
# $hash = [ \%hash, TYPE ]
# TYPE 0 : $hash{ valBn=>n-1 }
# TYPE 1 : $hash{ valBn=>n }
# $regexp = '(?:valA1|valA2|...|valB1|...)'
# $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
# [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
print "DEBUG: Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
my($data,$regexp,$opts,$lists,$hash)=@_;
my($i,@ele,$ele,@list,$j,$tmp)=();
my($lc,$sort,$back,$escape)=(0,0,0,0);
$lc=1 if ($opts =~ /lc/i);
$sort=1 if ($opts =~ /sort/i);
$back=1 if ($opts =~ /back/i);
$escape=1 if ($opts =~ /escape/i);
confess
"ERROR: Date_InitLists: lists must be 1 per data\n"
for ($i=0; $i<=$#data; $i++) {
if ($Cnf{"IntCharSet"} && $#ele>0) {
@
{ $lists[$i] } = @
{ $ele[1] };
@
{ $lists[$i] } = @
{ $ele[0] };
my($hashtype,$hashsave,%hash)=();
($hash,$hashtype)=@
$hash;
for ($i=0; $i<=$#data; $i++) {
for ($j=0; $j<=$#list; $j++) {
$hash{$tmp}= $j+$hashtype;
%$hash = %hash if ($hashsave);
# Create the regular expression
@list=sort sortByLength
(@list) if ($sort);
$$regexp="(" . join("|",@list) . ")";
$$regexp="(?:" . join("|",@list) . ")";
# This is used in Date_Init to fill in regular expressions and lists based
# on international data. This takes a list of strings and returns a regular
# expression (to find any one of them).
# $data = [ string1 string2 ... ]
# $opts = lc : lowercase the values in the regexp
# sort : sort (by length) the values in the regexp
# back : create a regexp with a back reference
# escape : escape all strings in the regexp
# $regexp = '(string1|string2|...)'
print "DEBUG: Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
my($data,$regexp,$opts)=@_;
my($lc,$sort,$back,$escape)=(0,0,0,0);
$lc=1 if ($opts =~ /lc/i);
$sort=1 if ($opts =~ /sort/i);
$back=1 if ($opts =~ /back/i);
$escape=1 if ($opts =~ /escape/i);
# Create the regular expression
@list=sort sortByLength
(@list) if ($sort);
$$regexp="(" . join("|",@list) . ")";
$$regexp="(?:" . join("|",@list) . ")";
$$regexp=lc($$regexp) if ($lc);
# items is passed in (either as a space separated string, or a reference to
# a list) and a regular expression which matches any one of the items is
# prepared. The regular expression will be of one of the forms:
# "(a|b)" @list not empty, back option included
# "(?:a|b)" @list not empty
# "()" @list empty, back option included
# $options is a string which contains any of the following strings:
# back : the regular expression has a backreference
# opt : the regular expression is optional and a "?" is appended in
# optws : the regular expression is optional and may be replaced by
# optWs : the regular expression is optional, but if not present, must
# be replaced by whitespace
# sort : the items in the list are sorted by length (longest first)
# lc : the string is lowercased
# under : any underscores are converted to spaces
# pre : it may be preceded by whitespace
# Pre : it must be preceded by whitespace
# PRE : it must be preceded by whitespace or the start
# post : it may be followed by whitespace
# Post : it must be followed by whitespace
# POST : it must be followed by whitespace or the end
# Spaces due to pre/post options will not be included in the back reference.
# If $array is included, then the elements will also be returned as a list.
# $array is a string which may contain any of the following:
# keys : treat the list as a hash and only the keys go into the regexp
# key0 : treat the list as the values of a hash with keys 0 .. N-1
# key1 : treat the list as the values of a hash with keys 1 .. N
# val0 : treat the list as the keys of a hash with values 0 .. N-1
# val1 : treat the list as the keys of a hash with values 1 .. N
# &Date_InitLists([$lang{"month_name"},$lang{"month_abb"}],
# [\$Month,"lc,sort,back"],
# This is used in Date_Init to prepare regular expressions. A list of
# items is passed in (either as a space separated string, or a reference to
# a list) and a regular expression which matches any one of the items is
# prepared. The regular expression will be of one of the forms:
# "(a|b)" @list not empty, back option included
# "(?:a|b)" @list not empty
# "()" @list empty, back option included
# $options is a string which contains any of the following strings:
# back : the regular expression has a backreference
# opt : the regular expression is optional and a "?" is appended in
# optws : the regular expression is optional and may be replaced by
# optWs : the regular expression is optional, but if not present, must
# be replaced by whitespace
# sort : the items in the list are sorted by length (longest first)
# lc : the string is lowercased
# under : any underscores are converted to spaces
# pre : it may be preceded by whitespace
# Pre : it must be preceded by whitespace
# PRE : it must be preceded by whitespace or the start
# post : it may be followed by whitespace
# Post : it must be followed by whitespace
# POST : it must be followed by whitespace or the end
# Spaces due to pre/post options will not be included in the back reference.
# If $array is included, then the elements will also be returned as a list.
# $array is a string which may contain any of the following:
# keys : treat the list as a hash and only the keys go into the regexp
# key0 : treat the list as the values of a hash with keys 0 .. N-1
# key1 : treat the list as the values of a hash with keys 1 .. N
# val0 : treat the list as the keys of a hash with values 0 .. N-1
# val1 : treat the list as the keys of a hash with values 1 .. N
print "DEBUG: Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
my($list,$options,$array)=@_;
my(@list,$ret,%hash,$i)=();
$options="" if (! defined $options);
$array="" if (! defined $array);
my($sort,$lc,$under)=(0,0,0);
$sort =1 if ($options =~ /sort/i);
$lc =1 if ($options =~ /lc/i);
$under=1 if ($options =~ /under/i);
my($back,$opt,$pre,$post,$ws)=("?:","","","","");
$back ="" if ($options =~ /back/i);
$opt ="?" if ($options =~ /opt/i);
$pre ='\s*' if ($options =~ /pre/);
$pre ='\s+' if ($options =~ /Pre/);
$pre ='(?:\s+|^)' if ($options =~ /PRE/);
$post ='\s*' if ($options =~ /post/);
$post ='\s+' if ($options =~ /Post/);
$post ='(?:$|\s+)' if ($options =~ /POST/);
$ws ='\s*' if ($options =~ /optws/);
$ws ='\s+' if ($options =~ /optws/);
my($hash,$keys,$key0,$key1,$val0,$val1)=(0,0,0,0,0,0);
$keys =1 if ($array =~ /keys/i);
$key0 =1 if ($array =~ /key0/i);
$key1 =1 if ($array =~ /key1/i);
$val0 =1 if ($array =~ /val0/i);
$val1 =1 if ($array =~ /val1/i);
$hash =1 if ($keys or $key0 or $key1 or $val0 or $val1);
} elsif ($ref eq "ARRAY") {
$list = join("&&&",@
$list);
confess
"ERROR: Date_Regexp.\n";
$list=lc($list) if ($lc);
$list=~ s/_/ /g if ($under);
@list=split(/&&&/,$list);
} elsif ($key0 or $key1 or $val0 or $val1) {
$i=1 if ($key1 or $val1);
%hash= map { $_,$i++ } @list;
%hash= map { $i++,$_ } @list;
@list=sort sortByLength
(@list) if ($sort);
$ret="($back" . join("|",@list) . ")";
$ret="(?:$pre$ret$post)" if ($pre or $post);
$ret="(?:$ret|$ws)" if ($ws);
# This will produce a delta with the correct number of signs. At most two
# signs will be in it normally (one before the year, and one in front of
# the day), but if appropriate, signs will be in front of all elements.
# Also, as many of the signs will be equivalent as possible.
print "DEBUG: Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
return "+0:+0:+0:+0:+0:+0:+0"
if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/ and $Cnf{"DeltaSigns"});
return "+0:0:0:0:0:0:0" if ($delta =~ /^([+-]?0+:){6}[+-]?0+$/);
my($tmp,$sign1,$sign2,$len)=();
# Calculate the length of the day in minutes
$len=$Curr{"WDlen"} if ($mode==2 || $mode==3);
# We have to get the sign of every component explicitely so that a "-0"
# or "+0" doesn't get lost by treating it numerically (i.e. "-0:0:2" must
my($y,$mon,$w,$d,$h,$m,$s)=&Delta_Split
($delta);
# We need to make sure that the signs of all parts of a delta are the
# same. The easiest way to do this is to convert all of the large
# components to the smallest ones, then convert the smaller components
# back to the larger ones.
$mon += $y*12; # convert y to m
$y = $mon/12; # convert m to y
$y=0 if ($y eq "-0"); # get around silly -0 problem
$mon=0 if ($mon eq "-0");
# Do the wk/day/hour/min/sec part
# Unfortunately, $s is overflowing for dates more than ~70 years
if ($mode==3 || $mode==2) {
$s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
$s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
$m = int($s/60); # convert s to m
$d = int($m/$len); # convert m to d
# The rest should be fine.
$h = $m/60; # convert m to h
if ($mode == 3 || $mode == 2) {
$w = $w*1; # get around +0 problem
$w = $d/7; # convert d to w
$w=0 if ($w eq "-0"); # get around silly -0 problem
# Only include two signs if necessary
$sign1=$sign2 if ($y==0 and $mon==0);
$sign2=$sign1 if ($w==0 and $d==0 and $h==0 and $m==0 and $s==0);
$sign2="" if ($sign1 eq $sign2 and ! $Cnf{"DeltaSigns"});
if ($Cnf{"DeltaSigns"}) {
return "$sign1$y:$sign1$mon:$sign2$w:$sign2$d:$sign2$h:$sign2$m:$sign2$s";
return "$sign1$y:$mon:$sign2$w:$d:$h:$m:$s";
# This checks a delta to make sure it is valid. If it is, it splits
# it and returns the elements with a sign on each. The 2nd argument
# specifies the default sign. Blank elements are set to 0. If the
# third element is non-nil, exactly 7 elements must be included.
print "DEBUG: Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
my($delta,$sign,$exact)=@_;
my(@delta)=split(/:/,$delta);
return () if ($exact and $#delta != 6);
$sign="+" if (! defined $sign);
for ($i=0; $i<=$#delta; $i++) {
$delta[$i]="0" if (! $delta[$i]);
return () if ($delta[$i] !~ /^[+-]?\d+$/);
$sign = ($delta[$i] =~ s/^([+-])// ?
$1 : $sign);
$delta[$i] = $sign.$delta[$i];
# Reads up to 3 arguments. $h may contain the time in any international
# format. Any empty elements are set to 0.
print "DEBUG: Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
my($t)=&CheckTime
("one");
if (defined $h and $h =~ /$t/) {
$h="00" if (! defined $h);
$m="00" if (! defined $m);
$s="00" if (! defined $s);
# Forms a date with the 6 elements passed in (all of which must be defined).
# No check as to validity is made.
print "DEBUG: Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
croak
"undefined arg $_ to Date_Join()" if not defined $_[$_];
my($y,$m,$d,$h,$mn,$s)=@_;
my($ym,$md,$dh,$hmn,$mns)=();
if ($Cnf{"Internal"} == 0) {
} elsif ($Cnf{"Internal"} == 1) {
$ym=$md=$dh=$hmn=$mns="";
} elsif ($Cnf{"Internal"} == 2) {
confess
"ERROR: Invalid internal format in Date_Join.\n";
$m="0$m" if (length($m)==1);
$d="0$d" if (length($d)==1);
$h="0$h" if (length($h)==1);
$mn="0$mn" if (length($mn)==1);
$s="0$s" if (length($s)==1);
"$y$ym$m$md$d$dh$h$hmn$mn$mns$s";
# This checks a time. If it is valid, it splits it and returns 3 elements.
# If "one" or "two" is passed in, a regexp with 1/2 or 2 digit hours is
print "DEBUG: CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
my($hm)="(?:". $Lang{$Cnf{"Language"}}{"SepHM"} ."|:)";
my($ms)="(?:". $Lang{$Cnf{"Language"}}{"SepMS"} ."|:)";
my($ss)=$Lang{$Cnf{"Language"}}{"SepSS"};
my($t)="^($h)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
} elsif ($time eq "two") {
$t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
$h="0$h" if (length($h)<2);
$m="0$m" if (length($m)<2);
$s="00" if (! defined $s);
# This checks a recurrence. If it is valid, it splits it and returns the
# elements. Otherwise, it returns an empty list.
# ($recur0,$recur1,$flags,$dateb,$date0,$date1)=&Recur_Split($recur);
print "DEBUG: Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
my($F) = '(?:\*([^*]*))';
if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
@tmp=split(/\*/,shift(@ret));
return (@tmp,"",@ret) if ($#tmp==0);
# This checks a date. If it is valid, it splits it and returns the elements.
# If no date is passed in, it returns a regular expression for the date.
# The optional second argument says 'I really expect this to be a
# valid Date::Manip object, please throw an exception if it is
# not'. Otherwise, errors are signalled by returning ().
print "DEBUG: Date_Split\n" if ($Curr{"Debug"} =~ /trace/);
my($date, $definitely_valid)=@_;
$definitely_valid = 0 if not defined $definitely_valid;
my($ym,$md,$dh,$hmn,$mns)=();
my($m)='(0[1-9]|1[0-2])';
my($d)='(0[1-9]|[1-2][0-9]|3[0-1])';
my($h)='([0-1][0-9]|2[0-3])';
if ($Cnf{"Internal"} == 0) {
} elsif ($Cnf{"Internal"} == 1) {
$ym=$md=$dh=$hmn=$mns="";
} elsif ($Cnf{"Internal"} == 2) {
confess
"ERROR: Invalid internal format in Date_Split.\n";
my($t)="^$y$ym$m$md$d$dh$h$hmn$mn$mns$s\$";
if (not defined $date or $date eq '') {
($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
$d_in_m[2]=29 if (&Date_LeapYear
($y));
my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
return ($y,$m,$d,$h,$mn,$s);
die "invalid date $date: doesn't match regexp $t";
# This returns the date easter occurs on for a given year as ($month,$day).
# This is from the Calendar FAQ.
$y=&Date_FixYear
($y) if (length($y)==2);
my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30;
$i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11));
my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7;
my($d) = $l + 28 - 31*($m/4);
# This takes a list of years, months, WeekOfMonth's, and optionally
# DayOfWeek's, and returns a list of dates. Optionally, a list of dates
# can be passed in as the 1st argument (with the 2nd argument the null list)
# and the year/month of these will be used.
# If $FDn is non-zero, the first week of the month contains the first
# occurence of this day (1=Monday). If $FIn is non-zero, the first week of
# the month contains the date (i.e. $FIn'th day of the month).
my($y,$m,$w,$d,$FDn,$FIn)=@_;
my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
return () if (length($y)==1 || length($y)==3 || ! &IsInt
($y,0,9999));
$y=&Date_FixYear
($y) if (length($y)==2);
@y=sort { $a<=>$b } (@tmp);
return () if (! &IsInt
($m,1,12));
@m=sort { $a<=>$b } (@m);
return () if ($w==0 || ! &IsInt
($w,-5,5));
return () if (! &IsInt
($d,1,7));
@d=sort { $a<=>$b } (@d);
# Find 1st day of this month and next month
$date0=&Date_Join
($y,$m,1,0,0,0);
$date1=&DateCalc
($date0,"+0:1:0:0:0:0:0");
# Find 1st occurence of DOW (in both months)
$d0=&Date_GetNext
($date0,$d,1);
$d1=&Date_GetNext
($date1,$d,1);
while (&Date_Cmp
($d0,$d1)<0) {
$d0=&DateCalc
($d0,"+0:0:1:0:0:0:0");
push(@tmp2,$tmp[$#tmp+1+$w]);
# Find 1st day of 1st week
$date0=&Date_GetNext
($date0,$FDn,1);
$date0=&Date_Join
($y,$m,$FIn,0,0,0);
$date0=&Date_GetPrev
($date0,$Cnf{"FirstDay"},1);
# Find 1st day of 1st week of next month
$date1=&Date_GetNext
($date1,$FDn,1);
$date1=&DateCalc
($date1,"+0:0:0:".($FIn-1).":0:0:0") if ($FIn>1);
$date1=&Date_GetPrev
($date1,$Cnf{"FirstDay"},1);
while (&Date_Cmp
($date0,$date1)<0) {
$date0=&DateCalc
($date0,"+0:0:1:0:0:0:0");
push(@tmp2,$tmp[$#tmp+1+$w]);
# This returns a sorted list of dates formed by adding/subtracting
# $delta to $dateb in the range $date0<=$d<$dateb. The first date int
# the list is actually the first date<$date0 and the last date in the
# list is the first date>=$date1 (because sometimes the set part will
# move the date back into the range).
my($date0,$date1,$dateb,$delta)=@_;
while (&Date_Cmp
($dateb,$date0)<0) {
$dateb=&DateCalc_DateDelta
($dateb,$delta);
while (&Date_Cmp
($dateb,$date1)>=0) {
$dateb=&DateCalc_DateDelta
($dateb,"-$delta");
# Add the dates $date0..$dateb
while (&Date_Cmp
($d,$date0)>=0) {
$d=&DateCalc_DateDelta
($d,"-$delta");
# Add the first date earler than the range
# Add the dates $dateb..$date1
$d=&DateCalc_DateDelta
($dateb,$delta);
while (&Date_Cmp
($d,$date1)<0) {
$d=&DateCalc_DateDelta
($d,$delta);
# Add the first date later than the range
# This sets the values in each date of a recurrence.
# $h,$m,$s can each be values or lists "1-2,4". If any are equal to "-1",
# they are not set (and none of the larger elements are set).
my($date0,$date1,$dates,$h,$m,$s)=@_;
my(@h,@m,@s,$date,@tmp)=();
@h=sort { $a<=>$b } (@h);
push(@tmp,&Date_SetDateField
($date,"h",$h,1));
@m=sort { $a<=>$b } (@m);
push(@tmp,&Date_SetDateField
($date,"mn",$m,1));
@s=sort { $a<=>$b } (@s);
push(@tmp,&Date_SetDateField
($date,"s",$s,1));
push(@tmp,$date) if (&Date_Cmp
($date,$date0)>=0 &&
&Date_Cmp
($date,$date1)<0 &&
print "DEBUG: DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
$mode=0 if (! defined $mode);
my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split
($D1, 1);
my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split
($D2, 1);
my($i,@delta,$d,$delta,$y)=();
# form the delta for hour/min/sec
# form the delta for yr/mon/day
$d=&Date_DaysInYear
($y1) - &Date_DayOfYear
($m1,$d1,$y1);
$d+=&Date_DayOfYear
($m2,$d2,$y2);
for ($y=$y1+1; $y<$y2; $y++) {
$d+= &Date_DaysInYear
($y);
$d=&Date_DaysInYear
($y2) - &Date_DayOfYear
($m2,$d2,$y2);
$d+=&Date_DayOfYear
($m1,$d1,$y1);
for ($y=$y2+1; $y<$y1; $y++) {
$d+= &Date_DaysInYear
($y);
$d=&Date_DayOfYear
($m2,$d2,$y2) - &Date_DayOfYear
($m1,$d1,$y1);
$delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
$delta=&Delta_Normalize
($delta,0);
my($date1,$date2)=($D1,$D2);
my($tmp,$sign,$err,@tmp)=();
# make sure both are work days
if ($mode==2 || $mode==3) {
$date1=&Date_NextWorkDay
($date1,0,1);
$date2=&Date_NextWorkDay
($date2,0,1);
# make sure date1 comes before date2
if (&Date_Cmp
($date1,$date2)>0) {
if (&Date_Cmp
($date1,$date2)==0) {
return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
my($y1,$m1,$d1,$h1,$mn1,$s1)=&Date_Split
($date1, 1);
my($y2,$m2,$d2,$h2,$mn2,$s2)=&Date_Split
($date2, 1);
my($dy,$dm,$dw,$dd,$dh,$dmn,$ds,$ddd)=(0,0,0,0,0,0,0,0);
$tmp=&DateCalc_DateDelta
($date1,"+$dy:0:0:0:0:0:0",\
$err,0);
if (&Date_Cmp
($tmp,$date2)>0) {
$tmp=&DateCalc_DateDelta
($date1,"+$dy:0:0:0:0:0:0",\
$err,0)
$tmp=&DateCalc_DateDelta
($date1,"+0:$dm:0:0:0:0:0",\
$err,0);
if (&Date_Cmp
($tmp,$date2)>0) {
$tmp=&DateCalc_DateDelta
($date1,"+0:$dm:0:0:0:0:0",\
$err,0)
# At this point, check to see that we're on a business day again so that
# Aug 3 (Monday) -> Sep 3 (Sunday) -> Sep 4 (Monday) = 1 month
if (! &Date_IsWorkDay
($date1,0)) {
$date1=&Date_NextWorkDay
($date1,0,1);
if ($mode==2 || $mode==3) {
$tmp=&Date_NextWorkDay
($date1,1,1);
if (&Date_Cmp
($tmp,$date2)<=0) {
($y1,$m1,$d1)=( &Date_Split
($date1, 1) )[0..2];
# If we're jumping across months, set $d1 to the first of the next month
# (or possibly the 0th of next month which is equivalent to the last day
$d_in_m[2]=29 if (&Date_LeapYear
($y1));
$tmp=&DateCalc_DateDelta
($date1,"+0:0:0:$dd:0:0:0",\
$err,0);
if (&Date_Cmp
($tmp,$date2)>0) {
$tmp=&DateCalc_DateDelta
($date1,"+0:0:0:$dd:0:0:0",\
$err,0);
$tmp=&DateCalc_DateDelta
($date1,"+0:0:0:$ddd:0:0:0",\
$err,0);
if (&Date_Cmp
($tmp,$date2)>0) {
$tmp=&DateCalc_DateDelta
($date1,"+0:0:0:$ddd:0:0:0",\
$err,0);
# in business mode, make sure h1 comes before h2 (if not find delta between
# now and end of day and move to start of next business day)
$d1=( &Date_Split
($date1, 1) )[2];
if ($mode==2 || $mode==3 and $d1 != $d2) {
$tmp=&Date_SetTime
($date1,$Cnf{"WorkDayEnd"});
$tmp=&DateCalc_DateDelta
($tmp,"+0:0:0:0:0:1:0")
if ($Cnf{"WorkDay24Hr"});
$tmp=&DateCalc_DateDate
($date1,$tmp,0);
($tmp,$tmp,$tmp,$tmp,$dh,$dmn,$ds)=&Delta_Split
($tmp);
$date1=&Date_NextWorkDay
($date1,1,0);
$date1=&Date_SetTime
($date1,$Cnf{"WorkDayBeg"});
$d1=( &Date_Split
($date1, 1) )[2];
confess
"ERROR: DateCalc DateDate Business.\n" if ($d1 != $d2);
# Hours, minutes, seconds
$tmp=&DateCalc_DateDate
($date1,$date2,0);
$tmp="$sign$dy:$dm:0:$dd:$dh:$dmn:$ds";
&Delta_Normalize
($tmp,$mode);
sub DateCalc_DeltaDelta
{
print "DEBUG: DateCalc_DeltaDelta\n" if ($Curr{"Debug"} =~ /trace/);
my(@delta1,@delta2,$i,$delta,@delta)=();
$mode=0 if (! defined $mode);
@delta1=&Delta_Split
($D1);
@delta2=&Delta_Split
($D2);
$delta[$i]=$delta1[$i]+$delta2[$i];
$delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
$delta=&Delta_Normalize
($delta,$mode);
print "DEBUG: DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
my($D1,$D2,$errref,$mode)=@_;
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
my($h1,$m1,$h2,$m2,$len,$hh,$mm)=();
$mode=0 if (! defined $mode);
if ($mode==2 || $mode==3) {
my($y,$m,$d,$h,$mn,$s)=&Date_Split
($D1, 1);
my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=&Delta_Split
($D2);
&ModuloAddition
(-12,$dm,\
$m,\
$y); # -12 means 1-12 instead of 0-11
$d_in_m[2]=29 if (&Date_LeapYear
($y));
# if we have gone past the last day of a month, move the date back to
# the last day of the month
if ($mode==0 || $mode==1) {
$date=&DateCalc_DateDelta
(&Date_Join
($y,$m,$d,$h,$mn,$s),
($y,$m,$d,$h,$mn,$s)=&Date_Split
($date, 1);
# in business mode, set the day to a work day at this point so the h/mn/s
if ($mode==2 || $mode==3) {
$d=$d_in_m[$m] if ($d>$d_in_m[$m]);
$date=&Date_NextWorkDay
(&Date_Join
($y,$m,$d,$h,$mn,$s),0,1);
($y,$m,$d,$h,$mn,$s)=&Date_Split
($date, 1);
# seconds, minutes, hours
&ModuloAddition
(60,$ds,\
$s,\
$mn);
if ($mode==2 || $mode==3) {
&ModuloAddition
(60,$dmn,\
$mn,\
$h);
if ($h>$h2 or $h==$h2 && $mn>$m2) {
} elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
} elsif ($h==$h2 && $mn==$m2) {
&ModuloAddition
(60,$dmn,\
$mn,\
$h);
&ModuloAddition
(24,$dh,\
$h,\
$d);
# If we have just gone past the last day of the month, we need to make
if ($mode==2 || $mode==3) {
$date=&Date_NextWorkDay
(&Date_Join
($y,$m,$d,$h,$mn,$s),$dd,1);
$date=&Date_PrevWorkDay
(&Date_Join
($y,$m,$d,$h,$mn,$s),-$dd,1);
($y,$m,$d,$h,$mn,$s)=&Date_Split
($date, 1);
$d_in_m[2]=29 if (&Date_LeapYear
($y));
$d=$d_in_m[$m] if ($d>$d_in_m[$m]);
if (&Date_LeapYear
($y)) {
if (&Date_LeapYear
($y)) {
&Date_Join
($y,$m,$d,$h,$mn,$s);
sub Date_UpdateHolidays
{
print "DEBUG: Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
$Holiday{"dates"}{$year}={};
my($date,$delta,$err)=();
foreach $key (keys %{ $Holiday{"desc"} }) {
$tmp=&ParseDateString
("${year}010100:00:00");
($date)=&ParseRecur
($key,$tmp,$tmp,($year+1)."-01-01");
} elsif ($key =~ /^(.*)([+-].*)$/) {
$tmp=&ParseDateString
("$date $year");
$date=&ParseDateString
($date);
next if ($date !~ /^$year/);
$date=&DateCalc
($date,$delta,\
$err,0);
$tmp=&ParseDateString
("$date $year");
$date=&ParseDateString
($date);
next if ($date !~ /^$year/);
$Holiday{"dates"}{$year}{$date}=$Holiday{"desc"}{$key};
# This sets a Date::Manip config variable.
sub Date_SetConfigVariable
{
print "DEBUG: Date_SetConfigVariable\n" if ($Curr{"Debug"} =~ /trace/);
# These are most appropriate for command line options instead of in files.
$Cnf{"PathSep"}=$val, return if ($var =~ /^PathSep$/i);
$Cnf{"PersonalCnf"}=$val, return if ($var =~ /^PersonalCnf$/i);
$Cnf{"PersonalCnfPath"}=$val, return if ($var =~ /^PersonalCnfPath$/i);
&EraseHolidays
(), return if ($var =~ /^EraseHolidays$/i);
$Cnf{"IgnoreGlobalCnf"}=1, return if ($var =~ /^IgnoreGlobalCnf$/i);
$Cnf{"GlobalCnf"}=$val, return if ($var =~ /^GlobalCnf$/i);
$Cnf{"Language"}=$val, return if ($var =~ /^Language$/i);
$Cnf{"DateFormat"}=$val, return if ($var =~ /^DateFormat$/i);
$Cnf{"TZ"}=$val, return if ($var =~ /^TZ$/i);
$Cnf{"ConvTZ"}=$val, return if ($var =~ /^ConvTZ$/i);
$Cnf{"Internal"}=$val, return if ($var =~ /^Internal$/i);
$Cnf{"FirstDay"}=$val, return if ($var =~ /^FirstDay$/i);
$Cnf{"WorkWeekBeg"}=$val, return if ($var =~ /^WorkWeekBeg$/i);
$Cnf{"WorkWeekEnd"}=$val, return if ($var =~ /^WorkWeekEnd$/i);
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayEnd$/i);
$Cnf{"WorkDay24Hr"}=$val,
$Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDay24Hr$/i);
$Cnf{"DeltaSigns"}=$val, return if ($var =~ /^DeltaSigns$/i);
$Cnf{"Jan1Week1"}=$val, return if ($var =~ /^Jan1Week1$/i);
$Cnf{"YYtoYYYY"}=$val, return if ($var =~ /^YYtoYYYY$/i);
$Cnf{"UpdateCurrTZ"}=$val, return if ($var =~ /^UpdateCurrTZ$/i);
$Cnf{"IntCharSet"}=$val, return if ($var =~ /^IntCharSet$/i);
$Curr{"DebugVal"}=$val, return if ($var =~ /^Debug$/i);
$Cnf{"TomorrowFirst"}=$val, return if ($var =~ /^TomorrowFirst$/i);
$Cnf{"ForceDate"}=$val, return if ($var =~ /^ForceDate$/i);
confess
"ERROR: Unknown configuration variable $var in Date::Manip.\n";
print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
# This returns a pointer to a list of times and events in the format
# [ date, [ events ], date, [ events ], ... ]
# where each list of events are events that are in effect at the date
# immediately preceding the list.
# This takes either one date or two dates as arguments.
print "DEBUG: Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
$date0=&ParseDateString
($date0);
return undef if (! $date0);
$date1=&ParseDateString
($date1);
if (&Date_Cmp
($date0,$date1)>0) {
$date1=&DateCalc_DateDelta
($date0,"+0:0:0:0:0:0:1");
# [ d0,d1,del,name ] => [ d0, d1+del )
# [ d0,0,del,name ] => [ d0, d0+del )
my(%ret,$d0,$d1,$del,$name,$c0,$c1);
my(@tmp)=@
{ $Events{"dates"} };
($d0,$d1,$del,$name)=splice(@tmp,0,4);
$d0=&ParseDateString
($d0);
$d1=&ParseDateString
($d1) if ($d1);
$del=&ParseDateDelta
($del) if ($del);
$d1=&DateCalc_DateDelta
($d1,$del);
$d1=&DateCalc_DateDelta
($d0,$del);
if (&Date_Cmp
($d0,$d1)>0) {
next DATE
if (&Date_Cmp
($d1,$date0)<=0 ||
&Date_Cmp
($d0,$date1)>=0);
if (&Date_Cmp
($d0,$date0)<=0) {
push @
{ $ret{$date0} },$name;
push @
{ $ret{$d1} },"!$name" if (&Date_Cmp
($d1,$date1)<0);
if (&Date_Cmp
($d1,$date1)>=0) {
push @
{ $ret{$d0} },$name;
push @
{ $ret{$d0} },$name;
push @
{ $ret{$d1} },"!$name";
# [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
@tmp=@
{ $Events{"recur"} };
($rec,$del0,$del1,$name)=splice(@tmp,0,4);
# Sort them AND take into account the "!$name" entries.
my(%tmp,$date,@tmp2,@ret);
@d=sort { &Date_Cmp
($a,$b) } keys %ret;
push(@tmp2,$tmp), next if ($tmp =~ /^!/);
push(@ret,$date,[ keys %tmp ]);
# This parses the raw events list
print "DEBUG: Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
# Only need to be parsed once
$Events{"parsed"}=0 if ($force);
return if ($Events{"parsed"});
my(@events)=@
{ $Events{"raw"} };
my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
($event,$name)=splice(@events,0,2);
@event=split(/\s*;\s*/,$event);
if ($date0=&ParseDateString
($event[0])) {
$tmp=&ParseDateString
("$event[0] 00:00:00");
if ($tmp && $tmp eq $date0) {
push @
{ $Events{"dates"} },($date0,0,$delta,$name);
} elsif ($recur=&ParseRecur
($event[0])) {
($recur0,$recur1)=&Recur_Split
($recur);
if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
push @
{ $Events{"recur"} },($recur,0,$delta,$name);
warn "WARNING: illegal event ignored [ @event ]\n";
if ($date0=&ParseDateString
($event[0])) {
if ($date1=&ParseDateString
($event[1])) {
$tmp=&ParseDateString
("$event[1] 00:00:00");
if ($tmp && $tmp eq $date1) {
$date1=&DateCalc_DateDelta
($date1,"+0:0:0:1:0:0:0");
push @
{ $Events{"dates"} },($date0,$date1,0,$name);
} elsif ($delta=&ParseDateDelta
($event[1])) {
push @
{ $Events{"dates"} },($date0,0,$delta,$name);
warn "WARNING: illegal event ignored [ @event ]\n";
} elsif ($recur=&ParseRecur
($event[0])) {
if ($delta=&ParseDateDelta
($event[1])) {
push @
{ $Events{"recur"} },($recur,0,$delta,$name);
warn "WARNING: illegal event ignored [ @event ]\n";
warn "WARNING: illegal event ignored [ @event ]\n";
# date ; delta0 ; delta1 = event
# recur ; delta0 ; delta1 = event
# ??? ; ??? ; ??? ... = event
warn "WARNING: illegal event ignored [ @event ]\n";
# This reads an init file.
print "DEBUG: Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
my($var,$val,$recur,$name)=();
$in->open($file) || return;
while(defined ($_=<$in>)) {
&EraseHolidays
() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
if ($section =~ /var/i) {
confess
"ERROR: invalid Date::Manip config file line.\n $_\n"
if (! /(.*\S)\s*=\s*(.*)$/);
&Date_SetConfigVariable
($var,$val);
} elsif ($section =~ /holiday/i) {
confess
"ERROR: invalid Date::Manip config file line.\n $_\n"
if (! /(.*\S)\s*=\s*(.*)$/);
$name="" if (! defined $name);
$Holiday{"desc"}{$recur}=$name;
} elsif ($section =~ /events/i) {
confess
"ERROR: invalid Date::Manip config file line.\n $_\n"
if (! /(.*\S)\s*=\s*(.*)$/);
push @
{ $Events{"raw"} },($val,$var);
# A section not currently used by Date::Manip (but may be
# used by some extension to it).
# $flag=&Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
# Returns 1 if any of the fields are bad. All fields are optional, and
# all possible checks are done on the data. If a field is not passed in,
# it is set to default values. If data is missing, appropriate defaults
print "DEBUG: Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
my($tmp1,$tmp2,$tmp3)=();
$$h="" if (! defined $$h);
$$mn="" if (! defined $$mn);
$$s="" if (! defined $$s);
$$ampm="" if (! defined $$ampm);
$$ampm=uc($$ampm) if ($$ampm);
$tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
if ($$ampm =~ /^$tmp1$/i) {
$tmp3=$Lang{$Cnf{"Language"}}{"AM"};
$tmp2="AM" if ($$ampm =~ /^$tmp3$/i);
$tmp3=$Lang{$Cnf{"Language"}}{"PM"};
$tmp2="PM" if ($$ampm =~ /^$tmp3$/i);
if ($tmp2 eq "AM" || $tmp2 eq "PM") {
$$h="0$$h" if (length($$h)==1);
return 1 if ($$h<1 || $$h>12);
$$h="00" if ($tmp2 eq "AM" and $$h==12);
$$h += 12 if ($tmp2 eq "PM" and $$h!=12);
$$h="0$$h" if (length($$h)==1);
return 1 if (! &IsInt
($$h,0,23));
$$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
$$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
$$mn="00" if ($$mn eq "");
$$mn="0$$mn" if (length($$mn)==1);
return 1 if (! &IsInt
($$mn,0,59));
$$s="0$$s" if (length($$s)==1);
return 1 if (! &IsInt
($$s,0,59));
# $flag=&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
# Returns 1 if any of the fields are bad. All fields are optional, and
# all possible checks are done on the data. If a field is not passed in,
# it is set to default values. If data is missing, appropriate defaults
# If the flag UpdateHolidays is set, the year is set to
print "DEBUG: Date_DateCheck\n" if ($Curr{"Debug"} =~ /trace/);
my($y,$m,$d,$h,$mn,$s,$ampm,$wk)=@_;
my($tmp1,$tmp2,$tmp3)=();
my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
$$m=1, $$d=1 if (defined $$y and ! defined $$m and ! defined $$d);
$$y="" if (! defined $$y);
$$m="" if (! defined $$m);
$$d="" if (! defined $$d);
$$wk="" if (! defined $$wk);
$$d=$curr_d if ($$y eq "" and $$m eq "" and $$d eq "");
$$y=$curr_y if ($$y eq "");
$$y=&Date_FixYear
($$y) if (length($$y)<4);
return 1 if (! &IsInt
($$y,0,9999));
$d_in_m[2]=29 if (&Date_LeapYear
($$y));
$$m=$curr_m if ($$m eq "");
$$m=$Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)}
if (exists $Lang{$Cnf{"Language"}}{"MonthH"}{lc($$m)});
$$m="0$$m" if (length($$m)==1);
return 1 if (! &IsInt
($$m,1,12));
$$d="0$$d" if (length($$d)==1);
return 1 if (! &IsInt
($$d,1,$d_in_m[$$m]));
$tmp1=&Date_DayOfWeek
($$m,$$d,$$y);
$tmp2=$Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)}
if (exists $Lang{$Cnf{"Language"}}{"WeekH"}{lc($$wk)});
return 1 if ($tmp1 != $tmp2);
return &Date_TimeCheck
($h,$mn,$s,$ampm);
# Takes a year in 2 digit form and returns it in 4 digit form
print "DEBUG: Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
$y=$curr_y if (! defined $y or ! $y);
return $y if (length($y)==4);
confess
"ERROR: Invalid year ($y)\n" if (length($y)!=2);
if (lc($Cnf{"YYtoYYYY"}) eq "c") {
} elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
} elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
$y1=$curr_y-$Cnf{"YYtoYYYY"};
# &Date_NthWeekOfYear($y,$n);
# Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
# &Date_NthWeekOfYear($y,$n,$dow,$flag);
# Returns a list of (YYYY,MM,DD) for the Nth DoW of the year. If flag
# is nil, the first DoW of the year may actually be in the previous
# year (since the 1st week may include days from the previous year).
# If flag is non-nil, the 1st DoW of the year refers to the 1st one
print "DEBUG: Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
my($m,$d,$err,$tmp,$date,%dow)=();
$y=$Curr{"Y"} if (! defined $y or ! $y);
$n=1 if (! defined $n or $n eq "");
return () if ($n<0 || $n>53);
%dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
$dow=$dow{$dow} if (exists $dow{$dow});
return () if ($dow<1 || $dow>7);
$flag="" if (! defined $flag);
$y=&Date_FixYear
($y) if (length($y)<4);
$date=&Date_Join
($y,1,1,0,0,0);
$date=&Date_Join
($y,1,4,0,0,0);
$date=&Date_GetPrev
($date,$Cnf{"FirstDay"},1);
$date=&Date_GetNext
($date,$dow,1) if ($dow ne "");
($tmp)=&Date_Split
($date, 1);
$date=&DateCalc_DateDelta
($date,"+0:0:". ($n-1) . ":0:0:0:0",\
$err,0);
$date=&DateCalc_DateDelta
($date,"-0:0:1:0:0:0:0",\
$err,0);
($y,$m,$d)=&Date_Split
($date, 1);
########################################################################
# LANGUAGE INITIALIZATION
########################################################################
# 8-bit international characters can be gotten by "\xXX". I don't know
# how to get 16-bit characters. I've got to read up on perllocale.
$$hash{"A`"} = "\xc0"; # LATIN CAPITAL LETTER A WITH GRAVE
$$hash{"E`"} = "\xc8"; # LATIN CAPITAL LETTER E WITH GRAVE
$$hash{"I`"} = "\xcc"; # LATIN CAPITAL LETTER I WITH GRAVE
$$hash{"O`"} = "\xd2"; # LATIN CAPITAL LETTER O WITH GRAVE
$$hash{"U`"} = "\xd9"; # LATIN CAPITAL LETTER U WITH GRAVE
$$hash{"a`"} = "\xe0"; # LATIN SMALL LETTER A WITH GRAVE
$$hash{"e`"} = "\xe8"; # LATIN SMALL LETTER E WITH GRAVE
$$hash{"i`"} = "\xec"; # LATIN SMALL LETTER I WITH GRAVE
$$hash{"o`"} = "\xf2"; # LATIN SMALL LETTER O WITH GRAVE
$$hash{"u`"} = "\xf9"; # LATIN SMALL LETTER U WITH GRAVE
$$hash{"A'"} = "\xc1"; # LATIN CAPITAL LETTER A WITH ACUTE
$$hash{"E'"} = "\xc9"; # LATIN CAPITAL LETTER E WITH ACUTE
$$hash{"I'"} = "\xcd"; # LATIN CAPITAL LETTER I WITH ACUTE
$$hash{"O'"} = "\xd3"; # LATIN CAPITAL LETTER O WITH ACUTE
$$hash{"U'"} = "\xda"; # LATIN CAPITAL LETTER U WITH ACUTE
$$hash{"Y'"} = "\xdd"; # LATIN CAPITAL LETTER Y WITH ACUTE
$$hash{"a'"} = "\xe1"; # LATIN SMALL LETTER A WITH ACUTE
$$hash{"e'"} = "\xe9"; # LATIN SMALL LETTER E WITH ACUTE
$$hash{"i'"} = "\xed"; # LATIN SMALL LETTER I WITH ACUTE
$$hash{"o'"} = "\xf3"; # LATIN SMALL LETTER O WITH ACUTE
$$hash{"u'"} = "\xfa"; # LATIN SMALL LETTER U WITH ACUTE
$$hash{"y'"} = "\xfd"; # LATIN SMALL LETTER Y WITH ACUTE
$$hash{"A^"} = "\xc2"; # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
$$hash{"E^"} = "\xca"; # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
$$hash{"I^"} = "\xce"; # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
$$hash{"O^"} = "\xd4"; # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
$$hash{"U^"} = "\xdb"; # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
$$hash{"a^"} = "\xe2"; # LATIN SMALL LETTER A WITH CIRCUMFLEX
$$hash{"e^"} = "\xea"; # LATIN SMALL LETTER E WITH CIRCUMFLEX
$$hash{"i^"} = "\xee"; # LATIN SMALL LETTER I WITH CIRCUMFLEX
$$hash{"o^"} = "\xf4"; # LATIN SMALL LETTER O WITH CIRCUMFLEX
$$hash{"u^"} = "\xfb"; # LATIN SMALL LETTER U WITH CIRCUMFLEX
$$hash{"A~"} = "\xc3"; # LATIN CAPITAL LETTER A WITH TILDE
$$hash{"N~"} = "\xd1"; # LATIN CAPITAL LETTER N WITH TILDE
$$hash{"O~"} = "\xd5"; # LATIN CAPITAL LETTER O WITH TILDE
$$hash{"a~"} = "\xe3"; # LATIN SMALL LETTER A WITH TILDE
$$hash{"n~"} = "\xf1"; # LATIN SMALL LETTER N WITH TILDE
$$hash{"o~"} = "\xf5"; # LATIN SMALL LETTER O WITH TILDE
# breve ( [half circle up]
# diaeresis : [side by side dots]
$$hash{"A:"} = "\xc4"; # LATIN CAPITAL LETTER A WITH DIAERESIS
$$hash{"E:"} = "\xcb"; # LATIN CAPITAL LETTER E WITH DIAERESIS
$$hash{"I:"} = "\xcf"; # LATIN CAPITAL LETTER I WITH DIAERESIS
$$hash{"O:"} = "\xd6"; # LATIN CAPITAL LETTER O WITH DIAERESIS
$$hash{"U:"} = "\xdc"; # LATIN CAPITAL LETTER U WITH DIAERESIS
$$hash{"a:"} = "\xe4"; # LATIN SMALL LETTER A WITH DIAERESIS
$$hash{"e:"} = "\xeb"; # LATIN SMALL LETTER E WITH DIAERESIS
$$hash{"i:"} = "\xef"; # LATIN SMALL LETTER I WITH DIAERESIS
$$hash{"o:"} = "\xf6"; # LATIN SMALL LETTER O WITH DIAERESIS
$$hash{"u:"} = "\xfc"; # LATIN SMALL LETTER U WITH DIAERESIS
$$hash{"y:"} = "\xff"; # LATIN SMALL LETTER Y WITH DIAERESIS
# cedilla , [squiggle down and left below the letter]
$$hash{",C"} = "\xc7"; # LATIN CAPITAL LETTER C WITH CEDILLA
$$hash{",c"} = "\xe7"; # LATIN SMALL LETTER C WITH CEDILLA
# ogonek ; [squiggle down and right below the letter]
# caron < [little v on top]
# First character is below, 2nd character is above
$$hash{"||"} = "\xa6"; # BROKEN BAR
$$hash{" :"} = "\xa8"; # DIAERESIS
$$hash{"-a"} = "\xaa"; # FEMININE ORDINAL INDICATOR
#$$hash{" -"}= "\xaf"; # MACRON (narrow bar)
$$hash{" -"} = "\xad"; # HYPHEN (wide bar)
$$hash{" o"} = "\xb0"; # DEGREE SIGN
$$hash{"-+"} = "\xb1"; # PLUS\342\200\220MINUS SIGN
$$hash{" 1"} = "\xb9"; # SUPERSCRIPT ONE
$$hash{" 2"} = "\xb2"; # SUPERSCRIPT TWO
$$hash{" 3"} = "\xb3"; # SUPERSCRIPT THREE
$$hash{" '"} = "\xb4"; # ACUTE ACCENT
$$hash{"-o"} = "\xba"; # MASCULINE ORDINAL INDICATOR
$$hash{" ."} = "\xb7"; # MIDDLE DOT
$$hash{", "} = "\xb8"; # CEDILLA
$$hash{"Ao"} = "\xc5"; # LATIN CAPITAL LETTER A WITH RING ABOVE
$$hash{"ao"} = "\xe5"; # LATIN SMALL LETTER A WITH RING ABOVE
$$hash{"ox"} = "\xf0"; # LATIN SMALL LETTER ETH
$$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
$$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
$$hash{"X o"} = "\xa4"; # CURRENCY SIGN
$$hash{"Y ="} = "\xa5"; # YEN SIGN
$$hash{"S o"} = "\xa7"; # SECTION SIGN
$$hash{"O c"} = "\xa9"; # COPYRIGHT SIGN Copyright
$$hash{"O R"} = "\xae"; # REGISTERED SIGN
$$hash{"D -"} = "\xd0"; # LATIN CAPITAL LETTER ETH
$$hash{"O /"} = "\xd8"; # LATIN CAPITAL LETTER O WITH STROKE
$$hash{"o /"} = "\xf8"; # LATIN SMALL LETTER O WITH STROKE
$$hash{"1/4"} = "\xbc"; # VULGAR FRACTION ONE QUARTER
$$hash{"1/2"} = "\xbd"; # VULGAR FRACTION ONE HALF
$$hash{"3/4"} = "\xbe"; # VULGAR FRACTION THREE QUARTERS
$$hash{"<<"} = "\xab"; # LEFT POINTING DOUBLE ANGLE QUOTATION MARK
$$hash{">>"} = "\xbb"; # RIGHT POINTING DOUBLE ANGLE QUOTATION MARK
$$hash{"cent"}= "\xa2"; # CENT SIGN
$$hash{"lb"} = "\xa3"; # POUND SIGN
$$hash{"mu"} = "\xb5"; # MICRO SIGN
$$hash{"beta"}= "\xdf"; # LATIN SMALL LETTER SHARP S
$$hash{"para"}= "\xb6"; # PILCROW SIGN
$$hash{"-|"} = "\xac"; # NOT SIGN
$$hash{"AE"} = "\xc6"; # LATIN CAPITAL LETTER AE
$$hash{"ae"} = "\xe6"; # LATIN SMALL LETTER AE
$$hash{"x"} = "\xd7"; # MULTIPLICATION SIGN
$$hash{"P"} = "\xde"; # LATIN CAPITAL LETTER THORN
$$hash{"/"} = "\xf7"; # DIVISION SIGN
$$hash{"p"} = "\xfe"; # LATIN SMALL LETTER THORN
# $hashref = &Date_Init_LANGUAGE;
# This returns a hash containing all of the initialization for a
# specific language. The hash elements are:
# @ month_name full month names January February ...
# @ month_abb month abbreviations Jan Feb ...
# @ day_name day names Monday Tuesday ...
# @ day_abb day abbreviations Mon Tue ...
# @ day_char day character abbrevs M T ...
# @ num_suff number with suffix 1st 2nd ...
# @ num_word numbers spelled out first second ...
# $ now words which mean now now today ...
# $ last words which mean last last final ...
# $ each words which mean each each every ...
# $ of of (as in a member of) in of ...
# $ future in the future in
# $ prev previous item last previous
# % offset a hash of special dates { tomorrow->0:0:0:1:0:0:0 }
# % times a hash of times { noon->12:00:00 ... }
# $ years words for year y yr year ...
# $ months words for month
# $ minutes words for minute
# $ seconds words for second
# The replace element is quite important, but a bit tricky. In
# English (and probably other languages), one of the abbreviations
# for the word month that would be nice is "m". The problem is that
# "m" matches the "m" in "minute" which causes the string to be
# improperly matched in some cases. Hence, the list of abbreviations
# In order to allow you to enter "m", replacements can be done.
# $replace is a list of pairs of words which are matched and replaced
# AS ENTIRE WORDS. Having $replace equal to "m"->"month" means that
# the entire word "m" will be replaced with "month". This allows the
# desired abbreviation to be used. Make sure that replace contains
# an even number of words (i.e. all must be pairs). Any time a
# desired abbreviation matches the start of any other, it has to go
# $ exact exact mode exactly
# $ approx approximate mode approximately
# $ business business mode business
# r sephm hour/minute separator (?::)
# r sepms minute/second separator (?::)
# r sepss second/fraction separator (?:[.:])
# Elements marked with an asterix (@) are returned as a set of lists.
# Each list contains the strings for each element. The first set is used
# when the 7-bit ASCII (US) character set is wanted. The 2nd set is used
# when an international character set is available. Both of the 1st two
# sets should be complete (but the 2nd list can be left empty to force the
# first set to be used always). The 3rd set and later can be partial sets
# Elements marked with a dollar ($) are returned as a simple list of words.
# Elements marked with a percent (%) are returned as a hash list.
# Elements marked with (r) are regular expression elements which must not
# create a back reference.
# ***NOTE*** Every hash element (unless otherwise noted) MUST be defined in
print "DEBUG: Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
[["January","February","March","April","May","June",
"July","August","September","October","November","December"]];
[["Jan","Feb","Mar","Apr","May","Jun",
"Jul","Aug","Sep","Oct","Nov","Dec"],
["","","","","","","","","Sept"]];
[["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
[["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
["", "Tues","", "Thur","", "", ""]];
[["M","T","W","Th","F","Sa","S"]];
[["1st","2nd","3rd","4th","5th","6th","7th","8th","9th","10th",
"11th","12th","13th","14th","15th","16th","17th","18th","19th","20th",
"21st","22nd","23rd","24th","25th","26th","27th","28th","29th","30th",
[["first","second","third","fourth","fifth","sixth","seventh","eighth",
"ninth","tenth","eleventh","twelfth","thirteenth","fourteenth",
"fifteenth","sixteenth","seventeenth","eighteenth","nineteenth",
"twentieth","twenty-first","twenty-second","twenty-third",
"twenty-fourth","twenty-fifth","twenty-sixth","twenty-seventh",
"twenty-eighth","twenty-ninth","thirtieth","thirty-first"]];
$$d{"now"} =["today","now"];
$$d{"last"} =["last","final"];
$$d{"each"} =["each","every"];
$$d{"prev"} =["previous","last"];
$$d{"exact"} =["exactly"];
$$d{"approx"} =["approximately"];
$$d{"business"}=["business"];
$$d{"offset"} =["yesterday","-0:0:0:1:0:0:0","tomorrow","+0:0:0:1:0:0:0"];
$$d{"times"} =["noon","12:00:00","midnight","00:00:00"];
$$d{"years"} =["y","yr","year","yrs","years"];
$$d{"months"} =["mon","month","months"];
$$d{"weeks"} =["w","wk","wks","week","weeks"];
$$d{"days"} =["d","day","days"];
$$d{"hours"} =["h","hr","hrs","hour","hours"];
$$d{"minutes"} =["mn","min","minute","minutes"];
$$d{"seconds"} =["s","sec","second","seconds"];
$$d{"replace"} =["m","month"];
$$d{"am"} = ["AM","A.M."];
$$d{"pm"} = ["PM","P.M."];
print "DEBUG: Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
[[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
[[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
[[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
[qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
[[qw(Lun Mar Mer Gio Ven Sab Dom)]];
[[qw(1mo 2do 3zo 4to 5to 6to 7mo 8vo 9no 10mo 11mo 12mo 13mo 14mo 15mo
16mo 17mo 18mo 19mo 20mo 21mo 22mo 23mo 24mo 25mo 26mo 27mo 28mo
[[qw(primo secondo terzo quarto quinto sesto settimo ottavo nono decimo
undicesimo dodicesimo tredicesimo quattordicesimo quindicesimo
sedicesimo diciassettesimo diciottesimo diciannovesimo ventesimo
ventunesimo ventiduesimo ventitreesimo ventiquattresimo
venticinquesimo ventiseiesimo ventisettesimo ventottesimo
ventinovesimo trentesimo trentunesimo)]];
$$d{"now"} =[qw(adesso oggi)];
$$d{"last"} =[qw(ultimo)];
$$d{"of"} =[qw(della del)];
$$d{"future"} =[qw(fra)];
$$d{"next"} =[qw(prossimo)];
$$d{"prev"} =[qw(ultimo)];
$$d{"later"} =[qw(dopo)];
$$d{"exact"} =[qw(esattamente)];
$$d{"approx"} =[qw(circa)];
$$d{"business"}=[qw(lavorativi lavorativo)];
$$d{"offset"} =[qw(ieri -0:0:0:1:0:0:0 domani +0:0:0:1:0:0:0)];
$$d{"times"} =[qw(mezzogiorno 12:00:00 mezzanotte 00:00:00)];
$$d{"years"} =[qw(anni anno a)];
$$d{"months"} =[qw(mesi mese mes)];
$$d{"weeks"} =[qw(settimane settimana sett)];
$$d{"days"} =[qw(giorni giorno g)];
$$d{"hours"} =[qw(ore ora h)];
$$d{"minutes"} =[qw(minuti minuto min)];
$$d{"seconds"} =[qw(secondi secondo sec)];
$$d{"replace"} =[qw(s sec m mes)];
print "DEBUG: Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
[["janvier","fevrier","mars","avril","mai","juin",
"juillet","aout","septembre","octobre","novembre","decembre"],
["janvier","f${e}vrier","mars","avril","mai","juin",
"juillet","ao${u}t","septembre","octobre","novembre","d${e}cembre"]];
[["jan","fev","mar","avr","mai","juin",
"juil","aout","sept","oct","nov","dec"],
["jan","f${e}v","mar","avr","mai","juin",
"juil","ao${u}t","sept","oct","nov","d${e}c"]];
[["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
[["lun","mar","mer","jeu","ven","sam","dim"]];
[["l","ma","me","j","v","s","d"]];
[["1er","2e","3e","4e","5e","6e","7e","8e","9e","10e",
"11e","12e","13e","14e","15e","16e","17e","18e","19e","20e",
"21e","22e","23e","24e","25e","26e","27e","28e","29e","30e",
[["premier","deux","trois","quatre","cinq","six","sept","huit","neuf",
"dix","onze","douze","treize","quatorze","quinze","seize","dix-sept",
"dix-huit","dix-neuf","vingt","vingt et un","vingt-deux","vingt-trois",
"vingt-quatre","vingt-cinq","vingt-six","vingt-sept","vingt-huit",
"vingt-neuf","trente","trente et un"],
$$d{"now"} =["aujourd'hui","maintenant"];
$$d{"last"} =["dernier"];
$$d{"each"} =["chaque","tous les","toutes les"];
$$d{"at"} =["a","${a}0"];
$$d{"next"} =["suivant"];
$$d{"prev"} =["precedent","pr${e}c${e}dent"];
$$d{"later"} =["plus tard"];
$$d{"exact"} =["exactement"];
$$d{"approx"} =["approximativement"];
$$d{"business"}=["professionel"];
$$d{"offset"} =["hier","-0:0:0:1:0:0:0","demain","+0:0:0:1:0:0:0"];
$$d{"times"} =["midi","12:00:00","minuit","00:00:00"];
$$d{"years"} =["an","annee","ans","annees","ann${e}e","ann${e}es"];
$$d{"weeks"} =["sem","semaine"];
$$d{"days"} =["j","jour","jours"];
$$d{"hours"} =["h","heure","heures"];
$$d{"minutes"} =["mn","min","minute","minutes"];
$$d{"seconds"} =["s","sec","seconde","secondes"];
$$d{"replace"} =["m","mois"];
$$d{"am"} = ["du matin"];
print "DEBUG: Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
[["ianuarie","februarie","martie","aprilie","mai","iunie",
"iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
[["ian","febr","mart","apr","mai","iun",
"iul","aug","sept","oct","nov","dec"],
[["luni","marti","miercuri","joi","vineri","simbata","duminica"],
["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
[["lun","mar","mie","joi","vin","sim","dum"],
["lun","mar","mie","joi","vin","s${i}m","dum"]];
[["L","Ma","Mi","J","V","S","D"]];
[["prima","a doua","a 3-a","a 4-a","a 5-a","a 6-a","a 7-a","a 8-a",
"a 9-a","a 10-a","a 11-a","a 12-a","a 13-a","a 14-a","a 15-a",
"a 16-a","a 17-a","a 18-a","a 19-a","a 20-a","a 21-a","a 22-a",
"a 23-a","a 24-a","a 25-a","a 26-a","a 27-a","a 28-a","a 29-a",
[["prima","a doua","a treia","a patra","a cincea","a sasea","a saptea",
"a opta","a noua","a zecea","a unsprezecea","a doisprezecea",
"a treisprezecea","a patrusprezecea","a cincisprezecea","a saiprezecea",
"a saptesprezecea","a optsprezecea","a nouasprezecea","a douazecea",
"a douazecisiuna","a douazecisidoua","a douazecisitreia",
"a douazecisipatra","a douazecisicincea","a douazecisisasea",
"a douazecisisaptea","a douazecisiopta","a douazecisinoua","a treizecea",
["prima","a doua","a treia","a patra","a cincea","a ${o}asea",
"a ${o}aptea","a opta","a noua","a zecea","a unsprezecea",
"a doisprezecea","a treisprezecea","a patrusprezecea","a cincisprezecea",
"a ${o}aiprezecea","a ${o}aptesprezecea","a optsprezecea",
"a nou${a}sprezecea","a dou${a}zecea","a dou${a}zeci${o}iuna",
"a dou${a}zeci${o}idoua","a dou${a}zeci${o}itreia",
"a dou${a}zeci${o}ipatra","a dou${a}zeci${o}icincea",
"a dou${a}zeci${o}i${o}asea","a dou${a}zeci${o}i${o}aptea",
"a dou${a}zeci${o}iopta","a dou${a}zeci${o}inoua","a treizecea",
["intii", "doi", "trei", "patru", "cinci", "sase", "sapte",
"opt","noua","zece","unsprezece","doisprezece",
"treisprezece","patrusprezece","cincisprezece","saiprezece",
"saptesprezece","optsprezece","nouasprezece","douazeci",
"douazecisiunu","douazecisidoi","douazecisitrei",
"douazecisipatru","douazecisicinci","douazecisisase","douazecisisapte",
"douazecisiopt","douazecisinoua","treizeci","treizecisiunu"],
["${i}nt${i}i", "doi", "trei", "patru", "cinci", "${o}ase", "${o}apte",
"opt","nou${a}","zece","unsprezece","doisprezece",
"treisprezece","patrusprezece","cincisprezece","${o}aiprezece",
"${o}aptesprezece","optsprezece","nou${a}sprezece","dou${a}zeci",
"dou${a}zeci${o}iunu","dou${a}zeci${o}idoi","dou${a}zeci${o}itrei",
"dou${a}zecisipatru","dou${a}zeci${o}icinci","dou${a}zeci${o}i${o}ase",
"dou${a}zeci${o}i${o}apte","dou${a}zeci${o}iopt",
"dou${a}zeci${o}inou${a}","treizeci","treizeci${o}iunu"]];
$$d{"now"} =["acum","azi","astazi","ast${a}zi"];
$$d{"each"} =["fiecare"];
$$d{"of"} =["din","in","n"];
$$d{"future"} =["in","${i}n"];
$$d{"past"} =["in urma", "${i}n urm${a}"];
$$d{"next"} =["urmatoarea","urm${a}toarea"];
$$d{"prev"} =["precedenta","ultima"];
$$d{"later"} =["mai tirziu", "mai t${i}rziu"];
$$d{"approx"} =["aproximativ"];
$$d{"business"}=["de lucru","lucratoare","lucr${a}toare"];
$$d{"offset"} =["ieri","-0:0:0:1:0:0:0",
"alaltaieri", "-0:0:0:2:0:0:0",
"alalt${a}ieri","-0:0:0:2:0:0:0",
"miine","+0:0:0:1:0:0:0",
"m${i}ine","+0:0:0:1:0:0:0",
"poimiine","+0:0:0:2:0:0:0",
"poim${i}ine","+0:0:0:2:0:0:0"];
$$d{"times"} =["amiaza","12:00:00",
"miezul noptii","00:00:00",
"miezul nop${p}ii","00:00:00"];
$$d{"years"} =["ani","an","a"];
$$d{"months"} =["luni","luna","lun${a}","l"];
$$d{"weeks"} =["saptamini","s${a}pt${a}m${i}ni","saptamina",
"s${a}pt${a}m${i}na","sapt","s${a}pt"];
$$d{"days"} =["zile","zi","z"];
$$d{"hours"} =["ore", "ora", "or${a}", "h"];
$$d{"minutes"} =["minute","min","m"];
$$d{"seconds"} =["secunde","sec",];
$$d{"replace"} =["s","secunde"];
$$d{"am"} = ["AM","A.M."];
$$d{"pm"} = ["PM","P.M."];
print "DEBUG: Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
[["Januari","Februari","Mars","April","Maj","Juni",
"Juli","Augusti","September","Oktober","November","December"]];
[["Jan","Feb","Mar","Apr","Maj","Jun",
"Jul","Aug","Sep","Okt","Nov","Dec"]];
[["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
[["Man","Tis","Ons","Tor","Fre","Lor","Son"],
["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
[["M","Ti","O","To","F","L","S"]];
[["1:a","2:a","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
"11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
"21:a","22:a","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
[["forsta","andra","tredje","fjarde","femte","sjatte","sjunde",
"attonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
"femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
"tjugoforsta","tjugoandra","tjugotredje","tjugofjarde","tjugofemte",
"tjugosjatte","tjugosjunde","tjugoattonde","tjugonionde",
"trettionde","trettioforsta"],
["f${o}rsta","andra","tredje","fj${a}rde","femte","sj${a}tte","sjunde",
"${ao}ttonde","nionde","tionde","elfte","tolfte","trettonde","fjortonde",
"femtonde","sextonde","sjuttonde","artonde","nittonde","tjugonde",
"tjugof${o}rsta","tjugoandra","tjugotredje","tjugofj${a}rde","tjugofemte",
"tjugosj${a}tte","tjugosjunde","tjugo${ao}ttonde","tjugonionde",
"trettionde","trettiof${o}rsta"]];
$$d{"now"} =["idag","nu"];
$$d{"last"} =["forra","f${o}rra","senaste"];
$$d{"at"} =["kl","kl.","klockan"];
$$d{"on"} =["pa","p${ao}"];
$$d{"next"} =["nasta","n${a}sta"];
$$d{"prev"} =["forra","f${o}rra"];
$$d{"later"} =["senare"];
$$d{"approx"} =["ungefar","ungef${a}r"];
$$d{"business"}=["arbetsdag","arbetsdagar"];
$$d{"offset"} =["ig${ao}r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
"imorgon","+0:0:0:1:0:0:0"];
$$d{"times"} =["mitt pa dagen","12:00:00","mitt p${ao} dagen","12:00:00",
$$d{"years"} =["ar","${ao}r"];
$$d{"months"} =["man","manad","manader","m${ao}n","m${ao}nad","m${ao}nader"];
$$d{"weeks"} =["v","vecka","veckor"];
$$d{"days"} =["d","dag","dagar"];
$$d{"hours"} =["t","tim","timme","timmar"];
$$d{"minutes"} =["min","minut","minuter"];
$$d{"seconds"} =["s","sek","sekund","sekunder"];
$$d{"replace"} =["m","minut"];
print "DEBUG: Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
[["Januar","Februar","Maerz","April","Mai","Juni",
"Juli","August","September","Oktober","November","Dezember"],
["J${a}nner","Februar","M${a}rz","April","Mai","Juni",
"Juli","August","September","Oktober","November","Dezember"]];
[["Jan","Feb","Mar","Apr","Mai","Jun",
"Jul","Aug","Sep","Okt","Nov","Dez"],
["J${a}n","Feb","M${a}r","Apr","Mai","Jun",
"Jul","Aug","Sep","Okt","Nov","Dez"]];
[["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
[["Mon","Die","Mit","Don","Fre","Sam","Son"]];
[["M","Di","Mi","Do","F","Sa","So"]];
[["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
"11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
"21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
["erste","zweite","dritte","vierte","funfte","sechste","siebente",
"achte","neunte","zehnte","elfte","zwolfte","dreizehnte","vierzehnte",
"funfzehnte","sechzehnte","siebzehnte","achtzehnte","neunzehnte",
"zwanzigste","einundzwanzigste","zweiundzwanzigste","dreiundzwanzigste",
"vierundzwanzigste","funfundzwanzigste","sechundzwanzigste",
"siebundzwanzigste","achtundzwanzigste","neunundzwanzigste",
"dreibigste","einunddreibigste"],
["erste","zweite","dritte","vierte","f${u}nfte","sechste","siebente",
"achte","neunte","zehnte","elfte","zw${o}lfte","dreizehnte",
"vierzehnte","f${u}nfzehnte","sechzehnte","siebzehnte","achtzehnte",
"neunzehnte","zwanzigste","einundzwanzigste","zweiundzwanzigste",
"dreiundzwanzigste","vierundzwanzigste","f${u}nfundzwanzigste",
"sechundzwanzigste","siebundzwanzigste","achtundzwanzigste",
"neunundzwanzigste","drei${b}igste","einunddrei${b}igste"],
$$d{"now"} =["heute","jetzt"];
$$d{"last"} =["letzte","letzten"];
$$d{"of"} =["der","im","des"];
$$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
$$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
$$d{"later"} =["spater","sp${a}ter"];
$$d{"approx"} =["ungefahr","ungef${a}hr"];
$$d{"business"}=["Arbeitstag"];
$$d{"offset"} =["gestern","-0:0:0:1:0:0:0","morgen","+0:0:0:1:0:0:0"];
$$d{"times"} =["mittag","12:00:00","mitternacht","00:00:00"];
$$d{"years"} =["j","Jahr","Jahre"];
$$d{"months"} =["Monat","Monate"];
$$d{"weeks"} =["w","Woche","Wochen"];
$$d{"days"} =["t","Tag","Tage"];
$$d{"hours"} =["h","std","Stunde","Stunden"];
$$d{"minutes"} =["min","Minute","Minuten"];
$$d{"seconds"} =["s","sek","Sekunde","Sekunden"];
$$d{"replace"} =["m","Monat"];
print "DEBUG: Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
[["januari","februari","maart","april","mei","juni","juli","augustus",
"september","october","november","december"],
["","","","","","","","","","oktober"]];
[["jan","feb","maa","apr","mei","jun","jul",
"aug","sep","oct","nov","dec"],
["","","mrt","","","","","","","okt"]];
[["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
[["ma","di","wo","do","vr","zat","zon"],
["","","","","","za","zo"]];
[["M","D","W","D","V","Za","Zo"]];
[["1ste","2de","3de","4de","5de","6de","7de","8ste","9de","10de",
"11de","12de","13de","14de","15de","16de","17de","18de","19de","20ste",
"21ste","22ste","23ste","24ste","25ste","26ste","27ste","28ste","29ste",
[["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
"negende","tiende","elfde","twaalfde",
map {"${_}tiende";} qw
(der veer vijf zes zeven acht negen
),
map {"${_}entwintigste";} qw
(een twee drie vier vijf zes zeven acht
"dertigste","eenendertigste"],
["","","","","","","","","","","","","","","","","","","","",
map {"${_}-en-twintigste";} qw
(een twee drie vier vijf zes zeven acht
"dertigste","een-en-dertigste"],
["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
map {"${_}tien"} qw
(der veer vijf zes zeven acht negen
),
map {"${_}entwintig"} qw
(een twee drie vier vijf zes zeven acht negen
),
["","","","","","","","","","","","","","","","","","","","",
map {"${_}-en-twintig"} qw
(een twee drie vier vijf zes zeven acht
"dertig","een-en-dertig"]];
$$d{"now"} =["nu","nou","vandaag"];
$$d{"last"} =["laatste"];
$$d{"each"} =["elke","elk"];
$$d{"past"} =["geleden","vroeger","eerder"];
$$d{"next"} =["volgende","volgend"];
$$d{"prev"} =["voorgaande","voorgaand"];
$$d{"exact"} =["exact","precies","nauwkeurig"];
$$d{"approx"} =["ongeveer","ong",'ong\.',"circa","ca",'ca\.'];
$$d{"business"}=["werk","zakelijke","zakelijk"];
$$d{"offset"} =["morgen","+0:0:0:1:0:0:0","overmorgen","+0:0:0:2:0:0:0",
"gisteren","-0:0:0:1:0:0:0","eergisteren","-0::00:2:0:0:0"];
$$d{"times"} =["noen","12:00:00","middernacht","00:00:00"];
$$d{"years"} =["jaar","jaren","ja","j"];
$$d{"months"} =["maand","maanden","mnd"];
$$d{"weeks"} =["week","weken","w"];
$$d{"days"} =["dag","dagen","d"];
$$d{"hours"} =["uur","uren","u","h"];
$$d{"minutes"} =["minuut","minuten","min"];
$$d{"seconds"} =["seconde","seconden","sec","s"];
$$d{"replace"} =["m","minuten"];
$$d{"am"} = ["am","a.m.","vm","v.m.","voormiddag","'s_ochtends",
"ochtend","'s_nachts","nacht"];
$$d{"pm"} = ["pm","p.m.","nm","n.m.","namiddag","'s_middags","middag",
print "DEBUG: Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
[["stycznia","luty","marca","kwietnia","maja","czerwca",
"lipca","sierpnia","wrzesnia","pazdziernika","listopada","grudnia"],
["stycznia","luty","marca","kwietnia","maja","czerwca","lipca",
"sierpnia","wrze\x9cnia","pa\x9fdziernika","listopada","grudnia"]];
[["sty.","lut.","mar.","kwi.","maj","cze.",
"lip.","sie.","wrz.","paz.","lis.","gru."],
["sty.","lut.","mar.","kwi.","maj","cze.",
"lip.","sie.","wrz.","pa\x9f.","lis.","gru."]];
[["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
[["po.","wt.","sr.","cz.","pi.","so.","ni."],
["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
[["p","w","e","c","p","s","n"],
["p","w","\x9c.","c","p","s","n"]];
[["1.","2.","3.","4.","5.","6.","7.","8.","9.","10.",
"11.","12.","13.","14.","15.","16.","17.","18.","19.","20.",
"21.","22.","23.","24.","25.","26.","27.","28.","29.","30.",
[["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
"siodmego","osmego","dziewiatego","dziesiatego",
"jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
"szestnastego","siedemnastego","osiemnastego","dziewietnastego",
"dwudziestego pierwszego","dwudziestego drugiego",
"dwudziestego trzeczego","dwudziestego czwartego",
"dwudziestego piatego","dwudziestego szostego",
"dwudziestego siodmego","dwudziestego osmego",
"dwudziestego dziewiatego","trzydziestego","trzydziestego pierwszego"],
["pierwszego","drugiego","trzeczego","czwartego","pi\x81\xb9tego",
"sz\x81\xf3stego","si\x81\xf3dmego","\x81\xf3smego","dziewi\x81\xb9tego",
"dziesi\x81\xb9tego","jedenastego","dwunastego","trzynastego",
"czternastego","pi\x81\xeatnastego","szestnastego","siedemnastego",
"osiemnastego","dziewietnastego","dwudziestego",
"dwudziestego pierwszego","dwudziestego drugiego",
"dwudziestego trzeczego","dwudziestego czwartego",
"dwudziestego pi\x81\xb9tego","dwudziestego sz\x81\xf3stego",
"dwudziestego si\x81\xf3dmego","dwudziestego \x81\xf3smego",
"dwudziestego dziewi\x81\xb9tego","trzydziestego",
"trzydziestego pierwszego"]];
$$d{"now"} =["dzisaj","teraz"];
$$d{"last"} =["ostatni","ostatna"];
$$d{"each"} =["kazdy","ka\x81\xbfdy", "kazdym","ka\x81\xbfdym"];
$$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
"przyszly","przysz\x81\xb3y","przyszlym",
$$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
$$d{"exact"} =["doklandnie","dok\x81\xb3andnie"];
$$d{"approx"} =["w przyblizeniu","w przybli\x81\xbfeniu","mniej wiecej",
"mniej wi\x81\xeacej","okolo","oko\x81\xb3o"];
$$d{"business"}=["sluzbowy","s\x81\xb3u\x81\xbfbowy","sluzbowym",
"s\x81\xb3u\x81\xbfbowym"];
$$d{"times"} =["po\x81\xb3udnie","12:00:00",
"p\x81\xf3\x81\xb3noc","00:00:00",
"poludnie","12:00:00","polnoc","00:00:00"];
$$d{"offset"} =["wczoraj","-0:0:1:0:0:0","jutro","+0:0:1:0:0:0"];
$$d{"years"} =["rok","lat","lata","latach"];
$$d{"months"} =["m.","miesiac","miesi\x81\xb9c","miesiecy",
"miesi\x81\xeacy","miesiacu","miesi\x81\xb9cu"];
$$d{"weeks"} =["ty.","tydzien","tydzie\x81\xf1","tygodniu"];
$$d{"days"} =["d.","dzien","dzie\x81\xf1","dni"];
$$d{"hours"} =["g.","godzina","godziny","godzinie"];
$$d{"minutes"} =["mn.","min.","minut","minuty"];
$$d{"seconds"} =["s.","sekund","sekundy"];
$$d{"replace"} =["m.","miesiac"];
$$d{"am"} = ["AM","A.M."];
$$d{"pm"} = ["PM","P.M."];
print "DEBUG: Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
[["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
"Septiembre","Octubre","Noviembre","Diciembre"]];
[["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
[["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
[["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
[["L","Ma","Mi","J","V","S","D"]];
[["1o","2o","3o","4o","5o","6o","7o","8o","9o","10o",
"11o","12o","13o","14o","15o","16o","17o","18o","19o","20o",
"21o","22o","23o","24o","25o","26o","27o","28o","29o","30o","31o"],
["1a","2a","3a","4a","5a","6a","7a","8a","9a","10a",
"11a","12a","13a","14a","15a","16a","17a","18a","19a","20a",
"21a","22a","23a","24a","25a","26a","27a","28a","29a","30a","31a"]];
[["Primero","Segundo","Tercero","Cuarto","Quinto","Sexto","Septimo",
"Octavo","Noveno","Decimo","Decimo Primero","Decimo Segundo",
"Decimo Tercero","Decimo Cuarto","Decimo Quinto","Decimo Sexto",
"Decimo Septimo","Decimo Octavo","Decimo Noveno","Vigesimo",
"Vigesimo Primero","Vigesimo Segundo","Vigesimo Tercero",
"Vigesimo Cuarto","Vigesimo Quinto","Vigesimo Sexto",
"Vigesimo Septimo","Vigesimo Octavo","Vigesimo Noveno","Trigesimo",
["Primera","Segunda","Tercera","Cuarta","Quinta","Sexta","Septima",
"Octava","Novena","Decima","Decimo Primera","Decimo Segunda",
"Decimo Tercera","Decimo Cuarta","Decimo Quinta","Decimo Sexta",
"Decimo Septima","Decimo Octava","Decimo Novena","Vigesima",
"Vigesimo Primera","Vigesimo Segunda","Vigesimo Tercera",
"Vigesimo Cuarta","Vigesimo Quinta","Vigesimo Sexta",
"Vigesimo Septima","Vigesimo Octava","Vigesimo Novena","Trigesima",
$$d{"now"} =["Hoy","Ahora"];
$$d{"next"} =["siguiente"];
$$d{"prev"} =["anterior"];
$$d{"exact"} =["exactamente"];
$$d{"approx"} =["aproximadamente"];
$$d{"business"}=["laborales"];
$$d{"offset"} =["ayer","-0:0:0:1:0:0:0","manana","+0:0:0:1:0:0:0"];
$$d{"times"} =["mediodia","12:00:00","medianoche","00:00:00"];
$$d{"years"} =["a","ano","ano","anos","anos"];
$$d{"months"} =["m","mes","mes","meses"];
$$d{"weeks"} =["sem","semana","semana","semanas"];
$$d{"days"} =["d","dia","dias"];
$$d{"hours"} =["hr","hrs","hora","horas"];
$$d{"minutes"} =["min","min","minuto","minutos"];
$$d{"seconds"} =["s","seg","segundo","segundos"];
$$d{"replace"} =["m","mes"];
$$d{"am"} = ["AM","A.M."];
$$d{"pm"} = ["PM","P.M."];
sub Date_Init_Portuguese
{
print "DEBUG: Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
[["Janeiro","Fevereiro","Marco","Abril","Maio","Junho",
"Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"],
["Janeiro","Fevereiro","Mar${c}o","Abril","Maio","Junho",
"Julho","Agosto","Setembro","Outubro","Novembro","Dezembro"]];
[["Jan","Fev","Mar","Abr","Mai","Jun",
"Jul","Ago","Set","Out","Nov","Dez"]];
[["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
[["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
[["Sg","T","Qa","Qi","Sx","Sb","D"]];
[["1${o}","2${o}","3${o}","4${o}","5${o}","6${o}","7${o}","8${o}",
"9${o}","10${o}","11${o}","12${o}","13${o}","14${o}","15${o}",
"16${o}","17${o}","18${o}","19${o}","20${o}","21${o}","22${o}",
"23${o}","24${o}","25${o}","26${o}","27${o}","28${o}","29${o}",
[["primeiro","segundo","terceiro","quarto","quinto","sexto","setimo",
"oitavo","nono","decimo","decimo primeiro","decimo segundo",
"decimo terceiro","decimo quarto","decimo quinto","decimo sexto",
"decimo setimo","decimo oitavo","decimo nono","vigesimo",
"vigesimo primeiro","vigesimo segundo","vigesimo terceiro",
"vigesimo quarto","vigesimo quinto","vigesimo sexto","vigesimo setimo",
"vigesimo oitavo","vigesimo nono","trigesimo","trigesimo primeiro"],
["primeiro","segundo","terceiro","quarto","quinto","sexto","s${e}timo",
"oitavo","nono","d${e}cimo","d${e}cimo primeiro","d${e}cimo segundo",
"d${e}cimo terceiro","d${e}cimo quarto","d${e}cimo quinto",
"d${e}cimo sexto","d${e}cimo s${e}timo","d${e}cimo oitavo",
"d${e}cimo nono","vig${e}simo","vig${e}simo primeiro",
"vig${e}simo segundo","vig${e}simo terceiro","vig${e}simo quarto",
"vig${e}simo quinto","vig${e}simo sexto","vig${e}simo s${e}timo",
"vig${e}simo oitavo","vig${e}simo nono","trig${e}simo",
"trig${e}simo primeiro"]];
$$d{"now"} =["agora","hoje"];
$$d{"last"} =["${u}ltimo","ultimo"];
$$d{"at"} =["as","${a2}s"];
$$d{"past"} =["a","${a2}"];
$$d{"next"} =["proxima","proximo","pr${o2}xima","pr${o2}ximo"];
$$d{"prev"} =["ultima","ultimo","${u}ltima","${u}ltimo"];
$$d{"later"} =["passadas","passados"];
$$d{"exact"} =["exactamente"];
$$d{"approx"} =["aproximadamente"];
$$d{"business"}=["util","uteis"];
$$d{"offset"} =["ontem","-0:0:0:1:0:0:0",
"amanha","+0:0:0:1:0:0:0","amanh${a3}","+0:0:0:1:0:0:0"];
$$d{"times"} =["meio-dia","12:00:00","meia-noite","00:00:00"];
$$d{"years"} =["anos","ano","ans","an","a"];
$$d{"months"} =["meses","m${e2}s","mes","m"];
$$d{"weeks"} =["semanas","semana","sem","sems","s"];
$$d{"days"} =["dias","dia","d"];
$$d{"hours"} =["horas","hora","hr","hrs"];
$$d{"minutes"} =["minutos","minuto","min","mn"];
$$d{"seconds"} =["segundos","segundo","seg","sg"];
$$d{"replace"} =["m","mes","s","sems"];
$$d{"am"} = ["AM","A.M."];
$$d{"pm"} = ["PM","P.M."];
print "DEBUG: Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
["\xd1\xce\xd7\xc1\xd2\xd1","\xc6\xc5\xd7\xd2\xc1\xcc\xd1",
"\xcd\xc1\xd2\xd4\xc1","\xc1\xd0\xd2\xc5\xcc\xd1","\xcd\xc1\xd1",
"\xc9\xc0\xcc\xd1","\xc1\xd7\xc7\xd5\xd3\xd4\xc1",
"\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd1","\xcf\xcb\xd4\xd1\xc2\xd2\xd1",
"\xce\xcf\xd1\xc2\xd2\xd1","\xc4\xc5\xcb\xc1\xc2\xd2\xd1"],
["\xd1\xce\xd7\xc1\xd2\xd8","\xc6\xc5\xd7\xd2\xc1\xcc\xd8",
"\xcd\xc1\xd2\xd4","\xc1\xd0\xd2\xc5\xcc\xd8","\xcd\xc1\xca",
"\xc9\xc0\xcc\xd8","\xc1\xd7\xc7\xd5\xd3\xd4",
"\xd3\xc5\xce\xd4\xd1\xc2\xd2\xd8","\xcf\xcb\xd4\xd1\xc2\xd2\xd8",
"\xce\xcf\xd1\xc2\xd2\xd8","\xc4\xc5\xcb\xc1\xc2\xd2\xd8"]
[["\xd1\xce\xd7","\xc6\xc5\xd7","\xcd\xd2\xd4","\xc1\xd0\xd2",
"\xcd\xc1\xca","\xc9\xc0\xce",
"\xc9\xc0\xcc","\xc1\xd7\xc7","\xd3\xce\xd4","\xcf\xcb\xd4",
"\xce\xcf\xd1\xc2","\xc4\xc5\xcb"],
["","\xc6\xd7\xd2","","","\xcd\xc1\xd1","",
"","","\xd3\xc5\xce","\xcf\xcb\xd4","\xce\xcf\xd1",""]];
[["\xd0\xcf\xce\xc5\xc4\xc5\xcc\xd8\xce\xc9\xcb",
"\xd7\xd4\xcf\xd2\xce\xc9\xcb","\xd3\xd2\xc5\xc4\xc1",
"\xde\xc5\xd4\xd7\xc5\xd2\xc7","\xd0\xd1\xd4\xce\xc9\xc3\xc1",
"\xd3\xd5\xc2\xc2\xcf\xd4\xc1",
"\xd7\xcf\xd3\xcb\xd2\xc5\xd3\xc5\xce\xd8\xc5"]];
[["\xd0\xce\xc4","\xd7\xd4\xd2","\xd3\xd2\xc4","\xde\xd4\xd7",
"\xd0\xd4\xce","\xd3\xd5\xc2","\xd7\xd3\xcb"],
["\xd0\xcf\xce","\xd7\xd4\xcf","\xd3\xd2e","\xde\xc5\xd4",
"\xd0\xd1\xd4","\xd3\xd5\xc2","\xd7\xcf\xd3\xcb"]];
[["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
[["1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ",
"11 ","12 ","13 ","14 ","15 ","16 ","17 ","18 ","19 ","20 ",
"21 ","22 ","23 ","24 ","25 ","26 ","27 ","28 ","29 ","30 ",
[["\xd0\xc5\xd2\xd7\xd9\xca","\xd7\xd4\xcf\xd2\xcf\xca",
"\xd4\xd2\xc5\xd4\xc9\xca","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
"\xd0\xd1\xd4\xd9\xca","\xdb\xc5\xd3\xd4\xcf\xca",
"\xd3\xc5\xc4\xd8\xcd\xcf\xca","\xd7\xcf\xd3\xd8\xcd\xcf\xca",
"\xc4\xc5\xd7\xd1\xd4\xd9\xca","\xc4\xc5\xd3\xd1\xd4\xd9\xca",
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xc4\xd7\xc5\xce\xc1\xc4\xde\xc1\xd4\xd9\xca",
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd9\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xc9\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xd9\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xd9\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xca",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xd9\xca",
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd9\xca",
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xd9\xca"],
["\xd0\xc5\xd2\xd7\xcf\xc5","\xd7\xd4\xcf\xd2\xcf\xc5",
"\xd4\xd2\xc5\xd4\xd8\xc5","\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
"\xd0\xd1\xd4\xcf\xc5","\xdb\xc5\xd3\xd4\xcf\xc5",
"\xd3\xc5\xc4\xd8\xcd\xcf\xc5","\xd7\xcf\xd3\xd8\xcd\xcf\xc5",
"\xc4\xc5\xd7\xd1\xd4\xcf\xc5","\xc4\xc5\xd3\xd1\xd4\xcf\xc5",
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc5",
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc5",
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc5"],
["\xd0\xc5\xd2\xd7\xcf\xc7\xcf","\xd7\xd4\xcf\xd2\xcf\xc7\xcf",
"\xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
"\xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf","\xd0\xd1\xd4\xcf\xc7\xcf",
"\xdb\xc5\xd3\xd4\xcf\xc7\xcf","\xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
"\xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
"\xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf","\xc4\xc5\xd3\xd1\xd4\xcf\xc7\xcf",
"\xcf\xc4\xc9\xce\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xc4\xd7\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xd4\xd2\xc5\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xde\xc5\xd4\xd9\xd2\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xd0\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xdb\xc5\xd3\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xd7\xcf\xd3\xc5\xcd\xd8\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xc4\xc5\xd7\xd1\xd4\xce\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xd4\xcf\xd2\xcf\xc5",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd4\xd2\xc5\xd4\xd8\xc5\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xde\xc5\xd4\xd7\xc5\xd2\xd4\xcf\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd0\xd1\xd4\xcf\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xdb\xc5\xd3\xd4\xcf\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd3\xc5\xc4\xd8\xcd\xcf\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xd7\xcf\xd3\xd8\xcd\xcf\xc7\xcf",
"\xc4\xd7\xc1\xc4\xc3\xc1\xd4\xd8 \xc4\xc5\xd7\xd1\xd4\xcf\xc7\xcf",
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xcf\xc7\xcf",
"\xd4\xd2\xc9\xc4\xc3\xc1\xd4\xd8 \xd0\xc5\xd2\xd7\xcf\xc7\xcf"]];
$$d{"now"} =["\xd3\xc5\xc7\xcf\xc4\xce\xd1","\xd3\xc5\xca\xde\xc1\xd3"];
$$d{"last"} =["\xd0\xcf\xd3\xcc\xc5\xc4\xce\xc9\xca"];
$$d{"each"} =["\xcb\xc1\xd6\xc4\xd9\xca"];
$$d{"future"} =["\xd7\xd0\xc5\xd2\xc5\xc4 \xce\xc1"];
$$d{"past"} =["\xce\xc1\xda\xc1\xc4 \xce\xc1 "];
$$d{"next"} =["\xd3\xcc\xc5\xc4\xd5\xc0\xdd\xc9\xca"];
$$d{"prev"} =["\xd0\xd2\xc5\xc4\xd9\xc4\xd5\xdd\xc9\xca"];
$$d{"later"} =["\xd0\xcf\xda\xd6\xc5"];
$$d{"exact"} =["\xd4\xcf\xde\xce\xcf"];
$$d{"approx"} =["\xd0\xd2\xc9\xcd\xc5\xd2\xce\xcf"];
$$d{"business"}=["\xd2\xc1\xc2\xcf\xde\xc9\xc8"];
$$d{"offset"} =["\xd0\xcf\xda\xc1\xd7\xde\xc5\xd2\xc1","-0:0:0:2:0:0:0",
"\xd7\xde\xc5\xd2\xc1","-0:0:0:1:0:0:0",
"\xda\xc1\xd7\xd4\xd2\xc1","+0:0:0:1:0:0:0",
"\xd0\xcf\xd3\xcc\xc5\xda\xc1\xd7\xd4\xd2\xc1",
$$d{"times"} =["\xd0\xcf\xcc\xc4\xc5\xce\xd8","12:00:00",
"\xd0\xcf\xcc\xce\xcf\xde\xd8","00:00:00"];
$$d{"years"} =["\xc7","\xc7\xc4","\xc7\xcf\xc4","\xcc\xc5\xd4",
"\xcc\xc5\xd4","\xc7\xcf\xc4\xc1"];
$$d{"months"} =["\xcd\xc5\xd3","\xcd\xc5\xd3\xd1\xc3",
"\xcd\xc5\xd3\xd1\xc3\xc5\xd7"];
$$d{"weeks"} =["\xce\xc5\xc4\xc5\xcc\xd1","\xce\xc5\xc4\xc5\xcc\xd8",
"\xce\xc5\xc4\xc5\xcc\xc9","\xce\xc5\xc4\xc5\xcc\xc0"];
$$d{"days"} =["\xc4","\xc4\xc5\xce\xd8","\xc4\xce\xc5\xca",
$$d{"hours"} =["\xde","\xde.","\xde\xd3","\xde\xd3\xd7","\xde\xc1\xd3",
"\xde\xc1\xd3\xcf\xd7","\xde\xc1\xd3\xc1"];
$$d{"minutes"} =["\xcd\xce","\xcd\xc9\xce","\xcd\xc9\xce\xd5\xd4\xc1",
$$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
"\xd3\xc5\xcb\xd5\xce\xc4"];
$$d{"sepss"} ="[:.\xd3]";
$$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
"\xc4\xcf \xd0\xcf\xcc\xd5\xc4\xce\xd1"];
$$d{"pm"} = ["\xd0\xd0","\xf0\xf0","\xf0.\xf0.","\xc4\xce\xd1",
"\xd7\xc5\xde\xc5\xd2\xc1",
"\xd0\xcf\xd3\xcc\xc5 \xd0\xcf\xcc\xd5\xc4\xce\xd1",
"\xd0\xcf \xd0\xcf\xcc\xd5\xc4\xce\xc0"];
print "DEBUG: Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
["ocak","subat","mart","nisan","mayis","haziran",
"temmuz","agustos","eylul","ekim","kasim","aralik"],
["ocak","\xfeubat","mart","nisan","may\xfds","haziran",
"temmuz","a\xf0ustos","eyl\xfcl","ekim","kas\xfdm","aral\xfdk"]
["oca","sub","mar","nis","may","haz",
"tem","agu","eyl","eki","kas","ara"],
["oca","\xfeub","mar","nis","may","haz",
"tem","a\xf0u","eyl","eki","kas","ara"]
["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
["pzt","sal","car","per","cum","cts","paz"],
["pzt","sal","\xe7ar","per","cum","cts","paz"],
[["Pt","S","Cr","Pr","C","Ct","P"],
["Pt","S","\xc7","Pr","C","Ct","P"]];
[[ "1.", "2.", "3.", "4.", "5.", "6.", "7.", "8.", "9.", "10.",
"11.", "12.", "13.", "14.", "15.", "16.", "17.", "18.", "19.", "20.",
"21.", "22.", "23.", "24.", "25.", "26.", "27.", "28.", "29.", "30.",
["birinci","ikinci","ucuncu","dorduncu",
"besinci","altinci","yedinci","sekizinci",
"dokuzuncu","onuncu","onbirinci","onikinci",
"onbesinci","onaltinci","onyedinci","onsekizinci",
"ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
"yirmiucuncu","yirmidorduncu",
"yirmibesinci","yirmialtinci","yirmiyedinci","yirmisekizinci",
"yirmidokuzuncu","otuzuncu","otuzbirinci"],
["birinci","ikinci","\xfc\xe7\xfcnc\xfc","d\xf6rd\xfcnc\xfc",
"be\xfeinci","alt\xfdnc\xfd","yedinci","sekizinci",
"dokuzuncu","onuncu","onbirinci","onikinci",
"on\xfc\xe7\xfcnc\xfc","ond\xf6rd\xfcnc\xfc",
"onbe\xfeinci","onalt\xfdnc\xfd","onyedinci","onsekizinci",
"ondokuzuncu","yirminci","yirmibirinci","yirmikinci",
"yirmi\xfc\xe7\xfcnc\xfc","yirmid\xf6rd\xfcnc\xfc",
"yirmibe\xfeinci","yirmialt\xfdnc\xfd","yirmiyedinci","yirmisekizinci",
"yirmidokuzuncu","otuzuncu","otuzbirinci"]
$$d{"now"} =["\xfeimdi", "simdi", "bugun","bug\xfcn"];
$$d{"last"} =["son", "sonuncu"];
$$d{"future"} =["gelecek"];
$$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
$$d{"next"} =["gelecek","sonraki"];
$$d{"prev"} =["onceki","\xf6nceki"];
$$d{"approx"} =["yakla\xfe\xfdk", "yaklasik"];
$$d{"business"}=["i\xfe","\xe7al\xfd\xfema","is", "calisma"];
$$d{"offset"} =["d\xfcn","-0:0:0:1:0:0:0",
"yar\xfdn","+0:0:0:1:0:0:0",
"yarin","+0:0:0:1:0:0:0"];
$$d{"times"} =["\xf6\xf0len","12:00:00",
"gece yar\xfds\xfd","00:00:00",
"gece yarisi","00:00:00"];
$$d{"years"} =["yil","y"];
$$d{"months"} =["ay","a"];
$$d{"weeks"} =["hafta", "h"];
$$d{"days"} =["gun","g"];
$$d{"minutes"} =["dakika","dak","d"];
$$d{"seconds"} =["saniye","sn",];
$$d{"replace"} =["s","saat"];
$$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
$$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
print "DEBUG: Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
[["Januar","Februar","Marts","April","Maj","Juni",
"Juli","August","September","Oktober","November","December"]];
[["Jan","Feb","Mar","Apr","Maj","Jun",
"Jul","Aug","Sep","Okt","Nov","Dec"]];
[["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
[["Man","Tis","Ons","Tor","Fre","Lor","Son"],
["Man","Tis","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
[["M","Ti","O","To","F","L","S"]];
[["1:e","2:e","3:e","4:e","5:e","6:e","7:e","8:e","9:e","10:e",
"11:e","12:e","13:e","14:e","15:e","16:e","17:e","18:e","19:e","20:e",
"21:e","22:e","23:e","24:e","25:e","26:e","27:e","28:e","29:e","30:e",
[["forste","anden","tredie","fjerde","femte","sjette","syvende",
"ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
"femtende","sekstende","syttende","attende","nittende","tyvende",
"enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
"seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
"tredivte","enogtredivte"],
["f\xf8rste","anden","tredie","fjerde","femte","sjette","syvende",
"ottende","niende","tiende","elfte","tolvte","trettende","fjortende",
"femtende","sekstende","syttende","attende","nittende","tyvende",
"enogtyvende","toogtyvende","treogtyvende","fireogtyvende","femogtyvende",
"seksogtyvende","syvogtyvende","otteogtyvende","niogtyvende",
"tredivte","enogtredivte"]];
$$d{"now"} =["idag","nu"];
$$d{"last"} =["forrige","sidste","nyeste"];
$$d{"at"} =["kl","kl.","klokken"];
$$d{"on"} =["pa","p\xe5"];
$$d{"next"} =["nasta","n\xe6ste"];
$$d{"prev"} =["forrige"];
$$d{"later"} =["senere"];
$$d{"exact"} =["pracist","pr\xe6cist"];
$$d{"approx"} =["circa"];
$$d{"business"}=["arbejdsdag","arbejdsdage"];
$$d{"offset"} =["ig\xe5r","-0:0:0:1:0:0:0","igar","-0:0:0:1:0:0:0",
"imorgen","+0:0:0:1:0:0:0"];
$$d{"times"} =["midt pa dagen","12:00:00","midt p\xe5 dagen","12:00:00",
$$d{"years"} =["ar","\xe5r"];
$$d{"months"} =["man","maned","maneder","m\xe5n","m\xe5ned","m\xe5neder"];
$$d{"weeks"} =["u","uge","uger"];
$$d{"days"} =["d","dag","dage"];
$$d{"hours"} =["t","tim","time","timer"];
$$d{"minutes"} =["min","minut","minutter"];
$$d{"seconds"} =["s","sek","sekund","sekunder"];
$$d{"replace"} =["m","minut"];
########################################################################
# FROM MY PERSONAL LIBRARIES
########################################################################
# &ModuloAddition($N,$add,\$val,\$rem);
# This calculates $val=$val+$add and forces $val to be in a certain range.
# This is useful for adding numbers for which only a certain range is
# allowed (for example, minutes can be between 0 and 59 or months can be
# between 1 and 12). The absolute value of $N determines the range and
# the sign of $N determines whether the range is 0 to N-1 (if N>0) or
# 1 to N (N<0). The remainder (as modulo N) is added to $rem.
# To add 2 hours together (with the excess returned in days) use:
# &ModuloAddition(60,$s1,\$s,\$day);
my($N,$add,$val,$rem)=@_;
$$rem+= int(($$val-1)/$N);
$$rem-= int(-$$val/$N)+1;
$$val = $N-(-$$val % $N);
$$rem-= int(-($$val+1)/$N)+1;
$$val = ($N-1)-(-($$val+1)%$N);
# $Flag=&IsInt($String [,$low, $high]);
# Returns 1 if $String is a valid integer, 0 otherwise. If $low is
# entered, $String must be >= $low. If $high is entered, $String must
# be <= $high. It is valid to check only one of the bounds.
return 0 if (! defined $N or
$N !~ /^\s*[-+]?\d+\s*$/ or
defined $low && $N<$low or
defined $high && $N>$high);
# $Pos=&SinLindex(\@List,$Str [,$offset [,$CaseInsensitive]]);
# Searches for an exact string in a list.
# This is similar to RinLindex except that it searches for elements
# which are exactly equal to $Str (possibly case insensitive).
my($listref,$Str,$offset,$Insensitive)=@_;
return -2 if ($len<0 or ! $Str);
return -1 if (&Index_First
(\
$offset,$len));
$Str=uc($Str) if ($Insensitive);
for ($i=$offset; $i<=$len; $i++) {
$tmp=uc($tmp) if ($Insensitive);
return $i if ($tmp eq $Str);
$$offsetref=0 if (! $$offsetref);
$$offsetref=0 if ($$offsetref < 0);
return -1 if ($$offsetref > $max);
# $File=&CleanFile($file);
# This cleans up a path to remove the following things:
# double slash /a//b -> /a/b
# trailing dot /a/. -> /a
$file =~ s
|//+|/|g
; # multiple slash
$file =~ s
|/\.$|/|; # trailing /. (leaves trailing slash)
$file =~ s
|^\
./|| # leading ./
$file =~ s
|/$|| # trailing slash
# $File=&ExpandTilde($file);
# This checks to see if a "~" appears as the first character in a path.
# If it does, the "~" expansion is interpreted (if possible) and the full
# path is returned. If a "~" expansion is used but cannot be
# interpreted, an empty string is returned.
# This is Windows/Mac friendly.
if ($file =~ s
|^~([^/]*)||) {
# Single user operating systems (Mac, MSWindows) don't have the getpwnam
# and getpwuid routines defined. Try to catch various different ways
# of knowing we are on one of these systems:
return "" if ($OS eq "Windows" or
$user="" if (! defined $user);
$home= (getpwnam($user))[7];
$home= (getpwuid($<))[7];
$home = VMS
::Filespec
::unixpath
($home) if ($OS eq "VMS");
# $File=&FullFilePath($file);
# Returns the full or relative path to $file (expanding "~" if necessary).
# Returns an empty string if a "~" expansion cannot be interpreted. The
# path does not need to exist. CleanFile is called.
my($rootpat) = '^/'; #default pattern to match absolute path
$rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
$file=&ExpandTilde
($file);
return &CleanFile
($file);
# $Flag=&CheckFilePath($file [,$mode]);
# Checks to see if $file exists, to see what type it is, and whether
# the script can access it. If it exists and has the correct mode, 1
# $mode is a string which may contain any of the valid file test operator
# characters except t, M, A, C. The appropriate test is run for each
# character. For example, if $mode is "re" the -r and -e tests are both
# An empty string is returned if the file doesn't exist. A 0 is returned
# if the file exists but any test fails.
# All characters in $mode which do not correspond to valid tests are
$file=&FullFilePath
($file);
$mode = "" if (! defined $mode);
return 0 if (! defined $file or ! $file);
return 0 if (( ! -e
$file) or
($mode =~ /r/ && ! -r
$file) or
($mode =~ /w/ && ! -w
$file) or
($mode =~ /x/ && ! -x
$file) or
($mode =~ /R/ && ! -R
$file) or
($mode =~ /W/ && ! -W
$file) or
($mode =~ /X/ && ! -X
$file) or
($mode =~ /o/ && ! -o
$file) or
($mode =~ /O/ && ! -O
$file) or
($mode =~ /z/ && ! -z
$file) or
($mode =~ /s/ && ! -s
$file) or
($mode =~ /f/ && ! -f
$file) or
($mode =~ /d/ && ! -d
$file) or
($mode =~ /l/ && ! -l
$file) or
($mode =~ /s/ && ! -s
$file) or
($mode =~ /p/ && ! -p
$file) or
($mode =~ /b/ && ! -b
$file) or
($mode =~ /c/ && ! -c
$file) or
($mode =~ /u/ && ! -u
$file) or
($mode =~ /g/ && ! -g
$file) or
($mode =~ /k/ && ! -k
$file) or
($mode =~ /T/ && ! -T
$file) or
($mode =~ /B/ && ! -B
$file));
# $Path=&FixPath($path [,$full] [,$mode] [,$error]);
# Makes sure that every directory in $path (a colon separated list of
# directories) appears as a full path or relative path. All "~"
# expansions are removed. All trailing slashes are removed also. If
# $full is non-nil, relative paths are expanded to full paths as well.
# If $mode is given, it may be either "e", "r", or "w". In this case,
# additional checking is done to each directory. If $mode is "e", it
# need ony exist to pass the check. If $mode is "r", it must have have
# read and execute permission. If $mode is "w", it must have read,
# write, and execute permission.
# The value of $error determines what happens if the directory does not
# pass the test. If it is non-nil, if any directory does not pass the
# test, the subroutine returns the empty string. Otherwise, it is simply
# The corrected path is returned.
my($path,$full,$mode,$err)=@_;
my(@dir)=split(/$Cnf{"PathSep"}/,$path);
$full=0 if (! defined $full);
$mode="" if (! defined $mode);
$err=0 if (! defined $err);
if (! $mode or &CheckFilePath
($_,$mode)) {
$path .= $Cnf{"PathSep"} . $_;
$path =~ s/^$Cnf{"PathSep"}//;
# $File=&SearchPath($file,$path [,$mode] [,@suffixes]);
# Searches through directories in $path for a file named $file. The
# full path is returned if one is found, or an empty string otherwise.
# The file may exist with one of the @suffixes. The mode is checked
# similar to &CheckFilePath.
# The first full path that matches the name and mode is returned. If none
# is found, an empty string is returned.
my($file,$path,$mode,@suff)=@_;
my($f,$s,$d,@dir,$fs)=();
$path=&FixPath
($path,1,"r");
@dir=split(/$Cnf{"PathSep"}/,$path);
return $f if (&CheckFilePath
($f,$mode));
return $fs if (&CheckFilePath
($fs,$mode));
# @list=&ReturnList($str);
# This takes a string which should be a comma separated list of integers
# or ranges (5-7). It returns a sorted list of all integers referred to
# by the string, or () if there is an invalid element.
# Negative integers are also handled. "-2--1" is equivalent to "-2,-1".
my(@ret,@str,$from,$to,$tmp)=();
if ($str =~ /^[-+]?\d+$/) {
} elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {