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