diff options
author | Yorhel <git@yorhel.nl> | 2019-08-15 11:53:50 +0200 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2019-08-15 11:55:30 +0200 |
commit | 28f18ff529fade0b87763aae75c0c261ebce2387 (patch) | |
tree | c8b2bf4da1d1f386601e35b123cc151b30be381e | |
parent | 0fc969cdc0ec13bbd01344ed7e1b666264df8de4 (diff) |
Add support for JSON::PP and Cpanel::JSON::PP
Mainly motivated by the fact that JSON::PP is now in core, so that's one
less dependency. Cpanel::JSON::PP is supported because some people like
it and to avoid loading multiple JSON modules in a single process.
TUWF prefers whatever module is already in memory, so if you load
JSON::PP at any point before using TUWF's JSON functionality you will
not benefit from the XS performance.
-rw-r--r-- | lib/TUWF.pm | 2 | ||||
-rw-r--r-- | lib/TUWF.pod | 3 | ||||
-rw-r--r-- | lib/TUWF/Misc.pm | 13 | ||||
-rw-r--r-- | lib/TUWF/Request.pm | 7 | ||||
-rw-r--r-- | lib/TUWF/Request.pod | 5 | ||||
-rw-r--r-- | lib/TUWF/Response.pm | 6 |
6 files changed, 26 insertions, 10 deletions
diff --git a/lib/TUWF.pm b/lib/TUWF.pm index 612696b..651c3be 100644 --- a/lib/TUWF.pm +++ b/lib/TUWF.pm @@ -488,7 +488,7 @@ sub _handle_error { join('', map sprintf(" %s: %s\n", $_, $self->reqHeader($_)), $self->reqHeader). "POST dump:\n". ($self->reqJSON() - ? JSON::XS->new->pretty->encode($self->reqJSON()) + ? TUWF::Misc::_JSON()->new->pretty->encode($self->reqJSON()) : join('', map sprintf(" %s: %s\n", $_, join "\n ", $self->reqPosts($_)), $self->reqPosts) ). "Error:\n $err\n" diff --git a/lib/TUWF.pod b/lib/TUWF.pod index 8f18f84..8b2ca87 100644 --- a/lib/TUWF.pod +++ b/lib/TUWF.pod @@ -37,7 +37,8 @@ Some optional features, however, do require extra modules: =item * L<HTTP::Server::Simple>: To run the standalone HTTP server. -=item * L<JSON::XS>: If you need to handle requests with a JSON body, or wish to output JSON yourself. +=item * L<JSON::XS>, L<Cpanel::JSON::XS> or L<JSON::PP>: If you need to handle +requests with a JSON body or wish to output JSON yourself. =item * L<PerlIO::gzip>: For output compression. diff --git a/lib/TUWF/Misc.pm b/lib/TUWF/Misc.pm index 6c08aff..e887409 100644 --- a/lib/TUWF/Misc.pm +++ b/lib/TUWF/Misc.pm @@ -231,4 +231,17 @@ sub TUWF::Object::validate { _compile({ type => 'hash', keys => { @_ } })->validate($source); } + +# Internal function used by other TUWF modules to find an appropriate JSON +# module. Kinda like JSON::MaybeXS, but without an extra dependency. +sub _JSON { + return 'JSON::XS' if $INC{'JSON/XS.pm'}; + return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'}; + return 'JSON::PP' if $INC{'JSON/PP.pm'}; + return 'JSON::XS' if eval { require JSON::XS; 1 }; + return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS; 1 }; + die "Unable to load a suitable JSON module: $@" if !eval { require JSON::PP; 1 }; + 'JSON::PP' +} + 1; diff --git a/lib/TUWF/Request.pm b/lib/TUWF/Request.pm index c7054eb..0cec70e 100644 --- a/lib/TUWF/Request.pm +++ b/lib/TUWF/Request.pm @@ -96,11 +96,12 @@ sub _parse_urlencoded { } +my $_json_codec; sub _parse_json { my $d = shift; - die "Received a JSON request body, but was unable to load JSON::XS. Is it installed?\n" - unless eval { require JSON::XS; 1 }; - my $res = eval { JSON::XS::decode_json($d) }; + $_json_codec ||= TUWF::Misc::_JSON()->new->utf8; + + my $res = eval { $_json_codec->decode($d) }; return undef if !$res || ref $res ne 'HASH'; # We always expect to receive a JSON object. return $res; } diff --git a/lib/TUWF/Request.pod b/lib/TUWF/Request.pod index 44b8050..af1f221 100644 --- a/lib/TUWF/Request.pod +++ b/lib/TUWF/Request.pod @@ -82,8 +82,9 @@ is returned. Returns the decoded JSON object if the request body was of type C<application/json>; Returns C<undef> otherwise. -This requires the L<JSON::XS> module. If this module is not available, any -request with a JSON body will automatically get a 500 response. +This requires either the L<JSON::XS>, L<Cpanel::JSON::XS> or L<JSON::PP> +module. If none of these modules is not available, any request with a JSON body +will automatically get a 500 response. =head2 reqUploadMIMEs(name) diff --git a/lib/TUWF/Response.pm b/lib/TUWF/Response.pm index 9918879..21e6fce 100644 --- a/lib/TUWF/Response.pm +++ b/lib/TUWF/Response.pm @@ -185,14 +185,14 @@ sub resNotFound { } +my $_json_codec; sub resJSON { my($self, $obj) = @_; - croak "Unable to load JSON::XS, is it installed?\n" - unless eval { require JSON::XS; 1 }; + $_json_codec ||= TUWF::Misc::_JSON()->new->utf8; $self->resHeader('Content-Type' => 'application/json; charset=UTF-8'); $self->resBuffer('clear'); - $self->resBinary(JSON::XS::encode_json($obj)); + $self->resBinary($_json_codec->encode($obj)); } |