url-normalizer.pl
上传用户:liugui
上传日期:2007-01-04
资源大小:822k
文件大小:1k
源码类别:

代理服务器

开发平台:

Unix_Linux

  1. #!/usr/local/bin/perl -Tw
  2. # From:    Markus Gyger <mgyger@itr.ch>
  3. #
  4. # I'd like to see a redirector which "normalizes" URLs to have
  5. # a higher chance to get a hit. I didn't see such a redirector,
  6. # so I thought I would send my little attempt. However, I have
  7. # no real idea how much CPU time it needs using the LWP modules,
  8. # but it seems to work.
  9. require 5.003;
  10. use strict;
  11. use URI::URL;
  12. $| = 1;  # force a flush after every print on STDOUT
  13. my ($url, $addr, $fqdn, $ident, $method);
  14. while (<>) {
  15.     ($url, $addr, $fqdn, $ident, $method) = m:(S*) (S*)/(S*) (S*) (S*):;
  16.     # "normalize" URL
  17.     $url = url $url;                    # also removes default port number
  18.     $url->host(lc $url->host);          # map host name to lower case
  19.     my $epath = $url->epath;
  20.     $epath =~ s/%7e/~/ig;               # unescape ~
  21.     $epath =~ s/(%[da-f]{2})/U$1/ig;  # capitalize escape digits
  22.     if ($url->scheme =~ /^(http|ftp)$/) {
  23. $epath =~ s:/./:/:g;           # safe?
  24. $epath =~ s://:/:g;             # safe?
  25.     }
  26.     $url->epath($epath);
  27.     # ...
  28. } continue {
  29.     print "$url $addr/$fqdn $ident $methodn"
  30. }
  31. BEGIN {
  32.     unless (URI::URL::implementor('cache_object')) {
  33. package cache_object;
  34. @cache_object::ISA = (URI::URL::implementor());
  35. URI::URL::implementor('cache_object', 'cache_object');
  36. sub default_port { 3128 }
  37.     }
  38. }