← Index
NYTProf Performance Profile   « line view »
For Makefile.PL
  Run on Sun Mar 1 16:04:44 2015
Reported on Sun Mar 1 16:09:02 2015

FilenameC:/tmp64ng/perl/lib/JSON/PP.pm
StatementsExecuted 217270 statements in 203ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
2264216146.8ms46.8msJSON::PP::::next_chr JSON::PP::next_chr
14062131.2ms78.0msJSON::PP::::string JSON::PP::string
7342131.2ms46.8msJSON::PP::::value_to_json JSON::PP::value_to_json
11115.6ms15.6msJSON::PP::::BEGIN@11 JSON::PP::BEGIN@11
34262115.6ms15.6msJSON::PP::::CORE:subst JSON::PP::CORE:subst (opcode)
4651115.6ms93.6msJSON::PP::::hash_to_json JSON::PP::hash_to_json (recurses: max depth 3, inclusive time 15.6ms)
3741115.6ms109msJSON::PP::::object JSON::PP::object (recurses: max depth 3, inclusive time 15.6ms)
13214115.6ms93.6msJSON::PP::::object_to_json JSON::PP::object_to_json (recurses: max depth 5, inclusive time 125ms)
17132115.6ms31.2msJSON::PP::::string_to_json JSON::PP::string_to_json
10673115.6ms109msJSON::PP::::value JSON::PP::value (recurses: max depth 4, inclusive time 62.4ms)
1110s0sJSON::PP::::BEGIN@10 JSON::PP::BEGIN@10
1110s0sJSON::PP::::BEGIN@1269 JSON::PP::BEGIN@1269
1110s0sJSON::PP::::BEGIN@1332 JSON::PP::BEGIN@1332
1110s0sJSON::PP::::BEGIN@21 JSON::PP::BEGIN@21
1110s0sJSON::PP::::BEGIN@22 JSON::PP::BEGIN@22
1110s0sJSON::PP::::BEGIN@23 JSON::PP::BEGIN@23
1110s0sJSON::PP::::BEGIN@24 JSON::PP::BEGIN@24
1110s0sJSON::PP::::BEGIN@25 JSON::PP::BEGIN@25
1110s0sJSON::PP::::BEGIN@26 JSON::PP::BEGIN@26
1110s0sJSON::PP::::BEGIN@27 JSON::PP::BEGIN@27
1110s0sJSON::PP::::BEGIN@28 JSON::PP::BEGIN@28
1110s0sJSON::PP::::BEGIN@29 JSON::PP::BEGIN@29
1110s0sJSON::PP::::BEGIN@30 JSON::PP::BEGIN@30
1110s0sJSON::PP::::BEGIN@31 JSON::PP::BEGIN@31
1110s0sJSON::PP::::BEGIN@32 JSON::PP::BEGIN@32
1110s0sJSON::PP::::BEGIN@34 JSON::PP::BEGIN@34
1110s0sJSON::PP::::BEGIN@35 JSON::PP::BEGIN@35
1110s0sJSON::PP::::BEGIN@36 JSON::PP::BEGIN@36
1110s0sJSON::PP::::BEGIN@37 JSON::PP::BEGIN@37
1110s0sJSON::PP::::BEGIN@38 JSON::PP::BEGIN@38
1110s0sJSON::PP::::BEGIN@39 JSON::PP::BEGIN@39
1110s0sJSON::PP::::BEGIN@41 JSON::PP::BEGIN@41
1110s0sJSON::PP::::BEGIN@43 JSON::PP::BEGIN@43
1110s0sJSON::PP::::BEGIN@45 JSON::PP::BEGIN@45
1110s0sJSON::PP::::BEGIN@5 JSON::PP::BEGIN@5
1110s0sJSON::PP::::BEGIN@584 JSON::PP::BEGIN@584
1110s0sJSON::PP::::BEGIN@6 JSON::PP::BEGIN@6
1110s0sJSON::PP::::BEGIN@667 JSON::PP::BEGIN@667
1110s0sJSON::PP::::BEGIN@7 JSON::PP::BEGIN@7
1110s0sJSON::PP::::BEGIN@8 JSON::PP::BEGIN@8
1110s0sJSON::PP::Boolean::::BEGIN@1403 JSON::PP::Boolean::BEGIN@1403
0000s0sJSON::PP::Boolean::::__ANON__[:1404] JSON::PP::Boolean::__ANON__[:1404]
0000s0sJSON::PP::Boolean::::__ANON__[:1405] JSON::PP::Boolean::__ANON__[:1405]
0000s0sJSON::PP::Boolean::::__ANON__[:1406] JSON::PP::Boolean::__ANON__[:1406]
173611010s0sJSON::PP::::CORE:match JSON::PP::CORE:match (opcode)
96110s0sJSON::PP::::CORE:sort JSON::PP::CORE:sort (opcode)
55110s0sJSON::PP::::CORE:unpack JSON::PP::CORE:unpack (opcode)
1110s0sJSON::PP::IncrParser::::BEGIN@1415JSON::PP::IncrParser::BEGIN@1415
1110s0sJSON::PP::IncrParser::::BEGIN@1417JSON::PP::IncrParser::BEGIN@1417
1110s0sJSON::PP::IncrParser::::BEGIN@1418JSON::PP::IncrParser::BEGIN@1418
1110s0sJSON::PP::IncrParser::::BEGIN@1419JSON::PP::IncrParser::BEGIN@1419
1110s0sJSON::PP::IncrParser::::BEGIN@1420JSON::PP::IncrParser::BEGIN@1420
1110s0sJSON::PP::IncrParser::::BEGIN@1421JSON::PP::IncrParser::BEGIN@1421
1110s0sJSON::PP::IncrParser::::BEGIN@1422JSON::PP::IncrParser::BEGIN@1422
0000s0sJSON::PP::IncrParser::::_incr_parseJSON::PP::IncrParser::_incr_parse
0000s0sJSON::PP::IncrParser::::incr_parseJSON::PP::IncrParser::incr_parse
0000s0sJSON::PP::IncrParser::::incr_resetJSON::PP::IncrParser::incr_reset
0000s0sJSON::PP::IncrParser::::incr_skipJSON::PP::IncrParser::incr_skip
0000s0sJSON::PP::IncrParser::::incr_textJSON::PP::IncrParser::incr_text
0000s0sJSON::PP::IncrParser::::newJSON::PP::IncrParser::new
0000s0sJSON::PP::::PP_decode_box JSON::PP::PP_decode_box
55110s109msJSON::PP::::PP_decode_json JSON::PP::PP_decode_json
0000s0sJSON::PP::::PP_encode_box JSON::PP::PP_encode_box
63110s93.6msJSON::PP::::PP_encode_json JSON::PP::PP_encode_json
0000s0sJSON::PP::::__ANON__[:1345] JSON::PP::__ANON__[:1345]
0000s0sJSON::PP::::__ANON__[:134] JSON::PP::__ANON__[:134]
0000s0sJSON::PP::::__ANON__[:1366] JSON::PP::__ANON__[:1366]
0000s0sJSON::PP::::__ANON__[:1383] JSON::PP::__ANON__[:1383]
0000s0sJSON::PP::::__ANON__[:281] JSON::PP::__ANON__[:281]
0000s0sJSON::PP::::__ANON__[:286] JSON::PP::__ANON__[:286]
0000s0sJSON::PP::::_decode_surrogates JSON::PP::_decode_surrogates
0000s0sJSON::PP::::_decode_unicode JSON::PP::_decode_unicode
123210s0sJSON::PP::::_down_indent JSON::PP::_down_indent
0000s0sJSON::PP::::_encode_ascii JSON::PP::_encode_ascii
0000s0sJSON::PP::::_encode_latin1 JSON::PP::_encode_latin1
0000s0sJSON::PP::::_encode_surrogates JSON::PP::_encode_surrogates
0000s0sJSON::PP::::_is_bignum JSON::PP::_is_bignum
0000s0sJSON::PP::::_json_object_hook JSON::PP::_json_object_hook
465110s0sJSON::PP::::_sort JSON::PP::_sort
123210s0sJSON::PP::::_up_indent JSON::PP::_up_indent
0000s0sJSON::PP::::allow_bigint JSON::PP::allow_bigint
106110s0sJSON::PP::::array JSON::PP::array
130110s15.6msJSON::PP::::array_to_json JSON::PP::array_to_json
0000s0sJSON::PP::::bareKey JSON::PP::bareKey
0000s0sJSON::PP::::blessed_to_json JSON::PP::blessed_to_json
55220s109msJSON::PP::::decode JSON::PP::decode
0000s0sJSON::PP::::decode_error JSON::PP::decode_error
0000s0sJSON::PP::::decode_json JSON::PP::decode_json
0000s0sJSON::PP::::decode_prefix JSON::PP::decode_prefix
63220s93.6msJSON::PP::::encode JSON::PP::encode
0000s0sJSON::PP::::encode_error JSON::PP::encode_error
0000s0sJSON::PP::::encode_json JSON::PP::encode_json
0000s0sJSON::PP::::false JSON::PP::false
0000s0sJSON::PP::::filter_json_object JSON::PP::filter_json_object
0000s0sJSON::PP::::filter_json_single_key_object JSON::PP::filter_json_single_key_object
0000s0sJSON::PP::::from_json JSON::PP::from_json
0000s0sJSON::PP::::get_indent_length JSON::PP::get_indent_length
0000s0sJSON::PP::::get_max_depth JSON::PP::get_max_depth
0000s0sJSON::PP::::get_max_size JSON::PP::get_max_size
0000s0sJSON::PP::::incr_parse JSON::PP::incr_parse
0000s0sJSON::PP::::incr_reset JSON::PP::incr_reset
0000s0sJSON::PP::::incr_skip JSON::PP::incr_skip
9110s0sJSON::PP::::indent_length JSON::PP::indent_length
0000s0sJSON::PP::::is_bool JSON::PP::is_bool
0000s0sJSON::PP::::is_valid_utf8 JSON::PP::is_valid_utf8
0000s0sJSON::PP::::max_depth JSON::PP::max_depth
0000s0sJSON::PP::::max_size JSON::PP::max_size
64330s0sJSON::PP::::new JSON::PP::new
0000s0sJSON::PP::::null JSON::PP::null
54110s0sJSON::PP::::number JSON::PP::number
9110s0sJSON::PP::::pretty JSON::PP::pretty
0000s0sJSON::PP::::sort_by JSON::PP::sort_by
0000s0sJSON::PP::::to_json JSON::PP::to_json
0000s0sJSON::PP::::true JSON::PP::true
41111010s0sJSON::PP::::white JSON::PP::white
0000s0sJSON::PP::::word JSON::PP::word
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package JSON::PP;
2
3# JSON-2.0
4
520s10s
# spent 0s within JSON::PP::BEGIN@5 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 5
use 5.005;
# spent 0s making 1 call to JSON::PP::BEGIN@5
620s20s
# spent 0s within JSON::PP::BEGIN@6 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 6
use strict;
# spent 0s making 1 call to JSON::PP::BEGIN@6 # spent 0s making 1 call to strict::import
720s20s
# spent 0s within JSON::PP::BEGIN@7 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 7
use base qw(Exporter);
# spent 0s making 1 call to JSON::PP::BEGIN@7 # spent 0s making 1 call to base::import
820s10s
# spent 0s within JSON::PP::BEGIN@8 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 8
use overload ();
# spent 0s making 1 call to JSON::PP::BEGIN@8
9
1020s10s
# spent 0s within JSON::PP::BEGIN@10 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 10
use Carp ();
# spent 0s making 1 call to JSON::PP::BEGIN@10
1120s115.6ms
# spent 15.6ms within JSON::PP::BEGIN@11 which was called: # once (15.6ms+0s) by Parse::CPAN::Meta::_can_load at line 11
use B ();
# spent 15.6ms making 1 call to JSON::PP::BEGIN@11
12#use Devel::Peek;
13
1410s$JSON::PP::VERSION = '2.27300';
15
1610s@JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
17
18# instead of hash-access, i tried index-access for speed.
19# but this method is not faster than what i expected. so it will be changed.
20
2120s20s
# spent 0s within JSON::PP::BEGIN@21 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 21
use constant P_ASCII => 0;
# spent 0s making 1 call to JSON::PP::BEGIN@21 # spent 0s making 1 call to constant::import
2220s20s
# spent 0s within JSON::PP::BEGIN@22 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 22
use constant P_LATIN1 => 1;
# spent 0s making 1 call to JSON::PP::BEGIN@22 # spent 0s making 1 call to constant::import
2320s20s
# spent 0s within JSON::PP::BEGIN@23 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 23
use constant P_UTF8 => 2;
# spent 0s making 1 call to JSON::PP::BEGIN@23 # spent 0s making 1 call to constant::import
2420s20s
# spent 0s within JSON::PP::BEGIN@24 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 24
use constant P_INDENT => 3;
# spent 0s making 1 call to JSON::PP::BEGIN@24 # spent 0s making 1 call to constant::import
2520s20s
# spent 0s within JSON::PP::BEGIN@25 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 25
use constant P_CANONICAL => 4;
# spent 0s making 1 call to JSON::PP::BEGIN@25 # spent 0s making 1 call to constant::import
2620s20s
# spent 0s within JSON::PP::BEGIN@26 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 26
use constant P_SPACE_BEFORE => 5;
# spent 0s making 1 call to JSON::PP::BEGIN@26 # spent 0s making 1 call to constant::import
2720s20s
# spent 0s within JSON::PP::BEGIN@27 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 27
use constant P_SPACE_AFTER => 6;
# spent 0s making 1 call to JSON::PP::BEGIN@27 # spent 0s making 1 call to constant::import
2820s20s
# spent 0s within JSON::PP::BEGIN@28 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 28
use constant P_ALLOW_NONREF => 7;
# spent 0s making 1 call to JSON::PP::BEGIN@28 # spent 0s making 1 call to constant::import
2920s20s
# spent 0s within JSON::PP::BEGIN@29 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 29
use constant P_SHRINK => 8;
# spent 0s making 1 call to JSON::PP::BEGIN@29 # spent 0s making 1 call to constant::import
3020s20s
# spent 0s within JSON::PP::BEGIN@30 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 30
use constant P_ALLOW_BLESSED => 9;
# spent 0s making 1 call to JSON::PP::BEGIN@30 # spent 0s making 1 call to constant::import
3120s20s
# spent 0s within JSON::PP::BEGIN@31 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 31
use constant P_CONVERT_BLESSED => 10;
# spent 0s making 1 call to JSON::PP::BEGIN@31 # spent 0s making 1 call to constant::import
3220s20s
# spent 0s within JSON::PP::BEGIN@32 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 32
use constant P_RELAXED => 11;
# spent 0s making 1 call to JSON::PP::BEGIN@32 # spent 0s making 1 call to constant::import
33
3420s20s
# spent 0s within JSON::PP::BEGIN@34 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 34
use constant P_LOOSE => 12;
# spent 0s making 1 call to JSON::PP::BEGIN@34 # spent 0s making 1 call to constant::import
3520s20s
# spent 0s within JSON::PP::BEGIN@35 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 35
use constant P_ALLOW_BIGNUM => 13;
# spent 0s making 1 call to JSON::PP::BEGIN@35 # spent 0s making 1 call to constant::import
3620s20s
# spent 0s within JSON::PP::BEGIN@36 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 36
use constant P_ALLOW_BAREKEY => 14;
# spent 0s making 1 call to JSON::PP::BEGIN@36 # spent 0s making 1 call to constant::import
3720s20s
# spent 0s within JSON::PP::BEGIN@37 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 37
use constant P_ALLOW_SINGLEQUOTE => 15;
# spent 0s making 1 call to JSON::PP::BEGIN@37 # spent 0s making 1 call to constant::import
3820s20s
# spent 0s within JSON::PP::BEGIN@38 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 38
use constant P_ESCAPE_SLASH => 16;
# spent 0s making 1 call to JSON::PP::BEGIN@38 # spent 0s making 1 call to constant::import
3920s20s
# spent 0s within JSON::PP::BEGIN@39 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 39
use constant P_AS_NONBLESSED => 17;
# spent 0s making 1 call to JSON::PP::BEGIN@39 # spent 0s making 1 call to constant::import
40
4120s20s
# spent 0s within JSON::PP::BEGIN@41 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 41
use constant P_ALLOW_UNKNOWN => 18;
# spent 0s making 1 call to JSON::PP::BEGIN@41 # spent 0s making 1 call to constant::import
42
4320s20s
# spent 0s within JSON::PP::BEGIN@43 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 43
use constant OLD_PERL => $] < 5.008 ? 1 : 0;
# spent 0s making 1 call to JSON::PP::BEGIN@43 # spent 0s making 1 call to constant::import
44
45
# spent 0s within JSON::PP::BEGIN@45 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 86
BEGIN {
4610s my @xs_compati_bit_properties = qw(
47 latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
48 allow_blessed convert_blessed relaxed allow_unknown
49 );
5010s my @pp_bit_properties = qw(
51 allow_singlequote allow_bignum loose
52 allow_barekey escape_slash as_nonblessed
53 );
54
55 # Perl version check, Unicode handling is enable?
56 # Helper module sets @JSON::PP::_properties.
5710s if ($] < 5.008 ) {
58 my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
59 eval qq| require $helper |;
60 if ($@) { Carp::croak $@; }
61 }
62
6310s for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
64190s my $flag_name = 'P_' . uc($name);
65
66190s eval qq/
# spent 15.6ms executing statements in string eval
# includes 15.6ms spent executing 54 calls to 2 subs defined therein. # spent 0s executing statements in string eval
# includes 0s spent executing 9 calls to 2 subs defined therein. # spent 0s executing statements in string eval
# includes 0s spent executing 9 calls to 2 subs defined therein. # spent 0s executing statements in string eval
# includes 0s spent executing 9 calls to 2 subs defined therein. # spent 0s executing statements in string eval
# includes 0s spent executing 9 calls to 2 subs defined therein. # spent 0s executing statements in string eval
# includes 0s spent executing 54 calls to 2 subs defined therein. # spent 0s executing statements in string eval
# includes 0s spent executing 54 calls to 2 subs defined therein.
67 sub $name {
68 my \$enable = defined \$_[1] ? \$_[1] : 1;
69
70 if (\$enable) {
71 \$_[0]->{PROPS}->[$flag_name] = 1;
72 }
73 else {
74 \$_[0]->{PROPS}->[$flag_name] = 0;
75 }
76
77 \$_[0];
78 }
79
80 sub get_$name {
81 \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
82 }
83 /;
84 }
85
8610s10s}
# spent 0s making 1 call to JSON::PP::BEGIN@45
87
- -
90# Functions
91
92my %encode_allow_method
9310s = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash
94 allow_blessed convert_blessed indent indent_length allow_bignum
95 as_nonblessed
96 /;
97my %decode_allow_method
9810s = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum
99 allow_barekey max_size relaxed/;
100
101
10210smy $JSON; # cache
103
104sub encode_json ($) { # encode
105 ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
106}
107
108
109sub decode_json { # decode
110 ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
111}
112
113# Obsoleted
114
115sub to_json($) {
116 Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
117}
118
119
120sub from_json($) {
121 Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
122}
123
124
125# Methods
126
127
# spent 0s within JSON::PP::new which was called 64 times, avg 0s/call: # 54 times (0s+0s) by CPAN::Meta::Converter::_dclone at line 56 of CPAN/Meta/Converter.pm, avg 0s/call # 9 times (0s+0s) by CPAN::Meta::as_string at line 612 of CPAN/Meta.pm, avg 0s/call # once (0s+0s) by Parse::CPAN::Meta::load_json_string at line 52 of Parse/CPAN/Meta.pm
sub new {
128640s my $class = shift;
129 my $self = {
130 max_depth => 512,
131 max_size => 0,
132 indent => 0,
133 FLAGS => 0,
134 fallback => sub { encode_error('Invalid value. JSON can only reference.') },
135640s indent_length => 3,
136 };
137
138640s bless $self, $class;
139}
140
141
142
# spent 93.6ms (0s+93.6) within JSON::PP::encode which was called 63 times, avg 1.49ms/call: # 54 times (0s+78.0ms) by CPAN::Meta::Converter::_dclone at line 60 of CPAN/Meta/Converter.pm, avg 1.44ms/call # 9 times (0s+15.6ms) by CPAN::Meta::as_string at line 612 of CPAN/Meta.pm, avg 1.73ms/call
sub encode {
143630s6393.6ms return $_[0]->PP_encode_json($_[1]);
# spent 93.6ms making 63 calls to JSON::PP::PP_encode_json, avg 1.49ms/call
144}
145
146
147
# spent 109ms (0s+109) within JSON::PP::decode which was called 55 times, avg 1.99ms/call: # 54 times (0s+109ms) by CPAN::Meta::Converter::_dclone at line 60 of CPAN/Meta/Converter.pm, avg 2.02ms/call # once (0s+0s) by Parse::CPAN::Meta::load_json_string at line 52 of Parse/CPAN/Meta.pm
sub decode {
148550s55109ms return $_[0]->PP_decode_json($_[1], 0x00000000);
# spent 109ms making 55 calls to JSON::PP::PP_decode_json, avg 1.99ms/call
149}
150
151
152sub decode_prefix {
153 return $_[0]->PP_decode_json($_[1], 0x00000001);
154}
155
156
157# accessor
158
159
160# pretty printing
161
162
# spent 0s within JSON::PP::pretty which was called 9 times, avg 0s/call: # 9 times (0s+0s) by CPAN::Meta::as_string at line 612 of CPAN/Meta.pm, avg 0s/call
sub pretty {
16390s my ($self, $v) = @_;
16490s my $enable = defined $v ? $v : 1;
165
16690s360s if ($enable) { # indent_length(3) for JSON::XS compatibility
# spent 0s making 9 calls to JSON::PP::indent, avg 0s/call # spent 0s making 9 calls to JSON::PP::indent_length, avg 0s/call # spent 0s making 9 calls to JSON::PP::space_after, avg 0s/call # spent 0s making 9 calls to JSON::PP::space_before, avg 0s/call
167 $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
168 }
169 else {
170 $self->indent(0)->space_before(0)->space_after(0);
171 }
172
17390s $self;
174}
175
176# etc
177
178sub max_depth {
179 my $max = defined $_[1] ? $_[1] : 0x80000000;
180 $_[0]->{max_depth} = $max;
181 $_[0];
182}
183
184
185sub get_max_depth { $_[0]->{max_depth}; }
186
187
188sub max_size {
189 my $max = defined $_[1] ? $_[1] : 0;
190 $_[0]->{max_size} = $max;
191 $_[0];
192}
193
194
195sub get_max_size { $_[0]->{max_size}; }
196
197
198sub filter_json_object {
199 $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0;
200 $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
201 $_[0];
202}
203
204sub filter_json_single_key_object {
205 if (@_ > 1) {
206 $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
207 }
208 $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
209 $_[0];
210}
211
212
# spent 0s within JSON::PP::indent_length which was called 9 times, avg 0s/call: # 9 times (0s+0s) by JSON::PP::pretty at line 166, avg 0s/call
sub indent_length {
21390s if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
214 Carp::carp "The acceptable range of indent_length() is 0 to 15.";
215 }
216 else {
21790s $_[0]->{indent_length} = $_[1];
218 }
21990s $_[0];
220}
221
222sub get_indent_length {
223 $_[0]->{indent_length};
224}
225
226sub sort_by {
227 $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
228 $_[0];
229}
230
231sub allow_bigint {
232 Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.");
233}
234
235###############################
236
237###
238### Perl => JSON
239###
240
241
242{ # Convert
243
24420s my $max_depth;
245 my $indent;
246 my $ascii;
247 my $latin1;
248 my $utf8;
249 my $space_before;
250 my $space_after;
251 my $canonical;
252 my $allow_blessed;
253 my $convert_blessed;
254
255 my $indent_length;
256 my $escape_slash;
257 my $bignum;
258 my $as_nonblessed;
259
260 my $depth;
261 my $indent_count;
262 my $keysort;
263
264
265
# spent 93.6ms (0s+93.6) within JSON::PP::PP_encode_json which was called 63 times, avg 1.49ms/call: # 63 times (0s+93.6ms) by JSON::PP::encode at line 143, avg 1.49ms/call
sub PP_encode_json {
266630s my $self = shift;
267630s my $obj = shift;
268
269630s $indent_count = 0;
270630s $depth = 0;
271
272630s my $idx = $self->{PROPS};
273
274 ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
275 $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
276630s = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
277 P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
278
279630s ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
280
2813670s $keysort = $canonical ? sub { $a cmp $b } : undef;
282
283630s if ($self->{sort_by}) {
284 $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
285 : $self->{sort_by} =~ /\D+/ ? $self->{sort_by}
286 : sub { $a cmp $b };
287 }
288
289630s encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
290 if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]);
291
292630s6393.6ms my $str = $self->object_to_json($obj);
# spent 93.6ms making 63 calls to JSON::PP::object_to_json, avg 1.49ms/call
293
294630s $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
295
296630s90s unless ($ascii or $latin1 or $utf8) {
# spent 0s making 9 calls to utf8::upgrade, avg 0s/call
297 utf8::upgrade($str);
298 }
299
300630s if ($idx->[ P_SHRINK ]) {
301 utf8::downgrade($str, 1);
302 }
303
304630s return $str;
305 }
306
307
308
# spent 93.6ms (15.6+78.0) within JSON::PP::object_to_json which was called 1321 times, avg 71µs/call: # 1068 times (15.6ms+-15.6ms) by JSON::PP::hash_to_json at line 368, avg 0s/call # 171 times (0s+0s) by JSON::PP::array_to_json at line 390, avg 0s/call # 63 times (0s+93.6ms) by JSON::PP::PP_encode_json at line 292, avg 1.49ms/call # 19 times (0s+0s) by JSON::PP::object_to_json at line 334, avg 0s/call
sub object_to_json {
30913210s my ($self, $obj) = @_;
31013210s my $type = ref($obj);
311
31213210s595109ms if($type eq 'HASH'){
# spent 109ms making 465 calls to JSON::PP::hash_to_json, avg 235µs/call, recursion: max depth 3, sum of overlapping time 15.6ms # spent 15.6ms making 130 calls to JSON::PP::array_to_json, avg 120µs/call
313 return $self->hash_to_json($obj);
314 }
315 elsif($type eq 'ARRAY'){
316 return $self->array_to_json($obj);
317 }
318 elsif ($type) { # blessed object?
319190s190s if (blessed($obj)) {
# spent 0s making 19 calls to Scalar::Util::blessed, avg 0s/call
320
321190s190s return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
# spent 0s making 19 calls to UNIVERSAL::isa, avg 0s/call
322
323190s190s if ( $convert_blessed and $obj->can('TO_JSON') ) {
# spent 0s making 19 calls to UNIVERSAL::can, avg 0s/call
324190s190s my $result = $obj->TO_JSON();
# spent 0s making 19 calls to CPAN::Meta::TO_JSON, avg 0s/call
325190s380s if ( defined $result and ref( $result ) ) {
# spent 0s making 38 calls to Scalar::Util::refaddr, avg 0s/call
326 if ( refaddr( $obj ) eq refaddr( $result ) ) {
327 encode_error( sprintf(
328 "%s::TO_JSON method returned same object as was passed instead of a new one",
329 ref $obj
330 ) );
331 }
332 }
333
334190s190s return $self->object_to_json( $result );
# spent 31.2ms making 19 calls to JSON::PP::object_to_json, avg 1.64ms/call, recursion: max depth 1, sum of overlapping time 31.2ms
335 }
336
337 return "$obj" if ( $bignum and _is_bignum($obj) );
338 return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed.
339
340 encode_error( sprintf("encountered object '%s', but neither allow_blessed "
341 . "nor convert_blessed settings are enabled", $obj)
342 ) unless ($allow_blessed);
343
344 return 'null';
345 }
346 else {
347 return $self->value_to_json($obj);
348 }
349 }
350 else{
35170715.6ms70746.8ms return $self->value_to_json($obj);
# spent 46.8ms making 707 calls to JSON::PP::value_to_json, avg 66µs/call
352 }
353 }
354
355
356
# spent 93.6ms (15.6+78.0) within JSON::PP::hash_to_json which was called 465 times, avg 201µs/call: # 465 times (15.6ms+78.0ms) by JSON::PP::object_to_json at line 312, avg 201µs/call
sub hash_to_json {
3574650s my ($self, $obj) = @_;
3584650s my @res;
359
3604650s encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
361 if (++$depth > $max_depth);
362
3634650s960s my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
# spent 0s making 96 calls to JSON::PP::_up_indent, avg 0s/call
3644650s my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
365
3664650s4650s for my $k ( _sort( $obj ) ) {
# spent 0s making 465 calls to JSON::PP::_sort, avg 0s/call
367 if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
36810680s216315.6ms push @res, string_to_json( $self, $k )
# spent 15.6ms making 1068 calls to JSON::PP::string_to_json, avg 15µs/call # spent 78.0ms making 1068 calls to JSON::PP::object_to_json, avg 73µs/call, recursion: max depth 5, sum of overlapping time 78.0ms # spent 0s making 27 calls to JSON::PP::value_to_json, avg 0s/call
369 . $del
370 . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
371 }
372
3734650s --$depth;
3744650s960s $self->_down_indent() if ($indent);
# spent 0s making 96 calls to JSON::PP::_down_indent, avg 0s/call
375
3764650s return '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . '}';
377 }
378
379
380
# spent 15.6ms (0s+15.6) within JSON::PP::array_to_json which was called 130 times, avg 120µs/call: # 130 times (0s+15.6ms) by JSON::PP::object_to_json at line 312, avg 120µs/call
sub array_to_json {
3811300s my ($self, $obj) = @_;
3821300s my @res;
383
3841300s encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
385 if (++$depth > $max_depth);
386
3871300s270s my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
# spent 0s making 27 calls to JSON::PP::_up_indent, avg 0s/call
388
3891300s for my $v (@$obj){
3901710s1710s push @res, $self->object_to_json($v) || $self->value_to_json($v);
# spent 15.6ms making 171 calls to JSON::PP::object_to_json, avg 91µs/call, recursion: max depth 4, sum of overlapping time 15.6ms
391 }
392
3931300s --$depth;
3941300s270s $self->_down_indent() if ($indent);
# spent 0s making 27 calls to JSON::PP::_down_indent, avg 0s/call
395
39613015.6ms return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']';
397 }
398
399
400
# spent 46.8ms (31.2+15.6) within JSON::PP::value_to_json which was called 734 times, avg 64µs/call: # 707 times (31.2ms+15.6ms) by JSON::PP::object_to_json at line 351, avg 66µs/call # 27 times (0s+0s) by JSON::PP::hash_to_json at line 368, avg 0s/call
sub value_to_json {
4017340s my ($self, $value) = @_;
402
4037340s return 'null' if(!defined $value);
404
4057340s7340s my $b_obj = B::svref_2object(\$value); # for round trip problem
# spent 0s making 734 calls to B::svref_2object, avg 0s/call
40673415.6ms7340s my $flags = $b_obj->FLAGS;
# spent 0s making 734 calls to B::SV::FLAGS, avg 0s/call
407
40873415.6ms return $value # as is
409 if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
410
4116450s my $type = ref($value);
412
4136450s64515.6ms if(!$type){
# spent 15.6ms making 645 calls to JSON::PP::string_to_json, avg 24µs/call
414 return string_to_json($self, $value);
415 }
416 elsif( blessed($value) and $value->isa('JSON::PP::Boolean') ){
417 return $$value == 1 ? 'true' : 'false';
418 }
419 elsif ($type) {
420 if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
421 return $self->value_to_json("$value");
422 }
423
424 if ($type eq 'SCALAR' and defined $$value) {
425 return $$value eq '1' ? 'true'
426 : $$value eq '0' ? 'false'
427 : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
428 : encode_error("cannot encode reference to scalar");
429 }
430
431 if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
432 return 'null';
433 }
434 else {
435 if ( $type eq 'SCALAR' or $type eq 'REF' ) {
436 encode_error("cannot encode reference to scalar");
437 }
438 else {
439 encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
440 }
441 }
442
443 }
444 else {
445 return $self->{fallback}->($value)
446 if ($self->{fallback} and ref($self->{fallback}) eq 'CODE');
447 return 'null';
448 }
449
450 }
451
452
45310s my %esc = (
454 "\n" => '\n',
455 "\r" => '\r',
456 "\t" => '\t',
457 "\f" => '\f',
458 "\b" => '\b',
459 "\"" => '\"',
460 "\\" => '\\\\',
461 "\'" => '\\\'',
462 );
463
464
465
# spent 31.2ms (15.6+15.6) within JSON::PP::string_to_json which was called 1713 times, avg 18µs/call: # 1068 times (15.6ms+0s) by JSON::PP::hash_to_json at line 368, avg 15µs/call # 645 times (0s+15.6ms) by JSON::PP::value_to_json at line 413, avg 24µs/call
sub string_to_json {
46617130s my ($self, $arg) = @_;
467
468171331.2ms171315.6ms $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
# spent 15.6ms making 1713 calls to JSON::PP::CORE:subst, avg 9µs/call
46917130s $arg =~ s/\//\\\//g if ($escape_slash);
47017130s17130s $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
# spent 0s making 1713 calls to JSON::PP::CORE:subst, avg 0s/call
471
47217130s if ($ascii) {
473 $arg = JSON_PP_encode_ascii($arg);
474 }
475
47617130s if ($latin1) {
477 $arg = JSON_PP_encode_latin1($arg);
478 }
479
48017130s13740s if ($utf8) {
# spent 0s making 1374 calls to utf8::encode, avg 0s/call
481 utf8::encode($arg);
482 }
483
48417130s return '"' . $arg . '"';
485 }
486
487
488 sub blessed_to_json {
489 my $reftype = reftype($_[1]) || '';
490 if ($reftype eq 'HASH') {
491 return $_[0]->hash_to_json($_[1]);
492 }
493 elsif ($reftype eq 'ARRAY') {
494 return $_[0]->array_to_json($_[1]);
495 }
496 else {
497 return 'null';
498 }
499 }
500
501
502 sub encode_error {
503 my $error = shift;
504 Carp::croak "$error";
505 }
506
507
508
# spent 0s within JSON::PP::_sort which was called 465 times, avg 0s/call: # 465 times (0s+0s) by JSON::PP::hash_to_json at line 366, avg 0s/call
sub _sort {
5094650s960s defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
# spent 0s making 96 calls to JSON::PP::CORE:sort, avg 0s/call
510 }
511
512
513
# spent 0s within JSON::PP::_up_indent which was called 123 times, avg 0s/call: # 96 times (0s+0s) by JSON::PP::hash_to_json at line 363, avg 0s/call # 27 times (0s+0s) by JSON::PP::array_to_json at line 387, avg 0s/call
sub _up_indent {
5141230s my $self = shift;
5151230s my $space = ' ' x $indent_length;
516
5171230s my ($pre,$post) = ('','');
518
5191230s $post = "\n" . $space x $indent_count;
520
5211230s $indent_count++;
522
5231230s $pre = "\n" . $space x $indent_count;
524
5251230s return ($pre,$post);
526 }
527
528
5291230s
# spent 0s within JSON::PP::_down_indent which was called 123 times, avg 0s/call: # 96 times (0s+0s) by JSON::PP::hash_to_json at line 374, avg 0s/call # 27 times (0s+0s) by JSON::PP::array_to_json at line 394, avg 0s/call
sub _down_indent { $indent_count--; }
530
531
532 sub PP_encode_box {
533 {
534 depth => $depth,
535 indent_count => $indent_count,
536 };
537 }
538
539} # Convert
540
541
542sub _encode_ascii {
543 join('',
544 map {
545 $_ <= 127 ?
546 chr($_) :
547 $_ <= 65535 ?
548 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
549 } unpack('U*', $_[0])
550 );
551}
552
553
554sub _encode_latin1 {
555 join('',
556 map {
557 $_ <= 255 ?
558 chr($_) :
559 $_ <= 65535 ?
560 sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
561 } unpack('U*', $_[0])
562 );
563}
564
565
566sub _encode_surrogates { # from perlunicode
567 my $uni = $_[0] - 0x10000;
568 return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
569}
570
571
572sub _is_bignum {
573 $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
574}
575
- -
578#
579# JSON => Perl
580#
581
58210smy $max_intsize;
583
584
# spent 0s within JSON::PP::BEGIN@584 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 594
BEGIN {
58510s my $checkint = 1111;
58610s for my $d (5..64) {
587170s $checkint .= 1;
588170s my $int = eval qq| $checkint |;
# spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval # spent 0s executing statements in string eval
589170s170s if ($int =~ /[eE]/) {
# spent 0s making 17 calls to JSON::PP::CORE:match, avg 0s/call
59010s $max_intsize = $d - 1;
59110s last;
592 }
593 }
59410s10s}
# spent 0s making 1 call to JSON::PP::BEGIN@584
595
596{ # PARSE
597
59820s my %escapes = ( # by Jeremy Muhlich <jmuhlich [at] bitflood.org>
599 b => "\x8",
600 t => "\x9",
601 n => "\xA",
602 f => "\xC",
603 r => "\xD",
604 '\\' => '\\',
605 '"' => '"',
606 '/' => '/',
607 );
608
60910s my $text; # json data
610 my $at; # offset
611 my $ch; # 1chracter
612 my $len; # text length (changed according to UTF8 or NON UTF8)
613 # INTERNAL
614 my $depth; # nest counter
615 my $encoding; # json text encoding
616 my $is_valid_utf8; # temp variable
617 my $utf8_len; # utf8 byte length
618 # FLAGS
619 my $utf8; # must be utf8
620 my $max_depth; # max nest nubmer of objects and arrays
621 my $max_size;
622 my $relaxed;
623 my $cb_object;
624 my $cb_sk_object;
625
626 my $F_HOOK;
627
628 my $allow_bigint; # using Math::BigInt
629 my $singlequote; # loosely quoting
630 my $loose; #
63110s my $allow_barekey; # bareKey
632
633 # $opt flag
634 # 0x00000001 .... decode_prefix
635 # 0x10000000 .... incr_parse
636
637
# spent 109ms (0s+109) within JSON::PP::PP_decode_json which was called 55 times, avg 1.99ms/call: # 55 times (0s+109ms) by JSON::PP::decode at line 148, avg 1.99ms/call
sub PP_decode_json {
638550s my ($self, $opt); # $opt is an effective flag during this decode_json.
639
640550s ($self, $text, $opt) = @_;
641
642550s ($at, $ch, $depth) = (0, '', 0);
643
644550s if ( !defined $text or ref $text ) {
645 decode_error("malformed JSON string, neither array, object, number, string or atom");
646 }
647
648550s my $idx = $self->{PROPS};
649
650 ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
651550s = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
652
653550s540s if ( $utf8 ) {
# spent 0s making 54 calls to utf8::downgrade, avg 0s/call
654 utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
655 }
656 else {
65710s10s utf8::upgrade( $text );
# spent 0s making 1 call to utf8::upgrade
65810s10s utf8::encode( $text );
# spent 0s making 1 call to utf8::encode
659 }
660
661550s $len = length $text;
662
663 ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
664550s = @{$self}{qw/max_depth max_size cb_object cb_sk_object F_HOOK/};
665
666550s if ($max_size > 1) {
66720s20s
# spent 0s within JSON::PP::BEGIN@667 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 667
use bytes;
# spent 0s making 1 call to JSON::PP::BEGIN@667 # spent 0s making 1 call to bytes::import
668 my $bytes = length $text;
669 decode_error(
670 sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
671 , $bytes, $max_size), 1
672 ) if ($bytes > $max_size);
673 }
674
675 # Currently no effect
676 # should use regexp
677550s550s my @octets = unpack('C4', $text);
# spent 0s making 55 calls to JSON::PP::CORE:unpack, avg 0s/call
678550s $encoding = ( $octets[0] and $octets[1]) ? 'UTF-8'
679 : (!$octets[0] and $octets[1]) ? 'UTF-16BE'
680 : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
681 : ( $octets[2] ) ? 'UTF-16LE'
682 : (!$octets[2] ) ? 'UTF-32LE'
683 : 'unknown';
684
685550s550s white(); # remove head white space
# spent 0s making 55 calls to JSON::PP::white, avg 0s/call
686
687550s my $valid_start = defined $ch; # Is there a first character for JSON structure?
688
689550s55109ms my $result = value();
# spent 109ms making 55 calls to JSON::PP::value, avg 1.99ms/call
690
691550s return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse
692
693550s decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
694
695550s if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) {
696 decode_error(
697 'JSON text must be an object or array (but found number, string, true, false or null,'
698 . ' use allow_nonref to allow this)', 1);
699 }
700
701550s Carp::croak('something wrong.') if $len < $at; # we won't arrive here.
702
703550s my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length
704
705550s550s white(); # remove tail white space
# spent 0s making 55 calls to JSON::PP::white, avg 0s/call
706
707550s if ( $ch ) {
708 return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix
709 decode_error("garbage after JSON object");
710 }
711
712550s ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result;
713 }
714
715
716
# spent 46.8ms within JSON::PP::next_chr which was called 22642 times, avg 2µs/call: # 17072 times (15.6ms+0s) by JSON::PP::string at line 746, avg 914ns/call # 1406 times (15.6ms+0s) by JSON::PP::string at line 744, avg 11µs/call # 1406 times (15.6ms+0s) by JSON::PP::string at line 747, avg 11µs/call # 873 times (0s+0s) by JSON::PP::object at line 964, avg 0s/call # 532 times (0s+0s) by JSON::PP::object at line 983, avg 0s/call # 374 times (0s+0s) by JSON::PP::object at line 943, avg 0s/call # 341 times (0s+0s) by JSON::PP::object at line 972, avg 0s/call # 294 times (0s+0s) by JSON::PP::white at line 839, avg 0s/call # 106 times (0s+0s) by JSON::PP::array at line 893, avg 0s/call # 102 times (0s+0s) by JSON::PP::array at line 913, avg 0s/call # 54 times (0s+0s) by JSON::PP::number at line 1085, avg 0s/call # 37 times (0s+0s) by JSON::PP::array at line 921, avg 0s/call # 33 times (0s+0s) by JSON::PP::object at line 948, avg 0s/call # 4 times (0s+0s) by JSON::PP::number at line 1099, avg 0s/call # 4 times (0s+0s) by JSON::PP::number at line 1091, avg 0s/call # 4 times (0s+0s) by JSON::PP::array at line 898, avg 0s/call
sub next_chr {
7172264215.6ms return $ch = undef if($at >= $len);
7182258731.2ms $ch = substr($text, $at++, 1);
719 }
720
721
722
# spent 109ms (15.6+93.6) within JSON::PP::value which was called 1067 times, avg 102µs/call: # 873 times (15.6ms+-15.6ms) by JSON::PP::object at line 965, avg 0s/call # 139 times (0s+0s) by JSON::PP::array at line 903, avg 0s/call # 55 times (0s+109ms) by JSON::PP::PP_decode_json at line 689, avg 1.99ms/call
sub value {
72310670s10670s white();
# spent 0s making 1067 calls to JSON::PP::white, avg 0s/call
72410670s return if(!defined $ch);
72510670s374109ms return object() if($ch eq '{');
# spent 125ms making 374 calls to JSON::PP::object, avg 334µs/call, recursion: max depth 3, sum of overlapping time 15.6ms
7266930s1060s return array() if($ch eq '[');
# spent 0s making 106 calls to JSON::PP::array, avg 0s/call
72758715.6ms53331.2ms return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
# spent 31.2ms making 533 calls to JSON::PP::string, avg 59µs/call
728540s1080s return number() if($ch =~ /[0-9]/ or $ch eq '-');
# spent 0s making 54 calls to JSON::PP::CORE:match, avg 0s/call # spent 0s making 54 calls to JSON::PP::number, avg 0s/call
729 return word();
730 }
731
732
# spent 78.0ms (31.2+46.8) within JSON::PP::string which was called 1406 times, avg 55µs/call: # 873 times (31.2ms+15.6ms) by JSON::PP::object at line 956, avg 54µs/call # 533 times (0s+31.2ms) by JSON::PP::value at line 727, avg 59µs/call
sub string {
73314060s my ($i, $s, $t, $u);
734 my $utf16;
735 my $is_utf8;
736
73714060s ($is_valid_utf8, $utf8_len) = ('', 0);
738
73914060s $s = ''; # basically UTF8 flag on
740
74114060s if($ch eq '"' or ($singlequote and $ch eq "'")){
74214060s my $boundChar = $ch;
743
74414060s140615.6ms OUTER: while( defined(next_chr()) ){
# spent 15.6ms making 1406 calls to JSON::PP::next_chr, avg 11µs/call
745
7461847831.2ms1707215.6ms if($ch eq $boundChar){
# spent 15.6ms making 17072 calls to JSON::PP::next_chr, avg 914ns/call
74714060s140615.6ms next_chr();
# spent 15.6ms making 1406 calls to JSON::PP::next_chr, avg 11µs/call
748
74914060s if ($utf16) {
750 decode_error("missing low surrogate character in surrogate pair");
751 }
752
75314060s utf8::decode($s) if($is_utf8);
754
75514060s return $s;
756 }
757 elsif($ch eq '\\'){
758 next_chr();
759 if(exists $escapes{$ch}){
760 $s .= $escapes{$ch};
761 }
762 elsif($ch eq 'u'){ # UNICODE handling
763 my $u = '';
764
765 for(1..4){
766 $ch = next_chr();
767 last OUTER if($ch !~ /[0-9a-fA-F]/);
768 $u .= $ch;
769 }
770
771 # U+D800 - U+DBFF
772 if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
773 $utf16 = $u;
774 }
775 # U+DC00 - U+DFFF
776 elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
777 unless (defined $utf16) {
778 decode_error("missing high surrogate character in surrogate pair");
779 }
780 $is_utf8 = 1;
781 $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
782 $utf16 = undef;
783 }
784 else {
785 if (defined $utf16) {
786 decode_error("surrogate pair expected");
787 }
788
789 if ( ( my $hex = hex( $u ) ) > 127 ) {
790 $is_utf8 = 1;
791 $s .= JSON_PP_decode_unicode($u) || next;
792 }
793 else {
794 $s .= chr $hex;
795 }
796 }
797
798 }
799 else{
800 unless ($loose) {
801 $at -= 2;
802 decode_error('illegal backslash escape sequence in string');
803 }
804 $s .= $ch;
805 }
806 }
807 else{
808
809170720s if ( ord $ch > 127 ) {
810 unless( $ch = is_valid_utf8($ch) ) {
811 $at -= 1;
812 decode_error("malformed UTF-8 character in JSON string");
813 }
814 else {
815 $at += $utf8_len - 1;
816 }
817
818 $is_utf8 = 1;
819 }
820
821170720s if (!$loose) {
822170720s170720s if ($ch =~ /[\x00-\x1f\x22\x5c]/) { # '/' ok
# spent 0s making 17072 calls to JSON::PP::CORE:match, avg 0s/call
823 $at--;
824 decode_error('invalid character encountered while parsing JSON string');
825 }
826 }
827
828170720s $s .= $ch;
829 }
830 }
831 }
832
833 decode_error("unexpected end of string while parsing JSON string");
834 }
835
836
837
# spent 0s within JSON::PP::white which was called 4111 times, avg 0s/call: # 1067 times (0s+0s) by JSON::PP::value at line 723, avg 0s/call # 873 times (0s+0s) by JSON::PP::object at line 966, avg 0s/call # 873 times (0s+0s) by JSON::PP::object at line 957, avg 0s/call # 532 times (0s+0s) by JSON::PP::object at line 984, avg 0s/call # 374 times (0s+0s) by JSON::PP::object at line 944, avg 0s/call # 139 times (0s+0s) by JSON::PP::array at line 905, avg 0s/call # 106 times (0s+0s) by JSON::PP::array at line 894, avg 0s/call # 55 times (0s+0s) by JSON::PP::PP_decode_json at line 705, avg 0s/call # 55 times (0s+0s) by JSON::PP::PP_decode_json at line 685, avg 0s/call # 37 times (0s+0s) by JSON::PP::array at line 922, avg 0s/call
sub white {
83841110s while( defined $ch ){
83943500s2940s if($ch le ' '){
# spent 0s making 294 calls to JSON::PP::next_chr, avg 0s/call
840 next_chr();
841 }
842 elsif($ch eq '/'){
843 next_chr();
844 if(defined $ch and $ch eq '/'){
845 1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
846 }
847 elsif(defined $ch and $ch eq '*'){
848 next_chr();
849 while(1){
850 if(defined $ch){
851 if($ch eq '*'){
852 if(defined(next_chr()) and $ch eq '/'){
853 next_chr();
854 last;
855 }
856 }
857 else{
858 next_chr();
859 }
860 }
861 else{
862 decode_error("Unterminated comment");
863 }
864 }
865 next;
866 }
867 else{
868 $at--;
869 decode_error("malformed JSON string, neither array, object, number, string or atom");
870 }
871 }
872 else{
87340560s if ($relaxed and $ch eq '#') { # correctly?
874 pos($text) = $at;
875 $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
876 $at = pos($text);
877 next_chr;
878 next;
879 }
880
881405615.6ms last;
882 }
883 }
884 }
885
886
887
# spent 0s within JSON::PP::array which was called 106 times, avg 0s/call: # 106 times (0s+0s) by JSON::PP::value at line 726, avg 0s/call
sub array {
8881060s my $a = $_[0] || []; # you can use this code to use another array ref object.
889
8901060s decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
891 if (++$depth > $max_depth);
892
8931060s1060s next_chr();
# spent 0s making 106 calls to JSON::PP::next_chr, avg 0s/call
8941060s1060s white();
# spent 0s making 106 calls to JSON::PP::white, avg 0s/call
895
8961060s if(defined $ch and $ch eq ']'){
89740s --$depth;
89840s40s next_chr();
# spent 0s making 4 calls to JSON::PP::next_chr, avg 0s/call
89940s return $a;
900 }
901 else {
9021020s while(defined($ch)){
9031390s1390s push @$a, value();
# spent 0s making 139 calls to JSON::PP::value, avg 0s/call, recursion: max depth 3, sum of overlapping time 0s
904
9051390s1390s white();
# spent 0s making 139 calls to JSON::PP::white, avg 0s/call
906
9071390s if (!defined $ch) {
908 last;
909 }
910
9111390s if($ch eq ']'){
9121020s --$depth;
9131020s1020s next_chr();
# spent 0s making 102 calls to JSON::PP::next_chr, avg 0s/call
9141020s return $a;
915 }
916
917370s if($ch ne ','){
918 last;
919 }
920
921370s370s next_chr();
# spent 0s making 37 calls to JSON::PP::next_chr, avg 0s/call
922370s370s white();
# spent 0s making 37 calls to JSON::PP::white, avg 0s/call
923
924370s if ($relaxed and $ch eq ']') {
925 --$depth;
926 next_chr();
927 return $a;
928 }
929
930 }
931 }
932
933 decode_error(", or ] expected while parsing array");
934 }
935
936
937
# spent 109ms (15.6+93.6) within JSON::PP::object which was called 374 times, avg 292µs/call: # 374 times (15.6ms+93.6ms) by JSON::PP::value at line 725, avg 292µs/call
sub object {
9383740s my $o = $_[0] || {}; # you can use this code to use another hash ref object.
9393740s my $k;
940
9413740s decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
942 if (++$depth > $max_depth);
9433740s3740s next_chr();
# spent 0s making 374 calls to JSON::PP::next_chr, avg 0s/call
9443740s3740s white();
# spent 0s making 374 calls to JSON::PP::white, avg 0s/call
945
9463740s if(defined $ch and $ch eq '}'){
947330s --$depth;
948330s330s next_chr();
# spent 0s making 33 calls to JSON::PP::next_chr, avg 0s/call
949330s if ($F_HOOK) {
950 return _json_object_hook($o);
951 }
952330s return $o;
953 }
954 else {
9553410s while (defined $ch) {
9568730s87346.8ms $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
# spent 46.8ms making 873 calls to JSON::PP::string, avg 54µs/call
9578730s8730s white();
# spent 0s making 873 calls to JSON::PP::white, avg 0s/call
958
9598730s if(!defined $ch or $ch ne ':'){
960 $at--;
961 decode_error("':' expected");
962 }
963
9648730s8730s next_chr();
# spent 0s making 873 calls to JSON::PP::next_chr, avg 0s/call
9658730s8730s $o->{$k} = value();
# spent 62.4ms making 873 calls to JSON::PP::value, avg 71µs/call, recursion: max depth 4, sum of overlapping time 62.4ms
9668730s8730s white();
# spent 0s making 873 calls to JSON::PP::white, avg 0s/call
967
9688730s last if (!defined $ch);
969
9708730s if($ch eq '}'){
9713410s --$depth;
9723410s3410s next_chr();
# spent 0s making 341 calls to JSON::PP::next_chr, avg 0s/call
9733410s if ($F_HOOK) {
974 return _json_object_hook($o);
975 }
9763410s return $o;
977 }
978
9795320s if($ch ne ','){
980 last;
981 }
982
9835320s5320s next_chr();
# spent 0s making 532 calls to JSON::PP::next_chr, avg 0s/call
9845320s5320s white();
# spent 0s making 532 calls to JSON::PP::white, avg 0s/call
985
9865320s if ($relaxed and $ch eq '}') {
987 --$depth;
988 next_chr();
989 if ($F_HOOK) {
990 return _json_object_hook($o);
991 }
992 return $o;
993 }
994
995 }
996
997 }
998
999 $at--;
1000 decode_error(", or } expected while parsing object/hash");
1001 }
1002
1003
1004 sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
1005 my $key;
1006 while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
1007 $key .= $ch;
1008 next_chr();
1009 }
1010 return $key;
1011 }
1012
1013
1014 sub word {
1015 my $word = substr($text,$at-1,4);
1016
1017 if($word eq 'true'){
1018 $at += 3;
1019 next_chr;
1020 return $JSON::PP::true;
1021 }
1022 elsif($word eq 'null'){
1023 $at += 3;
1024 next_chr;
1025 return undef;
1026 }
1027 elsif($word eq 'fals'){
1028 $at += 3;
1029 if(substr($text,$at,1) eq 'e'){
1030 $at++;
1031 next_chr;
1032 return $JSON::PP::false;
1033 }
1034 }
1035
1036 $at--; # for decode_error report
1037
1038 decode_error("'null' expected") if ($word =~ /^n/);
1039 decode_error("'true' expected") if ($word =~ /^t/);
1040 decode_error("'false' expected") if ($word =~ /^f/);
1041 decode_error("malformed JSON string, neither array, object, number, string or atom");
1042 }
1043
1044
1045
# spent 0s within JSON::PP::number which was called 54 times, avg 0s/call: # 54 times (0s+0s) by JSON::PP::value at line 728, avg 0s/call
sub number {
1046540s my $n = '';
1047540s my $v;
1048
1049 # According to RFC4627, hex or oct digts are invalid.
1050540s if($ch eq '0'){
1051240s my $peek = substr($text,$at,1);
1052240s240s my $hex = $peek =~ /[xX]/; # 0 or 1
# spent 0s making 24 calls to JSON::PP::CORE:match, avg 0s/call
1053
1054240s if($hex){
1055 decode_error("malformed number (leading zero must not be followed by another digit)");
1056 ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
1057 }
1058 else{ # oct
1059240s240s ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
# spent 0s making 24 calls to JSON::PP::CORE:match, avg 0s/call
1060240s if (defined $n and length $n > 1) {
1061 decode_error("malformed number (leading zero must not be followed by another digit)");
1062 }
1063 }
1064
1065240s if(defined $n and length($n)){
1066 if (!$hex and length($n) == 1) {
1067 decode_error("malformed number (leading zero must not be followed by another digit)");
1068 }
1069 $at += length($n) + $hex;
1070 next_chr;
1071 return $hex ? hex($n) : oct($n);
1072 }
1073 }
1074
1075540s if($ch eq '-'){
1076 $n = '-';
1077 next_chr;
1078 if (!defined $ch or $ch !~ /\d/) {
1079 decode_error("malformed number (no digits after initial minus)");
1080 }
1081 }
1082
1083540s540s while(defined $ch and $ch =~ /\d/){
# spent 0s making 54 calls to JSON::PP::CORE:match, avg 0s/call
1084540s $n .= $ch;
1085540s1080s next_chr;
# spent 0s making 54 calls to JSON::PP::CORE:match, avg 0s/call # spent 0s making 54 calls to JSON::PP::next_chr, avg 0s/call
1086 }
1087
1088540s if(defined $ch and $ch eq '.'){
108940s $n .= '.';
1090
109140s40s next_chr;
# spent 0s making 4 calls to JSON::PP::next_chr, avg 0s/call
109240s40s if (!defined $ch or $ch !~ /\d/) {
# spent 0s making 4 calls to JSON::PP::CORE:match, avg 0s/call
1093 decode_error("malformed number (no digits after decimal point)");
1094 }
1095 else {
109640s $n .= $ch;
1097 }
1098
109940s80s while(defined(next_chr) and $ch =~ /\d/){
# spent 0s making 4 calls to JSON::PP::CORE:match, avg 0s/call # spent 0s making 4 calls to JSON::PP::next_chr, avg 0s/call
1100 $n .= $ch;
1101 }
1102 }
1103
1104540s if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
1105 $n .= $ch;
1106 next_chr;
1107
1108 if(defined($ch) and ($ch eq '+' or $ch eq '-')){
1109 $n .= $ch;
1110 next_chr;
1111 if (!defined $ch or $ch =~ /\D/) {
1112 decode_error("malformed number (no digits after exp sign)");
1113 }
1114 $n .= $ch;
1115 }
1116 elsif(defined($ch) and $ch =~ /\d/){
1117 $n .= $ch;
1118 }
1119 else {
1120 decode_error("malformed number (no digits after exp sign)");
1121 }
1122
1123 while(defined(next_chr) and $ch =~ /\d/){
1124 $n .= $ch;
1125 }
1126
1127 }
1128
1129540s $v .= $n;
1130
1131540s540s if ($v !~ /[.eE]/ and length $v > $max_intsize) {
# spent 0s making 54 calls to JSON::PP::CORE:match, avg 0s/call
1132 if ($allow_bigint) { # from Adam Sussman
1133 require Math::BigInt;
1134 return Math::BigInt->new($v);
1135 }
1136 else {
1137 return "$v";
1138 }
1139 }
1140 elsif ($allow_bigint) {
1141 require Math::BigFloat;
1142 return Math::BigFloat->new($v);
1143 }
1144
1145540s return 0+$v;
1146 }
1147
1148
1149 sub is_valid_utf8 {
1150
1151 $utf8_len = $_[0] =~ /[\x00-\x7F]/ ? 1
1152 : $_[0] =~ /[\xC2-\xDF]/ ? 2
1153 : $_[0] =~ /[\xE0-\xEF]/ ? 3
1154 : $_[0] =~ /[\xF0-\xF4]/ ? 4
1155 : 0
1156 ;
1157
1158 return unless $utf8_len;
1159
1160 my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
1161
1162 return ( $is_valid_utf8 =~ /^(?:
1163 [\x00-\x7F]
1164 |[\xC2-\xDF][\x80-\xBF]
1165 |[\xE0][\xA0-\xBF][\x80-\xBF]
1166 |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
1167 |[\xED][\x80-\x9F][\x80-\xBF]
1168 |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
1169 |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
1170 |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
1171 |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
1172 )$/x ) ? $is_valid_utf8 : '';
1173 }
1174
1175
1176 sub decode_error {
1177 my $error = shift;
1178 my $no_rep = shift;
1179 my $str = defined $text ? substr($text, $at) : '';
1180 my $mess = '';
1181 my $type = $] >= 5.008 ? 'U*'
1182 : $] < 5.006 ? 'C*'
1183 : utf8::is_utf8( $str ) ? 'U*' # 5.6
1184 : 'C*'
1185 ;
1186
1187 for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
1188 $mess .= $c == 0x07 ? '\a'
1189 : $c == 0x09 ? '\t'
1190 : $c == 0x0a ? '\n'
1191 : $c == 0x0d ? '\r'
1192 : $c == 0x0c ? '\f'
1193 : $c < 0x20 ? sprintf('\x{%x}', $c)
1194 : $c == 0x5c ? '\\\\'
1195 : $c < 0x80 ? chr($c)
1196 : sprintf('\x{%x}', $c)
1197 ;
1198 if ( length $mess >= 20 ) {
1199 $mess .= '...';
1200 last;
1201 }
1202 }
1203
1204 unless ( length $mess ) {
1205 $mess = '(end of string)';
1206 }
1207
1208 Carp::croak (
1209 $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
1210 );
1211
1212 }
1213
1214
1215 sub _json_object_hook {
1216 my $o = $_[0];
1217 my @ks = keys %{$o};
1218
1219 if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
1220 my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
1221 if (@val == 1) {
1222 return $val[0];
1223 }
1224 }
1225
1226 my @val = $cb_object->($o) if ($cb_object);
1227 if (@val == 0 or @val > 1) {
1228 return $o;
1229 }
1230 else {
1231 return $val[0];
1232 }
1233 }
1234
1235
1236 sub PP_decode_box {
1237 {
1238 text => $text,
1239 at => $at,
1240 ch => $ch,
1241 len => $len,
1242 depth => $depth,
1243 encoding => $encoding,
1244 is_valid_utf8 => $is_valid_utf8,
1245 };
1246 }
1247
1248} # PARSE
1249
1250
1251sub _decode_surrogates { # from perlunicode
1252 my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
1253 my $un = pack('U*', $uni);
1254 utf8::encode( $un );
1255 return $un;
1256}
1257
1258
1259sub _decode_unicode {
1260 my $un = pack('U', hex shift);
1261 utf8::encode( $un );
1262 return $un;
1263}
1264
1265#
1266# Setup for various Perl versions (the code from JSON::PP58)
1267#
1268
1269
# spent 0s within JSON::PP::BEGIN@1269 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1325
BEGIN {
1270
127110s unless ( defined &utf8::is_utf8 ) {
1272 require Encode;
1273 *utf8::is_utf8 = *Encode::is_utf8;
1274 }
1275
127610s if ( $] >= 5.008 ) {
127710s *JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii;
127810s *JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1;
127910s *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
128010s *JSON::PP::JSON_PP_decode_unicode = \&_decode_unicode;
1281 }
1282
128310s if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
1284 package JSON::PP;
1285 require subs;
1286 subs->import('join');
1287 eval q|
1288 sub join {
1289 return '' if (@_ < 2);
1290 my $j = shift;
1291 my $str = shift;
1292 for (@_) { $str .= $j . $_; }
1293 return $str;
1294 }
1295 |;
1296 }
1297
1298
1299 sub JSON::PP::incr_parse {
1300 local $Carp::CarpLevel = 1;
1301 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
1302 }
1303
1304
1305 sub JSON::PP::incr_skip {
1306 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
1307 }
1308
1309
1310 sub JSON::PP::incr_reset {
1311 ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
1312 }
1313
131410s eval q{
1315 sub JSON::PP::incr_text : lvalue {
1316 $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
1317
1318 if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
1319 Carp::croak("incr_text can not be called when the incremental parser already started parsing");
1320 }
1321 $_[0]->{_incr_parser}->{incr_text};
1322 }
1323 } if ( $] >= 5.006 );
1324
132510s10s} # Setup for various Perl versions (the code from JSON::PP58)
# spent 0s making 1 call to JSON::PP::BEGIN@1269
1326
1327
1328###############################
1329# Utilities
1330#
1331
1332
# spent 0s within JSON::PP::BEGIN@1332 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1385
BEGIN {
133310s eval 'require Scalar::Util';
# spent 0s executing statements in string eval
133410s unless($@){
133510s *JSON::PP::blessed = \&Scalar::Util::blessed;
133610s *JSON::PP::reftype = \&Scalar::Util::reftype;
133710s *JSON::PP::refaddr = \&Scalar::Util::refaddr;
1338 }
1339 else{ # This code is from Sclar::Util.
1340 # warn $@;
1341 eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
1342 *JSON::PP::blessed = sub {
1343 local($@, $SIG{__DIE__}, $SIG{__WARN__});
1344 ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
1345 };
1346 my %tmap = qw(
1347 B::NULL SCALAR
1348 B::HV HASH
1349 B::AV ARRAY
1350 B::CV CODE
1351 B::IO IO
1352 B::GV GLOB
1353 B::REGEXP REGEXP
1354 );
1355 *JSON::PP::reftype = sub {
1356 my $r = shift;
1357
1358 return undef unless length(ref($r));
1359
1360 my $t = ref(B::svref_2object($r));
1361
1362 return
1363 exists $tmap{$t} ? $tmap{$t}
1364 : length(ref($$r)) ? 'REF'
1365 : 'SCALAR';
1366 };
1367 *JSON::PP::refaddr = sub {
1368 return undef unless length(ref($_[0]));
1369
1370 my $addr;
1371 if(defined(my $pkg = blessed($_[0]))) {
1372 $addr .= bless $_[0], 'Scalar::Util::Fake';
1373 bless $_[0], $pkg;
1374 }
1375 else {
1376 $addr .= $_[0]
1377 }
1378
1379 $addr =~ /0x(\w+)/;
1380 local $^W;
1381 #no warnings 'portable';
1382 hex($1);
1383 }
1384 }
138510s10s}
# spent 0s making 1 call to JSON::PP::BEGIN@1332
1386
1387
1388# shamely copied and modified from JSON::XS code.
1389
139010s$JSON::PP::true = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
139110s$JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
1392
1393sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); }
1394
1395sub true { $JSON::PP::true }
1396sub false { $JSON::PP::false }
1397sub null { undef; }
1398
1399###############################
1400
1401package JSON::PP::Boolean;
1402
1403
# spent 0s within JSON::PP::Boolean::BEGIN@1403 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1408
use overload (
1404 "0+" => sub { ${$_[0]} },
1405 "++" => sub { $_[0] = ${$_[0]} + 1 },
1406 "--" => sub { $_[0] = ${$_[0]} - 1 },
140710s10s fallback => 1,
# spent 0s making 1 call to overload::import
140810s10s);
# spent 0s making 1 call to JSON::PP::Boolean::BEGIN@1403
1409
1410
1411###############################
1412
1413package JSON::PP::IncrParser;
1414
141520s20s
# spent 0s within JSON::PP::IncrParser::BEGIN@1415 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1415
use strict;
# spent 0s making 1 call to JSON::PP::IncrParser::BEGIN@1415 # spent 0s making 1 call to strict::import
1416
141720s20s
# spent 0s within JSON::PP::IncrParser::BEGIN@1417 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1417
use constant INCR_M_WS => 0; # initial whitespace skipping
# spent 0s making 1 call to JSON::PP::IncrParser::BEGIN@1417 # spent 0s making 1 call to constant::import
141820s20s
# spent 0s within JSON::PP::IncrParser::BEGIN@1418 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1418
use constant INCR_M_STR => 1; # inside string
# spent 0s making 1 call to JSON::PP::IncrParser::BEGIN@1418 # spent 0s making 1 call to constant::import
141920s20s
# spent 0s within JSON::PP::IncrParser::BEGIN@1419 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1419
use constant INCR_M_BS => 2; # inside backslash
# spent 0s making 1 call to JSON::PP::IncrParser::BEGIN@1419 # spent 0s making 1 call to constant::import
142020s20s
# spent 0s within JSON::PP::IncrParser::BEGIN@1420 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1420
use constant INCR_M_JSON => 3; # outside anything, count nesting
# spent 0s making 1 call to JSON::PP::IncrParser::BEGIN@1420 # spent 0s making 1 call to constant::import
142120s20s
# spent 0s within JSON::PP::IncrParser::BEGIN@1421 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1421
use constant INCR_M_C0 => 4;
# spent 0s making 1 call to JSON::PP::IncrParser::BEGIN@1421 # spent 0s making 1 call to constant::import
142220s20s
# spent 0s within JSON::PP::IncrParser::BEGIN@1422 which was called: # once (0s+0s) by Parse::CPAN::Meta::_can_load at line 1422
use constant INCR_M_C1 => 5;
# spent 0s making 1 call to JSON::PP::IncrParser::BEGIN@1422 # spent 0s making 1 call to constant::import
1423
142410s$JSON::PP::IncrParser::VERSION = '1.01';
1425
142610smy $unpack_format = $] < 5.006 ? 'C*' : 'U*';
1427
1428sub new {
1429 my ( $class ) = @_;
1430
1431 bless {
1432 incr_nest => 0,
1433 incr_text => undef,
1434 incr_parsing => 0,
1435 incr_p => 0,
1436 }, $class;
1437}
1438
1439
1440sub incr_parse {
1441 my ( $self, $coder, $text ) = @_;
1442
1443 $self->{incr_text} = '' unless ( defined $self->{incr_text} );
1444
1445 if ( defined $text ) {
1446 if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
1447 utf8::upgrade( $self->{incr_text} ) ;
1448 utf8::decode( $self->{incr_text} ) ;
1449 }
1450 $self->{incr_text} .= $text;
1451 }
1452
1453
1454 my $max_size = $coder->get_max_size;
1455
1456 if ( defined wantarray ) {
1457
1458 $self->{incr_mode} = INCR_M_WS unless defined $self->{incr_mode};
1459
1460 if ( wantarray ) {
1461 my @ret;
1462
1463 $self->{incr_parsing} = 1;
1464
1465 do {
1466 push @ret, $self->_incr_parse( $coder, $self->{incr_text} );
1467
1468 unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) {
1469 $self->{incr_mode} = INCR_M_WS if $self->{incr_mode} != INCR_M_STR;
1470 }
1471
1472 } until ( length $self->{incr_text} >= $self->{incr_p} );
1473
1474 $self->{incr_parsing} = 0;
1475
1476 return @ret;
1477 }
1478 else { # in scalar context
1479 $self->{incr_parsing} = 1;
1480 my $obj = $self->_incr_parse( $coder, $self->{incr_text} );
1481 $self->{incr_parsing} = 0 if defined $obj; # pointed by Martin J. Evans
1482 return $obj ? $obj : undef; # $obj is an empty string, parsing was completed.
1483 }
1484
1485 }
1486
1487}
1488
1489
1490sub _incr_parse {
1491 my ( $self, $coder, $text, $skip ) = @_;
1492 my $p = $self->{incr_p};
1493 my $restore = $p;
1494
1495 my @obj;
1496 my $len = length $text;
1497
1498 if ( $self->{incr_mode} == INCR_M_WS ) {
1499 while ( $len > $p ) {
1500 my $s = substr( $text, $p, 1 );
1501 $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
1502 $self->{incr_mode} = INCR_M_JSON;
1503 last;
1504 }
1505 }
1506
1507 while ( $len > $p ) {
1508 my $s = substr( $text, $p++, 1 );
1509
1510 if ( $s eq '"' ) {
1511 if (substr( $text, $p - 2, 1 ) eq '\\' ) {
1512 next;
1513 }
1514
1515 if ( $self->{incr_mode} != INCR_M_STR ) {
1516 $self->{incr_mode} = INCR_M_STR;
1517 }
1518 else {
1519 $self->{incr_mode} = INCR_M_JSON;
1520 unless ( $self->{incr_nest} ) {
1521 last;
1522 }
1523 }
1524 }
1525
1526 if ( $self->{incr_mode} == INCR_M_JSON ) {
1527
1528 if ( $s eq '[' or $s eq '{' ) {
1529 if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
1530 Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
1531 }
1532 }
1533 elsif ( $s eq ']' or $s eq '}' ) {
1534 last if ( --$self->{incr_nest} <= 0 );
1535 }
1536 elsif ( $s eq '#' ) {
1537 while ( $len > $p ) {
1538 last if substr( $text, $p++, 1 ) eq "\n";
1539 }
1540 }
1541
1542 }
1543
1544 }
1545
1546 $self->{incr_p} = $p;
1547
1548 return if ( $self->{incr_mode} == INCR_M_STR and not $self->{incr_nest} );
1549 return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 );
1550
1551 return '' unless ( length substr( $self->{incr_text}, 0, $p ) );
1552
1553 local $Carp::CarpLevel = 2;
1554
1555 $self->{incr_p} = $restore;
1556 $self->{incr_c} = $p;
1557
1558 my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 );
1559
1560 $self->{incr_text} = substr( $self->{incr_text}, $p );
1561 $self->{incr_p} = 0;
1562
1563 return $obj || '';
1564}
1565
1566
1567sub incr_text {
1568 if ( $_[0]->{incr_parsing} ) {
1569 Carp::croak("incr_text can not be called when the incremental parser already started parsing");
1570 }
1571 $_[0]->{incr_text};
1572}
1573
1574
1575sub incr_skip {
1576 my $self = shift;
1577 $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} );
1578 $self->{incr_p} = 0;
1579}
1580
1581
1582sub incr_reset {
1583 my $self = shift;
1584 $self->{incr_text} = undef;
1585 $self->{incr_p} = 0;
1586 $self->{incr_mode} = 0;
1587 $self->{incr_nest} = 0;
1588 $self->{incr_parsing} = 0;
1589}
1590
1591###############################
1592
1593
159410s1;
1595__END__
 
