diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/URI/Escape.pm')
| -rwxr-xr-x | Master/tlpkg/tlperl/lib/URI/Escape.pm | 218 |
1 files changed, 218 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/URI/Escape.pm b/Master/tlpkg/tlperl/lib/URI/Escape.pm new file mode 100755 index 00000000000..c2da23becac --- /dev/null +++ b/Master/tlpkg/tlperl/lib/URI/Escape.pm @@ -0,0 +1,218 @@ +package URI::Escape; +use strict; + +=head1 NAME + +URI::Escape - Escape and unescape unsafe characters + +=head1 SYNOPSIS + + use URI::Escape; + $safe = uri_escape("10% is enough\n"); + $verysafe = uri_escape("foo", "\0-\377"); + $str = uri_unescape($safe); + +=head1 DESCRIPTION + +This module provides functions to escape and unescape URI strings as +defined by RFC 2396 (and updated by RFC 2732). +A URI consists of a restricted set of characters, +denoted as C<uric> in RFC 2396. The restricted set of characters +consists of digits, letters, and a few graphic symbols chosen from +those common to most of the character encodings and input facilities +available to Internet users: + + "A" .. "Z", "a" .. "z", "0" .. "9", + ";", "/", "?", ":", "@", "&", "=", "+", "$", ",", "[", "]", # reserved + "-", "_", ".", "!", "~", "*", "'", "(", ")" + +In addition, any byte (octet) can be represented in a URI by an escape +sequence: a triplet consisting of the character "%" followed by two +hexadecimal digits. A byte can also be represented directly by a +character, using the US-ASCII character for that octet (iff the +character is part of C<uric>). + +Some of the C<uric> characters are I<reserved> for use as delimiters +or as part of certain URI components. These must be escaped if they are +to be treated as ordinary data. Read RFC 2396 for further details. + +The functions provided (and exported by default) from this module are: + +=over 4 + +=item uri_escape( $string ) + +=item uri_escape( $string, $unsafe ) + +Replaces each unsafe character in the $string with the corresponding +escape sequence and returns the result. The $string argument should +be a string of bytes. The uri_escape() function will croak if given a +characters with code above 255. Use uri_escape_utf8() if you know you +have such chars or/and want chars in the 128 .. 255 range treated as +UTF-8. + +The uri_escape() function takes an optional second argument that +overrides the set of characters that are to be escaped. The set is +specified as a string that can be used in a regular expression +character class (between [ ]). E.g.: + + "\x00-\x1f\x7f-\xff" # all control and hi-bit characters + "a-z" # all lower case characters + "^A-Za-z" # everything not a letter + +The default set of characters to be escaped is all those which are +I<not> part of the C<uric> character class shown above as well as the +reserved characters. I.e. the default is: + + "^A-Za-z0-9\-_.!~*'()" + +=item uri_escape_utf8( $string ) + +=item uri_escape_utf8( $string, $unsafe ) + +Works like uri_escape(), but will encode chars as UTF-8 before +escaping them. This makes this function able do deal with characters +with code above 255 in $string. Note that chars in the 128 .. 255 +range will be escaped differently by this function compared to what +uri_escape() would. For chars in the 0 .. 127 range there is no +difference. + +The call: + + $uri = uri_escape_utf8($string); + +will be the same as: + + use Encode qw(encode); + $uri = uri_escape(encode("UTF-8", $string)); + +but will even work for perl-5.6 for chars in the 128 .. 255 range. + +Note: Javascript has a function called escape() that produces the +sequence "%uXXXX" for chars in the 256 .. 65535 range. This function +has really nothing to do with URI escaping but some folks got confused +since it "does the right thing" in the 0 .. 255 range. Because of +this you sometimes see "URIs" with these kind of escapes. The +JavaScript encodeURIComponent() function is similar to uri_escape_utf8(). + +=item uri_unescape($string,...) + +Returns a string with each %XX sequence replaced with the actual byte +(octet). + +This does the same as: + + $string =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + +but does not modify the string in-place as this RE would. Using the +uri_unescape() function instead of the RE might make the code look +cleaner and is a few characters less to type. + +In a simple benchmark test I did, +calling the function (instead of the inline RE above) if a few chars +were unescaped was something like 40% slower, and something like 700% slower if none were. If +you are going to unescape a lot of times it might be a good idea to +inline the RE. + +If the uri_unescape() function is passed multiple strings, then each +one is returned unescaped. + +=back + +The module can also export the C<%escapes> hash, which contains the +mapping from all 256 bytes to the corresponding escape codes. Lookup +in this hash is faster than evaluating C<sprintf("%%%02X", ord($byte))> +each time. + +=head1 SEE ALSO + +L<URI> + + +=head1 COPYRIGHT + +Copyright 1995-2004 Gisle Aas. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); +use vars qw(%escapes); + +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(uri_escape uri_unescape uri_escape_utf8); +@EXPORT_OK = qw(%escapes); +$VERSION = "3.29"; + +use Carp (); + +# Build a char->hex map +for (0..255) { + $escapes{chr($_)} = sprintf("%%%02X", $_); +} + +my %subst; # compiled patternes + +sub uri_escape +{ + my($text, $patn) = @_; + return undef unless defined $text; + if (defined $patn){ + unless (exists $subst{$patn}) { + # Because we can't compile the regex we fake it with a cached sub + (my $tmp = $patn) =~ s,/,\\/,g; + eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }"; + Carp::croak("uri_escape: $@") if $@; + } + &{$subst{$patn}}($text); + } else { + # Default unsafe characters. RFC 2732 ^(uric - reserved) + $text =~ s/([^A-Za-z0-9\-_.!~*'()])/$escapes{$1} || _fail_hi($1)/ge; + } + $text; +} + +sub _fail_hi { + my $chr = shift; + Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead", ord($chr)); +} + +sub uri_escape_utf8 +{ + my $text = shift; + if ($] < 5.008) { + $text =~ s/([^\0-\x7F])/do {my $o = ord($1); sprintf("%c%c", 0xc0 | ($o >> 6), 0x80 | ($o & 0x3f)) }/ge; + } + else { + utf8::encode($text); + } + + return uri_escape($text, @_); +} + +sub uri_unescape +{ + # Note from RFC1630: "Sequences which start with a percent sign + # but are not followed by two hexadecimal characters are reserved + # for future extension" + my $str = shift; + if (@_ && wantarray) { + # not executed for the common case of a single argument + my @str = ($str, @_); # need to copy + foreach (@str) { + s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + } + return @str; + } + $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str; + $str; +} + +sub escape_char { + return join '', @URI::Escape::escapes{$_[0] =~ /(\C)/g}; +} + +1; |