CPAN::Groonga

     jpeg   image/jpeg
      jpg    image/jpeg
      js     application/javascript
      json   application/json
      jxl    image/jxl
      mjs    application/javascript
      mp3    audio/mpeg
    

ontrolchar';
  warn "Client sent an invalid JSON object. Generating HTTP 400 response.\n" if $terr eq 'json';

  my $han = {
    utf8        => 400,
    json        => 400,
    controlchar => 400,
   

ader($_)), $self->reqHeader).
    "POST dump:\n".
    ($self->reqJSON()
      ? TUWF::Misc::_JSON()->new->pretty->encode($self->reqJSON())
      : join('', map sprintf("  %s: %s\n", $_, join "\n    ",

t'     || $n eq 'uint';
  $o->{type} = 'bool'   if $n eq 'anybool' || $n eq 'undefbool' || $n eq 'jsonbool';
  $o->{type} = 'num'    if $n eq 'num';
}


sub _merge {
  my($c, $o) = @_;

  _merge_type 

odd things may
# happen if this is not the case.
#   unknown => remove|reject|pass
sub coerce_for_json {
  my($o, $obj, %opt) = @_;
  $opt{unknown} ||= $o->{unknown};
  return undef if !defined $obj;

o->{values}->coerce_for_json($_, %opt), @$obj] if $o->{type} eq 'array' && $o->{values};
  return {map {
        $o->{keys}{$_}            ? ($_, $o->{keys}{$_}->coerce_for_json($obj->{$_}, %opt)) :
 

    # Error objects should be plain data structures so that they can easily
    # be converted to JSON for debugging. We have to stringify $reg in the
    # error object to ensure that.
    +{ type =>

0] = $_[0] ? 1 : 0; 1 } },
  jsonbool  => { type => 'any', func => sub {
    my $r = $_[0];
    blessed $r && (
         $r->isa('JSON::PP::Boolean')
      || $r->isa('JSON::XS::Boolean')
      || $r-

   || $r->isa('Cpanel::JSON::XS::Boolean')
      || $r->isa('boolean')
    ) ? 1 : {};
  } },

  # JSON number format, regex from http://stackoverflow.com/questions/13340717/json-numbers-regular-expre

rgument  Source
    post     reqPosts()
    get      reqGets()
    param    reqParams()
    json     reqJSON()

This method takes several different forms for the further arguments (the
examples below 

re schema will be compiled with the
L<custom_validations|TUWF/custom_validations> setting.

The C<json> source only supports the I<Hash value> form. Using the C<param>
source is discouraged, as it is 

ype => 'array', scalar => 1} >> schema.

Some examples:

  # JSON, with custom error handling
  my $validation_result = tuwf->validate(json => {
    type => 'hash',
    keys => {
      username => { l

a of
truth.

=item jsonbool => 1

Require the input to be a boolean type returned by a JSON parser. Supported
types are L<JSON::PP>, L<JSON::XS>, L<Types::Serialiser>, L<Cpanel::JSON::XS>
and L<boolea

C<< type => 'scalar' >>. Require the input to be a number formatted
using the format permitted by JSON. Note that this is slightly more restrictive
from Perl's number formatting, in that 'NaN', 'Inf' 

it faster than
TUWF::Validate, at the cost of higher memory usage and a large dependency tree.

L<JSON::Schema> is similar to Sah: It features more advanced data structure
validation, but the schema i

 > $_[1]{max};
  return 1;
}


my %default_templates = (
  # JSON number format, regex from http://stackoverflow.com/questions/13340717/json-numbers-regular-expression
  num    => { func => \&_templat

 {
  my $self = shift;
  my $what = shift;

  return _compile($_[0])->validate($self->reqJSON) if $what eq 'json';

  # 'param' is special, and not really encouraged. Create a new hash based on
  # re

riate 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.p

ERSION = '1.6';
our @EXPORT = qw|
  reqInit reqGets reqGet reqPosts reqPost reqParams reqParam reqJSON
  reqUploadMIMEs reqUploadMIME reqUploadRaws reqUploadRaw reqSaveUpload
  reqCookie reqMethod req

YPE'}||'') =~ m{^application/json(?:;.*)?$}) {
        $self->{_TUWF}{Req}{JSON} = _parse_json($data);
        die TUWF::Exception->new('json') if !$self->{_TUWF}{Req}{JSON};
      } elsif(($RENV->{'C

}, $val;
  }
  return \%dat;
}


my $_json_codec;
sub _parse_json {
  my $d = shift;
  $_json_codec ||= TUWF::Misc::_JSON()->new->utf8;

  my $res = eval { $_json_codec->decode($d) };
  return undef i

d2 reqJSON()

Returns the decoded JSON object if the request body was of type
C<application/json>; Returns C<undef> otherwise.

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)

When I<name> is not given, returns a list of all p

EXPORT = qw|
  resInit resHeader resCookie resBuffer resFd resStatus resRedirect
  resNotFound resJSON resBinary resFile resFinish
|;


# try to load PerlIO::gzip, resBuffer will check for its availab

lf);
}


my $_json_codec;
sub resJSON {
  my($self, $obj) = @_;
  $_json_codec ||= TUWF::Misc::_JSON()->new->convert_blessed->utf8;

  $self->resHeader('Content-Type' => 'application/json; charset=UTF

-8');
  $self->resBinary($_json_codec->encode($obj), 'clear');
}


sub resBinary {
  my($self, $data, $buffer) = @_;
  my $enc = $self->resBuffer($buffer//'none', 'noutf8');

  if($enc eq 'none') {
  

nd cookies set before calling C<resRedirect()>.

=head2 resJSON(data)

Sets the content type to C<application/json> and sends the encoded JSON object
to the client.

=head2 resBinary(data, buffer_acti

un the standalone HTTP server.

=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 

UWF::any ['get'], '/literal.json', sub {
    # This code will be called on "GET /literal.json"
    # But NOT on "GET /literalXjson"
  };

  TUWF::any ['get'], qr{/regex.json}, sub {
    # This code wi

ll be called on "GET /regex.json"
    # And also on "GET /regexXjson"
  };

  TUWF::any ['get','head'], qr{/user/(?<uid>\d+)}, sub {
    # This code will be called on a "GET /user/123".
    # The user