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