perl
/
libjson-tiny-perl
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Imported Upstream version 0.58

This commit is contained in:
Mario Fetka 2018-03-27 21:25:33 +02:00
commit 17f03193ad
25 changed files with 1730 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

159
Changes Normal file
View File

@ -0,0 +1,159 @@
Revision history for Perl module JSON::Tiny
0.58 2017-11-12
- Version bump to fix inconsistency in version number.
0.57 2017-11-11
- Resolved https://rt.cpan.org/Public/Bug/Display.html?id=122139 via
https://github.com/daoswald/JSON-Tiny/pull/4
0.56 2016-05-18
- Removed B as a tested dependency.
0.55 2016-04-25
- Canonical object encoding.
0.54 2015-10-27
- Fixed loss of large integer precision.
0.53 2015-01-25
- Minor POD and code tweaks.
0.52 2015-01-25
- Remove deprecated object-oriented API.
0.51 2015-01-25
- Document '/' escaping.
- Add from_json and to_json functions.
- Deprecate Object-Oriented API.
- Improved Boolean tests.
0.50 2014-08-05
- Whitespace parsing simplification/optimization.
0.49 2014-05-18
- Fix regression: $j->encode({a=>undef}) threw exception.
0.48 2014-05-17
- Mini-optimization in number detection code.
0.47 2014-05-13
- Number detection heuristics better match user expectations.
0.46 2014-03-06
- POD revisions.
- Tighten 'examples/', &error, tests.
0.45 2014-03-05
- Streamline POD.
0.44 2014-03-05
- Established RFC7159 compliance.
- De-deprecate &j: document limitations.
0.43 2014-03-03
- Slim the dist.
- Deprecate &j: Ambiguities with RFC7159.
0.42 2014-02-20
- Document die on failure for &j.
- More tests.
- u007f isn't mentioned in RFC4627.
- Adapt Mojo::JSON updates.
- Eradicate //.
- Cleaner examples.
0.41 2014-02-19
- ADD decode_json and encode_json functions.
- Fix decoding error.
- Handle encoding errors better.
- Fix line numbers in error messages.
- Test all decoding errors.
0.40 2014-01-16
- Mini-optimization: &encode.
- Linkify RFC mention in POD.
- Fixed bug with PREREQ_PM hashref.
0.39 2013-12-04
- POD refinements.
0.38 2013-12-03
- ACKNOWLEDGEMENTS recognize chansen's GitHub Gist: Mojo::JSON's birth.
0.37 2013-11-21
- Removed minimum dependency version checks in Makefile.PL.
- POD: JSON::Tiny is not relaxed.
0.36 2013-11-08
- Special char \b (was \x07) correctly associated with 0x08.
- Tests for 0x07=>0x08.
0.35 2013-10-16
- References to a scalar (even blessed) encode as Boolean.
0.34 2013-10-15
- Added t/22-bool.t to test Boolean override.
- Documented Boolean override.
0.33 2013-10-15
- Change 'my $TRUE', 'my $FALSE' to 'our': users can override
Booleans. http://perlmonks.org/?node_id=1058232
- Added META: Git repo, Meta spec versn.
0.32 2013-06-22
- &j dies on non-parsable JSON.
- Performance tweaks.
- Document: Perl 5.8.9 or older may segfault decoding JSON strings >22k.
0.31 2013-06-19
- Document Exporter dependency for Perl <5.8.4.
0.30 2013-06-19
- Push minimum Perl version back to 5.8.4, was 5.10. (tye)
- Document INCOMPATIBILITIES: upgrade Exporter to facilitate running under
Perl <5.8.4.
0.29 2013-06-18
- Added tests for empty keys.
- Revised UTF patterns.
0.28 2013-05-31
- Tests for "inf" and "nan" made portable. RT# 85775.
0.27 2013-05-15
- Encode "inf" and "nan" values as strings.
0.26 2013-05-13
- Change heuristics for number detection: better match user expectations.
0.25 2012-03-05
- Add test "Decode object with duplicate keys".
0.24 2012-03-01
- POD tweaks.
0.23 2013-02-27
- Add &j, and Exporter dependency.
- POD tweaks, incl. documentation for &j.
- &j tests.
0.22 2012-11-02
- Enable lexical warnings in Tiny.pm.
- Silence unwanted Perl Critiques.
- "Changes" W3CDTF compliance.
0.21 2012-10-27
- Add boolean shortcut support to JSON::Tiny.
- Fix context bugs.
0.20 2012-10-04
- Bump to version number .20: avoid confusion with like-named Perl6 module.
- POD tweaks.
- Drop ref($class)||$class; from c'tor.
0.01 2012-10-03
- JSON::Tiny adapts Mojo::JSON.
- t/20-mojo-json.t adapts Mojolicious/t/mojo/json.t
- Mojolicious dependencies purged.
- Artistic 2.0 license, as Mojolicious.

201
LICENSE Normal file
View File

