1package JSON::PP56; 2 3use 5.006; 4use strict; 5 6my @properties; 7 8$JSON::PP56::VERSION = '1.08'; 9 10BEGIN { 11 12 sub utf8::is_utf8 { 13 my $len = length $_[0]; # char length 14 { 15 use bytes; # byte length; 16 return $len != length $_[0]; # if !=, UTF8-flagged on. 17 } 18 } 19 20 21 sub utf8::upgrade { 22 ; # noop; 23 } 24 25 26 sub utf8::downgrade ($;$) { 27 return 1 unless ( utf8::is_utf8( $_[0] ) ); 28 29 if ( _is_valid_utf8( $_[0] ) ) { 30 my $downgrade; 31 for my $c ( unpack( "U*", $_[0] ) ) { 32 if ( $c < 256 ) { 33 $downgrade .= pack("C", $c); 34 } 35 else { 36 $downgrade .= pack("U", $c); 37 } 38 } 39 $_[0] = $downgrade; 40 return 1; 41 } 42 else { 43 Carp::croak("Wide character in subroutine entry") unless ( $_[1] ); 44 0; 45 } 46 } 47 48 49 sub utf8::encode ($) { # UTF8 flag off 50 if ( utf8::is_utf8( $_[0] ) ) { 51 $_[0] = pack( "C*", unpack( "C*", $_[0] ) ); 52 } 53 else { 54 $_[0] = pack( "U*", unpack( "C*", $_[0] ) ); 55 $_[0] = pack( "C*", unpack( "C*", $_[0] ) ); 56 } 57 } 58 59 60 sub utf8::decode ($) { # UTF8 flag on 61 if ( _is_valid_utf8( $_[0] ) ) { 62 utf8::downgrade( $_[0] ); 63 $_[0] = pack( "U*", unpack( "U*", $_[0] ) ); 64 } 65 } 66 67 68 *JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii; 69 *JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1; 70 *JSON::PP::JSON_PP_decode_surrogates = \&JSON::PP::_decode_surrogates; 71 *JSON::PP::JSON_PP_decode_unicode = \&JSON::PP::_decode_unicode; 72 73 unless ( defined &B::SVp_NOK ) { # missing in B module. 74 eval q{ sub B::SVp_NOK () { 0x02000000; } }; 75 } 76 77} 78 79 80 81sub _encode_ascii { 82 join('', 83 map { 84 $_ <= 127 ? 85 chr($_) : 86 $_ <= 65535 ? 87 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_)); 88 } _unpack_emu($_[0]) 89 ); 90} 91 92 93sub _encode_latin1 { 94 join('', 95 map { 96 $_ <= 255 ? 97 chr($_) : 98 $_ <= 65535 ? 99 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_)); 100 } _unpack_emu($_[0]) 101 ); 102} 103 104 105sub _unpack_emu { # for Perl 5.6 unpack warnings 106 return !utf8::is_utf8($_[0]) ? unpack('C*', $_[0]) 107 : _is_valid_utf8($_[0]) ? unpack('U*', $_[0]) 108 : unpack('C*', $_[0]); 109} 110 111 112sub _is_valid_utf8 { 113 my $str = $_[0]; 114 my $is_utf8; 115 116 while ($str =~ /(?: 117 ( 118 [\x00-\x7F] 119 |[\xC2-\xDF][\x80-\xBF] 120 |[\xE0][\xA0-\xBF][\x80-\xBF] 121 |[\xE1-\xEC][\x80-\xBF][\x80-\xBF] 122 |[\xED][\x80-\x9F][\x80-\xBF] 123 |[\xEE-\xEF][\x80-\xBF][\x80-\xBF] 124 |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] 125 |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] 126 |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] 127 ) 128 | (.) 129 )/xg) 130 { 131 if (defined $1) { 132 $is_utf8 = 1 if (!defined $is_utf8); 133 } 134 else { 135 $is_utf8 = 0 if (!defined $is_utf8); 136 if ($is_utf8) { # eventually, not utf8 137 return; 138 } 139 } 140 } 141 142 return $is_utf8; 143} 144 145 146sub JSON::PP::incr_parse { 147 local $Carp::CarpLevel = 1; 148 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ ); 149} 150 151 152sub JSON::PP::incr_text : lvalue { 153 $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new; 154 155 if ( $_[0]->{_incr_parser}->{incr_parsing} ) { 156 Carp::croak("incr_text can not be called when the incremental parser already started parsing"); 157 } 158 $_[0]->{_incr_parser}->{incr_text}; 159} 160 161 162sub JSON::PP::incr_skip { 163 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip; 164} 165 166 167sub JSON::PP::incr_reset { 168 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset; 169} 170 171 1721; 173__END__ 174 175=pod 176 177=head1 NAME 178 179JSON::PP56 - Helper module in using JSON::PP in Perl 5.6 180 181=head1 DESCRIPTION 182 183JSON::PP calls internally. 184 185=head1 AUTHOR 186 187Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> 188 189 190=head1 COPYRIGHT AND LICENSE 191 192Copyright 2007-2009 by Makamaka Hannyaharamitu 193 194This library is free software; you can redistribute it and/or modify 195it under the same terms as Perl itself. 196 197=cut 198 199