Profile of JSON/PP.pm

Filename	/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/JSON/PP.pm
Statements	Executed 1202 statements in 11.8ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
584	4	4	1.77ms	1.77ms	JSON::PP::::true JSON::PP::true
410	3	3	1.01ms	1.01ms	JSON::PP::::false JSON::PP::false
1	1	1	886µs	886µs	JSON::PP::::BEGIN@56 JSON::PP::BEGIN@56
1	1	1	239µs	282µs	JSON::PP::::BEGIN@12 JSON::PP::BEGIN@12
1	1	1	142µs	154µs	JSON::PP::::BEGIN@646 JSON::PP::BEGIN@646
1	1	1	56µs	56µs	JSON::PP::::BEGIN@1371 JSON::PP::BEGIN@1371
1	1	1	24µs	24µs	JSON::PP::::BEGIN@1434 JSON::PP::BEGIN@1434
1	1	1	24µs	61µs	JSON::PP::IncrParser::::BEGIN@1511JSON::PP::IncrParser::BEGIN@1511
1	1	1	21µs	52µs	JSON::PP::IncrParser::::BEGIN@1510JSON::PP::IncrParser::BEGIN@1510
1	1	1	16µs	16µs	JSON::PP::::BEGIN@5 JSON::PP::BEGIN@5
1	1	1	15µs	42µs	JSON::PP::::BEGIN@39 JSON::PP::BEGIN@39
1	1	1	13µs	89µs	JSON::PP::IncrParser::::BEGIN@1512JSON::PP::IncrParser::BEGIN@1512
17	1	1	12µs	12µs	JSON::PP::::CORE:match JSON::PP::CORE:match (opcode)
1	1	1	11µs	15µs	JSON::PP::::BEGIN@749 JSON::PP::BEGIN@749
1	1	1	11µs	56µs	JSON::PP::IncrParser::::BEGIN@1514JSON::PP::IncrParser::BEGIN@1514
1	1	1	10µs	14µs	JSON::PP::IncrParser::::BEGIN@1506JSON::PP::IncrParser::BEGIN@1506
1	1	1	9µs	44µs	JSON::PP::::BEGIN@47 JSON::PP::BEGIN@47
1	1	1	9µs	44µs	JSON::PP::::BEGIN@48 JSON::PP::BEGIN@48
1	1	1	8µs	72µs	JSON::PP::::BEGIN@37 JSON::PP::BEGIN@37
1	1	1	8µs	32µs	JSON::PP::::BEGIN@457 JSON::PP::BEGIN@457
1	1	1	8µs	65µs	JSON::PP::IncrParser::::BEGIN@1508JSON::PP::IncrParser::BEGIN@1508
1	1	1	8µs	30µs	JSON::PP::IncrParser::::BEGIN@1509JSON::PP::IncrParser::BEGIN@1509
1	1	1	8µs	11µs	JSON::PP::IncrParser::::BEGIN@1573JSON::PP::IncrParser::BEGIN@1573
1	1	1	7µs	30µs	JSON::PP::::BEGIN@38 JSON::PP::BEGIN@38
1	1	1	7µs	61µs	JSON::PP::::BEGIN@45 JSON::PP::BEGIN@45
1	1	1	7µs	7µs	JSON::PP::::BEGIN@9 JSON::PP::BEGIN@9
1	1	1	7µs	42µs	JSON::PP::IncrParser::::BEGIN@1513JSON::PP::IncrParser::BEGIN@1513
1	1	1	6µs	40µs	JSON::PP::::BEGIN@24 JSON::PP::BEGIN@24
1	1	1	6µs	39µs	JSON::PP::::BEGIN@41 JSON::PP::BEGIN@41
1	1	1	6µs	26µs	JSON::PP::::BEGIN@42 JSON::PP::BEGIN@42
1	1	1	6µs	93µs	JSON::PP::::BEGIN@44 JSON::PP::BEGIN@44
1	1	1	6µs	35µs	JSON::PP::IncrParser::::BEGIN@1515JSON::PP::IncrParser::BEGIN@1515
1	1	1	5µs	94µs	JSON::PP::::BEGIN@40 JSON::PP::BEGIN@40
1	1	1	4µs	18µs	JSON::PP::::BEGIN@25 JSON::PP::BEGIN@25
1	1	1	4µs	20µs	JSON::PP::::BEGIN@26 JSON::PP::BEGIN@26
1	1	1	4µs	17µs	JSON::PP::::BEGIN@28 JSON::PP::BEGIN@28
1	1	1	4µs	37µs	JSON::PP::::BEGIN@33 JSON::PP::BEGIN@33
1	1	1	4µs	16µs	JSON::PP::::BEGIN@34 JSON::PP::BEGIN@34
1	1	1	4µs	21µs	JSON::PP::::BEGIN@35 JSON::PP::BEGIN@35
1	1	1	4µs	6µs	JSON::PP::::BEGIN@6 JSON::PP::BEGIN@6
1	1	1	3µs	15µs	JSON::PP::::BEGIN@29 JSON::PP::BEGIN@29
1	1	1	3µs	21µs	JSON::PP::::BEGIN@31 JSON::PP::BEGIN@31
1	1	1	3µs	12µs	JSON::PP::::BEGIN@32 JSON::PP::BEGIN@32
1	1	1	2µs	2µs	JSON::PP::::BEGIN@11 JSON::PP::BEGIN@11
1	1	1	2µs	2µs	JSON::PP::::BEGIN@14 JSON::PP::BEGIN@14
1	1	1	2µs	18µs	JSON::PP::::BEGIN@27 JSON::PP::BEGIN@27
1	1	1	2µs	14µs	JSON::PP::::BEGIN@30 JSON::PP::BEGIN@30
1	1	1	2µs	2µs	JSON::PP::::BEGIN@50 JSON::PP::BEGIN@50
1	1	1	1µs	1µs	JSON::PP::::BEGIN@8 JSON::PP::BEGIN@8
0	0	0	0s	0s	JSON::PP::IncrParser::::_incr_parseJSON::PP::IncrParser::_incr_parse
0	0	0	0s	0s	JSON::PP::IncrParser::::incr_parseJSON::PP::IncrParser::incr_parse
0	0	0	0s	0s	JSON::PP::IncrParser::::incr_resetJSON::PP::IncrParser::incr_reset
0	0	0	0s	0s	JSON::PP::IncrParser::::incr_skipJSON::PP::IncrParser::incr_skip
0	0	0	0s	0s	JSON::PP::IncrParser::::incr_textJSON::PP::IncrParser::incr_text
0	0	0	0s	0s	JSON::PP::IncrParser::::newJSON::PP::IncrParser::new
0	0	0	0s	0s	JSON::PP::::PP_decode_box JSON::PP::PP_decode_box
0	0	0	0s	0s	JSON::PP::::PP_decode_json JSON::PP::PP_decode_json
0	0	0	0s	0s	JSON::PP::::PP_encode_box JSON::PP::PP_encode_box
0	0	0	0s	0s	JSON::PP::::PP_encode_json JSON::PP::PP_encode_json
1	1	1	0s	0s	JSON::PP::::__ANON__ JSON::PP::__ANON__ (xsub)
0	0	0	0s	0s	JSON::PP::::__ANON__[:1447] JSON::PP::__ANON__[:1447]
0	0	0	0s	0s	JSON::PP::::__ANON__[:1469] JSON::PP::__ANON__[:1469]
0	0	0	0s	0s	JSON::PP::::__ANON__[:1486] JSON::PP::__ANON__[:1486]
0	0	0	0s	0s	JSON::PP::::__ANON__[:314] JSON::PP::__ANON__[:314]
0	0	0	0s	0s	JSON::PP::::__ANON__[:319] JSON::PP::__ANON__[:319]
0	0	0	0s	0s	JSON::PP::::_decode_surrogates JSON::PP::_decode_surrogates
0	0	0	0s	0s	JSON::PP::::_decode_unicode JSON::PP::_decode_unicode
0	0	0	0s	0s	JSON::PP::::_detect_utf_encoding JSON::PP::_detect_utf_encoding
0	0	0	0s	0s	JSON::PP::::_down_indent JSON::PP::_down_indent
0	0	0	0s	0s	JSON::PP::::_encode_ascii JSON::PP::_encode_ascii
0	0	0	0s	0s	JSON::PP::::_encode_latin1 JSON::PP::_encode_latin1
0	0	0	0s	0s	JSON::PP::::_encode_surrogates JSON::PP::_encode_surrogates
0	0	0	0s	0s	JSON::PP::::_is_bignum JSON::PP::_is_bignum
0	0	0	0s	0s	JSON::PP::::_json_object_hook JSON::PP::_json_object_hook
0	0	0	0s	0s	JSON::PP::::_looks_like_number JSON::PP::_looks_like_number
0	0	0	0s	0s	JSON::PP::::_sort JSON::PP::_sort
0	0	0	0s	0s	JSON::PP::::_up_indent JSON::PP::_up_indent
0	0	0	0s	0s	JSON::PP::::allow_bigint JSON::PP::allow_bigint
0	0	0	0s	0s	JSON::PP::::array JSON::PP::array
0	0	0	0s	0s	JSON::PP::::array_to_json JSON::PP::array_to_json
0	0	0	0s	0s	JSON::PP::::bareKey JSON::PP::bareKey
0	0	0	0s	0s	JSON::PP::::blessed_to_json JSON::PP::blessed_to_json
0	0	0	0s	0s	JSON::PP::::boolean_values JSON::PP::boolean_values
0	0	0	0s	0s	JSON::PP::::decode JSON::PP::decode
0	0	0	0s	0s	JSON::PP::::decode_error JSON::PP::decode_error
0	0	0	0s	0s	JSON::PP::::decode_json JSON::PP::decode_json
0	0	0	0s	0s	JSON::PP::::decode_prefix JSON::PP::decode_prefix
0	0	0	0s	0s	JSON::PP::::encode JSON::PP::encode
0	0	0	0s	0s	JSON::PP::::encode_error JSON::PP::encode_error
0	0	0	0s	0s	JSON::PP::::encode_json JSON::PP::encode_json
0	0	0	0s	0s	JSON::PP::::filter_json_object JSON::PP::filter_json_object
0	0	0	0s	0s	JSON::PP::filter_json_single_key_object
0	0	0	0s	0s	JSON::PP::::from_json JSON::PP::from_json
0	0	0	0s	0s	JSON::PP::::get_boolean_values JSON::PP::get_boolean_values
0	0	0	0s	0s	JSON::PP::::get_indent_length JSON::PP::get_indent_length
0	0	0	0s	0s	JSON::PP::::get_max_depth JSON::PP::get_max_depth
0	0	0	0s	0s	JSON::PP::::get_max_size JSON::PP::get_max_size
0	0	0	0s	0s	JSON::PP::::hash_to_json JSON::PP::hash_to_json
0	0	0	0s	0s	JSON::PP::::incr_parse JSON::PP::incr_parse
0	0	0	0s	0s	JSON::PP::::incr_reset JSON::PP::incr_reset
0	0	0	0s	0s	JSON::PP::::incr_skip JSON::PP::incr_skip
0	0	0	0s	0s	JSON::PP::::indent_length JSON::PP::indent_length
0	0	0	0s	0s	JSON::PP::::is_bool JSON::PP::is_bool
0	0	0	0s	0s	JSON::PP::::is_valid_utf8 JSON::PP::is_valid_utf8
0	0	0	0s	0s	JSON::PP::::max_depth JSON::PP::max_depth
0	0	0	0s	0s	JSON::PP::::max_size JSON::PP::max_size
0	0	0	0s	0s	JSON::PP::::new JSON::PP::new
0	0	0	0s	0s	JSON::PP::::next_chr JSON::PP::next_chr
0	0	0	0s	0s	JSON::PP::::null JSON::PP::null
0	0	0	0s	0s	JSON::PP::::number JSON::PP::number
0	0	0	0s	0s	JSON::PP::::object JSON::PP::object
0	0	0	0s	0s	JSON::PP::::object_to_json JSON::PP::object_to_json
0	0	0	0s	0s	JSON::PP::::pretty JSON::PP::pretty
0	0	0	0s	0s	JSON::PP::::sort_by JSON::PP::sort_by
0	0	0	0s	0s	JSON::PP::::string JSON::PP::string
0	0	0	0s	0s	JSON::PP::::string_to_json JSON::PP::string_to_json
0	0	0	0s	0s	JSON::PP::::tag JSON::PP::tag
0	0	0	0s	0s	JSON::PP::::to_json JSON::PP::to_json
0	0	0	0s	0s	JSON::PP::::value JSON::PP::value
0	0	0	0s	0s	JSON::PP::::value_to_json JSON::PP::value_to_json
0	0	0	0s	0s	JSON::PP::::white JSON::PP::white
0	0	0	0s	0s	JSON::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
1					package JSON::PP;
2
3					# JSON-2.0
4
5	2	27µs	1	16µs	# spent 16µs within JSON::PP::BEGIN@5 which was called: # once (16µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 5 use 5.005; # spent 16µs making 1 call to JSON::PP::BEGIN@5
6	2	15µs	2	8µs	# spent 6µs (4+2) within JSON::PP::BEGIN@6 which was called: # once (4µs+2µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 6 use strict; # spent 6µs making 1 call to JSON::PP::BEGIN@6 # spent 2µs making 1 call to strict::import
7
8	2	19µs	1	1µs	# spent 1µs within JSON::PP::BEGIN@8 which was called: # once (1µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 8 use Exporter (); # spent 1µs making 1 call to JSON::PP::BEGIN@8
9	1	18µs	1	7µs	# spent 7µs within JSON::PP::BEGIN@9 which was called: # once (7µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 9 BEGIN { @JSON::PP::ISA = ('Exporter') } # spent 7µs making 1 call to JSON::PP::BEGIN@9
10
11	2	15µs	1	2µs	# spent 2µs within JSON::PP::BEGIN@11 which was called: # once (2µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 11 use overload (); # spent 2µs making 1 call to JSON::PP::BEGIN@11
12	2	158µs	2	282µs	# spent 282µs (239+43) within JSON::PP::BEGIN@12 which was called: # once (239µs+43µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 12 use JSON::PP::Boolean; # spent 282µs making 1 call to JSON::PP::BEGIN@12 # spent 0s making 1 call to JSON::PP::__ANON__
13
14	2	24µs	1	2µs	# spent 2µs within JSON::PP::BEGIN@14 which was called: # once (2µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 14 use Carp (); # spent 2µs making 1 call to JSON::PP::BEGIN@14
15					#use Devel::Peek;
16
17	1	1µs			$JSON::PP::VERSION = '4.07';
18
19	1	1µs			@JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
20
21					# instead of hash-access, i tried index-access for speed.
22					# but this method is not faster than what i expected. so it will be changed.
23
24	2	15µs	2	74µs	# spent 40µs (6+34) within JSON::PP::BEGIN@24 which was called: # once (6µs+34µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 24 use constant P_ASCII => 0; # spent 40µs making 1 call to JSON::PP::BEGIN@24 # spent 34µs making 1 call to constant::import
25	2	12µs	2	32µs	# spent 18µs (4+14) within JSON::PP::BEGIN@25 which was called: # once (4µs+14µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 25 use constant P_LATIN1 => 1; # spent 18µs making 1 call to JSON::PP::BEGIN@25 # spent 14µs making 1 call to constant::import
26	2	11µs	2	36µs	# spent 20µs (4+16) within JSON::PP::BEGIN@26 which was called: # once (4µs+16µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 26 use constant P_UTF8 => 2; # spent 20µs making 1 call to JSON::PP::BEGIN@26 # spent 16µs making 1 call to constant::import
27	2	10µs	2	34µs	# spent 18µs (2+16) within JSON::PP::BEGIN@27 which was called: # once (2µs+16µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 27 use constant P_INDENT => 3; # spent 18µs making 1 call to JSON::PP::BEGIN@27 # spent 16µs making 1 call to constant::import
28	2	11µs	2	30µs	# spent 17µs (4+13) within JSON::PP::BEGIN@28 which was called: # once (4µs+13µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 28 use constant P_CANONICAL => 4; # spent 17µs making 1 call to JSON::PP::BEGIN@28 # spent 13µs making 1 call to constant::import
29	2	12µs	2	27µs	# spent 15µs (3+12) within JSON::PP::BEGIN@29 which was called: # once (3µs+12µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 29 use constant P_SPACE_BEFORE => 5; # spent 15µs making 1 call to JSON::PP::BEGIN@29 # spent 12µs making 1 call to constant::import
30	2	9µs	2	26µs	# spent 14µs (2+12) within JSON::PP::BEGIN@30 which was called: # once (2µs+12µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 30 use constant P_SPACE_AFTER => 6; # spent 14µs making 1 call to JSON::PP::BEGIN@30 # spent 12µs making 1 call to constant::import
31	2	11µs	2	39µs	# spent 21µs (3+18) within JSON::PP::BEGIN@31 which was called: # once (3µs+18µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 31 use constant P_ALLOW_NONREF => 7; # spent 21µs making 1 call to JSON::PP::BEGIN@31 # spent 18µs making 1 call to constant::import
32	2	9µs	2	21µs	# spent 12µs (3+9) within JSON::PP::BEGIN@32 which was called: # once (3µs+9µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 32 use constant P_SHRINK => 8; # spent 12µs making 1 call to JSON::PP::BEGIN@32 # spent 9µs making 1 call to constant::import
33	2	13µs	2	70µs	# spent 37µs (4+33) within JSON::PP::BEGIN@33 which was called: # once (4µs+33µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 33 use constant P_ALLOW_BLESSED => 9; # spent 37µs making 1 call to JSON::PP::BEGIN@33 # spent 33µs making 1 call to constant::import
34	2	18µs	2	28µs	# spent 16µs (4+12) within JSON::PP::BEGIN@34 which was called: # once (4µs+12µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 34 use constant P_CONVERT_BLESSED => 10; # spent 16µs making 1 call to JSON::PP::BEGIN@34 # spent 12µs making 1 call to constant::import
35	2	26µs	2	38µs	# spent 21µs (4+17) within JSON::PP::BEGIN@35 which was called: # once (4µs+17µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 35 use constant P_RELAXED => 11; # spent 21µs making 1 call to JSON::PP::BEGIN@35 # spent 17µs making 1 call to constant::import
36
37	2	36µs	2	136µs	# spent 72µs (8+64) within JSON::PP::BEGIN@37 which was called: # once (8µs+64µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 37 use constant P_LOOSE => 12; # spent 72µs making 1 call to JSON::PP::BEGIN@37 # spent 64µs making 1 call to constant::import
38	2	37µs	2	53µs	# spent 30µs (7+23) within JSON::PP::BEGIN@38 which was called: # once (7µs+23µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 38 use constant P_ALLOW_BIGNUM => 13; # spent 30µs making 1 call to JSON::PP::BEGIN@38 # spent 23µs making 1 call to constant::import
39	2	39µs	2	69µs	# spent 42µs (15+27) within JSON::PP::BEGIN@39 which was called: # once (15µs+27µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 39 use constant P_ALLOW_BAREKEY => 14; # spent 42µs making 1 call to JSON::PP::BEGIN@39 # spent 27µs making 1 call to constant::import
40	2	142µs	2	183µs	# spent 94µs (5+89) within JSON::PP::BEGIN@40 which was called: # once (5µs+89µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 40 use constant P_ALLOW_SINGLEQUOTE => 15; # spent 94µs making 1 call to JSON::PP::BEGIN@40 # spent 89µs making 1 call to constant::import
41	2	29µs	2	72µs	# spent 39µs (6+33) within JSON::PP::BEGIN@41 which was called: # once (6µs+33µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 41 use constant P_ESCAPE_SLASH => 16; # spent 39µs making 1 call to JSON::PP::BEGIN@41 # spent 33µs making 1 call to constant::import
42	2	25µs	2	46µs	# spent 26µs (6+20) within JSON::PP::BEGIN@42 which was called: # once (6µs+20µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 42 use constant P_AS_NONBLESSED => 17; # spent 26µs making 1 call to JSON::PP::BEGIN@42 # spent 20µs making 1 call to constant::import
43
44	2	58µs	2	180µs	# spent 93µs (6+87) within JSON::PP::BEGIN@44 which was called: # once (6µs+87µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 44 use constant P_ALLOW_UNKNOWN => 18; # spent 93µs making 1 call to JSON::PP::BEGIN@44 # spent 87µs making 1 call to constant::import
45	2	78µs	2	115µs	# spent 61µs (7+54) within JSON::PP::BEGIN@45 which was called: # once (7µs+54µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 45 use constant P_ALLOW_TAGS => 19; # spent 61µs making 1 call to JSON::PP::BEGIN@45 # spent 54µs making 1 call to constant::import
46
47	2	47µs	2	79µs	# spent 44µs (9+35) within JSON::PP::BEGIN@47 which was called: # once (9µs+35µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 47 use constant OLD_PERL => $] < 5.008 ? 1 : 0; # spent 44µs making 1 call to JSON::PP::BEGIN@47 # spent 35µs making 1 call to constant::import
48	2	40µs	2	79µs	# spent 44µs (9+35) within JSON::PP::BEGIN@48 which was called: # once (9µs+35µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 48 use constant USE_B => $ENV{PERL_JSON_PP_USE_B} \|\| 0; # spent 44µs making 1 call to JSON::PP::BEGIN@48 # spent 35µs making 1 call to constant::import
49
50					# spent 2µs within JSON::PP::BEGIN@50 which was called: # once (2µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 54 BEGIN {
51	1	2µs			if (USE_B) {
52					require B;
53					}
54	1	294µs	1	2µs	} # spent 2µs making 1 call to JSON::PP::BEGIN@50
55
56					# spent 886µs within JSON::PP::BEGIN@56 which was called: # once (886µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 98 BEGIN {
57	1	4µs			my @xs_compati_bit_properties = qw(
58					latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
59					allow_blessed convert_blessed relaxed allow_unknown
60					allow_tags
61					);
62	1	1µs			my @pp_bit_properties = qw(
63					allow_singlequote allow_bignum loose
64					allow_barekey escape_slash as_nonblessed
65					);
66
67					# Perl version check, Unicode handling is enabled?
68					# Helper module sets @JSON::PP::_properties.
69					if ( OLD_PERL ) {
70					my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
71					eval qq\| require $helper \|;
72					if ($@) { Carp::croak $@; }
73					}
74
75	1	7µs			for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
76	20	9µs			my $property_id = 'P_' . uc($name);
77
78	20	868µs			eval qq/
79					sub $name {
80					my \$enable = defined \$_[1] ? \$_[1] : 1;
81
82					if (\$enable) {
83					\$_[0]->{PROPS}->[$property_id] = 1;
84					}
85					else {
86					\$_[0]->{PROPS}->[$property_id] = 0;
87					}
88
89					\$_[0];
90					}
91
92					sub get_$name {
93					\$_[0]->{PROPS}->[$property_id] ? 1 : '';
94					}
95					/;
96					}
97
98	1	1.03ms	1	886µs	} # spent 886µs making 1 call to JSON::PP::BEGIN@56
99
- -
102					# Functions
103
104	1	0s			my $JSON; # cache
105
106					sub encode_json ($) { # encode
107					($JSON \|\|= __PACKAGE__->new->utf8)->encode(@_);
108					}
109
110
111					sub decode_json { # decode
112					($JSON \|\|= __PACKAGE__->new->utf8)->decode(@_);
113					}
114
115					# Obsoleted
116
117					sub to_json($) {
118					Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
119					}
120
121
122					sub from_json($) {
123					Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
124					}
125
126
127					# Methods
128
129					sub new {
130					my $class = shift;
131					my $self = {
132					max_depth => 512,
133					max_size => 0,
134					indent_length => 3,
135					};
136
137					$self->{PROPS}[P_ALLOW_NONREF] = 1;
138
139					bless $self, $class;
140					}
141
142
143					sub encode {
144					return $_[0]->PP_encode_json($_[1]);
145					}
146
147
148					sub decode {
149					return $_[0]->PP_decode_json($_[1], 0x00000000);
150					}
151
152
153					sub decode_prefix {
154					return $_[0]->PP_decode_json($_[1], 0x00000001);
155					}
156
157
158					# accessor
159
160
161					# pretty printing
162
163					sub pretty {
164					my ($self, $v) = @_;
165					my $enable = defined $v ? $v : 1;
166
167					if ($enable) { # indent_length(3) for JSON::XS compatibility
168					$self->indent(1)->space_before(1)->space_after(1);
169					}
170					else {
171					$self->indent(0)->space_before(0)->space_after(0);
172					}
173
174					$self;
175					}
176
177					# etc
178
179					sub max_depth {
180					my $max = defined $_[1] ? $_[1] : 0x80000000;
181					$_[0]->{max_depth} = $max;
182					$_[0];
183					}
184
185
186					sub get_max_depth { $_[0]->{max_depth}; }
187
188
189					sub max_size {
190					my $max = defined $_[1] ? $_[1] : 0;
191					$_[0]->{max_size} = $max;
192					$_[0];
193					}
194
195
196					sub get_max_size { $_[0]->{max_size}; }
197
198					sub boolean_values {
199					my $self = shift;
200					if (@_) {
201					my ($false, $true) = @_;
202					$self->{false} = $false;
203					$self->{true} = $true;
204					} else {
205					delete $self->{false};
206					delete $self->{true};
207					}
208					return $self;
209					}
210
211					sub get_boolean_values {
212					my $self = shift;
213					if (exists $self->{true} and exists $self->{false}) {
214					return @$self{qw/false true/};
215					}
216					return;
217					}
218
219					sub filter_json_object {
220					if (defined $_[1] and ref $_[1] eq 'CODE') {
221					$_[0]->{cb_object} = $_[1];
222					} else {
223					delete $_[0]->{cb_object};
224					}
225					$_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
226					$_[0];
227					}
228
229					sub filter_json_single_key_object {
230					if (@_ == 1 or @_ > 3) {
231					Carp::croak("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)");
232					}
233					if (defined $_[2] and ref $_[2] eq 'CODE') {
234					$_[0]->{cb_sk_object}->{$_[1]} = $_[2];
235					} else {
236					delete $_[0]->{cb_sk_object}->{$_[1]};
237					delete $_[0]->{cb_sk_object} unless %{$_[0]->{cb_sk_object} \|\| {}};
238					}
239					$_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
240					$_[0];
241					}
242
243					sub indent_length {
244					if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
245					Carp::carp "The acceptable range of indent_length() is 0 to 15.";
246					}
247					else {
248					$_[0]->{indent_length} = $_[1];
249					}
250					$_[0];
251					}
252
253					sub get_indent_length {
254					$_[0]->{indent_length};
255					}
256
257					sub sort_by {
258					$_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
259					$_[0];
260					}
261
262					sub allow_bigint {
263					Carp::carp("allow_bigint() is obsoleted. use allow_bignum() instead.");
264					$_[0]->allow_bignum;
265					}
266
267					###############################
268
269					###
270					### Perl => JSON
271					###
272
273
274					{ # Convert
275
276	1	0s			my $max_depth;
277					my $indent;
278					my $ascii;
279					my $latin1;
280					my $utf8;
281					my $space_before;
282					my $space_after;
283					my $canonical;
284					my $allow_blessed;
285					my $convert_blessed;
286
287					my $indent_length;
288					my $escape_slash;
289					my $bignum;
290					my $as_nonblessed;
291					my $allow_tags;
292
293					my $depth;
294					my $indent_count;
295					my $keysort;
296
297
298					sub PP_encode_json {
299					my $self = shift;
300					my $obj = shift;
301
302					$indent_count = 0;
303					$depth = 0;
304
305					my $props = $self->{PROPS};
306
307					($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
308					$convert_blessed, $escape_slash, $bignum, $as_nonblessed, $allow_tags)
309					= @{$props}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
310					P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED, P_ALLOW_TAGS];
311
312					($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
313
314					$keysort = $canonical ? sub { $a cmp $b } : undef;
315
316					if ($self->{sort_by}) {
317					$keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
318					: $self->{sort_by} =~ /\D+/ ? $self->{sort_by}
319					: sub { $a cmp $b };
320					}
321
322					encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
323					if(!ref $obj and !$props->[ P_ALLOW_NONREF ]);
324
325					my $str = $self->object_to_json($obj);
326
327					$str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
328
329					unless ($ascii or $latin1 or $utf8) {
330					utf8::upgrade($str);
331					}
332
333					if ($props->[ P_SHRINK ]) {
334					utf8::downgrade($str, 1);
335					}
336
337					return $str;
338					}
339
340
341					sub object_to_json {
342					my ($self, $obj) = @_;
343					my $type = ref($obj);
344
345					if($type eq 'HASH'){
346					return $self->hash_to_json($obj);
347					}
348					elsif($type eq 'ARRAY'){
349					return $self->array_to_json($obj);
350					}
351					elsif ($type) { # blessed object?
352					if (blessed($obj)) {
353
354					return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
355
356					if ( $allow_tags and $obj->can('FREEZE') ) {
357					my $obj_class = ref $obj \|\| $obj;
358					$obj = bless $obj, $obj_class;
359					my @results = $obj->FREEZE('JSON');
360					if ( @results and ref $results[0] ) {
361					if ( refaddr( $obj ) eq refaddr( $results[0] ) ) {
362					encode_error( sprintf(
363					"%s::FREEZE method returned same object as was passed instead of a new one",
364					ref $obj
365					) );
366					}
367					}
368					return '("'.$obj_class.'")['.join(',', @results).']';
369					}
370
371					if ( $convert_blessed and $obj->can('TO_JSON') ) {
372					my $result = $obj->TO_JSON();
373					if ( defined $result and ref( $result ) ) {
374					if ( refaddr( $obj ) eq refaddr( $result ) ) {
375					encode_error( sprintf(
376					"%s::TO_JSON method returned same object as was passed instead of a new one",
377					ref $obj
378					) );
379					}
380					}
381
382					return $self->object_to_json( $result );
383					}
384
385					return "$obj" if ( $bignum and _is_bignum($obj) );
386
387					if ($allow_blessed) {
388					return $self->blessed_to_json($obj) if ($as_nonblessed); # will be removed.
389					return 'null';
390					}
391					encode_error( sprintf("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)", $obj)
392					);
393					}
394					else {
395					return $self->value_to_json($obj);
396					}
397					}
398					else{
399					return $self->value_to_json($obj);
400					}
401					}
402
403
404					sub hash_to_json {
405					my ($self, $obj) = @_;
406					my @res;
407
408					encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
409					if (++$depth > $max_depth);
410
411					my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
412					my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
413
414					for my $k ( _sort( $obj ) ) {
415					if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
416					push @res, $self->string_to_json( $k )
417					. $del
418					. ( ref $obj->{$k} ? $self->object_to_json( $obj->{$k} ) : $self->value_to_json( $obj->{$k} ) );
419					}
420
421					--$depth;
422					$self->_down_indent() if ($indent);
423
424					return '{}' unless @res;
425					return '{' . $pre . join( ",$pre", @res ) . $post . '}';
426					}
427
428
429					sub array_to_json {
430					my ($self, $obj) = @_;
431					my @res;
432
433					encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
434					if (++$depth > $max_depth);
435
436					my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
437
438					for my $v (@$obj){
439					push @res, ref($v) ? $self->object_to_json($v) : $self->value_to_json($v);
440					}
441
442					--$depth;
443					$self->_down_indent() if ($indent);
444
445					return '[]' unless @res;
446					return '[' . $pre . join( ",$pre", @res ) . $post . ']';
447					}
448
449					sub _looks_like_number {
450					my $value = shift;
451					if (USE_B) {
452					my $b_obj = B::svref_2object(\$value);
453					my $flags = $b_obj->FLAGS;
454					return 1 if $flags & ( B::SVp_IOK() \| B::SVp_NOK() ) and !( $flags & B::SVp_POK() );
455					return;
456					} else {
457	2	611µs	2	56µs	# spent 32µs (8+24) within JSON::PP::BEGIN@457 which was called: # once (8µs+24µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 457 no warnings 'numeric'; # spent 32µs making 1 call to JSON::PP::BEGIN@457 # spent 24µs making 1 call to warnings::unimport
458					# if the utf8 flag is on, it almost certainly started as a string
459					return if utf8::is_utf8($value);
460					# detect numbers
461					# string & "" -> ""
462					# number & "" -> 0 (with warning)
463					# nan and inf can detect as numbers, so check with * 0
464					return unless length((my $dummy = "") & $value);
465					return unless 0 + $value eq $value;
466					return 1 if $value * 0 == 0;
467					return -1; # inf/nan
468					}
469					}
470
471					sub value_to_json {
472					my ($self, $value) = @_;
473
474					return 'null' if(!defined $value);
475
476					my $type = ref($value);
477
478					if (!$type) {
479					if (_looks_like_number($value)) {
480					return $value;
481					}
482					return $self->string_to_json($value);
483					}
484					elsif( blessed($value) and $value->isa('JSON::PP::Boolean') ){
485					return $$value == 1 ? 'true' : 'false';
486					}
487					else {
488					if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
489					return $self->value_to_json("$value");
490					}
491
492					if ($type eq 'SCALAR' and defined $$value) {
493					return $$value eq '1' ? 'true'
494					: $$value eq '0' ? 'false'
495					: $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
496					: encode_error("cannot encode reference to scalar");
497					}
498
499					if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
500					return 'null';
501					}
502					else {
503					if ( $type eq 'SCALAR' or $type eq 'REF' ) {
504					encode_error("cannot encode reference to scalar");
505					}
506					else {
507					encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
508					}
509					}
510
511					}
512					}
513
514
515	1	3µs			my %esc = (
516					"\n" => '\n',
517					"\r" => '\r',
518					"\t" => '\t',
519					"\f" => '\f',
520					"\b" => '\b',
521					"\"" => '\"',
522					"\\" => '\\\\',
523					"\'" => '\\\'',
524					);
525
526
527					sub string_to_json {
528					my ($self, $arg) = @_;
529
530					$arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
531					$arg =~ s/\//\\\//g if ($escape_slash);
532					$arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
533
534					if ($ascii) {
535					$arg = JSON_PP_encode_ascii($arg);
536					}
537
538					if ($latin1) {
539					$arg = JSON_PP_encode_latin1($arg);
540					}
541
542					if ($utf8) {
543					utf8::encode($arg);
544					}
545
546					return '"' . $arg . '"';
547					}
548
549
550					sub blessed_to_json {
551					my $reftype = reftype($_[1]) \|\| '';
552					if ($reftype eq 'HASH') {
553					return $_[0]->hash_to_json($_[1]);
554					}
555					elsif ($reftype eq 'ARRAY') {
556					return $_[0]->array_to_json($_[1]);
557					}
558					else {
559					return 'null';
560					}
561					}
562
563
564					sub encode_error {
565					my $error = shift;
566					Carp::croak "$error";
567					}
568
569
570					sub _sort {
571					defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
572					}
573
574
575					sub _up_indent {
576					my $self = shift;
577					my $space = ' ' x $indent_length;
578
579					my ($pre,$post) = ('','');
580
581					$post = "\n" . $space x $indent_count;
582
583					$indent_count++;
584
585					$pre = "\n" . $space x $indent_count;
586
587					return ($pre,$post);
588					}
589
590
591					sub _down_indent { $indent_count--; }
592
593
594					sub PP_encode_box {
595					{
596					depth => $depth,
597					indent_count => $indent_count,
598					};
599					}
600
601					} # Convert
602
603
604	1	0s			sub _encode_ascii {
605					join('',
606					map {
607					$_ <= 127 ?
608					chr($_) :
609					$_ <= 65535 ?
610					sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
611					} unpack('U*', $_[0])
612					);
613					}
614
615
616					sub _encode_latin1 {
617					join('',
618					map {
619					$_ <= 255 ?
620					chr($_) :
621					$_ <= 65535 ?
622					sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
623					} unpack('U*', $_[0])
624					);
625					}
626
627
628					sub _encode_surrogates { # from perlunicode
629					my $uni = $_[0] - 0x10000;
630					return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
631					}
632
633
634					sub _is_bignum {
635					$_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
636					}
637
- -
640					#
641					# JSON => Perl
642					#
643
644	1	0s			my $max_intsize;
645
646					# spent 154µs (142+12) within JSON::PP::BEGIN@646 which was called: # once (142µs+12µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 656 BEGIN {
647	1	0s			my $checkint = 1111;
648	1	1µs			for my $d (5..64) {
649	17	2µs			$checkint .= 1;
650	17	98µs			my $int = eval qq\| $checkint \|; # spent 2µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs executing statements in string eval # spent 1µs 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
651	17	34µs	17	12µs	if ($int =~ /[eE]/) { # spent 12µs making 17 calls to JSON::PP::CORE:match, avg 706ns/call
652	1	1µs			$max_intsize = $d - 1;
653	1	4µs			last;
654					}
655					}
656	1	258µs	1	154µs	} # spent 154µs making 1 call to JSON::PP::BEGIN@646
657
658					{ # PARSE
659
660	1	3µs			my %escapes = ( # by Jeremy Muhlich <jmuhlich [at] bitflood.org>
661					b => "\x8",
662					t => "\x9",
663					n => "\xA",
664					f => "\xC",
665					r => "\xD",
666					'\\' => '\\',
667					'"' => '"',
668					'/' => '/',
669					);
670
671	1	0s			my $text; # json data
672					my $at; # offset
673					my $ch; # first character
674					my $len; # text length (changed according to UTF8 or NON UTF8)
675					# INTERNAL
676					my $depth; # nest counter
677					my $encoding; # json text encoding
678					my $is_valid_utf8; # temp variable
679					my $utf8_len; # utf8 byte length
680					# FLAGS
681					my $utf8; # must be utf8
682					my $max_depth; # max nest number of objects and arrays
683					my $max_size;
684					my $relaxed;
685					my $cb_object;
686					my $cb_sk_object;
687
688					my $F_HOOK;
689
690					my $allow_bignum; # using Math::BigInt/BigFloat
691					my $singlequote; # loosely quoting
692					my $loose; #
693					my $allow_barekey; # bareKey
694					my $allow_tags;
695
696					my $alt_true;
697	1	0s			my $alt_false;
698
699					sub _detect_utf_encoding {
700					my $text = shift;
701					my @octets = unpack('C4', $text);
702					return 'unknown' unless defined $octets[3];
703					return ( $octets[0] and $octets[1]) ? 'UTF-8'
704					: (!$octets[0] and $octets[1]) ? 'UTF-16BE'
705					: (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
706					: ( $octets[2] ) ? 'UTF-16LE'
707					: (!$octets[2] ) ? 'UTF-32LE'
708					: 'unknown';
709					}
710
711					sub PP_decode_json {
712					my ($self, $want_offset);
713
714					($self, $text, $want_offset) = @_;
715
716					($at, $ch, $depth) = (0, '', 0);
717
718					if ( !defined $text or ref $text ) {
719					decode_error("malformed JSON string, neither array, object, number, string or atom");
720					}
721
722					my $props = $self->{PROPS};
723
724					($utf8, $relaxed, $loose, $allow_bignum, $allow_barekey, $singlequote, $allow_tags)
725					= @{$props}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE, P_ALLOW_TAGS];
726
727					($alt_true, $alt_false) = @$self{qw/true false/};
728
729					if ( $utf8 ) {
730					$encoding = _detect_utf_encoding($text);
731					if ($encoding ne 'UTF-8' and $encoding ne 'unknown') {
732					require Encode;
733					Encode::from_to($text, $encoding, 'utf-8');
734					} else {
735					utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
736					}
737					}
738					else {
739					utf8::upgrade( $text );
740					utf8::encode( $text );
741					}
742
743					$len = length $text;
744
745					($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
746					= @{$self}{qw/max_depth max_size cb_object cb_sk_object F_HOOK/};
747
748					if ($max_size > 1) {
749	2	2.87ms	2	19µs	# spent 15µs (11+4) within JSON::PP::BEGIN@749 which was called: # once (11µs+4µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 749 use bytes; # spent 15µs making 1 call to JSON::PP::BEGIN@749 # spent 4µs making 1 call to bytes::import
750					my $bytes = length $text;
751					decode_error(
752					sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
753					, $bytes, $max_size), 1
754					) if ($bytes > $max_size);
755					}
756
757					white(); # remove head white space
758
759					decode_error("malformed JSON string, neither array, object, number, string or atom") unless defined $ch; # Is there a first character for JSON structure?
760
761					my $result = value();
762
763					if ( !$props->[ P_ALLOW_NONREF ] and !ref $result ) {
764					decode_error(
765					'JSON text must be an object or array (but found number, string, true, false or null,'
766					. ' use allow_nonref to allow this)', 1);
767					}
768
769					Carp::croak('something wrong.') if $len < $at; # we won't arrive here.
770
771					my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length
772
773					white(); # remove tail white space
774
775					return ( $result, $consumed ) if $want_offset; # all right if decode_prefix
776
777					decode_error("garbage after JSON object") if defined $ch;
778
779					$result;
780					}
781
782
783					sub next_chr {
784					return $ch = undef if($at >= $len);
785					$ch = substr($text, $at++, 1);
786					}
787
788
789					sub value {
790					white();
791					return if(!defined $ch);
792					return object() if($ch eq '{');
793					return array() if($ch eq '[');
794					return tag() if($ch eq '(');
795					return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
796					return number() if($ch =~ /[0-9]/ or $ch eq '-');
797					return word();
798					}
799
800					sub string {
801					my $utf16;
802					my $is_utf8;
803
804					($is_valid_utf8, $utf8_len) = ('', 0);
805
806					my $s = ''; # basically UTF8 flag on
807
808					if($ch eq '"' or ($singlequote and $ch eq "'")){
809					my $boundChar = $ch;
810
811					OUTER: while( defined(next_chr()) ){
812
813					if($ch eq $boundChar){
814					next_chr();
815
816					if ($utf16) {
817					decode_error("missing low surrogate character in surrogate pair");
818					}
819
820					utf8::decode($s) if($is_utf8);
821
822					return $s;
823					}
824					elsif($ch eq '\\'){
825					next_chr();
826					if(exists $escapes{$ch}){
827					$s .= $escapes{$ch};
828					}
829					elsif($ch eq 'u'){ # UNICODE handling
830					my $u = '';
831
832					for(1..4){
833					$ch = next_chr();
834					last OUTER if($ch !~ /[0-9a-fA-F]/);
835					$u .= $ch;
836					}
837
838					# U+D800 - U+DBFF
839					if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
840					$utf16 = $u;
841					}
842					# U+DC00 - U+DFFF
843					elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
844					unless (defined $utf16) {
845					decode_error("missing high surrogate character in surrogate pair");
846					}
847					$is_utf8 = 1;
848					$s .= JSON_PP_decode_surrogates($utf16, $u) \|\| next;
849					$utf16 = undef;
850					}
851					else {
852					if (defined $utf16) {
853					decode_error("surrogate pair expected");
854					}
855
856					if ( ( my $hex = hex( $u ) ) > 127 ) {
857					$is_utf8 = 1;
858					$s .= JSON_PP_decode_unicode($u) \|\| next;
859					}
860					else {
861					$s .= chr $hex;
862					}
863					}
864
865					}
866					else{
867					unless ($loose) {
868					$at -= 2;
869					decode_error('illegal backslash escape sequence in string');
870					}
871					$s .= $ch;
872					}
873					}
874					else{
875
876					if ( ord $ch > 127 ) {
877					unless( $ch = is_valid_utf8($ch) ) {
878					$at -= 1;
879					decode_error("malformed UTF-8 character in JSON string");
880					}
881					else {
882					$at += $utf8_len - 1;
883					}
884
885					$is_utf8 = 1;
886					}
887
888					if (!$loose) {
889					if ($ch =~ /[\x00-\x1f\x22\x5c]/) { # '/' ok
890					if (!$relaxed or $ch ne "\t") {
891					$at--;
892					decode_error('invalid character encountered while parsing JSON string');
893					}
894					}
895					}
896
897					$s .= $ch;
898					}
899					}
900					}
901
902					decode_error("unexpected end of string while parsing JSON string");
903					}
904
905
906					sub white {
907					while( defined $ch ){
908					if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){
909					next_chr();
910					}
911					elsif($relaxed and $ch eq '/'){
912					next_chr();
913					if(defined $ch and $ch eq '/'){
914					1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
915					}
916					elsif(defined $ch and $ch eq '*'){
917					next_chr();
918					while(1){
919					if(defined $ch){
920					if($ch eq '*'){
921					if(defined(next_chr()) and $ch eq '/'){
922					next_chr();
923					last;
924					}
925					}
926					else{
927					next_chr();
928					}
929					}
930					else{
931					decode_error("Unterminated comment");
932					}
933					}
934					next;
935					}
936					else{
937					$at--;
938					decode_error("malformed JSON string, neither array, object, number, string or atom");
939					}
940					}
941					else{
942					if ($relaxed and $ch eq '#') { # correctly?
943					pos($text) = $at;
944					$text =~ /\G([^\n]*(?:\r\n\|\r\|\n\|$))/g;
945					$at = pos($text);
946					next_chr;
947					next;
948					}
949
950					last;
951					}
952					}
953					}
954
955
956					sub array {
957					my $a = $_[0] \|\| []; # you can use this code to use another array ref object.
958
959					decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
960					if (++$depth > $max_depth);
961
962					next_chr();
963					white();
964
965					if(defined $ch and $ch eq ']'){
966					--$depth;
967					next_chr();
968					return $a;
969					}
970					else {
971					while(defined($ch)){
972					push @$a, value();
973
974					white();
975
976					if (!defined $ch) {
977					last;
978					}
979
980					if($ch eq ']'){
981					--$depth;
982					next_chr();
983					return $a;
984					}
985
986					if($ch ne ','){
987					last;
988					}
989
990					next_chr();
991					white();
992
993					if ($relaxed and $ch eq ']') {
994					--$depth;
995					next_chr();
996					return $a;
997					}
998
999					}
1000					}
1001
1002					$at-- if defined $ch and $ch ne '';
1003					decode_error(", or ] expected while parsing array");
1004					}
1005
1006					sub tag {
1007					decode_error('malformed JSON string, neither array, object, number, string or atom') unless $allow_tags;
1008
1009					next_chr();
1010					white();
1011
1012					my $tag = value();
1013					return unless defined $tag;
1014					decode_error('malformed JSON string, (tag) must be a string') if ref $tag;
1015
1016					white();
1017
1018					if (!defined $ch or $ch ne ')') {
1019					decode_error(') expected after tag');
1020					}
1021
1022					next_chr();
1023					white();
1024
1025					my $val = value();
1026					return unless defined $val;
1027					decode_error('malformed JSON string, tag value must be an array') unless ref $val eq 'ARRAY';
1028
1029					if (!eval { $tag->can('THAW') }) {
1030					decode_error('cannot decode perl-object (package does not exist)') if $@;
1031					decode_error('cannot decode perl-object (package does not have a THAW method)');
1032					}
1033					$tag->THAW('JSON', @$val);
1034					}
1035
1036					sub object {
1037					my $o = $_[0] \|\| {}; # you can use this code to use another hash ref object.
1038					my $k;
1039
1040					decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
1041					if (++$depth > $max_depth);
1042					next_chr();
1043					white();
1044
1045					if(defined $ch and $ch eq '}'){
1046					--$depth;
1047					next_chr();
1048					if ($F_HOOK) {
1049					return _json_object_hook($o);
1050					}
1051					return $o;
1052					}
1053					else {
1054					while (defined $ch) {
1055					$k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
1056					white();
1057
1058					if(!defined $ch or $ch ne ':'){
1059					$at--;
1060					decode_error("':' expected");
1061					}
1062
1063					next_chr();
1064					$o->{$k} = value();
1065					white();
1066
1067					last if (!defined $ch);
1068
1069					if($ch eq '}'){
1070					--$depth;
1071					next_chr();
1072					if ($F_HOOK) {
1073					return _json_object_hook($o);
1074					}
1075					return $o;
1076					}
1077
1078					if($ch ne ','){
1079					last;
1080					}
1081
1082					next_chr();
1083					white();
1084
1085					if ($relaxed and $ch eq '}') {
1086					--$depth;
1087					next_chr();
1088					if ($F_HOOK) {
1089					return _json_object_hook($o);
1090					}
1091					return $o;
1092					}
1093
1094					}
1095
1096					}
1097
1098					$at-- if defined $ch and $ch ne '';
1099					decode_error(", or } expected while parsing object/hash");
1100					}
1101
1102
1103					sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
1104					my $key;
1105					while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
1106					$key .= $ch;
1107					next_chr();
1108					}
1109					return $key;
1110					}
1111
1112
1113					sub word {
1114					my $word = substr($text,$at-1,4);
1115
1116					if($word eq 'true'){
1117					$at += 3;
1118					next_chr;
1119					return defined $alt_true ? $alt_true : $JSON::PP::true;
1120					}
1121					elsif($word eq 'null'){
1122					$at += 3;
1123					next_chr;
1124					return undef;
1125					}
1126					elsif($word eq 'fals'){
1127					$at += 3;
1128					if(substr($text,$at,1) eq 'e'){
1129					$at++;
1130					next_chr;
1131					return defined $alt_false ? $alt_false : $JSON::PP::false;
1132					}
1133					}
1134
1135					$at--; # for decode_error report
1136
1137					decode_error("'null' expected") if ($word =~ /^n/);
1138					decode_error("'true' expected") if ($word =~ /^t/);
1139					decode_error("'false' expected") if ($word =~ /^f/);
1140					decode_error("malformed JSON string, neither array, object, number, string or atom");
1141					}
1142
1143
1144					sub number {
1145					my $n = '';
1146					my $v;
1147					my $is_dec;
1148					my $is_exp;
1149
1150					if($ch eq '-'){
1151					$n = '-';
1152					next_chr;
1153					if (!defined $ch or $ch !~ /\d/) {
1154					decode_error("malformed number (no digits after initial minus)");
1155					}
1156					}
1157
1158					# According to RFC4627, hex or oct digits are invalid.
1159					if($ch eq '0'){
1160					my $peek = substr($text,$at,1);
1161					if($peek =~ /^[0-9a-dfA-DF]/){ # e may be valid (exponential)
1162					decode_error("malformed number (leading zero must not be followed by another digit)");
1163					}
1164					$n .= $ch;
1165					next_chr;
1166					}
1167
1168					while(defined $ch and $ch =~ /\d/){
1169					$n .= $ch;
1170					next_chr;
1171					}
1172
1173					if(defined $ch and $ch eq '.'){
1174					$n .= '.';
1175					$is_dec = 1;
1176
1177					next_chr;
1178					if (!defined $ch or $ch !~ /\d/) {
1179					decode_error("malformed number (no digits after decimal point)");
1180					}
1181					else {
1182					$n .= $ch;
1183					}
1184
1185					while(defined(next_chr) and $ch =~ /\d/){
1186					$n .= $ch;
1187					}
1188					}
1189
1190					if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
1191					$n .= $ch;
1192					$is_exp = 1;
1193					next_chr;
1194
1195					if(defined($ch) and ($ch eq '+' or $ch eq '-')){
1196					$n .= $ch;
1197					next_chr;
1198					if (!defined $ch or $ch =~ /\D/) {
1199					decode_error("malformed number (no digits after exp sign)");
1200					}
1201					$n .= $ch;
1202					}
1203					elsif(defined($ch) and $ch =~ /\d/){
1204					$n .= $ch;
1205					}
1206					else {
1207					decode_error("malformed number (no digits after exp sign)");
1208					}
1209
1210					while(defined(next_chr) and $ch =~ /\d/){
1211					$n .= $ch;
1212					}
1213
1214					}
1215
1216					$v .= $n;
1217
1218					if ($is_dec or $is_exp) {
1219					if ($allow_bignum) {
1220					require Math::BigFloat;
1221					return Math::BigFloat->new($v);
1222					}
1223					} else {
1224					if (length $v > $max_intsize) {
1225					if ($allow_bignum) { # from Adam Sussman
1226					require Math::BigInt;
1227					return Math::BigInt->new($v);
1228					}
1229					else {
1230					return "$v";
1231					}
1232					}
1233					}
1234
1235					return $is_dec ? $v/1.0 : 0+$v;
1236					}
1237
1238
1239					sub is_valid_utf8 {
1240
1241					$utf8_len = $_[0] =~ /[\x00-\x7F]/ ? 1
1242					: $_[0] =~ /[\xC2-\xDF]/ ? 2
1243					: $_[0] =~ /[\xE0-\xEF]/ ? 3
1244					: $_[0] =~ /[\xF0-\xF4]/ ? 4
1245					: 0
1246					;
1247
1248					return unless $utf8_len;
1249
1250					my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
1251
1252					return ( $is_valid_utf8 =~ /^(?:
1253					[\x00-\x7F]
1254					\|[\xC2-\xDF][\x80-\xBF]
1255					\|[\xE0][\xA0-\xBF][\x80-\xBF]
1256					\|[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
1257					\|[\xED][\x80-\x9F][\x80-\xBF]
1258					\|[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
1259					\|[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
1260					\|[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
1261					\|[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
1262					)$/x ) ? $is_valid_utf8 : '';
1263					}
1264
1265
1266					sub decode_error {
1267					my $error = shift;
1268					my $no_rep = shift;
1269					my $str = defined $text ? substr($text, $at) : '';
1270					my $mess = '';
1271					my $type = 'U*';
1272
1273					if ( OLD_PERL ) {
1274					my $type = $] < 5.006 ? 'C*'
1275					: utf8::is_utf8( $str ) ? 'U*' # 5.6
1276					: 'C*'
1277					;
1278					}
1279
1280					for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
1281					$mess .= $c == 0x07 ? '\a'
1282					: $c == 0x09 ? '\t'
1283					: $c == 0x0a ? '\n'
1284					: $c == 0x0d ? '\r'
1285					: $c == 0x0c ? '\f'
1286					: $c < 0x20 ? sprintf('\x{%x}', $c)
1287					: $c == 0x5c ? '\\\\'
1288					: $c < 0x80 ? chr($c)
1289					: sprintf('\x{%x}', $c)
1290					;
1291					if ( length $mess >= 20 ) {
1292					$mess .= '...';
1293					last;
1294					}
1295					}
1296
1297					unless ( length $mess ) {
1298					$mess = '(end of string)';
1299					}
1300
1301					Carp::croak (
1302					$no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
1303					);
1304
1305					}
1306
1307
1308					sub _json_object_hook {
1309					my $o = $_[0];
1310					my @ks = keys %{$o};
1311
1312					if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
1313					my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
1314					if (@val == 0) {
1315					return $o;
1316					}
1317					elsif (@val == 1) {
1318					return $val[0];
1319					}
1320					else {
1321					Carp::croak("filter_json_single_key_object callbacks must not return more than one scalar");
1322					}
1323					}
1324
1325					my @val = $cb_object->($o) if ($cb_object);
1326					if (@val == 0) {
1327					return $o;
1328					}
1329					elsif (@val == 1) {
1330					return $val[0];
1331					}
1332					else {
1333					Carp::croak("filter_json_object callbacks must not return more than one scalar");
1334					}
1335					}
1336
1337
1338					sub PP_decode_box {
1339					{
1340					text => $text,
1341					at => $at,
1342					ch => $ch,
1343					len => $len,
1344					depth => $depth,
1345					encoding => $encoding,
1346					is_valid_utf8 => $is_valid_utf8,
1347					};
1348					}
1349
1350					} # PARSE
1351
1352
1353	1	0s			sub _decode_surrogates { # from perlunicode
1354					my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
1355					my $un = pack('U*', $uni);
1356					utf8::encode( $un );
1357					return $un;
1358					}
1359
1360
1361					sub _decode_unicode {
1362					my $un = pack('U', hex shift);
1363					utf8::encode( $un );
1364					return $un;
1365					}
1366
1367					#
1368					# Setup for various Perl versions (the code from JSON::PP58)
1369					#
1370
1371					# spent 56µs within JSON::PP::BEGIN@1371 which was called: # once (56µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 1427 BEGIN {
1372
1373	1	0s			unless ( defined &utf8::is_utf8 ) {
1374					require Encode;
1375					utf8::is_utf8 = Encode::is_utf8;
1376					}
1377
1378	1	1µs			if ( !OLD_PERL ) {
1379	1	1µs			*JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii;
1380	1	1µs			*JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1;
1381	1	0s			*JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
1382	1	1µs			*JSON::PP::JSON_PP_decode_unicode = \&_decode_unicode;
1383
1384	1	0s			if ($] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
1385					package JSON::PP;
1386					require subs;
1387					subs->import('join');
1388					eval q\|
1389					sub join {
1390					return '' if (@_ < 2);
1391					my $j = shift;
1392					my $str = shift;
1393					for (@_) { $str .= $j . $_; }
1394					return $str;
1395					}
1396					\|;
1397					}
1398					}
1399
1400
1401					sub JSON::PP::incr_parse {
1402					local $Carp::CarpLevel = 1;
1403					( $_[0]->{_incr_parser} \|\|= JSON::PP::IncrParser->new )->incr_parse( @_ );
1404					}
1405
1406
1407					sub JSON::PP::incr_skip {
1408					( $_[0]->{_incr_parser} \|\|= JSON::PP::IncrParser->new )->incr_skip;
1409					}
1410
1411
1412					sub JSON::PP::incr_reset {
1413					( $_[0]->{_incr_parser} \|\|= JSON::PP::IncrParser->new )->incr_reset;
1414					}
1415
1416	1	53µs			eval q{
1417					sub JSON::PP::incr_text : lvalue {
1418					$_[0]->{_incr_parser} \|\|= JSON::PP::IncrParser->new;
1419
1420					if ( $_[0]->{_incr_parser}->{incr_pos} ) {
1421					Carp::croak("incr_text cannot be called when the incremental parser already started parsing");
1422					}
1423					$_[0]->{_incr_parser}->{incr_text};
1424					}
1425					} if ( $] >= 5.006 );
1426
1427	1	252µs	1	56µs	} # Setup for various Perl versions (the code from JSON::PP58) # spent 56µs making 1 call to JSON::PP::BEGIN@1371
1428
1429
1430					###############################
1431					# Utilities
1432					#
1433
1434					# spent 24µs within JSON::PP::BEGIN@1434 which was called: # once (24µs+0s) by JSON::Schema::Modern::Error::BEGIN@18 at line 1488 BEGIN {
1435	1	15µs			eval 'require Scalar::Util'; # spent 4µs executing statements in string eval
1436	1	4µs			unless($@){
1437	1	1µs			*JSON::PP::blessed = \&Scalar::Util::blessed;
1438	1	1µs			*JSON::PP::reftype = \&Scalar::Util::reftype;
1439	1	0s			*JSON::PP::refaddr = \&Scalar::Util::refaddr;
1440					}
1441					else{ # This code is from Scalar::Util.
1442					# warn $@;
1443					eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
1444					*JSON::PP::blessed = sub {
1445					local($@, $SIG{__DIE__}, $SIG{__WARN__});
1446					ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
1447					};
1448					require B;
1449					my %tmap = qw(
1450					B::NULL SCALAR
1451					B::HV HASH
1452					B::AV ARRAY
1453					B::CV CODE
1454					B::IO IO
1455					B::GV GLOB
1456					B::REGEXP REGEXP
1457					);
1458					*JSON::PP::reftype = sub {
1459					my $r = shift;
1460
1461					return undef unless length(ref($r));
1462
1463					my $t = ref(B::svref_2object($r));
1464
1465					return
1466					exists $tmap{$t} ? $tmap{$t}
1467					: length(ref($$r)) ? 'REF'
1468					: 'SCALAR';
1469					};
1470					*JSON::PP::refaddr = sub {
1471					return undef unless length(ref($_[0]));
1472
1473					my $addr;
1474					if(defined(my $pkg = blessed($_[0]))) {
1475					$addr .= bless $_[0], 'Scalar::Util::Fake';
1476					bless $_[0], $pkg;
1477					}
1478					else {
1479					$addr .= $_[0]
1480					}
1481
1482					$addr =~ /0x(\w+)/;
1483					local $^W;
1484					#no warnings 'portable';
1485					hex($1);
1486					}
1487					}
1488	1	117µs	1	24µs	} # spent 24µs making 1 call to JSON::PP::BEGIN@1434
1489
1490
1491					# shamelessly copied and modified from JSON::XS code.
1492
1493	1	1µs			$JSON::PP::true = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
1494	1	0s			$JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
1495
1496					sub is_bool { blessed $_[0] and ( $_[0]->isa("JSON::PP::Boolean") or $_[0]->isa("Types::Serialiser::BooleanBase") or $_[0]->isa("JSON::XS::Boolean") ); }
1497
1498	584	1.92ms			# spent 1.77ms within JSON::PP::true which was called 584 times, avg 3µs/call: # 581 times (1.77ms+0s) by YAML::PP::Schema::_bool_jsonpp_true at line 416 of YAML/PP/Schema.pm, avg 3µs/call # once (2µs+0s) by JSON::Schema::Modern::Utilities::BEGIN@53 at line 53 of JSON/Schema/Modern/Utilities.pm # once (1µs+0s) by OpenAPI::Modern::BEGIN@32 at line 32 of OpenAPI/Modern.pm # once (1µs+0s) by JSON::Schema::Modern::Result::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/JSON/Schema/Modern/Result.pm:38] at line 38 of JSON/Schema/Modern/Result.pm sub true { $JSON::PP::true }
1499	410	1.24ms			# spent 1.01ms within JSON::PP::false which was called 410 times, avg 2µs/call: # 408 times (1.01ms+0s) by YAML::PP::Schema::_bool_jsonpp_false at line 422 of YAML/PP/Schema.pm, avg 2µs/call # once (1µs+0s) by OpenAPI::Modern::BEGIN@32 at line 32 of OpenAPI/Modern.pm # once (0s+0s) by JSON::Schema::Modern::Utilities::BEGIN@53 at line 53 of JSON/Schema/Modern/Utilities.pm sub false { $JSON::PP::false }
1500					sub null { undef; }
1501
1502					###############################
1503
1504					package JSON::PP::IncrParser;
1505
1506	2	31µs	2	18µs	# spent 14µs (10+4) within JSON::PP::IncrParser::BEGIN@1506 which was called: # once (10µs+4µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1506 use strict; # spent 14µs making 1 call to JSON::PP::IncrParser::BEGIN@1506 # spent 4µs making 1 call to strict::import
1507
1508	2	40µs	2	122µs	# spent 65µs (8+57) within JSON::PP::IncrParser::BEGIN@1508 which was called: # once (8µs+57µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1508 use constant INCR_M_WS => 0; # initial whitespace skipping # spent 65µs making 1 call to JSON::PP::IncrParser::BEGIN@1508 # spent 57µs making 1 call to constant::import
1509	2	23µs	2	52µs	# spent 30µs (8+22) within JSON::PP::IncrParser::BEGIN@1509 which was called: # once (8µs+22µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1509 use constant INCR_M_STR => 1; # inside string # spent 30µs making 1 call to JSON::PP::IncrParser::BEGIN@1509 # spent 22µs making 1 call to constant::import
1510	2	73µs	2	83µs	# spent 52µs (21+31) within JSON::PP::IncrParser::BEGIN@1510 which was called: # once (21µs+31µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1510 use constant INCR_M_BS => 2; # inside backslash # spent 52µs making 1 call to JSON::PP::IncrParser::BEGIN@1510 # spent 31µs making 1 call to constant::import
1511	2	38µs	2	98µs	# spent 61µs (24+37) within JSON::PP::IncrParser::BEGIN@1511 which was called: # once (24µs+37µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1511 use constant INCR_M_JSON => 3; # outside anything, count nesting # spent 61µs making 1 call to JSON::PP::IncrParser::BEGIN@1511 # spent 37µs making 1 call to constant::import
1512	2	41µs	2	165µs	# spent 89µs (13+76) within JSON::PP::IncrParser::BEGIN@1512 which was called: # once (13µs+76µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1512 use constant INCR_M_C0 => 4; # spent 89µs making 1 call to JSON::PP::IncrParser::BEGIN@1512 # spent 76µs making 1 call to constant::import
1513	2	26µs	2	77µs	# spent 42µs (7+35) within JSON::PP::IncrParser::BEGIN@1513 which was called: # once (7µs+35µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1513 use constant INCR_M_C1 => 5; # spent 42µs making 1 call to JSON::PP::IncrParser::BEGIN@1513 # spent 35µs making 1 call to constant::import
1514	2	29µs	2	101µs	# spent 56µs (11+45) within JSON::PP::IncrParser::BEGIN@1514 which was called: # once (11µs+45µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1514 use constant INCR_M_TFN => 6; # spent 56µs making 1 call to JSON::PP::IncrParser::BEGIN@1514 # spent 45µs making 1 call to constant::import
1515	2	189µs	2	64µs	# spent 35µs (6+29) within JSON::PP::IncrParser::BEGIN@1515 which was called: # once (6µs+29µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1515 use constant INCR_M_NUM => 7; # spent 35µs making 1 call to JSON::PP::IncrParser::BEGIN@1515 # spent 29µs making 1 call to constant::import
1516
1517	1	1µs			$JSON::PP::IncrParser::VERSION = '1.01';
1518
1519					sub new {
1520					my ( $class ) = @_;
1521
1522					bless {
1523					incr_nest => 0,
1524					incr_text => undef,
1525					incr_pos => 0,
1526					incr_mode => 0,
1527					}, $class;
1528					}
1529
1530
1531					sub incr_parse {
1532					my ( $self, $coder, $text ) = @_;
1533
1534					$self->{incr_text} = '' unless ( defined $self->{incr_text} );
1535
1536					if ( defined $text ) {
1537					if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
1538					utf8::upgrade( $self->{incr_text} ) ;
1539					utf8::decode( $self->{incr_text} ) ;
1540					}
1541					$self->{incr_text} .= $text;
1542					}
1543
1544					if ( defined wantarray ) {
1545					my $max_size = $coder->get_max_size;
1546					my $p = $self->{incr_pos};
1547					my @ret;
1548					{
1549					do {
1550					unless ( $self->{incr_nest} <= 0 and $self->{incr_mode} == INCR_M_JSON ) {
1551					$self->_incr_parse( $coder );
1552
1553					if ( $max_size and $self->{incr_pos} > $max_size ) {
1554					Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size");
1555					}
1556					unless ( $self->{incr_nest} <= 0 and $self->{incr_mode} == INCR_M_JSON ) {
1557					# as an optimisation, do not accumulate white space in the incr buffer
1558					if ( $self->{incr_mode} == INCR_M_WS and $self->{incr_pos} ) {
1559					$self->{incr_pos} = 0;
1560					$self->{incr_text} = '';
1561					}
1562					last;
1563					}
1564					}
1565
1566					unless ( $coder->get_utf8 ) {
1567					utf8::upgrade( $self->{incr_text} );
1568					utf8::decode( $self->{incr_text} );
1569					}
1570
1571					my ($obj, $offset) = $coder->PP_decode_json( $self->{incr_text}, 0x00000001 );
1572					push @ret, $obj;
1573	2	673µs	2	14µs	# spent 11µs (8+3) within JSON::PP::IncrParser::BEGIN@1573 which was called: # once (8µs+3µs) by JSON::Schema::Modern::Error::BEGIN@18 at line 1573 use bytes; # spent 11µs making 1 call to JSON::PP::IncrParser::BEGIN@1573 # spent 3µs making 1 call to bytes::import
1574					$self->{incr_text} = substr( $self->{incr_text}, $offset \|\| 0 );
1575					$self->{incr_pos} = 0;
1576					$self->{incr_nest} = 0;
1577					$self->{incr_mode} = 0;
1578					last unless wantarray;
1579					} while ( wantarray );
1580					}
1581
1582					if ( wantarray ) {
1583					return @ret;
1584					}
1585					else { # in scalar context
1586					return defined $ret[0] ? $ret[0] : undef;
1587					}
1588					}
1589					}
1590
1591
1592					sub _incr_parse {
1593					my ($self, $coder) = @_;
1594					my $text = $self->{incr_text};
1595					my $len = length $text;
1596					my $p = $self->{incr_pos};
1597
1598					INCR_PARSE:
1599					while ( $len > $p ) {
1600					my $s = substr( $text, $p, 1 );
1601					last INCR_PARSE unless defined $s;
1602					my $mode = $self->{incr_mode};
1603
1604					if ( $mode == INCR_M_WS ) {
1605					while ( $len > $p ) {
1606					$s = substr( $text, $p, 1 );
1607					last INCR_PARSE unless defined $s;
1608					if ( ord($s) > 0x20 ) {
1609					if ( $s eq '#' ) {
1610					$self->{incr_mode} = INCR_M_C0;
1611					redo INCR_PARSE;
1612					} else {
1613					$self->{incr_mode} = INCR_M_JSON;
1614					redo INCR_PARSE;
1615					}
1616					}
1617					$p++;
1618					}
1619					} elsif ( $mode == INCR_M_BS ) {
1620					$p++;
1621					$self->{incr_mode} = INCR_M_STR;
1622					redo INCR_PARSE;
1623					} elsif ( $mode == INCR_M_C0 or $mode == INCR_M_C1 ) {
1624					while ( $len > $p ) {
1625					$s = substr( $text, $p, 1 );
1626					last INCR_PARSE unless defined $s;
1627					if ( $s eq "\n" ) {
1628					$self->{incr_mode} = $self->{incr_mode} == INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;
1629					last;
1630					}
1631					$p++;
1632					}
1633					next;
1634					} elsif ( $mode == INCR_M_TFN ) {
1635					while ( $len > $p ) {
1636					$s = substr( $text, $p++, 1 );
1637					next if defined $s and $s =~ /[rueals]/;
1638					last;
1639					}
1640					$p--;
1641					$self->{incr_mode} = INCR_M_JSON;
1642
1643					last INCR_PARSE unless $self->{incr_nest};
1644					redo INCR_PARSE;
1645					} elsif ( $mode == INCR_M_NUM ) {
1646					while ( $len > $p ) {
1647					$s = substr( $text, $p++, 1 );
1648					next if defined $s and $s =~ /[0-9eE.+\-]/;
1649					last;
1650					}
1651					$p--;
1652					$self->{incr_mode} = INCR_M_JSON;
1653
1654					last INCR_PARSE unless $self->{incr_nest};
1655					redo INCR_PARSE;
1656					} elsif ( $mode == INCR_M_STR ) {
1657					while ( $len > $p ) {
1658					$s = substr( $text, $p, 1 );
1659					last INCR_PARSE unless defined $s;
1660					if ( $s eq '"' ) {
1661					$p++;
1662					$self->{incr_mode} = INCR_M_JSON;
1663
1664					last INCR_PARSE unless $self->{incr_nest};
1665					redo INCR_PARSE;
1666					}
1667					elsif ( $s eq '\\' ) {
1668					$p++;
1669					if ( !defined substr($text, $p, 1) ) {
1670					$self->{incr_mode} = INCR_M_BS;
1671					last INCR_PARSE;
1672					}
1673					}
1674					$p++;
1675					}
1676					} elsif ( $mode == INCR_M_JSON ) {
1677					while ( $len > $p ) {
1678					$s = substr( $text, $p++, 1 );
1679					if ( $s eq "\x00" ) {
1680					$p--;
1681					last INCR_PARSE;
1682					} elsif ( $s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20" ) {
1683					if ( !$self->{incr_nest} ) {
1684					$p--; # do not eat the whitespace, let the next round do it
1685					last INCR_PARSE;
1686					}
1687					next;
1688					} elsif ( $s eq 't' or $s eq 'f' or $s eq 'n' ) {
1689					$self->{incr_mode} = INCR_M_TFN;
1690					redo INCR_PARSE;
1691					} elsif ( $s =~ /^[0-9\-]$/ ) {
1692					$self->{incr_mode} = INCR_M_NUM;
1693					redo INCR_PARSE;
1694					} elsif ( $s eq '"' ) {
1695					$self->{incr_mode} = INCR_M_STR;
1696					redo INCR_PARSE;
1697					} elsif ( $s eq '[' or $s eq '{' ) {
1698					if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
1699					Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
1700					}
1701					next;
1702					} elsif ( $s eq ']' or $s eq '}' ) {
1703					if ( --$self->{incr_nest} <= 0 ) {
1704					last INCR_PARSE;
1705					}
1706					} elsif ( $s eq '#' ) {
1707					$self->{incr_mode} = INCR_M_C1;
1708					redo INCR_PARSE;
1709					}
1710					}
1711					}
1712					}
1713
1714					$self->{incr_pos} = $p;
1715					$self->{incr_parsing} = $p ? 1 : 0; # for backward compatibility
1716					}
1717
1718
1719					sub incr_text {
1720					if ( $_[0]->{incr_pos} ) {
1721					Carp::croak("incr_text cannot be called when the incremental parser already started parsing");
1722					}
1723					$_[0]->{incr_text};
1724					}
1725
1726
1727					sub incr_skip {
1728					my $self = shift;
1729					$self->{incr_text} = substr( $self->{incr_text}, $self->{incr_pos} );
1730					$self->{incr_pos} = 0;
1731					$self->{incr_mode} = 0;
1732					$self->{incr_nest} = 0;
1733					}
1734
1735
1736					sub incr_reset {
1737					my $self = shift;
1738					$self->{incr_text} = undef;
1739					$self->{incr_pos} = 0;
1740					$self->{incr_mode} = 0;
1741					$self->{incr_nest} = 0;
1742					}
1743
1744					###############################
1745
1746
1747	1	9µs			1;
1748					__END__

					# spent 12µs within JSON::PP::CORE:match which was called 17 times, avg 706ns/call: # 17 times (12µs+0s) by JSON::PP::BEGIN@646 at line 651, avg 706ns/call sub JSON::PP::CORE:match; # opcode
					# spent 0s within JSON::PP::__ANON__ which was called: # once (0s+0s) by JSON::PP::BEGIN@12 at line 12 sub JSON::PP::__ANON__; # xsub