@ -0,0 +1,201 @@
The Artistic License 2.0
Copyright (c) 2000-2006, The Perl Foundation.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
This license establishes the terms under which a given free software
Package may be copied, modified, distributed, and/or redistributed.
The intent is that the Copyright Holder maintains some artistic
control over the development of that Package while still keeping the
Package available as open source and free software.
You are always permitted to make arrangements wholly outside of this
license directly with the Copyright Holder of a given Package. If the
terms of this license do not permit the full use that you propose to
make of the Package, you should contact the Copyright Holder and seek
a different licensing arrangement.
Definitions
"Copyright Holder" means the individual(s) or organization(s)
named in the copyright notice for the entire Package.
"Contributor" means any party that has contributed code or other
material to the Package, in accordance with the Copyright Holder's
procedures.
"You" and "your" means any person who would like to copy,
distribute, or modify the Package.
"Package" means the collection of files distributed by the
Copyright Holder, and derivatives of that collection and/or of
those files. A given Package may consist of either the Standard
Version, or a Modified Version.
"Distribute" means providing a copy of the Package or making it
accessible to anyone else, or in the case of a company or
organization, to others outside of your company or organization.
"Distributor Fee" means any fee that you charge for Distributing
this Package or providing support for this Package to another
party. It does not mean licensing fees.
"Standard Version" refers to the Package if it has not been
modified, or has been modified only in ways explicitly requested
by the Copyright Holder.
"Modified Version" means the Package, if it has been changed, and
such changes were not explicitly requested by the Copyright
Holder.
"Original License" means this Artistic License as Distributed with
the Standard Version of the Package, in its current version or as
it may be modified by The Perl Foundation in the future.
"Source" form means the source code, documentation source, and
configuration files for the Package.
"Compiled" form means the compiled bytecode, object code, binary,
or any other form resulting from mechanical transformation or
translation of the Source form.
Permission for Use and Modification Without Distribution
(1) You are permitted to use the Standard Version and create and use
Modified Versions for any purpose without restriction, provided that
you do not Distribute the Modified Version.
Permissions for Redistribution of the Standard Version
(2) You may Distribute verbatim copies of the Source form of the
Standard Version of this Package in any medium without restriction,
either gratis or for a Distributor Fee, provided that you duplicate
all of the original copyright notices and associated disclaimers. At
your discretion, such verbatim copies may or may not include a
Compiled form of the Package.
(3) You may apply any bug fixes, portability changes, and other
modifications made available from the Copyright Holder. The resulting
Package will still be considered the Standard Version, and as such
will be subject to the Original License.
Distribution of Modified Versions of the Package as Source
(4) You may Distribute your Modified Version as Source (either gratis
or for a Distributor Fee, and with or without a Compiled form of the
Modified Version) provided that you clearly document how it differs
from the Standard Version, including, but not limited to, documenting
any non-standard features, executables, or modules, and provided that
you do at least ONE of the following:
(a) make the Modified Version available to the Copyright Holder
of the Standard Version, under the Original License, so that the
Copyright Holder may include your modifications in the Standard
Version.
(b) ensure that installation of your Modified Version does not
prevent the user installing or running the Standard Version. In
addition, the Modified Version must bear a name that is different
from the name of the Standard Version.
(c) allow anyone who receives a copy of the Modified Version to
make the Source form of the Modified Version available to others
under
(i) the Original License or
(ii) a license that permits the licensee to freely copy,
modify and redistribute the Modified Version using the same
licensing terms that apply to the copy that the licensee
received, and requires that the Source form of the Modified
Version, and of any works derived from it, be made freely
available in that license fees are prohibited but Distributor
Fees are allowed.
Distribution of Compiled Forms of the Standard Version
or Modified Versions without the Source
(5) You may Distribute Compiled forms of the Standard Version without
the Source, provided that you include complete instructions on how to
get the Source of the Standard Version. Such instructions must be
valid at the time of your distribution. If these instructions, at any
time while you are carrying out such distribution, become invalid, you
must provide new instructions on demand or cease further distribution.
If you provide valid instructions or cease distribution within thirty
days after you become aware that the instructions are invalid, then
you do not forfeit any of your rights under this license.
(6) You may Distribute a Modified Version in Compiled form without
the Source, provided that you comply with Section 4 with respect to
the Source of the Modified Version.
Aggregating or Linking the Package
(7) You may aggregate the Package (either the Standard Version or
Modified Version) with other packages and Distribute the resulting
aggregation provided that you do not charge a licensing fee for the
Package. Distributor Fees are permitted, and licensing fees for other
components in the aggregation are permitted. The terms of this license
apply to the use and Distribution of the Standard or Modified Versions
as included in the aggregation.
(8) You are permitted to link Modified and Standard Versions with
other works, to embed the Package in a larger work of your own, or to
build stand-alone binary or bytecode versions of applications that
include the Package, and Distribute the result without restriction,
provided the result does not expose a direct interface to the Package.
Items That are Not Considered Part of a Modified Version
(9) Works (including, but not limited to, modules and scripts) that
merely extend or make use of the Package, do not, by themselves, cause
the Package to be a Modified Version. In addition, such works are not
considered parts of the Package itself, and are not subject to the
terms of this license.
General Provisions
(10) Any use, modification, and distribution of the Standard or
Modified Versions is governed by this Artistic License. By using,
modifying or distributing the Package, you accept this license. Do not
use, modify, or distribute the Package, if you do not accept this
license.
(11) If your Modified Version has been derived from a Modified
Version made by someone other than you, you are nevertheless required
to ensure that your Modified Version complies with the requirements of
this license.
(12) This license does not grant you the right to use any trademark,
service mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide,
free-of-charge patent license to make, have made, use, offer to sell,
sell, import and otherwise transfer the Package with respect to any
patent claims licensable by the Copyright Holder that are necessarily
infringed by the Package. If you institute patent litigation
(including a cross-claim or counterclaim) against any party alleging
that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the
date that such litigation is filed.
(14) Disclaimer of Warranty:
THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS
IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL
LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL
BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

26
MANIFEST Normal file
View File

@ -0,0 +1,26 @@
Changes
lib/JSON/Tiny.pm
lib/JSON/Tiny.pod
Makefile.PL
MANIFEST
MANIFEST.SKIP
README
LICENSE
META.json
META.yml
t/01-manifest.t
t/02-pod.t
t/03-pod-coverage.t
t/04-perlcritic.t
t/05-load-prereqs.t
t/09-changes.t
t/10-load-can.t
t/13-kwalitee.t
t/20-mojo-json.t
t/21-j-dies.t
t/22-bool.t
examples/json_pp.pl
examples/json_tiny.pl
examples/json_bench.pl
examples/sample.json

