home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _4c91826b9b7110333be4fad12199e9e1 < prev    next >
Text File  |  2000-03-15  |  5KB  |  156 lines
  1. #
  2. # $Id: Escape.pm,v 3.13 1999/03/20 07:34:08 gisle Exp $
  3. #
  4.  
  5. package URI::Escape;
  6. use strict;
  7.  
  8. =head1 NAME
  9.  
  10. URI::Escape - Escape and unescape unsafe characters
  11.  
  12. =head1 SYNOPSIS
  13.  
  14.  use URI::Escape;
  15.  $safe = uri_escape("10% is enough\n");
  16.  $verysafe = uri_escape("foo", "\0-\377");
  17.  $str  = uri_unescape($safe);
  18.  
  19. =head1 DESCRIPTION
  20.  
  21. This module provides functions to escape and unescape URI strings as
  22. defined by RFC 2396.  URIs consist of a restricted set of characters,
  23. denoted as C<uric> in RFC 2396.  The restricted set of characters
  24. consists of digits, letters, and a few graphic symbols chosen from
  25. those common to most of the character encodings and input facilities
  26. available to Internet users:
  27.  
  28.   "A" .. "Z", "a" .. "z", "0" .. "9",
  29.   ";", "/", "?", ":", "@", "&", "=", "+", "$", ",",   # reserved
  30.   "-", "_", ".", "!", "~", "*", "'", "(", ")"
  31.  
  32. In addition any byte (octet) can be represented in a URI by an escape
  33. sequence; a triplet consisting of the character "%" followed by two
  34. hexadecimal digits.  Bytes can also be represented directly by a
  35. character using the US-ASCII character for that octet (iff the
  36. character is part of C<uric>).
  37.  
  38. Some of the C<uric> characters are I<reserved> for use as delimiters
  39. or as part of certain URI components.  These must be escaped if they are
  40. to be treated as ordinary data.  Read RFC 2396 for further details.
  41.  
  42. The functions provided (and exported by default) from this module are:
  43.  
  44. =over 4
  45.  
  46. =item uri_escape($string, [$unsafe])
  47.  
  48. This function replaces all unsafe characters in the $string with their
  49. escape sequences and returns the result.
  50.  
  51. The uri_escape() function takes an optional second argument that
  52. overrides the set of characters that are to be escaped.  The set is
  53. specified as a string that can be used in a regular expression
  54. character class (between [ ]).  E.g.:
  55.  
  56.   "\x00-\x1f\x7f-\xff"          # all control and hi-bit characters
  57.   "a-z"                         # all lower case characters
  58.   "^A-Za-z"                     # everything not a letter
  59.  
  60. The default set of characters to be escaped is all those which are
  61. I<not> part of the C<uric> character class shown above.
  62.  
  63. =item uri_unescape($string)
  64.  
  65. Returns a string with all %XX sequences replaced with the actual byte
  66. (octet).
  67.  
  68. This does the same as:
  69.  
  70.    $string =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
  71.  
  72. but does not modify the string in-place as this RE would.  Using the
  73. uri_unescape() function instead of the RE might make the code look
  74. cleaner and is a few characters less to type.
  75.  
  76. In a simple benchmark test I made I got something like 40% slowdown by
  77. calling the function (instead of the inline RE above) if a few chars
  78. where unescaped and something like 700% slowdown if none where.  If
  79. you are going to unescape a lot of times it might be a good idea to
  80. inline the RE.
  81.  
  82. =back
  83.  
  84. The module can also export the C<%escapes> hash which contains the
  85. mapping from all 256 bytes to the corresponding escape code.  Lookup
  86. in this hash is faster than evaluating C<sprintf("%%%02X", ord($byte))>
  87. each time.
  88.  
  89. =head1 SEE ALSO
  90.  
  91. L<URI>
  92.  
  93.  
  94. =head1 COPYRIGHT
  95.  
  96. Copyright 1995-1998 Gisle Aas.
  97.  
  98. This program is free software; you can redistribute it and/or modify
  99. it under the same terms as Perl itself.
  100.  
  101. =cut
  102.  
  103. use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  104. use vars qw(%escapes);
  105.  
  106. require Exporter;
  107. @ISA = qw(Exporter);
  108. @EXPORT = qw(uri_escape uri_unescape);
  109. @EXPORT_OK = qw(%escapes);
  110. $VERSION = sprintf("%d.%02d", q$Revision: 3.13 $ =~ /(\d+)\.(\d+)/);
  111.  
  112. use Carp ();
  113.  
  114. # Build a char->hex map
  115. for (0..255) {
  116.     $escapes{chr($_)} = sprintf("%%%02X", $_);
  117. }
  118.  
  119. my %subst;  # compiled patternes
  120.  
  121. sub uri_escape
  122. {
  123.     my($text, $patn) = @_;
  124.     return undef unless defined $text;
  125.     if (defined $patn){
  126.     unless (exists  $subst{$patn}) {
  127.         # Because we can't compile the regex we fake it with a cached sub
  128.         $subst{$patn} =
  129.           eval "sub {\$_[0] =~ s/([$patn])/\$escapes{\$1}/g; }";
  130.         Carp::croak("uri_escape: $@") if $@;
  131.     }
  132.     &{$subst{$patn}}($text);
  133.     } else {
  134.     # Default unsafe characters. (RFC 2396 ^uric)
  135.     $text =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/$escapes{$1}/g;
  136.     }
  137.     $text;
  138. }
  139.  
  140. sub uri_unescape
  141. {
  142.     # Note from RFC1630:  "Sequences which start with a percent sign
  143.     # but are not followed by two hexadecimal characters are reserved
  144.     # for future extension"
  145.     my $str = shift;
  146.     if (@_ && wantarray) {
  147.     # not executed for the common case of a single argument
  148.     my @str = @_;  # need to copy
  149.     return map { s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg } $str, @str;
  150.     }
  151.     $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
  152.     $str;
  153. }
  154.  
  155. 1;
  156.