| Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/JSON.pm |
| Statements | Executed 72 statements in 1.18ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 38µs | 65µs | JSON::__load_xs |
| 1 | 1 | 1 | 27µs | 7.36ms | JSON::__load_pp |
| 1 | 1 | 1 | 23µs | 26µs | JSON::Backend::PP::init |
| 1 | 1 | 1 | 9µs | 10µs | JSON::BEGIN@4 |
| 1 | 1 | 1 | 7µs | 11µs | JSON::Backend::PP::BEGIN@342 |
| 1 | 1 | 1 | 6µs | 6µs | JSON::BEGIN@7 |
| 1 | 1 | 1 | 5µs | 7.39ms | JSON::_load_pp |
| 1 | 1 | 1 | 4µs | 68µs | JSON::_load_xs |
| 1 | 1 | 1 | 3µs | 11µs | JSON::BEGIN@6 |
| 1 | 1 | 1 | 2µs | 2µs | JSON::BEGIN@11 |
| 1 | 1 | 1 | 1µs | 1µs | JSON::BEGIN@5 |
| 0 | 0 | 0 | 0s | 0s | JSON::Backend::PP::__ANON__[:366] |
| 0 | 0 | 0 | 0s | 0s | JSON::Backend::PP::is_pp |
| 0 | 0 | 0 | 0s | 0s | JSON::Backend::PP::is_xs |
| 0 | 0 | 0 | 0s | 0s | JSON::backend |
| 0 | 0 | 0 | 0s | 0s | JSON::boolean |
| 0 | 0 | 0 | 0s | 0s | JSON::false |
| 0 | 0 | 0 | 0s | 0s | JSON::from_json |
| 0 | 0 | 0 | 0s | 0s | JSON::import |
| 0 | 0 | 0 | 0s | 0s | JSON::is_pp |
| 0 | 0 | 0 | 0s | 0s | JSON::is_xs |
| 0 | 0 | 0 | 0s | 0s | JSON::jsonToObj |
| 0 | 0 | 0 | 0s | 0s | JSON::null |
| 0 | 0 | 0 | 0s | 0s | JSON::objToJson |
| 0 | 0 | 0 | 0s | 0s | JSON::property |
| 0 | 0 | 0 | 0s | 0s | JSON::pureperl_only_methods |
| 0 | 0 | 0 | 0s | 0s | JSON::require_xs_version |
| 0 | 0 | 0 | 0s | 0s | JSON::to_json |
| 0 | 0 | 0 | 0s | 0s | JSON::true |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package JSON; | ||||
| 2 | |||||
| 3 | |||||
| 4 | 2 | 17µs | 2 | 11µs | # spent 10µs (9+1) within JSON::BEGIN@4 which was called:
# once (9µs+1µs) by CryptX::BEGIN@13 at line 4 # spent 10µs making 1 call to JSON::BEGIN@4
# spent 1µs making 1 call to strict::import |
| 5 | 2 | 9µs | 1 | 1µs | # spent 1µs within JSON::BEGIN@5 which was called:
# once (1µs+0s) by CryptX::BEGIN@13 at line 5 # spent 1µs making 1 call to JSON::BEGIN@5 |
| 6 | 2 | 17µs | 2 | 20µs | # spent 11µs (3+8) within JSON::BEGIN@6 which was called:
# once (3µs+8µs) by CryptX::BEGIN@13 at line 6 # spent 11µs making 1 call to JSON::BEGIN@6
# spent 8µs making 1 call to Exporter::import |
| 7 | 1 | 41µs | 1 | 6µs | # spent 6µs within JSON::BEGIN@7 which was called:
# once (6µs+0s) by CryptX::BEGIN@13 at line 7 # spent 6µs making 1 call to JSON::BEGIN@7 |
| 8 | |||||
| 9 | 1 | 1µs | @JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json); | ||
| 10 | |||||
| 11 | # spent 2µs within JSON::BEGIN@11 which was called:
# once (2µs+0s) by CryptX::BEGIN@13 at line 15 | ||||
| 12 | 1 | 200ns | $JSON::VERSION = '4.10'; | ||
| 13 | 1 | 200ns | $JSON::DEBUG = 0 unless (defined $JSON::DEBUG); | ||
| 14 | 1 | 2µs | $JSON::DEBUG = $ENV{ PERL_JSON_DEBUG } if exists $ENV{ PERL_JSON_DEBUG }; | ||
| 15 | 1 | 800µs | 1 | 2µs | } # spent 2µs making 1 call to JSON::BEGIN@11 |
| 16 | |||||
| 17 | 1 | 900ns | my %RequiredVersion = ( | ||
| 18 | 'JSON::PP' => '2.27203', | ||||
| 19 | 'JSON::XS' => '2.34', | ||||
| 20 | ); | ||||
| 21 | |||||
| 22 | # XS and PP common methods | ||||
| 23 | |||||
| 24 | 1 | 1µs | my @PublicMethods = qw/ | ||
| 25 | ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref | ||||
| 26 | allow_blessed convert_blessed filter_json_object filter_json_single_key_object | ||||
| 27 | shrink max_depth max_size encode decode decode_prefix allow_unknown | ||||
| 28 | /; | ||||
| 29 | |||||
| 30 | 1 | 1µs | my @Properties = qw/ | ||
| 31 | ascii latin1 utf8 indent space_before space_after relaxed canonical allow_nonref | ||||
| 32 | allow_blessed convert_blessed shrink max_depth max_size allow_unknown | ||||
| 33 | /; | ||||
| 34 | |||||
| 35 | 1 | 200ns | my @XSOnlyMethods = qw//; # Currently nothing | ||
| 36 | |||||
| 37 | 1 | 300ns | my @PublicMethodsSince4_0 = qw/allow_tags/; | ||
| 38 | 1 | 200ns | my @PropertiesSince4_0 = qw/allow_tags/; | ||
| 39 | |||||
| 40 | 1 | 600ns | my @PPOnlyMethods = qw/ | ||
| 41 | indent_length sort_by | ||||
| 42 | allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed | ||||
| 43 | /; # JSON::PP specific | ||||
| 44 | |||||
| 45 | |||||
| 46 | # used in _load_xs and _load_pp ($INSTALL_ONLY is not used currently) | ||||
| 47 | 1 | 100ns | my $_INSTALL_DONT_DIE = 1; # When _load_xs fails to load XS, don't die. | ||
| 48 | 1 | 100ns | my $_ALLOW_UNSUPPORTED = 0; | ||
| 49 | 1 | 100ns | my $_UNIV_CONV_BLESSED = 0; | ||
| 50 | |||||
| 51 | |||||
| 52 | # Check the environment variable to decide worker module. | ||||
| 53 | |||||
| 54 | 1 | 300ns | unless ($JSON::Backend) { | ||
| 55 | 1 | 100ns | $JSON::DEBUG and Carp::carp("Check used worker module..."); | ||
| 56 | |||||
| 57 | 1 | 400ns | my $backend = exists $ENV{PERL_JSON_BACKEND} ? $ENV{PERL_JSON_BACKEND} : 1; | ||
| 58 | |||||
| 59 | 1 | 700ns | if ($backend eq '1') { | ||
| 60 | $backend = 'JSON::XS,JSON::PP'; | ||||
| 61 | } | ||||
| 62 | elsif ($backend eq '0') { | ||||
| 63 | $backend = 'JSON::PP'; | ||||
| 64 | } | ||||
| 65 | elsif ($backend eq '2') { | ||||
| 66 | $backend = 'JSON::XS'; | ||||
| 67 | } | ||||
| 68 | 1 | 5µs | 1 | 1µs | $backend =~ s/\s+//g; # spent 1µs making 1 call to CORE::subst |
| 69 | |||||
| 70 | 1 | 1µs | my @backend_modules = split /,/, $backend; | ||
| 71 | 1 | 900ns | while(my $module = shift @backend_modules) { | ||
| 72 | 2 | 7µs | 5 | 7.46ms | if ($module =~ /JSON::XS/) { # spent 7.39ms making 1 call to JSON::_load_pp
# spent 68µs making 1 call to JSON::_load_xs
# spent 2µs making 3 calls to CORE::match, avg 800ns/call |
| 73 | _load_xs($module, @backend_modules ? $_INSTALL_DONT_DIE : 0); | ||||
| 74 | } | ||||
| 75 | elsif ($module =~ /JSON::PP/) { | ||||
| 76 | _load_pp($module); | ||||
| 77 | } | ||||
| 78 | elsif ($module =~ /JSON::backportPP/) { | ||||
| 79 | _load_pp($module); | ||||
| 80 | } | ||||
| 81 | else { | ||||
| 82 | Carp::croak "The value of environmental variable 'PERL_JSON_BACKEND' is invalid."; | ||||
| 83 | } | ||||
| 84 | 2 | 1µs | last if $JSON::Backend; | ||
| 85 | } | ||||
| 86 | } | ||||
| 87 | |||||
| 88 | |||||
| 89 | sub import { | ||||
| 90 | my $pkg = shift; | ||||
| 91 | my @what_to_export; | ||||
| 92 | my $no_export; | ||||
| 93 | |||||
| 94 | for my $tag (@_) { | ||||
| 95 | if ($tag eq '-support_by_pp') { | ||||
| 96 | if (!$_ALLOW_UNSUPPORTED++) { | ||||
| 97 | JSON::Backend::XS | ||||
| 98 | ->support_by_pp(@PPOnlyMethods) if ($JSON::Backend->is_xs); | ||||
| 99 | } | ||||
| 100 | next; | ||||
| 101 | } | ||||
| 102 | elsif ($tag eq '-no_export') { | ||||
| 103 | $no_export++, next; | ||||
| 104 | } | ||||
| 105 | elsif ( $tag eq '-convert_blessed_universally' ) { | ||||
| 106 | my $org_encode = $JSON::Backend->can('encode'); | ||||
| 107 | eval q| | ||||
| 108 | require B; | ||||
| 109 | local $^W; | ||||
| 110 | no strict 'refs'; | ||||
| 111 | *{"${JSON::Backend}\::encode"} = sub { | ||||
| 112 | # only works with Perl 5.18+ | ||||
| 113 | local *UNIVERSAL::TO_JSON = sub { | ||||
| 114 | my $b_obj = B::svref_2object( $_[0] ); | ||||
| 115 | return $b_obj->isa('B::HV') ? { %{ $_[0] } } | ||||
| 116 | : $b_obj->isa('B::AV') ? [ @{ $_[0] } ] | ||||
| 117 | : undef | ||||
| 118 | ; | ||||
| 119 | }; | ||||
| 120 | $org_encode->(@_); | ||||
| 121 | }; | ||||
| 122 | | if ( !$_UNIV_CONV_BLESSED++ ); | ||||
| 123 | next; | ||||
| 124 | } | ||||
| 125 | push @what_to_export, $tag; | ||||
| 126 | } | ||||
| 127 | |||||
| 128 | return if ($no_export); | ||||
| 129 | |||||
| 130 | __PACKAGE__->export_to_level(1, $pkg, @what_to_export); | ||||
| 131 | } | ||||
| 132 | |||||
| 133 | |||||
| 134 | # OBSOLETED | ||||
| 135 | |||||
| 136 | sub jsonToObj { | ||||
| 137 | my $alternative = 'from_json'; | ||||
| 138 | if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) { | ||||
| 139 | shift @_; $alternative = 'decode'; | ||||
| 140 | } | ||||
| 141 | Carp::carp "'jsonToObj' will be obsoleted. Please use '$alternative' instead."; | ||||
| 142 | return JSON::from_json(@_); | ||||
| 143 | }; | ||||
| 144 | |||||
| 145 | sub objToJson { | ||||
| 146 | my $alternative = 'to_json'; | ||||
| 147 | if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) { | ||||
| 148 | shift @_; $alternative = 'encode'; | ||||
| 149 | } | ||||
| 150 | Carp::carp "'objToJson' will be obsoleted. Please use '$alternative' instead."; | ||||
| 151 | JSON::to_json(@_); | ||||
| 152 | }; | ||||
| 153 | |||||
| 154 | |||||
| 155 | # INTERFACES | ||||
| 156 | |||||
| 157 | sub to_json ($@) { | ||||
| 158 | if ( | ||||
| 159 | ref($_[0]) eq 'JSON' | ||||
| 160 | or (@_ > 2 and $_[0] eq 'JSON') | ||||
| 161 | ) { | ||||
| 162 | Carp::croak "to_json should not be called as a method."; | ||||
| 163 | } | ||||
| 164 | my $json = JSON->new; | ||||
| 165 | |||||
| 166 | if (@_ == 2 and ref $_[1] eq 'HASH') { | ||||
| 167 | my $opt = $_[1]; | ||||
| 168 | for my $method (keys %$opt) { | ||||
| 169 | $json->$method( $opt->{$method} ); | ||||
| 170 | } | ||||
| 171 | } | ||||
| 172 | |||||
| 173 | $json->encode($_[0]); | ||||
| 174 | } | ||||
| 175 | |||||
| 176 | |||||
| 177 | sub from_json ($@) { | ||||
| 178 | if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) { | ||||
| 179 | Carp::croak "from_json should not be called as a method."; | ||||
| 180 | } | ||||
| 181 | my $json = JSON->new; | ||||
| 182 | |||||
| 183 | if (@_ == 2 and ref $_[1] eq 'HASH') { | ||||
| 184 | my $opt = $_[1]; | ||||
| 185 | for my $method (keys %$opt) { | ||||
| 186 | $json->$method( $opt->{$method} ); | ||||
| 187 | } | ||||
| 188 | } | ||||
| 189 | |||||
| 190 | return $json->decode( $_[0] ); | ||||
| 191 | } | ||||
| 192 | |||||
| - - | |||||
| 195 | sub true { $JSON::true } | ||||
| 196 | |||||
| 197 | sub false { $JSON::false } | ||||
| 198 | |||||
| 199 | sub boolean { | ||||
| 200 | # might be called as method or as function, so pop() to get the last arg instead of shift() to get the first | ||||
| 201 | pop() ? $JSON::true : $JSON::false | ||||
| 202 | } | ||||
| 203 | |||||
| 204 | sub null { undef; } | ||||
| 205 | |||||
| 206 | |||||
| 207 | sub require_xs_version { $RequiredVersion{'JSON::XS'}; } | ||||
| 208 | |||||
| 209 | sub backend { | ||||
| 210 | my $proto = shift; | ||||
| 211 | $JSON::Backend; | ||||
| 212 | } | ||||
| 213 | |||||
| 214 | #*module = *backend; | ||||
| 215 | |||||
| 216 | |||||
| 217 | sub is_xs { | ||||
| 218 | return $_[0]->backend->is_xs; | ||||
| 219 | } | ||||
| 220 | |||||
| 221 | |||||
| 222 | sub is_pp { | ||||
| 223 | return $_[0]->backend->is_pp; | ||||
| 224 | } | ||||
| 225 | |||||
| 226 | |||||
| 227 | sub pureperl_only_methods { @PPOnlyMethods; } | ||||
| 228 | |||||
| 229 | |||||
| 230 | sub property { | ||||
| 231 | my ($self, $name, $value) = @_; | ||||
| 232 | |||||
| 233 | if (@_ == 1) { | ||||
| 234 | my %props; | ||||
| 235 | for $name (@Properties) { | ||||
| 236 | my $method = 'get_' . $name; | ||||
| 237 | if ($name eq 'max_size') { | ||||
| 238 | my $value = $self->$method(); | ||||
| 239 | $props{$name} = $value == 1 ? 0 : $value; | ||||
| 240 | next; | ||||
| 241 | } | ||||
| 242 | $props{$name} = $self->$method(); | ||||
| 243 | } | ||||
| 244 | return \%props; | ||||
| 245 | } | ||||
| 246 | elsif (@_ > 3) { | ||||
| 247 | Carp::croak('property() can take only the option within 2 arguments.'); | ||||
| 248 | } | ||||
| 249 | elsif (@_ == 2) { | ||||
| 250 | if ( my $method = $self->can('get_' . $name) ) { | ||||
| 251 | if ($name eq 'max_size') { | ||||
| 252 | my $value = $self->$method(); | ||||
| 253 | return $value == 1 ? 0 : $value; | ||||
| 254 | } | ||||
| 255 | $self->$method(); | ||||
| 256 | } | ||||
| 257 | } | ||||
| 258 | else { | ||||
| 259 | $self->$name($value); | ||||
| 260 | } | ||||
| 261 | |||||
| 262 | } | ||||
| 263 | |||||
| - - | |||||
| 266 | # INTERNAL | ||||
| 267 | |||||
| 268 | # spent 65µs (38+27) within JSON::__load_xs which was called:
# once (38µs+27µs) by JSON::_load_xs at line 291 | ||||
| 269 | 1 | 200ns | my ($module, $opt) = @_; | ||
| 270 | |||||
| 271 | 1 | 100ns | $JSON::DEBUG and Carp::carp "Load $module."; | ||
| 272 | 1 | 400ns | my $required_version = $RequiredVersion{$module} || ''; | ||
| 273 | |||||
| 274 | 1 | 26µs | eval qq| # spent 37µs executing statements in string eval # includes 27µs spent executing 1 call to 1 sub defined therein. | ||
| 275 | use $module $required_version (); | ||||
| 276 | |; | ||||
| 277 | |||||
| 278 | 1 | 200ns | if ($@) { | ||
| 279 | 1 | 500ns | if (defined $opt and $opt & $_INSTALL_DONT_DIE) { | ||
| 280 | 1 | 100ns | $JSON::DEBUG and Carp::carp "Can't load $module...($@)"; | ||
| 281 | 1 | 2µs | return 0; | ||
| 282 | } | ||||
| 283 | Carp::croak $@; | ||||
| 284 | } | ||||
| 285 | $JSON::BackendModuleXS = $module; | ||||
| 286 | return 1; | ||||
| 287 | } | ||||
| 288 | |||||
| 289 | # spent 68µs (4+65) within JSON::_load_xs which was called:
# once (4µs+65µs) by CryptX::BEGIN@13 at line 72 | ||||
| 290 | 1 | 400ns | my ($module, $opt) = @_; | ||
| 291 | 1 | 2µs | 1 | 65µs | __load_xs($module, $opt) or return; # spent 65µs making 1 call to JSON::__load_xs |
| 292 | |||||
| 293 | my $data = join("", <DATA>); # this code is from Jcode 2.xx. | ||||
| 294 | close(DATA); | ||||
| 295 | eval $data; | ||||
| 296 | JSON::Backend::XS->init($module); | ||||
| 297 | |||||
| 298 | return 1; | ||||
| 299 | }; | ||||
| 300 | |||||
| 301 | |||||
| 302 | # spent 7.36ms (27µs+7.33) within JSON::__load_pp which was called:
# once (27µs+7.33ms) by JSON::_load_pp at line 325 | ||||
| 303 | 1 | 300ns | my ($module, $opt) = @_; | ||
| 304 | |||||
| 305 | 1 | 100ns | $JSON::DEBUG and Carp::carp "Load $module."; | ||
| 306 | 1 | 500ns | my $required_version = $RequiredVersion{$module} || ''; | ||
| 307 | |||||
| 308 | 1 | 19µs | eval qq| use $module $required_version () |; # spent 84µs executing statements in string eval # includes 5.24ms spent executing 1 call to 1 sub defined therein. | ||
| 309 | |||||
| 310 | 1 | 200ns | if ($@) { | ||
| 311 | if ( $module eq 'JSON::PP' ) { | ||||
| 312 | $JSON::DEBUG and Carp::carp "Can't load $module ($@), so try to load JSON::backportPP"; | ||||
| 313 | $module = 'JSON::backportPP'; | ||||
| 314 | local $^W; # if PP installed but invalid version, backportPP redefines methods. | ||||
| 315 | eval qq| require $module |; | ||||
| 316 | } | ||||
| 317 | Carp::croak $@ if $@; | ||||
| 318 | } | ||||
| 319 | 1 | 300ns | $JSON::BackendModulePP = $module; | ||
| 320 | 1 | 2µs | return 1; | ||
| 321 | } | ||||
| 322 | |||||
| 323 | # spent 7.39ms (5µs+7.39) within JSON::_load_pp which was called:
# once (5µs+7.39ms) by CryptX::BEGIN@13 at line 72 | ||||
| 324 | 1 | 400ns | my ($module, $opt) = @_; | ||
| 325 | 1 | 600ns | 1 | 7.36ms | __load_pp($module, $opt); # spent 7.36ms making 1 call to JSON::__load_pp |
| 326 | |||||
| 327 | 1 | 2µs | 1 | 26µs | JSON::Backend::PP->init($module); # spent 26µs making 1 call to JSON::Backend::PP::init |
| 328 | }; | ||||
| 329 | |||||
| 330 | # | ||||
| 331 | # Helper classes for Backend Module (PP) | ||||
| 332 | # | ||||
| 333 | |||||
| 334 | package JSON::Backend::PP; | ||||
| 335 | |||||
| 336 | # spent 26µs (23+2) within JSON::Backend::PP::init which was called:
# once (23µs+2µs) by JSON::_load_pp at line 327 | ||||
| 337 | 1 | 500ns | my ($class, $module) = @_; | ||
| 338 | |||||
| 339 | # name may vary, but the module should (always) be a JSON::PP | ||||
| 340 | |||||
| 341 | 1 | 1µs | local $^W; | ||
| 342 | 2 | 171µs | 2 | 15µs | # spent 11µs (7+4) within JSON::Backend::PP::BEGIN@342 which was called:
# once (7µs+4µs) by CryptX::BEGIN@13 at line 342 # spent 11µs making 1 call to JSON::Backend::PP::BEGIN@342
# spent 4µs making 1 call to strict::unimport |
| 343 | 1 | 2µs | *{"JSON::decode_json"} = \&{"JSON::PP::decode_json"}; | ||
| 344 | 1 | 800ns | *{"JSON::encode_json"} = \&{"JSON::PP::encode_json"}; | ||
| 345 | 1 | 700ns | *{"JSON::is_bool"} = \&{"JSON::PP::is_bool"}; | ||
| 346 | |||||
| 347 | 1 | 500ns | $JSON::true = ${"JSON::PP::true"}; | ||
| 348 | 1 | 300ns | $JSON::false = ${"JSON::PP::false"}; | ||
| 349 | |||||
| 350 | 1 | 3µs | push @JSON::Backend::PP::ISA, 'JSON::PP'; | ||
| 351 | 1 | 3µs | push @JSON::ISA, $class; | ||
| 352 | 1 | 300ns | $JSON::Backend = $class; | ||
| 353 | 1 | 200ns | $JSON::BackendModule = $module; | ||
| 354 | 1 | 6µs | 1 | 2µs | my $version = ${"$class\::VERSION"} = $module->VERSION; # spent 2µs making 1 call to UNIVERSAL::VERSION |
| 355 | 1 | 3µs | 1 | 700ns | $version =~ s/_//; # spent 700ns making 1 call to CORE::subst |
| 356 | 1 | 2µs | if ($version < 3.99) { | ||
| 357 | push @XSOnlyMethods, qw/allow_tags get_allow_tags/; | ||||
| 358 | } else { | ||||
| 359 | 1 | 700ns | push @Properties, 'allow_tags'; | ||
| 360 | } | ||||
| 361 | |||||
| 362 | 1 | 300ns | for my $method (@XSOnlyMethods) { | ||
| 363 | *{"JSON::$method"} = sub { | ||||
| 364 | Carp::carp("$method is not supported by $module $version."); | ||||
| 365 | $_[0]; | ||||
| 366 | }; | ||||
| 367 | } | ||||
| 368 | |||||
| 369 | 1 | 2µs | return 1; | ||
| 370 | } | ||||
| 371 | |||||
| 372 | sub is_xs { 0 }; | ||||
| 373 | sub is_pp { 1 }; | ||||
| 374 | |||||
| 375 | # | ||||
| 376 | # To save memory, the below lines are read only when XS backend is used. | ||||
| 377 | # | ||||
| 378 | |||||
| 379 | package JSON; | ||||
| 380 | |||||
| 381 | 1 | 15µs | 1; | ||
| 382 | __DATA__ |