search.pl

一百个病毒的源代码 包括熊猫烧香等 极其具有研究价值

	  $urlhtml =~ s/%YEARVIS/$vtyear/g;
	  $urlhtml =~ s/%YEARFVIS/$vtyearf/g;
	  $urlhtml =~ s/%YEARMOD/$mtyear/g;
	  $urlhtml =~ s/%YEARFMOD/$mtyearf/g;
	  $urlhtml =~ s/%TIMEFCRE/$ctfull/g;
	  $urlhtml =~ s/%TIMEFVIS/$vtfull/g;
	  $urlhtml =~ s/%TIMEFMOD/$mtfull/g;
	  while ( $urlhtml =~ /%IFCOMHAS\((.*?)\)\((.*?)\)/ ){
	    $v1 = $1;
	    $v2 = $2;
	    $v1 =~ s/([*+?$.^])/\\$1/g; 
	    if ($comment =~ s/$v1//g) {
	      $urlhtml =~ s/%IFCOMHAS\(.*?\)\(.*?\)/$v2/;
	    }
	    else {
	      $urlhtml =~ s/%IFCOMHAS\(.*?\)\(.*?\)//;
	    };
	  };
	    
	  if ($creationtime > $oldesttime) {
	    $timestring = "$ctmon/$ctday/$ctyear";
	    $newgifhtml = $newgif;
	    $newgifhtml =~ s/%URL/$url/g;
	    $newgifhtml =~ s/%TITLE/$title/g;
	    $newgifhtml =~ s/%HITS/$numberofhits/g;
	    $newgifhtml =~ s/%DAYCRE/$ctday/g;
	    $newgifhtml =~ s/%DAYVIS/$vtday/g;
	    $newgifhtml =~ s/%DAYMOD/$mtday/g;
	    $newgifhtml =~ s/%MONTHCRE1/$ctmon/g;
	    $newgifhtml =~ s/%MONTHVIS1/$vtmon/g;
	    $newgifhtml =~ s/%MONTHMOD1/$mtmon/g;
	    $newgifhtml =~ s/%YEARCRE/$ctyear/g;
	    $newgifhtml =~ s/%YEARFCRE/$ctyearf/g;
	    $newgifhtml =~ s/%YEARVIS/$vtyear/g;
	    $newgifhtml =~ s/%YEARFVIS/$vtyearf/g;
	    $newgifhtml =~ s/%YEARMOD/$mtyear/g;
	    $newgifhtml =~ s/%YEARFMOD/$mtyearf/g;
	    $newgifhtml =~ s/%TIMEFCRE/$ctfull/g;
	    $newgifhtml =~ s/%TIMEFVIS/$vtfull/g;
	    $newgifhtml =~ s/%TIMEFMOD/$mtfull/g;
	    $urlhtml =~ s/%NEW/$newgifhtml/g;
	  }
	  else {
	    $urlhtml =~ s/%NEW//g;
	  };
	  if ($comment ne "") {
	    $urlhtml =~ s/%CONDDASH/-/g;
	  }
	  else {
	    $urlhtml =~ s/%CONDDASH//g;
	  };
	  $urlhtml =~ s/%(LONG)?COMMENT/$comment/g;

	  # Let the subroutines that emulate bk2site's builtin
	  # functions process the string before sending it to the
	  # resulting document.
	  $urlhtml = processFunctions(qq{$urlhtml});

	  print "<LI>$urlhtml";
	  $printed++;
	  if ($printed >= $num) {
	    print "</UL>\n</UL>\n";
	    goto end;
	  };
	}
      }
      print "</UL>\n";
    }
  }
  print "</UL>\n";
}

end: 

if (($siteMatches + $categoryMatches) > $num){
  print "<center>";
  for ($i =0; $i < ($siteMatches + $categoryMatches); $i += $num){
    if (($stq >= $i) && ($stq < ($i + $num))){
      print " <b>$i</b>";
    }
    else {
      $ip1 = $i + 1;
      print " <a href=\"$searchprog?num=$num&q=$escquery&stq=$i&db=$database\">$i</a> ";
    }
  }
  print "</center>";
};
print "<!-- Code above was automatically generated by bk2site-->\n";
print $afterComment;

