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"};