summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-08-15 11:53:50 +0200
committerYorhel <git@yorhel.nl>2019-08-15 11:55:30 +0200
commit28f18ff529fade0b87763aae75c0c261ebce2387 (patch)
treec8b2bf4da1d1f386601e35b123cc151b30be381e
parent0fc969cdc0ec13bbd01344ed7e1b666264df8de4 (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.pm2
-rw-r--r--lib/TUWF.pod3
-rw-r--r--lib/TUWF/Misc.pm13
-rw-r--r--lib/TUWF/Request.pm7
-rw-r--r--lib/TUWF/Request.pod5
-rw-r--r--lib/TUWF/Response.pm6
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));
}