p2: while (<OTHERBASE>){
  if (/(.*)%QUERY(.*)/){
    $_ =~ s/%QUERY/$query/g;
  }
  if (/(.*)%ESCQUERY(.*)/){
    $_ =~ s/%ESCQUERY/$escquery/g;
  }
  if (/(.*)%NUMBER(.*)/){
    $_ =~ s/%NUMBER/$num/g;
  }
  print;
}

close(DB);

sub processFunctions {
  my ($input, $output_prefix) = @_;
  my $output;
  my $prefix;
  my $function;
  my $rest;
  my $args;

  print STDERR "$output_prefix". "entering processFunctions($input)\n" if $debug_emulateBuiltins;
  $output_prefix .= "  ";

  if ( $input =~ /(&(FILL|NOHTML|REPLACE|CUT|NOLINEBREAKS|NOACCENTS|FS)\[)/ ) {
    $prefix = $`;
    $function = $2;
    $rest = $';

    print STDERR "$output_prefix\$prefix = $prefix\n" if $debug_emulateBuiltins;
    print STDERR "$output_prefix\$function = $function\n" if $debug_emulateBuiltins;
    print STDERR "$output_prefix\$rest = $rest\n" if $debug_emulateBuiltins;

    $args = processFunctions($rest, $output_prefix);
    print STDERR "$output_prefix\$args = $args\n" if $debug_emulateBuiltins;

    $res = eval("builtin_$function(q{$args}, \"$output_prefix\")");

    if ( !defined($res) ) {
      # Something was wrong with the arguments to the emulated builtin
      # function. Ideally we should return the unmodified string
      # argument, but if builtin_* hadn't been able to parse the input
      # string it is unfeasible here. I think returning the entire
      # input string is the best we can do.
      #$res = $input;
      $res = "&$function\[$args";
    }

    $output = "$prefix$res";
  }
  else {
    $output = $input;
  }

  print STDERR "$output_prefix" . "returning $output\n" if $debug_emulateBuiltins;
  return($output);
}

# the following builtin function is not yet implemented
sub builtin_FILL {
  my ($arg, $output_prefix) = @_;
  my $result;
  my $string;
  my $column;
  my $rest;

  print STDERR "${output_prefix}FILL($arg)\n" if $debug_emulateBuiltins;
  $output_prefix .= "  ";

  if ( $arg =~ /^([^|[\]]*)\|(\d+)\]/ ) {
    $string = $1;
    $column = $2;
    $rest = $';

    # OK, how do we have to fill $string to column $column? Apart from
    # that, I think this kind of layout aspects should be left to the
    # browser.

    # At this time we simply take $string as the result of filling.
    $result = "$string$rest";
  }
  else {
    # The parameter list if malformed.
    $result = undef;
  }

  print STDERR "${output_prefix}\$result = ${\(defined($result) ? $result : \"undef\" )}\n" if $debug_emulateBuiltins;
  return($result);
}

sub builtin_NOHTML {
  my ($arg, $output_prefix) = @_;
  my $result;
  my $string;
  my $rest;

  print STDERR "${output_prefix}NOHTML($arg)\n" if $debug_emulateBuiltins;
  $output_prefix .= "  ";

  if ( $arg =~ /^([^|[\]]*)\]/ ) {
    $string = $1;
    $rest = $';

    $string =~ s/<[^>]+>//g;

    $result = "$string$rest";
  }
  else {
    # The parameter list if malformed.
    $result = undef;
  }

  print STDERR "${output_prefix}\$result = ${\(defined($result) ? $result : \"undef\" )}\n" if $debug_emulateBuiltins;
  return($result);
}

sub builtin_REPLACE {
  my ($arg, $output_prefix) = @_;
  my $result;
  my $string;
  my $from;
  my $to;
  my $rest;

  print STDERR "${output_prefix}REPLACE($arg)\n" if $debug_emulateBuiltins;
  $output_prefix .= "  ";

  if ( $arg =~ /^([^|[\]]*)\|([^|[\]]*)\|([^|[\]]*)\]/ ) {
    $string = $1;
    $from = qr/$2/;
    $to = $3;
    $rest = $';

    print STDERR "\$string = $string\n" if $debug_emulateBuiltins;
    print STDERR "\$from = $from\n" if $debug_emulateBuiltins;
    print STDERR "\$to = $to\n" if $debug_emulateBuiltins;
    print STDERR "\$rest = $rest\n" if $debug_emulateBuiltins;

    if ( $string && $from ) {
      $string =~ s/$from/$to/g;
    }

    $result = "$string$rest";
  }
  else {
    # The parameter list if malformed.
    $result = undef;
  }

  print STDERR "${output_prefix}\$result = ${\(defined($result) ? $result : \"undef\" )}\n" if $debug_emulateBuiltins;
  return($result);
}

sub builtin_CUT {
  my ($arg, $output_prefix) = @_;
  my $result;
  my $string;
  my $n;
  my $rest;

  print STDERR "${output_prefix}CUT($arg)\n" if $debug_emulateBuiltins;
  $output_prefix .= "  ";

  if ( $arg =~ /^([^|[\]]*)\|(\d+)\]/ ) {
    $string = $1;
    $n = $2;
    $rest = $';

    $result = "${\(substr($string, 0, $n))}$rest";
  }
  else {
    # The parameter list if malformed.
    $result = undef;
  }

  print STDERR "${output_prefix}\$result = ${\(defined($result) ? $result : \"undef\" )}\n" if $debug_emulateBuiltins;
  return($result);
}

sub builtin_NOLINEBREAKS {
  my ($arg, $output_prefix) = @_;

  print STDERR "${output_prefix}NOLINEBREAKS($arg)\n" if $debug_emulateBuiltins;
  $output_prefix .= "  ";

  if ( $arg =~ /^([^|[\]]*)\]/ ) {
    $string = $1;
    $rest = $';

    $string =~ s/[\n\b\t]/ /g;

    $result = "$string$rest";
  }
  else {
    # The parameter list if malformed.
    $result = undef;
  }

  print STDERR "${output_prefix}\$result = ${\(defined($result) ? $result : \"undef\" )}\n" if $debug_emulateBuiltins;
  return($result);
}

# the following builtin function is not yet implemented
sub builtin_NOACCENTS {
  my ($arg, $output_prefix) = @_;

  print STDERR "${output_prefix}NOACCENTS($arg)\n" if $debug_emulateBuiltins;
  $output_prefix .= "  ";

  if ( $arg =~ /^([^|[\]]*)\]/ ) {
    $string = $1;
    $rest = $';

    # What do we have to do with $string???

    # At this time we simply take $string as the result.
    $result = "$string$rest";
  }
  else {
    # The parameter list if malformed.
    $result = undef;
  }

  print STDERR "${output_prefix}\$result = ${\(defined($result) ? $result : \"undef\" )}\n" if $debug_emulateBuiltins;
  return($result);
}

sub builtin_FS {
  my ($arg, $output_prefix) = @_;

  print STDERR "${output_prefix}FS($arg)\n" if $debug_emulateBuiltins;
  $output_prefix .= "  ";

  if ( $arg =~ /^([^|[\]]*)\]/ ) {
    $string = $1;
    $rest = $';

    $string =~ s/([.!?]).*/$1/;

    $result = "$string$rest";
  }
  else {
    # The parameter list if malformed.
    $result = undef;
  }

  print STDERR "${output_prefix}\$result = ${\(defined($result) ? $result : \"undef\" )}\n" if $debug_emulateBuiltins;
  return($result);
}