15
MANIFEST.SKIP Normal file
View File

@ -0,0 +1,15 @@
^\.git
^Makefile$
^blib/
^MakeMaker-\d
\.tar\.gz
^JSON-Tiny-[\d._]+/
~$
\.old$
^#.*#$
^\.#
\.gz$
^MYMETA
pm_to_blib
cover
^JSON-Tiny$

61
META.json Normal file
View File

@ -0,0 +1,61 @@
{
"abstract" : "Minimalistic JSON. No dependencies.",
"author" : [
"David Oswald <davido[at]cpan[dot]org>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010",
"license" : [
"artistic_2"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "JSON-Tiny",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"perl" : "5.008000"
},
"suggests" : {
"JSON::PP" : "0"
}
}
},
"provides" : {
"JSON::Tiny" : {
"file" : "lib/JSON/Tiny.pm",
"version" : "0.58"
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"http://www.perlfoundation.org/artistic_license_2_0"
],
"repository" : {
"type" : "git",
"url" : "https://github.com/daoswald/JSON-Tiny.git",
"web" : "https://github.com/daoswald/JSON-Tiny"
}
},
"version" : "0.58",
"x_serialization_backend" : "JSON::PP version 2.27400_02"
}

30
META.yml Normal file
View File

@ -0,0 +1,30 @@
---
abstract: 'Minimalistic JSON. No dependencies.'
author:
- 'David Oswald <davido[at]cpan[dot]org>'
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010'
license: artistic_2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: JSON-Tiny
no_index:
directory:
- t
- inc
provides:
JSON::Tiny:
file: lib/JSON/Tiny.pm
version: '0.58'
requires:
perl: '5.008000'
resources:
license: http://www.perlfoundation.org/artistic_license_2_0
repository: https://github.com/daoswald/JSON-Tiny.git
version: '0.58'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

45
Makefile.PL Normal file
View File

