manip.pm

harvest是一个下载html网页得机器人

package Date::Manip;

# Copyright (c) 1995-2001 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);

# 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="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
$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.

@DatePath=();
if ($OS eq "Windows") {
  $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"}         = ":";
  $Cnf{"PersonalCnf"}     = "Manip.cnf";
  $Cnf{"PersonalCnfPath"} = ".:~";

} else {
  # Unix
  $Cnf{"PathSep"}         = ":";
  $Cnf{"PersonalCnf"}     = ".DateManip.cnf";
  $Cnf{"PersonalCnfPath"} = ".:~";
  @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;

use vars qw($VERSION);
$VERSION="5.40";

########################################################################
########################################################################

$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);

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