diff -r 8b87ea768cb8 -r 60053dab7e2a dummy_foundation/lib/Date/Manip.pm --- 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;