17d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)package # This is JSON::backportPP 27d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) JSON::backportPP56; 37d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 47d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)use 5.006; 57d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)use strict; 67d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 77d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)my @properties; 87d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 97d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)$JSON::PP56::VERSION = '1.08'; 107d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 117d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)BEGIN { 127d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 137d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) sub utf8::is_utf8 { 147d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) my $len = length $_[0]; # char length 157d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) { 167d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) use bytes; # byte length; 177d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) return $len != length $_[0]; # if !=, UTF8-flagged on. 187d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 197d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 207d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 217d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 227d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) sub utf8::upgrade { 237d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) ; # noop; 247d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 257d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 267d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 277d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) sub utf8::downgrade ($;$) { 287d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) return 1 unless ( utf8::is_utf8( $_[0] ) ); 297d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 307d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) if ( _is_valid_utf8( $_[0] ) ) { 317d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) my $downgrade; 327d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) for my $c ( unpack( "U*", $_[0] ) ) { 337d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) if ( $c < 256 ) { 347d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $downgrade .= pack("C", $c); 357d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 367d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) else { 377d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $downgrade .= pack("U", $c); 387d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 397d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 407d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_[0] = $downgrade; 417d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) return 1; 427d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 437d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) else { 447d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) Carp::croak("Wide character in subroutine entry") unless ( $_[1] ); 457d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 0; 467d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 477d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 487d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 497d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 507d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) sub utf8::encode ($) { # UTF8 flag off 517d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) if ( utf8::is_utf8( $_[0] ) ) { 527d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_[0] = pack( "C*", unpack( "C*", $_[0] ) ); 537d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 547d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) else { 557d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_[0] = pack( "U*", unpack( "C*", $_[0] ) ); 567d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_[0] = pack( "C*", unpack( "C*", $_[0] ) ); 577d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 587d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 597d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 607d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 617d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) sub utf8::decode ($) { # UTF8 flag on 627d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) if ( _is_valid_utf8( $_[0] ) ) { 637d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) utf8::downgrade( $_[0] ); 647d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_[0] = pack( "U*", unpack( "U*", $_[0] ) ); 657d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 667d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 677d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 687d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 697d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) *JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii; 707d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) *JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1; 717d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) *JSON::PP::JSON_PP_decode_surrogates = \&JSON::PP::_decode_surrogates; 727d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) *JSON::PP::JSON_PP_decode_unicode = \&JSON::PP::_decode_unicode; 737d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 747d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) unless ( defined &B::SVp_NOK ) { # missing in B module. 757d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) eval q{ sub B::SVp_NOK () { 0x02000000; } }; 767d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 777d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 787d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)} 797d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 807d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 817d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 827d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)sub _encode_ascii { 837d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) join('', 847d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) map { 857d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_ <= 127 ? 867d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) chr($_) : 877d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_ <= 65535 ? 887d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_)); 897d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } _unpack_emu($_[0]) 907d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) ); 917d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)} 927d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 937d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 947d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)sub _encode_latin1 { 957d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) join('', 967d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) map { 977d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_ <= 255 ? 987d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) chr($_) : 997d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $_ <= 65535 ? 1007d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_)); 1017d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } _unpack_emu($_[0]) 1027d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) ); 1037d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)} 1047d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1057d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1067d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)sub _unpack_emu { # for Perl 5.6 unpack warnings 1077d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) return !utf8::is_utf8($_[0]) ? unpack('C*', $_[0]) 1087d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) : _is_valid_utf8($_[0]) ? unpack('U*', $_[0]) 1097d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) : unpack('C*', $_[0]); 1107d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)} 1117d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1127d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1137d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)sub _is_valid_utf8 { 1147d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) my $str = $_[0]; 1157d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) my $is_utf8; 1167d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1177d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) while ($str =~ /(?: 1187d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) ( 1197d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) [\x00-\x7F] 1207d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) |[\xC2-\xDF][\x80-\xBF] 1217d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) |[\xE0][\xA0-\xBF][\x80-\xBF] 1227d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) |[\xE1-\xEC][\x80-\xBF][\x80-\xBF] 1237d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) |[\xED][\x80-\x9F][\x80-\xBF] 1247d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) |[\xEE-\xEF][\x80-\xBF][\x80-\xBF] 1257d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] 1267d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] 1277d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] 1287d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) ) 1297d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) | (.) 1307d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) )/xg) 1317d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) { 1327d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) if (defined $1) { 1337d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $is_utf8 = 1 if (!defined $is_utf8); 1347d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 1357d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) else { 1367d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) $is_utf8 = 0 if (!defined $is_utf8); 1377d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) if ($is_utf8) { # eventually, not utf8 1387d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) return; 1397d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 1407d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 1417d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) } 1427d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1437d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) return $is_utf8; 1447d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)} 1457d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1467d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1477d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)1; 1487d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)__END__ 1497d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1507d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)=pod 1517d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1527d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)=head1 NAME 1537d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1547d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)JSON::PP56 - Helper module in using JSON::PP in Perl 5.6 1557d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1567d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)=head1 DESCRIPTION 1577d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1587d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)JSON::PP calls internally. 1597d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1607d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)=head1 AUTHOR 1617d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1627d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> 1637d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1647d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1657d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)=head1 COPYRIGHT AND LICENSE 1667d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1677d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)Copyright 2007-2012 by Makamaka Hannyaharamitu 1687d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1697d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)This library is free software; you can redistribute it and/or modify 1707d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)it under the same terms as Perl itself. 1717d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 1727d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles)=cut 1737d4cd473f85ac64c3747c96c277f9e506a0d2246Torne (Richard Coles) 174