package JE; use strict; use warnings; no warnings 'utf8'; use Encode 2.08 qw< decode_utf8 encode_utf8 FB_CROAK >; sub _decodeURI { my $global = shift; my $str = shift; $str = defined $str ? $str->to_string->value : 'undefined'; $str =~ /%(?![a-fA-F0-9]{2})(.{0,2})/ and require JE::Object::Error::URIError, die JE::Object::Error::URIError->new( $global, add_line_number "Invalid escape %$1 in URI" ); $str = encode_utf8 $str; # [;/?:@&=+$,#] do not get unescaped $str =~ s/%(?!2[346bcf]|3[abdf]|40) ([0-9a-f]{2})/chr hex $1/iegx; if (do{ local $@; eval { $str = decode_utf8 $str, FB_CROAK; }; $@ }) { require JE'Object'Error'URIError; die JE::Object::Error::URIError ->new( $global, add_line_number 'Malformed UTF-8 in URI' ); } $str =~ /^[\0-\x{10ffff}]*\z/ or require JE::Object::Error::URIError, die JE::Object::Error::URIError->new( $global, add_line_number 'Malformed UTF-8 in URI'); JE::String->_new($global, $str); } sub _decodeURIComponent { my $global = shift; my $str = shift; $str = defined $str ? $str->to_string->value : 'undefined'; $str =~ /%(?![a-fA-F0-9]{2})(.{0,2})/ and require JE::Object::Error::URIError, die JE::Object::Error::URIError->new( $global, add_line_number "Invalid escape %$1 in URI" ); $str = encode_utf8 $str; # [;/?:@&=+$,#] do not get unescaped $str =~ s/%([0-9a-f]{2})/chr hex $1/iegx; if (do{ local $@; eval { $str = decode_utf8 $str, FB_CROAK; }; $@ }) { require JE'Object'Error'URIError; die JE::Object::Error::URIError ->new( $global, add_line_number 'Malformed UTF-8 in URI' ); } $str =~ /^[\0-\x{10ffff}]*\z/ or require JE::Object::Error::URIError, die JE::Object::Error::URIError->new( $global, add_line_number 'Malformed UTF-8 in URI'); JE::String->_new($global, $str); } sub _encodeURI { my $global = shift; my $str = shift; $str = defined $str ? $str->to_string->value : 'undefined'; $str =~ /(\p{Cs})/ and require JE::Object::Error::URIError, die JE::Object::Error::URIError->new($global, add_line_number sprintf "Unpaired surrogate 0x%x in string", ord $1 ); $str = encode_utf8 $str; $str =~ s< ([^;/?:@&=+\$,A-Za-z0-9\-_.!~*'()#]) > < sprintf '%%%02X', ord $1 >egx; JE::String->_new($global, $str); } sub _encodeURIComponent { my $global = shift; my $str = shift; $str = defined $str ? $str->to_string->value : 'undefined'; $str =~ /(\p{Cs})/ and require JE::Object::Error::URIError, die JE::Object::Error::URIError->new( $global, add_line_number sprintf "Unpaired surrogate 0x%x in string", ord $1 ); $str = encode_utf8 $str; $str =~ s< ([^A-Za-z0-9\-_.!~*'()]) > < sprintf '%%%02X', ord $1 >egx; JE::String->_new($global, $str); } sub _escape { my $global = shift; my $str = defined $_[0] ? shift->to_string->value16 : 'undefined'; no warnings 'utf8'; $str =~ s< ([^A-Za-z0-9\@*_+\-./]) > [ sprintf '%%' . ( ord $1 <= 0xff ? '%02' : 'u%04' ) . 'x', ord $1 ]egx; JE::String->_new($global, $str); } sub _unescape { my $global = shift; my $str = defined $_[0] ? shift->to_string->value16 : 'undefined'; $str =~s<%(?:u([a-f0-9]{4})|([a-f0-9]{2}))> < chr hex $+ >egix; JE::String->_new($global, $str); } 1