manip.pm

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

      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"});
  my($signexp)='([+-]?)';
  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);
      }
      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);
  $f{"y"}=substr $f{"Y"},2;
  &Date_Init()  if (! $Curr{"InitDone"});

  if (! wantarray) {
    $format=join(" ",@format);