# spent 0s within JSON::PP::CORE:match which was called 17361 times, avg 0s/call: # 17072 times (0s+0s) by JSON::PP::string at line 822, avg 0s/call # 54 times (0s+0s) by JSON::PP::number at line 1085, avg 0s/call # 54 times (0s+0s) by JSON::PP::number at line 1083, avg 0s/call # 54 times (0s+0s) by JSON::PP::number at line 1131, avg 0s/call # 54 times (0s+0s) by JSON::PP::value at line 728, avg 0s/call # 24 times (0s+0s) by JSON::PP::number at line 1052, avg 0s/call # 24 times (0s+0s) by JSON::PP::number at line 1059, avg 0s/call # 17 times (0s+0s) by JSON::PP::BEGIN@584 at line 589, avg 0s/call # 4 times (0s+0s) by JSON::PP::number at line 1092, avg 0s/call # 4 times (0s+0s) by JSON::PP::number at line 1099, avg 0s/call
sub JSON::PP::CORE:match; # opcode
# spent 0s within JSON::PP::CORE:sort which was called 96 times, avg 0s/call: # 96 times (0s+0s) by JSON::PP::_sort at line 509, avg 0s/call
sub JSON::PP::CORE:sort; # opcode
# spent 15.6ms within JSON::PP::CORE:subst which was called 3426 times, avg 5µs/call: # 1713 times (15.6ms+0s) by JSON::PP::string_to_json at line 468, avg 9µs/call # 1713 times (0s+0s) by JSON::PP::string_to_json at line 470, avg 0s/call
sub JSON::PP::CORE:subst; # opcode
# spent 0s within JSON::PP::CORE:unpack which was called 55 times, avg 0s/call: # 55 times (0s+0s) by JSON::PP::PP_decode_json at line 677, avg 0s/call
sub JSON::PP::CORE:unpack; # opcode
Report produced by the NYTProf 5.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.