URI-Escape-XS-0.14/000755 000765 000024 00000000000 12726247214 014552 5ustar00dankogaistaff000000 000000 URI-Escape-XS-0.14/Changes000644 000765 000024 00000006141 12726247165 016054 0ustar00dankogaistaff000000 000000 # # $Id: Changes,v 0.14 2016/06/09 11:09:38 dankogai Exp dankogai $ # # Revision history for Revision history for URI-Escape-XS # $Revision: 0.14 $ $Date: 2016/06/09 11:09:38 $ ! XS.xs pulled: RT #115183: MSVC 2013 and earlier do not understand `inline` https://github.com/dankogai/p5-uri-escape-xs/pull/6 0.13 2015/06/27 00:28:39 ! XS.xs t/02-basic.t Refactor & debug my_hextol() ! XS.xs Pulled: Speed up common case of decoding https://github.com/dankogai/p5-uri-escape-xs/pull/5 0.12 2014/04/16 10:49:36 ! XS.xs + t/06-nonstr.t Addressed: RT#94793: encodeURIComponent can't encode integer values https://rt.cpan.org/Ticket/Display.html?id=94793 0.11 2014/01/20 20:39:54 ! t/03-hashu.t No longer skips tests 4-6 for Test::Harness->VERSION > 3 ! Makefile.PL Pulled: https://github.com/dankogai/p5-uri-escape-xs/pull/4 ! lib/URI/Escape/XS.pm Pulled: https://github.com/dankogai/p5-uri-escape-xs/pull/3 0.10 2013/02/25 17:24:25 ! lib/URI/Escape/XS.pm Updated mail address ! XS.xs Pulled: https://github.com/dankogai/p5-uri-escape-xs/pull/2 0.09 2012/08/06 01:44:20 ! lib/URI/Escape/XS.pm POD Fixes ! Makefile.PL Addressed: RT#78738: Please provide LICENSE in metadata. https://rt.cpan.org/Ticket/Display.html?id=78738 ! t/04-idn.t Addressed: RT#74344: Fails when Net::IDN::Encode 2.003 installed https://rt.cpan.org/Ticket/Display.html?id=74344 0.08 2010/07/16 07:52:31 ! XS.xs The fix in RT#39135 did not address %XX reported by @kazuho via twitter DM 0.07 2010/05/04 06:02:38 ! XS.xs Addressed: #57168: memory leak in uri_escape ? http://rt.cpan.org/Public/Bug/Display.html?id=57168 0.06 2009/10/07 11:40:30 + t/05-null.t ! XS.xs lib/URI/Escape/XS.pm Addressed: #45392: First invocation of encodeURIComponentIDN loses the path #49375: decodeURIComponent() influences references from a regexp #45855: Problems with undef http://rt.cpan.org/Public/Bug/Display.html?id=45392 http://rt.cpan.org/Public/Bug/Display.html?id=49375 http://rt.cpan.org/Public/Bug/Display.html?id=45855 0.05 2009/03/24 14:24:09 ! lib/URI/Escape/XS.pm t/04-IDN.t Now you can also use Net::LibIDN instead of Net::IDN::Encode http://rt.cpan.org/Public/Bug/Display.html?id=44084 0.04 2009/01/16 08:26:52 ! lib/URI/Escape/XS.pm ! t/04-IDN.t drry: * fixed POD and test. * et cetera. http://coderepos.org/share/changeset/28708 ! t/t/01-compat.t Retouched so it is now locale-free http://rt.cpan.org/Public/Bug/Display.html?41134 http://rt.cpan.org/Public/Bug/Display.html?42702 0.04 2009/01/16 08:26:52 ! XS.pm README + t/04-idn.t added: decodeURICompornentIDN() and encodeURICompornentIDN() 0.03 2009/01/16 08:26:52 ! XS.pm Arguments are now unconditionally stringified http://rt.cpan.org/Public/Bug/Display.html?39344 ! XS.xs Addressed test failure on 5.10.x and others http://rt.cpan.org/Public/Bug/Display.html?39135 0.02 2008/05/30 23:53:13 ! XS.xs s/ishexnumber/isxdigit/g # for better compatibility http://rt.cpan.org/Public/Bug/Display.html?id=32556 http://rt.cpan.org/Public/Bug/Display.html?id=28583 ! lib/URI/Escape/XS.pm POD fixes. 0.01 2007/04/27 17:17:46 + * First Release. URI-Escape-XS-0.14/lib/000755 000765 000024 00000000000 12726247214 015320 5ustar00dankogaistaff000000 000000 URI-Escape-XS-0.14/Makefile.PL000644 000765 000024 00000001443 12267302052 016516 0ustar00dankogaistaff000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'URI::Escape::XS', AUTHOR => 'Dan Kogai ', VERSION_FROM => 'lib/URI/Escape/XS.pm', ABSTRACT_FROM => 'lib/URI/Escape/XS.pm', LICENSE => 'perl', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'URI-Escape-XS-*' }, META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/dankogai/p5-uri-escape-xs.git', web => 'https://github.com/dankogai/p5-uri-escape-xs', }, }, }, ); URI-Escape-XS-0.14/MANIFEST000644 000765 000024 00000000501 12726247214 015677 0ustar00dankogaistaff000000 000000 Changes MANIFEST META.yml # Will be created by "make dist" Makefile.PL README XS.xs lib/URI/Escape/XS.pm t/00-load.t t/01-compat.t t/02-basic.t t/03-hashu.t t/04-idn.t t/05-null.t t/06-nonstr.t t/boilerplate.t t/pod-coverage.t t/pod.t META.json Module JSON meta-data (added by MakeMaker) URI-Escape-XS-0.14/META.json000644 000765 000024 00000002210 12726247214 016166 0ustar00dankogaistaff000000 000000 { "abstract" : "Drop-In replacement for URI::Escape", "author" : [ "Dan Kogai " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.14, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "URI-Escape-XS", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/dankogai/p5-uri-escape-xs.git", "web" : "https://github.com/dankogai/p5-uri-escape-xs" } }, "version" : "0.14", "x_serialization_backend" : "JSON::PP version 2.27300" } URI-Escape-XS-0.14/META.yml000644 000765 000024 00000001201 12726247214 016015 0ustar00dankogaistaff000000 000000 --- abstract: 'Drop-In replacement for URI::Escape' author: - 'Dan Kogai ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.14, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: URI-Escape-XS no_index: directory: - t - inc requires: Test::More: '0' resources: repository: https://github.com/dankogai/p5-uri-escape-xs.git version: '0.14' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' URI-Escape-XS-0.14/README000644 000765 000024 00000014755 12726247165 015453 0ustar00dankogaistaff000000 000000 NAME URI::Escape::XS - Drop-In replacement for URI::Escape VERSION $Id: README,v 0.5 2013/02/25 17:24:25 dankogai Exp $ SYNOPSIS # use it instead of URI::Escape use URI::Escape::XS qw/uri_escape uri_unescape/; $safe = uri_escape("10% is enough\n"); $verysafe = uri_escape("foo", "\0-\377"); $str = uri_unescape($safe); # or use encodeURIComponent and decodeURIComponent use URI::Escape::XS; $safe = encodeURIComponent("10% is enough\n"); $str = decodeURIComponent("10%25%20is%20enough%0A"); # if you have CNet::IDN::Encode installed $safe = encodeURIComponentIDN("http://ドメイン名例.jp/dan/"); $str = decodeURIComponentIDN("http:%2F%2Fxn--eckwd4c7cu47r2wf.jp%2Fdan%2F"); EXPORT by default "encodeURIComponent" and "decodeURIComponent" "encodeURIComponentIDN" and "decodeURIComponentIDN" if either Net::LibIDN or Net::IDN::Encode is available on demand "uri_escape" and "uri_unescape" FUNCTIONS encodeURIComponent Does what JavaScript's encodeURIComponent does. $uri = encodeURIComponent("http://www.example.com/"); # http%3A%2F%2Fwww.example.com%2F Note you cannot customize characters to escape. If you need to do so, use "uri_escape". decodeURIComponent Does what JavaScript's decodeURIComponent does. $str = decodeURIComponent("http%3A%2F%2Fwww.example.com%2F"); # http://www.example.com/ It decode not only %HH sequences but also %uHHHH sequences, with surrogate pairs correctly decoded. $str = decodeURIComponent("%uD869%uDEB2%u5F3E%u0061"); # \x{2A6B2}\x{5F3E}a This function UNCONDITIONALLY returns the decoded string with utf8 flag off. To get utf8-decoded string, use Encode and decode_utf8(decodeURIComponent($uri)); This is the correct behavior because you cannot tell if the decoded string actually contains UTF-8 decoded string, like ISO-8859-1 and Shift_JIS. encodeURIComponentIDN Same as "encodeURIComponent" except that the host part is encoded in punycode. Either Net::LibIDN or Net::IDN::Encode is required to use this function. URIs with Internationalizing Domain Names require two encodings: Punycode for host part and URI escape for the rest. Currently only FULL URIs with "http:" or "https:" are supported. decodeURIComponentIDN Same as "decodeURIComponent" except that the host part is encoded in punycode. Either Net::LibIDN or Net::IDN::Encode is required to use this function. uri_escape Does exactly the same as URI::Escape::uri_escape() except when utf8-flagged string is fed. URI::Escape::uri_escape() croak and urge you to "uri_escape_utf8()" but it is pointless because URI itself has no such things as utf8 flag. The function in this module ALWAYS TREATS the string as byte sequence. That way you can safely use this function without worring about utf8 flags. Note this function is NOT EXPORTED by default. That way you can use URI::Escape and URI::Escape::XS simultaneously. uri_unescape Does exactly the same as URI::Escape::uri_escape() except when %uHHHH is fed. URI::Escape::uri_unescape() simply ignores %uHHHH sequences while the function in this module does decode it into the corresponding UTF-8 byte sequence. Like uri_escape, this funciton is NOT EXPORTED by default. Note on the %uHHHH sequence With this module the resulting strings never have the utf8 flag on. So if you want to decode it to perl utf8, You have to explicitly decode via Encode. Remember. URIs have always been a byte sequence, not UTF-8 characters. If the %uHHHH sequence became standard, you could have safely told if a given URI is in Unicode. But more fortunately than unfortunately, the RFC proposal was rejected so you cannot tell which encoding is used just by looking at the URI. I said fortunately because %uHHHH can be nasty for non-BMP characters. Since each %uHHHH can hold one 16-bit value, you need a *surrogate pair* to represent it if it is U+10000 and above. In spite of that, there are a significant number of URIs with %uHHHH escapes. Therefore this module supports decoding only. SPEED Since this module uses XS, it is really fast except for uri_escape("noop"). Regexp which is used in URI::Escape is really fast for non-matching but slows down significantly when it has to replace string. BENCHMARK On Macbook Pro 2GHz, Perl 5.8.8. http://www.google.co.jp/search?q=%E5%B0%8F%E9%A3%BC%E5%BC%BE ============================================================ Unescape it ----------- U::E 58526/s -- -88% U::E::XS 486968/s 732% -- -------------- Escape it back -------------- U::E 30046/s -- -78% U::E::XS 136992/s 356% -- www.example.com =============== Unescape it ----------- Rate U::E U::E::XS U::E 821972/s -- -4% U::E::XS 854732/s 4% -- -------------- Escape it back ------------- U::E::XS 522969/s -- -7% U::E 565112/s 8% -- AUTHOR Dan Kogai, "" BUGS Please report any bugs or feature requests to "bug-uri-escape-xs at rt.cpan.org", or through the web interface at . I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. SUPPORT You can find documentation for this module with the perldoc command. perldoc URI::Escape::XS You can also look for information at: * AnnoCPAN: Annotated CPAN documentation * CPAN Ratings * RT: CPAN's request tracker * Search CPAN ACKNOWLEDGEMENTS Gisle Aas for URI::Escape Koichi Taniguchi for URI::Escape::JavaScript Thomas Jacob for Net::LibIDN Claus Färber for Net::IDN::Encode COPYRIGHT & LICENSE Copyright 2007-2012 Dan Kogai, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. URI-Escape-XS-0.14/t/000755 000765 000024 00000000000 12726247214 015015 5ustar00dankogaistaff000000 000000 URI-Escape-XS-0.14/XS.xs000644 000765 000024 00000011576 12726247175 015500 0ustar00dankogaistaff000000 000000 /* * $Id: XS.xs,v 0.10 2016/06/09 11:09:38 dankogai Exp dankogai $ */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" /* #include "ppport.h" */ /* #include */ # include # include # include # include #if defined(_MSC_VER) && (_MSC_VER < 1900) #define inline __inline #endif static char escapes[256] = /* 0 1 2 3 4 5 6 7 8 9 a b c d e f */ { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 }; static char hex_chars[16] = {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'}; #ifdef EBCDIC static inline int my_hextol(const char *buf) { return (int)strtol((char *)buf, NULL, 16); } #else static inline char my_hextoh(const char c) { return c < '0' ? 0 : c <= '9' ? c - '0' : c <= 'F' ? c - 'A' + 10 : c <= 'f' ? c - 'a' + 10 : 0; } static inline int my_hextol(const char *buf){ return (my_hextoh(buf[0]) << 4) + my_hextoh(buf[1]); } #endif SV *encode_uri_component(SV *sstr){ SV *str, *result; int slen, dlen; U8 *src, *dst; int i; if (sstr == &PL_sv_undef) return newSV(0); str = sv_2mortal(newSVsv(sstr)); /* make a copy to make func($1) work */ if (!SvPOK(str)) sv_catpv(str, ""); slen = SvCUR(str); dlen = 0; result = newSV(slen * 3 + 1); /* at most 3 times */ SvPOK_on(result); src = (U8 *)SvPV_nolen(str); dst = (U8 *)SvPV_nolen(result); for (i = 0; i < slen; i++){ if (escapes[ src[i] ]){ dst[dlen++] = '%'; dst[dlen++] = hex_chars[src[i]>>4]; dst[dlen++] = hex_chars[src[i]%16]; } else{ dst[dlen++] = src[i]; } } dst[dlen] = '\0'; /* for sure; */ SvCUR_set(result, dlen); return result; } SV *decode_uri_component(SV *suri){ SV *uri, *result; int slen, dlen; U8 buf[8], *dst, *src, *bp; int i, hi, lo; if (suri == &PL_sv_undef) return newSV(0); /* if (!SvPOK(suri)) return newSV(0); */ uri = sv_2mortal(newSVsv(suri)); /* make a copy to make func($1) work */ if (!SvPOK(uri)) sv_catpv(uri, ""); slen = SvCUR(uri); dlen = 0; result = newSV(slen + 1); SvPOK_on(result); dst = (U8 *)SvPV_nolen(result); src = (U8 *)SvPV_nolen(uri); for (i = 0; i < slen; i++){ if (src[i] == '%'){ if (isxdigit(src[i+1]) && isxdigit(src[i+2])){ strncpy((char *)buf, (char *)(src + i + 1), 2); buf[2] = '\0'; /* @kazuho++ */ hi = my_hextol((char *)buf); dst[dlen++] = hi; i += 2; } else if(src[i+1] == 'u' && isxdigit(src[i+2]) && isxdigit(src[i+3]) && isxdigit(src[i+4]) && isxdigit(src[i+5])){ strncpy((char *)buf, (char *)(src + i + 2), 4); buf[4] = '\0'; /* RT#39135 */ hi = strtol((char *)buf, NULL, 16); i += 5; if (hi < 0xD800 || 0xDFFF < hi){ bp = uvchr_to_utf8((U8 *)buf, (UV)hi); strncpy((char *)(dst+dlen), (char *)buf, bp - buf); dlen += bp - buf; }else{ if (0xDC00 <= hi){ /* invalid */ warn("U+%04X is an invalid surrogate hi\n", hi); }else{ i++; if(src[i] == '%' && src[i+1] == 'u' && isxdigit(src[i+2]) && isxdigit(src[i+3]) && isxdigit(src[i+4]) && isxdigit(src[i+5])){ strncpy((char *)buf, (char *)(src + i + 2), 4); lo = strtol((char *)buf, NULL, 16); i += 5; if (lo < 0xDC00 || 0xDFFF < lo){ warn("U+%04X is an invalid lo surrogate", lo); }else{ lo += 0x10000 + (hi - 0xD800) * 0x400 - 0xDC00; bp = uvchr_to_utf8((U8 *)buf, (UV)lo); strncpy((char *)(dst+dlen), (char *)buf, bp - buf); dlen += bp - buf; } }else{ warn("lo surrogate is missing for U+%04X", hi); } } } }else{ dst[dlen++] = '%'; } } else{ dst[dlen++] = src[i]; } } dst[dlen] = '\0'; /* for sure; */ SvCUR_set(result, dlen); return result; } MODULE = URI::Escape::XS PACKAGE = URI::Escape::XS PROTOTYPES: ENABLE SV * encodeURIComponent(str) SV *str; CODE: RETVAL = encode_uri_component(str); OUTPUT: RETVAL SV * decodeURIComponent(str) SV *str; CODE: RETVAL = decode_uri_component(str); OUTPUT: RETVAL URI-Escape-XS-0.14/t/00-load.t000644 000765 000024 00000000233 11164763214 016332 0ustar00dankogaistaff000000 000000 #!perl -T use Test::More tests => 1; BEGIN { use_ok( 'URI::Escape::XS' ); } diag( "Testing URI::Escape::XS $URI::Escape::XS::VERSION, Perl $], $^X" ); URI-Escape-XS-0.14/t/01-compat.t000644 000765 000024 00000001425 12726247175 016713 0ustar00dankogaistaff000000 000000 #!perl -w # # $Id: 01-compat.t,v 0.2 2009/03/24 14:24:09 dankogai Exp $ # # Original as URI-1.35/t/escape.t # use URI::Escape::XS qw/uri_escape uri_unescape/; use Test::More tests => 7; { use bytes; is uri_escape("|abc\xE5"), "%7Cabc%E5", qq{uri_escape("|abc?")}; is uri_escape("abc", "b-d"), "a%62%63", qq{uri_escape("abc", "b-d")}; ok !defined(uri_escape(undef)), qq{uri_escape(undef)}; is uri_unescape("%7Cabc%e5"), "|abc\xE5" , qq{uri_unescape("%7Cabc%e5")}; ; is join(":", uri_unescape("%40A%42", "CDE", "F%47H")), '@AB:CDE:FGH', qq{uri_unescape("%40A%42", "CDE", "F%47H")}; } eval { my $escaped = uri_escape("abc" . chr(300)) }; ok !$@, qq{uri_escape("abc".chr(300)) does NOT croak}; is uri_escape(chr(0xFFF)), "%E0%BF%BF", qq{uri_escape(chr(0xFFF))}; URI-Escape-XS-0.14/t/02-basic.t000644 000765 000024 00000001140 12726247175 016504 0ustar00dankogaistaff000000 000000 #!perl -w # # $Id: 02-basic.t,v 0.2 2015/06/27 00:28:39 dankogai Exp $ # # Original as URI-1.35/t/escape.t # use URI::Escape::XS; use Test::More tests => 697; # basic round-trip test for my $ord ( 0 .. 255 ) { use bytes; my $chr = chr $ord; my $esc = $chr =~ /[A-Za-z0-9\-_.!~*'()]/ ? $chr : sprintf "%%%02X", $ord; is encodeURIComponent($chr) => $esc, "encodeURIComponent(ord $ord)"; is decodeURIComponent($esc) => $chr, "decodeURIComponent($esc)"; if ($esc =~ /^%/) { my $lesc = lc $esc; is decodeURIComponent($lesc) => $chr, "decodeURIComponent($lesc)"; } } URI-Escape-XS-0.14/t/03-hashu.t000644 000765 000024 00000001542 12726247175 016542 0ustar00dankogaistaff000000 000000 #!perl -w # # $Id: 03-hashu.t,v 0.3 2014/01/20 20:39:54 dankogai Exp $ # # Original as URI-1.35/t/escape.t # use URI::Escape::XS; use Test::More tests => 6; use Encode; my %esc = map { encode_utf8($_) } ( '%uHHHH' => "%uHHHH", '%uD869%uDEB2%u5F3E%u0064' => "\x{2a6b2}\x{5F3E}d" ); for my $k (keys %esc) { is decodeURIComponent($k) => $esc{$k}, qq{decodeURI("$k")}; } { # Test::Harness 3.x hates me! # skip 'Test::Harness->VERSION > 3', 4 # if Test::Harness->can('VERSION') and Test::Harness->VERSION >= 3; my $warn; local($SIG{__WARN__}) = sub { $warn = shift }; is decodeURIComponent('%uD869') => '', qq{decodeURI("%uD869")}; like $warn => qr/lo surrogate is missing/, $warn; is decodeURIComponent('%uDEB2') => '', qq{decodeURI("%uDEB2")}; like $warn => qr/invalid surrogate hi/, $warn; } URI-Escape-XS-0.14/t/04-idn.t000644 000765 000024 00000002716 12726247175 016211 0ustar00dankogaistaff000000 000000 #!perl -w # # $Id: 04-idn.t,v 1.4 2012/08/06 01:44:20 dankogai Exp $ # # Original as URI-1.35/t/escape.t # use URI::Escape::XS; use Test::More tests => 8; SKIP: { use utf8; eval { require Net::LibIDN } or eval { require Net::IDN::Encode } or skip 'Net::LibIDN or Net::IDN::Encode required', 8; my $d = 'http://cnn.com/news'; my $e = 'http:%2F%2Fcnn.com%2Fnews'; is encodeURIComponentIDN($d) => $e, 'first encodeURIComponentIDN must preserve the path'; $d = 'http://cnn.com/news'; $e = 'http:%2F%2Fcnn.com%2Fnews'; is encodeURIComponentIDN($d) => $e, 'second encodeURIComponentIDN must preserve the path as well'; $d = 'http://ドメイン名例.jp/dankogai/だん/ダン'; $e = 'http:%2F%2Fxn--eckwd4c7cu47r2wf.jp%2Fdankogai%2F%E3%81%A0%E3%82%93%2F%E3%83%80%E3%83%B3'; is decodeURIComponentIDN($e) => $d, 'decodeURIComponentIDN'; is encodeURIComponentIDN($d) => $e, 'encodeURIComponentIDN'; $d = 'http://ドメイン名例.jp:8080/dankogai/だん/ダン'; $e = 'http:%2F%2Fxn--eckwd4c7cu47r2wf.jp:8080%2Fdankogai%2F%E3%81%A0%E3%82%93%2F%E3%83%80%E3%83%B3'; is decodeURIComponentIDN($e) => $d, 'decodeURIComponentIDN'; is encodeURIComponentIDN($d) => $e, 'encodeURIComponentIDN'; $d = 'http://مثال.إختبار'; $e = 'http:%2F%2Fxn--mgbh0fb.xn--kgbechtv'; is decodeURIComponentIDN($e) => $d, 'decodeURIComponentIDN'; is encodeURIComponentIDN($d) => $e, 'encodeURIComponentIDN'; } URI-Escape-XS-0.14/t/05-null.t000644 000765 000024 00000001231 12726247175 016401 0ustar00dankogaistaff000000 000000 #!perl -w # # $Id: 05-null.t,v 1.1 2009/10/07 11:40:30 dankogai Exp $ # # https://rt.cpan.org/Ticket/Display.html?id=45855 use URI::Escape::XS; use Test::More tests => 6; { no warnings 'uninitialized'; my $d; is encodeURIComponent($d) => '', 'encodeURIComponent(null)'; is decodeURIComponent($d) => '', 'decodeURIComponent(null)'; } $d = ''; is length(encodeURIComponent($d)) => 0, 'length encodeURIComponent(\'\')'; is defined(encodeURIComponent($d)) => 1, 'defined encodeURIComponent(\'\')'; is length(decodeURIComponent($d)) => 0, 'length decodeURIComponent(\'\')'; is defined(decodeURIComponent($d)) => 1, 'defined decodeURIComponent(\'\')'; URI-Escape-XS-0.14/t/06-nonstr.t000644 000765 000024 00000000756 12726247175 016766 0ustar00dankogaistaff000000 000000 #!perl -w # # $Id: 06-nonstr.t,v 0.1 2014/04/16 10:48:20 dankogai Exp $ # # https://rt.cpan.org/Ticket/Display.html?id=45855 use URI::Escape::XS; use Test::More tests => 4; my $d = 42; is encodeURIComponent($d) => '42', "encodeURIComponent($d)"; is decodeURIComponent($d) => '42', "decodeURIComponent($d)"; my $rd = \$d; my $rx = qr/^SCALAR\(0x[0-9a-fA-F]+\)$/ms; like encodeURIComponent($rd) => $rx, "encodeURIComponent($rd)"; like decodeURIComponent($rd) => $rx, "decodeURIComponent($rd)"; URI-Escape-XS-0.14/t/boilerplate.t000644 000765 000024 00000002324 11164763214 017503 0ustar00dankogaistaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 3; sub not_in_file_ok { my ($filename, %regex) = @_; open my $fh, "<", $filename or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } module_boilerplate_ok('lib/URI/Escape/XS.pm'); URI-Escape-XS-0.14/t/pod-coverage.t000644 000765 000024 00000000254 11164763214 017554 0ustar00dankogaistaff000000 000000 #!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); URI-Escape-XS-0.14/t/pod.t000644 000765 000024 00000000214 11164763214 015757 0ustar00dankogaistaff000000 000000 #!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); URI-Escape-XS-0.14/lib/URI/000755 000765 000024 00000000000 12726247214 015757 5ustar00dankogaistaff000000 000000 URI-Escape-XS-0.14/lib/URI/Escape/000755 000765 000024 00000000000 12726247214 017157 5ustar00dankogaistaff000000 000000 URI-Escape-XS-0.14/lib/URI/Escape/XS.pm000644 000765 000024 00000021367 12726247175 020066 0ustar00dankogaistaff000000 000000 package URI::Escape::XS; # # $Id: XS.pm,v 0.14 2016/06/09 11:09:14 dankogai Exp $ # use 5.008001; use warnings; use strict; our $VERSION = sprintf "%d.%02d", q$Revision: 0.14 $ =~ /(\d+)/g; use base qw(Exporter); our @EXPORT = qw(encodeURIComponent decodeURIComponent encodeURIComponentIDN decodeURIComponentIDN); our @EXPORT_OK = qw(uri_escape uri_unescape); require XSLoader; XSLoader::load('URI::Escape::XS', $VERSION); sub uri_unescape { wantarray ? map { decodeURIComponent($_) } @_ : decodeURIComponent(shift) } { use bytes; my %escapes = map { chr($_) => sprintf("%%%02X", $_) } (0..255); my %regexp; sub uri_escape { return unless @_; my ($text, $patn) = @_; return undef unless defined $text; $text .= ''; # RT#39344 -- force string if (defined $patn){ unless (exists $regexp{$patn}){ my $re; eval { $re = qr/[$patn]/; }; if ($@){ require Carp; Carp::croak(__PACKAGE__, $@); } $regexp{$patn} = $re; } $text =~ s/($regexp{$patn})/$escapes{$1}/ge; return $text; } else { return encodeURIComponent($text); } } } eval { require Net::LibIDN }; if ( !$@ ) { require Encode; *decodeURIComponentIDN = sub ($) { my $uri = Encode::decode_utf8( decodeURIComponent(shift) ); $uri =~ s{\A (https?://)([^/:]+)(:[\d]+)?(.*) } { $1 . Encode::decode_utf8( Net::LibIDN::idn_to_unicode($2, 'utf-8') ) . ($3||'') . $4; }msex; return $uri; }; *encodeURIComponentIDN = sub ($) { my $uri = shift; $uri =~ s{\A (https?)://([^/:]+)(:[\d]+)?(.*) } { $1 . ":%2F%2F" . Net::LibIDN::idn_to_ascii($2, 'utf-8') . ($3||'') . encodeURIComponent($4); }msex; return $uri; }; } else { eval { require Net::IDN::Encode }; if ( !$@ ) { require Encode; *decodeURIComponentIDN = sub ($) { my $uri = Encode::decode_utf8( decodeURIComponent(shift) ); $uri =~ s{\A (https?://)([^/:]+)(:[\d]+)?(.*) } { $1 . Net::IDN::Encode::domain_to_unicode($2) . ($3||'') . $4; }msex; return $uri; }; *encodeURIComponentIDN = sub ($) { my $uri = shift; $uri =~ s{\A (https?)://([^/:]+)(:[\d]+)?(.*) } { $1 . ":%2F%2F" . Net::IDN::Encode::domain_to_ascii($2) . ($3||'') . encodeURIComponent($4); }msex; return $uri; }; } } 1; __END__ =encoding utf8 =head1 NAME URI::Escape::XS - Drop-In replacement for URI::Escape =head1 VERSION $Id: XS.pm,v 0.14 2016/06/09 11:09:14 dankogai Exp $ =cut =head1 SYNOPSIS # use it instead of URI::Escape use URI::Escape::XS qw/uri_escape uri_unescape/; $safe = uri_escape("10% is enough\n"); $verysafe = uri_escape("foo", "\0-\377"); $str = uri_unescape($safe); # or use encodeURIComponent and decodeURIComponent use URI::Escape::XS; $safe = encodeURIComponent("10% is enough\n"); $str = decodeURIComponent("10%25%20is%20enough%0A"); # if you have CNet::IDN::Encode installed $safe = encodeURIComponentIDN("http://ドメイン名例.jp/dan/"); $str = decodeURIComponentIDN("http:%2F%2Fxn--eckwd4c7cu47r2wf.jp%2Fdan%2F"); =head1 EXPORT =head2 by default L and L L and L if either L or L is available =head2 on demand L and L =head1 FUNCTIONS =head2 encodeURIComponent Does what JavaScript's encodeURIComponent does. $uri = encodeURIComponent("http://www.example.com/"); # http%3A%2F%2Fwww.example.com%2F Note you cannot customize characters to escape. If you need to do so, use L. =head2 decodeURIComponent Does what JavaScript's decodeURIComponent does. $str = decodeURIComponent("http%3A%2F%2Fwww.example.com%2F"); # http://www.example.com/ It decode not only %HH sequences but also %uHHHH sequences, with surrogate pairs correctly decoded. $str = decodeURIComponent("%uD869%uDEB2%u5F3E%u0061"); # \x{2A6B2}\x{5F3E}a This function UNCONDITIONALLY returns the decoded string with utf8 flag off. To get utf8-decoded string, use L and decode_utf8(decodeURIComponent($uri)); This is the correct behavior because you cannot tell if the decoded string actually contains UTF-8 decoded string, like ISO-8859-1 and Shift_JIS. =head2 encodeURIComponentIDN Same as L except that the host part is encoded in punycode. Either L or L is required to use this function. URIs with Internationalizing Domain Names require two encodings: Punycode for host part and URI escape for the rest. Currently only FULL URIs with C or C are supported. =head2 decodeURIComponentIDN Same as L except that the host part is encoded in punycode. Either L or L is required to use this function. =head2 uri_escape Does exactly the same as L::uri_escape() B when utf8-flagged string is fed. L::uri_escape() croak and urge you to C but it is pointless because URI itself has no such things as utf8 flag. The function in this module ALWAYS TREATS the string as byte sequence. That way you can safely use this function without worrying about utf8 flags. Note this function is NOT EXPORTED by default. That way you can use L and L simultaneously. =head2 uri_unescape Does exactly the same as L::uri_escape() B when %uHHHH is fed. L::uri_unescape() simply ignores %uHHHH sequences while the function in this module does decode it into the corresponding UTF-8 B. Like L, this function is NOT EXPORTED by default. =head2 Note on the %uHHHH sequence With this module the resulting strings never have the utf8 flag on. So if you want to decode it to perl utf8, You have to explicitly decode via L. Remember. URIs have always been a byte sequence, not UTF-8 characters. If the %uHHHH sequence became standard, you could have safely told if a given URI is in Unicode. But more fortunately than unfortunately, the RFC proposal was rejected so you cannot tell which encoding is used just by looking at the URI. L I said fortunately because %uHHHH can be nasty for non-BMP characters. Since each %uHHHH can hold one 16-bit value, you need a I to represent it if it is U+10000 and above. In spite of that, there are a significant number of URIs with %uHHHH escapes. Therefore this module supports decoding only. =head1 SPEED Since this module uses XS, it is really fast except for uri_escape("noop"). Regexp which is used in L is really fast for non-matching but slows down significantly when it has to replace string. =head2 BENCHMARK On Macbook Pro 2GHz, Perl 5.8.8. http://www.google.co.jp/search?q=%E5%B0%8F%E9%A3%BC%E5%BC%BE ============================================================ Unescape it ----------- U::E 58526/s -- -88% U::E::XS 486968/s 732% -- -------------- Escape it back -------------- U::E 30046/s -- -78% U::E::XS 136992/s 356% -- www.example.com =============== Unescape it ----------- Rate U::E U::E::XS U::E 821972/s -- -4% U::E::XS 854732/s 4% -- -------------- Escape it back ------------- U::E::XS 522969/s -- -7% U::E 565112/s 8% -- =head1 AUTHOR Dan Kogai, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc URI::Escape::XS You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS Gisle Aas for L Koichi Taniguchi for L Thomas Jacob for L Claus Färber for L =head1 COPYRIGHT & LICENSE Copyright 2007-2014 Dan Kogai, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut