git.maemo.org Git - dh-make-perl/blob - dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/URI/Escape.pm

   1 #
   2 # $Id: Escape.pm,v 3.28 2004/11/05 13:58:31 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 (and updated by RFC 2732).
  23 A URI consists of a restricted set of characters,
  24 denoted as C<uric> in RFC 2396.  The restricted set of characters
  25 consists of digits, letters, and a few graphic symbols chosen from
  26 those common to most of the character encodings and input facilities
  27 available to Internet users:
  28
  29   "A" .. "Z", "a" .. "z", "0" .. "9",
  30   ";", "/", "?", ":", "@", "&", "=", "+", "$", ",", "[", "]",   # reserved
  31   "-", "_", ".", "!", "~", "*", "'", "(", ")"
  32
  33 In addition, any byte (octet) can be represented in a URI by an escape
  34 sequence: a triplet consisting of the character "%" followed by two
  35 hexadecimal digits.  A byte can also be represented directly by a
  36 character, using the US-ASCII character for that octet (iff the
  37 character is part of C<uric>).
  38
  39 Some of the C<uric> characters are I<reserved> for use as delimiters
  40 or as part of certain URI components.  These must be escaped if they are
  41 to be treated as ordinary data.  Read RFC 2396 for further details.
  42
  43 The functions provided (and exported by default) from this module are:
  44
  45 =over 4
  46
  47 =item uri_escape( $string )
  48
  49 =item uri_escape( $string, $unsafe )
  50
  51 Replaces each unsafe character in the $string with the corresponding
  52 escape sequence and returns the result.  The $string argument should
  53 be a string of bytes.  The uri_escape() function will croak if given a
  54 characters with code above 255.  Use uri_escape_utf8() if you know you
  55 have such chars or/and want chars in the 128 .. 255 range treated as
  56 UTF-8.
  57
  58 The uri_escape() function takes an optional second argument that
  59 overrides the set of characters that are to be escaped.  The set is
  60 specified as a string that can be used in a regular expression
  61 character class (between [ ]).  E.g.:
  62
  63   "\x00-\x1f\x7f-\xff"          # all control and hi-bit characters
  64   "a-z"                         # all lower case characters
  65   "^A-Za-z"                     # everything not a letter
  66
  67 The default set of characters to be escaped is all those which are
  68 I<not> part of the C<uric> character class shown above as well as the
  69 reserved characters.  I.e. the default is:
  70
  71   "^A-Za-z0-9\-_.!~*'()"
  72
  73 =item uri_escape_utf8( $string )
  74
  75 =item uri_escape_utf8( $string, $unsafe )
  76
  77 Works like uri_escape(), but will encode chars as UTF-8 before
  78 escaping them.  This makes this function able do deal with characters
  79 with code above 255 in $string.  Note that chars in the 128 .. 255
  80 range will be escaped differently by this function compared to what
  81 uri_escape() would.  For chars in the 0 .. 127 range there is no
  82 difference.
  83
  84 The call:
  85
  86     $uri = uri_escape_utf8($string);
  87
  88 will be the same as:
  89
  90     use Encode qw(encode);
  91     $uri = uri_escape(encode("UTF-8", $string));
  92
  93 but will even work for perl-5.6 for chars in the 128 .. 255 range.
  94
  95 Note: Javascript has a function called escape() that produce the
  96 sequence "%uXXXX" for chars in the 256 .. 65535 range.  This function
  97 has really nothing to do with URI escaping but some folks got confused
  98 since it "does the right thing" in the 0 .. 255 range.  Because of
  99 this you sometimes see "URIs" with these kind of escapes.  The
 100 JavaScript encodeURI() function is similar to uri_escape_utf8().
 101
 102 =item uri_unescape($string,...)
 103
 104 Returns a string with each %XX sequence replaced with the actual byte
 105 (octet).
 106
 107 This does the same as:
 108
 109    $string =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
 110
 111 but does not modify the string in-place as this RE would.  Using the
 112 uri_unescape() function instead of the RE might make the code look
 113 cleaner and is a few characters less to type.
 114
 115 In a simple benchmark test I did,
 116 calling the function (instead of the inline RE above) if a few chars
 117 were unescaped was something like 40% slower, and something like 700% slower if none were.  If
 118 you are going to unescape a lot of times it might be a good idea to
 119 inline the RE.
 120
 121 If the uri_unescape() function is passed multiple strings, then each
 122 one is returned unescaped.
 123
 124 =back
 125
 126 The module can also export the C<%escapes> hash, which contains the
 127 mapping from all 256 bytes to the corresponding escape codes.  Lookup
 128 in this hash is faster than evaluating C<sprintf("%%%02X", ord($byte))>
 129 each time.
 130
 131 =head1 SEE ALSO
 132
 133 L<URI>
 134
 135
 136 =head1 COPYRIGHT
 137
 138 Copyright 1995-2004 Gisle Aas.
 139
 140 This program is free software; you can redistribute it and/or modify
 141 it under the same terms as Perl itself.
 142
 143 =cut
 144
 145 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 146 use vars qw(%escapes);
 147
 148 require Exporter;
 149 @ISA = qw(Exporter);
 150 @EXPORT = qw(uri_escape uri_unescape);
 151 @EXPORT_OK = qw(%escapes uri_escape_utf8);
 152 $VERSION = sprintf("%d.%02d", q$Revision: 3.28 $ =~ /(\d+)\.(\d+)/);
 153
 154 use Carp ();
 155
 156 # Build a char->hex map
 157 for (0..255) {
 158     $escapes{chr($_)} = sprintf("%%%02X", $_);
 159 }
 160
 161 my %subst;  # compiled patternes
 162
 163 sub uri_escape
 164 {
 165     my($text, $patn) = @_;
 166     return undef unless defined $text;
 167     if (defined $patn){
 168         unless (exists  $subst{$patn}) {
 169             # Because we can't compile the regex we fake it with a cached sub
 170             (my $tmp = $patn) =~ s,/,\\/,g;
 171             eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
 172             Carp::croak("uri_escape: $@") if $@;
 173         }
 174         &{$subst{$patn}}($text);
 175     } else {
 176         # Default unsafe characters.  RFC 2732 ^(uric - reserved)
 177         $text =~ s/([^A-Za-z0-9\-_.!~*'()])/$escapes{$1} || _fail_hi($1)/ge;
 178     }
 179     $text;
 180 }
 181
 182 sub _fail_hi {
 183     my $chr = shift;
 184     Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead", ord($chr));
 185 }
 186
 187 sub uri_escape_utf8
 188 {
 189     my $text = shift;
 190     if ($] < 5.008) {
 191         $text =~ s/([^\0-\x7F])/do {my $o = ord($1); sprintf("%c%c", 0xc0 | ($o >> 6), 0x80 | ($o & 0x3f)) }/ge;
 192     }
 193     else {
 194         utf8::encode($text);
 195     }
 196
 197     return uri_escape($text, @_);
 198 }
 199
 200 sub uri_unescape
 201 {
 202     # Note from RFC1630:  "Sequences which start with a percent sign
 203     # but are not followed by two hexadecimal characters are reserved
 204     # for future extension"
 205     my $str = shift;
 206     if (@_ && wantarray) {
 207         # not executed for the common case of a single argument
 208         my @str = ($str, @_);  # need to copy
 209         foreach (@str) {
 210             s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
 211         }
 212         return @str;
 213     }
 214     $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
 215     $str;
 216 }
 217
 218 1;