@ -0,0 +1,45 @@
## no critic (RCS,VERSION,may require interpolation)
use 5.008000;
use strict;
use warnings;
use ExtUtils::MakeMaker;
my $PREREQ_PM = {};
$PREREQ_PM->{'Exporter'} = '5.59' if $] < 5.008004;
WriteMakefile(
NAME => 'JSON::Tiny',
AUTHOR => q{David Oswald <davido[at]cpan[dot]org>},
VERSION_FROM => 'lib/JSON/Tiny.pm',
ABSTRACT_FROM => 'lib/JSON/Tiny.pod',
LICENSE => 'artistic_2',
MIN_PERL_VERSION => '5.008000',
PL_FILES => {},
PREREQ_PM => $PREREQ_PM,
META_MERGE => {
'meta-spec' => { version => 2 },
resources => {
license => 'http://www.perlfoundation.org/artistic_license_2_0',
repository => {
type => 'git',
url => 'https://github.com/daoswald/JSON-Tiny.git',
web => 'https://github.com/daoswald/JSON-Tiny',
},
},
provides => {
'JSON::Tiny' => {
file => 'lib/JSON/Tiny.pm',
version => '0.58'
},
},
prereqs => {
runtime => {
requires => $PREREQ_PM,
suggests => {'JSON::PP' => '0'},
},
},
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' },
clean => { FILES => 'JSON-Tiny-*' },
);

47
README Normal file
View File

@ -0,0 +1,47 @@
JSON::Tiny
Minimal JSON with no dependencies.
DESCRIPTION
Lightweight, fast, pure-Perl JSON in a stand-alone module with only core
dependencies.
INSTALLATION
To install this module, run the following commands:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
Minimum recommended Perl version: 5.10.
SUPPORT AND DOCUMENTATION
Once installed, you may find documentation with the perldoc command.
perldoc JSON::Tiny
You may also look for information at:
RT, CPAN's request tracker (report bugs here)
http://rt.cpan.org/NoAuth/Bugs.html?Dist=JSON-Tiny
Search CPAN
http://search.cpan.org/dist/JSON-Tiny/
See the module's POD for additional info.
LICENSE AND COPYRIGHT
Copyright (C)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 http://www.perlfoundation.org/artistic_license_2_0 for more information.

17
examples/json_bench.pl Normal file
View File

@ -0,0 +1,17 @@
BEGIN { $ENV{PERL_JSON_BACKEND}=0; }
use File::Slurp 'read_file';
use JSON;
use JSON::Tiny;
use Benchmark 'cmpthese';
my @json = split /-{4}/, read_file('sample.json');
sub json_pp {
my $j = JSON->new->relaxed;
[ map { $j->decode($_) } @json ];
}
sub json_tiny { [ map { JSON::Tiny::decode_json $_ } @json ]; }
cmpthese -15, { JSON_PP => \&json_pp, JSON_Tiny => \&json_tiny };

10
examples/json_pp.pl Normal file
View File

@ -0,0 +1,10 @@
BEGIN { $ENV{PERL_JSON_BACKEND} = 0; } # JSON::PP.
use JSON;
my @json
= split /-{4}/, do { open my $fh, '<sample.json'; local $/ = undef; <$fh> };
sub json_pp { my $j = JSON->new; [ map { $j->decode($_) } @json ]; }
my $value = json_pp;

9
examples/json_tiny.pl Normal file
View File

@ -0,0 +1,9 @@
use JSON::Tiny 'j';
my @json
= split /-{4}/, do { open my $fh, '<sample.json'; local $/ = undef; <$fh> };
sub json_tiny { [ map { j $_ } @json ]; }
my $value = json_tiny;

7
examples/sample.json Normal file
View File

@ -0,0 +1,7 @@
{"firstName":"John","lastName":"Smith","address":{"state":"NY","streetAddress":"21 2nd Street","city":"New York","postalCode":"10021"},"phoneNumber":[{"number":"212 555-1234","type":"home"},{"type":"fax","number":"646 555-4567"}],"age":25}
----
{"properties":{"price":{"type":"number","minimum":0,"required":true},"stock":{"type":"object","properties":{"retail":{"type":"number"},"warehouse":{"type":"number"}}},"tags":{"items":{"type":"string"},"type":"array"},"name":{"description":"Name of the product","type":"string","required":true},"id":{"required":true,"type":"number","description":"Product identifier"}},"name":"Product"}
----
{"price":123,"tags":["Bar","Eek"],"stock":{"warehouse":300,"retail":20},"id":1,"name":"Foo"}
----
{"web-app":{"taglib":{"taglib-uri":"cofax.tld","taglib-location":"\/WEB-INF\/tlds\/cofax.tld"},"servlet-mapping":{"fileServlet":"\/static\/*","cofaxAdmin":"\/admin\/*","cofaxTools":"\/tools\/*","cofaxEmail":"\/cofaxutil\/aemail\/*","cofaxCDS":"\/"},"servlet":[{"servlet-class":"org.cofax.cds.CDSServlet","init-param":{"dataStoreClass":"org.cofax.SqlDataStore","dataStoreUrl":"jdbc:microsoft:sqlserver:\/\/LOCALHOST:1433;DatabaseName=goon","redirectionClass":"org.cofax.SqlRedirection","dataStoreLogLevel":"debug","cachePagesTrack":200,"dataStoreInitConns":10,"configGlossary:poweredByIcon":"\/images\/cofax.gif","cachePackageTagsStore":200,"cachePackageTagsRefresh":60,"dataStoreConnUsageLimit":100,"cacheTemplatesTrack":100,"maxUrlLength":500,"dataStoreName":"cofax","searchEngineFileTemplate":"forSearchEngines.htm","searchEngineListTemplate":"forSearchEnginesList.htm","configGlossary:installationAt":"Philadelphia, PA","useJSP":false,"cachePagesRefresh":10,"templateProcessorClass":"org.cofax.WysiwygTemplate","cachePagesDirtyRead":10,"cacheTemplatesRefresh":15,"dataStoreLogFile":"\/usr\/local\/tomcat\/logs\/datastore.log","templateLoaderClass":"org.cofax.FilesTemplateLoader","jspFileTemplate":"articleTemplate.jsp","defaultFileTemplate":"articleTemplate.htm","searchEngineRobotsDb":"WEB-INF\/robots.db","templatePath":"templates","configGlossary:staticPath":"\/content\/static","dataStoreTestQuery":"SET NOCOUNT ON;select test='test';","dataStorePassword":"dataStoreTestQuery","cachePackageTagsTrack":200,"dataStoreUser":"sa","defaultListTemplate":"listTemplate.htm","templateOverridePath":"","dataStoreMaxConns":100,"dataStoreDriver":"com.microsoft.jdbc.sqlserver.SQLServerDriver","cachePagesStore":100,"configGlossary:adminEmail":"ksm@pobox.com","jspListTemplate":"listTemplate.jsp","configGlossary:poweredBy":"Cofax","cacheTemplatesStore":50,"useDataStore":true},"servlet-name":"cofaxCDS"},{"servlet-name":"cofaxEmail","init-param":{"mailHostOverride":"mail2","mailHost":"mail1"},"servlet-class":"org.cofax.cds.EmailServlet"},{"servlet-class":"org.cofax.cds.AdminServlet","servlet-name":"cofaxAdmin"},{"servlet-name":"fileServlet","servlet-class":"org.cofax.cds.FileServlet"},{"servlet-name":"cofaxTools","init-param":{"dataLogMaxSize":"","fileTransferFolder":"\/usr\/local\/tomcat\/webapps\/content\/fileTransferFolder","removePageCache":"\/content\/admin\/remove?cache=pages&id=","removeTemplateCache":"\/content\/admin\/remove?cache=templates&id=","log":1,"adminGroupID":4,"betaServer":true,"dataLogLocation":"\/usr\/local\/tomcat\/logs\/dataLog.log","lookInContext":1,"logMaxSize":"","templatePath":"toolstemplates\/","logLocation":"\/usr\/local\/tomcat\/logs\/CofaxTools.log","dataLog":1},"servlet-class":"org.cofax.cms.CofaxToolsServlet"}]}}

299
lib/JSON/Tiny.pm Normal file
View 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
View 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

12
t/01-manifest.t Normal file
View File

@ -0,0 +1,12 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
plan skip_all => 'Author tests not required for installation.'
unless $ENV{RELEASE_TESTING};
eval "use Test::CheckManifest 0.9"; ## no critic (eval)
plan skip_all => "Test::CheckManifest 0.9 required" if $@;
ok_manifest();

9
t/02-pod.t Normal file
View File

@ -0,0 +1,9 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
eval 'use Test::Pod 1.26'; ## no critic (eval)
plan skip_all => 'Test::Pod 1.26 required for this test' if $@;
all_pod_files_ok();

15
t/03-pod-coverage.t Normal file
View File

@ -0,0 +1,15 @@
use strict;
use warnings;
use Test::More;
if( $ENV{RELEASE_TESTING} ) {
eval 'use Test::Pod::Coverage 1.00'; ## no critic (eval)
if( $@ ) {
plan skip_all => 'Test::Pod::Coverage 1.00 required for this test.';
}
else { plan tests => 1; }
}
else { plan skip_all => 'Author Test: Set $ENV{RELEASE_TESTING} to run.'; }
pod_coverage_ok( 'JSON::Tiny', {also_private => [ qw/encode decode error new/ ]}
);

22
t/04-perlcritic.t Normal file
View File

@ -0,0 +1,22 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use English '-no_match_vars';
if ( not $ENV{RELEASE_TESTING} ) {
my $msg = 'Author Test: Set $ENV{RELEASE_TESTING} to run.';
plan skip_all => $msg;
}
eval { require Test::Perl::Critic; }; ## no critic (eval)
if ( $EVAL_ERROR ) {
my $msg = 'Author Test: Test::Perl::Critic required for critique.';
plan skip_all => $msg;
}
Test::Perl::Critic->import(-severity => 5);
my @directories = qw{ blib/ t/ };
Test::Perl::Critic::all_critic_ok(@directories);

9
t/05-load-prereqs.t Normal file
View File

@ -0,0 +1,9 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 2;
sub msg { "*** $_[0] MUST BE INSTALLED BEFORE PROCEEDING ***\n"; }
BEGIN { use_ok $_ or BAIL_OUT msg $_ for qw/Scalar::Util Encode/; }

9
t/09-changes.t Normal file
View File

@ -0,0 +1,9 @@
use strict;
use warnings;
use Test::More;
plan skip_all => 'Author tests skipped. Set $ENV{RELEASE_TESTING} to run.'
unless $ENV{RELEASE_TESTING};
plan skip_all => 'Test::CPAN::Changes needed for this test.'
unless eval 'use Test::CPAN::Changes; 1;'; ## no critic (eval)
changes_ok();

11
t/10-load-can.t Normal file
View File

@ -0,0 +1,11 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 2;
BEGIN { use_ok 'JSON::Tiny' or BAIL_OUT(); }
diag "Testing JSON::Tiny $JSON::Tiny::VERSION, Perl $], $^X";
can_ok 'JSON::Tiny',
qw( decode_json encode_json false from_json j to_json true );

15
t/13-kwalitee.t Normal file
View File

@ -0,0 +1,15 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
if ( $ENV{RELEASE_TESTING} ) {
eval { require Test::Kwalitee; Test::Kwalitee->import }; ## no critic (eval)
plan skip_all => 'Test::Kwalitee not installed: skip' if $@;
unlink 'Debian_CPANTS.txt' if -e 'Debian_CPANTS.txt'; # Clean up.
}
else {
my $msg = 'Author Test: Set $ENV{RELEASE_TESTING} true to run.';
plan skip_all => $msg;
}

404
t/20-mojo-json.t Normal file
View File

@ -0,0 +1,404 @@
package JSONTest; ## no critic (package)
use strict;
# Emulate Mojo::Base -base.
sub new {
my $c = shift;
bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $c || $c;
}
sub foo {
my $s = shift;
$s->{foo} = shift if @_;
$s->{foo} = {} if ! defined $s->{foo};
return $s->{foo};
}
sub TO_JSON { shift->foo }
package main;
use strict;
use utf8;
use Encode qw( encode decode );
use Test::More;
use JSON::Tiny qw(decode_json encode_json false from_json j to_json true);
# Decode array
my $array = decode_json '[]';
is_deeply $array, [], 'decode []';
$array = decode_json '[ [ ]]';
is_deeply $array, [[]], 'decode [ [ ]]';
# Decode number
$array = decode_json '[0]';
is_deeply $array, [0], 'decode [0]';
$array = decode_json '[1]';
is_deeply $array, [1], 'decode [1]';
$array = decode_json '[ "-122.026020" ]';
is_deeply $array, ['-122.026020'], 'decode [ -122.026020 ]';
$array = decode_json '[ -122.026020 ]';
is_deeply $array, ['-122.02602'], 'decode [ -122.026020 ]';
$array = decode_json '[0.0]';
cmp_ok $array->[0], '==', 0, 'value is 0';
$array = decode_json '[0e0]';
cmp_ok $array->[0], '==', 0, 'value is 0';
$array = decode_json '[1,-2]';
is_deeply $array, [1, -2], 'decode [1,-2]';
$array = decode_json '["10e12" , [2 ]]';
is_deeply $array, ['10e12', [2]], 'decode ["10e12" , [2 ]]';
$array = decode_json '[10e12 , [2 ]]';
is_deeply $array, [10000000000000, [2]], 'decode [10e12 , [2 ]]';
$array = decode_json '[37.7668 , [ 20 ]] ';
is_deeply $array, [37.7668, [20]], 'decode [37.7668 , [ 20 ]] ';
$array = decode_json '[1e3]';
cmp_ok $array->[0], '==', 1e3, 'value is 1e3';
my $value = decode_json '0';
cmp_ok $value, '==', 0, 'decode 0';
$value = decode_json '23.3';
cmp_ok $value, '==', 23.3, 'decode 23.3';
# Decode name
$array = decode_json '[true]';
is_deeply $array, [JSON::Tiny->true], 'decode [true]';
$array = decode_json '[null]';
is_deeply $array, [undef], 'decode [null]';
$array = decode_json '[true, false]';
is_deeply $array, [true, false], 'decode [true, false]';
$value = decode_json 'true';
is $value, JSON::Tiny->true, 'decode true';
$value = decode_json 'false';
is $value, JSON::Tiny->false, 'decode false';
$value = decode_json 'null';
is $value, undef, 'decode null';
# Decode string
$array = decode_json '[" "]';
is_deeply $array, [' '], 'decode [" "]';
$array = decode_json '["hello world!"]';
is_deeply $array, ['hello world!'], 'decode ["hello world!"]';
$array = decode_json '["hello\nworld!"]';
is_deeply $array, ["hello\nworld!"], 'decode ["hello\nworld!"]';
$array = decode_json '["hello\t\"world!"]';
is_deeply $array, ["hello\t\"world!"], 'decode ["hello\t\"world!"]';
$array = decode_json '["hello\u0152world\u0152!"]';
is_deeply $array, ["hello\x{0152}world\x{0152}!"],
'decode ["hello\u0152world\u0152!"]';
$array = decode_json '["0."]';
is_deeply $array, ['0.'], 'decode ["0."]';
$array = decode_json '[" 0"]';
is_deeply $array, [' 0'], 'decode [" 0"]';
$array = decode_json '["1"]';
is_deeply $array, ['1'], 'decode ["1"]';
$array = decode_json '["\u0007\b\/\f\r"]';
is_deeply $array, ["\a\b/\f\r"], 'decode ["\u0007\b\/\f\r"]';
$value = decode_json '""';
is $value, '', 'decode ""';
$value = decode_json '"hell\no"';
is $value, "hell\no", 'decode "hell\no"';
# Decode object
my $hash = decode_json '{}';
is_deeply $hash, {}, 'decode {}';
$hash = decode_json '{"foo": "bar"}';
is_deeply $hash, {foo => 'bar'}, 'decode {"foo": "bar"}';
$hash = decode_json '{"foo": [23, "bar"]}';
is_deeply $hash, {foo => [qw(23 bar)]}, 'decode {"foo": [23, "bar"]}';
# Decode full spec example
$hash = decode_json <<EOF;
{
"Image": {
"Width": 800,
"Height": 600,
"Title": "View from 15th Floor",
"Thumbnail": {
"Url": "http://www.example.com/image/481989943",
"Height": 125,
"Width": "100"
},
"IDs": [116, 943, 234, 38793]
}
}
EOF
is $hash->{Image}{Width}, 800, 'right value';
is $hash->{Image}{Height}, 600, 'right value';
is $hash->{Image}{Title}, 'View from 15th Floor', 'right value';
is $hash->{Image}{Thumbnail}{Url}, 'http://www.example.com/image/481989943',
'right value';
is $hash->{Image}{Thumbnail}{Height}, 125, 'right value';
is $hash->{Image}{Thumbnail}{Width}, 100, 'right value';
is $hash->{Image}{IDs}[0], 116, 'right value';
is $hash->{Image}{IDs}[1], 943, 'right value';
is $hash->{Image}{IDs}[2], 234, 'right value';
is $hash->{Image}{IDs}[3], 38793, 'right value';
# Encode array
my $bytes = encode_json [];
is $bytes, '[]', 'encode []';
$bytes = encode_json [[]];
is $bytes, '[[]]', 'encode [[]]';
$bytes = encode_json [[], []];
is $bytes, '[[],[]]', 'encode [[], []]';
$bytes = encode_json [[], [[]], []];
is $bytes, '[[],[[]],[]]', 'encode [[], [[]], []]';
# Encode string
$bytes = encode_json ['foo'];
is $bytes, '["foo"]', 'encode [\'foo\']';
$bytes = encode_json ["hello\nworld!"];
is $bytes, '["hello\nworld!"]', 'encode ["hello\nworld!"]';
$bytes = encode_json ["hello\t\"world!"];
is $bytes, '["hello\t\"world!"]', 'encode ["hello\t\"world!"]';
$bytes = encode_json ["hello\x{0003}\x{0152}world\x{0152}!"];
is decode('UTF-8', $bytes), "[\"hello\\u0003\x{0152}world\x{0152}!\"]",
'encode ["hello\x{0003}\x{0152}world\x{0152}!"]';
$bytes = encode_json ["123abc"];
is $bytes, '["123abc"]', 'encode ["123abc"]';
$bytes = encode_json ["\x00\x1f \a\b/\f\r"];
is $bytes, '["\\u0000\\u001F \\u0007\\b\/\f\r"]',
'encode ["\x00\x1f \a\b/\f\r"]';
$bytes = encode_json '';
is $bytes, '""', 'encode ""';
$bytes = encode_json "hell\no";
is $bytes, '"hell\no"', 'encode "hell\no"';
# Encode object
$bytes = encode_json {};
is $bytes, '{}', 'encode {}';
$bytes = encode_json {foo => {}};
is $bytes, '{"foo":{}}', 'encode {foo => {}}';
$bytes = encode_json {foo => 'bar'};
is $bytes, '{"foo":"bar"}', 'encode {foo => \'bar\'}';
$bytes = encode_json {foo => []};
is $bytes, '{"foo":[]}', 'encode {foo => []}';
$bytes = encode_json {foo => ['bar']};
is $bytes, '{"foo":["bar"]}', 'encode {foo => [\'bar\']}';
$bytes = encode_json {foo => 'bar', baz => 'yada'};
is $bytes, '{"baz":"yada","foo":"bar"}',
'encode {foo => \'bar\', baz => \'yada\'}';
# Encode name
$bytes = encode_json [JSON::Tiny->true];
is $bytes, '[true]', 'encode [JSON::Tiny->true]';
$bytes = encode_json [undef];
is $bytes, '[null]', 'encode [undef]';
$bytes = encode_json [JSON::Tiny->true, JSON::Tiny->false];
is $bytes, '[true,false]', 'encode [JSON::Tiny->true, JSON::Tiny->false]';
$bytes = encode_json(JSON::Tiny->true);
is $bytes, 'true', 'encode JSON::Tiny->true';
$bytes = encode_json(JSON::Tiny->false);
is $bytes, 'false', 'encode JSON::Tiny->false';
$bytes = encode_json undef;
is $bytes, 'null', 'encode undef';
# Encode number
$bytes = encode_json [1];
is $bytes, '[1]', 'encode [1]';
$bytes = encode_json ["1"];
is $bytes, '["1"]', 'encode ["1"]';
$bytes = encode_json ['-122.026020'];
is $bytes, '["-122.026020"]', 'encode [\'-122.026020\']';
$bytes = encode_json [-122.026020];
is $bytes, '[-122.02602]', 'encode [-122.026020]';
$bytes = encode_json [1, -2];
is $bytes, '[1,-2]', 'encode [1, -2]';
$bytes = encode_json ['10e12', [2]];
is $bytes, '["10e12",[2]]', 'encode [\'10e12\', [2]]';
$bytes = encode_json [10e12, [2]];
is $bytes, '[10000000000000,[2]]', 'encode [10e12, [2]]';
$bytes = encode_json [37.7668, [20]];
is $bytes, '[37.7668,[20]]', 'encode [37.7668, [20]]';
$bytes = encode_json 0;
is $bytes, '0', 'encode 0';
$bytes = encode_json 23.3;
is $bytes, '23.3', 'encode 23.3';
# Faihu roundtrip
$bytes = j ["\x{10346}"];
is decode( 'UTF-8', $bytes ), "[\"\x{10346}\"]", 'encode ["\x{10346}"]';
$array = j $bytes;
is_deeply $array, ["\x{10346}"], 'successful roundtrip';
# Decode faihu surrogate pair
$array = decode_json '["\\ud800\\udf46"]';
is_deeply $array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]';
# Decode object with duplicate keys
$hash = decode_json '{"foo": 1, "foo": 2}';
is_deeply $hash, {foo =>2}, 'decode {"foo": 1, "foo": 2}';
# Complicated roudtrips
$bytes = '{"":""}';
$hash = decode_json $bytes;
is_deeply $hash, {'' => ''}, 'decode {"":""}';
is encode_json($hash), $bytes, 'reencode';
$bytes = '[null,false,true,"",0,1]';
$array = decode_json $bytes;
is_deeply $array, [undef, JSON::Tiny->false, JSON::Tiny->true, '', 0, 1],
'decode [null,false,true,"",0,1]';
is encode_json($array), $bytes, 'reencode';
$array = [undef, 0, 1, '', JSON::Tiny->true, JSON::Tiny->false];
$bytes = encode_json $array;
ok $bytes, 'defined value';
is_deeply decode_json($bytes), $array, 'successful roundtrip';
# Real world roundtrip
$bytes = encode_json {foo => 'c:\progra~1\mozill~1\firefox.exe'};
is $bytes, '{"foo":"c:\\\\progra~1\\\\mozill~1\\\\firefox.exe"}',
'encode {foo => \'c:\progra~1\mozill~1\firefox.exe\'}';
$hash = decode_json $bytes;
is_deeply $hash, {foo => 'c:\progra~1\mozill~1\firefox.exe'},
'successful roundtrip';
# Huge string
$bytes = encode_json ['a' x 32768];
is_deeply decode_json($bytes), ['a' x 32768], 'successful roundtrip (huge)'; # segfault under 5.8.x.
# u2028 and u2029 and slash
$bytes = encode_json ["\x{2028}test\x{2029}123</script>"];
is $bytes, '["\u2028test\u2029123<\/script>"]',
'escaped u2028, u2029 and slash';
is_deeply decode_json($bytes), ["\x{2028}test\x{2029}123</script>"],
'successful roundtrip';
# JSON without UTF-8 encoding
is_deeply from_json('["♥"]'), ['♥'], 'characters decoded';
is to_json(['♥']), '["♥"]', 'characters encoded';
is_deeply from_json(to_json(["\xe9"])), ["\xe9"], 'successful roundtrip';
# Blessed reference
# Mojo::ByteStream needed for this test.
#$bytes = encode_json b(['test']);
#is_deeply decode_json($bytes), ['test'], 'successful roundtrip';
# Blessed reference with TO_JSON method
$bytes = encode_json(JSONTest->new);
is_deeply decode_json($bytes), {}, 'successful roundtrip';
$bytes = encode_json(
JSONTest->new(foo => {just => 'works'}, else => {not => 'working'}));
is_deeply decode_json($bytes), {just => 'works'}, 'successful roundtrip';
# Boolean shortcut
is encode_json({true => \1}), '{"true":true}', 'encode {true => \1}';
is encode_json({false => \0}), '{"false":false}', 'encode {false => \0}';
$bytes = 'some true value';
is encode_json({true => \!!$bytes}), '{"true":true}',
'encode true boolean from double negated reference';
is encode_json({true => \$bytes}), '{"true":true}',
'encode true boolean from reference';
$bytes = '';
is encode_json({false => \!!$bytes}), '{"false":false}',
'encode false boolean from double negated reference';
is encode_json({false => \$bytes}), '{"false":false}',
'encode false boolean from reference';
# Booleans in different contexts
is(true, 1, 'right string value');
is(true + 0, 1, 'right numeric value');
is(false, 0, 'right string value');
is(false + 0, 0, 'right numeric value');
# Upgraded numbers
my $num = 3;
my $str = "$num";
is encode_json({test => [$num, $str]}), '{"test":[3,"3"]}',
'upgraded number detected';
$num = 3.21;
$str = "$num";
is encode_json({test => [$num, $str]}), '{"test":[3.21,"3.21"]}',
'upgraded number detected';
$str = '0 but true';
$num = 1 + $str;
is encode_json({test => [$num, $str]}), '{"test":[1,"0 but true"]}',
'upgraded number detected';
# Upgraded string
$str = "bar";
{ no warnings 'numeric'; $num = 23 + $str }
is encode_json({test => [$num, $str]}), '{"test":[23,"bar"]}',
'upgraded string detected';
# "inf" and "nan"
like encode_json({test => 9**9**9}), qr/^{"test":".*"}$/,
'encode "inf" as string';
like encode_json({test => -sin(9**9**9)}), qr/^{"test":".*"}$/,
'encode "nan" as string';
# "null"
is j('null'), undef, 'decode null';
# Errors
eval { decode_json 'test' };
like $@, qr/Malformed JSON: Expected string, array, object/, 'right error';
like $@, qr/object, number, boolean or null at line 0, offset 0/, 'right error';
eval { decode_json(encode('UTF-8','["\\ud800"]')) };
like $@, qr/Malformed JSON: Missing low-surrogate at line 1, offset 8/,
'right error';
eval { decode_json(encode('UTF-8', '["\\udf46"]')) };
like $@, qr/Malformed JSON: Missing high-surrogate at line 1, offset 8/,
'right error';
eval { decode_json '[[]' };
like $@, qr/Malformed JSON: Expected comma or right square bracket/,
'right error';
like $@, qr/bracket while parsing array at line 1, offset 3/, 'right error';
eval { decode_json '{{}' };
like $@,
qr/Malformed JSON: Expected string while parsing object at line 1, offset 1/,
'right error';
eval { decode_json "[\"foo\x00]" };
like $@, qr/Malformed JSON: Unexpected character or invalid escape/,
'right error';
like $@, qr/escape while parsing string at line 1, offset 5/, 'right error';
eval { decode_json '{"foo":"bar"{' };
like $@, qr/Malformed JSON: Expected comma or right curly bracket/,
'right error';
like $@, qr/bracket while parsing object at line 1, offset 12/, 'right error';
eval { decode_json '{"foo""bar"}' };
like $@,
qr/Malformed JSON: Expected colon while parsing object at line 1, offset 6/,
'right error';
eval { decode_json '[[]...' };
like $@, qr/Malformed JSON: Expected comma or right square bracket/,
'right error';
like $@, qr/bracket while parsing array at line 1, offset 3/, 'right error';
eval { decode_json '{{}...' };
like $@,
qr/Malformed JSON: Expected string while parsing object at line 1, offset 1/,
'right error';
eval { decode_json '[nan]' };
like $@, qr/Malformed JSON: Expected string, array, object, number/,
'right error';
like $@, qr/number, boolean or null at line 1, offset 1/, 'right error';
eval { decode_json '["foo]' };
like $@, qr/Malformed JSON: Unterminated string at line 1, offset 6/,
'right error';
eval { decode_json '{"foo":"bar"}lala' };
like $@, qr/Malformed JSON: Unexpected data at line 1, offset 13/,
'right error';
eval { decode_json '' };
like $@, qr/Missing or empty input/, 'right error';
eval { decode_json "[\"foo\",\n\"bar\"]lala" };
like $@, qr/Malformed JSON: Unexpected data at line 2, offset 6/,
'right error';
eval { decode_json "[\"foo\",\n\"bar\",\n\"bazra\"]lalala" };
like $@, qr/Malformed JSON: Unexpected data at line 3, offset 8/,
'right error';
eval { decode_json '["♥"]' };
like $@, qr/Input is not UTF-8 encoded/, 'right error';
eval { decode_json encode('Shift_JIS', 'やった') };
like $@, qr/Input is not UTF-8 encoded/, 'right error';
is eval { j '{'; 1 }, undef, 'syntax error';
eval { decode_json "[\"foo\",\n\"bar\",\n\"bazra\"]lalala" };
like $@,
qr/JSON: Unexpected data at line 3, offset 8 at.*json\.t/,
'right error';
eval { from_json "[\"foo\",\n\"bar\",\n\"bazra\"]lalala" };
like $@, qr/JSON: Unexpected data at line 3, offset 8 at.*json\.t/,
'right error';
is encode_json({a=>undef}), '{"a":null}', 'Encode undef to null.';
done_testing();

