--- a/dummy_foundation/lib/Date/Manip.pm Wed Jun 03 18:33:51 2009 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,7362 +0,0 @@
-package Date::Manip;
-# 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="Unix";
-$OS="Windows" if ((defined $^O and
- $^O =~ /MSWin32/i ||
- $^O =~ /Windows_95/i ||
- $^O =~ /Windows_NT/i) ||
- (defined $ENV{OS} and
- $ENV{OS} =~ /MSWin32/i ||
- $ENV{OS} =~ /Windows_95/i ||
- $ENV{OS} =~ /Windows_NT/i));
-$OS="Netware" if (defined $^O and
- $^O =~ /NetWare/i);
-$OS="Mac" if ((defined $^O and
- $^O =~ /MacOS/i) ||
- (defined $ENV{OS} and
- $ENV{OS} =~ /MacOS/i));
-$OS="MPE" if (defined $^O and
- $^O =~ /MPE/i);
-$OS="OS2" if (defined $^O and
- $^O =~ /os2/i);
-$OS="VMS" if (defined $^O and
- $^O =~ /VMS/i);
-
-# Determine if we're doing taint checking
-$Date::Manip::NoTaint = eval { local $^W; unlink "$^X$^T"; 1 };
-
-###########################################################################
-# CUSTOMIZATION
-###########################################################################
-#
-# 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{"GlobalCnf"}="";
-$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=();
-if ($OS eq "Windows") {
- $Cnf{"PathSep"} = ";";
- $Cnf{"PersonalCnf"} = "Manip.cnf";
- $Cnf{"PersonalCnfPath"} = ".";
-
-} elsif ($OS eq "Netware") {
- $Cnf{"PathSep"} = ";";
- $Cnf{"PersonalCnf"} = "Manip.cnf";
- $Cnf{"PersonalCnfPath"} = ".";
-
-} elsif ($OS eq "MPE") {
- $Cnf{"PathSep"} = ":";
- $Cnf{"PersonalCnf"} = "Manip.cnf";
- $Cnf{"PersonalCnfPath"} = ".";
-
-} elsif ($OS eq "OS2") {
- $Cnf{"PathSep"} = ":";
- $Cnf{"PersonalCnf"} = "Manip.cnf";
- $Cnf{"PersonalCnfPath"} = ".";
-
-} elsif ($OS eq "Mac") {
- $Cnf{"PathSep"} = ":";
- $Cnf{"PersonalCnf"} = "Manip.cnf";
- $Cnf{"PersonalCnfPath"} = ".";
-
-} elsif ($OS eq "VMS") {
- # VMS doesn't like files starting with "."
- $Cnf{"PathSep"} = "\n";
- $Cnf{"PersonalCnf"} = "Manip.cnf";
- $Cnf{"PersonalCnfPath"} = ".\n~";
-
-} else {
- # Unix
- $Cnf{"PathSep"} = ":";
- $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)
-$Cnf{"DateFormat"}="US";
-
-# Local timezone
-$Cnf{"TZ"}="";
-
-# Timezone to work in (""=local, "IGNORE", or a timezone)
-$Cnf{"ConvTZ"}="";
-
-# Date::Manip internal format (0=YYYYMMDDHH:MN:SS, 1=YYYYHHMMDDHHMNSS)
-$Cnf{"Internal"}=0;
-
-# First day of the week (1=monday, 7=sunday). ISO 8601 says monday.
-$Cnf{"FirstDay"}=1;
-
-# First and last day of the work week (1=monday, 7=sunday)
-$Cnf{"WorkWeekBeg"}=1;
-$Cnf{"WorkWeekEnd"}=5;
-
-# If non-nil, a work day is treated as 24 hours long (WorkDayBeg/WorkDayEnd
-# ignored)
-$Cnf{"WorkDay24Hr"}=0;
-
-# Start and end time of the work day (any time format allowed, seconds
-# ignored)
-$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"
-# first.
-$Cnf{"TomorrowFirst"}=1;
-
-# Erase the old holidays
-$Cnf{"EraseHolidays"}="";
-
-# Set this to non-zero to be produce completely backwards compatible deltas
-$Cnf{"DeltaSigns"}=0;
-
-# If this is 0, use the ISO 8601 standard that Jan 4 is in week 1. If 1,
-# make week 1 contain Jan 1.
-$Cnf{"Jan1Week1"}=0;
-
-# 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.
-$Cnf{"YYtoYYYY"}=89;
-
-# 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.
-$Cnf{"UpdateCurrTZ"}=0;
-
-# Use an international character set.
-$Cnf{"IntCharSet"}=0;
-
-# Use this to force the current date to be set to this:
-$Cnf{"ForceDate"}="";
-
-###########################################################################
-
-require 5.000;
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(
- DateManipVersion
- Date_Init
- ParseDateString
- ParseDate
- ParseRecur
- Date_Cmp
- DateCalc
- ParseDateDelta
- UnixDate
- Delta_Format
- Date_GetPrev
- Date_GetNext
- Date_SetTime
- Date_SetDateField
- Date_IsHoliday
- Events_List
-
- Date_DaysInMonth
- Date_DayOfWeek
- Date_SecsSince1970
- Date_SecsSince1970GMT
- Date_DaysSince1BC
- Date_DayOfYear
- Date_DaysInYear
- Date_WeekOfYear
- Date_LeapYear
- Date_DaySuffix
- Date_ConvTZ
- Date_TimeZone
- Date_IsWorkDay
- Date_NextWorkDay
- Date_PrevWorkDay
- Date_NearestWorkDay
- Date_NthDayOfYear
-);
-use strict;
-use integer;
-use Carp;
-
-use IO::File;
-
-$VERSION="5.42";
-
-########################################################################
-########################################################################
-
-$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;
-$Curr{"Debug"} = "";
-$Curr{"DebugVal"} = "";
-
-$Holiday{"year"} = 0;
-$Holiday{"dates"} = {};
-$Holiday{"desc"} = {};
-
-$Events{"raw"} = [];
-$Events{"parsed"} = 0;
-$Events{"dates"} = [];
-$Events{"recur"} = [];
-
-########################################################################
-########################################################################
-# THESE ARE THE MAIN ROUTINES
-########################################################################
-########################################################################
-
-# Get rid of a problem with old versions of perl
-no strict "vars";
-# This sorts from longest to shortest element
-sub sortByLength {
- return (length $b <=> length $a);
-}
-use strict "vars";
-
-sub DateManipVersion {
- print "DEBUG: DateManipVersion\n" if ($Curr{"Debug"} =~ /trace/);
- return $VERSION;
-}
-
-sub Date_Init {
- print "DEBUG: Date_Init\n" if ($Curr{"Debug"} =~ /trace/);
- $Curr{"Debug"}="";
-
- my(@args)=@_;
- $Curr{"InitDone"}=1;
- local($_)=();
- my($internal,$firstday)=();
- my($var,$val,$file,@tmp)=();
-
- # InitFilesRead = 0 : no conf files read yet
- # 1 : global read, no personal read
- # 2 : personal read
-
- $Cnf{"EraseHolidays"}=0;
- foreach (@args) {
- s/\s*$//;
- s/^\s*//;
- /^(\S+) \s* = \s* (.+)$/x;
- ($var,$val)=($1,$2);
- if ($var =~ /^GlobalCnf$/i) {
- $Cnf{"GlobalCnf"}=$val;
- if ($val) {
- $Curr{"InitFilesRead"}=0;
- &EraseHolidays();
- }
- } elsif ($var =~ /^PathSep$/i) {
- $Cnf{"PathSep"}=$val;
- } 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) {
- &EraseHolidays();
- } else {
- push(@tmp,$_);
- }
- }
- @args=@tmp;
-
- # Read global config file
- if ($Curr{"InitFilesRead"}<1 && ! $Cnf{"IgnoreGlobalCnf"}) {
- $Curr{"InitFilesRead"}=1;
-
- if ($Cnf{"GlobalCnf"}) {
- $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);
- }
- }
-
- foreach (@args) {
- s/\s*$//;
- s/^\s*//;
- /^(\S+) \s* = \s* (.*)$/x;
- ($var,$val)=($1,$2);
- $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"});
-
- my(%lang,
- $tmp,%tmp,$tmp2,@tmp2,
- $i,$j,@tmp3,
- $zonesrfc,@zones)=();
-
- my($L)=$Cnf{"Language"};
-
- if ($Curr{"InitLang"}) {
- $Curr{"InitLang"}=0;
-
- if ($L eq "English") {
- &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" ||
- $L eq "Nederlands") {
- &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);
-
- } else {
- confess "ERROR: Unknown language in Date::Manip.\n";
- }
-
- # variables for months
- # Month = "(jan|january|feb|february ... )"
- # MonL = [ "Jan","Feb",... ]
- # MonthL = [ "January","February", ... ]
- # MonthH = { "january"=>1, "jan"=>1, ... }
-
- $Lang{$L}{"MonthH"}={};
- $Lang{$L}{"MonthL"}=[];
- $Lang{$L}{"MonL"}=[];
- &Date_InitLists([$lang{"month_name"},
- $lang{"month_abb"}],
- \$Lang{$L}{"Month"},"lc,sort,back",
- [$Lang{$L}{"MonthL"},
- $Lang{$L}{"MonL"}],
- [$Lang{$L}{"MonthH"},1]);
-
- # variables for day of week
- # Week = "(mon|monday|tue|tuesday ... )"
- # WL = [ "M","T",... ]
- # WkL = [ "Mon","Tue",... ]
- # WeekL = [ "Monday","Tudesday",... ]
- # WeekH = { "monday"=>1,"mon"=>1,"m"=>1,... }
-
- $Lang{$L}{"WeekH"}={};
- $Lang{$L}{"WeekL"}=[];
- $Lang{$L}{"WkL"}=[];
- $Lang{$L}{"WL"}=[];
- &Date_InitLists([$lang{"day_name"},
- $lang{"day_abb"}],
- \$Lang{$L}{"Week"},"lc,sort,back",
- [$Lang{$L}{"WeekL"},
- $Lang{$L}{"WkL"}],
- [$Lang{$L}{"WeekH"},1]);
- &Date_InitLists([$lang{"day_char"}],
- "","lc",
- [$Lang{$L}{"WL"}],
- [\%tmp,1]);
- %{ $Lang{$L}{"WeekH"} } =
- (%{ $Lang{$L}{"WeekH"} },%tmp);
-
- # variables for last
- # Last = "(last)"
- # LastL = [ "last" ]
- # Each = "(each)"
- # EachL = [ "each" ]
- # 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");
-
- $Lang{$L}{"DoMH"}={};
- $Lang{$L}{"DoML"}=[];
- &Date_InitLists([$lang{"num_suff"},
- $lang{"num_word"}],
- \$Lang{$L}{"DoM"},"lc,sort,back,escape",
- [$Lang{$L}{"DoML"},
- \@tmp],
- [$Lang{$L}{"DoMH"},1]);
-
- @tmp=();
- foreach $tmp (keys %{ $Lang{$L}{"DoMH"} }) {
- $tmp2=$Lang{$L}{"DoMH"}{$tmp};
- if ($tmp2<6) {
- $Lang{$L}{"WoMH"}{$tmp} = $tmp2;
- push(@tmp,$tmp);
- }
- }
- foreach $tmp (@{ $Lang{$L}{"LastL"} }) {
- $Lang{$L}{"WoMH"}{$tmp} = -1;
- push(@tmp,$tmp);
- }
- &Date_InitStrings(\@tmp,\$Lang{$L}{"WoM"},
- "lc,sort,back,escape");
-
- # variables for AM or PM
- # AM = "(am)"
- # PM = "(pm)"
- # AmPm = "(am|pm)"
- # AMstr = "AM"
- # PMstr = "PM"
-
- &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"},
- "lc,back,sort,escape");
- $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");
- $Lang{$L}{"Repl"}={};
- &Date_InitHash($lang{"replace"},undef,"lc",$Lang{$L}{"Repl"});
-
- # variables for special dates that are offsets from now
- # Now = "(now|today)"
- # 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
-
- $Lang{$L}{"TimesH"}={};
- &Date_InitHash($lang{"times"},
- \$Lang{$L}{"Times"},"lc,sort,back",
- $Lang{$L}{"TimesH"});
- &Date_InitStrings($lang{"now"},\$Lang{$L}{"Now"},"lc,sort");
- $Lang{$L}{"OffsetH"}={};
- &Date_InitHash($lang{"offset"},
- \$Lang{$L}{"Offset"},"lc,sort,back",
- $Lang{$L}{"OffsetH"});
- $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)
-
- $zonesrfc=
- "idlw -1200 ". # International Date Line West
- "nt -1100 ". # Nome
- "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
- "sat -0400 ". # Chile
- "bot -0400 ". # Bolivia
- "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
- "at -0200 ". # Azores
- "wat -0100 ". # West Africa
- "fnst -0100 ". # Brazil, Fernando de Noronha Daylight
- "gmt +0000 ". # Greenwich Mean
- "ut +0000 ". # Universal
- "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
- "msk +0300 ". # Moscow
- "eat +0300 ". # East Africa
- "it +0330 ". # Iran
- "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
- "javt +0700 ". # Java
- "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
- "z +0000 ".
- "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{"n2o"} = {};
- ($Zone{"zones"},%{ $Zone{"n2o"} })=
- &Date_Regexp($zonesrfc,"sort,lc,under,back",
- "keys");
-
- $tmp=
- "US/Pacific PST8PDT ".
- "US/Mountain MST7MDT ".
- "US/Central CST6CDT ".
- "US/Eastern EST5EDT ".
- "Canada/Pacific PST8PDT ".
- "Canada/Mountain MST7MDT ".
- "Canada/Central CST6CDT ".
- "Canada/Eastern EST5EDT";
-
- $Zone{"tz2z"} = {};
- ($Zone{"tzones"},%{ $Zone{"tz2z"} })=
- &Date_Regexp($tmp,"lc,under,back","keys");
- $Cnf{"TZ"}=&Date_TimeZone;
-
- # misc. variables
- # At = "(?:at)"
- # Of = "(?:in|of)"
- # On = "(?:on)"
- # Future = "(?:in)"
- # Later = "(?:later)"
- # Past = "(?:ago)"
- # Next = "(?:next)"
- # 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");
-
- # calc mode variables
- # Approx = "(?:approximately)"
- # Exact = "(?:exactly)"
- # 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"}) {
- my($h1,$m1,$h2,$m2)=();
- if ($Cnf{"WorkDay24Hr"}) {
- ($Curr{"WDBh"},$Curr{"WDBm"})=(0,0);
- ($Curr{"WDEh"},$Curr{"WDEm"})=(24,0);
- $Curr{"WDlen"}=24*60;
- $Cnf{"WorkDayBeg"}="00:00";
- $Cnf{"WorkDayEnd"}="23:59";
-
- } else {
- 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)
- $h1=$h2-$h1;
- $m1=$m2-$m1;
- if ($m1<0) {
- $h1--;
- $m1+=60;
- }
- $Curr{"WDlen"}=$h1*60+$m1;
- }
- $Curr{"ResetWorkDay"}=0;
- }
-
- # current time
- my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst,$ampm,$wk)=();
- if ($Cnf{"ForceDate"}=~
- /^(\d{4})-(\d{2})-(\d{2})-(\d{2}):(\d{2}):(\d{2})$/) {
- ($y,$m,$d,$h,$mn,$s)=($1,$2,$3,$4,$5,$6);
- } else {
- ($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst)=localtime(time);
- $y+=1900;
- $m++;
- }
- &Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk);
- $Curr{"Y"}=$y;
- $Curr{"M"}=$m;
- $Curr{"D"}=$d;
- $Curr{"H"}=$h;
- $Curr{"Mn"}=$mn;
- $Curr{"S"}=$s;
- $Curr{"AmPm"}=$ampm;
- $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
- # currently in.
- if (wantarray) {
- # Some special variables that have to be in a specific order
- my(@special)=qw(IgnoreGlobalCnf GlobalCnf PersonalCnf PersonalCnfPath);
- my(%tmp)=map { $_,1 } @special;
- my(@tmp,$key,$val);
- foreach $key (@special) {
- $val=$Cnf{$key};
- push(@tmp,"$key=$val");
- }
- foreach $key (keys %Cnf) {
- next if (exists $tmp{$key});
- $val=$Cnf{$key};
- push(@tmp,"$key=$val");
- }
- return @tmp;
- }
- return ();
-}
-
-sub ParseDateString {
- print "DEBUG: ParseDateString\n" if ($Curr{"Debug"} =~ /trace/);
- local($_)=@_;
- return "" if (! $_);
-
- 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($L)=$Cnf{"Language"};
- my($type)=$Cnf{"DateFormat"};
-
- # Mode is set in DateCalc. ParseDate only overrides it if the string
- # contains a mode.
- if ($Lang{$L}{"Exact"} &&
- s/$Lang{$L}{"Exact"}//) {
- $Curr{"Mode"}=0;
- } elsif ($Lang{$L}{"Approx"} &&
- s/$Lang{$L}{"Approx"}//) {
- $Curr{"Mode"}=1;
- } elsif ($Lang{$L}{"Business"} &&
- s/$Lang{$L}{"Business"}//) {
- $Curr{"Mode"}=2;
- } elsif (! exists $Curr{"Mode"}) {
- $Curr{"Mode"}=0;
- }
-
- # 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:
- # 1998010101:00:00
- # 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
- # interpreted as a date.
- #
- # We will insist that the string contain something other than digits and
- # colons so that the following will get correctly interpreted as a date
- # rather than a delta:
- # 12:30
- # 19980101
-
- $delta="";
- $delta=&ParseDateDelta($_) if (/[^:0-9]/);
-
- # Put parse in a simple loop for an easy exit.
- PARSE: {
- my(@tmp)=&Date_Split($_);
- if (@tmp) {
- ($y,$m,$d,$h,$mn,$s)=@tmp;
- last PARSE;
- }
-
- # 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+)';
- # \s*(?:on)\s* or \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))".
- # +0700 +07:00 -07
- '(?:\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";
-
- my($time)="";
- $ampm="";
- $date="";
-
- # Substitute all special time expressions.
- if (/(^|[^a-z])$timeexp($|[^a-z])/i) {
- $tmp=$2;
- $tmp=$Lang{$L}{"TimesH"}{lc($tmp)};
- s/(^|[^a-z])$timeexp($|[^a-z])/$1 $tmp $3/i;
- }
-
- # Remove some punctuation
- s/[,]/ /g;
-
- # Make sure that ...7EST works (i.e. a timezone immediately following
- # a digit.
- s/(\d)$zone(\s+|$|[0-9])/$1 $2$3/i;
- $zone = '\s+'.$zone;
-
- # Remove the time
- $iso=1;
- $midnight=0;
- $from="24${hm}00(?:${ms}00)?";
- $falsefrom="${hm}24${ms}00"; # Don't trap XX:24:00
- $to="00${hm}00${ms}00";
- $midnight=1 if (!/$falsefrom/ && s/$from/$to/);
-
- $h=$mn=$s=0;
- if (/$D$mnsec/i || /$ampmexp/i) {
- $iso=0;
- $tmp=0;
- $tmp=1 if (/$mnsec$zone2?\s*$/i); # or /$mnsec$zone/ ??
- $tmp=0 if (/$ampmexp/i);
- 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 ||
- 0
- ) {
- ($h,$mn,$s,$ampm,$z,$z2)=($2,$3,$4,$5,$6,$7);
- if (defined ($z)) {
- if ($z =~ /^[+-]\d{2}:\d{2}$/) {
- $z=~ s/://;
- } elsif ($z =~ /^[+-]\d{2}$/) {
- $z .= "00";
- }
- }
- $time=1;
- &Date_TimeCheck(\$h,\$mn,\$s,\$ampm);
- $y=$m=$d="";
- # 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.
- $ampm="";
- if (/^\s*$/) {
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- last PARSE;
- }
- }
- }
- $time=0 if ($time ne "1");
- s/\s+$//;
- s/^\s+//;
-
- # dateTtime ISO 8601 formats
- my($orig)=$_;
- s/t$//i if ($iso<0);
-
- # 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) ||
- 0) {
-
- # ISO 8601 dates
- ($_,$z,$z2) = ($1,$2);
- s,-, ,g; # Change all ISO8601 seps to spaces
- s/^\s+//;
- s/\s+$//;
-
- 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 ||
- 0
- ) {
- # ISO 8601 Dates with times
- # YYYYMMDDHHMNSSFFFF...
- # YYYYMMDDHHMNSS
- # YYYYMMDDHHMN
- # YYYYMMDDHH
- # YY MMDDHHMNSSFFFF...
- # YY MMDDHHMNSS
- # YY MMDDHHMN
- # YY MMDDHH
- ($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)) {
- $h=0;
- $midnight=1;
- }
- $z = "" if (! defined $h);
- return "" if ($time && defined $h);
- last PARSE;
-
- } elsif (/^$D4(?:\s*$DD(?:\s*$DD)?)?$/ ||
- /^$DD(?:\s+$DD(?:\s*$DD)?)?$/) {
- # ISO 8601 Dates
- # YYYYMMDD
- # YYYYMM
- # YYYY
- # YY MMDD
- # YY MM
- # YY
- ($y,$m,$d)=($1,$2,$3);
- last PARSE;
-
- } elsif (/^$YY\s+$D\s+$D/) {
- # YY-M-D
- ($y,$m,$d)=($1,$2,$3);
- last PARSE;
-
- } elsif (/^$YY\s*W$DD\s*(\d)?$/i) {
- # YY-W##-D
- ($y,$wofm,$dofw)=($1,$2,$3);
- ($y,$m,$d)=&Date_NthWeekOfYear($y,$wofm,$dofw);
- last PARSE;
-
- } elsif (/^$D4\s*(\d{3})$/ ||
- /^$DD\s*(\d{3})$/) {
- # YYDOY
- ($y,$which)=($1,$2);
- ($y,$m,$d)=&Date_NthDayOfYear($y,$which);
- last PARSE;
-
- } elsif ($iso<0) {
- # We confused something like 1999/August12:00:00
- # with a dateTtime format
- $_=$orig;
-
- } else {
- return "";
- }
- }
-
- # All deltas that are not ISO-8601 dates are NOT dates.
- return "" if ($Curr{"InCalc"} && $delta);
- if ($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) {
- $tmp=0;
-
- if (/^$wom\s*$week$of\s*$month\s*$YY?$/i) {
- # last friday in October 95
- ($wofm,$dofw,$m,$y)=($1,$2,$3,$4);
- # fix $m, $y
- return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
- $dofw=$week{lc($dofw)};
- $wofm=$wom{lc($wofm)};
- # Get the first day of the month
- $date=&Date_Join($y,$m,1,$h,$mn,$s);
- if ($wofm==-1) {
- $date=&DateCalc_DateDelta($date,"+0:1:0:0:0:0:0",\$err,0);
- $date=&Date_GetPrev($date,$dofw,0);
- } else {
- for ($i=0; $i<$wofm; $i++) {
- if ($i==0) {
- $date=&Date_GetNext($date,$dofw,1);
- } else {
- $date=&Date_GetNext($date,$dofw,0);
- }
- }
- }
- last PARSE;
-
- } elsif (/^$last$day$of\s*$month(?:$of?\s*$YY)?/i) {
- # last day in month
- ($m,$y)=($1,$2);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $y=&Date_FixYear($y) if (! defined $y or length($y)<4);
- $m=$month{lc($m)};
- $d=&Date_DaysInMonth($m,$y);
- last PARSE;
-
- } elsif (/^$week$/i) {
- # friday
- ($dofw)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&Date_GetPrev($Curr{"Now"},$Cnf{"FirstDay"},1);
- $date=&Date_GetNext($date,$dofw,1,$h,$mn,$s);
- last PARSE;
-
- } elsif (/^$next\s*$week$/i) {
- # next friday
- ($dofw)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&Date_GetNext($Curr{"Now"},$dofw,0,$h,$mn,$s);
- last PARSE;
-
- } elsif (/^$prev\s*$week$/i) {
- # last friday
- ($dofw)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&Date_GetPrev($Curr{"Now"},$dofw,0,$h,$mn,$s);
- last PARSE;
-
- } elsif (/^$next$wkabb$/i) {
- # next week
- &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);
- last PARSE;
- } elsif (/^$prev$wkabb$/i) {
- # last week
- &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);
- last PARSE;
-
- } elsif (/^$next$mabb$/i) {
- # next month
- &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);
- last PARSE;
- } elsif (/^$prev$mabb$/i) {
- # last month
- &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);
- last PARSE;
-
- } elsif (/^$future\s*(\d+)$day$/i ||
- /^(\d+)$day$later$/i) {
- # in 2 days
- # 2 days later
- ($num)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:0:$num:0:0:0",
- \$err,0);
- $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
- last PARSE;
- } elsif (/^(\d+)$day$past$/i) {
- # 2 days ago
- ($num)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:0:$num:0:0:0",
- \$err,0);
- $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
- last PARSE;
-
- } elsif (/^$future\s*(\d+)$wkabb$/i ||
- /^(\d+)$wkabb$later$/i) {
- # in 2 weeks
- # 2 weeks later
- ($num)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&DateCalc_DateDelta($Curr{"Now"},"+0:0:$num:0:0:0:0",
- \$err,0);
- $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
- last PARSE;
- } elsif (/^(\d+)$wkabb$past$/i) {
- # 2 weeks ago
- ($num)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&DateCalc_DateDelta($Curr{"Now"},"-0:0:$num:0:0:0:0",
- \$err,0);
- $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
- last PARSE;
-
- } elsif (/^$future\s*(\d+)$mabb$/i ||
- /^(\d+)$mabb$later$/i) {
- # in 2 months
- # 2 months later
- ($num)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&DateCalc_DateDelta($Curr{"Now"},"+0:$num:0:0:0:0:0",
- \$err,0);
- $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
- last PARSE;
- } elsif (/^(\d+)$mabb$past$/i) {
- # 2 months ago
- ($num)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=&DateCalc_DateDelta($Curr{"Now"},"-0:$num:0:0:0:0:0",
- \$err,0);
- $date=&Date_SetTime($date,$h,$mn,$s) if (defined $h);
- last PARSE;
-
- } elsif (/^$week$future\s*(\d+)$wkabb$/i ||
- /^$week\s*(\d+)$wkabb$later$/i) {
- # friday in 2 weeks
- # friday 2 weeks later
- ($dofw,$num)=($1,$2);
- $tmp="+";
- } elsif (/^$week\s*(\d+)$wkabb$past$/i) {
- # friday 2 weeks ago
- ($dofw,$num)=($1,$2);
- $tmp="-";
- } elsif (/^$future\s*(\d+)$wkabb$on$week$/i ||
- /^(\d+)$wkabb$later$on$week$/i) {
- # in 2 weeks on friday
- # 2 weeks later on friday
- ($num,$dofw)=($1,$2);
- $tmp="+"
- } elsif (/^(\d+)$wkabb$past$on$week$/i) {
- # 2 weeks ago on friday
- ($num,$dofw)=($1,$2);
- $tmp="-";
- } elsif (/^$week\s*$wkabb$/i) {
- # monday week (British date: in 1 week on monday)
- $dofw=$1;
- $num=1;
- $tmp="+";
- } 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);
- last PARSE;
- } elsif (/^$offset\s*$wkabb$/i) {
- # tomorrow week (British date: 1 week from tomorrow)
- ($offset)=($1);
- &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 ($time) {
- return ""
- if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
- $date=&Date_SetTime($date,$h,$mn,$s);
- }
- last PARSE;
- }
-
- if ($tmp) {
- &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);
- last PARSE;
- }
- }
-
- # Change (2nd, second) to 2
- $tmp=0;
- if (/(^|[^a-z0-9])$dom($|[^a-z0-9])/i) {
- if (/^\s*$dom\s*$/) {
- ($d)=($1);
- $d=$dom{lc($d)};
- $m=$Curr{"M"};
- last PARSE;
- }
- my $from = $2;
- my $to = $dom{ lc($from) };
- s/(^|[^a-z])$from($|[^a-z])/$1 $to $2/i;
- s/^\s+//;
- s/\s+$//;
- }
-
- # Another set of special dates (Nth week)
- if (/^$D\s*$week(?:$of?\s*$YY)?$/i) {
- # 22nd sunday in 1996
- ($which,$dofw,$y)=($1,$2,$3);
- $y=$Curr{"Y"} if (! $y);
- $y--; # previous year
- $tmp=&Date_GetNext("$y-12-31",$dofw,0);
- if ($which>1) {
- $tmp=&DateCalc_DateDelta($tmp,"+0:0:".($which-1).":0:0:0:0",\$err,0);
- }
- ($y,$m,$d)=(&Date_Split($tmp, 1))[0..2];
- last PARSE;
- } elsif (/^$week$wkabb\s*$D(?:$of?\s*$YY)?$/i ||
- /^$week\s*$D$wkabb(?:$of?\s*$YY)?$/i) {
- # sunday week 22 in 1996
- # sunday 22nd week in 1996
- ($dofw,$which,$y)=($1,$2,$3);
- ($y,$m,$d)=&Date_NthWeekOfYear($y,$which,$dofw);
- last PARSE;
- }
-
- # Get rid of day of week
- if (/(^|[^a-z])$week($|[^a-z])/i) {
- $wk=$2;
- (s/(^|[^a-z])$week,/$1 /i) ||
- s/(^|[^a-z])$week($|[^a-z])/$1 $3/i;
- s/^\s+//;
- s/\s+$//;
- }
-
- {
- # 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;
-
- # Non-ISO8601 dates
- s,\s*$sep\s*, ,g; # change all non-ISO8601 seps to spaces
- s,^\s*,,; # remove leading/trailing space
- s,\s*$,,;
-
- if (/^$D\s+$D(?:\s+$YY)?$/) {
- # MM DD YY (DD MM YY non-US)
- ($m,$d,$y)=($1,$2,$3);
- ($m,$d)=($d,$m) if ($type ne "US");
- last PARSE;
-
- } elsif (/^$D4\s*$D\s*$D$/) {
- # YYYY MM DD
- ($y,$m,$d)=($1,$2,$3);
- last PARSE;
-
- } elsif (s/(^|[^a-z])$month($|[^a-z])/$1 $3/i) {
- ($m)=($2);
-
- if (/^\s*$D(?:\s+$YY)?\s*$/) {
- # mmm DD YY
- # DD mmm YY
- # DD YY mmm
- ($d,$y)=($1,$2);
- last PARSE;
-
- } elsif (/^\s*$D$D4\s*$/) {
- # mmm DD YYYY
- # DD mmm YYYY
- # DD YYYY mmm
- ($d,$y)=($1,$2);
- last PARSE;
-
- } elsif (/^\s*$D4\s*$D\s*$/) {
- # mmm YYYY DD
- # YYYY mmm DD
- # YYYY DD mmm
- ($y,$d)=($1,$2);
- last PARSE;
-
- } elsif (/^\s*$D4\s*$/) {
- # mmm YYYY
- # YYYY mmm
- ($y,$d)=($1,1);
- last PARSE;
-
- } else {
- return "";
- }
-
- } elsif (/^epochNEGATIVE (\d+)$/) {
- $s=$1;
- $date=&DateCalc("1970-01-01 00:00 GMT","-0:0:$s");
- } elsif (/^epoch\s*(\d+)$/i) {
- $s=$1;
- $date=&DateCalc("1970-01-01 00:00 GMT","+0:0:$s");
-
- } elsif (/^$now$/i) {
- # now, today
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $date=$Curr{"Now"};
- if ($time) {
- return ""
- if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
- $date=&Date_SetTime($date,$h,$mn,$s);
- }
- last PARSE;
-
- } elsif (/^$offset$/i) {
- # yesterday, tomorrow
- ($offset)=($1);
- &Date_Init() if (! $Cnf{"UpdateCurrTZ"});
- $offset=$Lang{$L}{"OffsetH"}{lc($offset)};
- $date=&DateCalc_DateDelta($Curr{"Now"},$offset,\$err,0);
- if ($time) {
- return ""
- if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
- $date=&Date_SetTime($date,$h,$mn,$s);
- }
- last PARSE;
-
- } else {
- return "";
- }
- }
- }
-
- if (! $date) {
- 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);
- if ($midnight) {
- $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0");
- }
- return $date;
-}
-
-sub ParseDate {
- print "DEBUG: ParseDate\n" if ($Curr{"Debug"} =~ /trace/);
- &Date_Init() if (! $Curr{"InitDone"});
- my($args,@args,@a,$ref,$date)=();
- @a=@_;
-
- # @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.
-
- if ($#a!=0) {
- print "ERROR: Invalid number of arguments to ParseDate.\n";
- return "";
- }
- $args=$a[0];
- $ref=ref $args;
- if (! $ref) {
- return $args if (&Date_Split($args));
- @args=($args);
- } elsif ($ref eq "ARRAY") {
- @args=@$args;
- } elsif ($ref eq "SCALAR") {
- return $$args if (&Date_Split($$args));
- @args=($$args);
- } else {
- print "ERROR: Invalid arguments to ParseDate.\n";
- return "";
- }
- @a=@args;
-
- # @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
-
- PARSE: while($#a>=0) {
- $date=join(" ",@a);
- $date=&ParseDateString($date);
- last if ($date);
- pop(@a);
- } # PARSE
-
- splice(@args,0,$#a + 1);
- @$args= @args if (defined $ref and $ref eq "ARRAY");
- $date;
-}
-
-sub Date_Cmp {
- my($D1,$D2)=@_;
- my($date1)=&ParseDateString($D1);
- my($date2)=&ParseDateString($D2);
- return $date1 cmp $date2;
-}
-
-# **NOTE**
-# The calc routines all call parse routines, so it is never necessary to
-# call Date_Init in the calc routines.
-sub DateCalc {
- print "DEBUG: DateCalc\n" if ($Curr{"Debug"} =~ /trace/);
- my($D1,$D2,@arg)=@_;
- my($ref,$err,$errref,$mode)=();
-
- $errref=shift(@arg);
- $ref=0;
- if (defined $errref) {
- if (ref $errref) {
- $mode=shift(@arg);
- $ref=1;
- } else {
- $mode=$errref;
- $errref="";
- }
- }
-
- my(@date,@delta,$ret,$tmp,$old)=();
-
- if (defined $mode and $mode>=0 and $mode<=3) {
- $Curr{"Mode"}=$mode;
- } else {
- $Curr{"Mode"}=0;
- }
-
- $old=$Curr{"InCalc"};
- $Curr{"InCalc"}=1;
-
- 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).
- if (&Date_Split($D1)) {
- push(@date,$D1);
- } else {
- push(@date,$tmp);
- }
- } elsif ($tmp=&ParseDateDelta($D1)) {
- push(@delta,$tmp);
- } else {
- $$errref=1 if ($ref);
- return;
- }
-
- if ($tmp=&ParseDateString($D2)) {
- if (&Date_Split($D2)) {
- push(@date,$D2);
- } else {
- push(@date,$tmp);
- }
- } elsif ($tmp=&ParseDateDelta($D2)) {
- push(@delta,$tmp);
- } else {
- $$errref=2 if ($ref);
- return;
- }
- $mode=$Curr{"Mode"};
- $Curr{"InCalc"}=$old;
-
- if ($#date==1) {
- $ret=&DateCalc_DateDate(@date,$mode);
- } elsif ($#date==0) {
- $ret=&DateCalc_DateDelta(@date,@delta,\$err,$mode);
- $$errref=$err if ($ref);
- } else {
- $ret=&DateCalc_DeltaDelta(@delta,$mode);
- }
- $ret;
-}
-
-sub ParseDateDelta {
- print "DEBUG: ParseDateDelta\n" if ($Curr{"Debug"} =~ /trace/);
- my($args,@args,@a,$ref)=();
- local($_)=();
- @a=@_;
-
- # @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.
-
- if ($#a!=0) {
- print "ERROR: Invalid number of arguments to ParseDateDelta.\n";
- return "";
- }
- $args=$a[0];
- $ref=ref $args;
- if (! $ref) {
- @args=($args);
- } elsif ($ref eq "ARRAY") {
- @args=@$args;
- } elsif ($ref eq "SCALAR") {
- @args=($$args);
- } else {
- print "ERROR: Invalid arguments to ParseDateDelta.\n";
- return "";
- }
- @a=@args;
-
- # @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($from,$to)=();
- 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($numexp)='(\d+)';
- 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"};
-
- $delta="";
- PARSE: while (@a) {
- $_ = join(" ", grep {defined;} @a);
- s/\s+$//;
- last if ($_ eq "");
-
- # 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"}//) {
- $Curr{"Mode"}=0;
- } elsif ($Lang{$Cnf{"Language"}}{"Approx"} &&
- s/$Lang{$Cnf{"Language"}}{"Approx"}//) {
- $Curr{"Mode"}=1;
- } elsif ($Lang{$Cnf{"Language"}}{"Business"} &&
- s/$Lang{$Cnf{"Language"}}{"Business"}//) {
- $Curr{"Mode"}=2;
- } elsif (! exists $Curr{"Mode"}) {
- $Curr{"Mode"}=0;
- }
- $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;
- }
-
- # in or ago
- #
- # 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
-
- $len=0;
- $tmp=$_;
- $dir=1;
-
- $tmp2=$_;
- if ($tmp2 =~ s/(^|[^a-z])($future)($|[^a-z])/$1 $3/i) {
- $tmpl=length($2);
- if ($tmpl>$len) {
- $tmp=$tmp2;
- $dir=1;
- $len=$tmpl;
- }
- }
-
- $tmp2=$_;
- if ($tmp2 =~ s/(^|[^a-z])($later)($|[^a-z])/$1 $3/i) {
- $tmpl=length($2);
- if ($tmpl>$len) {
- $tmp=$tmp2;
- $dir=1;
- $len=$tmpl;
- }
- }
-
- $tmp2=$_;
- if ($tmp2 =~ s/(^|[^a-z])($past)($|[^a-z])/$1 $3/i) {
- $tmpl=length($2);
- if ($tmpl>$len) {
- $tmp=$tmp2;
- $dir=-1;
- $len=$tmpl;
- }
- }
-
- $_ = $tmp;
- s/\s*$//;
-
- # the colon part of the delta
- $colon="";
- if (s/($signexp?$numexp?(:($signexp?$numexp)?){1,6})$//) {
- $colon=$1;
- s/\s+$//;
- }
- @colon=split(/:/,$colon);
-
- # the non-colon part of the delta
- $sign="+";
- @delta=();
- $i=6;
- foreach $exp1 ($yexp,$mexp,$wexp,$dexp,$hexp,$mnexp,$sexp) {
- last if ($#colon>=$i--);
- $val=0;
- if (s/^$exp1//ix) {
- $val=$2 if ($2);
- $sign=$1 if ($1);
- }
-
- # Collapse a sign like '+ -' into a single character like '-',
- # by counting the occurrences of '-'.
- #
- $sign =~ s/\s+//g;
- $sign =~ tr/+//d;
- my $count = ($sign =~ tr/-//d);
- die "bad characters in sign: $sign" if length $sign;
- $sign = $count % 2 ? '-' : '+';
-
- push(@delta,"$sign$val");
- }
- if (! /^\s*$/) {
- pop(@a);
- next PARSE;
- }
-
- # make sure that the colon part has a sign
- for ($i=0; $i<=$#colon; $i++) {
- $val=0;
- if ($colon[$i] =~ /^$signexp$numexp?/) {
- $val=$2 if ($2);
- $sign=$1 if ($1);
- }
- $colon[$i] = "$sign$val";
- }
-
- # combine the two
- push(@delta,@colon);
- if ($dir<0) {
- for ($i=0; $i<=$#delta; $i++) {
- $delta[$i] =~ tr/-+/+-/;
- }
- }
-
- # form the delta and shift off the valid part
- $delta=join(":",@delta);
- splice(@args,0,$#a+1);
- @$args=@args if (defined $ref and $ref eq "ARRAY");
- last PARSE;
- }
-
- $delta=&Delta_Normalize($delta,$Curr{"Mode"});
- return $delta;
-}
-
-sub UnixDate {
- print "DEBUG: UnixDate\n" if ($Curr{"Debug"} =~ /trace/);
- my($date,@format)=@_;
- local($_)=();
- my($format,%f,$out,@out,$c,$date1,$date2,$tmp)=();
- my($scalar)=();
- $date=&ParseDateString($date);
- return if (! $date);
-
- my($y,$m,$d,$h,$mn,$s)=($f{"Y"},$f{"m"},$f{"d"},$f{"H"},$f{"M"},$f{"S"})=
- &Date_Split($date, 1);
- $f{"y"}=substr $f{"Y"},2;
- &Date_Init() if (! $Curr{"InitDone"});
-
- if (! wantarray) {
- $format=join(" ",@format);
- @format=($format);
- $scalar=1;
- }
-
- # month, week
- $_=$m;
- s/^0//;
- $f{"b"}=$f{"h"}=$Lang{$Cnf{"Language"}}{"MonL"}[$_-1];
- $f{"B"}=$Lang{$Cnf{"Language"}}{"MonthL"}[$_-1];
- $_=$m;
- s/^0/ /;
- $f{"f"}=$_;
- $f{"U"}=&Date_WeekOfYear($m,$d,$y,7);
- $f{"W"}=&Date_WeekOfYear($m,$d,$y,1);
-
- # check week 52,53 and 0
- $f{"G"}=$f{"L"}=$y;
- if ($f{"W"}>=52 || $f{"U"}>=52) {
- my($dd,$mm,$yy)=($d,$m,$y);
- $dd+=7;
- if ($dd>31) {
- $dd-=31;
- $mm=1;
- $yy++;
- if (&Date_WeekOfYear($mm,$dd,$yy,1)==2) {
- $f{"G"}=$yy;
- $f{"W"}=1;
- }
- if (&Date_WeekOfYear($mm,$dd,$yy,7)==2) {
- $f{"L"}=$yy;
- $f{"U"}=1;
- }
- }
- }
- if ($f{"W"}==0) {
- my($dd,$mm,$yy)=($d,$m,$y);
- $dd-=7;
- $dd+=31 if ($dd<1);
- $yy--;
- $mm=12;
- $f{"G"}=$yy;
- $f{"W"}=&Date_WeekOfYear($mm,$dd,$yy,1)+1;
- }
- if ($f{"U"}==0) {
- my($dd,$mm,$yy)=($d,$m,$y);
- $dd-=7;
- $dd+=31 if ($dd<1);
- $yy--;
- $mm=12;
- $f{"L"}=$yy;
- $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);
-
- # day
- $f{"j"}=&Date_DayOfYear($m,$d,$y);
- $f{"j"} = "0" . $f{"j"} while (length($f{"j"})<3);
- $_=$d;
- s/^0/ /;
- $f{"e"}=$_;
- $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"});
-
- # hour
- $_=$h;
- s/^0/ /;
- $f{"k"}=$_;
- $f{"i"}=$f{"k"}+1;
- $f{"i"}=$f{"k"};
- $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{"I"}=$f{"i"};
- $f{"I"}=~ s/^ /0/;
- $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"}} || "");
-
- # date, time
- $f{"c"}=qq|$f{"a"} $f{"b"} $f{"e"} $h:$mn:$s $y|;
- $f{"C"}=$f{"u"}=
- 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{"R"}=qq|$h:$mn|;
- $f{"T"}=$f{"X"}=qq|$h:$mn:$s|;
- $f{"V"}=qq|$m$d$h$mn$f{"y"}|;
- $f{"Q"}="$y$m$d";
- $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"}|;
- if ($f{"W"}==0) {
- $y--;
- $tmp=&Date_WeekOfYear(12,31,$y,1);
- $tmp="0$tmp" if (length($tmp) < 2);
- $f{"J"}=qq|$y-W$tmp-$f{"w"}|;
- } else {
- $f{"J"}=qq|$f{"G"}-W$f{"W"}-$f{"w"}|;
- }
- $f{"K"}=qq|$y-$f{"j"}|;
- # %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
- # recursion breaks.
-
- # other formats
- $f{"n"}="\n";
- $f{"t"}="\t";
- $f{"%"}="%";
- $f{"+"}="+";
-
- foreach $format (@format) {
- $format=reverse($format);
- $out="";
- while ($format ne "") {
- $c=chop($format);
- if ($c eq "%") {
- $c=chop($format);
- if ($c eq "l") {
- &Date_Init();
- $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|;
- } else {
- $f{"l"}=qq|$f{"b"} $f{"e"} $f{"Y"}|;
- }
- $out .= $f{"$c"};
- } elsif (exists $f{"$c"}) {
- $out .= $f{"$c"};
- } else {
- $out .= $c;
- }
- } else {
- $out .= $c;
- }
- }
- push(@out,$out);
- }
- if ($scalar) {
- return $out[0];
- } else {
- return (@out);
- }
-}
-
-# Can't be in "use integer" because we're doing decimal arithmatic
-no integer;
-sub Delta_Format {
- print "DEBUG: Delta_Format\n" if ($Curr{"Debug"} =~ /trace/);
- my($delta,$dec,@format)=@_;
- $delta=&ParseDateDelta($delta);
- return "" if (! $delta);
- my(@out,%f,$out,$c1,$c2,$scalar,$format)=();
- local($_)=$delta;
- 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";
- } else {
- $dec="%f";
- }
-
- if (! wantarray) {
- $format=join(" ",@format);
- @format=($format);
- $scalar=1;
- }
-
- # Length of each unit in seconds
- my($sl,$ml,$hl,$dl,$wl,$yl)=();
- $sl = 1;
- $ml = $sl*60;
- $hl = $ml*60;
- $dl = $hl*24;
- $wl = $dl*7;
- $yl = $dl*365.25;
-
- # The decimal amount of each unit contained in all smaller units
- my($yd,$Md,$sd,$md,$hd,$dd,$wd)=();
- if ($M) {
- $yd = $M/12;
- $Md = 0;
- } else {
- $yd = ($w*$wl + $d*$dl + $h*$hl + $m*$ml + $s*$sl)/$yl;
- $Md = 0;
- }
-
- $wd = ($d*$dl + $h*$hl + $m*$ml + $s*$sl)/$wl;
- $dd = ($h*$hl + $m*$ml + $s*$sl)/$dl;
- $hd = ($m*$ml + $s*$sl)/$hl;
- $md = ($s*$sl)/$ml;
- $sd = 0;
-
- # The amount of each unit contained in higher units.
- my($yh,$Mh,$sh,$mh,$hh,$dh,$wh)=();
- $yh = 0;
-
- if ($M) {
- $Mh = ($yh+$y)*12;
- $wh = 0;
- $dh = ($wh+$w)*7;
- } else {
- $Mh = 0;
- $wh = ($yh+$y)*365.25/7;
- $dh = ($yh+$y)*365.25 + $w*7;
- }
-
- $hh = ($dh+$d)*24;
- $mh = ($hh+$h)*60;
- $sh = ($mh+$m)*60;
-
- # Set up the formats
-
- $f{"yv"} = $y;
- $f{"Mv"} = $M;
- $f{"wv"} = $w;
- $f{"dv"} = $d;
- $f{"hv"} = $h;
- $f{"mv"} = $m;
- $f{"sv"} = $s;
-
- $f{"yh"} = $y+$yh;
- $f{"Mh"} = $M+$Mh;
- $f{"wh"} = $w+$wh;
- $f{"dh"} = $d+$dh;
- $f{"hh"} = $h+$hh;
- $f{"mh"} = $m+$mh;
- $f{"sh"} = $s+$sh;
-
- $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);
-
- $f{"%"} = "%";
-
- foreach $format (@format) {
- $format=reverse($format);
- $out="";
- PARSE: while ($format) {
- $c1=chop($format);
- if ($c1 eq "%") {
- $c1=chop($format);
- if (exists($f{$c1})) {
- $out .= $f{$c1};
- next PARSE;
- }
- $c2=chop($format);
- if (exists($f{"$c1$c2"})) {
- $out .= $f{"$c1$c2"};
- next PARSE;
- }
- $out .= $c1;
- $format .= $c2;
- } else {
- $out .= $c1;
- }
- }
- push(@out,$out);
- }
- if ($scalar) {
- return $out[0];
- } else {
- return (@out);
- }
-}
-use integer;
-
-sub ParseRecur {
- print "DEBUG: ParseRecur\n" if ($Curr{"Debug"} =~ /trace/);
- &Date_Init() if (! $Curr{"InitDone"});
-
- my($recur,$dateb,$date0,$date1,$flag)=@_;
- local($_)=$recur;
-
- 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
- # following are used:
- # 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
- # $dateb $date_b
- # 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);
-
- if ($dateb) {
- $dateb=&ParseDateString($dateb);
- return "" if (! $dateb);
- }
- if ($date0) {
- $date0=&ParseDateString($date0);
- return "" if (! $date0);
- }
- if ($date1) {
- $date1=&ParseDateString($date1);
- return "" if (! $date1);
- }
-
- #
- # Parse the recur. $date_b, $date_0, and $date_e are values obtained
- # from the recur.
- #
-
- @tmp=&Recur_Split($_);
-
- if (@tmp) {
- ($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);
-
- if ($date_b) {
- $date_b=&ParseDateString($date_b);
- return "" if (! $date_b);
- }
- if ($date_0) {
- $date_0=&ParseDateString($date_0);
- return "" if (! $date_0);
- }
- if ($date_1) {
- $date_1=&ParseDateString($date_1);
- return "" if (! $date_1);
- }
-
- } else {
-
- 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"} };
- # { 1st=>1,first=>1,...}
- 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($D)='\s*(\d+)';
- my($Y)='\s*(\d{4}|\d{2})';
-
- # Change 1st to 1
- if (/(^|[^a-z])$daysexp($|[^a-z])/i) {
- $tmp=lc($2);
- $tmp=$dayshash{"$tmp"};
- s/(^|[^a-z])$daysexp($|[^a-z])/$1 $tmp $3/i;
- }
- s/\s*$//;
-
- # Get rid of "each"
- if (/(^|[^a-z])$each($|[^a-z])/i) {
- s/(^|[^a-z])$each($|[^a-z])/$1 $2/i;
- $each=1;
- } else {
- $each=0;
- }
-
- if ($each) {
-
- if (/^$D?$day(?:$of$mmm?$Y)?$/i ||
- /^$D?$day(?:$of$mmm())?$/i) {
- # every [2nd] day in [june] 1997
- # every [2nd] day [in june]
- ($num,$m,$y)=($1,$2,$3);
- $num=1 if (! defined $num);
- $m="" if (! defined $m);
- $y="" if (! defined $y);
-
- $y=$Curr{"Y"} if (! $y);
- if ($m) {
- $m=$mmm{lc($m)};
- $date_0=&Date_Join($y,$m,1,0,0,0);
- $date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
- } else {
- $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);
- @recur1=();
-
- } elsif (/^$D$day?$of$month(?:$of?$Y)?$/) {
- # 2nd [day] of every month [in 1997]
- ($num,$y)=($1,$2);
- $y=$Curr{"Y"} if (! $y);
-
- $date_0=&Date_Join($y, 1,1,0,0,0);
- $date_1=&Date_Join($y+1,1,1,0,0,0);
- $date_b=$date_0;
-
- @recur0=(0,1,0);
- @recur1=($num,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,$d,$y)=($1,$2,$3);
- $y=$Curr{"Y"} if (! $y);
- $d=$week{lc($d)};
- $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);
- $date_b=$date_0;
-
- @recur0=(0,1);
- @recur1=($num,$d,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);
- $y=$Curr{"Y"} if (! $y);
- $num=1 if (! defined $num);
- $m="" if (! defined $m);
- $d=$week{lc($d)};
-
- if ($m) {
- $m=$mmm{lc($m)};
- $date_0=&Date_Join($y,$m,1,0,0,0);
- $date_1=&DateCalc_DateDelta($date_0,"+0:1:0:0:0:0:0",0);
- } else {
- $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,$num);
- @recur1=($d,0,0,0);
-
- } else {
- return "";
- }
-
- $date_0="" if ($date0);
- $date_1="" if ($date1);
- } else {
- return "";
- }
- }
-
- #
- # Override with any values passed in
- #
-
- if ($date0 && $date_0) {
- $date0=( &Date_Cmp($date0,$date_0) > 1 ? $date0 : $date_0);
- } elsif ($date_0) {
- $date0 = $date_0;
- }
-
- if ($date1 && $date_1) {
- $date1=( &Date_Cmp($date1,$date_1) > 1 ? $date_1 : $date1);
- } elsif ($date_1) {
- $date1 = $date_1;
- }
-
- $dateb=$date_b if (! $dateb);
-
- if ($flag =~ s/^\+//) {
- if ($flag_t) {
- $flag="$flag_t,$flag";
- }
- }
- $flag =$flag_t if (! $flag && $flag_t);
-
- if (! wantarray) {
- $tmp = join(":",@recur0);
- $tmp .= "*" . join(":",@recur1) if (@recur1);
- $tmp .= "*$flag*$dateb*$date0*$date1";
- return $tmp;
- }
- if (@recur0) {
- return () if (! $date0 || ! $date1); # dateb is NOT required in all case
- }
-
- #
- # Some flags affect parsing.
- #
-
- @flags = split(/,/,$flag);
- my($MDn) = 0;
- my($MWn) = 7;
- my($f);
- foreach $f (@flags) {
- if ($f =~ /^MW([1-7])$/i) {
- $MWn=$1;
- $MDn=0;
-
- } elsif ($f =~ /^MD([1-7])$/i) {
- $MDn=$1;
- $MWn=0;
-
- } 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.
- if ($#recur0==-1) {
- @recur1=($y,1,0,1,$h,$mn,$s);
- } elsif ($#recur0<=3) {
- @recur0=($y,0,0,0);
- @recur1=($h,$mn,$s);
- } elsif ($#recur0==4) {
- @recur0=($y,0,0,0,0);
- @recur1=($mn,$s);
- } elsif ($#recur0==5) {
- @recur0=($y,0,0,0,0,0);
- @recur1=($s);
- } else {
- @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=@m=@w=@d=();
- my(@time)=($h,$mn,$s);
-
- RECUR: while (1) {
-
- if ($#recur0==-1) {
- # * Y-M-W-D-H-MN-S
- if ($y eq "0") {
- push(@recur0,0);
- shift(@recur1);
-
- } else {
- @y=&ReturnList($y);
- foreach $y (@y) {
- $y=&Date_FixYear($y) if (length($y)==2);
- return () if (length($y)!=4 || ! &IsInt($y));
- }
- @y=sort { $a<=>$b } @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") {
- # * Y-0-0-0-H-MN-S
- # * Y-0-0-DOY-H-MN-S
- if ($d eq "0") {
- @d=(1);
- } else {
- @d=&ReturnList($d);
- return () if (! @d);
- foreach $d (@d) {
- return () if (! &IsInt($d,1,366));
- }
- @d=sort { $a<=>$b } (@d);
- }
-
- @date=();
- foreach $yy (@y) {
- foreach $d (@d) {
- ($y,$m,$dd)=&Date_NthDayOfYear($yy,$d);
- push(@date, &Date_Join($y,$m,$dd,0,0,0));
- }
- }
- last RECUR;
-
- } elsif ($w eq "0") {
- # * Y-M-0-0-H-MN-S
- # * Y-M-0-DOM-H-MN-S
-
- @m=&ReturnList($m);
- return () if (! @m);
- foreach $m (@m) {
- return () if (! &IsInt($m,1,12));
- }
- @m=sort { $a<=>$b } (@m);
-
- if ($d eq "0") {
- @d=(1);
- } else {
- @d=&ReturnList($d);
- return () if (! @d);
- foreach $d (@d) {
- return () if (! &IsInt($d,1,31));
- }
- @d=sort { $a<=>$b } (@d);
- }
-
- @date=();
- foreach $y (@y) {
- foreach $m (@m) {
- foreach $d (@d) {
- $date=&Date_Join($y,$m,$d,0,0,0);
- push(@date,$date) if ($d<29 || &Date_Split($date));
- }
- }
- }
- last RECUR;
-
- } elsif ($m eq "0") {
- # * Y-0-WOY-DOW-H-MN-S
- # * Y-0-WOY-0-H-MN-S
- @w=&ReturnList($w);
- return () if (! @w);
- foreach $w (@w) {
- return () if (! &IsInt($w,1,53));
- }
-
- if ($d eq "0") {
- @d=($Cnf{"FirstDay"});
- } else {
- @d=&ReturnList($d);
- return () if (! @d);
- foreach $d (@d) {
- return () if (! &IsInt($d,1,7));
- }
- @d=sort { $a<=>$b } (@d);
- }
-
- @date=();
- foreach $y (@y) {
- foreach $w (@w) {
- $w="0$w" if (length($w)==1);
- foreach $d (@d) {
- $date=&ParseDateString("$y-W$w-$d");
- push(@date,$date);
- }
- }
- }
- last RECUR;
-
- } else {
- # * Y-M-WOM-DOW-H-MN-S
- # * Y-M-WOM-0-H-MN-S
-
- @m=&ReturnList($m);
- return () if (! @m);
- foreach $m (@m) {
- return () if (! &IsInt($m,1,12));
- }
- @m=sort { $a<=>$b } (@m);
-
- @w=&ReturnList($w);
-
- if ($d eq "0") {
- @d=();
- } else {
- @d=&ReturnList($d);
- }
-
- @date=&Date_Recur_WoM(\@y,\@m,\@w,\@d,$MWn,$MDn);
- last RECUR;
- }
- }
- }
-
- if ($#recur0==0) {
- # Y * M-W-D-H-MN-S
- $n=$y;
- $n=1 if ($n==0);
-
- @m=&ReturnList($m);
- return () if (! @m);
- foreach $m (@m) {
- return () if (! &IsInt($m,1,12));
- }
- @m=sort { $a<=>$b } (@m);
-
- if ($m eq "0") {
- # Y * 0-W-D-H-MN-S (equiv to Y-0 * W-D-H-MN-S)
- push(@recur0,0);
- shift(@recur1);
-
- } elsif ($w eq "0") {
- # Y * M-0-DOM-H-MN-S
- return () if (! $dateb);
- $d=1 if ($d eq "0");
-
- @d=&ReturnList($d);
- return () if (! @d);
- foreach $d (@d) {
- 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];
- @date=();
- for ($yy=$y0; $yy<=$y1; $yy++) {
- if (($yy-$yb)%$n == 0) {
- foreach $m (@m) {
- foreach $d (@d) {
- $date=&Date_Join($yy,$m,$d,0,0,0);
- push(@date,$date) if ($d<29 || &Date_Split($date));
- }
- }
- }
- }
- last RECUR;
-
- } else {
- # Y * M-WOM-DOW-H-MN-S
- # Y * M-WOM-0-H-MN-S
- return () if (! $dateb);
- @m=&ReturnList($m);
- @w=&ReturnList($w);
- if ($d eq "0") {
- @d=();
- } else {
- @d=&ReturnList($d);
- }
-
- ($y0)=( &Date_Split($date0, 1) )[0];
- ($y1)=( &Date_Split($date1, 1) )[0];
- ($yb)=( &Date_Split($dateb, 1) )[0];
- @y=();
- for ($yy=$y0; $yy<=$y1; $yy++) {
- if (($yy-$yb)%$n == 0) {
- push(@y,$yy);
- }
- }
-
- @date=&Date_Recur_WoM(\@y,\@m,\@w,\@d,$MWn,$MDn);
- last RECUR;
- }
- }
-
- if ($#recur0==1) {
- # Y-M * W-D-H-MN-S
-
- if ($w eq "0") {
- # Y-M * 0-D-H-MN-S (equiv to Y-M-0 * D-H-MN-S)
- push(@recur0,0);
- shift(@recur1);
-
- } elsif ($m==0) {
- # Y-0 * WOY-0-H-MN-S
- # Y-0 * WOY-DOW-H-MN-S
- return () if (! $dateb);
- $n=$y;
- $n=1 if ($n==0);
-
- @w=&ReturnList($w);
- return () if (! @w);
- foreach $w (@w) {
- return () if (! &IsInt($w,1,53));
- }
-
- if ($d eq "0") {
- @d=($Cnf{"FirstDay"});
- } else {
- @d=&ReturnList($d);
- return () if (! @d);
- foreach $d (@d) {
- 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];
- @date=();
- for ($yy=$y0; $yy<=$y1; $yy++) {
- if (($yy-$yb)%$n == 0) {
- foreach $w (@w) {
- $w="0$w" if (length($w)==1);
- foreach $tmp (@d) {
- $date=&ParseDateString("$yy-W$w-$tmp");
- push(@date,$date);
- }
- }
- }
- }
- last RECUR;
-
- } else {
- # Y-M * WOM-0-H-MN-S
- # Y-M * WOM-DOW-H-MN-S
- return () if (! $dateb);
- @tmp=(@recur0);
- push(@tmp,0) while ($#tmp<6);
- $delta=join(":",@tmp);
- @tmp=&Date_Recur($date0,$date1,$dateb,$delta);
-
- @w=&ReturnList($w);
- @m=();
- if ($d eq "0") {
- @d=();
- } else {
- @d=&ReturnList($d);
- }
-
- @date=&Date_Recur_WoM(\@tmp,\@m,\@w,\@d,$MWn,$MDn);
- last RECUR;
- }
- }
-
- if ($#recur0==2) {
- # Y-M-W * D-H-MN-S
-
- if ($d eq "0") {
- # Y-M-W * 0-H-MN-S
- return () if (! $dateb);
- $y=1 if ($y==0 && $m==0 && $w==0);
- $delta="$y:$m:$w:0:0:0:0";
- @date=&Date_Recur($date0,$date1,$dateb,$delta);
- last RECUR;
-
- } elsif ($m==0 && $w==0) {
- # Y-0-0 * DOY-H-MN-S
- $y=1 if ($y==0);
- $n=$y;
- return () if (! $dateb && $y!=1);
-
- @d=&ReturnList($d);
- return () if (! @d);
- foreach $d (@d) {
- 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];
- @date=();
- for ($yy=$y0; $yy<=$y1; $yy++) {
- if (($yy-$yb)%$n == 0) {
- foreach $d (@d) {
- ($y,$m,$dd)=&Date_NthDayOfYear($yy,$d);
- push(@date, &Date_Join($y,$m,$dd,0,0,0));
- }
- }
- }
- last RECUR;
-
- } elsif ($w>0) {
- # Y-M-W * DOW-H-MN-S
- return () if (! $dateb);
- @tmp=(@recur0);
- push(@tmp,0) while ($#tmp<6);
- $delta=join(":",@tmp);
-
- @d=&ReturnList($d);
- return () if (! @d);
- foreach $d (@d) {
- 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]);
-
- @date=();
- foreach $d (@d) {
- $date_b=$dateb;
- # Move basedate to DOW
- if ($d != $tmp) {
- if (($tmp>=$Cnf{"FirstDay"} && $d<$Cnf{"FirstDay"}) ||
- ($tmp>=$Cnf{"FirstDay"} && $d>$tmp) ||
- ($tmp<$d && $d<$Cnf{"FirstDay"})) {
- $date_b=&Date_GetNext($date_b,$d);
- } else {
- $date_b=&Date_GetPrev($date_b,$d);
- }
- }
- push(@date,&Date_Recur($date0,$date1,$date_b,$delta));
- }
- @date=sort(@date);
- last RECUR;
-
- } elsif ($m>0) {
- # Y-M-0 * DOM-H-MN-S
- return () if (! $dateb);
- @tmp=(@recur0);
- push(@tmp,0) while ($#tmp<6);
- $delta=join(":",@tmp);
-
- @d=&ReturnList($d);
- return () if (! @d);
- foreach $d (@d) {
- return () if (! &IsInt($d,-31,31) || $d==0);
- }
- @d=sort { $a<=>$b } (@d);
-
- @tmp2=&Date_Recur($date0,$date1,$dateb,$delta);
- @date=();
- foreach $date (@tmp2) {
- ($y,$m)=( &Date_Split($date, 1) )[0..1];
- $tmp2=&Date_DaysInMonth($m,$y);
- foreach $d (@d) {
- $d2=$d;
- $d2=$tmp2+1+$d if ($d<0);
- push(@date,&Date_Join($y,$m,$d2,0,0,0)) if ($d2<=$tmp2);
- }
- }
- @date=sort (@date);
- last RECUR;
-
- } else {
- return ();
- }
- }
-
- if ($#recur0>2) {
- # Y-M-W-D * H-MN-S
- # Y-M-W-D-H * MN-S
- # Y-M-W-D-H-MN * S
- # Y-M-W-D-H-S
- return () if (! $dateb);
- @tmp=(@recur0);
- push(@tmp,0) while ($#tmp<6);
- $delta=join(":",@tmp);
- return () if ($delta !~ /[1-9]/); # return if "0:0:0:0:0:0:0"
- @date=&Date_Recur($date0,$date1,$dateb,$delta);
- if (@recur1) {
- unshift(@recur1,-1) while ($#recur1<2);
- @time=@recur1;
- } else {
- shift(@date);
- pop(@date);
- @time=();
- }
- }
-
- last RECUR;
- }
- @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);
- if (@flags) {
- FLAG: foreach $f (@flags) {
- $f = uc($f);
-
- if ($f =~ /^(P|N)(D|T)([1-7])$/) {
- @tmp=($1,$2,$3);
- $forw =($tmp[0] eq "P" ? 0 : 1);
- $today=($tmp[1] eq "D" ? 0 : 1);
- $d=$tmp[2];
- @tmp=();
- foreach $date (@date) {
- if ($forw) {
- push(@tmp, &Date_GetNext($date,$d,$today));
- } else {
- push(@tmp, &Date_GetPrev($date,$d,$today));
- }
- }
- @date=@tmp;
- next FLAG;
- }
-
- # 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+)$/) {
- @tmp=($1,$2,$3);
- $sign="+";
- $sign="-" if ($tmp[0] eq "B");
- $work=0;
- $work=1 if ($tmp[1] eq "W");
- $n=$tmp[2];
- @tmp=();
- foreach $date (@date) {
- for ($i=1; $i<=$n; $i++) {
- while (1) {
- $date=&DateCalc($date,"${sign}0:0:0:1:0:0:0");
- last if (! $work || &Date_IsWorkDay($date,0));
- }
- }
- push(@tmp,$date);
- }
- @date=@tmp;
- next FLAG;
- }
-
- if ($f =~ /^CW(N|P|D)$/ || $f =~ /^(N|P|D)W(D)$/) {
- $tmp=$1;
- my $noalt = $2 ? 1 : 0;
- if ($tmp eq "N" || ($tmp eq "D" && $Cnf{"TomorrowFirst"})) {
- $forw=1;
- } else {
- $forw=0;
- }
-
- @tmp=();
- DATE: foreach $date (@date) {
- $df=$db=$date;
- if (&Date_IsWorkDay($date)) {
- push(@tmp,$date);
- next DATE;
- }
- while (1) {
- if ($forw) {
- $d=$df=&DateCalc($df,"+0:0:0:1:0:0:0");
- } else {
- $d=$db=&DateCalc($db,"-0:0:0:1:0:0:0");
- }
- if (&Date_IsWorkDay($d)) {
- push(@tmp,$d);
- next DATE;
- }
- $forw=1-$forw if (! $noalt);
- }
- }
- @date=@tmp;
- next FLAG;
- }
-
- if ($f eq "EASTER") {
- @tmp=();
- foreach $date (@date) {
- ($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);
- push(@tmp,$date);
- }
- @date=@tmp;
- }
- }
- @date = sort(@date);
- }
- @date;
-}
-
-sub Date_GetPrev {
- 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,
- $adjust,$curr)=();
- $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);
- return "" if (! $date);
- }
- $curr=$date;
- ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
-
- if ($dow) {
- $curr_dow=&Date_DayOfWeek($m,$d,$y);
- %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
- if (&IsInt($dow)) {
- return "" if ($dow<1 || $dow>7);
- } else {
- return "" if (! exists $dow{lc($dow)});
- $dow=$dow{lc($dow)};
- }
- if ($dow == $curr_dow) {
- $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0) if (! $today);
- $adjust=1 if ($today==2);
- } else {
- $dow -= 7 if ($dow>$curr_dow); # make sure previous day is less
- $num = $curr_dow - $dow;
- $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);
-
- } else {
- ($h,$mn,$s)=( &Date_Split($date, 1) )[3..5];
- ($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec);
- if ($hr) {
- ($hr,$min,$sec)=($th,$tm,$ts);
- $delta="-0:0:0:1:0:0:0";
- } elsif ($min) {
- ($hr,$min,$sec)=($h,$tm,$ts);
- $delta="-0:0:0:0:1:0:0";
- } elsif ($sec) {
- ($hr,$min,$sec)=($h,$mn,$ts);
- $delta="-0:0:0:0:0:1:0";
- } else {
- confess "ERROR: invalid arguments in Date_GetPrev.\n";
- }
-
- $d=&Date_SetTime($date,$hr,$min,$sec);
- if ($today) {
- $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>0);
- } else {
- $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)>=0);
- }
- $date=$d;
- }
- return $date;
-}
-
-sub Date_GetNext {
- 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,
- $adjust,$curr)=();
- $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);
- return "" if (! $date);
- }
- $curr=$date;
- ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
-
- if ($dow) {
- $curr_dow=&Date_DayOfWeek($m,$d,$y);
- %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
- if (&IsInt($dow)) {
- return "" if ($dow<1 || $dow>7);
- } else {
- return "" if (! exists $dow{lc($dow)});
- $dow=$dow{lc($dow)};
- }
- if ($dow == $curr_dow) {
- $date=&DateCalc_DateDelta($date,"+0:0:1:0:0:0:0",\$err,0) if (! $today);
- $adjust=1 if ($today==2);
- } else {
- $curr_dow -= 7 if ($curr_dow>$dow); # make sure next date is greater
- $num = $dow - $curr_dow;
- $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);
-
- } else {
- ($h,$mn,$s)=( &Date_Split($date, 1) )[3..5];
- ($th,$tm,$ts)=&Date_ParseTime($hr,$min,$sec);
- if ($hr) {
- ($hr,$min,$sec)=($th,$tm,$ts);
- $delta="+0:0:0:1:0:0:0";
- } elsif ($min) {
- ($hr,$min,$sec)=($h,$tm,$ts);
- $delta="+0:0:0:0:1:0:0";
- } elsif ($sec) {
- ($hr,$min,$sec)=($h,$mn,$ts);
- $delta="+0:0:0:0:0:1:0";
- } else {
- confess "ERROR: invalid arguments in Date_GetNext.\n";
- }
-
- $d=&Date_SetTime($date,$hr,$min,$sec);
- if ($today) {
- $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<0);
- } else {
- $d=&DateCalc_DateDelta($d,$delta,\$err,0) if (&Date_Cmp($d,$date)<1);
- }
- $date=$d;
- }
-
- return $date;
-}
-
-sub Date_IsHoliday {
- print "DEBUG: Date_IsHoliday\n" if ($Curr{"Debug"} =~ /trace/);
- my($date)=@_;
- &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};
- return "" if (! $name);
- $name;
-}
-
-sub Events_List {
- print "DEBUG: Events_List\n" if ($Curr{"Debug"} =~ /trace/);
- my(@args)=@_;
- &Date_Init() if (! $Curr{"InitDone"});
- &Events_ParseRaw();
-
- my($tmp,$date0,$date1,$flag);
- $date0=&ParseDateString($args[0]);
- warn "Invalid date $args[0]", return undef if (! $date0);
-
- if ($#args == 0) {
- return &Events_Calc($date0);
- }
-
- if ($args[1]) {
- $date1=&ParseDateString($args[1]);
- warn "Invalid date $args[1]\n", return undef if (! $date1);
- if (&Date_Cmp($date0,$date1)>0) {
- $tmp=$date1;
- $date1=$date0;
- $date0=$tmp;
- }
- } else {
- $date0=&Date_SetTime($date0,"00:00:00");
- $date1=&DateCalc_DateDelta($date0,"+0:0:0:1:0:0:0");
- }
-
- $tmp=&Events_Calc($date0,$date1);
-
- $flag=$args[2];
- return $tmp if (! $flag);
-
- my(@tmp,%ret,$delta)=();
- @tmp=@$tmp;
- push(@tmp,$date1);
-
- if ($flag==1) {
- while ($#tmp>0) {
- ($date0,$tmp)=splice(@tmp,0,2);
- $date1=$tmp[0];
- $delta=&DateCalc_DateDate($date0,$date1);
- foreach $flag (@$tmp) {
- if (exists $ret{$flag}) {
- $ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta);
- } else {
- $ret{$flag}=$delta;
- }
- }
- }
- return \%ret;
-
- } elsif ($flag==2) {
- while ($#tmp>0) {
- ($date0,$tmp)=splice(@tmp,0,2);
- $date1=$tmp[0];
- $delta=&DateCalc_DateDate($date0,$date1);
- $flag=join("+",sort @$tmp);
- next if (! $flag);
- if (exists $ret{$flag}) {
- $ret{$flag}=&DateCalc_DeltaDelta($ret{$flag},$delta);
- } else {
- $ret{$flag}=$delta;
- }
- }
- return \%ret;
- }
-
- warn "Invalid flag $flag\n";
- return undef;
-}
-
-###
-# NOTE: The following routines may be called in the routines below with very
-# little time penalty.
-###
-sub Date_SetTime {
- print "DEBUG: Date_SetTime\n" if ($Curr{"Debug"} =~ /trace/);
- my($date,$h,$mn,$s)=@_;
- &Date_Init() if (! $Curr{"InitDone"});
- my($y,$m,$d)=();
-
- if (! &Date_Split($date)) {
- $date=&ParseDateString($date);
- return "" if (! $date);
- }
-
- ($y,$m,$d)=( &Date_Split($date, 1) )[0..2];
- ($h,$mn,$s)=&Date_ParseTime($h,$mn,$s);
-
- my($ampm,$wk);
- return "" if (&Date_DateCheck(\$y,\$m,\$d,\$h,\$mn,\$s,\$ampm,\$wk));
- &Date_Join($y,$m,$d,$h,$mn,$s);
-}
-
-sub Date_SetDateField {
- 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);
-
- if (! $y) {
- $date=&ParseDateString($date);
- return "" if (! $date);
- ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
- }
-
- if (lc($field) eq "y") {
- $y=$val;
- } elsif (lc($field) eq "m") {
- $m=$val;
- } elsif (lc($field) eq "d") {
- $d=$val;
- } elsif (lc($field) eq "h") {
- $h=$val;
- } elsif (lc($field) eq "mn") {
- $mn=$val;
- } elsif (lc($field) eq "s") {
- $s=$val;
- } else {
- confess "ERROR: Date_SetDateField: invalid field: $field\n";
- }
-
- $date=&Date_Join($y,$m,$d,$h,$mn,$s);
- return $date if ($nocheck || &Date_Split($date));
- return "";
-}
-
-########################################################################
-# OTHER SUBROUTINES
-########################################################################
-# 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
-# exceptions.
-# NOTE: Date_Init is a special case. It should be called (conditionally)
-# in every routine that uses any variable from the Date::Manip
-# namespace.
-########################################################################
-
-sub Date_DaysInMonth {
- print "DEBUG: Date_DaysInMonth\n" if ($Curr{"Debug"} =~ /trace/);
- my($m,$y)=@_;
- $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));
- return $d_in_m[$m];
-}
-
-sub Date_DayOfWeek {
- print "DEBUG: Date_DayOfWeek\n" if ($Curr{"Debug"} =~ /trace/);
- my($m,$d,$y)=@_;
- $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);
- return $dayofweek;
-}
-
-# Can't be in "use integer" because the numbers are too big.
-no integer;
-sub Date_SecsSince1970 {
- print "DEBUG: Date_SecsSince1970\n" if ($Curr{"Debug"} =~ /trace/);
- my($m,$d,$y,$h,$mn,$s)=@_;
- $y=&Date_FixYear($y) if (length($y)!=4);
- my($sec_now,$sec_70)=();
- $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;
- $sec_70 =62167219200;
- 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");
-
- my($tz)=$Cnf{"ConvTZ"};
- $tz=$Cnf{"TZ"} if (! $tz);
- $tz=$Zone{"n2o"}{lc($tz)} if ($tz !~ /^[+-]\d{4}$/);
-
- my($tzs)=1;
- $tzs=-1 if ($tz<0);
- $tz=~/.(..)(..)/;
- my($tzh,$tzm)=($1,$2);
- $sec - $tzs*($tzh*3600+$tzm*60);
-}
-use integer;
-
-sub Date_DaysSince1BC {
- print "DEBUG: Date_DaysSince1BC\n" if ($Curr{"Debug"} =~ /trace/);
- my($m,$d,$y)=@_;
- $y=&Date_FixYear($y) if (length($y)!=4);
- my($Ny,$N4,$N100,$N400,$dayofyear,$days)=();
- my($cc,$yy)=();
-
- $y=~ /(\d{2})(\d{2})/;
- ($cc,$yy)=($1,$2);
-
- # Number of full years since Dec 31, 1BC (counting the year 0000).
- $Ny=$y;
-
- # Number of full 4th years (incl. 0000) since Dec 31, 1BC
- $N4=($Ny-1)/4 + 1;
- $N4=0 if ($y==0);
-
- # Number of full 100th years (incl. 0000)
- $N100=$cc + 1;
- $N100-- if ($yy==0);
- $N100=0 if ($y==0);
-
- # Number of full 400th years (incl. 0000)
- $N400=($N100-1)/4 + 1;
- $N400=0 if ($y==0);
-
- $dayofyear=&Date_DayOfYear($m,$d,$y);
- $days= $Ny*365 + $N4 - $N100 + $N400 + $dayofyear;
-
- return $days;
-}
-
-sub Date_DayOfYear {
- print "DEBUG: Date_DayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
- my($m,$d,$y)=@_;
- $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);
- my($ly)=0;
- $ly=1 if ($m>2 && &Date_LeapYear($y));
- return ($days[$m-1]+$d+$ly);
-}
-
-sub Date_DaysInYear {
- print "DEBUG: Date_DaysInYear\n" if ($Curr{"Debug"} =~ /trace/);
- my($y)=@_;
- $y=&Date_FixYear($y) if (length($y)!=4);
- return 366 if (&Date_LeapYear($y));
- return 365;
-}
-
-sub Date_WeekOfYear {
- print "DEBUG: Date_WeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
- my($m,$d,$y,$f)=@_;
- &Date_Init() if (! $Curr{"InitDone"});
- $y=&Date_FixYear($y) if (length($y)!=4);
-
- my($day,$dow,$doy)=();
- $doy=&Date_DayOfYear($m,$d,$y);
-
- # The current DayOfYear and DayOfWeek
- if ($Cnf{"Jan1Week1"}) {
- $day=1;
- } else {
- $day=4;
- }
- $dow=&Date_DayOfWeek(1,$day,$y);
-
- # Move back to the first day of week 1.
- $f-=7 if ($f>$dow);
- $day-= ($dow-$f);
-
- return 0 if ($day>$doy); # Day is in last week of previous year
- return (($doy-$day)/7 + 1);
-}
-
-sub Date_LeapYear {
- print "DEBUG: Date_LeapYear\n" if ($Curr{"Debug"} =~ /trace/);
- my($y)=@_;
- $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;
- return 1;
-}
-
-sub Date_DaySuffix {
- print "DEBUG: Date_DaySuffix\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- &Date_Init() if (! $Curr{"InitDone"});
- return $Lang{$Cnf{"Language"}}{"DoML"}[$d-1];
-}
-
-sub Date_ConvTZ {
- print "DEBUG: Date_ConvTZ\n" if ($Curr{"Debug"} =~ /trace/);
- my($date,$from,$to)=@_;
- if (not Date_Split($date)) {
- croak "date passed in ('$date') is not a Date::Manip object";
- }
-
- &Date_Init() if (! $Curr{"InitDone"});
- my($gmt)=();
-
- if (! $from) {
-
- if (! $to) {
- # TZ -> ConvTZ
- return $date if ($Cnf{"ConvTZ"} eq "IGNORE" or ! $Cnf{"ConvTZ"});
- $from=$Cnf{"TZ"};
- $to=$Cnf{"ConvTZ"};
-
- } else {
- # ConvTZ,TZ -> $to
- $from=$Cnf{"ConvTZ"};
- $from=$Cnf{"TZ"} if (! $from);
- }
-
- } else {
-
- if (! $to) {
- # $from -> ConvTZ,TZ
- return $date if ($Cnf{"ConvTZ"} eq "IGNORE");
- $to=$Cnf{"ConvTZ"};
- $to=$Cnf{"TZ"} if (! $to);
-
- } else {
- # $from -> $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
-
- # and from GMT to $to
- $to=~/([+-])(\d{2})(\d{2})/;
- ($s2,$h2,$m2)=($1,$2,$3);
-
- if ($s1 eq $s2) {
- # Both the same sign
- $m+= $sign*($m1+$m2);
- $h+= $sign*($h1+$h2);
- } else {
- $sign=($s2 eq "-" ? +1 : -1) if ($h1<$h2 || ($h1==$h2 && $m1<$m2));
- $m+= $sign*($m1-$m2);
- $h+= $sign*($h1-$h2);
- }
-
- if ($m>59) {
- $h+= $m/60;
- $m-= ($m/60)*60;
- } elsif ($m<0) {
- $h+= ($m/60 - 1);
- $m-= ($m/60 - 1)*60;
- }
-
- if ($h>23) {
- $delta=$h/24;
- $h -= $delta*24;
- 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);
- }
- $d+= $delta;
- } elsif ($h<0) {
- $delta=-$h/24 + 1;
- $h += $delta*24;
- if (($d - $delta) < 1) {
- $date=&Date_Join($yr,$mon,$d,$h,$m,$sec);
- return &DateCalc_DateDelta($date,"-0:0:0:$delta:0:0:0",\$err,0);
- }
- $d-= $delta;
- }
- return &Date_Join($yr,$mon,$d,$h,$m,$sec);
-}
-
-sub Date_TimeZone {
- 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
- push(@tz,$ENV{'UCX$TZ'})
- 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
- ($OS eq "Windows") or
- ($OS eq "Netware") or
- ($OS eq "VMS")) {
- if ($Date::Manip::NoTaint) {
- if ($OS eq "VMS") {
- $tz=$ENV{'SYS$TIMEZONE_NAME'};
- if (! $tz) {
- $tz=$ENV{'MULTINET_TIMEZONE'};
- if (! $tz) {
- $tz=$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}/3600.; # e.g. '-4' for EDT
- }
- }
- } else {
- $tz=`date +%Z 2> /dev/null`;
- chomp($tz);
- if (! $tz) {
- $tz=`date 2> /dev/null`;
- chomp($tz);
- $tz=(split(/\s+/,$tz))[4];
- }
- }
- push(@tz,$tz);
- } else {
- # 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`;
- chomp($tz);
- if (! $tz) {
- $tz=`date 2> /dev/null`;
- chomp($tz);
- $tz=(split(/\s+/,$tz))[4];
- }
- push(@tz,$tz);
- }
- }
-
- push(@tz,$main::TZ) if (defined $main::TZ); # $main::TZ
-
- if (-s "/etc/TIMEZONE") { # /etc/TIMEZONE
- $in=new IO::File;
- $in->open("/etc/TIMEZONE","r");
- while (! eof($in)) {
- $tmp=<$in>;
- if ($tmp =~ /^TZ\s*=\s*(.*?)\s*$/) {
- push(@tz,$1);
- last;
- }
- }
- $in->close;
- }
-
- if (-s "/etc/timezone") { # /etc/timezone
- $in=new IO::File;
- $in->open("/etc/timezone","r");
- while (! eof($in)) {
- $tmp=<$in>;
- next if ($tmp =~ /^\s*\043/);
- chomp($tmp);
- if ($tmp =~ /^\s*(.*?)\s*$/) {
- push(@tz,$1);
- last;
- }
- }
- $in->close;
- }
-
- # Now parse each one to find the first valid one.
- foreach $tz (@tz) {
- $tz =~ s/\s*$//;
- $tz =~ s/^\s*//;
- next if (! $tz);
-
- return uc($tz)
- if (defined $Zone{"n2o"}{lc($tz)});
-
- if ($tz =~ /^[+-]\d{4}$/) {
- return $tz;
- } elsif ($tz =~ /^([+-]\d{2})(?::(\d{2}))?$/) {
- my($h,$m)=($1,$2);
- $m="00" if (! $m);
- return "$h$m";
- }
-
- # Handle US/Eastern format
- if ($tz =~ /^$Zone{"tzones"}$/i) {
- $tmp=lc $1;
- $tz=$Zone{"tz2z"}{$tmp};
- }
-
- # Handle STD#DST# format (and STD-#DST-# formats)
- if ($tz =~ /^([a-z]+)-?\d([a-z]+)-?\d?$/i) {
- ($std,$dst)=($1,$2);
- next if (! defined $Zone{"n2o"}{lc($std)} or
- ! defined $Zone{"n2o"}{lc($dst)});
- $time = time();
- ($null,$null,$null,$null,$null,$null,$null,$null,$isdst) =
- localtime($time);
- return uc($dst) if ($isdst);
- return uc($std);
- }
- }
-
- 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.
-sub Date_IsWorkDay {
- print "DEBUG: Date_IsWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
- my($date,$time)=@_;
- &Date_Init() if (! $Curr{"InitDone"});
- $date=&ParseDateString($date);
- return "" if (! $date);
- my($d)=$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}={};
- &Date_UpdateHolidays($y)
- }
- $d=&Date_SetTime($date,"00:00:00");
- return 0 if (exists $Holiday{"dates"}{$y}{$d});
- 1;
-}
-
-# 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.
-sub Date_NextWorkDay {
- print "DEBUG: Date_NextWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
- my($date,$off,$time)=@_;
- &Date_Init() if (! $Curr{"InitDone"});
- $date=&ParseDateString($date);
- my($err)=();
-
- if (! &Date_IsWorkDay($date,$time)) {
- if ($time) {
- while (1) {
- $date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
- last if (&Date_IsWorkDay($date,$time));
- }
- } else {
- while (1) {
- $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
- last if (&Date_IsWorkDay($date,$time));
- }
- }
- }
-
- while ($off>0) {
- while (1) {
- $date=&DateCalc_DateDelta($date,"+0:0:0:1:0:0:0",\$err,0);
- last if (&Date_IsWorkDay($date,$time));
- }
- $off--;
- }
-
- return $date;
-}
-
-# 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.
-sub Date_PrevWorkDay {
- print "DEBUG: Date_PrevWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
- my($date,$off,$time)=@_;
- &Date_Init() if (! $Curr{"InitDone"});
- $date=&ParseDateString($date);
- my($err)=();
-
- if (! &Date_IsWorkDay($date,$time)) {
- if ($time) {
- while (1) {
- $date=&Date_GetPrev($date,undef,0,$Cnf{"WorkDayEnd"});
- last if (&Date_IsWorkDay($date,$time));
- }
- while (1) {
- $date=&Date_GetNext($date,undef,0,$Cnf{"WorkDayBeg"});
- last if (&Date_IsWorkDay($date,$time));
- }
- } else {
- while (1) {
- $date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
- last if (&Date_IsWorkDay($date,$time));
- }
- }
- }
-
- while ($off>0) {
- while (1) {
- $date=&DateCalc_DateDelta($date,"-0:0:0:1:0:0:0",\$err,0);
- last if (&Date_IsWorkDay($date,$time));
- }
- $off--;
- }
-
- return $date;
-}
-
-# This finds the nearest workday to $date. If $date is a workday, it
-# is returned.
-sub Date_NearestWorkDay {
- print "DEBUG: Date_NearestWorkDay\n" if ($Curr{"Debug"} =~ /trace/);
- my($date,$tomorrow)=@_;
- &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));
-
- # Find the nearest one.
- if ($tomorrow) {
- $dela="+0:0:0:1:0:0:0";
- $delb="-0:0:0:1:0:0:0";
- } else {
- $dela="-0:0:0:1:0:0:0";
- $delb="+0:0:0:1:0:0:0";
- }
- $a=$b=$date;
-
- while (1) {
- $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.
-sub Date_NthDayOfYear {
- no integer;
- print "DEBUG: Date_NthDayOfYear\n" if ($Curr{"Debug"} =~ /trace/);
- my($y,$n)=@_;
- $y=$Curr{"Y"} if (! $y);
- $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<1);
- 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;
- my $h=int($remain);
- $remain=($remain - $h)*60;
- my $mn=int($remain);
- $remain=($remain - $mn)*60;
- my $s=$remain;
-
- # Calculate the month and the day.
- my($m,$d)=(0,0);
- $n=int($n);
- while ($n>0) {
- $m++;
- if ($n<=$d_in_m[0]) {
- $d=int($n);
- $n=0;
- } else {
- $n-= $d_in_m[0];
- shift(@d_in_m);
- }
- }
-
- ($y,$m,$d,$h,$mn,$s);
-}
-
-########################################################################
-# NOT FOR EXPORT
-########################################################################
-
-# 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.
-#
-# IN:
-# $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
-#
-# OUT:
-# $regexp = '(?:key1|key2|...)'
-# $hash = { key1=>val1 key2=>val2 ... }
-
-sub Date_InitHash {
- print "DEBUG: Date_InitHash\n" if ($Curr{"Debug"} =~ /trace/);
- my($data,$regexp,$opts,$hash)=@_;
- my(@data)=@$data;
- my($key,$val,@list)=();
-
- # Parse the options
- 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 hash
- while (@data) {
- ($key,$val,@data)=@data;
- $key=lc($key) if ($lc);
- $$hash{$key}=$val;
- }
-
- # Create the regular expression
- if ($regexp) {
- @list=keys(%$hash);
- @list=sort sortByLength(@list) if ($sort);
- if ($escape) {
- foreach $val (@list) {
- $val="\Q$val\E";
- }
- }
- if ($back) {
- $$regexp="(" . join("|",@list) . ")";
- } else {
- $$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).
-#
-# IN:
-# $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 }
-#
-# OUT:
-# $regexp = '(?:valA1|valA2|...|valB1|...)'
-# $lists = [ [ valA1 valA2 ... ] # only the 1st list (or
-# [ valB1 valB2 ... ] ... ] # 2nd for int. characters)
-# $hash
-
-sub Date_InitLists {
- print "DEBUG: Date_InitLists\n" if ($Curr{"Debug"} =~ /trace/);
- my($data,$regexp,$opts,$lists,$hash)=@_;
- my(@data)=@$data;
- my(@lists)=@$lists;
- my($i,@ele,$ele,@list,$j,$tmp)=();
-
- # Parse the options
- 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);
-
- # Set each of the lists
- if (@lists) {
- confess "ERROR: Date_InitLists: lists must be 1 per data\n"
- if ($#lists != $#data);
- for ($i=0; $i<=$#data; $i++) {
- @ele=@{ $data[$i] };
- if ($Cnf{"IntCharSet"} && $#ele>0) {
- @{ $lists[$i] } = @{ $ele[1] };
- } else {
- @{ $lists[$i] } = @{ $ele[0] };
- }
- }
- }
-
- # Create the hash
- my($hashtype,$hashsave,%hash)=();
- if (@$hash) {
- ($hash,$hashtype)=@$hash;
- $hashsave=1;
- } else {
- $hashtype=0;
- $hashsave=0;
- }
- for ($i=0; $i<=$#data; $i++) {
- @ele=@{ $data[$i] };
- foreach $ele (@ele) {
- @list = @{ $ele };
- for ($j=0; $j<=$#list; $j++) {
- $tmp=$list[$j];
- next if (! $tmp);
- $tmp=lc($tmp) if ($lc);
- $hash{$tmp}= $j+$hashtype;
- }
- }
- }
- %$hash = %hash if ($hashsave);
-
- # Create the regular expression
- if ($regexp) {
- @list=keys(%hash);
- @list=sort sortByLength(@list) if ($sort);
- if ($escape) {
- foreach $ele (@list) {
- $ele="\Q$ele\E";
- }
- }
- if ($back) {
- $$regexp="(" . join("|",@list) . ")";
- } else {
- $$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).
-#
-# IN:
-# $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
-#
-# OUT:
-# $regexp = '(string1|string2|...)'
-
-sub Date_InitStrings {
- print "DEBUG: Date_InitStrings\n" if ($Curr{"Debug"} =~ /trace/);
- my($data,$regexp,$opts)=@_;
- my(@list)=@{ $data };
-
- # Parse the options
- 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
- my($ele)=();
- @list=sort sortByLength(@list) if ($sort);
- if ($escape) {
- foreach $ele (@list) {
- $ele="\Q$ele\E";
- }
- }
- if ($back) {
- $$regexp="(" . join("|",@list) . ")";
- } else {
- $$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
-# "" @list empty
-# $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
-# the first two forms
-# optws : the regular expression is optional and may be replaced by
-# whitespace
-# 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"],
-# [\@Month,\@Mon],
-# [\%Month,1]);
-
-# 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
-# "" @list empty
-# $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
-# the first two forms
-# optws : the regular expression is optional and may be replaced by
-# whitespace
-# 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
-sub Date_Regexp {
- print "DEBUG: Date_Regexp\n" if ($Curr{"Debug"} =~ /trace/);
- my($list,$options,$array)=@_;
- my(@list,$ret,%hash,$i)=();
- local($_)=();
- $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);
-
- my($ref)=ref $list;
- if (! $ref) {
- $list =~ s/\s*$//;
- $list =~ s/^\s*//;
- $list =~ s/\s+/&&&/g;
- } elsif ($ref eq "ARRAY") {
- $list = join("&&&",@$list);
- } else {
- confess "ERROR: Date_Regexp.\n";
- }
-
- if (! $list) {
- if ($back eq "") {
- return "()";
- } else {
- return "";
- }
- }
-
- $list=lc($list) if ($lc);
- $list=~ s/_/ /g if ($under);
- @list=split(/&&&/,$list);
- if ($keys) {
- %hash=@list;
- @list=keys %hash;
- } elsif ($key0 or $key1 or $val0 or $val1) {
- $i=0;
- $i=1 if ($key1 or $val1);
- if ($key0 or $key1) {
- %hash= map { $_,$i++ } @list;
- } else {
- %hash= map { $i++,$_ } @list;
- }
- }
- @list=sort sortByLength(@list) if ($sort);
-
- $ret="($back" . join("|",@list) . ")";
- $ret="(?:$pre$ret$post)" if ($pre or $post);
- $ret.=$opt;
- $ret="(?:$ret|$ws)" if ($ws);
-
- if ($array and $hash) {
- return ($ret,%hash);
- } elsif ($array) {
- return ($ret,@list);
- } else {
- return $ret;
- }
-}
-
-# 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.
-sub Delta_Normalize {
- print "DEBUG: Delta_Normalize\n" if ($Curr{"Debug"} =~ /trace/);
- my($delta,$mode)=@_;
- return "" if (! $delta);
- 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=24*60;
- $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
- # be a negative delta).
-
- 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.
-
- # Do the year/month part
-
- $mon += $y*12; # convert y to m
- $sign1="+";
- if ($mon<0) {
- $mon *= -1;
- $sign1="-";
- }
-
- $y = $mon/12; # convert m to y
- $mon -= $y*12;
-
- $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
- # apart.
- no integer;
-
- if ($mode==3 || $mode==2) {
- $s += $d*$len*60 + $h*3600 + $m*60; # convert d/h/m to s
- } else {
- $s += ($d+7*$w)*$len*60 + $h*3600 + $m*60; # convert w/d/h/m to s
- }
- $sign2="+";
- if ($s<0) {
- $s*=-1;
- $sign2="-";
- }
-
- $m = int($s/60); # convert s to m
- $s -= $m*60;
- $d = int($m/$len); # convert m to d
- $m -= $d*$len;
-
- # The rest should be fine.
- }
- $h = $m/60; # convert m to h
- $m -= $h*60;
- if ($mode == 3 || $mode == 2) {
- $w = $w*1; # get around +0 problem
- } else {
- $w = $d/7; # convert d to w
- $d -= $w*7;
- }
-
- $w=0 if ($w eq "-0"); # get around silly -0 problem
- $d=0 if ($d eq "-0");
- $h=0 if ($h eq "-0");
- $m=0 if ($m eq "-0");
- $s=0 if ($s eq "-0");
-
- # 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";
- } else {
- 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.
-sub Delta_Split {
- print "DEBUG: Delta_Split\n" if ($Curr{"Debug"} =~ /trace/);
- my($delta,$sign,$exact)=@_;
- my(@delta)=split(/:/,$delta);
- return () if ($exact and $#delta != 6);
- my($i)=();
- $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];
- }
- @delta;
-}
-
-# Reads up to 3 arguments. $h may contain the time in any international
-# format. Any empty elements are set to 0.
-sub Date_ParseTime {
- print "DEBUG: Date_ParseTime\n" if ($Curr{"Debug"} =~ /trace/);
- my($h,$m,$s)=@_;
- my($t)=&CheckTime("one");
-
- if (defined $h and $h =~ /$t/) {
- $h=$1;
- $m=$2;
- $s=$3 if (defined $3);
- }
- $h="00" if (! defined $h);
- $m="00" if (! defined $m);
- $s="00" if (! defined $s);
-
- ($h,$m,$s);
-}
-
-# Forms a date with the 6 elements passed in (all of which must be defined).
-# No check as to validity is made.
-sub Date_Join {
- print "DEBUG: Date_Join\n" if ($Curr{"Debug"} =~ /trace/);
- foreach (0 .. $#_) {
- 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) {
- $ym=$md=$dh="";
- $hmn=$mns=":";
-
- } elsif ($Cnf{"Internal"} == 1) {
- $ym=$md=$dh=$hmn=$mns="";
-
- } elsif ($Cnf{"Internal"} == 2) {
- $ym=$md="-";
- $dh=" ";
- $hmn=$mns=":";
-
- } else {
- 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
-# returned.
-sub CheckTime {
- print "DEBUG: CheckTime\n" if ($Curr{"Debug"} =~ /trace/);
- my($time)=@_;
- my($h)='(?:0?[0-9]|1[0-9]|2[0-3])';
- my($h2)='(?:0[0-9]|1[0-9]|2[0-3])';
- my($m)='[0-5][0-9]';
- my($s)=$m;
- 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+)?)?\$";
- if ($time eq "one") {
- return $t;
- } elsif ($time eq "two") {
- $t="^($h2)$hm($m)(?:$ms($s)(?:$ss\\d+)?)?\$";
- return $t;
- }
-
- if ($time =~ /$t/i) {
- ($h,$m,$s)=($1,$2,$3);
- $h="0$h" if (length($h)<2);
- $m="0$m" if (length($m)<2);
- $s="00" if (! defined $s);
- return ($h,$m,$s);
- } else {
- return ();
- }
-}
-
-# 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);
-sub Recur_Split {
- print "DEBUG: Recur_Split\n" if ($Curr{"Debug"} =~ /trace/);
- my($recur)=@_;
- my(@ret,@tmp);
-
- my($R) = '(\*?(?:[-,0-9]+[:\*]){6}[-,0-9]+)';
- my($F) = '(?:\*([^*]*))';
- my($DB,$D0,$D1);
- $DB=$D0=$D1=$F;
-
- if ($recur =~ /^$R$F?$DB?$D0?$D1?$/) {
- @ret=($1,$2,$3,$4,$5);
- @tmp=split(/\*/,shift(@ret));
- return () if ($#tmp>1);
- return (@tmp,"",@ret) if ($#tmp==0);
- return (@tmp,@ret);
- }
- return ();
-}
-
-# 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 ().
-#
-sub Date_Split {
- 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($y)='(\d{4})';
- 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])';
- my($mn)='([0-5][0-9])';
- my($s)=$mn;
-
- if ($Cnf{"Internal"} == 0) {
- $ym=$md=$dh="";
- $hmn=$mns=":";
-
- } elsif ($Cnf{"Internal"} == 1) {
- $ym=$md=$dh=$hmn=$mns="";
-
- } elsif ($Cnf{"Internal"} == 2) {
- $ym=$md="-";
- $dh=" ";
- $hmn=$mns=":";
-
- } else {
- 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 '') {
- if ($definitely_valid) {
- die "bad date '$date'";
- } else {
- return $t;
- }
- }
-
- if ($date =~ /$t/) {
- ($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));
- if ($d>$d_in_m[$m]) {
- my $msg = "invalid date $date: day $d of month $m, but only $d_in_m[$m] days in that month";
- if ($definitely_valid) {
- die $msg;
- }
- else {
- warn $msg;
- return ();
- }
- }
- return ($y,$m,$d,$h,$mn,$s);
- }
-
- if ($definitely_valid) {
- die "invalid date $date: doesn't match regexp $t";
- }
- return ();
-}
-
-# This returns the date easter occurs on for a given year as ($month,$day).
-# This is from the Calendar FAQ.
-sub Date_Easter {
- my($y)=@_;
- $y=&Date_FixYear($y) if (length($y)==2);
-
- my($c) = $y/100;
- my($g) = $y % 19;
- my($k) = ($c-17)/25;
- 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($l) = $i-$j;
- my($m) = 3 + ($l+40)/44;
- my($d) = $l + 28 - 31*($m/4);
- return ($m,$d);
-}
-
-# 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).
-sub Date_Recur_WoM {
- my($y,$m,$w,$d,$FDn,$FIn)=@_;
- my(@y)=@$y;
- my(@m)=@$m;
- my(@w)=@$w;
- my(@d)=@$d;
- my($date0,$date1,@tmp,@date,$d0,$d1,@tmp2)=();
-
- if (@m) {
- @tmp=();
- foreach $y (@y) {
- return () if (length($y)==1 || length($y)==3 || ! &IsInt($y,0,9999));
- $y=&Date_FixYear($y) if (length($y)==2);
- push(@tmp,$y);
- }
- @y=sort { $a<=>$b } (@tmp);
-
- return () if (! @m);
- foreach $m (@m) {
- return () if (! &IsInt($m,1,12));
- }
- @m=sort { $a<=>$b } (@m);
-
- @tmp=@tmp2=();
- foreach $y (@y) {
- foreach $m (@m) {
- push(@tmp,$y);
- push(@tmp2,$m);
- }
- }
-
- @y=@tmp;
- @m=@tmp2;
-
- } else {
- foreach $d0 (@y) {
- @tmp=&Date_Split($d0);
- return () if (! @tmp);
- push(@tmp2,$tmp[0]);
- push(@m,$tmp[1]);
- }
- @y=@tmp2;
- }
-
- return () if (! @w);
- foreach $w (@w) {
- return () if ($w==0 || ! &IsInt($w,-5,5));
- }
-
- if (@d) {
- foreach $d (@d) {
- return () if (! &IsInt($d,1,7));
- }
- @d=sort { $a<=>$b } (@d);
- }
-
- @date=();
- foreach $y (@y) {
- $m=shift(@m);
-
- # 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");
-
- if (@d) {
- foreach $d (@d) {
- # Find 1st occurence of DOW (in both months)
- $d0=&Date_GetNext($date0,$d,1);
- $d1=&Date_GetNext($date1,$d,1);
-
- @tmp=();
- while (&Date_Cmp($d0,$d1)<0) {
- push(@tmp,$d0);
- $d0=&DateCalc($d0,"+0:0:1:0:0:0:0");
- }
-
- @tmp2=();
- foreach $w (@w) {
- if ($w>0) {
- push(@tmp2,$tmp[$w-1]);
- } else {
- push(@tmp2,$tmp[$#tmp+1+$w]);
- }
- }
- @tmp2=sort(@tmp2);
- push(@date,@tmp2);
- }
-
- } else {
- # Find 1st day of 1st week
- if ($FDn != 0) {
- $date0=&Date_GetNext($date0,$FDn,1);
- } else {
- $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
- if ($FDn != 0) {
- $date1=&Date_GetNext($date1,$FDn,1);
- } else {
- $date1=&DateCalc($date1,"+0:0:0:".($FIn-1).":0:0:0") if ($FIn>1);
- }
- $date1=&Date_GetPrev($date1,$Cnf{"FirstDay"},1);
-
- @tmp=();
- while (&Date_Cmp($date0,$date1)<0) {
- push(@tmp,$date0);
- $date0=&DateCalc($date0,"+0:0:1:0:0:0:0");
- }
-
- @tmp2=();
- foreach $w (@w) {
- if ($w>0) {
- push(@tmp2,$tmp[$w-1]);
- } else {
- push(@tmp2,$tmp[$#tmp+1+$w]);
- }
- }
- @tmp2=sort(@tmp2);
- push(@date,@tmp2);
- }
- }
-
- @date;
-}
-
-# 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).
-sub Date_Recur {
- my($date0,$date1,$dateb,$delta)=@_;
- my(@ret,$d)=();
-
- 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
- $d=$dateb;
- while (&Date_Cmp($d,$date0)>=0) {
- unshift(@ret,$d);
- $d=&DateCalc_DateDelta($d,"-$delta");
- }
- # Add the first date earler than the range
- unshift(@ret,$d);
-
- # Add the dates $dateb..$date1
- $d=&DateCalc_DateDelta($dateb,$delta);
- while (&Date_Cmp($d,$date1)<0) {
- push(@ret,$d);
- $d=&DateCalc_DateDelta($d,$delta);
- }
- # Add the first date later than the range
- push(@ret,$d);
-
- @ret;
-}
-
-# 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).
-sub Date_RecurSetTime {
- my($date0,$date1,$dates,$h,$m,$s)=@_;
- my(@dates)=@$dates;
- my(@h,@m,@s,$date,@tmp)=();
-
- $m="-1" if ($s eq "-1");
- $h="-1" if ($m eq "-1");
-
- if ($h ne "-1") {
- @h=&ReturnList($h);
- return () if ! (@h);
- @h=sort { $a<=>$b } (@h);
-
- @tmp=();
- foreach $date (@dates) {
- foreach $h (@h) {
- push(@tmp,&Date_SetDateField($date,"h",$h,1));
- }
- }
- @dates=@tmp;
- }
-
- if ($m ne "-1") {
- @m=&ReturnList($m);
- return () if ! (@m);
- @m=sort { $a<=>$b } (@m);
-
- @tmp=();
- foreach $date (@dates) {
- foreach $m (@m) {
- push(@tmp,&Date_SetDateField($date,"mn",$m,1));
- }
- }
- @dates=@tmp;
- }
-
- if ($s ne "-1") {
- @s=&ReturnList($s);
- return () if ! (@s);
- @s=sort { $a<=>$b } (@s);
-
- @tmp=();
- foreach $date (@dates) {
- foreach $s (@s) {
- push(@tmp,&Date_SetDateField($date,"s",$s,1));
- }
- }
- @dates=@tmp;
- }
-
- @tmp=();
- foreach $date (@dates) {
- push(@tmp,$date) if (&Date_Cmp($date,$date0)>=0 &&
- &Date_Cmp($date,$date1)<0 &&
- &Date_Split($date));
- }
-
- @tmp;
-}
-
-sub DateCalc_DateDate {
- print "DEBUG: DateCalc_DateDate\n" if ($Curr{"Debug"} =~ /trace/);
- my($D1,$D2,$mode)=@_;
- my(@d_in_m)=(0,31,28,31,30,31,30,31,31,30,31,30,31);
- $mode=0 if (! defined $mode);
-
- # Exact mode
- if ($mode==0) {
- 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
- $delta[4]=$h2-$h1;
- $delta[5]=$mn2-$mn1;
- $delta[6]=$s2-$s1;
-
- # form the delta for yr/mon/day
- $delta[0]=$delta[1]=0;
- $d=0;
- if ($y2>$y1) {
- $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);
- }
- } elsif ($y2<$y1) {
- $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 *= -1;
- } else {
- $d=&Date_DayOfYear($m2,$d2,$y2) - &Date_DayOfYear($m1,$d1,$y1);
- }
- $delta[2]=0;
- $delta[3]=$d;
-
- for ($i=0; $i<7; $i++) {
- $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
- }
-
- $delta=join(":",@delta);
- $delta=&Delta_Normalize($delta,0);
- return $delta;
- }
-
- 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) {
- $sign="-";
- $tmp=$date1;
- $date1=$date2;
- $date2=$tmp;
- } else {
- $sign="+";
- }
- if (&Date_Cmp($date1,$date2)==0) {
- return "+0:+0:+0:+0:+0:+0:+0" if ($Cnf{"DeltaSigns"});
- return "+0:0:0:0:0:0:0";
- }
-
- 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);
-
- if ($mode != 3) {
-
- # Do years
- $dy=$y2-$y1;
- $dm=0;
- if ($dy>0) {
- $tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0);
- if (&Date_Cmp($tmp,$date2)>0) {
- $dy--;
- $tmp=$date1;
- $tmp=&DateCalc_DateDelta($date1,"+$dy:0:0:0:0:0:0",\$err,0)
- if ($dy>0);
- $dm=12;
- }
- $date1=$tmp;
- }
-
- # Do months
- $dm+=$m2-$m1;
- if ($dm>0) {
- $tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0);
- if (&Date_Cmp($tmp,$date2)>0) {
- $dm--;
- $tmp=$date1;
- $tmp=&DateCalc_DateDelta($date1,"+0:$dm:0:0:0:0:0",\$err,0)
- if ($dm>0);
- }
- $date1=$tmp;
- }
-
- # 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 ($mode==2) {
- if (! &Date_IsWorkDay($date1,0)) {
- $date1=&Date_NextWorkDay($date1,0,1);
- }
- }
- }
-
- # Do days
- if ($mode==2 || $mode==3) {
- $dd=0;
- while (1) {
- $tmp=&Date_NextWorkDay($date1,1,1);
- if (&Date_Cmp($tmp,$date2)<=0) {
- $dd++;
- $date1=$tmp;
- } else {
- last;
- }
- }
-
- } else {
- ($y1,$m1,$d1)=( &Date_Split($date1, 1) )[0..2];
- $dd=0;
- # 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
- # of this month)
- if ($m1!=$m2) {
- $d_in_m[2]=29 if (&Date_LeapYear($y1));
- $dd=$d_in_m[$m1]-$d1+1;
- $d1=1;
- $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
- if (&Date_Cmp($tmp,$date2)>0) {
- $dd--;
- $d1--;
- $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$dd:0:0:0",\$err,0);
- }
- $date1=$tmp;
- }
-
- $ddd=0;
- if ($d1<$d2) {
- $ddd=$d2-$d1;
- $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
- if (&Date_Cmp($tmp,$date2)>0) {
- $ddd--;
- $tmp=&DateCalc_DateDelta($date1,"+0:0:0:$ddd:0:0:0",\$err,0);
- }
- $date1=$tmp;
- }
- $dd+=$ddd;
- }
-
- # 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];
- $dh=$dmn=$ds=0;
- 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=&Delta_Split($tmp);
- $dh += $tmp[4];
- $dmn += $tmp[5];
- $ds += $tmp[6];
-
- $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($D1,$D2,$mode)=@_;
- my(@delta1,@delta2,$i,$delta,@delta)=();
- $mode=0 if (! defined $mode);
-
- @delta1=&Delta_Split($D1);
- @delta2=&Delta_Split($D2);
- for ($i=0; $i<7; $i++) {
- $delta[$i]=$delta1[$i]+$delta2[$i];
- $delta[$i]="+".$delta[$i] if ($delta[$i]>=0);
- }
-
- $delta=join(":",@delta);
- $delta=&Delta_Normalize($delta,$mode);
- return $delta;
-}
-
-sub DateCalc_DateDelta {
- print "DEBUG: DateCalc_DateDelta\n" if ($Curr{"Debug"} =~ /trace/);
- my($D1,$D2,$errref,$mode)=@_;
- my($date)=();
- 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) {
- $h1=$Curr{"WDBh"};
- $m1=$Curr{"WDBm"};
- $h2=$Curr{"WDEh"};
- $m2=$Curr{"WDEm"};
- $hh=$h2-$h1;
- $mm=$m2-$m1;
- if ($mm<0) {
- $hh--;
- $mm+=60;
- }
- }
-
- # Date, delta
- my($y,$m,$d,$h,$mn,$s)=&Date_Split($D1, 1);
- my($dy,$dm,$dw,$dd,$dh,$dmn,$ds)=&Delta_Split($D2);
-
- # do the month/year part
- $y+=$dy;
- while (length($y)<4) {
- $y = "0$y";
- }
- &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 ($d>$d_in_m[$m]) {
- $d=$d_in_m[$m];
- }
-
- # do the week part
- if ($mode==0 || $mode==1) {
- $dd += $dw*7;
- } else {
- $date=&DateCalc_DateDelta(&Date_Join($y,$m,$d,$h,$mn,$s),
- "+0:0:$dw:0:0:0:0",0);
- ($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
- # stuff will work out
- 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) {
- while (1) {
- &ModuloAddition(60,$dmn,\$mn,\$h);
- $h+= $dh;
-
- if ($h>$h2 or $h==$h2 && $mn>$m2) {
- $dh=$h-$h2;
- $dmn=$mn-$m2;
- $h=$h1;
- $mn=$m1;
- $dd++;
-
- } elsif ($h<$h1 or $h==$h1 && $mn<$m1) {
- $dh=$h-$h1;
- $dmn=$m1-$mn;
- $h=$h2;
- $mn=$m2;
- $dd--;
-
- } elsif ($h==$h2 && $mn==$m2) {
- $dd++;
- $dh=-$hh;
- $dmn=-$mm;
-
- } else {
- last;
- }
- }
-
- } else {
- &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
- # up for this:
- if ($d>$d_in_m[$m]) {
- $dd+= $d-$d_in_m[$m];
- $d=$d_in_m[$m];
- }
-
- # days
- if ($mode==2 || $mode==3) {
- if ($dd>=0) {
- $date=&Date_NextWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),$dd,1);
- } else {
- $date=&Date_PrevWorkDay(&Date_Join($y,$m,$d,$h,$mn,$s),-$dd,1);
- }
- ($y,$m,$d,$h,$mn,$s)=&Date_Split($date, 1);
-
- } else {
- $d_in_m[2]=29 if (&Date_LeapYear($y));
- $d=$d_in_m[$m] if ($d>$d_in_m[$m]);
- $d += $dd;
- while ($d<1) {
- $m--;
- if ($m==0) {
- $m=12;
- $y--;
- if (&Date_LeapYear($y)) {
- $d_in_m[2]=29;
- } else {
- $d_in_m[2]=28;
- }
- }
- $d += $d_in_m[$m];
- }
- while ($d>$d_in_m[$m]) {
- $d -= $d_in_m[$m];
- $m++;
- if ($m==13) {
- $m=1;
- $y++;
- if (&Date_LeapYear($y)) {
- $d_in_m[2]=29;
- } else {
- $d_in_m[2]=28;
- }
- }
- }
- }
-
- if ($y<0 or $y>9999) {
- $$errref=3;
- return;
- }
- &Date_Join($y,$m,$d,$h,$mn,$s);
-}
-
-sub Date_UpdateHolidays {
- print "DEBUG: Date_UpdateHolidays\n" if ($Curr{"Debug"} =~ /trace/);
- my($year)=@_;
- $Holiday{"year"}=$year;
- $Holiday{"dates"}{$year}={};
-
- my($date,$delta,$err)=();
- my($key,@tmp,$tmp);
-
- foreach $key (keys %{ $Holiday{"desc"} }) {
- @tmp=&Recur_Split($key);
- if (@tmp) {
- $tmp=&ParseDateString("${year}010100:00:00");
- ($date)=&ParseRecur($key,$tmp,$tmp,($year+1)."-01-01");
- next if (! $date);
-
- } elsif ($key =~ /^(.*)([+-].*)$/) {
- # Date +/- Delta
- ($date,$delta)=($1,$2);
- $tmp=&ParseDateString("$date $year");
- if ($tmp) {
- $date=$tmp;
- } else {
- $date=&ParseDateString($date);
- next if ($date !~ /^$year/);
- }
- $date=&DateCalc($date,$delta,\$err,0);
-
- } else {
- # Date
- $date=$key;
- $tmp=&ParseDateString("$date $year");
- if ($tmp) {
- $date=$tmp;
- } else {
- $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/);
- my($var,$val)=@_;
-
- # 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);
-
- $Curr{"InitLang"}=1,
- $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);
- $Cnf{"WorkDayBeg"}=$val,
- $Curr{"ResetWorkDay"}=1, return if ($var =~ /^WorkDayBeg$/i);
- $Cnf{"WorkDayEnd"}=$val,
- $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";
-}
-
-sub EraseHolidays {
- print "DEBUG: EraseHolidays\n" if ($Curr{"Debug"} =~ /trace/);
-
- $Cnf{"EraseHolidays"}=0;
- delete $Holiday{"list"};
- $Holiday{"list"}={};
- delete $Holiday{"desc"};
- $Holiday{"desc"}={};
- $Holiday{"dates"}={};
-}
-
-# 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.
-sub Events_Calc {
- print "DEBUG: Events_Calc\n" if ($Curr{"Debug"} =~ /trace/);
-
- my($date0,$date1)=@_;
-
- my($tmp);
- $date0=&ParseDateString($date0);
- return undef if (! $date0);
- if ($date1) {
- $date1=&ParseDateString($date1);
- if (&Date_Cmp($date0,$date1)>0) {
- $tmp=$date1;
- $date1=$date0;
- $date0=$tmp;
- }
- } else {
- $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"} };
- DATE: while (@tmp) {
- ($d0,$d1,$del,$name)=splice(@tmp,0,4);
- $d0=&ParseDateString($d0);
- $d1=&ParseDateString($d1) if ($d1);
- $del=&ParseDateDelta($del) if ($del);
- if ($d1) {
- if ($del) {
- $d1=&DateCalc_DateDelta($d1,$del);
- }
- } else {
- $d1=&DateCalc_DateDelta($d0,$del);
- }
- if (&Date_Cmp($d0,$d1)>0) {
- $tmp=$d1;
- $d1=$d0;
- $d0=$tmp;
- }
- # [ date0,date1 )
- # [ d0,d1 ) OR [ d0,d1 )
- next DATE if (&Date_Cmp($d1,$date0)<=0 ||
- &Date_Cmp($d0,$date1)>=0);
- # [ date0,date1 )
- # [ d0,d1 )
- # [ d0, d1 )
- if (&Date_Cmp($d0,$date0)<=0) {
- push @{ $ret{$date0} },$name;
- push @{ $ret{$d1} },"!$name" if (&Date_Cmp($d1,$date1)<0);
- next DATE;
- }
- # [ date0,date1 )
- # [ d0,d1 )
- if (&Date_Cmp($d1,$date1)>=0) {
- push @{ $ret{$d0} },$name;
- next DATE;
- }
- # [ date0,date1 )
- # [ d0,d1 )
- push @{ $ret{$d0} },$name;
- push @{ $ret{$d1} },"!$name";
- }
-
- #
- # [ recur,delta0,delta1,name ] => [ {date-delta0},{date+delta1} )
- #
- my($rec,$del0,$del1,@d);
- @tmp=@{ $Events{"recur"} };
- RECUR: while (@tmp) {
- ($rec,$del0,$del1,$name)=splice(@tmp,0,4);
- @d=();
-
- }
-
- # Sort them AND take into account the "!$name" entries.
- my(%tmp,$date,@tmp2,@ret);
- @d=sort { &Date_Cmp($a,$b) } keys %ret;
- foreach $date (@d) {
- @tmp=@{ $ret{$date} };
- @tmp2=();
- foreach $tmp (@tmp) {
- push(@tmp2,$tmp), next if ($tmp =~ /^!/);
- $tmp{$tmp}=1;
- }
- foreach $tmp (@tmp2) {
- $tmp =~ s/^!//;
- delete $tmp{$tmp};
- }
- push(@ret,$date,[ keys %tmp ]);
- }
-
- return \@ret;
-}
-
-# This parses the raw events list
-sub Events_ParseRaw {
- print "DEBUG: Events_ParseRaw\n" if ($Curr{"Debug"} =~ /trace/);
-
- # Only need to be parsed once
- my($force)=@_;
- $Events{"parsed"}=0 if ($force);
- return if ($Events{"parsed"});
- $Events{"parsed"}=1;
-
- my(@events)=@{ $Events{"raw"} };
- my($event,$name,@event,$date0,$date1,$tmp,$delta,$recur0,$recur1,@recur,$r,
- $recur);
- EVENT: while (@events) {
- ($event,$name)=splice(@events,0,2);
- @event=split(/\s*;\s*/,$event);
-
- if ($#event == 0) {
-
- if ($date0=&ParseDateString($event[0])) {
- #
- # date = event
- #
- $tmp=&ParseDateString("$event[0] 00:00:00");
- if ($tmp && $tmp eq $date0) {
- $delta="+0:0:0:1:0:0:0";
- } else {
- $delta="+0:0:0:0:1:0:0";
- }
- push @{ $Events{"dates"} },($date0,0,$delta,$name);
-
- } elsif ($recur=&ParseRecur($event[0])) {
- #
- # recur = event
- #
- ($recur0,$recur1)=&Recur_Split($recur);
- if ($recur0) {
- if ($recur1) {
- $r="$recur0:$recur1";
- } else {
- $r=$recur0;
- }
- } else {
- $r=$recur1;
- }
- (@recur)=split(/:/,$r);
- if (pop(@recur)==0 && pop(@recur)==0 && pop(@recur)==0) {
- $delta="+0:0:0:1:0:0:0";
- } else {
- $delta="+0:0:0:0:1:0:0";
- }
- push @{ $Events{"recur"} },($recur,0,$delta,$name);
-
- } else {
- # ??? = event
- warn "WARNING: illegal event ignored [ @event ]\n";
- next EVENT;
- }
-
- } elsif ($#event == 1) {
-
- if ($date0=&ParseDateString($event[0])) {
-
- if ($date1=&ParseDateString($event[1])) {
- #
- # date ; date = event
- #
- $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])) {
- #
- # date ; delta = event
- #
- push @{ $Events{"dates"} },($date0,0,$delta,$name);
-
- } else {
- # date ; ??? = event
- warn "WARNING: illegal event ignored [ @event ]\n";
- next EVENT;
- }
-
- } elsif ($recur=&ParseRecur($event[0])) {
-
- if ($delta=&ParseDateDelta($event[1])) {
- #
- # recur ; delta = event
- #
- push @{ $Events{"recur"} },($recur,0,$delta,$name);
-
- } else {
- # recur ; ??? = event
- warn "WARNING: illegal event ignored [ @event ]\n";
- next EVENT;
- }
-
- } else {
- # ??? ; ??? = event
- warn "WARNING: illegal event ignored [ @event ]\n";
- next EVENT;
- }
-
- } else {
- # date ; delta0 ; delta1 = event
- # recur ; delta0 ; delta1 = event
- # ??? ; ??? ; ??? ... = event
- warn "WARNING: illegal event ignored [ @event ]\n";
- next EVENT;
- }
- }
-}
-
-# This reads an init file.
-sub Date_InitFile {
- print "DEBUG: Date_InitFile\n" if ($Curr{"Debug"} =~ /trace/);
- my($file)=@_;
- my($in)=new IO::File;
- local($_)=();
- my($section)="vars";
- my($var,$val,$recur,$name)=();
-
- $in->open($file) || return;
- while(defined ($_=<$in>)) {
- chomp;
- s/^\s+//;
- s/\s+$//;
- next if (! $_ or /^\#/);
-
- if (/^\*holiday/i) {
- $section="holiday";
- &EraseHolidays() if ($section =~ /holiday/i && $Cnf{"EraseHolidays"});
- next;
- } elsif (/^\*events/i) {
- $section="events";
- next;
- }
-
- if ($section =~ /var/i) {
- confess "ERROR: invalid Date::Manip config file line.\n $_\n"
- if (! /(.*\S)\s*=\s*(.*)$/);
- ($var,$val)=($1,$2);
- &Date_SetConfigVariable($var,$val);
-
- } elsif ($section =~ /holiday/i) {
- confess "ERROR: invalid Date::Manip config file line.\n $_\n"
- if (! /(.*\S)\s*=\s*(.*)$/);
- ($recur,$name)=($1,$2);
- $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*(.*)$/);
- ($val,$var)=($1,$2);
- push @{ $Events{"raw"} },($val,$var);
-
- } else {
- # A section not currently used by Date::Manip (but may be
- # used by some extension to it).
- next;
- }
- }
- close($in);
-}
-
-# $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
-# are supplied.
-sub Date_TimeCheck {
- print "DEBUG: Date_TimeCheck\n" if ($Curr{"Debug"} =~ /trace/);
- my($h,$mn,$s,$ampm)=@_;
- 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);
-
- # Check hour
- $tmp1=$Lang{$Cnf{"Language"}}{"AmPm"};
- $tmp2="";
- 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);
- } elsif ($$ampm) {
- return 1;
- }
- 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);
- } else {
- $$h="00" if ($$h eq "");
- $$h="0$$h" if (length($$h)==1);
- return 1 if (! &IsInt($$h,0,23));
- $tmp2="AM" if ($$h<12);
- $tmp2="PM" if ($$h>=12);
- }
- $$ampm=$Lang{$Cnf{"Language"}}{"AMstr"};
- $$ampm=$Lang{$Cnf{"Language"}}{"PMstr"} if ($tmp2 eq "PM");
-
- # Check minutes
- $$mn="00" if ($$mn eq "");
- $$mn="0$$mn" if (length($$mn)==1);
- return 1 if (! &IsInt($$mn,0,59));
-
- # Check seconds
- $$s="00" if ($$s eq "");
- $$s="0$$s" if (length($$s)==1);
- return 1 if (! &IsInt($$s,0,59));
-
- return 0;
-}
-
-# $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
-# are supplied.
-#
-# If the flag UpdateHolidays is set, the year is set to
-# CurrHolidayYear.
-sub Date_DateCheck {
- 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);
- my($curr_y)=$Curr{"Y"};
- my($curr_m)=$Curr{"M"};
- my($curr_d)=$Curr{"D"};
- $$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 "");
-
- # Check year.
- $$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));
-
- # Check month
- $$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));
-
- # Check day
- $$d="01" if ($$d eq "");
- $$d="0$$d" if (length($$d)==1);
- return 1 if (! &IsInt($$d,1,$d_in_m[$$m]));
- if ($$wk) {
- $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
-sub Date_FixYear {
- print "DEBUG: Date_FixYear\n" if ($Curr{"Debug"} =~ /trace/);
- my($y)=@_;
- my($curr_y)=$Curr{"Y"};
- $y=$curr_y if (! defined $y or ! $y);
- return $y if (length($y)==4);
- confess "ERROR: Invalid year ($y)\n" if (length($y)!=2);
- my($y1,$y2)=();
-
- if (lc($Cnf{"YYtoYYYY"}) eq "c") {
- $y1=substring($y,0,2);
- $y="$y1$y";
-
- } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})$/i) {
- $y1=$1;
- $y="$y1$y";
-
- } elsif ($Cnf{"YYtoYYYY"} =~ /^c(\d{2})(\d{2})$/i) {
- $y1="$1$2";
- $y ="$1$y";
- $y += 100 if ($y<$y1);
-
- } else {
- $y1=$curr_y-$Cnf{"YYtoYYYY"};
- $y2=$y1+99;
- $y="19$y";
- while ($y<$y1) {
- $y+=100;
- }
- while ($y>$y2) {
- $y-=100;
- }
- }
- $y;
-}
-
-# &Date_NthWeekOfYear($y,$n);
-# Returns a list of (YYYY,MM,DD) for the 1st day of the Nth week of the
-# year.
-# &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
-# actually in the year
-sub Date_NthWeekOfYear {
- print "DEBUG: Date_NthWeekOfYear\n" if ($Curr{"Debug"} =~ /trace/);
- my($y,$n,$dow,$flag)=@_;
- 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);
- if (defined $dow) {
- $dow=lc($dow);
- %dow=%{ $Lang{$Cnf{"Language"}}{"WeekH"} };
- $dow=$dow{$dow} if (exists $dow{$dow});
- return () if ($dow<1 || $dow>7);
- $flag="" if (! defined $flag);
- } else {
- $dow="";
- $flag="";
- }
-
- $y=&Date_FixYear($y) if (length($y)<4);
- if ($Cnf{"Jan1Week1"}) {
- $date=&Date_Join($y,1,1,0,0,0);
- } else {
- $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 "");
-
- if ($flag) {
- ($tmp)=&Date_Split($date, 1);
- $n++ if ($tmp != $y);
- }
-
- if ($n>1) {
- $date=&DateCalc_DateDelta($date,"+0:0:". ($n-1) . ":0:0:0:0",\$err,0);
- } elsif ($n==0) {
- $date=&DateCalc_DateDelta($date,"-0:0:1:0:0:0:0",\$err,0);
- }
- ($y,$m,$d)=&Date_Split($date, 1);
- ($y,$m,$d);
-}
-
-########################################################################
-# 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.
-sub Char_8Bit {
- my($hash)=@_;
-
- # grave `
- # A` 00c0 a` 00e0
- # E` 00c8 e` 00e8
- # I` 00cc i` 00ec
- # O` 00d2 o` 00f2
- # U` 00d9 u` 00f9
- # W` 1e80 w` 1e81
- # Y` 1ef2 y` 1ef3
-
- $$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
-
- # acute '
- # A' 00c1 a' 00e1
- # C' 0106 c' 0107
- # E' 00c9 e' 00e9
- # I' 00cd i' 00ed
- # L' 0139 l' 013a
- # N' 0143 n' 0144
- # O' 00d3 o' 00f3
- # R' 0154 r' 0155
- # S' 015a s' 015b
- # U' 00da u' 00fa
- # W' 1e82 w' 1e83
- # Y' 00dd y' 00fd
- # Z' 0179 z' 017a
-
- $$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
-
- # double acute " "
- # O" 0150 o" 0151
- # U" 0170 u" 0171
-
- # circumflex ^
- # A^ 00c2 a^ 00e2
- # C^ 0108 c^ 0109
- # E^ 00ca e^ 00ea
- # G^ 011c g^ 011d
- # H^ 0124 h^ 0125
- # I^ 00ce i^ 00ee
- # J^ 0134 j^ 0135
- # O^ 00d4 o^ 00f4
- # S^ 015c s^ 015d
- # U^ 00db u^ 00fb
- # W^ 0174 w^ 0175
- # Y^ 0176 y^ 0177
-
- $$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
-
- # tilde ~
- # A~ 00c3 a~ 00e3
- # I~ 0128 i~ 0129
- # N~ 00d1 n~ 00f1
- # O~ 00d5 o~ 00f5
- # U~ 0168 u~ 0169
-
- $$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
-
- # macron -
- # A- 0100 a- 0101
- # E- 0112 e- 0113
- # I- 012a i- 012b
- # O- 014c o- 014d
- # U- 016a u- 016b
-
- # breve ( [half circle up]
- # A( 0102 a( 0103
- # G( 011e g( 011f
- # U( 016c u( 016d
-
- # dot .
- # C. 010a c. 010b
- # E. 0116 e. 0117
- # G. 0120 g. 0121
- # I. 0130
- # Z. 017b z. 017c
-
- # diaeresis : [side by side dots]
- # A: 00c4 a: 00e4
- # E: 00cb e: 00eb
- # I: 00cf i: 00ef
- # O: 00d6 o: 00f6
- # U: 00dc u: 00fc
- # W: 1e84 w: 1e85
- # Y: 0178 y: 00ff
-
- $$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
-
- # ring o
- # U0 016e u0 016f
-
- # cedilla , [squiggle down and left below the letter]
- # ,C 00c7 ,c 00e7
- # ,G 0122 ,g 0123
- # ,K 0136 ,k 0137
- # ,L 013b ,l 013c
- # ,N 0145 ,n 0146
- # ,R 0156 ,r 0157
- # ,S 015e ,s 015f
- # ,T 0162 ,t 0163
-
- $$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]
- # A; 0104 a; 0105
- # E; 0118 e; 0119
- # I; 012e i; 012f
- # U; 0172 u; 0173
-
- # caron < [little v on top]
- # A< 01cd a< 01ce
- # C< 010c c< 010d
- # D< 010e d< 010f
- # E< 011a e< 011b
- # L< 013d l< 013e
- # N< 0147 n< 0148
- # R< 0158 r< 0159
- # S< 0160 s< 0161
- # T< 0164 t< 0165
- # Z< 017d z< 017e
-
-
- # Other characters
-
- # 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
-
- # upside down characters
-
- $$hash{"ud!"} = "\xa1"; # INVERTED EXCLAMATION MARK
- $$hash{"ud?"} = "\xbf"; # INVERTED QUESTION MARK
-
- # overlay characters
-
- $$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
-
- # special names
-
- $$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 ...
-# @ am AM notations
-# @ pm PM notations
-#
-# @ 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 ...
-# ex. 4th day OF June
-# $ at at 4:00 at
-# $ on on Sunday on
-# $ future in the future in
-# $ past in the past ago
-# $ next next item next
-# $ prev previous item last previous
-# $ later 2 hours later
-#
-# % 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
-# $ weeks words for week
-# $ days words for day
-# $ hours words for hour
-# $ minutes words for minute
-# $ seconds words for second
-# % replace
-# 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
-# for month is given as:
-# "mon month months"
-# 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
-# here.
-#
-# $ 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
-# if desired.
-#
-# 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
-# every language.
-
-sub Date_Init_English {
- print "DEBUG: Date_Init_English\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
-
- $$d{"month_name"}=
- [["January","February","March","April","May","June",
- "July","August","September","October","November","December"]];
-
- $$d{"month_abb"}=
- [["Jan","Feb","Mar","Apr","May","Jun",
- "Jul","Aug","Sep","Oct","Nov","Dec"],
- [],
- ["","","","","","","","","Sept"]];
-
- $$d{"day_name"}=
- [["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]];
- $$d{"day_abb"}=
- [["Mon","Tue","Wed","Thu","Fri","Sat","Sun"],
- ["", "Tues","", "Thur","", "", ""]];
- $$d{"day_char"}=
- [["M","T","W","Th","F","Sa","S"]];
-
- $$d{"num_suff"}=
- [["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",
- "31st"]];
- $$d{"num_word"}=
- [["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{"of"} =["in","of"];
- $$d{"at"} =["at"];
- $$d{"on"} =["on"];
- $$d{"future"} =["in"];
- $$d{"past"} =["ago"];
- $$d{"next"} =["next"];
- $$d{"prev"} =["previous","last"];
- $$d{"later"} =["later"];
-
- $$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{"sephm"} =':';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:]';
-
- $$d{"am"} = ["AM","A.M."];
- $$d{"pm"} = ["PM","P.M."];
-}
-
-sub Date_Init_Italian {
- print "DEBUG: Date_Init_Italian\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
- my($i)=$h{"i'"};
-
- $$d{"month_name"}=
- [[qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
- Luglio Agosto Settembre Ottobre Novembre Dicembre)]];
-
- $$d{"month_abb"}=
- [[qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic)]];
-
- $$d{"day_name"}=
- [[qw(Lunedi Martedi Mercoledi Giovedi Venerdi Sabato Domenica)],
- [qw(Luned${i} Marted${i} Mercoled${i} Gioved${i} Venerd${i})]];
- $$d{"day_abb"}=
- [[qw(Lun Mar Mer Gio Ven Sab Dom)]];
- $$d{"day_char"}=
- [[qw(L Ma Me G V S D)]];
-
- $$d{"num_suff"}=
- [[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
- 29mo 3mo 31mo)]];
- $$d{"num_word"}=
- [[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{"each"} =[qw(ogni)];
- $$d{"of"} =[qw(della del)];
- $$d{"at"} =[qw(alle)];
- $$d{"on"} =[qw(di)];
- $$d{"future"} =[qw(fra)];
- $$d{"past"} =[qw(fa)];
- $$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)];
-
- $$d{"sephm"} =':';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:]';
-
- $$d{"am"} = [qw(AM)];
- $$d{"pm"} = [qw(PM)];
-}
-
-sub Date_Init_French {
- print "DEBUG: Date_Init_French\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
- my($e)=$h{"e'"};
- my($u)=$h{"u^"};
- my($a)=$h{"a'"};
-
- $$d{"month_name"}=
- [["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"]];
- $$d{"month_abb"}=
- [["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"]];
-
- $$d{"day_name"}=
- [["lundi","mardi","mercredi","jeudi","vendredi","samedi","dimanche"]];
- $$d{"day_abb"}=
- [["lun","mar","mer","jeu","ven","sam","dim"]];
- $$d{"day_char"}=
- [["l","ma","me","j","v","s","d"]];
-
- $$d{"num_suff"}=
- [["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",
- "31e"]];
- $$d{"num_word"}=
- [["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"],
- ["1re"]];
-
- $$d{"now"} =["aujourd'hui","maintenant"];
- $$d{"last"} =["dernier"];
- $$d{"each"} =["chaque","tous les","toutes les"];
- $$d{"of"} =["en","de"];
- $$d{"at"} =["a","${a}0"];
- $$d{"on"} =["sur"];
- $$d{"future"} =["en"];
- $$d{"past"} =["il y a"];
- $$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{"months"} =["mois"];
- $$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{"sephm"} ='[h:]';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:,]';
-
- $$d{"am"} = ["du matin"];
- $$d{"pm"} = ["du soir"];
-}
-
-sub Date_Init_Romanian {
- print "DEBUG: Date_Init_Romanian\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
- my($p)=$h{"p"};
- my($i)=$h{"i^"};
- my($a)=$h{"a~"};
- my($o)=$h{"-o"};
-
- $$d{"month_name"}=
- [["ianuarie","februarie","martie","aprilie","mai","iunie",
- "iulie","august","septembrie","octombrie","noiembrie","decembrie"]];
- $$d{"month_abb"}=
- [["ian","febr","mart","apr","mai","iun",
- "iul","aug","sept","oct","nov","dec"],
- ["","feb"]];
-
- $$d{"day_name"}=
- [["luni","marti","miercuri","joi","vineri","simbata","duminica"],
- ["luni","mar${p}i","miercuri","joi","vineri","s${i}mb${a}t${a}",
- "duminic${a}"]];
- $$d{"day_abb"}=
- [["lun","mar","mie","joi","vin","sim","dum"],
- ["lun","mar","mie","joi","vin","s${i}m","dum"]];
- $$d{"day_char"}=
- [["L","Ma","Mi","J","V","S","D"]];
-
- $$d{"num_suff"}=
- [["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",
- "a 30-a","a 31-a"]];
-
- $$d{"num_word"}=
- [["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",
- "a treizecisiuna"],
- ["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",
- "a treizeci${o}iuna"],
- ["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{"last"} =["ultima"];
- $$d{"each"} =["fiecare"];
- $$d{"of"} =["din","in","n"];
- $$d{"at"} =["la"];
- $$d{"on"} =["on"];
- $$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{"exact"} =["exact"];
- $$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",
- "amiaz${a}","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{"sephm"} =':';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:,]';
-
- $$d{"am"} = ["AM","A.M."];
- $$d{"pm"} = ["PM","P.M."];
-}
-
-sub Date_Init_Swedish {
- print "DEBUG: Date_Init_Swedish\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
- my($ao)=$h{"ao"};
- my($o) =$h{"o:"};
- my($a) =$h{"a:"};
-
- $$d{"month_name"}=
- [["Januari","Februari","Mars","April","Maj","Juni",
- "Juli","Augusti","September","Oktober","November","December"]];
- $$d{"month_abb"}=
- [["Jan","Feb","Mar","Apr","Maj","Jun",
- "Jul","Aug","Sep","Okt","Nov","Dec"]];
-
- $$d{"day_name"}=
- [["Mandag","Tisdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
- ["M${ao}ndag","Tisdag","Onsdag","Torsdag","Fredag","L${o}rdag",
- "S${o}ndag"]];
- $$d{"day_abb"}=
- [["Man","Tis","Ons","Tor","Fre","Lor","Son"],
- ["M${ao}n","Tis","Ons","Tor","Fre","L${o}r","S${o}n"]];
- $$d{"day_char"}=
- [["M","Ti","O","To","F","L","S"]];
-
- $$d{"num_suff"}=
- [["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",
- "31:a"]];
- $$d{"num_word"}=
- [["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{"each"} =["varje"];
- $$d{"of"} =["om"];
- $$d{"at"} =["kl","kl.","klockan"];
- $$d{"on"} =["pa","p${ao}"];
- $$d{"future"} =["om"];
- $$d{"past"} =["sedan"];
- $$d{"next"} =["nasta","n${a}sta"];
- $$d{"prev"} =["forra","f${o}rra"];
- $$d{"later"} =["senare"];
-
- $$d{"exact"} =["exakt"];
- $$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",
- "midnatt","00: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"];
-
- $$d{"sephm"} ='[.:]';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:]';
-
- $$d{"am"} = ["FM"];
- $$d{"pm"} = ["EM"];
-}
-
-sub Date_Init_German {
- print "DEBUG: Date_Init_German\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
- my($a)=$h{"a:"};
- my($u)=$h{"u:"};
- my($o)=$h{"o:"};
- my($b)=$h{"beta"};
-
- $$d{"month_name"}=
- [["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"]];
- $$d{"month_abb"}=
- [["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"]];
-
- $$d{"day_name"}=
- [["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag",
- "Sonntag"]];
- $$d{"day_abb"}=
- [["Mon","Die","Mit","Don","Fre","Sam","Son"]];
- $$d{"day_char"}=
- [["M","Di","Mi","Do","F","Sa","So"]];
-
- $$d{"num_suff"}=
- [["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.",
- "31."]];
- $$d{"num_word"}=
- [
- ["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"],
- ["erster"]];
-
- $$d{"now"} =["heute","jetzt"];
- $$d{"last"} =["letzte","letzten"];
- $$d{"each"} =["jeden"];
- $$d{"of"} =["der","im","des"];
- $$d{"at"} =["um"];
- $$d{"on"} =["am"];
- $$d{"future"} =["in"];
- $$d{"past"} =["vor"];
- $$d{"next"} =["nachste","n${a}chste","nachsten","n${a}chsten"];
- $$d{"prev"} =["vorherigen","vorherige","letzte","letzten"];
- $$d{"later"} =["spater","sp${a}ter"];
-
- $$d{"exact"} =["genau"];
- $$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"];
-
- $$d{"sephm"} =':';
- $$d{"sepms"} ='[: ]';
- $$d{"sepss"} ='[.:]';
-
- $$d{"am"} = ["FM"];
- $$d{"pm"} = ["EM"];
-}
-
-sub Date_Init_Dutch {
- print "DEBUG: Date_Init_Dutch\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
-
- $$d{"month_name"}=
- [["januari","februari","maart","april","mei","juni","juli","augustus",
- "september","october","november","december"],
- ["","","","","","","","","","oktober"]];
-
- $$d{"month_abb"}=
- [["jan","feb","maa","apr","mei","jun","jul",
- "aug","sep","oct","nov","dec"],
- ["","","mrt","","","","","","","okt"]];
- $$d{"day_name"}=
- [["maandag","dinsdag","woensdag","donderdag","vrijdag","zaterdag",
- "zondag"]];
- $$d{"day_abb"}=
- [["ma","di","wo","do","vr","zat","zon"],
- ["","","","","","za","zo"]];
- $$d{"day_char"}=
- [["M","D","W","D","V","Za","Zo"]];
-
- $$d{"num_suff"}=
- [["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",
- "30ste","31ste"]];
- $$d{"num_word"}=
- [["eerste","tweede","derde","vierde","vijfde","zesde","zevende","achtste",
- "negende","tiende","elfde","twaalfde",
- map {"${_}tiende";} qw (der veer vijf zes zeven acht negen),
- "twintigste",
- map {"${_}entwintigste";} qw (een twee drie vier vijf zes zeven acht
- negen),
- "dertigste","eenendertigste"],
- ["","","","","","","","","","","","","","","","","","","","",
- map {"${_}-en-twintigste";} qw (een twee drie vier vijf zes zeven acht
- negen),
- "dertigste","een-en-dertigste"],
- ["een","twee","drie","vier","vijf","zes","zeven","acht","negen","tien",
- "elf","twaalf",
- map {"${_}tien"} qw (der veer vijf zes zeven acht negen),
- "twintig",
- map {"${_}entwintig"} qw (een twee drie vier vijf zes zeven acht negen),
- "dertig","eenendertig"],
- ["","","","","","","","","","","","","","","","","","","","",
- map {"${_}-en-twintig"} qw (een twee drie vier vijf zes zeven acht
- negen),
- "dertig","een-en-dertig"]];
-
- $$d{"now"} =["nu","nou","vandaag"];
- $$d{"last"} =["laatste"];
- $$d{"each"} =["elke","elk"];
- $$d{"of"} =["in","van"];
- $$d{"at"} =["om"];
- $$d{"on"} =["op"];
- $$d{"future"} =["over"];
- $$d{"past"} =["geleden","vroeger","eerder"];
- $$d{"next"} =["volgende","volgend"];
- $$d{"prev"} =["voorgaande","voorgaand"];
- $$d{"later"} =["later"];
-
- $$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{"sephm"} ='[:.uh]';
- $$d{"sepms"} ='[:.m]';
- $$d{"sepss"} ='[.:]';
-
- $$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",
- "'s_avonds","avond"];
-}
-
-sub Date_Init_Polish {
- print "DEBUG: Date_Init_Polish\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
-
- $$d{"month_name"}=
- [["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"]];
- $$d{"month_abb"}=
- [["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."]];
-
- $$d{"day_name"}=
- [["poniedzialek","wtorek","sroda","czwartek","piatek","sobota",
- "niedziela"],
- ["poniedzia\x81\xb3ek","wtorek","\x9croda","czwartek","pi\x81\xb9tek",
- "sobota","niedziela"]];
- $$d{"day_abb"}=
- [["po.","wt.","sr.","cz.","pi.","so.","ni."],
- ["po.","wt.","\x9cr.","cz.","pi.","so.","ni."]];
- $$d{"day_char"}=
- [["p","w","e","c","p","s","n"],
- ["p","w","\x9c.","c","p","s","n"]];
-
- $$d{"num_suff"}=
- [["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.",
- "31."]];
- $$d{"num_word"}=
- [["pierwszego","drugiego","trzeczego","czwartego","piatego","szostego",
- "siodmego","osmego","dziewiatego","dziesiatego",
- "jedenastego","dwunastego","trzynastego","czternastego","pietnastego",
- "szestnastego","siedemnastego","osiemnastego","dziewietnastego",
- "dwudziestego",
- "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{"of"} =["w","z"];
- $$d{"at"} =["o","u"];
- $$d{"on"} =["na"];
- $$d{"future"} =["za"];
- $$d{"past"} =["temu"];
- $$d{"next"} =["nastepny","nast\x81\xeapny","nastepnym","nast\x81\xeapnym",
- "przyszly","przysz\x81\xb3y","przyszlym",
- "przysz\x81\xb3ym"];
- $$d{"prev"} =["zeszly","zesz\x81\xb3y","zeszlym","zesz\x81\xb3ym"];
- $$d{"later"} =["later"];
-
- $$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{"sephm"} =':';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:]';
-
- $$d{"am"} = ["AM","A.M."];
- $$d{"pm"} = ["PM","P.M."];
-}
-
-sub Date_Init_Spanish {
- print "DEBUG: Date_Init_Spanish\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
-
- $$d{"month_name"}=
- [["Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto",
- "Septiembre","Octubre","Noviembre","Diciembre"]];
-
- $$d{"month_abb"}=
- [["Ene","Feb","Mar","Abr","May","Jun","Jul","Ago","Sep","Oct",
- "Nov","Dic"]];
-
- $$d{"day_name"}=
- [["Lunes","Martes","Miercoles","Jueves","Viernes","Sabado","Domingo"]];
- $$d{"day_abb"}=
- [["Lun","Mar","Mie","Jue","Vie","Sab","Dom"]];
- $$d{"day_char"}=
- [["L","Ma","Mi","J","V","S","D"]];
-
- $$d{"num_suff"}=
- [["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"]];
- $$d{"num_word"}=
- [["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",
- "Trigesimo Primero"],
- ["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",
- "Trigesimo Primera"]];
-
- $$d{"now"} =["Hoy","Ahora"];
- $$d{"last"} =["ultimo"];
- $$d{"each"} =["cada"];
- $$d{"of"} =["en","de"];
- $$d{"at"} =["a"];
- $$d{"on"} =["el"];
- $$d{"future"} =["en"];
- $$d{"past"} =["hace"];
- $$d{"next"} =["siguiente"];
- $$d{"prev"} =["anterior"];
- $$d{"later"} =["later"];
-
- $$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{"sephm"} =':';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:]';
-
- $$d{"am"} = ["AM","A.M."];
- $$d{"pm"} = ["PM","P.M."];
-}
-
-sub Date_Init_Portuguese {
- print "DEBUG: Date_Init_Portuguese\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
- my($o) = $h{"-o"};
- my($c) = $h{",c"};
- my($a) = $h{"a'"};
- my($e) = $h{"e'"};
- my($u) = $h{"u'"};
- my($o2)= $h{"o'"};
- my($a2)= $h{"a`"};
- my($a3)= $h{"a~"};
- my($e2)= $h{"e^"};
-
- $$d{"month_name"}=
- [["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"]];
-
- $$d{"month_abb"}=
- [["Jan","Fev","Mar","Abr","Mai","Jun",
- "Jul","Ago","Set","Out","Nov","Dez"]];
-
- $$d{"day_name"}=
- [["Segunda","Terca","Quarta","Quinta","Sexta","Sabado","Domingo"],
- ["Segunda","Ter${c}a","Quarta","Quinta","Sexta","S${a}bado","Domingo"]];
- $$d{"day_abb"}=
- [["Seg","Ter","Qua","Qui","Sex","Sab","Dom"],
- ["Seg","Ter","Qua","Qui","Sex","S${a}b","Dom"]];
- $$d{"day_char"}=
- [["Sg","T","Qa","Qi","Sx","Sb","D"]];
-
- $$d{"num_suff"}=
- [["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}",
- "30${o}","31${o}"]];
- $$d{"num_word"}=
- [["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{"each"} =["cada"];
- $$d{"of"} =["da","do"];
- $$d{"at"} =["as","${a2}s"];
- $$d{"on"} =["na","no"];
- $$d{"future"} =["em"];
- $$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{"sephm"} =':';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[,]';
-
- $$d{"am"} = ["AM","A.M."];
- $$d{"pm"} = ["PM","P.M."];
-}
-
-sub Date_Init_Russian {
- print "DEBUG: Date_Init_Russian\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
- my(%h)=();
- &Char_8Bit(\%h);
- my($a) =$h{"a:"};
-
- $$d{"month_name"}=
- [
- ["\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\xce\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\xce\xd8",
- "\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"]
- ];
-
- $$d{"month_abb"}=
- [["\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",""]];
-
- $$d{"day_name"}=
- [["\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"]];
- $$d{"day_abb"}=
- [["\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"]];
- $$d{"day_char"}=
- [["\xd0\xce","\xd7\xd4","\xd3\xd2","\xde\xd4","\xd0\xd4","\xd3\xc2",
- "\xd7\xd3"]];
-
- $$d{"num_suff"}=
- [["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 ",
- "31 "]];
- $$d{"num_word"}=
- [["\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{"of"} =[" "];
- $$d{"at"} =["\xd7"];
- $$d{"on"} =["\xd7"];
- $$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",
- "+0:0:0:2:0:0:0"];
- $$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",
- "\xc4\xce\xd1"];
- $$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",
- "\xcd\xc9\xce\xd5\xd4"];
- $$d{"seconds"} =["\xd3","\xd3\xc5\xcb","\xd3\xc5\xcb\xd5\xce\xc4\xc1",
- "\xd3\xc5\xcb\xd5\xce\xc4"];
- $$d{"replace"} =[];
-
- $$d{"sephm"} ="[:\xde]";
- $$d{"sepms"} ="[:\xcd]";
- $$d{"sepss"} ="[:.\xd3]";
-
- $$d{"am"} = ["\xc4\xd0","${a}\xf0","${a}.\xf0.","\xce\xcf\xde\xc9",
- "\xd5\xd4\xd2\xc1",
- "\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"];
-}
-
-sub Date_Init_Turkish {
- print "DEBUG: Date_Init_Turkish\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
-
- $$d{"month_name"}=
- [
- ["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"]
- ];
-
- $$d{"month_abb"}=
- [
- ["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"]
- ];
-
- $$d{"day_name"}=
- [
- ["pazartesi","sali","carsamba","persembe","cuma","cumartesi","pazar"],
- ["pazartesi","sal\xfd","\xe7ar\xfeamba","per\xfeembe","cuma",
- "cumartesi","pazar"],
- ];
-
- $$d{"day_abb"}=
- [
- ["pzt","sal","car","per","cum","cts","paz"],
- ["pzt","sal","\xe7ar","per","cum","cts","paz"],
- ];
-
- $$d{"day_char"}=
- [["Pt","S","Cr","Pr","C","Ct","P"],
- ["Pt","S","\xc7","Pr","C","Ct","P"]];
-
- $$d{"num_suff"}=
- [[ "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.",
- "31."]];
-
- $$d{"num_word"}=
- [
- ["birinci","ikinci","ucuncu","dorduncu",
- "besinci","altinci","yedinci","sekizinci",
- "dokuzuncu","onuncu","onbirinci","onikinci",
- "onucuncu","ondordoncu",
- "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{"each"} =["her"];
- $$d{"of"} =["of"];
- $$d{"at"} =["saat"];
- $$d{"on"} =["on"];
- $$d{"future"} =["gelecek"];
- $$d{"past"} =["ge\xe7mi\xfe", "gecmis","gecen", "ge\xe7en"];
- $$d{"next"} =["gelecek","sonraki"];
- $$d{"prev"} =["onceki","\xf6nceki"];
- $$d{"later"} =["sonra"];
-
- $$d{"exact"} =["tam"];
- $$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",
- "dun", "-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",
- "oglen","12:00:00",
- "yarim","12:300:00",
- "yar\xfdm","12:30: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{"hours"} =["saat"];
- $$d{"minutes"} =["dakika","dak","d"];
- $$d{"seconds"} =["saniye","sn",];
- $$d{"replace"} =["s","saat"];
-
- $$d{"sephm"} =':';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:,]';
-
- $$d{"am"} = ["\xf6gleden \xf6nce","ogleden once"];
- $$d{"pm"} = ["\xf6\xf0leden sonra","ogleden sonra"];
-}
-
-sub Date_Init_Danish {
- print "DEBUG: Date_Init_Danish\n" if ($Curr{"Debug"} =~ /trace/);
- my($d)=@_;
-
- $$d{"month_name"}=
- [["Januar","Februar","Marts","April","Maj","Juni",
- "Juli","August","September","Oktober","November","December"]];
- $$d{"month_abb"}=
- [["Jan","Feb","Mar","Apr","Maj","Jun",
- "Jul","Aug","Sep","Okt","Nov","Dec"]];
-
- $$d{"day_name"}=
- [["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","Lordag","Sondag"],
- ["Mandag","Tirsdag","Onsdag","Torsdag","Fredag","L\xf8rdag","S\xf8ndag"]];
-
- $$d{"day_abb"}=
- [["Man","Tis","Ons","Tor","Fre","Lor","Son"],
- ["Man","Tis","Ons","Tor","Fre","L\xf8r","S\xf8n"]];
- $$d{"day_char"}=
- [["M","Ti","O","To","F","L","S"]];
-
- $$d{"num_suff"}=
- [["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",
- "31:e"]];
- $$d{"num_word"}=
- [["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{"each"} =["hver"];
- $$d{"of"} =["om"];
- $$d{"at"} =["kl","kl.","klokken"];
- $$d{"on"} =["pa","p\xe5"];
- $$d{"future"} =["om"];
- $$d{"past"} =["siden"];
- $$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",
- "midnat","00: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"];
-
- $$d{"sephm"} ='[.:]';
- $$d{"sepms"} =':';
- $$d{"sepss"} ='[.:]';
-
- $$d{"am"} = ["FM"];
- $$d{"pm"} = ["EM"];
-}
-
-########################################################################
-# FROM MY PERSONAL LIBRARIES
-########################################################################
-
-no integer;
-
-# &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.
-# Example:
-# To add 2 hours together (with the excess returned in days) use:
-# &ModuloAddition(60,$s1,\$s,\$day);
-sub ModuloAddition {
- my($N,$add,$val,$rem)=@_;
- return if ($N==0);
- $$val+=$add;
- if ($N<0) {
- # 1 to N
- $N = -$N;
- if ($$val>$N) {
- $$rem+= int(($$val-1)/$N);
- $$val = ($$val-1)%$N +1;
- } elsif ($$val<1) {
- $$rem-= int(-$$val/$N)+1;
- $$val = $N-(-$$val % $N);
- }
-
- } else {
- # 0 to N-1
- if ($$val>($N-1)) {
- $$rem+= int($$val/$N);
- $$val = $$val%$N;
- } elsif ($$val<0) {
- $$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.
-sub IsInt {
- my($N,$low,$high)=@_;
- return 0 if (! defined $N or
- $N !~ /^\s*[-+]?\d+\s*$/ or
- defined $low && $N<$low or
- defined $high && $N>$high);
- return 1;
-}
-
-# $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).
-sub SinLindex {
- my($listref,$Str,$offset,$Insensitive)=@_;
- my($i,$len,$tmp)=();
- $len=$#$listref;
- 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=$$listref[$i];
- $tmp=uc($tmp) if ($Insensitive);
- return $i if ($tmp eq $Str);
- }
- return -1;
-}
-
-sub Index_First {
- my($offsetref,$max)=@_;
- $$offsetref=0 if (! $$offsetref);
- if ($$offsetref < 0) {
- $$offsetref += $max + 1;
- $$offsetref=0 if ($$offsetref < 0);
- }
- return -1 if ($$offsetref > $max);
- return 0;
-}
-
-# $File=&CleanFile($file);
-# This cleans up a path to remove the following things:
-# double slash /a//b -> /a/b
-# trailing dot /a/. -> /a
-# leading dot ./a -> a
-# trailing slash a/ -> a
-sub CleanFile {
- my($file)=@_;
- $file =~ s/\s*$//;
- $file =~ s/^\s*//;
- $file =~ s|//+|/|g; # multiple slash
- $file =~ s|/\.$|/|; # trailing /. (leaves trailing slash)
- $file =~ s|^\./|| # leading ./
- if ($file ne "./");
- $file =~ s|/$|| # trailing slash
- if ($file ne "/");
- return $file;
-}
-
-# $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.
-# This is efficient.
-sub ExpandTilde {
- my($file)=shift;
- my($user,$home)=();
- # ~aaa/bbb= ~ aaa /bbb
- if ($file =~ s|^~([^/]*)||) {
- $user=$1;
- # 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
- $OS eq "Mac" or
- $OS eq "Netware" or
- $OS eq "MPE");
- $user="" if (! defined $user);
-
- if ($user) {
- $home= (getpwnam($user))[7];
- } else {
- $home= (getpwuid($<))[7];
- }
- $home = VMS::Filespec::unixpath($home) if ($OS eq "VMS");
- return "" if (! $home);
- $file="$home/$file";
- }
- $file;
-}
-
-# $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.
-sub FullFilePath {
- my($file)=shift;
- my($rootpat) = '^/'; #default pattern to match absolute path
- $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
- $file=&ExpandTilde($file);
- return "" if (! $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
-# is returned.
-#
-# $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
-# run.
-#
-# 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
-# ignored.
-sub CheckFilePath {
- my($file,$mode)=@_;
- my($test)=();
- $file=&FullFilePath($file);
- $mode = "" if (! defined $mode);
-
- # Run tests
- 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));
- return 1;
-}
-#&&
-
-# $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
-# removed from $path.
-#
-# The corrected path is returned.
-sub FixPath {
- my($path,$full,$mode,$err)=@_;
- local($_)="";
- my(@dir)=split(/$Cnf{"PathSep"}/,$path);
- $full=0 if (! defined $full);
- $mode="" if (! defined $mode);
- $err=0 if (! defined $err);
- $path="";
- if ($mode eq "e") {
- $mode="de";
- } elsif ($mode eq "r") {
- $mode="derx";
- } elsif ($mode eq "w") {
- $mode="derwx";
- }
-
- foreach (@dir) {
-
- # Expand path
- if ($full) {
- $_=&FullFilePath($_);
- } else {
- $_=&ExpandTilde($_);
- }
- if (! $_) {
- return "" if ($err);
- next;
- }
-
- # Check mode
- if (! $mode or &CheckFilePath($_,$mode)) {
- $path .= $Cnf{"PathSep"} . $_;
- } else {
- return "" if ($err);
- }
- }
- $path =~ s/^$Cnf{"PathSep"}//;
- return $path;
-}
-#&&
-
-# $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.
-sub SearchPath {
- my($file,$path,$mode,@suff)=@_;
- my($f,$s,$d,@dir,$fs)=();
- $path=&FixPath($path,1,"r");
- @dir=split(/$Cnf{"PathSep"}/,$path);
- foreach $d (@dir) {
- $f="$d/$file";
- $f=~ s|//|/|g;
- return $f if (&CheckFilePath($f,$mode));
- foreach $s (@suff) {
- $fs="$f.$s";
- return $fs if (&CheckFilePath($fs,$mode));
- }
- }
- return "";
-}
-
-# @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".
-sub ReturnList {
- my($str)=@_;
- my(@ret,@str,$from,$to,$tmp)=();
- @str=split(/,/,$str);
- foreach $str (@str) {
- if ($str =~ /^[-+]?\d+$/) {
- push(@ret,$str);
- } elsif ($str =~ /^([-+]?\d+)-([-+]?\d+)$/) {
- ($from,$to)=($1,$2);
- if ($from>$to) {
- $tmp=$from;
- $from=$to;
- $to=$tmp;
- }
- push(@ret,$from..$to);
- } else {
- return ();
- }
- }
- @ret;
-}
-
-1;