commit 17f03193ad694be2b10ddde0683033b875cac3d6 Author: Mario Fetka Date: Tue Mar 27 21:25:33 2018 +0200 Imported Upstream version 0.58 diff --git a/Changes b/Changes new file mode 100644 index 0000000..09773ae --- /dev/null +++ b/Changes @@ -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. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..a582bc5 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..768649b --- /dev/null +++ b/MANIFEST @@ -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 + diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..11cab8f --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,15 @@ +^\.git +^Makefile$ +^blib/ +^MakeMaker-\d +\.tar\.gz +^JSON-Tiny-[\d._]+/ +~$ +\.old$ +^#.*#$ +^\.# +\.gz$ +^MYMETA +pm_to_blib +cover +^JSON-Tiny$ diff --git a/META.json b/META.json new file mode 100644 index 0000000..3f57f82 --- /dev/null +++ b/META.json @@ -0,0 +1,61 @@ +{ + "abstract" : "Minimalistic JSON. No dependencies.", + "author" : [ + "David Oswald " + ], + "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" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..02ee374 --- /dev/null +++ b/META.yml @@ -0,0 +1,30 @@ +--- +abstract: 'Minimalistic JSON. No dependencies.' +author: + - 'David Oswald ' +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' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..cbb2a1f --- /dev/null +++ b/Makefile.PL @@ -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 }, + 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-*' }, +); diff --git a/README b/README new file mode 100644 index 0000000..209213c --- /dev/null +++ b/README @@ -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. + diff --git a/examples/json_bench.pl b/examples/json_bench.pl new file mode 100644 index 0000000..b429056 --- /dev/null +++ b/examples/json_bench.pl @@ -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 }; diff --git a/examples/json_pp.pl b/examples/json_pp.pl new file mode 100644 index 0000000..026fa58 --- /dev/null +++ b/examples/json_pp.pl @@ -0,0 +1,10 @@ +BEGIN { $ENV{PERL_JSON_BACKEND} = 0; } # JSON::PP. + +use JSON; + +my @json + = split /-{4}/, do { open my $fh, ' }; + +sub json_pp { my $j = JSON->new; [ map { $j->decode($_) } @json ]; } + +my $value = json_pp; diff --git a/examples/json_tiny.pl b/examples/json_tiny.pl new file mode 100644 index 0000000..79e0635 --- /dev/null +++ b/examples/json_tiny.pl @@ -0,0 +1,9 @@ +use JSON::Tiny 'j'; + +my @json + = split /-{4}/, do { open my $fh, ' }; + +sub json_tiny { [ map { j $_ } @json ]; } + +my $value = json_tiny; + diff --git a/examples/sample.json b/examples/sample.json new file mode 100644 index 0000000..458fcb1 --- /dev/null +++ b/examples/sample.json @@ -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"}]}} diff --git a/lib/JSON/Tiny.pm b/lib/JSON/Tiny.pm new file mode 100644 index 0000000..792b1a9 --- /dev/null +++ b/lib/JSON/Tiny.pm @@ -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; diff --git a/lib/JSON/Tiny.pod b/lib/JSON/Tiny.pod new file mode 100644 index 0000000..0062325 --- /dev/null +++ b/lib/JSON/Tiny.pod @@ -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 is a minimalistic standalone adaptation of L, from +the L 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, it is among the fastest pure-Perl implementations of +L. + +L supports normal Perl data types like scalar, array reference, +hash reference, and will try to call the L 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 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 and C will always be +escaped to make JSONP easier, and the character C to prevent XSS attacks. + +=head1 FUNCTIONS + +L 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 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 return value indicates a bare C. +Dies if decoding fails. + +=head2 to_json + + my $chars = to_json {i => '♥ Perl'}; + +Encode Perl value to JSON text without C 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: 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 to limit scope. + +=head1 Tiny + +JSON::Tiny compared with JSON::PP from the L distribution: + +=over 4 + +=item * L is configurable, but more complex. L offers +sane defaults, and no configuration. + +=item * Download and install with C: L, 5.2 seconds. +L, 1.9 seconds. + +=item * Minimal Dependencies: Both L and L only use core +dependencies. JSON::Tiny requires Perl 5.8.4, while L requires 5.6. + +=item * Simple Design: L has 2254 lines of code, six modules and five +files. Distribution: 85KB. + +L has under 300 lines of code; an embeddable single-file module. +Distribution: 18KB. + +=item * L has 42 functions and methods. L has seven. + +=item * Performance: + + Rate JSON_PP JSON_Tiny + JSON_PP 304/s -- -52% + JSON_Tiny 636/s 109% -- + +L uses L if it's available, in which case L wins. +See C for benchmark code. + +JSON::Tiny's lightweight design reduces its startup time compared to the +L module. This may benefit frequently run applications like CGI. + +=item * Light Memory Needs: Memory usage was tested with +L and L by running +C and C. + + 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 + +=head1 INCOMPATIBILITIES + +Incompatible with L versions older than 5.59 (ie, predating Perl +5.8.4). + +=head1 AUTHOR + +David Oswald, C<< >> + +Code and tests adapted from L. + +=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 + +=item * RT: CPAN's request tracker (bug reports) + +L + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * Search CPAN + +L + +=back + +=head1 ACKNOWLEDGEMENTS + +L team for its lightweight JSON implementation. This module was +adapted from L because it is robust, minimal, and well tested. +Mojo::JSON's tests were also adapted to a dependency-free design. + +Christian Hansen, whos L +formed the basis for L, and subsequently JSON::Tiny. + +Randal Schwartz showed his pure-regexp JSON parser +(L) 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 for more information. + +=head1 SEE ALSO + +L, L, L. + +=cut diff --git a/t/01-manifest.t b/t/01-manifest.t new file mode 100644 index 0000000..e6e60c4 --- /dev/null +++ b/t/01-manifest.t @@ -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(); diff --git a/t/02-pod.t b/t/02-pod.t new file mode 100644 index 0000000..f8ead3a --- /dev/null +++ b/t/02-pod.t @@ -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(); diff --git a/t/03-pod-coverage.t b/t/03-pod-coverage.t new file mode 100644 index 0000000..08b66bb --- /dev/null +++ b/t/03-pod-coverage.t @@ -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/ ]} +); diff --git a/t/04-perlcritic.t b/t/04-perlcritic.t new file mode 100644 index 0000000..fa8fcf2 --- /dev/null +++ b/t/04-perlcritic.t @@ -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); diff --git a/t/05-load-prereqs.t b/t/05-load-prereqs.t new file mode 100644 index 0000000..87802ac --- /dev/null +++ b/t/05-load-prereqs.t @@ -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/; } diff --git a/t/09-changes.t b/t/09-changes.t new file mode 100644 index 0000000..d5eb3b8 --- /dev/null +++ b/t/09-changes.t @@ -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(); diff --git a/t/10-load-can.t b/t/10-load-can.t new file mode 100644 index 0000000..a91d1de --- /dev/null +++ b/t/10-load-can.t @@ -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 ); diff --git a/t/13-kwalitee.t b/t/13-kwalitee.t new file mode 100644 index 0000000..684911b --- /dev/null +++ b/t/13-kwalitee.t @@ -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; +} diff --git a/t/20-mojo-json.t b/t/20-mojo-json.t new file mode 100644 index 0000000..ee8ab7b --- /dev/null +++ b/t/20-mojo-json.t @@ -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 <{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"]; +is $bytes, '["\u2028test\u2029123<\/script>"]', + 'escaped u2028, u2029 and slash'; +is_deeply decode_json($bytes), ["\x{2028}test\x{2029}123"], + '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(); diff --git a/t/21-j-dies.t b/t/21-j-dies.t new file mode 100644 index 0000000..b106ed8 --- /dev/null +++ b/t/21-j-dies.t @@ -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.'; diff --git a/t/22-bool.t b/t/22-bool.t new file mode 100644 index 0000000..3f3f8ae --- /dev/null +++ b/t/22-bool.t @@ -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();