9
t/21-j-dies.t Normal file
View File

@ -0,0 +1,9 @@
use strict;
use warnings;
use Test::More tests => 1;
use JSON::Tiny 'j';
eval { my $aref = j '[[]' };
like $@, qr/^Malformed JSON: Expected comma or right square/,
'j() dies on decode error; right error.';

41
t/22-bool.t Normal file
View File

@ -0,0 +1,41 @@
use strict;
use warnings;
no warnings 'once';
use Test::More;
use JSON::Tiny 'decode_json';
my $rv = decode_json '{ "a":false, "b":true }';
ok $rv->{a}->isa('JSON::Tiny::_Bool'),
'Decoding a "false" Boolean yields JSON::Tiny::_Bool object.';
ok $rv->{b}->isa('JSON::Tiny::_Bool'),
'Decoding "true" Boolean yields JSON::Tiny::_Bool object.';
is ref $rv->{a}, 'JSON::Tiny::_Bool', 'ref detects JSON::Tiny::_Bool';
is ref $rv->{b}, 'JSON::Tiny::_Bool',
'ref detects JSON::Tiny::_Bool type (true)';
{
local ( $JSON::Tiny::FALSE, $JSON::Tiny::TRUE ) = ( 0, 1 );
$rv = decode_json '{"a":false, "b":true}';
is $rv->{a}, 0, 'Overridden Boolean false yields 0';
is $rv->{b}, 1, 'Overridden Boolean true yields 1';
is ref $rv->{a}, '', 'Overriding Boolean false assumes correct type.';
is ref $rv->{b}, '', 'Overriding Boolean true assumes correct type.';
}
$rv = decode_json '{"a":false, "b":true}';
is ref $rv->{b}, 'JSON::Tiny::_Bool',
'JSON::Tiny::_Bool back after localized change to $JSON::Tiny::FALSE ' .
'falls from scope.';
is ref $rv->{a}, 'JSON::Tiny::_Bool',
'JSON::Tiny::_Bool back after localized change to $JSON::Tiny::TRUE ' .
'falls from scope.';
$rv = JSON::Tiny::encode_json { a=>\0, b=>\1 };
like $rv, qr/"b":true/, 'Reference to \\1 yields true.';
like $rv, qr/"a":false/, 'Reference to \\0 yields false.';
done_testing();