Imported Upstream version 0.58
This commit is contained in:
Mario Fetka
299
lib/JSON/Tiny.pm
Normal file
299
lib/JSON/Tiny.pm
Normal file
@@ -0,0 +1,299 @@
|
||||
package JSON::Tiny;
|
||||
|
||||
# Minimalistic JSON. Adapted from Mojo::JSON. (c)2012-2015 David Oswald
|
||||
# License: Artistic 2.0 license.
|
||||
# http://www.perlfoundation.org/artistic_license_2_0
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp 'croak';
|
||||
use Exporter 'import';
|
||||
use Scalar::Util 'blessed';
|
||||
use Encode ();
|
||||
use B;
|
||||
|
||||
our $VERSION = '0.58';
|
||||
our @EXPORT_OK = qw(decode_json encode_json false from_json j to_json true);
|
||||
|
||||
# Literal names
|
||||
# Users may override Booleans with literal 0 or 1 if desired.
|
||||
our($FALSE, $TRUE) = map { bless \(my $dummy = $_), 'JSON::Tiny::_Bool' } 0, 1;
|
||||
|
||||
# Escaped special character map with u2028 and u2029
|
||||
my %ESCAPE = (
|
||||
'"' => '"',
|
||||
'\\' => '\\',
|
||||
'/' => '/',
|
||||
'b' => "\x08",
|
||||
'f' => "\x0c",
|
||||
'n' => "\x0a",
|
||||
'r' => "\x0d",
|
||||
't' => "\x09",
|
||||
'u2028' => "\x{2028}",
|
||||
'u2029' => "\x{2029}"
|
||||
);
|
||||
my %REVERSE = map { $ESCAPE{$_} => "\\$_" } keys %ESCAPE;
|
||||
|
||||
for(0x00 .. 0x1f) {
|
||||
my $packed = pack 'C', $_;
|
||||
$REVERSE{$packed} = sprintf '\u%.4X', $_ unless defined $REVERSE{$packed};
|
||||
}
|
||||
|
||||
sub decode_json {
|
||||
my $err = _decode(\my $value, shift);
|
||||
return defined $err ? croak $err : $value;
|
||||
}
|
||||
|
||||
sub encode_json { Encode::encode 'UTF-8', _encode_value(shift) }
|
||||
|
||||
sub false () {$FALSE} ## no critic (prototypes)
|
||||
|
||||
sub from_json {
|
||||
my $err = _decode(\my $value, shift, 1);
|
||||
return defined $err ? croak $err : $value;
|
||||
}
|
||||
|
||||
sub j {
|
||||
return encode_json $_[0] if ref $_[0] eq 'ARRAY' || ref $_[0] eq 'HASH';
|
||||
return decode_json $_[0];
|
||||
}
|
||||
|
||||
sub to_json { _encode_value(shift) }
|
||||
|
||||
sub true () {$TRUE} ## no critic (prototypes)
|
||||
|
||||
sub _decode {
|
||||
my $valueref = shift;
|
||||
|
||||
eval {
|
||||
|
||||
# Missing input
|
||||
die "Missing or empty input\n" unless length( local $_ = shift );
|
||||
|
||||
# UTF-8
|
||||
$_ = eval { Encode::decode('UTF-8', $_, 1) } unless shift;
|
||||
die "Input is not UTF-8 encoded\n" unless defined $_;
|
||||
|
||||
# Value
|
||||
$$valueref = _decode_value();
|
||||
|
||||
# Leftover data
|
||||
return m/\G[\x20\x09\x0a\x0d]*\z/gc || _throw('Unexpected data');
|
||||
} ? return undef : chomp $@;
|
||||
|
||||
return $@;
|
||||
}
|
||||
|
||||
sub _decode_array {
|
||||
my @array;
|
||||
until (m/\G[\x20\x09\x0a\x0d]*\]/gc) {
|
||||
|
||||
# Value
|
||||
push @array, _decode_value();
|
||||
|
||||
# Separator
|
||||
redo if m/\G[\x20\x09\x0a\x0d]*,/gc;
|
||||
|
||||
# End
|
||||
last if m/\G[\x20\x09\x0a\x0d]*\]/gc;
|
||||
|
||||
# Invalid character
|
||||
_throw('Expected comma or right square bracket while parsing array');
|
||||
}
|
||||
|
||||
return \@array;
|
||||
}
|
||||
|
||||
sub _decode_object {
|
||||
my %hash;
|
||||
until (m/\G[\x20\x09\x0a\x0d]*\}/gc) {
|
||||
|
||||
# Quote
|
||||
m/\G[\x20\x09\x0a\x0d]*"/gc
|
||||
or _throw('Expected string while parsing object');
|
||||
|
||||
# Key
|
||||
my $key = _decode_string();
|
||||
|
||||
# Colon
|
||||
m/\G[\x20\x09\x0a\x0d]*:/gc
|
||||
or _throw('Expected colon while parsing object');
|
||||
|
||||
# Value
|
||||
$hash{$key} = _decode_value();
|
||||
|
||||
# Separator
|
||||
redo if m/\G[\x20\x09\x0a\x0d]*,/gc;
|
||||
|
||||
# End
|
||||
last if m/\G[\x20\x09\x0a\x0d]*\}/gc;
|
||||
|
||||
# Invalid character
|
||||
_throw('Expected comma or right curly bracket while parsing object');
|
||||
}
|
||||
|
||||
return \%hash;
|
||||
}
|
||||
|
||||
sub _decode_string {
|
||||
my $pos = pos;
|
||||
|
||||
# Extract string with escaped characters
|
||||
m!\G((?:(?:[^\x00-\x1f\\"]|\\(?:["\\/bfnrt]|u[0-9a-fA-F]{4})){0,32766})*)!gc; # segfault on 5.8.x in t/20-mojo-json.t
|
||||
my $str = $1;
|
||||
|
||||
# Invalid character
|
||||
unless (m/\G"/gc) {
|
||||
_throw('Unexpected character or invalid escape while parsing string')
|
||||
if m/\G[\x00-\x1f\\]/;
|
||||
_throw('Unterminated string');
|
||||
}
|
||||
|
||||
# Unescape popular characters
|
||||
if (index($str, '\\u') < 0) {
|
||||
$str =~ s!\\(["\\/bfnrt])!$ESCAPE{$1}!gs;
|
||||
return $str;
|
||||
}
|
||||
|
||||
# Unescape everything else
|
||||
my $buffer = '';
|
||||
while ($str =~ m/\G([^\\]*)\\(?:([^u])|u(.{4}))/gc) {
|
||||
$buffer .= $1;
|
||||
|
||||
# Popular character
|
||||
if ($2) { $buffer .= $ESCAPE{$2} }
|
||||
|
||||
# Escaped
|
||||
else {
|
||||
my $ord = hex $3;
|
||||
|
||||
# Surrogate pair
|
||||
if (($ord & 0xf800) == 0xd800) {
|
||||
|
||||
# High surrogate
|
||||
($ord & 0xfc00) == 0xd800
|
||||
or pos($_) = $pos + pos($str), _throw('Missing high-surrogate');
|
||||
|
||||
# Low surrogate
|
||||
$str =~ m/\G\\u([Dd][C-Fc-f]..)/gc
|
||||
or pos($_) = $pos + pos($str), _throw('Missing low-surrogate');
|
||||
|
||||
$ord = 0x10000 + ($ord - 0xd800) * 0x400 + (hex($1) - 0xdc00);
|
||||
}
|
||||
|
||||
# Character
|
||||
$buffer .= pack 'U', $ord;
|
||||
}
|
||||
}
|
||||
|
||||
# The rest
|
||||
return $buffer . substr $str, pos $str, length $str;
|
||||
}
|
||||
|
||||
sub _decode_value {
|
||||
|
||||
# Leading whitespace
|
||||
m/\G[\x20\x09\x0a\x0d]*/gc;
|
||||
|
||||
# String
|
||||
return _decode_string() if m/\G"/gc;
|
||||
|
||||
# Object
|
||||
return _decode_object() if m/\G\{/gc;
|
||||
|
||||
# Array
|
||||
return _decode_array() if m/\G\[/gc;
|
||||
|
||||
# Number
|
||||
my ($i) = /\G([-]?(?:0|[1-9][0-9]*)(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?)/gc;
|
||||
return 0 + $i if defined $i;
|
||||
|
||||
# True
|
||||
return $TRUE if m/\Gtrue/gc;
|
||||
|
||||
# False
|
||||
return $FALSE if m/\Gfalse/gc;
|
||||
|
||||
# Null
|
||||
return undef if m/\Gnull/gc; ## no critic (return)
|
||||
|
||||
# Invalid character
|
||||
_throw('Expected string, array, object, number, boolean or null');
|
||||
}
|
||||
|
||||
sub _encode_array {
|
||||
'[' . join(',', map { _encode_value($_) } @{$_[0]}) . ']';
|
||||
}
|
||||
|
||||
sub _encode_object {
|
||||
my $object = shift;
|
||||
my @pairs = map { _encode_string($_) . ':' . _encode_value($object->{$_}) }
|
||||
sort keys %$object;
|
||||
return '{' . join(',', @pairs) . '}';
|
||||
}
|
||||
|
||||
sub _encode_string {
|
||||
my $str = shift;
|
||||
$str =~ s!([\x00-\x1f\x{2028}\x{2029}\\"/])!$REVERSE{$1}!gs;
|
||||
return "\"$str\"";
|
||||
}
|
||||
|
||||
sub _encode_value {
|
||||
my $value = shift;
|
||||
|
||||
# Reference
|
||||
if (my $ref = ref $value) {
|
||||
|
||||
# Object
|
||||
return _encode_object($value) if $ref eq 'HASH';
|
||||
|
||||
# Array
|
||||
return _encode_array($value) if $ref eq 'ARRAY';
|
||||
|
||||
# True or false
|
||||
return $$value ? 'true' : 'false' if $ref eq 'SCALAR';
|
||||
return $value ? 'true' : 'false' if $ref eq 'JSON::Tiny::_Bool';
|
||||
|
||||
# Blessed reference with TO_JSON method
|
||||
if (blessed $value && (my $sub = $value->can('TO_JSON'))) {
|
||||
return _encode_value($value->$sub);
|
||||
}
|
||||
}
|
||||
|
||||
# Null
|
||||
return 'null' unless defined $value;
|
||||
|
||||
|
||||
# Number (bitwise operators change behavior based on the internal value type)
|
||||
|
||||
return $value
|
||||
if B::svref_2object(\$value)->FLAGS & (B::SVp_IOK | B::SVp_NOK)
|
||||
# filter out "upgraded" strings whose numeric form doesn't strictly match
|
||||
&& 0 + $value eq $value
|
||||
# filter out inf and nan
|
||||
&& $value * 0 == 0;
|
||||
|
||||
# String
|
||||
return _encode_string($value);
|
||||
}
|
||||
|
||||
sub _throw {
|
||||
|
||||
# Leading whitespace
|
||||
m/\G[\x20\x09\x0a\x0d]*/gc;
|
||||
|
||||
# Context
|
||||
my $context = 'Malformed JSON: ' . shift;
|
||||
if (m/\G\z/gc) { $context .= ' before end of data' }
|
||||
else {
|
||||
my @lines = split "\n", substr($_, 0, pos);
|
||||
$context .= ' at line ' . @lines . ', offset ' . length(pop @lines || '');
|
||||
}
|
||||
|
||||
die "$context\n";
|
||||
}
|
||||
|
||||
# Emulate boolean type
|
||||
package JSON::Tiny::_Bool;
|
||||
use overload '""' => sub { ${$_[0]} }, fallback => 1;
|
||||
1;
|
||||
248
lib/JSON/Tiny.pod
Normal file
248
lib/JSON/Tiny.pod
Normal file
@@ -0,0 +1,248 @@
|
||||
=pod
|
||||
|
||||
=encoding utf8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
JSON::Tiny - Minimalistic JSON. No dependencies.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use JSON::Tiny qw(decode_json encode_json);
|
||||
|
||||
my $bytes = encode_json {foo => [1, 2], bar => 'hello!', baz => \1};
|
||||
my $hash = decode_json $bytes;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
L<JSON::Tiny> is a minimalistic standalone adaptation of L<Mojo::JSON>, from
|
||||
the L<Mojolicious> framework. It is a single-source-file module with under 300
|
||||
lines of code and core-only dependencies.
|
||||
|
||||
Features include transparent Unicode support, speed, small memory footprint,
|
||||
and a minimal code base ideal for bundling or inlining. Along with
|
||||
L<Mojo::JSON>, it is among the fastest pure-Perl implementations of
|
||||
L<RFC 7159|http://tools.ietf.org/html/rfc7159>.
|
||||
|
||||
L<JSON::Tiny> supports normal Perl data types like scalar, array reference,
|
||||
hash reference, and will try to call the L<TO_JSON> method on blessed
|
||||
references, or stringify them if it doesn't exist.
|
||||
|
||||
Differentiating between strings and numbers in Perl is hard; depending on how
|
||||
it has been used, a scalar can be both at the same time. The string value has a
|
||||
higher precedence unless both representations are equivalent.
|
||||
|
||||
[1, -2, 3] -> [1, -2, 3]
|
||||
{"foo": "bar"} -> {foo => 'bar'}
|
||||
|
||||
Literal names will be translated to and from L<JSON::Tiny> constants or a
|
||||
similar native Perl value.
|
||||
|
||||
true -> JSON::Tiny->true
|
||||
false -> JSON::Tiny->false
|
||||
null -> undef
|
||||
|
||||
Scalar references will be used to generate Booleans, based on if their values
|
||||
are true or false.
|
||||
|
||||
\1 => true
|
||||
\0 => false
|
||||
|
||||
The two Unicode whitespace characters C<u2028> and C<u2029> will always be
|
||||
escaped to make JSONP easier, and the character C</> to prevent XSS attacks.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
L<JSON::Tiny> implements the following functions, which can be imported
|
||||
individually.
|
||||
|
||||
=head2 decode_json
|
||||
|
||||
my $value = decode_json $bytes;
|
||||
|
||||
Decode JSON to Perl value and die if decoding fails.
|
||||
|
||||
=head2 encode_json
|
||||
|
||||
my $bytes = encode_json {foo => 'bar'};
|
||||
|
||||
Encode Perl value to JSON.
|
||||
|
||||
=head2 false
|
||||
|
||||
my $false = false;
|
||||
|
||||
False value, used because Perl has no equivalent.
|
||||
|
||||
=head2 from_json
|
||||
|
||||
my $value = from_json $chars;
|
||||
|
||||
Decode JSON text that is not C<UTF-8> encoded to Perl value and die if
|
||||
decoding fails.
|
||||
|
||||
=head2 j
|
||||
|
||||
my $bytes = j [1, 2, 3];
|
||||
my $bytes = j {foo => 'bar'};
|
||||
my $value = j $bytes;
|
||||
|
||||
Encode Perl data structure (which may only be an array reference or hash
|
||||
reference) or decode JSON. An C<undef> return value indicates a bare C<null>.
|
||||
Dies if decoding fails.
|
||||
|
||||
=head2 to_json
|
||||
|
||||
my $chars = to_json {i => '♥ Perl'};
|
||||
|
||||
Encode Perl value to JSON text without C<UTF-8> encoding it.
|
||||
|
||||
=head2 true
|
||||
|
||||
my $true = true;
|
||||
|
||||
True value, used because Perl has no native equivalent.
|
||||
|
||||
=head3 More on Booleans
|
||||
|
||||
A reference to a scalar (even if blessed) is encoded as a Boolean value unless
|
||||
it has a TO_JSON method.
|
||||
|
||||
my $json = $j->encode( { b => \1, a => \0 } ); # {"b":true,"a":false}
|
||||
|
||||
Boolean false and true values returned when JSON is decoded are
|
||||
JSON::Tiny::_Bool objects with overloaded stringification.
|
||||
|
||||
B<Advanced option>: Users requiring a plain old literal C<0> or C<1>, may set
|
||||
C<$JSON::Tiny::FALSE = 0;> and C<$JSON::Tiny::TRUE = 1;>. Any value, including
|
||||
blessed references will work. This must be set prior to calling a JSON decoding
|
||||
function. Use C<local> to limit scope.
|
||||
|
||||
=head1 Tiny
|
||||
|
||||
JSON::Tiny compared with JSON::PP from the L<JSON> distribution:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * L<JSON::PP> is configurable, but more complex. L<JSON::Tiny> offers
|
||||
sane defaults, and no configuration.
|
||||
|
||||
=item * Download and install with C<cpanm>: L<JSON::PP>, 5.2 seconds.
|
||||
L<JSON::Tiny>, 1.9 seconds.
|
||||
|
||||
=item * Minimal Dependencies: Both L<JSON::PP> and L<JSON::Tiny> only use core
|
||||
dependencies. JSON::Tiny requires Perl 5.8.4, while L<JSON::PP> requires 5.6.
|
||||
|
||||
=item * Simple Design: L<JSON> has 2254 lines of code, six modules and five
|
||||
files. Distribution: 85KB.
|
||||
|
||||
L<JSON::Tiny> has under 300 lines of code; an embeddable single-file module.
|
||||
Distribution: 18KB.
|
||||
|
||||
=item * L<JSON::PP> has 42 functions and methods. L<JSON::Tiny> has seven.
|
||||
|
||||
=item * Performance:
|
||||
|
||||
Rate JSON_PP JSON_Tiny
|
||||
JSON_PP 304/s -- -52%
|
||||
JSON_Tiny 636/s 109% --
|
||||
|
||||
L<JSON> uses L<JSON::XS> if it's available, in which case L<JSON> wins.
|
||||
See C<examples/json_bench.pl> for benchmark code.
|
||||
|
||||
JSON::Tiny's lightweight design reduces its startup time compared to the
|
||||
L<JSON> module. This may benefit frequently run applications like CGI.
|
||||
|
||||
=item * Light Memory Needs: Memory usage was tested with
|
||||
L<http://valgrind.org/valgrind> and L<Devel::MemoryTrace::Light> by running
|
||||
C<examples/json_pp.pl> and C<examples/json_tiny.pl>.
|
||||
|
||||
valgrind Devel::MemoryTrace::Light
|
||||
JSON::PP 5.1MB 3.7MB
|
||||
JSON::Tiny 4.5MB 2.6MB
|
||||
|
||||
=back
|
||||
|
||||
=head1 CONFIGURATION AND ENVIRONMENT
|
||||
|
||||
No configuration.
|
||||
|
||||
=head1 DEPENDENCIES
|
||||
|
||||
Perl 5.8.4 or newer. B<Perl 5.10+ is recommended due to bugs in Perl 5.8's
|
||||
regular expression engine.>
|
||||
|
||||
=head1 INCOMPATIBILITIES
|
||||
|
||||
Incompatible with L<Exporter> versions older than 5.59 (ie, predating Perl
|
||||
5.8.4).
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David Oswald, C<< <davido at cpan.org> >>
|
||||
|
||||
Code and tests adapted from L<Mojo::JSON>.
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Direct support requests to the author. Direct bug reports to CPAN's Request
|
||||
Tracker (RT).
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc JSON::Tiny
|
||||
|
||||
You may look for additional information at:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * Github: Development is hosted on Github at:
|
||||
|
||||
L<http://www.github.com/daoswald/JSON-Tiny>
|
||||
|
||||
=item * RT: CPAN's request tracker (bug reports)
|
||||
|
||||
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=JSON-Tiny>
|
||||
|
||||
=item * AnnoCPAN: Annotated CPAN documentation
|
||||
|
||||
L<http://annocpan.org/dist/JSON-Tiny>
|
||||
|
||||
=item * CPAN Ratings
|
||||
|
||||
L<http://cpanratings.perl.org/d/JSON-Tiny>
|
||||
|
||||
=item * Search CPAN
|
||||
|
||||
L<http://search.cpan.org/dist/JSON-Tiny/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 ACKNOWLEDGEMENTS
|
||||
|
||||
L<Mojolicious> team for its lightweight JSON implementation. This module was
|
||||
adapted from L<Mojo::JSON> because it is robust, minimal, and well tested.
|
||||
Mojo::JSON's tests were also adapted to a dependency-free design.
|
||||
|
||||
Christian Hansen, whos L<GitHub Gist|https://gist.github.com/chansen/810296>
|
||||
formed the basis for L<Mojo::JSON>, and subsequently JSON::Tiny.
|
||||
|
||||
Randal Schwartz showed his pure-regexp JSON parser
|
||||
(L<PerlMonks|http://perlmonks.org/?node_id=995856>) to Los Angeles Perl Mongers
|
||||
(09/2012). He wasn't involved in JSON::Tiny, but exploring alternatives to his
|
||||
solution led to this project.
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 2012-2014 David Oswald.
|
||||
|
||||
This program is free software, you can redistribute it and/or modify it under
|
||||
the terms of the Artistic License version 2.0.
|
||||
|
||||
See L<http://www.perlfoundation.org/artistic_license_2_0> for more information.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Mojo::JSON>, L<JSON>, L<RFC7159|http://tools.ietf.org/html/rfc7159>.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user