manip.pm

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

    &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
      "sat    -0400 ".  # Chile
      "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
      "adt    -0300 ".  # Atlantic Daylight
      "ndt    -0230 ".  # Newfoundland Daylight
      "at     -0200 ".  # Azores
      "wat    -0100 ".  # West Africa
      "gmt    +0000 ".  # Greenwich Mean
      "ut     +0000 ".  # Universal
      "utc    +0000 ".  # Universal (Coordinated)
      "wet    +0000 ".  # Western European
      "west   +0000 ".  # Alias for 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
      "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
      "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
      "nst    +0630 ".  # North Sumatra              nst=Newfoundland Std -0330
      #"sst   +0700 ".  # South Sumatra, USSR Zone 6 sst=Swedish Summer   +0200
      "hkt    +0800 ".  # Hong Kong
      "sgt    +0800 ".  # Singapore
      "cct    +0800 ".  # China Coast, USSR Zone 7
      "awst   +0800 ".  # West Australian 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
      "cast   +0930 ".  # Central Australian Standard
      "east   +1000 ".  # Eastern Australian Standard
      "gst    +1000 ".  # Guam Standard, USSR Zone 9 gst=Greenland Std    -0300
      "cadt   +1030 ".  # Central Australian 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)?";