—

              
#!/usr/bin/env perl
# This chunk of stuff was generated by App::FatPacker. To find the original
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
BEGIN {
my %fatpacked;
$fatpacked{"JSON.pm"} = <<'JSON';
  package JSON;
   
   
  use strict;
  use Carp ();
  use base qw(Exporter);
  @JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json);
   
  BEGIN {
      $JSON::VERSION = '2.50';
      $JSON::DEBUG   = 0 unless (defined $JSON::DEBUG);
      $JSON::DEBUG   = $ENV{ PERL_JSON_DEBUG } if exists $ENV{ PERL_JSON_DEBUG };
  }
   
  my $Module_XS  = 'JSON::XS';
  my $Module_PP  = 'JSON::PP';
  my $Module_bp  = 'JSON::backportPP'; # included in JSON distribution
  my $PP_Version = '2.27101';
  my $XS_Version = '2.27';
   
   
  # XS and PP common methods
   
  my @PublicMethods = qw/
      ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref 
      allow_blessed convert_blessed filter_json_object filter_json_single_key_object 
      shrink max_depth max_size encode decode decode_prefix allow_unknown
  /;
   
  my @Properties = qw/
      ascii latin1 utf8 indent space_before space_after relaxed canonical allow_nonref
      allow_blessed convert_blessed shrink max_depth max_size allow_unknown
  /;
   
  my @XSOnlyMethods = qw//; # Currently nothing
   
  my @PPOnlyMethods = qw/
      indent_length sort_by
      allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed
  /; # JSON::PP specific
   
   
  # used in _load_xs and _load_pp ($INSTALL_ONLY is not used currently)
  my $_INSTALL_DONT_DIE  = 1; # When _load_xs fails to load XS, don't die.
  my $_INSTALL_ONLY      = 2; # Don't call _set_methods()
  my $_ALLOW_UNSUPPORTED = 0;
  my $_UNIV_CONV_BLESSED = 0;
  my $_USSING_bpPP       = 0;
   
   
  # Check the environment variable to decide worker module. 
   
  unless ($JSON::Backend) {
      $JSON::DEBUG and  Carp::carp("Check used worker module...");
   
      my $backend = exists $ENV{PERL_JSON_BACKEND} ? $ENV{PERL_JSON_BACKEND} : 1;
   
      if ($backend eq '1' or $backend =~ /JSON::XS\s*,\s*JSON::PP/) {
          _load_xs($_INSTALL_DONT_DIE) or _load_pp();
      }
      elsif ($backend eq '0' or $backend eq 'JSON::PP') {
          _load_pp();
      }
      elsif ($backend eq '2' or $backend eq 'JSON::XS') {
          _load_xs();
      }
      elsif ($backend eq 'JSON::backportPP') {
          $_USSING_bpPP = 1;
          _load_pp();
      }
      else {
          Carp::croak "The value of environmental variable 'PERL_JSON_BACKEND' is invalid.";
      }
  }
   
   
  sub import {
      my $pkg = shift;
      my @what_to_export;
      my $no_export;
   
      for my $tag (@_) {
          if ($tag eq '-support_by_pp') {
              if (!$_ALLOW_UNSUPPORTED++) {
                  JSON::Backend::XS
                      ->support_by_pp(@PPOnlyMethods) if ($JSON::Backend eq $Module_XS);
              }
              next;
          }
          elsif ($tag eq '-no_export') {
              $no_export++, next;
          }
          elsif ( $tag eq '-convert_blessed_universally' ) {
              eval q|
                  require B;
                  *UNIVERSAL::TO_JSON = sub {
                      my $b_obj = B::svref_2object( $_[0] );
                      return    $b_obj->isa('B::HV') ? { %{ $_[0] } }
                              : $b_obj->isa('B::AV') ? [ @{ $_[0] } ]
                              : undef
                              ;
                  }
              | if ( !$_UNIV_CONV_BLESSED++ );
              next;
          }
          push @what_to_export, $tag;
      }
   
      return if ($no_export);
   
      __PACKAGE__->export_to_level(1, $pkg, @what_to_export);
  }
   
   
  # OBSOLETED
   
  sub jsonToObj {
      my $alternative = 'from_json';
      if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) {
          shift @_; $alternative = 'decode';
      }
      Carp::carp "'jsonToObj' will be obsoleted. Please use '$alternative' instead.";
      return JSON::from_json(@_);
  };
   
  sub objToJson {
      my $alternative = 'to_json';
      if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) {
          shift @_; $alternative = 'encode';
      }
      Carp::carp "'objToJson' will be obsoleted. Please use '$alternative' instead.";
      JSON::to_json(@_);
  };
   
   
  # INTERFACES
   
  sub to_json ($@) {
      if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) {
          Carp::croak "to_json should not be called as a method.";
      }
      my $json = new JSON;
   
      if (@_ == 2 and ref $_[1] eq 'HASH') {
          my $opt  = $_[1];
          for my $method (keys %$opt) {
              $json->$method( $opt->{$method} );
          }
      }
   
      $json->encode($_[0]);
  }
   
   
  sub from_json ($@) {
      if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) {
          Carp::croak "from_json should not be called as a method.";
      }
      my $json = new JSON;
   
      if (@_ == 2 and ref $_[1] eq 'HASH') {
          my $opt  = $_[1];
          for my $method (keys %$opt) {
              $json->$method( $opt->{$method} );
          }
      }
   
      return $json->decode( $_[0] );
  }
   
   
  sub true  { $JSON::true  }
   
  sub false { $JSON::false }
   
  sub null  { undef; }
   
   
  sub require_xs_version { $XS_Version; }
   
  sub backend {
      my $proto = shift;
      $JSON::Backend;
  }
   
  #*module = *backend;
   
   
  sub is_xs {
      return $_[0]->module eq $Module_XS;
  }
   
   
  sub is_pp {
      return not $_[0]->xs;
  }
   
   
  sub pureperl_only_methods { @PPOnlyMethods; }
   
   
  sub property {
      my ($self, $name, $value) = @_;
   
      if (@_ == 1) {
          my %props;
          for $name (@Properties) {
              my $method = 'get_' . $name;
              if ($name eq 'max_size') {
                  my $value = $self->$method();
                  $props{$name} = $value == 1 ? 0 : $value;
                  next;
              }
              $props{$name} = $self->$method();
          }
          return \%props;
      }
      elsif (@_ > 3) {
          Carp::croak('property() can take only the option within 2 arguments.');
      }
      elsif (@_ == 2) {
          if ( my $method = $self->can('get_' . $name) ) {
              if ($name eq 'max_size') {
                  my $value = $self->$method();
                  return $value == 1 ? 0 : $value;
              }
              $self->$method();
          }
      }
      else {
          $self->$name($value);
      }
   
  }
   
   
   
  # INTERNAL
   
  sub _load_xs {
      my $opt = shift;
   
      $JSON::DEBUG and Carp::carp "Load $Module_XS.";
   
      # if called after install module, overload is disable.... why?
      JSON::Boolean::_overrride_overload($Module_XS);
      JSON::Boolean::_overrride_overload($Module_PP);
   
      eval qq|
          use $Module_XS $XS_Version ();
      |;
   
      if ($@) {
          if (defined $opt and $opt & $_INSTALL_DONT_DIE) {
              $JSON::DEBUG and Carp::carp "Can't load $Module_XS...($@)";
              return 0;
          }
          Carp::croak $@;
      }
   
      unless (defined $opt and $opt & $_INSTALL_ONLY) {
          _set_module( $JSON::Backend = $Module_XS );
          my $data = join("", <DATA>); # this code is from Jcode 2.xx.
          close(DATA);
          eval $data;
          JSON::Backend::XS->init;
      }
   
      return 1;
  };
   
   
  sub _load_pp {
      my $opt = shift;
      my $backend = $_USSING_bpPP ? $Module_bp : $Module_PP;
   
      $JSON::DEBUG and Carp::carp "Load $backend.";
   
      # if called after install module, overload is disable.... why?
      JSON::Boolean::_overrride_overload($Module_XS);
      JSON::Boolean::_overrride_overload($backend);
   
      if ( $_USSING_bpPP ) {
          eval qq| require $backend |;
      }
      else {
          eval qq| use $backend $PP_Version () |;
      }
   
      if ($@) {
          if ( $backend eq $Module_PP ) {
              $JSON::DEBUG and Carp::carp "Can't load $Module_PP ($@), so try to load $Module_bp";
              $_USSING_bpPP++;
              $backend = $Module_bp;
              JSON::Boolean::_overrride_overload($backend);
              local $^W; # if PP installed but invalid version, backportPP redifines methods.
              eval qq| require $Module_bp |;
          }
          Carp::croak $@ if $@;
      }
   
      unless (defined $opt and $opt & $_INSTALL_ONLY) {
          _set_module( $JSON::Backend = $Module_PP ); # even if backportPP, set $Backend with 'JSON::PP'
          JSON::Backend::PP->init;
      }
  };
   
   
  sub _set_module {
      return if defined $JSON::true;
   
      my $module = shift;
   
      local $^W;
      no strict qw(refs);
   
      $JSON::true  = ${"$module\::true"};
      $JSON::false = ${"$module\::false"};
   
      push @JSON::ISA, $module;
      push @{"$module\::Boolean::ISA"}, qw(JSON::Boolean);
   
      *{"JSON::is_bool"} = \&{"$module\::is_bool"};
   
      for my $method ($module eq $Module_XS ? @PPOnlyMethods : @XSOnlyMethods) {
          *{"JSON::$method"} = sub {
              Carp::carp("$method is not supported in $module.");
              $_[0];
          };
      }
   
      return 1;
  }
   
   
   
  #
  # JSON Boolean
  #
   
  package JSON::Boolean;
   
  my %Installed;
   
  sub _overrride_overload {
      return if ($Installed{ $_[0] }++);
   
      my $boolean = $_[0] . '::Boolean';
   
      eval sprintf(q|
          package %s;
          use overload (
              '""' => sub { ${$_[0]} == 1 ? 'true' : 'false' },
              'eq' => sub {
                  my ($obj, $op) = ref ($_[0]) ? ($_[0], $_[1]) : ($_[1], $_[0]);
                  if ($op eq 'true' or $op eq 'false') {
                      return "$obj" eq 'true' ? 'true' eq $op : 'false' eq $op;
                  }
                  else {
                      return $obj ? 1 == $op : 0 == $op;
                  }
              },
          );
      |, $boolean);
   
      if ($@) { Carp::croak $@; }
   
      return 1;
  }
   
   
  #
  # Helper classes for Backend Module (PP)
  #
   
  package JSON::Backend::PP;
   
  sub init {
      local $^W;
      no strict qw(refs); # this routine may be called after JSON::Backend::XS init was called.
      *{"JSON::decode_json"} = \&{"JSON::PP::decode_json"};
      *{"JSON::encode_json"} = \&{"JSON::PP::encode_json"};
      *{"JSON::PP::is_xs"}  = sub { 0 };
      *{"JSON::PP::is_pp"}  = sub { 1 };
      return 1;
  }
   
  #
  # To save memory, the below lines are read only when XS backend is used.
  #
   
  package JSON;
   
  1;
  __DATA__
   
   
  #
  # Helper classes for Backend Module (XS)
  #
   
  package JSON::Backend::XS;
   
  use constant INDENT_LENGTH_FLAG => 15 << 12;
   
  use constant UNSUPPORTED_ENCODE_FLAG => {
      ESCAPE_SLASH      => 0x00000010,
      ALLOW_BIGNUM      => 0x00000020,
      AS_NONBLESSED     => 0x00000040,
      EXPANDED          => 0x10000000, # for developer's
  };
   
  use constant UNSUPPORTED_DECODE_FLAG => {
      LOOSE             => 0x00000001,
      ALLOW_BIGNUM      => 0x00000002,
      ALLOW_BAREKEY     => 0x00000004,
      ALLOW_SINGLEQUOTE => 0x00000008,
      EXPANDED          => 0x20000000, # for developer's
  };
   
   
  sub init {
      local $^W;
      no strict qw(refs);
      *{"JSON::decode_json"} = \&{"JSON::XS::decode_json"};
      *{"JSON::encode_json"} = \&{"JSON::XS::encode_json"};
      *{"JSON::XS::is_xs"}  = sub { 1 };
      *{"JSON::XS::is_pp"}  = sub { 0 };
      return 1;
  }
   
   
  sub support_by_pp {
      my ($class, @methods) = @_;
   
      local $^W;
      no strict qw(refs);
   
      my $JSON_XS_encode_orignal     = \&JSON::XS::encode;
      my $JSON_XS_decode_orignal     = \&JSON::XS::decode;
      my $JSON_XS_incr_parse_orignal = \&JSON::XS::incr_parse;
   
      *JSON::XS::decode     = \&JSON::Backend::XS::Supportable::_decode;
      *JSON::XS::encode     = \&JSON::Backend::XS::Supportable::_encode;
      *JSON::XS::incr_parse = \&JSON::Backend::XS::Supportable::_incr_parse;
   
      *{JSON::XS::_original_decode}     = $JSON_XS_decode_orignal;
      *{JSON::XS::_original_encode}     = $JSON_XS_encode_orignal;
      *{JSON::XS::_original_incr_parse} = $JSON_XS_incr_parse_orignal;
   
      push @JSON::Backend::XS::Supportable::ISA, 'JSON';
   
      my $pkg = 'JSON::Backend::XS::Supportable';
   
      *{JSON::new} = sub {
          my $proto = new JSON::XS; $$proto = 0;
          bless  $proto, $pkg;
      };
   
   
      for my $method (@methods) {
          my $flag = uc($method);
          my $type |= (UNSUPPORTED_ENCODE_FLAG->{$flag} || 0);
             $type |= (UNSUPPORTED_DECODE_FLAG->{$flag} || 0);
   
          next unless($type);
   
          $pkg->_make_unsupported_method($method => $type);
      }
   
      push @{"JSON::XS::Boolean::ISA"}, qw(JSON::PP::Boolean);
      push @{"JSON::PP::Boolean::ISA"}, qw(JSON::Boolean);
   
      $JSON::DEBUG and Carp::carp("set -support_by_pp mode.");
   
      return 1;
  }
   
   
   
   
  #
  # Helper classes for XS
  #
   
  package JSON::Backend::XS::Supportable;
   
  $Carp::Internal{'JSON::Backend::XS::Supportable'} = 1;
   
  sub _make_unsupported_method {
      my ($pkg, $method, $type) = @_;
   
      local $^W;
      no strict qw(refs);
   
      *{"$pkg\::$method"} = sub {
          local $^W;
          if (defined $_[1] ? $_[1] : 1) {
              ${$_[0]} |= $type;
          }
          else {
              ${$_[0]} &= ~$type;
          }
          $_[0];
      };
   
      *{"$pkg\::get_$method"} = sub {
          ${$_[0]} & $type ? 1 : '';
      };
   
  }
   
   
  sub _set_for_pp {
      JSON::_load_pp( $_INSTALL_ONLY );
   
      my $type  = shift;
      my $pp    = new JSON::PP;
      my $prop = $_[0]->property;
   
      for my $name (keys %$prop) {
          $pp->$name( $prop->{$name} ? $prop->{$name} : 0 );
      }
   
      my $unsupported = $type eq 'encode' ? JSON::Backend::XS::UNSUPPORTED_ENCODE_FLAG
                                          : JSON::Backend::XS::UNSUPPORTED_DECODE_FLAG;
      my $flags       = ${$_[0]} || 0;
   
      for my $name (keys %$unsupported) {
          next if ($name eq 'EXPANDED'); # for developer's
          my $enable = ($flags & $unsupported->{$name}) ? 1 : 0;
          my $method = lc $name;
          $pp->$method($enable);
      }
   
      $pp->indent_length( $_[0]->get_indent_length );
   
      return $pp;
  }
   
  sub _encode { # using with PP encod
      if (${$_[0]}) {
          _set_for_pp('encode' => @_)->encode($_[1]);
      }
      else {
          $_[0]->_original_encode( $_[1] );
      }
  }
   
   
  sub _decode { # if unsupported-flag is set, use PP
      if (${$_[0]}) {
          _set_for_pp('decode' => @_)->decode($_[1]);
      }
      else {
          $_[0]->_original_decode( $_[1] );
      }
  }
   
   
  sub decode_prefix { # if unsupported-flag is set, use PP
      _set_for_pp('decode' => @_)->decode_prefix($_[1]);
  }
   
   
  sub _incr_parse {
      if (${$_[0]}) {
          _set_for_pp('decode' => @_)->incr_parse($_[1]);
      }
      else {
          $_[0]->_original_incr_parse( $_[1] );
      }
  }
   
   
  sub get_indent_length {
      ${$_[0]} << 4 >> 16;
  }
   
   
  sub indent_length {
      my $length = $_[1];
   
      if (!defined $length or $length > 15 or $length < 0) {
          Carp::carp "The acceptable range of indent_length() is 0 to 15.";
      }
      else {
          local $^W;
          $length <<= 12;
          ${$_[0]} &= ~ JSON::Backend::XS::INDENT_LENGTH_FLAG;
          ${$_[0]} |= $length;
          *JSON::XS::encode = \&JSON::Backend::XS::Supportable::_encode;
      }
   
      $_[0];
  }
   
   
  1;
  __END__
   
  =head1 NAME
   
  JSON - JSON (JavaScript Object Notation) encoder/decoder
   
  =head1 SYNOPSIS
   
   use JSON; # imports encode_json, decode_json, to_json and from_json.
    
   # simple and fast interfaces (expect/generate UTF-8)
    
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
    
   # OO-interface
    
   $json = JSON->new->allow_nonref;
    
   $json_text   = $json->encode( $perl_scalar );
   $perl_scalar = $json->decode( $json_text );
    
   $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
    
   # If you want to use PP only support features, call with '-support_by_pp'
   # When XS unsupported feature is enable, using PP (de|en)code instead of XS ones.
    
   use JSON -support_by_pp;
    
   # option-acceptable interfaces (expect/generate UNICODE by default)
    
   $json_text   = to_json( $perl_scalar, { ascii => 1, pretty => 1 } );
   $perl_scalar = from_json( $json_text, { utf8  => 1 } );
    
   # Between (en|de)code_json and (to|from)_json, if you want to write
   # a code which communicates to an outer world (encoded in UTF-8),
   # recommend to use (en|de)code_json.
    
  =head1 VERSION
   
      2.50
   
  This version is compatible with JSON::XS B<2.27> and later.
   
   
  =head1 NOTE
   
  JSON::PP was inculded in C<JSON> distribution.
  It comes to be a perl core module in Perl 5.14.
  And L<JSON::PP> will be split away it.
   
  C<JSON> distribution will inculde yet another JSON::PP modules.
  They are JSNO::backportPP and so on. JSON.pm should work as it did at all.
   
  =head1 DESCRIPTION
   
   ************************** CAUTION ********************************
   * This is 'JSON module version 2' and there are many differences  *
   * to version 1.xx                                                 *
   * Please check your applications useing old version.              *
   *   See to 'INCOMPATIBLE CHANGES TO OLD VERSION'                  *
   *******************************************************************
   
  JSON (JavaScript Object Notation) is a simple data format.
  See to L<http://www.json.org/> and C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>).
   
  This module converts Perl data structures to JSON and vice versa using either
  L<JSON::XS> or L<JSON::PP>.
   
  JSON::XS is the fastest and most proper JSON module on CPAN which must be
  compiled and installed in your environment.
  JSON::PP is a pure-Perl module which is bundled in this distribution and
  has a strong compatibility to JSON::XS.
   
  This module try to use JSON::XS by default and fail to it, use JSON::PP instead.
  So its features completely depend on JSON::XS or JSON::PP.
   
  See to L<BACKEND MODULE DECISION>.
   
  To distinguish the module name 'JSON' and the format type JSON,
  the former is quoted by CE<lt>E<gt> (its results vary with your using media),
  and the latter is left just as it is.
   
  Module name : C<JSON>
   
  Format type : JSON
   
  =head2 FEATURES
   
  =over
   
  =item * correct unicode handling
   
  This module (i.e. backend modules) knows how to handle Unicode, documents
  how and when it does so, and even documents what "correct" means.
   
  Even though there are limitations, this feature is available since Perl version 5.6.
   
  JSON::XS requires Perl 5.8.2 (but works correctly in 5.8.8 or later), so in older versions
  C<JSON> sholud call JSON::PP as the backend which can be used since Perl 5.005.
   
  With Perl 5.8.x JSON::PP works, but from 5.8.0 to 5.8.2, because of a Perl side problem,
  JSON::PP works slower in the versions. And in 5.005, the Unicode handling is not available.
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> for more information.
   
  See also to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>
  and L<JSON::XS/ENCODING/CODESET_FLAG_NOTES>.
   
   
  =item * round-trip integrity
   
  When you serialise a perl data structure using only data types supported
  by JSON and Perl, the deserialised data structure is identical on the Perl
  level. (e.g. the string "2.0" doesn't suddenly become "2" just because
  it looks like a number). There I<are> minor exceptions to this, read the
  L</MAPPING> section below to learn about those.
   
   
  =item * strict checking of JSON correctness
   
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default (the latter is a security
  feature).
   
  See to L<JSON::XS/FEATURES> and L<JSON::PP/FEATURES>.
   
  =item * fast
   
  This module returns a JSON::XS object itself if available.
  Compared to other JSON modules and other serialisers such as Storable,
  JSON::XS usually compares favourably in terms of speed, too.
   
  If not available, C<JSON> returns a JSON::PP object instead of JSON::XS and
  it is very slow as pure-Perl.
   
  =item * simple to use
   
  This module has both a simple functional interface as well as an
  object oriented interface interface.
   
  =item * reasonably versatile output formats
   
  You can choose between the most compact guaranteed-single-line format possible
  (nice for simple line-based protocols), a pure-ASCII format (for when your transport
  is not 8-bit clean, still supports the whole Unicode range), or a pretty-printed
  format (for when you want to read that stuff). Or you can combine those features
  in whatever way you like.
   
  =back
   
  =head1 FUNCTIONAL INTERFACE
   
  Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
  C<to_json> and C<from_json> are additional functions.
   
  =head2 encode_json
   
      $json_text = encode_json $perl_scalar
   
  Converts the given Perl data structure to a UTF-8 encoded, binary string.
   
  This function call is functionally identical to:
   
      $json_text = JSON->new->utf8->encode($perl_scalar)
   
  =head2 decode_json
   
      $perl_scalar = decode_json $json_text
   
  The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
  to parse that as an UTF-8 encoded JSON text, returning the resulting
  reference.
   
  This function call is functionally identical to:
   
      $perl_scalar = JSON->new->utf8->decode($json_text)
   
   
  =head2 to_json
   
     $json_text = to_json($perl_scalar)
   
  Converts the given Perl data structure to a json string.
   
  This function call is functionally identical to:
   
     $json_text = JSON->new->encode($perl_scalar)
   
  Takes a hash reference as the second.
   
     $json_text = to_json($perl_scalar, $flag_hashref)
   
  So,
   
     $json_text = encode_json($perl_scalar, {utf8 => 1, pretty => 1})
   
  equivalent to:
   
     $json_text = JSON->new->utf8(1)->pretty(1)->encode($perl_scalar)
   
  If you want to write a modern perl code which communicates to outer world,
  you should use C<encode_json> (supposed that JSON data are encoded in UTF-8).
   
  =head2 from_json
   
     $perl_scalar = from_json($json_text)
   
  The opposite of C<to_json>: expects a json string and tries
  to parse it, returning the resulting reference.
   
  This function call is functionally identical to:
   
      $perl_scalar = JSON->decode($json_text)
   
  Takes a hash reference as the second.
   
      $perl_scalar = from_json($json_text, $flag_hashref)
   
  So,
   
      $perl_scalar = from_json($json_text, {utf8 => 1})
   
  equivalent to:
   
      $perl_scalar = JSON->new->utf8(1)->decode($json_text)
   
  If you want to write a modern perl code which communicates to outer world,
  you should use C<decode_json> (supposed that JSON data are encoded in UTF-8).
   
  =head2 JSON::is_bool
   
      $is_boolean = JSON::is_bool($scalar)
   
  Returns true if the passed scalar represents either JSON::true or
  JSON::false, two constants that act like C<1> and C<0> respectively
  and are also used to represent JSON C<true> and C<false> in Perl strings.
   
  =head2 JSON::true
   
  Returns JSON true value which is blessed object.
  It C<isa> JSON::Boolean object.
   
  =head2 JSON::false
   
  Returns JSON false value which is blessed object.
  It C<isa> JSON::Boolean object.
   
  =head2 JSON::null
   
  Returns C<undef>.
   
  See L<MAPPING>, below, for more information on how JSON values are mapped to
  Perl.
   
  =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
   
  This section supposes that your perl vresion is 5.8 or later.
   
  If you know a JSON text from an outer world - a network, a file content, and so on,
  is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
  with C<utf8> enable. And the decoded result will contain UNICODE characters.
   
    # from network
    my $json        = JSON->new->utf8;
    my $json_text   = CGI->new->param( 'json_data' );
    my $perl_scalar = $json->decode( $json_text );
     
    # from file content
    local $/;
    open( my $fh, '<', 'json.data' );
    $json_text   = <$fh>;
    $perl_scalar = decode_json( $json_text );
   
  If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
   
    use Encode;
    local $/;
    open( my $fh, '<', 'json.data' );
    my $encoding = 'cp932';
    my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
     
    # or you can write the below code.
    #
    # open( my $fh, "<:encoding($encoding)", 'json.data' );
    # $unicode_json_text = <$fh>;
   
  In this case, C<$unicode_json_text> is of course UNICODE string.
  So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable or C<from_json>.
   
    $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
    # or
    $perl_scalar = from_json( $unicode_json_text );
   
  Or C<encode 'utf8'> and C<decode_json>:
   
    $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
    # this way is not efficient.
   
  And now, you want to convert your C<$perl_scalar> into JSON data and
  send it to an outer world - a network or a file content, and so on.
   
  Your data usually contains UNICODE strings and you want the converted data to be encoded
  in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
   
    print encode_json( $perl_scalar ); # to a network? file? or display?
    # or
    print $json->utf8->encode( $perl_scalar );
   
  If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
  for some reason, then its characters are regarded as B<latin1> for perl
  (because it does not concern with your $encoding).
  You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable or C<to_json>.
  Note that the resulted text is a UNICODE string but no problem to print it.
   
    # $perl_scalar contains $encoding encoded string values
    $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
    # or 
    $unicode_json_text = to_json( $perl_scalar );
    # $unicode_json_text consists of characters less than 0x100
    print $unicode_json_text;
   
  Or C<decode $encoding> all string values and C<encode_json>:
   
    $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
    # ... do it to each string values, then encode_json
    $json_text = encode_json( $perl_scalar );
   
  This method is a proper way but probably not efficient.
   
  See to L<Encode>, L<perluniintro>.
   
   
  =head1 COMMON OBJECT-ORIENTED INTERFACE
   
  =head2 new
   
      $json = new JSON
   
  Returns a new C<JSON> object inherited from either JSON::XS or JSON::PP
  that can be used to de/encode JSON strings.
   
  All boolean flags described below are by default I<disabled>.
   
  The mutators for flags all return the JSON object again and thus calls can
  be chained:
   
     my $json = JSON->new->utf8->space_after->encode({a => [1,2]})
     => {"a": [1, 2]}
   
  =head2 ascii
   
      $json = $json->ascii([$enable])
       
      $enabled = $json->get_ascii
   
  If $enable is true (or missing), then the encode method will not generate characters outside
  the code range 0..127. Any Unicode characters outside that range will be escaped using either
  a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
   
  If $enable is false, then the encode method will not escape Unicode characters unless
  required by the JSON syntax or other flags. This results in a faster and more compact format.
   
  This feature depends on the used Perl version and environment.
   
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> if the backend is PP.
   
    JSON->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
   
  =head2 latin1
   
      $json = $json->latin1([$enable])
       
      $enabled = $json->get_latin1
   
  If $enable is true (or missing), then the encode method will encode the resulting JSON
  text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
   
  If $enable is false, then the encode method will not escape Unicode characters
  unless required by the JSON syntax or other flags.
   
    JSON->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
   
  =head2 utf8
   
      $json = $json->utf8([$enable])
       
      $enabled = $json->get_utf8
   
  If $enable is true (or missing), then the encode method will encode the JSON result
  into UTF-8, as required by many protocols, while the decode method expects to be handled
  an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
  characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
   
  In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
  encoding families, as described in RFC4627.
   
  If $enable is false, then the encode method will return the JSON string as a (non-encoded)
  Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
  (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
   
   
  Example, output UTF-16BE-encoded JSON:
   
    use Encode;
    $jsontext = encode "UTF-16BE", JSON::XS->new->encode ($object);
   
  Example, decode UTF-32LE-encoded JSON:
   
    use Encode;
    $object = JSON::XS->new->decode (decode "UTF-32LE", $jsontext);
   
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> if the backend is PP.
   
   
  =head2 pretty
   
      $json = $json->pretty([$enable])
   
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> (and in the future possibly more) flags in one call to
  generate the most readable (or most compact) form possible.
   
  Equivalent to:
   
     $json->indent->space_before->space_after
   
  The indent space length is three and JSON::XS cannot change the indent
  space length.
   
  =head2 indent
   
      $json = $json->indent([$enable])
       
      $enabled = $json->get_indent
   
  If C<$enable> is true (or missing), then the C<encode> method will use a multiline
  format as output, putting every array member or object/hash key-value pair
  into its own line, identing them properly.
   
  If C<$enable> is false, no newlines or indenting will be produced, and the
  resulting JSON text is guarenteed not to contain any C<newlines>.
   
  This setting has no effect when decoding JSON texts.
   
  The indent space length is three.
  With JSON::PP, you can also access C<indent_length> to change indent space length.
   
   
  =head2 space_before
   
      $json = $json->space_before([$enable])
       
      $enabled = $json->get_space_before
   
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space before the C<:> separating keys from values in JSON objects.
   
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
   
  This setting has no effect when decoding JSON texts.
   
  Example, space_before enabled, space_after and indent disabled:
   
     {"key" :"value"}
   
   
  =head2 space_after
   
      $json = $json->space_after([$enable])
       
      $enabled = $json->get_space_after
   
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space after the C<:> separating keys from values in JSON objects
  and extra whitespace after the C<,> separating key-value pairs and array
  members.
   
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
   
  This setting has no effect when decoding JSON texts.
   
  Example, space_before and indent disabled, space_after enabled:
   
     {"key": "value"}
   
   
  =head2 relaxed
   
      $json = $json->relaxed([$enable])
       
      $enabled = $json->get_relaxed
   
  If C<$enable> is true (or missing), then C<decode> will accept some
  extensions to normal JSON syntax (see below). C<encode> will not be
  affected in anyway. I<Be aware that this option makes you accept invalid
  JSON texts as if they were valid!>. I suggest only to use this option to
  parse application-specific files written by humans (configuration files,
  resource files etc.)
   
  If C<$enable> is false (the default), then C<decode> will only accept
  valid JSON texts.
   
  Currently accepted extensions are:
   
  =over 4
   
  =item * list items can have an end-comma
   
  JSON I<separates> array elements and key-value pairs with commas. This
  can be annoying if you write JSON texts manually and want to be able to
  quickly append elements, so this extension accepts comma at the end of
  such items not just between them:
   
     [
        1,
        2, <- this comma not normally allowed
     ]
     {
        "k1": "v1",
        "k2": "v2", <- this comma not normally allowed
     }
   
  =item * shell-style '#'-comments
   
  Whenever JSON allows whitespace, shell-style comments are additionally
  allowed. They are terminated by the first carriage-return or line-feed
  character, after which more white-space and comments are allowed.
   
    [
       1, # this comment not allowed in JSON
          # neither this one...
    ]
   
  =back
   
   
  =head2 canonical
   
      $json = $json->canonical([$enable])
       
      $enabled = $json->get_canonical
   
  If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
  by sorting their keys. This is adding a comparatively high overhead.
   
  If C<$enable> is false, then the C<encode> method will output key-value
  pairs in the order Perl stores them (which will likely change between runs
  of the same script).
   
  This option is useful if you want the same data structure to be encoded as
  the same JSON text (given the same overall settings). If it is disabled,
  the same hash might be encoded differently even if contains the same data,
  as key-value pairs have no inherent ordering in Perl.
   
  This setting has no effect when decoding JSON texts.
   
  =head2 allow_nonref
   
      $json = $json->allow_nonref([$enable])
       
      $enabled = $json->get_allow_nonref
   
  If C<$enable> is true (or missing), then the C<encode> method can convert a
  non-reference into its corresponding string, number or null JSON value,
  which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
  values instead of croaking.
   
  If C<$enable> is false, then the C<encode> method will croak if it isn't
  passed an arrayref or hashref, as JSON texts must either be an object
  or array. Likewise, C<decode> will croak if given something that is not a
  JSON object or array.
   
     JSON->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
   
  =head2 allow_unknown
   
      $json = $json->allow_unknown ([$enable])
       
      $enabled = $json->get_allow_unknown
   
  If $enable is true (or missing), then "encode" will *not* throw an
  exception when it encounters values it cannot represent in JSON (for
  example, filehandles) but instead will encode a JSON "null" value.
  Note that blessed objects are not included here and are handled
  separately by c<allow_nonref>.
   
  If $enable is false (the default), then "encode" will throw an
  exception when it encounters anything it cannot encode as JSON.
   
  This option does not affect "decode" in any way, and it is
  recommended to leave it off unless you know your communications
  partner.
   
  =head2 allow_blessed
   
      $json = $json->allow_blessed([$enable])
       
      $enabled = $json->get_allow_blessed
   
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference. Instead, the value of the
  B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
  disabled or no C<TO_JSON> method found) or a representation of the
  object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
  encoded. Has no effect on C<decode>.
   
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object.
   
   
  =head2 convert_blessed
   
      $json = $json->convert_blessed([$enable])
       
      $enabled = $json->get_convert_blessed
   
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<TO_JSON> method
  on the object's class. If found, it will be called in scalar context
  and the resulting scalar will be encoded instead of the object. If no
  C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
  to do.
   
  The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
  returns other blessed objects, those will be handled in the same
  way. C<TO_JSON> must take care of not causing an endless recursion cycle
  (== crash) in this case. The name of C<TO_JSON> was chosen because other
  methods called by the Perl core (== not by the user of the object) are
  usually in upper case letters and to avoid collisions with the C<to_json>
  function or method.
   
  This setting does not yet influence C<decode> in any way.
   
  If C<$enable> is false, then the C<allow_blessed> setting will decide what
  to do when a blessed object is found.
   
  =over
   
  =item convert_blessed_universally mode
   
  If use C<JSON> with C<-convert_blessed_universally>, the C<UNIVERSAL::TO_JSON>
  subroutine is defined as the below code:
   
     *UNIVERSAL::TO_JSON = sub {
         my $b_obj = B::svref_2object( $_[0] );
         return    $b_obj->isa('B::HV') ? { %{ $_[0] } }
                 : $b_obj->isa('B::AV') ? [ @{ $_[0] } ]
                 : undef
                 ;
     }
   
  This will cause that C<encode> method converts simple blessed objects into
  JSON objects as non-blessed object.
   
     JSON -convert_blessed_universally;
     $json->allow_blessed->convert_blessed->encode( $blessed_object )
   
  This feature is experimental and may be removed in the future.
   
  =back
   
  =head2 filter_json_object
   
      $json = $json->filter_json_object([$coderef])
   
  When C<$coderef> is specified, it will be called from C<decode> each
  time it decodes a JSON object. The only argument passed to the coderef
  is a reference to the newly-created hash. If the code references returns
  a single scalar (which need not be a reference), this value
  (i.e. a copy of that scalar to avoid aliasing) is inserted into the
  deserialised data structure. If it returns an empty list
  (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
  hash will be inserted. This setting can slow down decoding considerably.
   
  When C<$coderef> is omitted or undefined, any existing callback will
  be removed and C<decode> will not change the deserialised hash in any
  way.
   
  Example, convert all JSON objects into the integer 5:
   
     my $js = JSON->new->filter_json_object (sub { 5 });
     # returns [5]
     $js->decode ('[{}]'); # the given subroutine takes a hash reference.
     # throw an exception because allow_nonref is not enabled
     # so a lone 5 is not allowed.
     $js->decode ('{"a":1, "b":2}');
   
   
  =head2 filter_json_single_key_object
   
      $json = $json->filter_json_single_key_object($key [=> $coderef])
   
  Works remotely similar to C<filter_json_object>, but is only called for
  JSON objects having a single key named C<$key>.
   
  This C<$coderef> is called before the one specified via
  C<filter_json_object>, if any. It gets passed the single value in the JSON
  object. If it returns a single value, it will be inserted into the data
  structure. If it returns nothing (not even C<undef> but the empty list),
  the callback from C<filter_json_object> will be called next, as if no
  single-key callback were specified.
   
  If C<$coderef> is omitted or undefined, the corresponding callback will be
  disabled. There can only ever be one callback for a given key.
   
  As this callback gets called less often then the C<filter_json_object>
  one, decoding speed will not usually suffer as much. Therefore, single-key
  objects make excellent targets to serialise Perl objects into, especially
  as single-key JSON objects are as close to the type-tagged value concept
  as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
  support this in any way, so you need to make sure your data never looks
  like a serialised Perl hash.
   
  Typical names for the single object key are C<__class_whatever__>, or
  C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
  things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
  with real hashes.
   
  Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
  into the corresponding C<< $WIDGET{<id>} >> object:
   
     # return whatever is in $WIDGET{5}:
     JSON
        ->new
        ->filter_json_single_key_object (__widget__ => sub {
              $WIDGET{ $_[0] }
           })
        ->decode ('{"__widget__": 5')
   
     # this can be used with a TO_JSON method in some "widget" class
     # for serialisation to json:
     sub WidgetBase::TO_JSON {
        my ($self) = @_;
   
        unless ($self->{id}) {
           $self->{id} = ..get..some..id..;
           $WIDGET{$self->{id}} = $self;
        }
   
        { __widget__ => $self->{id} }
     }
   
   
  =head2 shrink
   
      $json = $json->shrink([$enable])
       
      $enabled = $json->get_shrink
   
  With JSON::XS, this flag resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible. This can save
  memory when your JSON texts are either very very long or you have many
  short strings. It will also try to downgrade any strings to octet-form
  if possible: perl stores strings internally either in an encoding called
  UTF-X or in octet-form. The latter cannot store everything but uses less
  space in general (and some buggy Perl or C code might even rely on that
  internal representation being used).
   
  With JSON::PP, it is noop about resizing strings but tries
  C<utf8::downgrade> to the returned string by C<encode>. See to L<utf8>.
   
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE> and L<JSON::PP/METHODS>.
   
  =head2 max_depth
   
      $json = $json->max_depth([$maximum_nesting_depth])
       
      $max_depth = $json->get_max_depth
   
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
   
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
   
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
   
  Note that nesting is implemented by recursion in C. The default value has
  been chosen to be as large as typical operating systems allow without
  crashing. (JSON::XS)
   
  With JSON::PP as the backend, when a large value (100 or more) was set and
  it de/encodes a deep nested object/text, it may raise a warning
  'Deep recursion on subroutin' at the perl runtime phase.
   
  See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.
   
  =head2 max_size
   
      $json = $json->max_size([$maximum_string_size])
       
      $max_size = $json->get_max_size
   
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
   
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
   
  See L<JSON::XS/SECURITY CONSIDERATIONS>, below, for more info on why this is useful.
   
  =head2 encode
   
      $json_text = $json->encode($perl_scalar)
   
  Converts the given Perl data structure (a simple scalar or a reference
  to a hash or array) to its JSON representation. Simple scalars will be
  converted into JSON string or number sequences, while references to arrays
  become JSON arrays and references to hashes become JSON objects. Undefined
  Perl values (e.g. C<undef>) become JSON C<null> values.
  References to the integers C<0> and C<1> are converted into C<true> and C<false>.
   
  =head2 decode
   
      $perl_scalar = $json->decode($json_text)
   
  The opposite of C<encode>: expects a JSON text and tries to parse it,
  returning the resulting simple scalar or reference. Croaks on error.
   
  JSON numbers and strings become simple Perl scalars. JSON arrays become
  Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
  C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
  C<null> becomes C<undef>.
   
  =head2 decode_prefix
   
      ($perl_scalar, $characters) = $json->decode_prefix($json_text)
   
  This works like the C<decode> method, but instead of raising an exception
  when there is trailing garbage after the first JSON object, it will
  silently stop parsing there and return the number of characters consumed
  so far.
   
     JSON->new->decode_prefix ("[1] the tail")
     => ([], 3)
   
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
   
  =head2 property
   
      $boolean = $json->property($property_name)
   
  Returns a boolean value about above some properties.
   
  The available properties are C<ascii>, C<latin1>, C<utf8>,
  C<indent>,C<space_before>, C<space_after>, C<relaxed>, C<canonical>,
  C<allow_nonref>, C<allow_unknown>, C<allow_blessed>, C<convert_blessed>,
  C<shrink>, C<max_depth> and C<max_size>.
   
     $boolean = $json->property('utf8');
      => 0
     $json->utf8;
     $boolean = $json->property('utf8');
      => 1
   
  Sets the property with a given boolean value.
   
      $json = $json->property($property_name => $boolean);
   
  With no argumnt, it returns all the above properties as a hash reference.
   
      $flag_hashref = $json->property();
   
  =head1 INCREMENTAL PARSING
   
  Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
   
  In some cases, there is the need for incremental parsing of JSON texts.
  This module does allow you to parse a JSON stream incrementally.
  It does so by accumulating text until it has a full JSON object, which
  it then can decode. This process is similar to using C<decode_prefix>
  to see if a full JSON object is available, but is much more efficient
  (and can be implemented with a minimum of method calls).
   
  The backend module will only attempt to parse the JSON text once it is sure it
  has enough text to get a decisive result, using a very simple but
  truly incremental parser. This means that it sometimes won't stop as
  early as the full parser, for example, it doesn't detect parenthese
  mismatches. The only thing it guarantees is that it starts decoding as
  soon as a syntactically valid JSON text has been seen. This means you need
  to set resource limits (e.g. C<max_size>) to ensure the parser will stop
  parsing in the presence if syntax errors.
   
  The following methods implement this incremental parser.
   
  =head2 incr_parse
   
      $json->incr_parse( [$string] ) # void context
       
      $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
       
      @obj_or_empty = $json->incr_parse( [$string] ) # list context
   
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
   
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
   
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
   
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the errornous part). This is the most common way of
  using the method.
   
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
   
  Example: Parse some JSON arrays/objects in a given string and return them.
   
      my @objs = JSON->new->incr_parse ("[5][7][1,2]");
   
  =head2 incr_text
   
      $lvalue_string = $json->incr_text
   
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object. Under
  all other circumstances you must not call this function (I mean it.
  although in simple tests it might actually work, it I<will> fail under
  real world conditions). As a special exception, you can also call this
  method before having parsed anything.
   
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
   
      $json->incr_text =~ s/\s*,\s*//;
   
  In Perl 5.005, C<lvalue> attribute is not available.
  You must write codes like the below:
   
      $string = $json->incr_text;
      $string =~ s/\s*,\s*//;
      $json->incr_text( $string );
   
  =head2 incr_skip
   
      $json->incr_skip
   
  This will reset the state of the incremental parser and will remove the
  parsed text from the input buffer. This is useful after C<incr_parse>
  died, in which case the input buffer and incremental parser state is left
  unchanged, to skip the text parsed so far and to reset the parse state.
   
  =head2 incr_reset
   
      $json->incr_reset
   
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
   
  This is useful if you want ot repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
   
  See to L<JSON::XS/INCREMENTAL PARSING> for examples.
   
   
  =head1 JSON::PP SUPPORT METHODS
   
  The below methods are JSON::PP own methods, so when C<JSON> works
  with JSON::PP (i.e. the created object is a JSON::PP object), available.
  See to L<JSON::PP/JSON::PP OWN METHODS> in detail.
   
  If you use C<JSON> with additonal C<-support_by_pp>, some methods
  are available even with JSON::XS. See to L<USE PP FEATURES EVEN THOUGH XS BACKEND>.
   
     BEING { $ENV{PERL_JSON_BACKEND} = 'JSON::XS' }
      
     use JSON -support_by_pp;
      
     my $json = new JSON;
     $json->allow_nonref->escape_slash->encode("/");
   
     # functional interfaces too.
     print to_json(["/"], {escape_slash => 1});
     print from_json('["foo"]', {utf8 => 1});
   
  If you do not want to all functions but C<-support_by_pp>,
  use C<-no_export>.
   
     use JSON -support_by_pp, -no_export;
     # functional interfaces are not exported.
   
  =head2 allow_singlequote
   
      $json = $json->allow_singlequote([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will accept
  any JSON strings quoted by single quotations that are invalid JSON
  format.
   
      $json->allow_singlequote->decode({"foo":'bar'});
      $json->allow_singlequote->decode({'foo':"bar"});
      $json->allow_singlequote->decode({'foo':'bar'});
   
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
   
  =head2 allow_barekey
   
      $json = $json->allow_barekey([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will accept
  bare keys of JSON object that are invalid JSON format.
   
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
   
      $json->allow_barekey->decode('{foo:"bar"}');
   
  =head2 allow_bignum
   
      $json = $json->allow_bignum([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will convert
  the big integer Perl cannot handle as integer into a L<Math::BigInt>
  object and convert a floating number (any) into a L<Math::BigFloat>.
   
  On the contary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers with C<allow_blessed> enable.
   
     $json->allow_nonref->allow_blessed->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
   
  See to L<MAPPING> aboout the conversion of JSON number.
   
  =head2 loose
   
      $json = $json->loose([$enable])
   
  The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
  and the module doesn't allow to C<decode> to these (except for \x2f).
  If C<$enable> is true (or missing), then C<decode>  will accept these
  unescaped strings.
   
      $json->loose->decode(qq|["abc
                                     def"]|);
   
  See to L<JSON::PP/JSON::PP OWN METHODS>.
   
  =head2 escape_slash
   
      $json = $json->escape_slash([$enable])
   
  According to JSON Grammar, I<slash> (U+002F) is escaped. But by default
  JSON backend modules encode strings without escaping slash.
   
  If C<$enable> is true (or missing), then C<encode> will escape slashes.
   
  =head2 indent_length
   
      $json = $json->indent_length($length)
   
  With JSON::XS, The indent space length is 3 and cannot be changed.
  With JSON::PP, it sets the indent space length with the given $length.
  The default is 3. The acceptable range is 0 to 15.
   
  =head2 sort_by
   
      $json = $json->sort_by($function_name)
      $json = $json->sort_by($subroutine_ref)
   
  If $function_name or $subroutine_ref are set, its sort routine are used.
   
     $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
   
     $js = $pc->sort_by('own_sort')->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
   
     sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
   
  As the sorting routine runs in the JSON::PP scope, the given
  subroutine name and the special variables C<$a>, C<$b> will begin
  with 'JSON::PP::'.
   
  If $integer is set, then the effect is same as C<canonical> on.
   
  See to L<JSON::PP/JSON::PP OWN METHODS>.
   
  =head1 MAPPING
   
  This section is copied from JSON::XS and modified to C<JSON>.
  JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
   
  See to L<JSON::XS/MAPPING>.
   
  =head2 JSON -> PERL
   
  =over 4
   
  =item object
   
  A JSON object becomes a reference to a hash in Perl. No ordering of object
  keys is preserved (JSON does not preserver object key ordering itself).
   
  =item array
   
  A JSON array becomes a reference to an array in Perl.
   
  =item string
   
  A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
  are represented by the same codepoints in the Perl string, so no manual
  decoding is necessary.
   
  =item number
   
  A JSON number becomes either an integer, numeric (floating point) or
  string scalar in perl, depending on its range and any fractional parts. On
  the Perl level, there is no difference between those as Perl handles all
  the conversion details, but an integer may take slightly less memory and
  might represent more values exactly than floating point numbers.
   
  If the number consists of digits only, C<JSON> will try to represent
  it as an integer value. If that fails, it will try to represent it as
  a numeric (floating point) value if that is possible without loss of
  precision. Otherwise it will preserve the number as a string value (in
  which case you lose roundtripping ability, as the JSON number will be
  re-encoded toa JSON string).
   
  Numbers containing a fractional or exponential part will always be
  represented as numeric (floating point) values, possibly at a loss of
  precision (in which case you might lose perfect roundtripping ability, but
  the JSON number will still be re-encoded as a JSON number).
   
  Note that precision is not accuracy - binary floating point values cannot
  represent most decimal fractions exactly, and when converting from and to
  floating point, C<JSON> only guarantees precision up to but not including
  the leats significant bit.
   
  If the backend is JSON::PP and C<allow_bignum> is enable, the big integers 
  and the numeric can be optionally converted into L<Math::BigInt> and
  L<Math::BigFloat> objects.
   
  =item true, false
   
  These JSON atoms become C<JSON::true> and C<JSON::false>,
  respectively. They are overloaded to act almost exactly like the numbers
  C<1> and C<0>. You can check wether a scalar is a JSON boolean by using
  the C<JSON::is_bool> function.
   
  If C<JSON::true> and C<JSON::false> are used as strings or compared as strings,
  they represent as C<true> and C<false> respectively.
   
     print JSON::true . "\n";
      => true
     print JSON::true + 1;
      => 1
   
     ok(JSON::true eq 'true');
     ok(JSON::true eq  '1');
     ok(JSON::true == 1);
   
  C<JSON> will install these missing overloading features to the backend modules.
   
   
  =item null
   
  A JSON null atom becomes C<undef> in Perl.
   
  C<JSON::null> returns C<unddef>.
   
  =back
   
   
  =head2 PERL -> JSON
   
  The mapping from Perl to JSON is slightly more difficult, as Perl is a
  truly typeless language, so we can only guess which JSON type is meant by
  a Perl value.
   
  =over 4
   
  =item hash references
   
  Perl hash references become JSON objects. As there is no inherent ordering
  in hash keys (or JSON objects), they will usually be encoded in a
  pseudo-random order that can change between runs of the same program but
  stays generally the same within a single run of a program. C<JSON>
  optionally sort the hash keys (determined by the I<canonical> flag), so
  the same datastructure will serialise to the same JSON text (given same
  settings and version of JSON::XS), but this incurs a runtime overhead
  and is only rarely useful, e.g. when you want to compare some JSON text
  against another for equality.
   
  In future, the ordered object feature will be added to JSON::PP using C<tie> mechanism.
   
   
  =item array references
   
  Perl array references become JSON arrays.
   
  =item other references
   
  Other unblessed references are generally not allowed and will cause an
  exception to be thrown, except for references to the integers C<0> and
  C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
  also use C<JSON::false> and C<JSON::true> to improve readability.
   
     to_json [\0,JSON::true]      # yields [false,true]
   
  =item JSON::true, JSON::false, JSON::null
   
  These special values become JSON true and JSON false values,
  respectively. You can also use C<\1> and C<\0> directly if you want.
   
  JSON::null returns C<undef>.
   
  =item blessed objects
   
  Blessed objects are not directly representable in JSON. See the
  C<allow_blessed> and C<convert_blessed> methods on various options on
  how to deal with this: basically, you can choose between throwing an
  exception, encoding the reference as if it weren't blessed, or provide
  your own serialiser method.
   
  With C<convert_blessed_universally> mode,  C<encode> converts blessed
  hash references or blessed array references (contains other blessed references)
  into JSON members and arrays.
   
     use JSON -convert_blessed_universally;
     JSON->new->allow_blessed->convert_blessed->encode( $blessed_object );
   
  See to L<convert_blessed>.
   
  =item simple scalars
   
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
  JSON C<null> values, scalars that have last been used in a string context
  before encoding as JSON strings, and anything else as number value:
   
     # dump as number
     encode_json [2]                      # yields [2]
     encode_json [-3.0e17]                # yields [-3e+17]
     my $value = 5; encode_json [$value]  # yields [5]
   
     # used as string, so dump as string
     print $value;
     encode_json [$value]                 # yields ["5"]
   
     # undef becomes null
     encode_json [undef]                  # yields [null]
   
  You can force the type to be a string by stringifying it:
   
     my $x = 3.1; # some variable containing a number
     "$x";        # stringified
     $x .= "";    # another, more awkward way to stringify
     print $x;    # perl does it for you, too, quite often
   
  You can force the type to be a number by numifying it:
   
     my $x = "3"; # some variable containing a string
     $x += 0;     # numify it, ensuring it will be dumped as a number
     $x *= 1;     # same thing, the choise is yours.
   
  You can not currently force the type in other, less obscure, ways.
   
  Note that numerical precision has the same meaning as under Perl (so
  binary to decimal conversion follows the same rules as in Perl, which
  can differ to other languages). Also, your perl interpreter might expose
  extensions to the floating point numbers of your platform, such as
  infinities or NaN's - these cannot be represented in JSON, and it is an
  error to pass those in.
   
  =item Big Number
   
  If the backend is JSON::PP and C<allow_bignum> is enable, 
  C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers.
   
   
  =back
   
  =head1 JSON and ECMAscript
   
  See to L<JSON::XS/JSON and ECMAscript>.
   
  =head1 JSON and YAML
   
  JSON is not a subset of YAML.
  See to L<JSON::XS/JSON and YAML>.
   
   
  =head1 BACKEND MODULE DECISION
   
  When you use C<JSON>, C<JSON> tries to C<use> JSON::XS. If this call failed, it will
  C<uses> JSON::PP. The required JSON::XS version is I<2.2> or later.
   
  The C<JSON> constructor method returns an object inherited from the backend module,
  and JSON::XS object is a blessed scaler reference while JSON::PP is a blessed hash
  reference.
   
  So, your program should not depend on the backend module, especially
  returned objects should not be modified.
   
   my $json = JSON->new; # XS or PP?
   $json->{stash} = 'this is xs object'; # this code may raise an error!
   
  To check the backend module, there are some methods - C<backend>, C<is_pp> and C<is_xs>.
   
    JSON->backend; # 'JSON::XS' or 'JSON::PP'
     
    JSON->backend->is_pp: # 0 or 1
     
    JSON->backend->is_xs: # 1 or 0
     
    $json->is_xs; # 1 or 0
     
    $json->is_pp; # 0 or 1
   
   
  If you set an enviornment variable C<PERL_JSON_BACKEND>, The calling action will be changed.
   
  =over
   
  =item PERL_JSON_BACKEND = 0 or PERL_JSON_BACKEND = 'JSON::PP'
   
  Always use JSON::PP
   
  =item PERL_JSON_BACKEND == 1 or PERL_JSON_BACKEND = 'JSON::XS,JSON::PP'
   
  (The default) Use compiled JSON::XS if it is properly compiled & installed,
  otherwise use JSON::PP.
   
  =item PERL_JSON_BACKEND == 2 or PERL_JSON_BACKEND = 'JSON::XS'
   
  Always use compiled JSON::XS, die if it isn't properly compiled & installed.
   
  =item PERL_JSON_BACKEND = 'JSON::backportPP'
   
  Always use JSON::backportPP.
  JSON::backportPP is JSON::PP back port module.
  C<JSON> includs JSON::backportPP instead of JSON::PP.
   
  =back
   
  These ideas come from L<DBI::PurePerl> mechanism.
   
  example:
   
   BEGIN { $ENV{PERL_JSON_BACKEND} = 'JSON::PP' }
   use JSON; # always uses JSON::PP
   
  In future, it may be able to specify another module.
   
  =head1 USE PP FEATURES EVEN THOUGH XS BACKEND
   
  Many methods are available with either JSON::XS or JSON::PP and
  when the backend module is JSON::XS, if any JSON::PP specific (i.e. JSON::XS unspported)
  method is called, it will C<warn> and be noop.
   
  But If you C<use> C<JSON> passing the optional string C<-support_by_pp>,
  it makes a part of those unupported methods available.
  This feature is achieved by using JSON::PP in C<de/encode>.
   
     BEGIN { $ENV{PERL_JSON_BACKEND} = 2 } # with JSON::XS
     use JSON -support_by_pp;
     my $json = new JSON;
     $json->allow_nonref->escape_slash->encode("/");
   
  At this time, the returned object is a C<JSON::Backend::XS::Supportable>
  object (re-blessed XS object), and  by checking JSON::XS unsupported flags
  in de/encoding, can support some unsupported methods - C<loose>, C<allow_bignum>,
  C<allow_barekey>, C<allow_singlequote>, C<escape_slash> and C<indent_length>.
   
  When any unsupported methods are not enable, C<XS de/encode> will be
  used as is. The switch is achieved by changing the symbolic tables.
   
  C<-support_by_pp> is effective only when the backend module is JSON::XS
  and it makes the de/encoding speed down a bit.
   
  See to L<JSON::PP SUPPORT METHODS>.
   
  =head1 INCOMPATIBLE CHANGES TO OLD VERSION
   
  There are big incompatibility between new version (2.00) and old (1.xx).
  If you use old C<JSON> 1.xx in your code, please check it.
   
  See to L<Transition ways from 1.xx to 2.xx.>
   
  =over
   
  =item jsonToObj and objToJson are obsoleted.
   
  Non Perl-style name C<jsonToObj> and C<objToJson> are obsoleted
  (but not yet deleted from the source).
  If you use these functions in your code, please replace them
  with C<from_json> and C<to_json>.
   
   
  =item Global variables are no longer available.
   
  C<JSON> class variables - C<$JSON::AUTOCONVERT>, C<$JSON::BareKey>, etc...
  - are not available any longer.
  Instead, various features can be used through object methods.
   
   
  =item Package JSON::Converter and JSON::Parser are deleted.
   
  Now C<JSON> bundles with JSON::PP which can handle JSON more properly than them.
   
  =item Package JSON::NotString is deleted.
   
  There was C<JSON::NotString> class which represents JSON value C<true>, C<false>, C<null>
  and numbers. It was deleted and replaced by C<JSON::Boolean>.
   
  C<JSON::Boolean> represents C<true> and C<false>.
   
  C<JSON::Boolean> does not represent C<null>.
   
  C<JSON::null> returns C<undef>.
   
  C<JSON> makes L<JSON::XS::Boolean> and L<JSON::PP::Boolean> is-a relation
  to L<JSON::Boolean>.
   
  =item function JSON::Number is obsoleted.
   
  C<JSON::Number> is now needless because JSON::XS and JSON::PP have
  round-trip integrity.
   
  =item JSONRPC modules are deleted.
   
  Perl implementation of JSON-RPC protocol - C<JSONRPC >, C<JSONRPC::Transport::HTTP>
  and C<Apache::JSONRPC > are deleted in this distribution.
  Instead of them, there is L<JSON::RPC> which supports JSON-RPC protocol version 1.1.
   
  =back
   
  =head2 Transition ways from 1.xx to 2.xx.
   
  You should set C<suport_by_pp> mode firstly, because
  it is always successful for the below codes even with JSON::XS.
   
      use JSON -support_by_pp;
   
  =over
   
  =item Exported jsonToObj (simple)
   
    from_json($json_text);
   
  =item Exported objToJson (simple)
   
    to_json($perl_scalar);
   
  =item Exported jsonToObj (advanced)
   
    $flags = {allow_barekey => 1, allow_singlequote => 1};
    from_json($json_text, $flags);
   
  equivalent to:
   
    $JSON::BareKey = 1;
    $JSON::QuotApos = 1;
    jsonToObj($json_text);
   
  =item Exported objToJson (advanced)
   
    $flags = {allow_blessed => 1, allow_barekey => 1};
    to_json($perl_scalar, $flags);
   
  equivalent to:
   
    $JSON::BareKey = 1;
    objToJson($perl_scalar);
   
  =item jsonToObj as object method
   
    $json->decode($json_text);
   
  =item objToJson as object method
   
    $json->encode($perl_scalar);
   
  =item new method with parameters
   
  The C<new> method in 2.x takes any parameters no longer.
  You can set parameters instead;
   
     $json = JSON->new->pretty;
   
  =item $JSON::Pretty, $JSON::Indent, $JSON::Delimiter
   
  If C<indent> is enable, that menas C<$JSON::Pretty> flag set. And
  C<$JSON::Delimiter> was substituted by C<space_before> and C<space_after>.
  In conclusion:
   
     $json->indent->space_before->space_after;
   
  Equivalent to:
   
    $json->pretty;
   
  To change indent length, use C<indent_length>.
   
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
   
    $json->pretty->indent_length(2)->encode($perl_scalar);
   
  =item $JSON::BareKey
   
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
   
    $json->allow_barekey->decode($json_text)
   
  =item $JSON::ConvBlessed
   
  use C<-convert_blessed_universally>. See to L<convert_blessed>.
   
  =item $JSON::QuotApos
   
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
   
    $json->allow_singlequote->decode($json_text)
   
  =item $JSON::SingleQuote
   
  Disable. C<JSON> does not make such a invalid JSON string any longer.
   
  =item $JSON::KeySort
   
    $json->canonical->encode($perl_scalar)
   
  This is the ascii sort.
   
  If you want to use with your own sort routine, check the C<sort_by> method.
   
  (Only with JSON::PP, even if C<-support_by_pp> is used currently.)
   
    $json->sort_by($sort_routine_ref)->encode($perl_scalar)
    
    $json->sort_by(sub { $JSON::PP::a <=> $JSON::PP::b })->encode($perl_scalar)
   
  Can't access C<$a> and C<$b> but C<$JSON::PP::a> and C<$JSON::PP::b>.
   
  =item $JSON::SkipInvalid
   
    $json->allow_unknown
   
  =item $JSON::AUTOCONVERT
   
  Needless. C<JSON> backend modules have the round-trip integrity.
   
  =item $JSON::UTF8
   
  Needless because C<JSON> (JSON::XS/JSON::PP) sets
  the UTF8 flag on properly.
   
      # With UTF8-flagged strings
   
      $json->allow_nonref;
      $str = chr(1000); # UTF8-flagged
   
      $json_text  = $json->utf8(0)->encode($str);
      utf8::is_utf8($json_text);
      # true
      $json_text  = $json->utf8(1)->encode($str);
      utf8::is_utf8($json_text);
      # false
   
      $str = '"' . chr(1000) . '"'; # UTF8-flagged
   
      $perl_scalar  = $json->utf8(0)->decode($str);
      utf8::is_utf8($perl_scalar);
      # true
      $perl_scalar  = $json->utf8(1)->decode($str);
      # died because of 'Wide character in subroutine'
   
  See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
   
  =item $JSON::UnMapping
   
  Disable. See to L<MAPPING>.
   
  =item $JSON::SelfConvert
   
  This option was deleted.
  Instead of it, if a givien blessed object has the C<TO_JSON> method,
  C<TO_JSON> will be executed with C<convert_blessed>.
   
    $json->convert_blessed->encode($bleesed_hashref_or_arrayref)
    # if need, call allow_blessed
   
  Note that it was C<toJson> in old version, but now not C<toJson> but C<TO_JSON>.
   
  =back
   
  =head1 TODO
   
  =over
   
  =item example programs
   
  =back
   
  =head1 THREADS
   
  No test with JSON::PP. If with JSON::XS, See to L<JSON::XS/THREADS>.
   
   
  =head1 BUGS
   
  Please report bugs relevant to C<JSON> to E<lt>makamaka[at]cpan.orgE<gt>.
   
   
  =head1 SEE ALSO
   
  Most of the document is copied and modified from JSON::XS doc.
   
  L<JSON::XS>, L<JSON::PP>
   
  C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>)
   
  =head1 AUTHOR
   
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
   
  JSON::XS was written by  Marc Lehmann <schmorp[at]schmorp.de>
   
  The relese of this new version owes to the courtesy of Marc Lehmann.
   
   
  =head1 COPYRIGHT AND LICENSE
   
  Copyright 2005-2010 by Makamaka Hannyaharamitu
   
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
   
  =cut
   
JSON
$fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
  package JSON::PP;
   
  # JSON-2.0
   
  use 5.005;
  use strict;
  use base qw(Exporter);
  use overload ();
   
  use Carp ();
  use B ();
  #use Devel::Peek;
   
  $JSON::PP::VERSION = '2.27102';
   
  @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
   
  # instead of hash-access, i tried index-access for speed.
  # but this method is not faster than what i expected. so it will be changed.
   
  use constant P_ASCII                => 0;
  use constant P_LATIN1               => 1;
  use constant P_UTF8                 => 2;
  use constant P_INDENT               => 3;
  use constant P_CANONICAL            => 4;
  use constant P_SPACE_BEFORE         => 5;
  use constant P_SPACE_AFTER          => 6;
  use constant P_ALLOW_NONREF         => 7;
  use constant P_SHRINK               => 8;
  use constant P_ALLOW_BLESSED        => 9;
  use constant P_CONVERT_BLESSED      => 10;
  use constant P_RELAXED              => 11;
   
  use constant P_LOOSE                => 12;
  use constant P_ALLOW_BIGNUM         => 13;
  use constant P_ALLOW_BAREKEY        => 14;
  use constant P_ALLOW_SINGLEQUOTE    => 15;
  use constant P_ESCAPE_SLASH         => 16;
  use constant P_AS_NONBLESSED        => 17;
   
  use constant P_ALLOW_UNKNOWN        => 18;
   
  use constant OLD_PERL => $] < 5.008 ? 1 : 0;
   
  BEGIN {
      my @xs_compati_bit_properties = qw(
              latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
              allow_blessed convert_blessed relaxed allow_unknown
      );
      my @pp_bit_properties = qw(
              allow_singlequote allow_bignum loose
              allow_barekey escape_slash as_nonblessed
      );
   
      # Perl version check, Unicode handling is enable?
      # Helper module sets @JSON::PP::_properties.
      if ($] < 5.008 ) {
          my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
          eval qq| require $helper |;
          if ($@) { Carp::croak $@; }
      }
   
      for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
          my $flag_name = 'P_' . uc($name);
   
          eval qq/
              sub $name {
                  my \$enable = defined \$_[1] ? \$_[1] : 1;
   
                  if (\$enable) {
                      \$_[0]->{PROPS}->[$flag_name] = 1;
                  }
                  else {
                      \$_[0]->{PROPS}->[$flag_name] = 0;
                  }
   
                  \$_[0];
              }
   
              sub get_$name {
                  \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
              }
          /;
      }
   
  }
   
   
   
  # Functions
   
  my %encode_allow_method
       = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash
                            allow_blessed convert_blessed indent indent_length allow_bignum
                            as_nonblessed
                          /;
  my %decode_allow_method
       = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum
                            allow_barekey max_size relaxed/;
   
   
  my $JSON; # cache
   
  sub encode_json ($) { # encode
      ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
  }
   
   
  sub decode_json { # decode
      ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
  }
   
  # Obsoleted
   
  sub to_json($) {
     Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
  }
   
   
  sub from_json($) {
     Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
  }
   
   
  # Methods
   
  sub new {
      my $class = shift;
      my $self  = {
          max_depth   => 512,
          max_size    => 0,
          indent      => 0,
          FLAGS       => 0,
          fallback      => sub { encode_error('Invalid value. JSON can only reference.') },
          indent_length => 3,
      };
   
      bless $self, $class;
  }
   
   
  sub encode {
      return $_[0]->PP_encode_json($_[1]);
  }
   
   
  sub decode {
      return $_[0]->PP_decode_json($_[1], 0x00000000);
  }
   
   
  sub decode_prefix {
      return $_[0]->PP_decode_json($_[1], 0x00000001);
  }
   
   
  # accessor
   
   
  # pretty printing
   
  sub pretty {
      my ($self, $v) = @_;
      my $enable = defined $v ? $v : 1;
   
      if ($enable) { # indent_length(3) for JSON::XS compatibility
          $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
      }
      else {
          $self->indent(0)->space_before(0)->space_after(0);
      }
   
      $self;
  }
   
  # etc
   
  sub max_depth {
      my $max  = defined $_[1] ? $_[1] : 0x80000000;
      $_[0]->{max_depth} = $max;
      $_[0];
  }
   
   
  sub get_max_depth { $_[0]->{max_depth}; }
   
   
  sub max_size {
      my $max  = defined $_[1] ? $_[1] : 0;
      $_[0]->{max_size} = $max;
      $_[0];
  }
   
   
  sub get_max_size { $_[0]->{max_size}; }
   
   
  sub filter_json_object {
      $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0;
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
   
  sub filter_json_single_key_object {
      if (@_ > 1) {
          $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
      }
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
   
  sub indent_length {
      if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
          Carp::carp "The acceptable range of indent_length() is 0 to 15.";
      }
      else {
          $_[0]->{indent_length} = $_[1];
      }
      $_[0];
  }
   
  sub get_indent_length {
      $_[0]->{indent_length};
  }
   
  sub sort_by {
      $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
      $_[0];
  }
   
  sub allow_bigint {
      Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.");
  }
   
  ###############################
   
  ###
  ### Perl => JSON
  ###
   
   
  { # Convert
   
      my $max_depth;
      my $indent;
      my $ascii;
      my $latin1;
      my $utf8;
      my $space_before;
      my $space_after;
      my $canonical;
      my $allow_blessed;
      my $convert_blessed;
   
      my $indent_length;
      my $escape_slash;
      my $bignum;
      my $as_nonblessed;
   
      my $depth;
      my $indent_count;
      my $keysort;
   
   
      sub PP_encode_json {
          my $self = shift;
          my $obj  = shift;
   
          $indent_count = 0;
          $depth        = 0;
   
          my $idx = $self->{PROPS};
   
          ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
              $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
           = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
                      P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
   
          ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
   
          $keysort = $canonical ? sub { $a cmp $b } : undef;
   
          if ($self->{sort_by}) {
              $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
                       : $self->{sort_by} =~ /\D+/       ? $self->{sort_by}
                       : sub { $a cmp $b };
          }
   
          encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
               if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]);
   
          my $str  = $self->object_to_json($obj);
   
          $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
   
          unless ($ascii or $latin1 or $utf8) {
              utf8::upgrade($str);
          }
   
          if ($idx->[ P_SHRINK ]) {
              utf8::downgrade($str, 1);
          }
   
          return $str;
      }
   
   
      sub object_to_json {
          my ($self, $obj) = @_;
          my $type = ref($obj);
   
          if($type eq 'HASH'){
              return $self->hash_to_json($obj);
          }
          elsif($type eq 'ARRAY'){
              return $self->array_to_json($obj);
          }
          elsif ($type) { # blessed object?
              if (blessed($obj)) {
   
                  return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
   
                  if ( $convert_blessed and $obj->can('TO_JSON') ) {
                      my $result = $obj->TO_JSON();
                      if ( defined $result and overload::Overloaded( $obj ) ) {
                          if ( overload::StrVal( $obj ) eq $result ) {
                              encode_error( sprintf(
                                  "%s::TO_JSON method returned same object as was passed instead of a new one",
                                  ref $obj
                              ) );
                          }
                      }
   
                      return $self->object_to_json( $result );
                  }
   
                  return "$obj" if ( $bignum and _is_bignum($obj) );
                  return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed.
   
                  encode_error( sprintf("encountered object '%s', but neither allow_blessed "
                      . "nor convert_blessed settings are enabled", $obj)
                  ) unless ($allow_blessed);
   
                  return 'null';
              }
              else {
                  return $self->value_to_json($obj);
              }
          }
          else{
              return $self->value_to_json($obj);
          }
      }
   
   
      sub hash_to_json {
          my ($self, $obj) = @_;
          my @res;
   
          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                           if (++$depth > $max_depth);
   
          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
          my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
   
          for my $k ( _sort( $obj ) ) {
              if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
              push @res, string_to_json( $self, $k )
                            .  $del
                            . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
          }
   
          --$depth;
          $self->_down_indent() if ($indent);
   
          return   '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' )  . '}';
      }
   
   
      sub array_to_json {
          my ($self, $obj) = @_;
          my @res;
   
          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                           if (++$depth > $max_depth);
   
          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
   
          for my $v (@$obj){
              push @res, $self->object_to_json($v) || $self->value_to_json($v);
          }
   
          --$depth;
          $self->_down_indent() if ($indent);
   
          return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']';
      }
   
   
      sub value_to_json {
          my ($self, $value) = @_;
   
          return 'null' if(!defined $value);
   
          my $b_obj = B::svref_2object(\$value);  # for round trip problem
          my $flags = $b_obj->FLAGS;
   
          return $value # as is 
              if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
   
          my $type = ref($value);
   
          if(!$type){
              return string_to_json($self, $value);
          }
          elsif( blessed($value) and  $value->isa('JSON::PP::Boolean') ){
              return $$value == 1 ? 'true' : 'false';
          }
          elsif ($type) {
              if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
                  return $self->value_to_json("$value");
              }
   
              if ($type eq 'SCALAR' and defined $$value) {
                  return   $$value eq '1' ? 'true'
                         : $$value eq '0' ? 'false'
                         : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
                         : encode_error("cannot encode reference to scalar");
              }
   
               if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
                   return 'null';
               }
               else {
                   if ( $type eq 'SCALAR' or $type eq 'REF' ) {
                      encode_error("cannot encode reference to scalar");
                   }
                   else {
                      encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
                   }
               }
   
          }
          else {
              return $self->{fallback}->($value)
                   if ($self->{fallback} and ref($self->{fallback}) eq 'CODE');
              return 'null';
          }
   
      }
   
   
      my %esc = (
          "\n" => '\n',
          "\r" => '\r',
          "\t" => '\t',
          "\f" => '\f',
          "\b" => '\b',
          "\"" => '\"',
          "\\" => '\\\\',
          "\'" => '\\\'',
      );
   
   
      sub string_to_json {
          my ($self, $arg) = @_;
   
          $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
          $arg =~ s/\//\\\//g if ($escape_slash);
          $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
   
          if ($ascii) {
              $arg = JSON_PP_encode_ascii($arg);
          }
   
          if ($latin1) {
              $arg = JSON_PP_encode_latin1($arg);
          }
   
          if ($utf8) {
              utf8::encode($arg);
          }
   
          return '"' . $arg . '"';
      }
   
   
      sub blessed_to_json {
          my $reftype = reftype($_[1]) || '';
          if ($reftype eq 'HASH') {
              return $_[0]->hash_to_json($_[1]);
          }
          elsif ($reftype eq 'ARRAY') {
              return $_[0]->array_to_json($_[1]);
          }
          else {
              return 'null';
          }
      }
   
   
      sub encode_error {
          my $error  = shift;
          Carp::croak "$error";
      }
   
   
      sub _sort {
          defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
      }
   
   
      sub _up_indent {
          my $self  = shift;
          my $space = ' ' x $indent_length;
   
          my ($pre,$post) = ('','');
   
          $post = "\n" . $space x $indent_count;
   
          $indent_count++;
   
          $pre = "\n" . $space x $indent_count;
   
          return ($pre,$post);
      }
   
   
      sub _down_indent { $indent_count--; }
   
   
      sub PP_encode_box {
          {
              depth        => $depth,
              indent_count => $indent_count,
          };
      }
   
  } # Convert
   
   
  sub _encode_ascii {
      join('',
          map {
              $_ <= 127 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
          } unpack('U*', $_[0])
      );
  }
   
   
  sub _encode_latin1 {
      join('',
          map {
              $_ <= 255 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
          } unpack('U*', $_[0])
      );
  }
   
   
  sub _encode_surrogates { # from perlunicode
      my $uni = $_[0] - 0x10000;
      return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
  }
   
   
  sub _is_bignum {
      $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
  }
   
   
   
  #
  # JSON => Perl
  #
   
  my $max_intsize;
   
  BEGIN {
      my $checkint = 1111;
      for my $d (5..64) {
          $checkint .= 1;
          my $int   = eval qq| $checkint |;
          if ($int =~ /[eE]/) {
              $max_intsize = $d - 1;
              last;
          }
      }
  }
   
  { # PARSE 
   
      my %escapes = ( #  by Jeremy Muhlich <jmuhlich [at] bitflood.org>
          b    => "\x8",
          t    => "\x9",
          n    => "\xA",
          f    => "\xC",
          r    => "\xD",
          '\\' => '\\',
          '"'  => '"',
          '/'  => '/',
      );
   
      my $text; # json data
      my $at;   # offset
      my $ch;   # 1chracter
      my $len;  # text length (changed according to UTF8 or NON UTF8)
      # INTERNAL
      my $depth;          # nest counter
      my $encoding;       # json text encoding
      my $is_valid_utf8;  # temp variable
      my $utf8_len;       # utf8 byte length
      # FLAGS
      my $utf8;           # must be utf8
      my $max_depth;      # max nest nubmer of objects and arrays
      my $max_size;
      my $relaxed;
      my $cb_object;
      my $cb_sk_object;
   
      my $F_HOOK;
   
      my $allow_bigint;   # using Math::BigInt
      my $singlequote;    # loosely quoting
      my $loose;          # 
      my $allow_barekey;  # bareKey
   
      # $opt flag
      # 0x00000001 .... decode_prefix
      # 0x10000000 .... incr_parse
   
      sub PP_decode_json {
          my ($self, $opt); # $opt is an effective flag during this decode_json.
   
          ($self, $text, $opt) = @_;
   
          ($at, $ch, $depth) = (0, '', 0);
   
          if ( !defined $text or ref $text ) {
              decode_error("malformed JSON string, neither array, object, number, string or atom");
          }
   
          my $idx = $self->{PROPS};
   
          ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
              = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
   
          if ( $utf8 ) {
              utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
          }
          else {
              utf8::upgrade( $text );
          }
   
          $len = length $text;
   
          ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
               = @{$self}{qw/max_depth  max_size cb_object cb_sk_object F_HOOK/};
   
          if ($max_size > 1) {
              use bytes;
              my $bytes = length $text;
              decode_error(
                  sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
                      , $bytes, $max_size), 1
              ) if ($bytes > $max_size);
          }
   
          # Currently no effect
          # should use regexp
          my @octets = unpack('C4', $text);
          $encoding =   ( $octets[0] and  $octets[1]) ? 'UTF-8'
                      : (!$octets[0] and  $octets[1]) ? 'UTF-16BE'
                      : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
                      : ( $octets[2]                ) ? 'UTF-16LE'
                      : (!$octets[2]                ) ? 'UTF-32LE'
                      : 'unknown';
   
          white(); # remove head white space
   
          my $valid_start = defined $ch; # Is there a first character for JSON structure?
   
          my $result = value();
   
          return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse
   
          decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
   
          if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) {
                  decode_error(
                  'JSON text must be an object or array (but found number, string, true, false or null,'
                         . ' use allow_nonref to allow this)', 1);
          }
   
          Carp::croak('something wrong.') if $len < $at; # we won't arrive here.
   
          my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length
   
          white(); # remove tail white space
   
          if ( $ch ) {
              return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix
              decode_error("garbage after JSON object");
          }
   
          ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result;
      }
   
   
      sub next_chr {
          return $ch = undef if($at >= $len);
          $ch = substr($text, $at++, 1);
      }
   
   
      sub value {
          white();
          return          if(!defined $ch);
          return object() if($ch eq '{');
          return array()  if($ch eq '[');
          return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
          return number() if($ch =~ /[0-9]/ or $ch eq '-');
          return word();
      }
   
      sub string {
          my ($i, $s, $t, $u);
          my $utf16;
          my $is_utf8;
   
          ($is_valid_utf8, $utf8_len) = ('', 0);
   
          $s = ''; # basically UTF8 flag on
   
          if($ch eq '"' or ($singlequote and $ch eq "'")){
              my $boundChar = $ch;
   
              OUTER: while( defined(next_chr()) ){
   
                  if($ch eq $boundChar){
                      next_chr();
   
                      if ($utf16) {
                          decode_error("missing low surrogate character in surrogate pair");
                      }
   
                      utf8::decode($s) if($is_utf8);
   
                      return $s;
                  }
                  elsif($ch eq '\\'){
                      next_chr();
                      if(exists $escapes{$ch}){
                          $s .= $escapes{$ch};
                      }
                      elsif($ch eq 'u'){ # UNICODE handling
                          my $u = '';
   
                          for(1..4){
                              $ch = next_chr();
                              last OUTER if($ch !~ /[0-9a-fA-F]/);
                              $u .= $ch;
                          }
   
                          # U+D800 - U+DBFF
                          if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
                              $utf16 = $u;
                          }
                          # U+DC00 - U+DFFF
                          elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
                              unless (defined $utf16) {
                                  decode_error("missing high surrogate character in surrogate pair");
                              }
                              $is_utf8 = 1;
                              $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
                              $utf16 = undef;
                          }
                          else {
                              if (defined $utf16) {
                                  decode_error("surrogate pair expected");
                              }
   
                              if ( ( my $hex = hex( $u ) ) > 127 ) {
                                  $is_utf8 = 1;
                                  $s .= JSON_PP_decode_unicode($u) || next;
                              }
                              else {
                                  $s .= chr $hex;
                              }
                          }
   
                      }
                      else{
                          unless ($loose) {
                              $at -= 2;
                              decode_error('illegal backslash escape sequence in string');
                          }
                          $s .= $ch;
                      }
                  }
                  else{
   
                      if ( ord $ch  > 127 ) {
                          if ( $utf8 ) {
                              unless( $ch = is_valid_utf8($ch) ) {
                                  $at -= 1;
                                  decode_error("malformed UTF-8 character in JSON string");
                              }
                              else {
                                  $at += $utf8_len - 1;
                              }
                          }
                          else {
                              utf8::encode( $ch );
                          }
   
                          $is_utf8 = 1;
                      }
   
                      if (!$loose) {
                          if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { # '/' ok
                              $at--;
                              decode_error('invalid character encountered while parsing JSON string');
                          }
                      }
   
                      $s .= $ch;
                  }
              }
          }
   
          decode_error("unexpected end of string while parsing JSON string");
      }
   
   
      sub white {
          while( defined $ch  ){
              if($ch le ' '){
                  next_chr();
              }
              elsif($ch eq '/'){
                  next_chr();
                  if(defined $ch and $ch eq '/'){
                      1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
                  }
                  elsif(defined $ch and $ch eq '*'){
                      next_chr();
                      while(1){
                          if(defined $ch){
                              if($ch eq '*'){
                                  if(defined(next_chr()) and $ch eq '/'){
                                      next_chr();
                                      last;
                                  }
                              }
                              else{
                                  next_chr();
                              }
                          }
                          else{
                              decode_error("Unterminated comment");
                          }
                      }
                      next;
                  }
                  else{
                      $at--;
                      decode_error("malformed JSON string, neither array, object, number, string or atom");
                  }
              }
              else{
                  if ($relaxed and $ch eq '#') { # correctly?
                      pos($text) = $at;
                      $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
                      $at = pos($text);
                      next_chr;
                      next;
                  }
   
                  last;
              }
          }
      }
   
   
      sub array {
          my $a  = [];
   
          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                      if (++$depth > $max_depth);
   
          next_chr();
          white();
   
          if(defined $ch and $ch eq ']'){
              --$depth;
              next_chr();
              return $a;
          }
          else {
              while(defined($ch)){
                  push @$a, value();
   
                  white();
   
                  if (!defined $ch) {
                      last;
                  }
   
                  if($ch eq ']'){
                      --$depth;
                      next_chr();
                      return $a;
                  }
   
                  if($ch ne ','){
                      last;
                  }
   
                  next_chr();
                  white();
   
                  if ($relaxed and $ch eq ']') {
                      --$depth;
                      next_chr();
                      return $a;
                  }
   
              }
          }
   
          decode_error(", or ] expected while parsing array");
      }
   
   
      sub object {
          my $o = {};
          my $k;
   
          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                  if (++$depth > $max_depth);
          next_chr();
          white();
   
          if(defined $ch and $ch eq '}'){
              --$depth;
              next_chr();
              if ($F_HOOK) {
                  return _json_object_hook($o);
              }
              return $o;
          }
          else {
              while (defined $ch) {
                  $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
                  white();
   
                  if(!defined $ch or $ch ne ':'){
                      $at--;
                      decode_error("':' expected");
                  }
   
                  next_chr();
                  $o->{$k} = value();
                  white();
   
                  last if (!defined $ch);
   
                  if($ch eq '}'){
                      --$depth;
                      next_chr();
                      if ($F_HOOK) {
                          return _json_object_hook($o);
                      }
                      return $o;
                  }
   
                  if($ch ne ','){
                      last;
                  }
   
                  next_chr();
                  white();
   
                  if ($relaxed and $ch eq '}') {
                      --$depth;
                      next_chr();
                      if ($F_HOOK) {
                          return _json_object_hook($o);
                      }
                      return $o;
                  }
   
              }
   
          }
   
          $at--;
          decode_error(", or } expected while parsing object/hash");
      }
   
   
      sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
          my $key;
          while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
              $key .= $ch;
              next_chr();
          }
          return $key;
      }
   
   
      sub word {
          my $word =  substr($text,$at-1,4);
   
          if($word eq 'true'){
              $at += 3;
              next_chr;
              return $JSON::PP::true;
          }
          elsif($word eq 'null'){
              $at += 3;
              next_chr;
              return undef;
          }
          elsif($word eq 'fals'){
              $at += 3;
              if(substr($text,$at,1) eq 'e'){
                  $at++;
                  next_chr;
                  return $JSON::PP::false;
              }
          }
   
          $at--; # for decode_error report
   
          decode_error("'null' expected")  if ($word =~ /^n/);
          decode_error("'true' expected")  if ($word =~ /^t/);
          decode_error("'false' expected") if ($word =~ /^f/);
          decode_error("malformed JSON string, neither array, object, number, string or atom");
      }
   
   
      sub number {
          my $n    = '';
          my $v;
   
          # According to RFC4627, hex or oct digts are invalid.
          if($ch eq '0'){
              my $peek = substr($text,$at,1);
              my $hex  = $peek =~ /[xX]/; # 0 or 1
   
              if($hex){
                  decode_error("malformed number (leading zero must not be followed by another digit)");
                  ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
              }
              else{ # oct
                  ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
                  if (defined $n and length $n > 1) {
                      decode_error("malformed number (leading zero must not be followed by another digit)");
                  }
              }
   
              if(defined $n and length($n)){
                  if (!$hex and length($n) == 1) {
                     decode_error("malformed number (leading zero must not be followed by another digit)");
                  }
                  $at += length($n) + $hex;
                  next_chr;
                  return $hex ? hex($n) : oct($n);
              }
          }
   
          if($ch eq '-'){
              $n = '-';
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after initial minus)");
              }
          }
   
          while(defined $ch and $ch =~ /\d/){
              $n .= $ch;
              next_chr;
          }
   
          if(defined $ch and $ch eq '.'){
              $n .= '.';
   
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after decimal point)");
              }
              else {
                  $n .= $ch;
              }
   
              while(defined(next_chr) and $ch =~ /\d/){
                  $n .= $ch;
              }
          }
   
          if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
              $n .= $ch;
              next_chr;
   
              if(defined($ch) and ($ch eq '+' or $ch eq '-')){
                  $n .= $ch;
                  next_chr;
                  if (!defined $ch or $ch =~ /\D/) {
                      decode_error("malformed number (no digits after exp sign)");
                  }
                  $n .= $ch;
              }
              elsif(defined($ch) and $ch =~ /\d/){
                  $n .= $ch;
              }
              else {
                  decode_error("malformed number (no digits after exp sign)");
              }
   
              while(defined(next_chr) and $ch =~ /\d/){
                  $n .= $ch;
              }
   
          }
   
          $v .= $n;
   
          if ($v !~ /[.eE]/ and length $v > $max_intsize) {
              if ($allow_bigint) { # from Adam Sussman
                  require Math::BigInt;
                  return Math::BigInt->new($v);
              }
              else {
                  return "$v";
              }
          }
          elsif ($allow_bigint) {
              require Math::BigFloat;
              return Math::BigFloat->new($v);
          }
   
          return 0+$v;
      }
   
   
      sub is_valid_utf8 {
   
          $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
                    : $_[0] =~ /[\xC2-\xDF]/  ? 2
                    : $_[0] =~ /[\xE0-\xEF]/  ? 3
                    : $_[0] =~ /[\xF0-\xF4]/  ? 4
                    : 0
                    ;
   
          return unless $utf8_len;
   
          my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
   
          return ( $is_valid_utf8 =~ /^(?:
               [\x00-\x7F]
              |[\xC2-\xDF][\x80-\xBF]
              |[\xE0][\xA0-\xBF][\x80-\xBF]
              |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
              |[\xED][\x80-\x9F][\x80-\xBF]
              |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
              |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
          )$/x )  ? $is_valid_utf8 : '';
      }
   
   
      sub decode_error {
          my $error  = shift;
          my $no_rep = shift;
          my $str    = defined $text ? substr($text, $at) : '';
          my $mess   = '';
          my $type   = $] >= 5.008           ? 'U*'
                     : $] <  5.006           ? 'C*'
                     : utf8::is_utf8( $str ) ? 'U*' # 5.6
                     : 'C*'
                     ;
   
          for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
              $mess .=  $c == 0x07 ? '\a'
                      : $c == 0x09 ? '\t'
                      : $c == 0x0a ? '\n'
                      : $c == 0x0d ? '\r'
                      : $c == 0x0c ? '\f'
                      : $c <  0x20 ? sprintf('\x{%x}', $c)
                      : $c == 0x5c ? '\\\\'
                      : $c <  0x80 ? chr($c)
                      : sprintf('\x{%x}', $c)
                      ;
              if ( length $mess >= 20 ) {
                  $mess .= '...';
                  last;
              }
          }
   
          unless ( length $mess ) {
              $mess = '(end of string)';
          }
   
          Carp::croak (
              $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
          );
   
      }
   
   
      sub _json_object_hook {
          my $o    = $_[0];
          my @ks = keys %{$o};
   
          if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
              my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
              if (@val == 1) {
                  return $val[0];
              }
          }
   
          my @val = $cb_object->($o) if ($cb_object);
          if (@val == 0 or @val > 1) {
              return $o;
          }
          else {
              return $val[0];
          }
      }
   
   
      sub PP_decode_box {
          {
              text    => $text,
              at      => $at,
              ch      => $ch,
              len     => $len,
              depth   => $depth,
              encoding      => $encoding,
              is_valid_utf8 => $is_valid_utf8,
          };
      }
   
  } # PARSE
   
   
  sub _decode_surrogates { # from perlunicode
      my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
      my $un  = pack('U*', $uni);
      utf8::encode( $un );
      return $un;
  }
   
   
  sub _decode_unicode {
      my $un = pack('U', hex shift);
      utf8::encode( $un );
      return $un;
  }
   
  #
  # Setup for various Perl versions (the code from JSON::PP58)
  #
   
  BEGIN {
   
      unless ( defined &utf8::is_utf8 ) {
         require Encode;
         *utf8::is_utf8 = *Encode::is_utf8;
      }
   
      if ( $] >= 5.008 ) {
          *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
          *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
          *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
          *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
      }
   
      if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
          package JSON::PP;
          require subs;
          subs->import('join');
          eval q|
              sub join {
                  return '' if (@_ < 2);
                  my $j   = shift;
                  my $str = shift;
                  for (@_) { $str .= $j . $_; }
                  return $str;
              }
          |;
      }
   
   
      sub JSON::PP::incr_parse {
          local $Carp::CarpLevel = 1;
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
      }
   
   
      sub JSON::PP::incr_skip {
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
      }
   
   
      sub JSON::PP::incr_reset {
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
      }
   
      eval q{
          sub JSON::PP::incr_text : lvalue {
              $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
   
              if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
                  Carp::croak("incr_text can not be called when the incremental parser already started parsing");
              }
              $_[0]->{_incr_parser}->{incr_text};
          }
      } if ( $] >= 5.006 );
   
  } # Setup for various Perl versions (the code from JSON::PP58)
   
   
  ###############################
  # Utilities
  #
   
  BEGIN {
      eval 'require Scalar::Util';
      unless($@){
          *JSON::PP::blessed = \&Scalar::Util::blessed;
          *JSON::PP::reftype = \&Scalar::Util::reftype;
      }
      else{ # This code is from Sclar::Util.
          # warn $@;
          eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
          *JSON::PP::blessed = sub {
              local($@, $SIG{__DIE__}, $SIG{__WARN__});
              ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
          };
          my %tmap = qw(
              B::NULL   SCALAR
              B::HV     HASH
              B::AV     ARRAY
              B::CV     CODE
              B::IO     IO
              B::GV     GLOB
              B::REGEXP REGEXP
          );
          *JSON::PP::reftype = sub {
              my $r = shift;
   
              return undef unless length(ref($r));
   
              my $t = ref(B::svref_2object($r));
   
              return
                  exists $tmap{$t} ? $tmap{$t}
                : length(ref($$r)) ? 'REF'
                :                    'SCALAR';
          };
      }
  }
   
   
  # shamely copied and modified from JSON::XS code.
   
  $JSON::PP::true  = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
  $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
   
  sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); }
   
  sub true  { $JSON::PP::true  }
  sub false { $JSON::PP::false }
  sub null  { undef; }
   
  ###############################
   
  package JSON::PP::Boolean;
   
  #BEGIN { # when renamed into JSON::PP, delete this code.
  #    # avoid for warning Can't locate package JSON::PP::Boolean for @JSON::PP::Boolean::ISA
  #    eval q{ package JSON::PP::Boolean; };
  #    @JSON::PP::Boolean::ISA = ('JSON::PP::Boolean');
  #}
   
  # @JSON::PP::Boolean::ISA = ('JSON::PP::Boolean');
  use overload (
     "0+"     => sub { ${$_[0]} },
     "++"     => sub { $_[0] = ${$_[0]} + 1 },
     "--"     => sub { $_[0] = ${$_[0]} - 1 },
     fallback => 1,
  );
   
   
  ###############################
   
  package JSON::PP::IncrParser;
   
  use strict;
   
  use constant INCR_M_WS   => 0; # initial whitespace skipping
  use constant INCR_M_STR  => 1; # inside string
  use constant INCR_M_BS   => 2; # inside backslash
  use constant INCR_M_JSON => 3; # outside anything, count nesting
  use constant INCR_M_C0   => 4;
  use constant INCR_M_C1   => 5;
   
  $JSON::PP::IncrParser::VERSION = '1.01';
   
  my $unpack_format = $] < 5.006 ? 'C*' : 'U*';
   
  sub new {
      my ( $class ) = @_;
   
      bless {
          incr_nest    => 0,
          incr_text    => undef,
          incr_parsing => 0,
          incr_p       => 0,
      }, $class;
  }
   
   
  sub incr_parse {
      my ( $self, $coder, $text ) = @_;
   
      $self->{incr_text} = '' unless ( defined $self->{incr_text} );
   
      if ( defined $text ) {
          if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
              utf8::upgrade( $self->{incr_text} ) ;
              utf8::decode( $self->{incr_text} ) ;
          }
          $self->{incr_text} .= $text;
      }
   
   
      my $max_size = $coder->get_max_size;
   
      if ( defined wantarray ) {
   
          $self->{incr_mode} = INCR_M_WS;
   
          if ( wantarray ) {
              my @ret;
   
              $self->{incr_parsing} = 1;
   
              do {
                  push @ret, $self->_incr_parse( $coder, $self->{incr_text} );
   
                  unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) {
                      $self->{incr_mode} = INCR_M_WS;
                  }
   
              } until ( !$self->{incr_text} );
   
              $self->{incr_parsing} = 0;
   
              return @ret;
          }
          else { # in scalar context
              $self->{incr_parsing} = 1;
              my $obj = $self->_incr_parse( $coder, $self->{incr_text} );
              $self->{incr_parsing} = 0 if defined $obj; # pointed by Martin J. Evans
              return $obj ? $obj : undef; # $obj is an empty string, parsing was completed.
          }
   
      }
   
  }
   
   
  sub _incr_parse {
      my ( $self, $coder, $text, $skip ) = @_;
      my $p = $self->{incr_p};
      my $restore = $p;
   
      my @obj;
      my $len = length $text;
   
      if ( $self->{incr_mode} == INCR_M_WS ) {
          while ( $len > $p ) {
              my $s = substr( $text, $p, 1 );
              $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
              $self->{incr_mode} = INCR_M_JSON;
              last;
         }
      }
   
      while ( $len > $p ) {
          my $s = substr( $text, $p++, 1 );
   
          if ( $s eq '"' ) {
              if ( $self->{incr_mode} != INCR_M_STR  ) {
                  $self->{incr_mode} = INCR_M_STR;
              }
              else {
                  $self->{incr_mode} = INCR_M_JSON;
                  unless ( $self->{incr_nest} ) {
                      last;
                  }
              }
          }
   
          if ( $self->{incr_mode} == INCR_M_JSON ) {
   
              if ( $s eq '[' or $s eq '{' ) {
                  if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
                      Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
                  }
              }
              elsif ( $s eq ']' or $s eq '}' ) {
                  last if ( --$self->{incr_nest} <= 0 );
              }
              elsif ( $s eq '#' ) {
                  while ( $len > $p ) {
                      last if substr( $text, $p++, 1 ) eq "\n";
                  }
              }
   
          }
   
      }
   
      $self->{incr_p} = $p;
   
      return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 );
   
      return '' unless ( length substr( $self->{incr_text}, 0, $p ) );
   
      local $Carp::CarpLevel = 2;
   
      $self->{incr_p} = $restore;
      $self->{incr_c} = $p;
   
      my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 );
   
      $self->{incr_text} = substr( $self->{incr_text}, $p );
      $self->{incr_p} = 0;
   
      return $obj or '';
  }
   
   
  sub incr_text {
      if ( $_[0]->{incr_parsing} ) {
          Carp::croak("incr_text can not be called when the incremental parser already started parsing");
      }
      $_[0]->{incr_text};
  }
   
   
  sub incr_skip {
      my $self  = shift;
      $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} );
      $self->{incr_p} = 0;
  }
   
   
  sub incr_reset {
      my $self = shift;
      $self->{incr_text}    = undef;
      $self->{incr_p}       = 0;
      $self->{incr_mode}    = 0;
      $self->{incr_nest}    = 0;
      $self->{incr_parsing} = 0;
  }
   
  ###############################
   
   
  1;
  __END__
  =pod
   
  =head1 NAME
   
  JSON::PP - JSON::XS compatible pure-Perl module.
   
  =head1 SYNOPSIS
   
   use JSON::PP;
   
   # exported functions, they croak on error
   # and expect/generate UTF-8
   
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
   
   # OO-interface
   
   $coder = JSON::PP->new->ascii->pretty->allow_nonref;
    
   $json_text   = $json->encode( $perl_scalar );
   $perl_scalar = $json->decode( $json_text );
    
   $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
    
   # Note that JSON version 2.0 and above will automatically use
   # JSON::XS or JSON::PP, so you should be able to just:
    
   use JSON;
   
   
  =head1 VERSION
   
      2.27102
   
  =head1 NOTE
   
  JSON::PP was inculded in JSON distribution (CPAN module).
  It comes to be a perl core module in Perl 5.14.
   
      [STEPS]
   
      * release this module as JSON::PPdev.
   
      * release other PP::* modules as JSON::PP::Compat*.
   
      * JSON distribution will inculde yet another JSON::PP modules.
        They are JSNO::backportPP. So JSON.pm should work as it did at all!
   
      * remove JSON::PP and JSON::PP::* modules from JSON distribution
         and release it as developer version.
   
      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   
      * release JSON distribution as stable version.
   
      * rename JSON::PPdev into JSON::PP and release on CPAN. <<<< HERE
   
  =head1 DESCRIPTION
   
  This module is L<JSON::XS> compatible pure Perl module.
  (Perl 5.8 or later is recommended)
   
  JSON::XS is the fastest and most proper JSON module on CPAN.
  It is written by Marc Lehmann in C, so must be compiled and
  installed in the used environment.
   
  JSON::PP is a pure-Perl module and has compatibility to JSON::XS.
   
   
  =head2 FEATURES
   
  =over
   
  =item * correct unicode handling
   
  This module knows how to handle Unicode (depending on Perl version).
   
  See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL> and L<UNICODE HANDLING ON PERLS>.
   
   
  =item * round-trip integrity
   
  When you serialise a perl data structure using only data types supported
  by JSON and Perl, the deserialised data structure is identical on the Perl
  level. (e.g. the string "2.0" doesn't suddenly become "2" just because
  it looks like a number). There I<are> minor exceptions to this, read the
  MAPPING section below to learn about those.
   
   
  =item * strict checking of JSON correctness
   
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default (the latter is a security feature).
  But when some options are set, loose chcking features are available.
   
  =back
   
  =head1 FUNCTIONAL INTERFACE
   
  Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
   
  =head2 encode_json
   
      $json_text = encode_json $perl_scalar
   
  Converts the given Perl data structure to a UTF-8 encoded, binary string.
   
  This function call is functionally identical to:
   
      $json_text = JSON::PP->new->utf8->encode($perl_scalar)
   
  =head2 decode_json
   
      $perl_scalar = decode_json $json_text
   
  The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
  to parse that as an UTF-8 encoded JSON text, returning the resulting
  reference.
   
  This function call is functionally identical to:
   
      $perl_scalar = JSON::PP->new->utf8->decode($json_text)
   
  =head2 JSON::PP::is_bool
   
      $is_boolean = JSON::PP::is_bool($scalar)
   
  Returns true if the passed scalar represents either JSON::PP::true or
  JSON::PP::false, two constants that act like C<1> and C<0> respectively
  and are also used to represent JSON C<true> and C<false> in Perl strings.
   
  =head2 JSON::PP::true
   
  Returns JSON true value which is blessed object.
  It C<isa> JSON::PP::Boolean object.
   
  =head2 JSON::PP::false
   
  Returns JSON false value which is blessed object.
  It C<isa> JSON::PP::Boolean object.
   
  =head2 JSON::PP::null
   
  Returns C<undef>.
   
  See L<MAPPING>, below, for more information on how JSON values are mapped to
  Perl.
   
   
  =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
   
  This section supposes that your perl vresion is 5.8 or later.
   
  If you know a JSON text from an outer world - a network, a file content, and so on,
  is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
  with C<utf8> enable. And the decoded result will contain UNICODE characters.
   
    # from network
    my $json        = JSON::PP->new->utf8;
    my $json_text   = CGI->new->param( 'json_data' );
    my $perl_scalar = $json->decode( $json_text );
     
    # from file content
    local $/;
    open( my $fh, '<', 'json.data' );
    $json_text   = <$fh>;
    $perl_scalar = decode_json( $json_text );
   
  If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
   
    use Encode;
    local $/;
    open( my $fh, '<', 'json.data' );
    my $encoding = 'cp932';
    my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
     
    # or you can write the below code.
    #
    # open( my $fh, "<:encoding($encoding)", 'json.data' );
    # $unicode_json_text = <$fh>;
   
  In this case, C<$unicode_json_text> is of course UNICODE string.
  So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable.
   
    $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
   
  Or C<encode 'utf8'> and C<decode_json>:
   
    $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
    # this way is not efficient.
   
  And now, you want to convert your C<$perl_scalar> into JSON data and
  send it to an outer world - a network or a file content, and so on.
   
  Your data usually contains UNICODE strings and you want the converted data to be encoded
  in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
   
    print encode_json( $perl_scalar ); # to a network? file? or display?
    # or
    print $json->utf8->encode( $perl_scalar );
   
  If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
  for some reason, then its characters are regarded as B<latin1> for perl
  (because it does not concern with your $encoding).
  You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable.
  Note that the resulted text is a UNICODE string but no problem to print it.
   
    # $perl_scalar contains $encoding encoded string values
    $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
    # $unicode_json_text consists of characters less than 0x100
    print $unicode_json_text;
   
  Or C<decode $encoding> all string values and C<encode_json>:
   
    $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
    # ... do it to each string values, then encode_json
    $json_text = encode_json( $perl_scalar );
   
  This method is a proper way but probably not efficient.
   
  See to L<Encode>, L<perluniintro>.
   
   
  =head1 METHODS
   
  Basically, check to L<JSON> or L<JSON::XS>.
   
  =head2 new
   
      $json = new JSON::PP
   
  Rturns a new JSON::PP object that can be used to de/encode JSON
  strings.
   
  All boolean flags described below are by default I<disabled>.
   
  The mutators for flags all return the JSON object again and thus calls can
  be chained:
   
     my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]})
     => {"a": [1, 2]}
   
  =head2 ascii
   
      $json = $json->ascii([$enable])
       
      $enabled = $json->get_ascii
   
  If $enable is true (or missing), then the encode method will not generate characters outside
  the code range 0..127. Any Unicode characters outside that range will be escaped using either
  a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
  (See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>).
   
  In Perl 5.005, there is no character having high value (more than 255).
  See to L<UNICODE HANDLING ON PERLS>.
   
  If $enable is false, then the encode method will not escape Unicode characters unless
  required by the JSON syntax or other flags. This results in a faster and more compact format.
   
    JSON::PP->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
   
  =head2 latin1
   
      $json = $json->latin1([$enable])
       
      $enabled = $json->get_latin1
   
  If $enable is true (or missing), then the encode method will encode the resulting JSON
  text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
   
  If $enable is false, then the encode method will not escape Unicode characters
  unless required by the JSON syntax or other flags.
   
    JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
   
  See to L<UNICODE HANDLING ON PERLS>.
   
  =head2 utf8
   
      $json = $json->utf8([$enable])
       
      $enabled = $json->get_utf8
   
  If $enable is true (or missing), then the encode method will encode the JSON result
  into UTF-8, as required by many protocols, while the decode method expects to be handled
  an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
  characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
   
  (In Perl 5.005, any character outside the range 0..255 does not exist.
  See to L<UNICODE HANDLING ON PERLS>.)
   
  In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
  encoding families, as described in RFC4627.
   
  If $enable is false, then the encode method will return the JSON string as a (non-encoded)
  Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
  (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
   
  Example, output UTF-16BE-encoded JSON:
   
    use Encode;
    $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object);
   
  Example, decode UTF-32LE-encoded JSON:
   
    use Encode;
    $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext);
   
   
  =head2 pretty
   
      $json = $json->pretty([$enable])
   
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> flags in one call to generate the most readable
  (or most compact) form possible.
   
  Equivalent to:
   
     $json->indent->space_before->space_after
   
  =head2 indent
   
      $json = $json->indent([$enable])
       
      $enabled = $json->get_indent
   
  The default indent space length is three.
  You can use C<indent_length> to change the length.
   
  =head2 space_before
   
      $json = $json->space_before([$enable])
       
      $enabled = $json->get_space_before
   
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space before the C<:> separating keys from values in JSON objects.
   
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
   
  This setting has no effect when decoding JSON texts.
   
  Example, space_before enabled, space_after and indent disabled:
   
     {"key" :"value"}
   
  =head2 space_after
   
      $json = $json->space_after([$enable])
       
      $enabled = $json->get_space_after
   
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space after the C<:> separating keys from values in JSON objects
  and extra whitespace after the C<,> separating key-value pairs and array
  members.
   
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
   
  This setting has no effect when decoding JSON texts.
   
  Example, space_before and indent disabled, space_after enabled:
   
     {"key": "value"}
   
  =head2 relaxed
   
      $json = $json->relaxed([$enable])
       
      $enabled = $json->get_relaxed
   
  If C<$enable> is true (or missing), then C<decode> will accept some
  extensions to normal JSON syntax (see below). C<encode> will not be
  affected in anyway. I<Be aware that this option makes you accept invalid
  JSON texts as if they were valid!>. I suggest only to use this option to
  parse application-specific files written by humans (configuration files,
  resource files etc.)
   
  If C<$enable> is false (the default), then C<decode> will only accept
  valid JSON texts.
   
  Currently accepted extensions are:
   
  =over 4
   
  =item * list items can have an end-comma
   
  JSON I<separates> array elements and key-value pairs with commas. This
  can be annoying if you write JSON texts manually and want to be able to
  quickly append elements, so this extension accepts comma at the end of
  such items not just between them:
   
     [
        1,
        2, <- this comma not normally allowed
     ]
     {
        "k1": "v1",
        "k2": "v2", <- this comma not normally allowed
     }
   
  =item * shell-style '#'-comments
   
  Whenever JSON allows whitespace, shell-style comments are additionally
  allowed. They are terminated by the first carriage-return or line-feed
  character, after which more white-space and comments are allowed.
   
    [
       1, # this comment not allowed in JSON
          # neither this one...
    ]
   
  =back
   
  =head2 canonical
   
      $json = $json->canonical([$enable])
       
      $enabled = $json->get_canonical
   
  If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
  by sorting their keys. This is adding a comparatively high overhead.
   
  If C<$enable> is false, then the C<encode> method will output key-value
  pairs in the order Perl stores them (which will likely change between runs
  of the same script).
   
  This option is useful if you want the same data structure to be encoded as
  the same JSON text (given the same overall settings). If it is disabled,
  the same hash might be encoded differently even if contains the same data,
  as key-value pairs have no inherent ordering in Perl.
   
  This setting has no effect when decoding JSON texts.
   
  If you want your own sorting routine, you can give a code referece
  or a subroutine name to C<sort_by>. See to C<JSON::PP OWN METHODS>.
   
  =head2 allow_nonref
   
      $json = $json->allow_nonref([$enable])
       
      $enabled = $json->get_allow_nonref
   
  If C<$enable> is true (or missing), then the C<encode> method can convert a
  non-reference into its corresponding string, number or null JSON value,
  which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
  values instead of croaking.
   
  If C<$enable> is false, then the C<encode> method will croak if it isn't
  passed an arrayref or hashref, as JSON texts must either be an object
  or array. Likewise, C<decode> will croak if given something that is not a
  JSON object or array.
   
     JSON::PP->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
   
  =head2 allow_unknown
   
      $json = $json->allow_unknown ([$enable])
       
      $enabled = $json->get_allow_unknown
   
  If $enable is true (or missing), then "encode" will *not* throw an
  exception when it encounters values it cannot represent in JSON (for
  example, filehandles) but instead will encode a JSON "null" value.
  Note that blessed objects are not included here and are handled
  separately by c<allow_nonref>.
   
  If $enable is false (the default), then "encode" will throw an
  exception when it encounters anything it cannot encode as JSON.
   
  This option does not affect "decode" in any way, and it is
  recommended to leave it off unless you know your communications
  partner.
   
  =head2 allow_blessed
   
      $json = $json->allow_blessed([$enable])
       
      $enabled = $json->get_allow_blessed
   
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference. Instead, the value of the
  B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
  disabled or no C<TO_JSON> method found) or a representation of the
  object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
  encoded. Has no effect on C<decode>.
   
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object.
   
  =head2 convert_blessed
   
      $json = $json->convert_blessed([$enable])
       
      $enabled = $json->get_convert_blessed
   
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<TO_JSON> method
  on the object's class. If found, it will be called in scalar context
  and the resulting scalar will be encoded instead of the object. If no
  C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
  to do.
   
  The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
  returns other blessed objects, those will be handled in the same
  way. C<TO_JSON> must take care of not causing an endless recursion cycle
  (== crash) in this case. The name of C<TO_JSON> was chosen because other
  methods called by the Perl core (== not by the user of the object) are
  usually in upper case letters and to avoid collisions with the C<to_json>
  function or method.
   
  This setting does not yet influence C<decode> in any way.
   
  If C<$enable> is false, then the C<allow_blessed> setting will decide what
  to do when a blessed object is found.
   
  =head2 filter_json_object
   
      $json = $json->filter_json_object([$coderef])
   
  When C<$coderef> is specified, it will be called from C<decode> each
  time it decodes a JSON object. The only argument passed to the coderef
  is a reference to the newly-created hash. If the code references returns
  a single scalar (which need not be a reference), this value
  (i.e. a copy of that scalar to avoid aliasing) is inserted into the
  deserialised data structure. If it returns an empty list
  (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
  hash will be inserted. This setting can slow down decoding considerably.
   
  When C<$coderef> is omitted or undefined, any existing callback will
  be removed and C<decode> will not change the deserialised hash in any
  way.
   
  Example, convert all JSON objects into the integer 5:
   
     my $js = JSON::PP->new->filter_json_object (sub { 5 });
     # returns [5]
     $js->decode ('[{}]'); # the given subroutine takes a hash reference.
     # throw an exception because allow_nonref is not enabled
     # so a lone 5 is not allowed.
     $js->decode ('{"a":1, "b":2}');
   
  =head2 filter_json_single_key_object
   
      $json = $json->filter_json_single_key_object($key [=> $coderef])
   
  Works remotely similar to C<filter_json_object>, but is only called for
  JSON objects having a single key named C<$key>.
   
  This C<$coderef> is called before the one specified via
  C<filter_json_object>, if any. It gets passed the single value in the JSON
  object. If it returns a single value, it will be inserted into the data
  structure. If it returns nothing (not even C<undef> but the empty list),
  the callback from C<filter_json_object> will be called next, as if no
  single-key callback were specified.
   
  If C<$coderef> is omitted or undefined, the corresponding callback will be
  disabled. There can only ever be one callback for a given key.
   
  As this callback gets called less often then the C<filter_json_object>
  one, decoding speed will not usually suffer as much. Therefore, single-key
  objects make excellent targets to serialise Perl objects into, especially
  as single-key JSON objects are as close to the type-tagged value concept
  as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
  support this in any way, so you need to make sure your data never looks
  like a serialised Perl hash.
   
  Typical names for the single object key are C<__class_whatever__>, or
  C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
  things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
  with real hashes.
   
  Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
  into the corresponding C<< $WIDGET{<id>} >> object:
   
     # return whatever is in $WIDGET{5}:
     JSON::PP
        ->new
        ->filter_json_single_key_object (__widget__ => sub {
              $WIDGET{ $_[0] }
           })
        ->decode ('{"__widget__": 5')
   
     # this can be used with a TO_JSON method in some "widget" class
     # for serialisation to json:
     sub WidgetBase::TO_JSON {
        my ($self) = @_;
   
        unless ($self->{id}) {
           $self->{id} = ..get..some..id..;
           $WIDGET{$self->{id}} = $self;
        }
   
        { __widget__ => $self->{id} }
     }
   
  =head2 shrink
   
      $json = $json->shrink([$enable])
       
      $enabled = $json->get_shrink
   
  In JSON::XS, this flag resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible.
  It will also try to downgrade any strings to octet-form if possible.
   
  In JSON::PP, it is noop about resizing strings but tries
  C<utf8::downgrade> to the returned string by C<encode>.
  See to L<utf8>.
   
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
   
  =head2 max_depth
   
      $json = $json->max_depth([$maximum_nesting_depth])
       
      $max_depth = $json->get_max_depth
   
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
   
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
   
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
   
  See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
   
  When a large value (100 or more) was set and it de/encodes a deep nested object/text,
  it may raise a warning 'Deep recursion on subroutin' at the perl runtime phase.
   
  =head2 max_size
   
      $json = $json->max_size([$maximum_string_size])
       
      $max_size = $json->get_max_size
   
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
   
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
   
  See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
   
  =head2 encode
   
      $json_text = $json->encode($perl_scalar)
   
  Converts the given Perl data structure (a simple scalar or a reference
  to a hash or array) to its JSON representation. Simple scalars will be
  converted into JSON string or number sequences, while references to arrays
  become JSON arrays and references to hashes become JSON objects. Undefined
  Perl values (e.g. C<undef>) become JSON C<null> values.
  References to the integers C<0> and C<1> are converted into C<true> and C<false>.
   
  =head2 decode
   
      $perl_scalar = $json->decode($json_text)
   
  The opposite of C<encode>: expects a JSON text and tries to parse it,
  returning the resulting simple scalar or reference. Croaks on error.
   
  JSON numbers and strings become simple Perl scalars. JSON arrays become
  Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
  C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
  C<null> becomes C<undef>.
   
  =head2 decode_prefix
   
      ($perl_scalar, $characters) = $json->decode_prefix($json_text)
   
  This works like the C<decode> method, but instead of raising an exception
  when there is trailing garbage after the first JSON object, it will
  silently stop parsing there and return the number of characters consumed
  so far.
   
     JSON->new->decode_prefix ("[1] the tail")
     => ([], 3)
   
  =head1 INCREMENTAL PARSING
   
  Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
   
  In some cases, there is the need for incremental parsing of JSON texts.
  This module does allow you to parse a JSON stream incrementally.
  It does so by accumulating text until it has a full JSON object, which
  it then can decode. This process is similar to using C<decode_prefix>
  to see if a full JSON object is available, but is much more efficient
  (and can be implemented with a minimum of method calls).
   
  This module will only attempt to parse the JSON text once it is sure it
  has enough text to get a decisive result, using a very simple but
  truly incremental parser. This means that it sometimes won't stop as
  early as the full parser, for example, it doesn't detect parenthese
  mismatches. The only thing it guarantees is that it starts decoding as
  soon as a syntactically valid JSON text has been seen. This means you need
  to set resource limits (e.g. C<max_size>) to ensure the parser will stop
  parsing in the presence if syntax errors.
   
  The following methods implement this incremental parser.
   
  =head2 incr_parse
   
      $json->incr_parse( [$string] ) # void context
       
      $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
       
      @obj_or_empty = $json->incr_parse( [$string] ) # list context
   
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
   
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
   
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
   
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the errornous part). This is the most common way of
  using the method.
   
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
   
  Example: Parse some JSON arrays/objects in a given string and return them.
   
      my @objs = JSON->new->incr_parse ("[5][7][1,2]");
   
  =head2 incr_text
   
      $lvalue_string = $json->incr_text
   
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object. Under
  all other circumstances you must not call this function (I mean it.
  although in simple tests it might actually work, it I<will> fail under
  real world conditions). As a special exception, you can also call this
  method before having parsed anything.
   
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
   
      $json->incr_text =~ s/\s*,\s*//;
   
  In Perl 5.005, C<lvalue> attribute is not available.
  You must write codes like the below:
   
      $string = $json->incr_text;
      $string =~ s/\s*,\s*//;
      $json->incr_text( $string );
   
  =head2 incr_skip
   
      $json->incr_skip
   
  This will reset the state of the incremental parser and will remove the
  parsed text from the input buffer. This is useful after C<incr_parse>
  died, in which case the input buffer and incremental parser state is left
  unchanged, to skip the text parsed so far and to reset the parse state.
   
  =head2 incr_reset
   
      $json->incr_reset
   
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
   
  This is useful if you want ot repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
   
  See to L<JSON::XS/INCREMENTAL PARSING> for examples.
   
   
  =head1 JSON::PP OWN METHODS
   
  =head2 allow_singlequote
   
      $json = $json->allow_singlequote([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will accept
  JSON strings quoted by single quotations that are invalid JSON
  format.
   
      $json->allow_singlequote->decode({"foo":'bar'});
      $json->allow_singlequote->decode({'foo':"bar"});
      $json->allow_singlequote->decode({'foo':'bar'});
   
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
   
   
  =head2 allow_barekey
   
      $json = $json->allow_barekey([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will accept
  bare keys of JSON object that are invalid JSON format.
   
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
   
      $json->allow_barekey->decode('{foo:"bar"}');
   
  =head2 allow_bignum
   
      $json = $json->allow_bignum([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will convert
  the big integer Perl cannot handle as integer into a L<Math::BigInt>
  object and convert a floating number (any) into a L<Math::BigFloat>.
   
  On the contary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers with C<allow_blessed> enable.
   
     $json->allow_nonref->allow_blessed->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
   
  See to L<JSON::XS/MAPPING> aboout the normal conversion of JSON number.
   
  =head2 loose
   
      $json = $json->loose([$enable])
   
  The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
  and the module doesn't allow to C<decode> to these (except for \x2f).
  If C<$enable> is true (or missing), then C<decode>  will accept these
  unescaped strings.
   
      $json->loose->decode(qq|["abc
                                     def"]|);
   
  See L<JSON::XS/SSECURITY CONSIDERATIONS>.
   
  =head2 escape_slash
   
      $json = $json->escape_slash([$enable])
   
  According to JSON Grammar, I<slash> (U+002F) is escaped. But default
  JSON::PP (as same as JSON::XS) encodes strings without escaping slash.
   
  If C<$enable> is true (or missing), then C<encode> will escape slashes.
   
  =head2 indent_length
   
      $json = $json->indent_length($length)
   
  JSON::XS indent space length is 3 and cannot be changed.
  JSON::PP set the indent space length with the given $length.
  The default is 3. The acceptable range is 0 to 15.
   
  =head2 sort_by
   
      $json = $json->sort_by($function_name)
      $json = $json->sort_by($subroutine_ref)
   
  If $function_name or $subroutine_ref are set, its sort routine are used
  in encoding JSON objects.
   
     $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
   
     $js = $pc->sort_by('own_sort')->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
   
     sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
   
  As the sorting routine runs in the JSON::PP scope, the given
  subroutine name and the special variables C<$a>, C<$b> will begin
  'JSON::PP::'.
   
  If $integer is set, then the effect is same as C<canonical> on.
   
  =head1 INTERNAL
   
  For developers.
   
  =over
   
  =item PP_encode_box
   
  Returns
   
          {
              depth        => $depth,
              indent_count => $indent_count,
          }
   
   
  =item PP_decode_box
   
  Returns
   
          {
              text    => $text,
              at      => $at,
              ch      => $ch,
              len     => $len,
              depth   => $depth,
              encoding      => $encoding,
              is_valid_utf8 => $is_valid_utf8,
          };
   
  =back
   
  =head1 MAPPING
   
  This section is copied from JSON::XS and modified to C<JSON::PP>.
  JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
   
  See to L<JSON::XS/MAPPING>.
   
  =head2 JSON -> PERL
   
  =over 4
   
  =item object
   
  A JSON object becomes a reference to a hash in Perl. No ordering of object
  keys is preserved (JSON does not preserver object key ordering itself).
   
  =item array
   
  A JSON array becomes a reference to an array in Perl.
   
  =item string
   
  A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
  are represented by the same codepoints in the Perl string, so no manual
  decoding is necessary.
   
  =item number
   
  A JSON number becomes either an integer, numeric (floating point) or
  string scalar in perl, depending on its range and any fractional parts. On
  the Perl level, there is no difference between those as Perl handles all
  the conversion details, but an integer may take slightly less memory and
  might represent more values exactly than floating point numbers.
   
  If the number consists of digits only, C<JSON> will try to represent
  it as an integer value. If that fails, it will try to represent it as
  a numeric (floating point) value if that is possible without loss of
  precision. Otherwise it will preserve the number as a string value (in
  which case you lose roundtripping ability, as the JSON number will be
  re-encoded toa JSON string).
   
  Numbers containing a fractional or exponential part will always be
  represented as numeric (floating point) values, possibly at a loss of
  precision (in which case you might lose perfect roundtripping ability, but
  the JSON number will still be re-encoded as a JSON number).
   
  Note that precision is not accuracy - binary floating point values cannot
  represent most decimal fractions exactly, and when converting from and to
  floating point, C<JSON> only guarantees precision up to but not including
  the leats significant bit.
   
  When C<allow_bignum> is enable, the big integers 
  and the numeric can be optionally converted into L<Math::BigInt> and
  L<Math::BigFloat> objects.
   
  =item true, false
   
  These JSON atoms become C<JSON::PP::true> and C<JSON::PP::false>,
  respectively. They are overloaded to act almost exactly like the numbers
  C<1> and C<0>. You can check wether a scalar is a JSON boolean by using
  the C<JSON::is_bool> function.
   
     print JSON::PP::true . "\n";
      => true
     print JSON::PP::true + 1;
      => 1
   
     ok(JSON::true eq  '1');
     ok(JSON::true == 1);
   
  C<JSON> will install these missing overloading features to the backend modules.
   
   
  =item null
   
  A JSON null atom becomes C<undef> in Perl.
   
  C<JSON::PP::null> returns C<unddef>.
   
  =back
   
   
  =head2 PERL -> JSON
   
  The mapping from Perl to JSON is slightly more difficult, as Perl is a
  truly typeless language, so we can only guess which JSON type is meant by
  a Perl value.
   
  =over 4
   
  =item hash references
   
  Perl hash references become JSON objects. As there is no inherent ordering
  in hash keys (or JSON objects), they will usually be encoded in a
  pseudo-random order that can change between runs of the same program but
  stays generally the same within a single run of a program. C<JSON>
  optionally sort the hash keys (determined by the I<canonical> flag), so
  the same datastructure will serialise to the same JSON text (given same
  settings and version of JSON::XS), but this incurs a runtime overhead
  and is only rarely useful, e.g. when you want to compare some JSON text
  against another for equality.
   
   
  =item array references
   
  Perl array references become JSON arrays.
   
  =item other references
   
  Other unblessed references are generally not allowed and will cause an
  exception to be thrown, except for references to the integers C<0> and
  C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
  also use C<JSON::false> and C<JSON::true> to improve readability.
   
     to_json [\0,JSON::PP::true]      # yields [false,true]
   
  =item JSON::PP::true, JSON::PP::false, JSON::PP::null
   
  These special values become JSON true and JSON false values,
  respectively. You can also use C<\1> and C<\0> directly if you want.
   
  JSON::PP::null returns C<undef>.
   
  =item blessed objects
   
  Blessed objects are not directly representable in JSON. See the
  C<allow_blessed> and C<convert_blessed> methods on various options on
  how to deal with this: basically, you can choose between throwing an
  exception, encoding the reference as if it weren't blessed, or provide
  your own serialiser method.
   
  See to L<convert_blessed>.
   
  =item simple scalars
   
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
  JSON C<null> values, scalars that have last been used in a string context
  before encoding as JSON strings, and anything else as number value:
   
     # dump as number
     encode_json [2]                      # yields [2]
     encode_json [-3.0e17]                # yields [-3e+17]
     my $value = 5; encode_json [$value]  # yields [5]
   
     # used as string, so dump as string
     print $value;
     encode_json [$value]                 # yields ["5"]
   
     # undef becomes null
     encode_json [undef]                  # yields [null]
   
  You can force the type to be a string by stringifying it:
   
     my $x = 3.1; # some variable containing a number
     "$x";        # stringified
     $x .= "";    # another, more awkward way to stringify
     print $x;    # perl does it for you, too, quite often
   
  You can force the type to be a number by numifying it:
   
     my $x = "3"; # some variable containing a string
     $x += 0;     # numify it, ensuring it will be dumped as a number
     $x *= 1;     # same thing, the choise is yours.
   
  You can not currently force the type in other, less obscure, ways.
   
  Note that numerical precision has the same meaning as under Perl (so
  binary to decimal conversion follows the same rules as in Perl, which
  can differ to other languages). Also, your perl interpreter might expose
  extensions to the floating point numbers of your platform, such as
  infinities or NaN's - these cannot be represented in JSON, and it is an
  error to pass those in.
   
  =item Big Number
   
  When C<allow_bignum> is enable, 
  C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers.
   
   
  =back
   
  =head1 UNICODE HANDLING ON PERLS
   
  If you do not know about Unicode on Perl well,
  please check L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
   
  =head2 Perl 5.8 and later
   
  Perl can handle Unicode and the JSON::PP de/encode methods also work properly.
   
      $json->allow_nonref->encode(chr hex 3042);
      $json->allow_nonref->encode(chr hex 12345);
   
  Reuturns C<"\u3042"> and C<"\ud808\udf45"> respectively.
   
      $json->allow_nonref->decode('"\u3042"');
      $json->allow_nonref->decode('"\ud808\udf45"');
   
  Returns UTF-8 encoded strings with UTF8 flag, regarded as C<U+3042> and C<U+12345>.
   
  Note that the versions from Perl 5.8.0 to 5.8.2, Perl built-in C<join> was broken,
  so JSON::PP wraps the C<join> with a subroutine. Thus JSON::PP works slow in the versions.
   
   
  =head2 Perl 5.6
   
  Perl can handle Unicode and the JSON::PP de/encode methods also work.
   
  =head2 Perl 5.005
   
  Perl 5.005 is a byte sementics world -- all strings are sequences of bytes.
  That means the unicode handling is not available.
   
  In encoding,
   
      $json->allow_nonref->encode(chr hex 3042);  # hex 3042 is 12354.
      $json->allow_nonref->encode(chr hex 12345); # hex 12345 is 74565.
   
  Returns C<B> and C<E>, as C<chr> takes a value more than 255, it treats
  as C<$value % 256>, so the above codes are equivalent to :
   
      $json->allow_nonref->encode(chr 66);
      $json->allow_nonref->encode(chr 69);
   
  In decoding,
   
      $json->decode('"\u00e3\u0081\u0082"');
   
  The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded
  japanese character (C<HIRAGANA LETTER A>).
  And if it is represented in Unicode code point, C<U+3042>.
   
  Next, 
   
      $json->decode('"\u3042"');
   
  We ordinary expect the returned value is a Unicode character C<U+3042>.
  But here is 5.005 world. This is C<0xE3 0x81 0x82>.
   
      $json->decode('"\ud808\udf45"');
   
  This is not a character C<U+12345> but bytes - C<0xf0 0x92 0x8d 0x85>.
   
   
  =head1 TODO
   
  =over
   
  =item speed
   
  =item memory saving
   
  =back
   
   
  =head1 SEE ALSO
   
  Most of the document are copied and modified from JSON::XS doc.
   
  L<JSON::XS>
   
  RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
   
  =head1 AUTHOR
   
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
   
   
  =head1 COPYRIGHT AND LICENSE
   
  Copyright 2007-2010 by Makamaka Hannyaharamitu
   
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
   
  =cut
JSON_PP
$fatpacked{"JSON/PP/Boolean.pm"} = <<'JSON_PP_BOOLEAN';
  =head1 NAME
   
  JSON::PP::Boolean - dummy module providing JSON::PP::Boolean
   
  =head1 SYNOPSIS
   
   # do not "use" yourself
   
  =head1 DESCRIPTION
   
  This module exists only to provide overload resolution for Storable and similar modules. See
  L<JSON::PP> for more info about this class.
   
  =cut
   
  use JSON::PP ();
  use strict;
   
  1;
   
  =head1 AUTHOR
   
  This idea is from L<JSON::XS::Boolean> written by Marc Lehmann <schmorp[at]schmorp.de>
   
  =cut
   
JSON_PP_BOOLEAN
$fatpacked{"JSON/backportPP.pm"} = <<'JSON_BACKPORTPP';
  package # This is JSON::backportPP
      JSON::PP;
   
  # JSON-2.0
   
  use 5.005;
  use strict;
  use base qw(Exporter);
  use overload ();
   
  use Carp ();
  use B ();
  #use Devel::Peek;
   
  $JSON::PP::VERSION = '2.27008';
   
  @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
   
  # instead of hash-access, i tried index-access for speed.
  # but this method is not faster than what i expected. so it will be changed.
   
  use constant P_ASCII                => 0;
  use constant P_LATIN1               => 1;
  use constant P_UTF8                 => 2;
  use constant P_INDENT               => 3;
  use constant P_CANONICAL            => 4;
  use constant P_SPACE_BEFORE         => 5;
  use constant P_SPACE_AFTER          => 6;
  use constant P_ALLOW_NONREF         => 7;
  use constant P_SHRINK               => 8;
  use constant P_ALLOW_BLESSED        => 9;
  use constant P_CONVERT_BLESSED      => 10;
  use constant P_RELAXED              => 11;
   
  use constant P_LOOSE                => 12;
  use constant P_ALLOW_BIGNUM         => 13;
  use constant P_ALLOW_BAREKEY        => 14;
  use constant P_ALLOW_SINGLEQUOTE    => 15;
  use constant P_ESCAPE_SLASH         => 16;
  use constant P_AS_NONBLESSED        => 17;
   
  use constant P_ALLOW_UNKNOWN        => 18;
   
  use constant OLD_PERL => $] < 5.008 ? 1 : 0;
   
  BEGIN {
      my @xs_compati_bit_properties = qw(
              latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
              allow_blessed convert_blessed relaxed allow_unknown
      );
      my @pp_bit_properties = qw(
              allow_singlequote allow_bignum loose
              allow_barekey escape_slash as_nonblessed
      );
   
      # Perl version check, Unicode handling is enable?
      # Helper module sets @JSON::PP::_properties.
       if ($] < 5.008 ) {
          my $helper;
          $helper = $] >= 5.006 ? 'JSON::backportPP::Compat5006' : 'JSON::backportPP::Compat5005';
          eval qq| require $helper |;
          if ($@) { Carp::croak $@; }
      }
   
      for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
          my $flag_name = 'P_' . uc($name);
   
          eval qq/
              sub $name {
                  my \$enable = defined \$_[1] ? \$_[1] : 1;
   
                  if (\$enable) {
                      \$_[0]->{PROPS}->[$flag_name] = 1;
                  }
                  else {
                      \$_[0]->{PROPS}->[$flag_name] = 0;
                  }
   
                  \$_[0];
              }
   
              sub get_$name {
                  \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
              }
          /;
      }
   
  }
   
   
   
  # Functions
   
  my %encode_allow_method
       = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash
                            allow_blessed convert_blessed indent indent_length allow_bignum
                            as_nonblessed
                          /;
  my %decode_allow_method
       = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum
                            allow_barekey max_size relaxed/;
   
   
  my $JSON; # cache
   
  sub encode_json ($) { # encode
      ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
  }
   
   
  sub decode_json { # decode
      ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
  }
   
  # Obsoleted
   
  sub to_json($) {
     Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
  }
   
   
  sub from_json($) {
     Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
  }
   
   
  # Methods
   
  sub new {
      my $class = shift;
      my $self  = {
          max_depth   => 512,
          max_size    => 0,
          indent      => 0,
          FLAGS       => 0,
          fallback      => sub { encode_error('Invalid value. JSON can only reference.') },
          indent_length => 3,
      };
   
      bless $self, $class;
  }
   
   
  sub encode {
      return $_[0]->PP_encode_json($_[1]);
  }
   
   
  sub decode {
      return $_[0]->PP_decode_json($_[1], 0x00000000);
  }
   
   
  sub decode_prefix {
      return $_[0]->PP_decode_json($_[1], 0x00000001);
  }
   
   
  # accessor
   
   
  # pretty printing
   
  sub pretty {
      my ($self, $v) = @_;
      my $enable = defined $v ? $v : 1;
   
      if ($enable) { # indent_length(3) for JSON::XS compatibility
          $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
      }
      else {
          $self->indent(0)->space_before(0)->space_after(0);
      }
   
      $self;
  }
   
  # etc
   
  sub max_depth {
      my $max  = defined $_[1] ? $_[1] : 0x80000000;
      $_[0]->{max_depth} = $max;
      $_[0];
  }
   
   
  sub get_max_depth { $_[0]->{max_depth}; }
   
   
  sub max_size {
      my $max  = defined $_[1] ? $_[1] : 0;
      $_[0]->{max_size} = $max;
      $_[0];
  }
   
   
  sub get_max_size { $_[0]->{max_size}; }
   
   
  sub filter_json_object {
      $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0;
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
   
  sub filter_json_single_key_object {
      if (@_ > 1) {
          $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
      }
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
   
  sub indent_length {
      if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
          Carp::carp "The acceptable range of indent_length() is 0 to 15.";
      }
      else {
          $_[0]->{indent_length} = $_[1];
      }
      $_[0];
  }
   
  sub get_indent_length {
      $_[0]->{indent_length};
  }
   
  sub sort_by {
      $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
      $_[0];
  }
   
  sub allow_bigint {
      Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.");
  }
   
  ###############################
   
  ###
  ### Perl => JSON
  ###
   
   
  { # Convert
   
      my $max_depth;
      my $indent;
      my $ascii;
      my $latin1;
      my $utf8;
      my $space_before;
      my $space_after;
      my $canonical;
      my $allow_blessed;
      my $convert_blessed;
   
      my $indent_length;
      my $escape_slash;
      my $bignum;
      my $as_nonblessed;
   
      my $depth;
      my $indent_count;
      my $keysort;
   
   
      sub PP_encode_json {
          my $self = shift;
          my $obj  = shift;
   
          $indent_count = 0;
          $depth        = 0;
   
          my $idx = $self->{PROPS};
   
          ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
              $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
           = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
                      P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
   
          ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
   
          $keysort = $canonical ? sub { $a cmp $b } : undef;
   
          if ($self->{sort_by}) {
              $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
                       : $self->{sort_by} =~ /\D+/       ? $self->{sort_by}
                       : sub { $a cmp $b };
          }
   
          encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
               if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]);
   
          my $str  = $self->object_to_json($obj);
   
          $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
   
          unless ($ascii or $latin1 or $utf8) {
              utf8::upgrade($str);
          }
   
          if ($idx->[ P_SHRINK ]) {
              utf8::downgrade($str, 1);
          }
   
          return $str;
      }
   
   
      sub object_to_json {
          my ($self, $obj) = @_;
          my $type = ref($obj);
   
          if($type eq 'HASH'){
              return $self->hash_to_json($obj);
          }
          elsif($type eq 'ARRAY'){
              return $self->array_to_json($obj);
          }
          elsif ($type) { # blessed object?
              if (blessed($obj)) {
   
                  return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
   
                  if ( $convert_blessed and $obj->can('TO_JSON') ) {
                      my $result = $obj->TO_JSON();
                      if ( defined $result and overload::Overloaded( $obj ) ) {
                          if ( overload::StrVal( $obj ) eq $result ) {
                              encode_error( sprintf(
                                  "%s::TO_JSON method returned same object as was passed instead of a new one",
                                  ref $obj
                              ) );
                          }
                      }
   
                      return $self->object_to_json( $result );
                  }
   
                  return "$obj" if ( $bignum and _is_bignum($obj) );
                  return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed.
   
                  encode_error( sprintf("encountered object '%s', but neither allow_blessed "
                      . "nor convert_blessed settings are enabled", $obj)
                  ) unless ($allow_blessed);
   
                  return 'null';
              }
              else {
                  return $self->value_to_json($obj);
              }
          }
          else{
              return $self->value_to_json($obj);
          }
      }
   
   
      sub hash_to_json {
          my ($self, $obj) = @_;
          my @res;
   
          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                           if (++$depth > $max_depth);
   
          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
          my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
   
          for my $k ( _sort( $obj ) ) {
              if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
              push @res, string_to_json( $self, $k )
                            .  $del
                            . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
          }
   
          --$depth;
          $self->_down_indent() if ($indent);
   
          return   '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' )  . '}';
      }
   
   
      sub array_to_json {
          my ($self, $obj) = @_;
          my @res;
   
          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                           if (++$depth > $max_depth);
   
          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
   
          for my $v (@$obj){
              push @res, $self->object_to_json($v) || $self->value_to_json($v);
          }
   
          --$depth;
          $self->_down_indent() if ($indent);
   
          return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']';
      }
   
   
      sub value_to_json {
          my ($self, $value) = @_;
   
          return 'null' if(!defined $value);
   
          my $b_obj = B::svref_2object(\$value);  # for round trip problem
          my $flags = $b_obj->FLAGS;
   
          return $value # as is 
              if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
   
          my $type = ref($value);
   
          if(!$type){
              return string_to_json($self, $value);
          }
          elsif( blessed($value) and  $value->isa('JSON::PP::Boolean') ){
              return $$value == 1 ? 'true' : 'false';
          }
          elsif ($type) {
              if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
                  return $self->value_to_json("$value");
              }
   
              if ($type eq 'SCALAR' and defined $$value) {
                  return   $$value eq '1' ? 'true'
                         : $$value eq '0' ? 'false'
                         : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
                         : encode_error("cannot encode reference to scalar");
              }
   
               if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
                   return 'null';
               }
               else {
                   if ( $type eq 'SCALAR' or $type eq 'REF' ) {
                      encode_error("cannot encode reference to scalar");
                   }
                   else {
                      encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
                   }
               }
   
          }
          else {
              return $self->{fallback}->($value)
                   if ($self->{fallback} and ref($self->{fallback}) eq 'CODE');
              return 'null';
          }
   
      }
   
   
      my %esc = (
          "\n" => '\n',
          "\r" => '\r',
          "\t" => '\t',
          "\f" => '\f',
          "\b" => '\b',
          "\"" => '\"',
          "\\" => '\\\\',
          "\'" => '\\\'',
      );
   
   
      sub string_to_json {
          my ($self, $arg) = @_;
   
          $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
          $arg =~ s/\//\\\//g if ($escape_slash);
          $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
   
          if ($ascii) {
              $arg = JSON_PP_encode_ascii($arg);
          }
   
          if ($latin1) {
              $arg = JSON_PP_encode_latin1($arg);
          }
   
          if ($utf8) {
              utf8::encode($arg);
          }
   
          return '"' . $arg . '"';
      }
   
   
      sub blessed_to_json {
          my $reftype = reftype($_[1]) || '';
          if ($reftype eq 'HASH') {
              return $_[0]->hash_to_json($_[1]);
          }
          elsif ($reftype eq 'ARRAY') {
              return $_[0]->array_to_json($_[1]);
          }
          else {
              return 'null';
          }
      }
   
   
      sub encode_error {
          my $error  = shift;
          Carp::croak "$error";
      }
   
   
      sub _sort {
          defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
      }
   
   
      sub _up_indent {
          my $self  = shift;
          my $space = ' ' x $indent_length;
   
          my ($pre,$post) = ('','');
   
          $post = "\n" . $space x $indent_count;
   
          $indent_count++;
   
          $pre = "\n" . $space x $indent_count;
   
          return ($pre,$post);
      }
   
   
      sub _down_indent { $indent_count--; }
   
   
      sub PP_encode_box {
          {
              depth        => $depth,
              indent_count => $indent_count,
          };
      }
   
  } # Convert
   
   
  sub _encode_ascii {
      join('',
          map {
              $_ <= 127 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
          } unpack('U*', $_[0])
      );
  }
   
   
  sub _encode_latin1 {
      join('',
          map {
              $_ <= 255 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
          } unpack('U*', $_[0])
      );
  }
   
   
  sub _encode_surrogates { # from perlunicode
      my $uni = $_[0] - 0x10000;
      return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
  }
   
   
  sub _is_bignum {
      $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
  }
   
   
   
  #
  # JSON => Perl
  #
   
  my $max_intsize;
   
  BEGIN {
      my $checkint = 1111;
      for my $d (5..64) {
          $checkint .= 1;
          my $int   = eval qq| $checkint |;
          if ($int =~ /[eE]/) {
              $max_intsize = $d - 1;
              last;
          }
      }
  }
   
  { # PARSE 
   
      my %escapes = ( #  by Jeremy Muhlich <jmuhlich [at] bitflood.org>
          b    => "\x8",
          t    => "\x9",
          n    => "\xA",
          f    => "\xC",
          r    => "\xD",
          '\\' => '\\',
          '"'  => '"',
          '/'  => '/',
      );
   
      my $text; # json data
      my $at;   # offset
      my $ch;   # 1chracter
      my $len;  # text length (changed according to UTF8 or NON UTF8)
      # INTERNAL
      my $depth;          # nest counter
      my $encoding;       # json text encoding
      my $is_valid_utf8;  # temp variable
      my $utf8_len;       # utf8 byte length
      # FLAGS
      my $utf8;           # must be utf8
      my $max_depth;      # max nest nubmer of objects and arrays
      my $max_size;
      my $relaxed;
      my $cb_object;
      my $cb_sk_object;
   
      my $F_HOOK;
   
      my $allow_bigint;   # using Math::BigInt
      my $singlequote;    # loosely quoting
      my $loose;          # 
      my $allow_barekey;  # bareKey
   
      # $opt flag
      # 0x00000001 .... decode_prefix
      # 0x10000000 .... incr_parse
   
      sub PP_decode_json {
          my ($self, $opt); # $opt is an effective flag during this decode_json.
   
          ($self, $text, $opt) = @_;
   
          ($at, $ch, $depth) = (0, '', 0);
   
          if ( !defined $text or ref $text ) {
              decode_error("malformed JSON string, neither array, object, number, string or atom");
          }
   
          my $idx = $self->{PROPS};
   
          ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
              = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
   
          if ( $utf8 ) {
              utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
          }
          else {
              utf8::upgrade( $text );
          }
   
          $len = length $text;
   
          ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
               = @{$self}{qw/max_depth  max_size cb_object cb_sk_object F_HOOK/};
   
          if ($max_size > 1) {
              use bytes;
              my $bytes = length $text;
              decode_error(
                  sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
                      , $bytes, $max_size), 1
              ) if ($bytes > $max_size);
          }
   
          # Currently no effect
          # should use regexp
          my @octets = unpack('C4', $text);
          $encoding =   ( $octets[0] and  $octets[1]) ? 'UTF-8'
                      : (!$octets[0] and  $octets[1]) ? 'UTF-16BE'
                      : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
                      : ( $octets[2]                ) ? 'UTF-16LE'
                      : (!$octets[2]                ) ? 'UTF-32LE'
                      : 'unknown';
   
          white(); # remove head white space
   
          my $valid_start = defined $ch; # Is there a first character for JSON structure?
   
          my $result = value();
   
          return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse
   
          decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
   
          if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) {
                  decode_error(
                  'JSON text must be an object or array (but found number, string, true, false or null,'
                         . ' use allow_nonref to allow this)', 1);
          }
   
          Carp::croak('something wrong.') if $len < $at; # we won't arrive here.
   
          my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length
   
          white(); # remove tail white space
   
          if ( $ch ) {
              return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix
              decode_error("garbage after JSON object");
          }
   
          ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result;
      }
   
   
      sub next_chr {
          return $ch = undef if($at >= $len);
          $ch = substr($text, $at++, 1);
      }
   
   
      sub value {
          white();
          return          if(!defined $ch);
          return object() if($ch eq '{');
          return array()  if($ch eq '[');
          return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
          return number() if($ch =~ /[0-9]/ or $ch eq '-');
          return word();
      }
   
      sub string {
          my ($i, $s, $t, $u);
          my $utf16;
          my $is_utf8;
   
          ($is_valid_utf8, $utf8_len) = ('', 0);
   
          $s = ''; # basically UTF8 flag on
   
          if($ch eq '"' or ($singlequote and $ch eq "'")){
              my $boundChar = $ch;
   
              OUTER: while( defined(next_chr()) ){
   
                  if($ch eq $boundChar){
                      next_chr();
   
                      if ($utf16) {
                          decode_error("missing low surrogate character in surrogate pair");
                      }
   
                      utf8::decode($s) if($is_utf8);
   
                      return $s;
                  }
                  elsif($ch eq '\\'){
                      next_chr();
                      if(exists $escapes{$ch}){
                          $s .= $escapes{$ch};
                      }
                      elsif($ch eq 'u'){ # UNICODE handling
                          my $u = '';
   
                          for(1..4){
                              $ch = next_chr();
                              last OUTER if($ch !~ /[0-9a-fA-F]/);
                              $u .= $ch;
                          }
   
                          # U+D800 - U+DBFF
                          if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
                              $utf16 = $u;
                          }
                          # U+DC00 - U+DFFF
                          elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
                              unless (defined $utf16) {
                                  decode_error("missing high surrogate character in surrogate pair");
                              }
                              $is_utf8 = 1;
                              $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
                              $utf16 = undef;
                          }
                          else {
                              if (defined $utf16) {
                                  decode_error("surrogate pair expected");
                              }
   
                              if ( ( my $hex = hex( $u ) ) > 127 ) {
                                  $is_utf8 = 1;
                                  $s .= JSON_PP_decode_unicode($u) || next;
                              }
                              else {
                                  $s .= chr $hex;
                              }
                          }
   
                      }
                      else{
                          unless ($loose) {
                              $at -= 2;
                              decode_error('illegal backslash escape sequence in string');
                          }
                          $s .= $ch;
                      }
                  }
                  else{
   
                      if ( ord $ch  > 127 ) {
                          if ( $utf8 ) {
                              unless( $ch = is_valid_utf8($ch) ) {
                                  $at -= 1;
                                  decode_error("malformed UTF-8 character in JSON string");
                              }
                              else {
                                  $at += $utf8_len - 1;
                              }
                          }
                          else {
                              utf8::encode( $ch );
                          }
   
                          $is_utf8 = 1;
                      }
   
                      if (!$loose) {
                          if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { # '/' ok
                              $at--;
                              decode_error('invalid character encountered while parsing JSON string');
                          }
                      }
   
                      $s .= $ch;
                  }
              }
          }
   
          decode_error("unexpected end of string while parsing JSON string");
      }
   
   
      sub white {
          while( defined $ch  ){
              if($ch le ' '){
                  next_chr();
              }
              elsif($ch eq '/'){
                  next_chr();
                  if(defined $ch and $ch eq '/'){
                      1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
                  }
                  elsif(defined $ch and $ch eq '*'){
                      next_chr();
                      while(1){
                          if(defined $ch){
                              if($ch eq '*'){
                                  if(defined(next_chr()) and $ch eq '/'){
                                      next_chr();
                                      last;
                                  }
                              }
                              else{
                                  next_chr();
                              }
                          }
                          else{
                              decode_error("Unterminated comment");
                          }
                      }
                      next;
                  }
                  else{
                      $at--;
                      decode_error("malformed JSON string, neither array, object, number, string or atom");
                  }
              }
              else{
                  if ($relaxed and $ch eq '#') { # correctly?
                      pos($text) = $at;
                      $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
                      $at = pos($text);
                      next_chr;
                      next;
                  }
   
                  last;
              }
          }
      }
   
   
      sub array {
          my $a  = [];
   
          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                      if (++$depth > $max_depth);
   
          next_chr();
          white();
   
          if(defined $ch and $ch eq ']'){
              --$depth;
              next_chr();
              return $a;
          }
          else {
              while(defined($ch)){
                  push @$a, value();
   
                  white();
   
                  if (!defined $ch) {
                      last;
                  }
   
                  if($ch eq ']'){
                      --$depth;
                      next_chr();
                      return $a;
                  }
   
                  if($ch ne ','){
                      last;
                  }
   
                  next_chr();
                  white();
   
                  if ($relaxed and $ch eq ']') {
                      --$depth;
                      next_chr();
                      return $a;
                  }
   
              }
          }
   
          decode_error(", or ] expected while parsing array");
      }
   
   
      sub object {
          my $o = {};
          my $k;
   
          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                  if (++$depth > $max_depth);
          next_chr();
          white();
   
          if(defined $ch and $ch eq '}'){
              --$depth;
              next_chr();
              if ($F_HOOK) {
                  return _json_object_hook($o);
              }
              return $o;
          }
          else {
              while (defined $ch) {
                  $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
                  white();
   
                  if(!defined $ch or $ch ne ':'){
                      $at--;
                      decode_error("':' expected");
                  }
   
                  next_chr();
                  $o->{$k} = value();
                  white();
   
                  last if (!defined $ch);
   
                  if($ch eq '}'){
                      --$depth;
                      next_chr();
                      if ($F_HOOK) {
                          return _json_object_hook($o);
                      }
                      return $o;
                  }
   
                  if($ch ne ','){
                      last;
                  }
   
                  next_chr();
                  white();
   
                  if ($relaxed and $ch eq '}') {
                      --$depth;
                      next_chr();
                      if ($F_HOOK) {
                          return _json_object_hook($o);
                      }
                      return $o;
                  }
   
              }
   
          }
   
          $at--;
          decode_error(", or } expected while parsing object/hash");
      }
   
   
      sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
          my $key;
          while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
              $key .= $ch;
              next_chr();
          }
          return $key;
      }
   
   
      sub word {
          my $word =  substr($text,$at-1,4);
   
          if($word eq 'true'){
              $at += 3;
              next_chr;
              return $JSON::PP::true;
          }
          elsif($word eq 'null'){
              $at += 3;
              next_chr;
              return undef;
          }
          elsif($word eq 'fals'){
              $at += 3;
              if(substr($text,$at,1) eq 'e'){
                  $at++;
                  next_chr;
                  return $JSON::PP::false;
              }
          }
   
          $at--; # for decode_error report
   
          decode_error("'null' expected")  if ($word =~ /^n/);
          decode_error("'true' expected")  if ($word =~ /^t/);
          decode_error("'false' expected") if ($word =~ /^f/);
          decode_error("malformed JSON string, neither array, object, number, string or atom");
      }
   
   
      sub number {
          my $n    = '';
          my $v;
   
          # According to RFC4627, hex or oct digts are invalid.
          if($ch eq '0'){
              my $peek = substr($text,$at,1);
              my $hex  = $peek =~ /[xX]/; # 0 or 1
   
              if($hex){
                  decode_error("malformed number (leading zero must not be followed by another digit)");
                  ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
              }
              else{ # oct
                  ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
                  if (defined $n and length $n > 1) {
                      decode_error("malformed number (leading zero must not be followed by another digit)");
                  }
              }
   
              if(defined $n and length($n)){
                  if (!$hex and length($n) == 1) {
                     decode_error("malformed number (leading zero must not be followed by another digit)");
                  }
                  $at += length($n) + $hex;
                  next_chr;
                  return $hex ? hex($n) : oct($n);
              }
          }
   
          if($ch eq '-'){
              $n = '-';
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after initial minus)");
              }
          }
   
          while(defined $ch and $ch =~ /\d/){
              $n .= $ch;
              next_chr;
          }
   
          if(defined $ch and $ch eq '.'){
              $n .= '.';
   
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after decimal point)");
              }
              else {
                  $n .= $ch;
              }
   
              while(defined(next_chr) and $ch =~ /\d/){
                  $n .= $ch;
              }
          }
   
          if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
              $n .= $ch;
              next_chr;
   
              if(defined($ch) and ($ch eq '+' or $ch eq '-')){
                  $n .= $ch;
                  next_chr;
                  if (!defined $ch or $ch =~ /\D/) {
                      decode_error("malformed number (no digits after exp sign)");
                  }
                  $n .= $ch;
              }
              elsif(defined($ch) and $ch =~ /\d/){
                  $n .= $ch;
              }
              else {
                  decode_error("malformed number (no digits after exp sign)");
              }
   
              while(defined(next_chr) and $ch =~ /\d/){
                  $n .= $ch;
              }
   
          }
   
          $v .= $n;
   
          if ($v !~ /[.eE]/ and length $v > $max_intsize) {
              if ($allow_bigint) { # from Adam Sussman
                  require Math::BigInt;
                  return Math::BigInt->new($v);
              }
              else {
                  return "$v";
              }
          }
          elsif ($allow_bigint) {
              require Math::BigFloat;
              return Math::BigFloat->new($v);
          }
   
          return 0+$v;
      }
   
   
      sub is_valid_utf8 {
   
          $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
                    : $_[0] =~ /[\xC2-\xDF]/  ? 2
                    : $_[0] =~ /[\xE0-\xEF]/  ? 3
                    : $_[0] =~ /[\xF0-\xF4]/  ? 4
                    : 0
                    ;
   
          return unless $utf8_len;
   
          my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
   
          return ( $is_valid_utf8 =~ /^(?:
               [\x00-\x7F]
              |[\xC2-\xDF][\x80-\xBF]
              |[\xE0][\xA0-\xBF][\x80-\xBF]
              |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
              |[\xED][\x80-\x9F][\x80-\xBF]
              |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
              |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
          )$/x )  ? $is_valid_utf8 : '';
      }
   
   
      sub decode_error {
          my $error  = shift;
          my $no_rep = shift;
          my $str    = defined $text ? substr($text, $at) : '';
          my $mess   = '';
          my $type   = $] >= 5.008           ? 'U*'
                     : $] <  5.006           ? 'C*'
                     : utf8::is_utf8( $str ) ? 'U*' # 5.6
                     : 'C*'
                     ;
   
          for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
              $mess .=  $c == 0x07 ? '\a'
                      : $c == 0x09 ? '\t'
                      : $c == 0x0a ? '\n'
                      : $c == 0x0d ? '\r'
                      : $c == 0x0c ? '\f'
                      : $c <  0x20 ? sprintf('\x{%x}', $c)
                      : $c == 0x5c ? '\\\\'
                      : $c <  0x80 ? chr($c)
                      : sprintf('\x{%x}', $c)
                      ;
              if ( length $mess >= 20 ) {
                  $mess .= '...';
                  last;
              }
          }
   
          unless ( length $mess ) {
              $mess = '(end of string)';
          }
   
          Carp::croak (
              $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
          );
   
      }
   
   
      sub _json_object_hook {
          my $o    = $_[0];
          my @ks = keys %{$o};
   
          if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
              my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
              if (@val == 1) {
                  return $val[0];
              }
          }
   
          my @val = $cb_object->($o) if ($cb_object);
          if (@val == 0 or @val > 1) {
              return $o;
          }
          else {
              return $val[0];
          }
      }
   
   
      sub PP_decode_box {
          {
              text    => $text,
              at      => $at,
              ch      => $ch,
              len     => $len,
              depth   => $depth,
              encoding      => $encoding,
              is_valid_utf8 => $is_valid_utf8,
          };
      }
   
  } # PARSE
   
   
  sub _decode_surrogates { # from perlunicode
      my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
      my $un  = pack('U*', $uni);
      utf8::encode( $un );
      return $un;
  }
   
   
  sub _decode_unicode {
      my $un = pack('U', hex shift);
      utf8::encode( $un );
      return $un;
  }
   
   
  #
  # Setup for various Perl versions (the code from JSON::PP58)
  #
   
  BEGIN {
   
      unless ( defined &utf8::is_utf8 ) {
         require Encode;
         *utf8::is_utf8 = *Encode::is_utf8;
      }
   
      if ( $] >= 5.008 ) {
          *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
          *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
          *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
          *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
      }
   
      if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
          package JSON::PP;
          require subs;
          subs->import('join');
          eval q|
              sub join {
                  return '' if (@_ < 2);
                  my $j   = shift;
                  my $str = shift;
                  for (@_) { $str .= $j . $_; }
                  return $str;
              }
          |;
      }
   
      sub JSON::PP::incr_parse {
          local $Carp::CarpLevel = 1;
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
      }
   
      sub JSON::PP::incr_skip {
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
      }
   
      sub JSON::PP::incr_reset {
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
      }
   
      eval q{
          sub JSON::PP::incr_text : lvalue {
              $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
   
              if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
                  Carp::croak("incr_text can not be called when the incremental parser already started parsing");
              }
              $_[0]->{_incr_parser}->{incr_text};
          }
      } if ( $] >= 5.006 );
   
  } # Setup for various Perl versions (the code from JSON::PP58)
   
  ###############################
  # Utilities
  #
   
  BEGIN {
      eval 'require Scalar::Util';
      unless($@){
          *JSON::PP::blessed = \&Scalar::Util::blessed;
          *JSON::PP::reftype = \&Scalar::Util::reftype;
      }
      else{ # This code is from Sclar::Util.
          # warn $@;
          eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
          *JSON::PP::blessed = sub {
              local($@, $SIG{__DIE__}, $SIG{__WARN__});
              ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
          };
          my %tmap = qw(
              B::NULL   SCALAR
              B::HV     HASH
              B::AV     ARRAY
              B::CV     CODE
              B::IO     IO
              B::GV     GLOB
              B::REGEXP REGEXP
          );
          *JSON::PP::reftype = sub {
              my $r = shift;
   
              return undef unless length(ref($r));
   
              my $t = ref(B::svref_2object($r));
   
              return
                  exists $tmap{$t} ? $tmap{$t}
                : length(ref($$r)) ? 'REF'
                :                    'SCALAR';
          };
      }
  }
   
   
  # shamely copied and modified from JSON::XS code.
   
  $JSON::PP::true  = do { bless \(my $dummy = 1), "JSON::backportPP::Boolean" };
  $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::backportPP::Boolean" };
   
  sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); }
   
  sub true  { $JSON::PP::true  }
  sub false { $JSON::PP::false }
  sub null  { undef; }
   
  ###############################
   
  package JSON::backportPP::Boolean;
   
  @JSON::backportPP::Boolean::ISA = ('JSON::PP::Boolean');
  use overload (
     "0+"     => sub { ${$_[0]} },
     "++"     => sub { $_[0] = ${$_[0]} + 1 },
     "--"     => sub { $_[0] = ${$_[0]} - 1 },
     fallback => 1,
  );
   
   
  ###############################
   
  package JSON::PP::IncrParser;
   
  use strict;
   
  use constant INCR_M_WS   => 0; # initial whitespace skipping
  use constant INCR_M_STR  => 1; # inside string
  use constant INCR_M_BS   => 2; # inside backslash
  use constant INCR_M_JSON => 3; # outside anything, count nesting
  use constant INCR_M_C0   => 4;
  use constant INCR_M_C1   => 5;
   
  $JSON::PP::IncrParser::VERSION = '1.01';
   
  my $unpack_format = $] < 5.006 ? 'C*' : 'U*';
   
  sub new {
      my ( $class ) = @_;
   
      bless {
          incr_nest    => 0,
          incr_text    => undef,
          incr_parsing => 0,
          incr_p       => 0,
      }, $class;
  }
   
   
  sub incr_parse {
      my ( $self, $coder, $text ) = @_;
   
      $self->{incr_text} = '' unless ( defined $self->{incr_text} );
   
      if ( defined $text ) {
          if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
              utf8::upgrade( $self->{incr_text} ) ;
              utf8::decode( $self->{incr_text} ) ;
          }
          $self->{incr_text} .= $text;
      }
   
   
      my $max_size = $coder->get_max_size;
   
      if ( defined wantarray ) {
   
          $self->{incr_mode} = INCR_M_WS;
   
          if ( wantarray ) {
              my @ret;
   
              $self->{incr_parsing} = 1;
   
              do {
                  push @ret, $self->_incr_parse( $coder, $self->{incr_text} );
   
                  unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) {
                      $self->{incr_mode} = INCR_M_WS;
                  }
   
              } until ( !$self->{incr_text} );
   
              $self->{incr_parsing} = 0;
   
              return @ret;
          }
          else { # in scalar context
              $self->{incr_parsing} = 1;
              my $obj = $self->_incr_parse( $coder, $self->{incr_text} );
              $self->{incr_parsing} = 0 if defined $obj; # pointed by Martin J. Evans
              return $obj ? $obj : undef; # $obj is an empty string, parsing was completed.
          }
   
      }
   
  }
   
   
  sub _incr_parse {
      my ( $self, $coder, $text, $skip ) = @_;
      my $p = $self->{incr_p};
      my $restore = $p;
   
      my @obj;
      my $len = length $text;
   
      if ( $self->{incr_mode} == INCR_M_WS ) {
          while ( $len > $p ) {
              my $s = substr( $text, $p, 1 );
              $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
              $self->{incr_mode} = INCR_M_JSON;
              last;
         }
      }
   
      while ( $len > $p ) {
          my $s = substr( $text, $p++, 1 );
   
          if ( $s eq '"' ) {
              if ( $self->{incr_mode} != INCR_M_STR  ) {
                  $self->{incr_mode} = INCR_M_STR;
              }
              else {
                  $self->{incr_mode} = INCR_M_JSON;
                  unless ( $self->{incr_nest} ) {
                      last;
                  }
              }
          }
   
          if ( $self->{incr_mode} == INCR_M_JSON ) {
   
              if ( $s eq '[' or $s eq '{' ) {
                  if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
                      Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
                  }
              }
              elsif ( $s eq ']' or $s eq '}' ) {
                  last if ( --$self->{incr_nest} <= 0 );
              }
              elsif ( $s eq '#' ) {
                  while ( $len > $p ) {
                      last if substr( $text, $p++, 1 ) eq "\n";
                  }
              }
   
          }
   
      }
   
      $self->{incr_p} = $p;
   
      return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 );
   
      return '' unless ( length substr( $self->{incr_text}, 0, $p ) );
   
      local $Carp::CarpLevel = 2;
   
      $self->{incr_p} = $restore;
      $self->{incr_c} = $p;
   
      my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 );
   
      $self->{incr_text} = substr( $self->{incr_text}, $p );
      $self->{incr_p} = 0;
   
      return $obj or '';
  }
   
   
  sub incr_text {
      if ( $_[0]->{incr_parsing} ) {
          Carp::croak("incr_text can not be called when the incremental parser already started parsing");
      }
      $_[0]->{incr_text};
  }
   
   
  sub incr_skip {
      my $self  = shift;
      $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} );
      $self->{incr_p} = 0;
  }
   
   
  sub incr_reset {
      my $self = shift;
      $self->{incr_text}    = undef;
      $self->{incr_p}       = 0;
      $self->{incr_mode}    = 0;
      $self->{incr_nest}    = 0;
      $self->{incr_parsing} = 0;
  }
   
  ###############################
   
   
  1;
  __END__
  =pod
   
  =head1 NAME
   
  JSON::PP - JSON::XS compatible pure-Perl module.
   
  =head1 SYNOPSIS
   
   use JSON::PP;
   
   # exported functions, they croak on error
   # and expect/generate UTF-8
   
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
   
   # OO-interface
   
   $coder = JSON::PP->new->ascii->pretty->allow_nonref;
   $pretty_printed_unencoded = $coder->encode ($perl_scalar);
   $perl_scalar = $coder->decode ($unicode_json_text);
   
   # Note that JSON version 2.0 and above will automatically use
   # JSON::XS or JSON::PP, so you should be able to just:
    
   use JSON;
   
  =head1 VERSION
   
   JSON::PP version 2.27008
   
  =head1 DESCRIPTION
   
  This module is L<JSON::XS> compatible pure Perl module.
  (Perl 5.8 or later is recommended)
   
  JSON::XS is the fastest and most proper JSON module on CPAN.
  It is written by Marc Lehmann in C, so must be compiled and
  installed in the used environment.
   
  JSON::PP is a pure-Perl module and has compatibility to JSON::XS.
   
   
  =head2 FEATURES
   
  =over
   
  =item * correct unicode handling
   
  This module knows how to handle Unicode (depending on Perl version).
   
  See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL> and L<UNICODE HANDLING ON PERLS>.
   
   
  =item * round-trip integrity
   
  When you serialise a perl data structure using only data types supported
  by JSON and Perl, the deserialised data structure is identical on the Perl
  level. (e.g. the string "2.0" doesn't suddenly become "2" just because
  it looks like a number). There I<are> minor exceptions to this, read the
  MAPPING section below to learn about those.
   
   
  =item * strict checking of JSON correctness
   
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default (the latter is a security feature).
  But when some options are set, loose chcking features are available.
   
  =back
   
  =head1 FUNCTIONS
   
  Basically, check to L<JSON> or L<JSON::XS>.
   
  =head2 encode_json
   
      $json_text = encode_json $perl_scalar
   
  =head2 decode_json
   
      $perl_scalar = decode_json $json_text
   
  =head2 JSON::PP::true
   
  Returns JSON true value which is blessed object.
  It C<isa> JSON::PP::Boolean object.
   
  =head2 JSON::PP::false
   
  Returns JSON false value which is blessed object.
  It C<isa> JSON::PP::Boolean object.
   
  =head2 JSON::PP::null
   
  Returns C<undef>.
   
  =head1 METHODS
   
  Basically, check to L<JSON> or L<JSON::XS>.
   
  =head2 new
   
      $json = new JSON::PP
   
  Rturns a new JSON::PP object that can be used to de/encode JSON
  strings.
   
  =head2 ascii
   
      $json = $json->ascii([$enable])
       
      $enabled = $json->get_ascii
   
  If $enable is true (or missing), then the encode method will not generate characters outside
  the code range 0..127. Any Unicode characters outside that range will be escaped using either
  a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
  (See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>).
   
  In Perl 5.005, there is no character having high value (more than 255).
  See to L<UNICODE HANDLING ON PERLS>.
   
  If $enable is false, then the encode method will not escape Unicode characters unless
  required by the JSON syntax or other flags. This results in a faster and more compact format.
   
    JSON::PP->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
   
  =head2 latin1
   
      $json = $json->latin1([$enable])
       
      $enabled = $json->get_latin1
   
  If $enable is true (or missing), then the encode method will encode the resulting JSON
  text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
   
  If $enable is false, then the encode method will not escape Unicode characters
  unless required by the JSON syntax or other flags.
   
    JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
   
  See to L<UNICODE HANDLING ON PERLS>.
   
  =head2 utf8
   
      $json = $json->utf8([$enable])
       
      $enabled = $json->get_utf8
   
  If $enable is true (or missing), then the encode method will encode the JSON result
  into UTF-8, as required by many protocols, while the decode method expects to be handled
  an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
  characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
   
  (In Perl 5.005, any character outside the range 0..255 does not exist.
  See to L<UNICODE HANDLING ON PERLS>.)
   
  In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
  encoding families, as described in RFC4627.
   
  If $enable is false, then the encode method will return the JSON string as a (non-encoded)
  Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
  (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
   
  Example, output UTF-16BE-encoded JSON:
   
    use Encode;
    $jsontext = encode "UTF-16BE", JSON::XS->new->encode ($object);
   
  Example, decode UTF-32LE-encoded JSON:
   
    use Encode;
    $object = JSON::XS->new->decode (decode "UTF-32LE", $jsontext);
   
   
  =head2 pretty
   
      $json = $json->pretty([$enable])
   
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> flags in one call to generate the most readable
  (or most compact) form possible.
   
  =head2 indent
   
      $json = $json->indent([$enable])
       
      $enabled = $json->get_indent
   
  The default indent space length is three.
  You can use C<indent_length> to change the length.
   
  =head2 space_before
   
      $json = $json->space_before([$enable])
       
      $enabled = $json->get_space_before
   
  =head2 space_after
   
      $json = $json->space_after([$enable])
       
      $enabled = $json->get_space_after
   
  =head2 relaxed
   
      $json = $json->relaxed([$enable])
       
      $enabled = $json->get_relaxed
   
  =head2 canonical
   
      $json = $json->canonical([$enable])
       
      $enabled = $json->get_canonical
   
  If you want your own sorting routine, you can give a code referece
  or a subroutine name to C<sort_by>. See to C<JSON::PP OWN METHODS>.
   
  =head2 allow_nonref
   
      $json = $json->allow_nonref([$enable])
       
      $enabled = $json->get_allow_nonref
   
  =head2 allow_unknown
   
      $json = $json->allow_unknown ([$enable])
       
      $enabled = $json->get_allow_unknown
   
  =head2 allow_blessed
   
      $json = $json->allow_blessed([$enable])
       
      $enabled = $json->get_allow_blessed
   
  =head2 convert_blessed
   
      $json = $json->convert_blessed([$enable])
       
      $enabled = $json->get_convert_blessed
   
  =head2 filter_json_object
   
      $json = $json->filter_json_object([$coderef])
   
  =head2 filter_json_single_key_object
   
      $json = $json->filter_json_single_key_object($key [=> $coderef])
   
  =head2 shrink
   
      $json = $json->shrink([$enable])
       
      $enabled = $json->get_shrink
   
  In JSON::XS, this flag resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible.
  It will also try to downgrade any strings to octet-form if possible.
   
  In JSON::PP, it is noop about resizing strings but tries
  C<utf8::downgrade> to the returned string by C<encode>.
  See to L<utf8>.
   
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
   
  =head2 max_depth
   
      $json = $json->max_depth([$maximum_nesting_depth])
       
      $max_depth = $json->get_max_depth
   
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
   
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
   
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
   
  See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
   
  When a large value (100 or more) was set and it de/encodes a deep nested object/text,
  it may raise a warning 'Deep recursion on subroutin' at the perl runtime phase.
   
  =head2 max_size
   
      $json = $json->max_size([$maximum_string_size])
       
      $max_size = $json->get_max_size
   
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
   
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
   
  See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
   
  =head2 encode
   
      $json_text = $json->encode($perl_scalar)
   
  =head2 decode
   
      $perl_scalar = $json->decode($json_text)
   
  =head2 decode_prefix
   
      ($perl_scalar, $characters) = $json->decode_prefix($json_text)
   
   
  =head1 INCREMENTAL PARSING
   
  Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
   
  In some cases, there is the need for incremental parsing of JSON texts.
  This module does allow you to parse a JSON stream incrementally.
  It does so by accumulating text until it has a full JSON object, which
  it then can decode. This process is similar to using C<decode_prefix>
  to see if a full JSON object is available, but is much more efficient
  (and can be implemented with a minimum of method calls).
   
  This module will only attempt to parse the JSON text once it is sure it
  has enough text to get a decisive result, using a very simple but
  truly incremental parser. This means that it sometimes won't stop as
  early as the full parser, for example, it doesn't detect parenthese
  mismatches. The only thing it guarantees is that it starts decoding as
  soon as a syntactically valid JSON text has been seen. This means you need
  to set resource limits (e.g. C<max_size>) to ensure the parser will stop
  parsing in the presence if syntax errors.
   
  The following methods implement this incremental parser.
   
  =head2 incr_parse
   
      $json->incr_parse( [$string] ) # void context
       
      $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
       
      @obj_or_empty = $json->incr_parse( [$string] ) # list context
   
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
   
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
   
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
   
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the errornous part). This is the most common way of
  using the method.
   
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
   
  Example: Parse some JSON arrays/objects in a given string and return them.
   
      my @objs = JSON->new->incr_parse ("[5][7][1,2]");
   
  =head2 incr_text
   
      $lvalue_string = $json->incr_text
   
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object. Under
  all other circumstances you must not call this function (I mean it.
  although in simple tests it might actually work, it I<will> fail under
  real world conditions). As a special exception, you can also call this
  method before having parsed anything.
   
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
   
      $json->incr_text =~ s/\s*,\s*//;
   
  In Perl 5.005, C<lvalue> attribute is not available.
  You must write codes like the below:
   
      $string = $json->incr_text;
      $string =~ s/\s*,\s*//;
      $json->incr_text( $string );
   
  =head2 incr_skip
   
      $json->incr_skip
   
  This will reset the state of the incremental parser and will remove the
  parsed text from the input buffer. This is useful after C<incr_parse>
  died, in which case the input buffer and incremental parser state is left
  unchanged, to skip the text parsed so far and to reset the parse state.
   
  =head2 incr_reset
   
      $json->incr_reset
   
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
   
  This is useful if you want ot repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
   
  See to L<JSON::XS/INCREMENTAL PARSING> for examples.
   
   
  =head1 JSON::PP OWN METHODS
   
  =head2 allow_singlequote
   
      $json = $json->allow_singlequote([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will accept
  JSON strings quoted by single quotations that are invalid JSON
  format.
   
      $json->allow_singlequote->decode({"foo":'bar'});
      $json->allow_singlequote->decode({'foo':"bar"});
      $json->allow_singlequote->decode({'foo':'bar'});
   
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
   
   
  =head2 allow_barekey
   
      $json = $json->allow_barekey([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will accept
  bare keys of JSON object that are invalid JSON format.
   
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
   
      $json->allow_barekey->decode('{foo:"bar"}');
   
  =head2 allow_bignum
   
      $json = $json->allow_bignum([$enable])
   
  If C<$enable> is true (or missing), then C<decode> will convert
  the big integer Perl cannot handle as integer into a L<Math::BigInt>
  object and convert a floating number (any) into a L<Math::BigFloat>.
   
  On the contary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers with C<allow_blessed> enable.
   
     $json->allow_nonref->allow_blessed->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
   
  See to L<JSON::XS/MAPPING> aboout the normal conversion of JSON number.
   
  =head2 loose
   
      $json = $json->loose([$enable])
   
  The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
  and the module doesn't allow to C<decode> to these (except for \x2f).
  If C<$enable> is true (or missing), then C<decode>  will accept these
  unescaped strings.
   
      $json->loose->decode(qq|["abc
                                     def"]|);
   
  See L<JSON::XS/SSECURITY CONSIDERATIONS>.
   
  =head2 escape_slash
   
      $json = $json->escape_slash([$enable])
   
  According to JSON Grammar, I<slash> (U+002F) is escaped. But default
  JSON::PP (as same as JSON::XS) encodes strings without escaping slash.
   
  If C<$enable> is true (or missing), then C<encode> will escape slashes.
   
  =head2 (OBSOLETED)as_nonblessed
   
      $json = $json->as_nonblessed
   
  (OBSOLETED) If C<$enable> is true (or missing), then C<encode> will convert
  a blessed hash reference or a blessed array reference (contains
  other blessed references) into JSON members and arrays.
   
  This feature is effective only when C<allow_blessed> is enable.
   
  =head2 indent_length
   
      $json = $json->indent_length($length)
   
  JSON::XS indent space length is 3 and cannot be changed.
  JSON::PP set the indent space length with the given $length.
  The default is 3. The acceptable range is 0 to 15.
   
  =head2 sort_by
   
      $json = $json->sort_by($function_name)
      $json = $json->sort_by($subroutine_ref)
   
  If $function_name or $subroutine_ref are set, its sort routine are used
  in encoding JSON objects.
   
     $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
   
     $js = $pc->sort_by('own_sort')->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
   
     sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
   
  As the sorting routine runs in the JSON::PP scope, the given
  subroutine name and the special variables C<$a>, C<$b> will begin
  'JSON::PP::'.
   
  If $integer is set, then the effect is same as C<canonical> on.
   
  =head1 INTERNAL
   
  For developers.
   
  =over
   
  =item PP_encode_box
   
  Returns
   
          {
              depth        => $depth,
              indent_count => $indent_count,
          }
   
   
  =item PP_decode_box
   
  Returns
   
          {
              text    => $text,
              at      => $at,
              ch      => $ch,
              len     => $len,
              depth   => $depth,
              encoding      => $encoding,
              is_valid_utf8 => $is_valid_utf8,
          };
   
  =back
   
  =head1 MAPPING
   
  See to L<JSON::XS/MAPPING>.
   
   
  =head1 UNICODE HANDLING ON PERLS
   
  If you do not know about Unicode on Perl well,
  please check L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
   
  =head2 Perl 5.8 and later
   
  Perl can handle Unicode and the JSON::PP de/encode methods also work properly.
   
      $json->allow_nonref->encode(chr hex 3042);
      $json->allow_nonref->encode(chr hex 12345);
   
  Reuturns C<"\u3042"> and C<"\ud808\udf45"> respectively.
   
      $json->allow_nonref->decode('"\u3042"');
      $json->allow_nonref->decode('"\ud808\udf45"');
   
  Returns UTF-8 encoded strings with UTF8 flag, regarded as C<U+3042> and C<U+12345>.
   
  Note that the versions from Perl 5.8.0 to 5.8.2, Perl built-in C<join> was broken,
  so JSON::PP wraps the C<join> with a subroutine. Thus JSON::PP works slow in the versions.
   
   
  =head2 Perl 5.6
   
  Perl can handle Unicode and the JSON::PP de/encode methods also work.
   
  =head2 Perl 5.005
   
  Perl 5.005 is a byte sementics world -- all strings are sequences of bytes.
  That means the unicode handling is not available.
   
  In encoding,
   
      $json->allow_nonref->encode(chr hex 3042);  # hex 3042 is 12354.
      $json->allow_nonref->encode(chr hex 12345); # hex 12345 is 74565.
   
  Returns C<B> and C<E>, as C<chr> takes a value more than 255, it treats
  as C<$value % 256>, so the above codes are equivalent to :
   
      $json->allow_nonref->encode(chr 66);
      $json->allow_nonref->encode(chr 69);
   
  In decoding,
   
      $json->decode('"\u00e3\u0081\u0082"');
   
  The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded
  japanese character (C<HIRAGANA LETTER A>).
  And if it is represented in Unicode code point, C<U+3042>.
   
  Next, 
   
      $json->decode('"\u3042"');
   
  We ordinary expect the returned value is a Unicode character C<U+3042>.
  But here is 5.005 world. This is C<0xE3 0x81 0x82>.
   
      $json->decode('"\ud808\udf45"');
   
  This is not a character C<U+12345> but bytes - C<0xf0 0x92 0x8d 0x85>.
   
   
  =head1 TODO
   
  =over
   
  =item speed
   
  =item memory saving
   
  =back
   
   
  =head1 SEE ALSO
   
  Most of the document are copied and modified from JSON::XS doc.
   
  L<JSON::XS>
   
  RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
   
  =head1 AUTHOR
   
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
   
   
  =head1 COPYRIGHT AND LICENSE
   
  Copyright 2007-2010 by Makamaka Hannyaharamitu
   
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
   
  =cut
JSON_BACKPORTPP
$fatpacked{"JSON/backportPP/Boolean.pm"} = <<'JSON_BACKPORTPP_BOOLEAN';
  =head1 NAME
   
  JSON::PP::Boolean - dummy module providing JSON::PP::Boolean
   
  =head1 SYNOPSIS
   
   # do not "use" yourself
   
  =head1 DESCRIPTION
   
  This module exists only to provide overload resolution for Storable and similar modules. See
  L<JSON::PP> for more info about this class.
   
  =cut
   
  use JSON::backportPP ();
  use strict;
   
  1;
   
  =head1 AUTHOR
   
  This idea is from L<JSON::XS::Boolean> written by Marc Lehmann <schmorp[at]schmorp.de>
   
  =cut
   
JSON_BACKPORTPP_BOOLEAN
$fatpacked{"JSON/backportPP/Compat5005.pm"} = <<'JSON_BACKPORTPP_COMPAT5005';
  package # This is JSON::backportPP
      JSON::backportPP5005;
   
  use 5.005;
  use strict;
   
  my @properties;
   
  $JSON::PP5005::VERSION = '1.10';
   
  BEGIN {
   
      sub utf8::is_utf8 {
          0; # It is considered that UTF8 flag off for Perl 5.005.
      }
   
      sub utf8::upgrade {
      }
   
      sub utf8::downgrade {
          1; # must always return true.
      }
   
      sub utf8::encode  {
      }
   
      sub utf8::decode {
      }
   
      *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
      *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
      *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
      *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
   
      # missing in B module.
      sub B::SVp_IOK () { 0x01000000; }
      sub B::SVp_NOK () { 0x02000000; }
      sub B::SVp_POK () { 0x04000000; }
   
      $INC{'bytes.pm'} = 1; # dummy
  }
   
   
   
  sub _encode_ascii {
      join('', map { $_ <= 127 ? chr($_) : sprintf('\u%04x', $_) } unpack('C*', $_[0]) );
  }
   
   
  sub _encode_latin1 {
      join('', map { chr($_) } unpack('C*', $_[0]) );
  }
   
   
  sub _decode_surrogates { # from http://homepage1.nifty.com/nomenclator/unicode/ucs_utf.htm
      my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00); # from perlunicode
      my $bit = unpack('B32', pack('N', $uni));
   
      if ( $bit =~ /^00000000000(...)(......)(......)(......)$/ ) {
          my ($w, $x, $y, $z) = ($1, $2, $3, $4);
          return pack('B*', sprintf('11110%s10%s10%s10%s', $w, $x, $y, $z));
      }
      else {
          Carp::croak("Invalid surrogate pair");
      }
  }
   
   
  sub _decode_unicode {
      my ($u) = @_;
      my ($utf8bit);
   
      if ( $u =~ /^00([89a-f][0-9a-f])$/i ) { # 0x80-0xff
           return pack( 'H2', $1 );
      }
   
      my $bit = unpack("B*", pack("H*", $u));
   
      if ( $bit =~ /^00000(.....)(......)$/ ) {
          $utf8bit = sprintf('110%s10%s', $1, $2);
      }
      elsif ( $bit =~ /^(....)(......)(......)$/ ) {
          $utf8bit = sprintf('1110%s10%s10%s', $1, $2, $3);
      }
      else {
          Carp::croak("Invalid escaped unicode");
      }
   
      return pack('B*', $utf8bit);
  }
   
   
  sub JSON::PP::incr_text {
      $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
   
      if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
          Carp::croak("incr_text can not be called when the incremental parser already started parsing");
      }
   
      $_[0]->{_incr_parser}->{incr_text} = $_[1] if ( @_ > 1 );
      $_[0]->{_incr_parser}->{incr_text};
  }
   
   
  1;
  __END__
   
  =pod
   
  =head1 NAME
   
  JSON::PP5005 - Helper module in using JSON::PP in Perl 5.005
   
  =head1 DESCRIPTION
   
  JSON::PP calls internally.
   
  =head1 AUTHOR
   
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
   
   
  =head1 COPYRIGHT AND LICENSE
   
  Copyright 2007-2010 by Makamaka Hannyaharamitu
   
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
   
  =cut
   
JSON_BACKPORTPP_COMPAT5005
$fatpacked{"JSON/backportPP/Compat5006.pm"} = <<'JSON_BACKPORTPP_COMPAT5006';
  package # This is JSON::backportPP
      JSON::backportPP56;
   
  use 5.006;
  use strict;
   
  my @properties;
   
  $JSON::PP56::VERSION = '1.08';
   
  BEGIN {
   
      sub utf8::is_utf8 {
          my $len =  length $_[0]; # char length
          {
              use bytes; #  byte length;
              return $len != length $_[0]; # if !=, UTF8-flagged on.
          }
      }
   
   
      sub utf8::upgrade {
          ; # noop;
      }
   
   
      sub utf8::downgrade ($;$) {
          return 1 unless ( utf8::is_utf8( $_[0] ) );
   
          if ( _is_valid_utf8( $_[0] ) ) {
              my $downgrade;
              for my $c ( unpack( "U*", $_[0] ) ) {
                  if ( $c < 256 ) {
                      $downgrade .= pack("C", $c);
                  }
                  else {
                      $downgrade .= pack("U", $c);
                  }
              }
              $_[0] = $downgrade;
              return 1;
          }
          else {
              Carp::croak("Wide character in subroutine entry") unless ( $_[1] );
              0;
          }
      }
   
   
      sub utf8::encode ($) { # UTF8 flag off
          if ( utf8::is_utf8( $_[0] ) ) {
              $_[0] = pack( "C*", unpack( "C*", $_[0] ) );
          }
          else {
              $_[0] = pack( "U*", unpack( "C*", $_[0] ) );
              $_[0] = pack( "C*", unpack( "C*", $_[0] ) );
          }
      }
   
   
      sub utf8::decode ($) { # UTF8 flag on
          if ( _is_valid_utf8( $_[0] ) ) {
              utf8::downgrade( $_[0] );
              $_[0] = pack( "U*", unpack( "U*", $_[0] ) );
          }
      }
   
   
      *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
      *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
      *JSON::PP::JSON_PP_decode_surrogates = \&JSON::PP::_decode_surrogates;
      *JSON::PP::JSON_PP_decode_unicode    = \&JSON::PP::_decode_unicode;
   
      unless ( defined &B::SVp_NOK ) { # missing in B module.
          eval q{ sub B::SVp_NOK () { 0x02000000; } };
      }
   
  }
   
   
   
  sub _encode_ascii {
      join('',
          map {
              $_ <= 127 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_));
          } _unpack_emu($_[0])
      );
  }
   
   
  sub _encode_latin1 {
      join('',
          map {
              $_ <= 255 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_));
          } _unpack_emu($_[0])
      );
  }
   
   
  sub _unpack_emu { # for Perl 5.6 unpack warnings
      return   !utf8::is_utf8($_[0]) ? unpack('C*', $_[0]) 
             : _is_valid_utf8($_[0]) ? unpack('U*', $_[0])
             : unpack('C*', $_[0]);
  }
   
   
  sub _is_valid_utf8 {
      my $str = $_[0];
      my $is_utf8;
   
      while ($str =~ /(?:
            (
               [\x00-\x7F]
              |[\xC2-\xDF][\x80-\xBF]
              |[\xE0][\xA0-\xBF][\x80-\xBF]
              |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
              |[\xED][\x80-\x9F][\x80-\xBF]
              |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
              |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
            )
          | (.)
      )/xg)
      {
          if (defined $1) {
              $is_utf8 = 1 if (!defined $is_utf8);
          }
          else {
              $is_utf8 = 0 if (!defined $is_utf8);
              if ($is_utf8) { # eventually, not utf8
                  return;
              }
          }
      }
   
      return $is_utf8;
  }
   
   
  1;
  __END__
   
  =pod
   
  =head1 NAME
   
  JSON::PP56 - Helper module in using JSON::PP in Perl 5.6
   
  =head1 DESCRIPTION
   
  JSON::PP calls internally.
   
  =head1 AUTHOR
   
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
   
   
  =head1 COPYRIGHT AND LICENSE
   
  Copyright 2007-2009 by Makamaka Hannyaharamitu
   
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
   
  =cut
   
JSON_BACKPORTPP_COMPAT5006
$fatpacked{"Try/Tiny.pm"} = <<'TRY_TINY';
  package Try::Tiny;
   
  use strict;
  #use warnings;
   
  use vars qw(@EXPORT @EXPORT_OK $VERSION @ISA);
   
  BEGIN {
        require Exporter;
        @ISA = qw(Exporter);
  }
   
  $VERSION = "0.07";
   
  $VERSION = eval $VERSION;
   
  @EXPORT = @EXPORT_OK = qw(try catch finally);
   
  $Carp::Internal{+__PACKAGE__}++;
   
  # Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
  # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
  # context & not a scalar one
   
  sub try (&;@) {
        my ( $try, @code_refs ) = @_;
   
        # we need to save this here, the eval block will be in scalar context due
        # to $failed
        my $wantarray = wantarray;
   
        my ( $catch, @finally );
   
        # find labeled blocks in the argument list.
        # catch and finally tag the blocks by blessing a scalar reference to them.
        foreach my $code_ref (@code_refs) {
                next unless $code_ref;
   
                my $ref = ref($code_ref);
   
                if ( $ref eq 'Try::Tiny::Catch' ) {
                        $catch = ${$code_ref};
                } elsif ( $ref eq 'Try::Tiny::Finally' ) {
                        push @finally, ${$code_ref};
                } else {
                        use Carp;
                        confess("Unknown code ref type given '${ref}'. Check your usage & try again");
                }
        }
   
        # save the value of $@ so we can set $@ back to it in the beginning of the eval
        my $prev_error = $@;
   
        my ( @ret, $error, $failed );
   
        # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's
        # not perfect, but we could provide a list of additional errors for
        # $catch->();
   
        {
                # localize $@ to prevent clobbering of previous value by a successful
                # eval.
                local $@;
   
                # failed will be true if the eval dies, because 1 will not be returned
                # from the eval body
                $failed = not eval {
                        $@ = $prev_error;
   
                        # evaluate the try block in the correct context
                        if ( $wantarray ) {
                                @ret = $try->();
                        } elsif ( defined $wantarray ) {
                                $ret[0] = $try->();
                        } else {
                                $try->();
                        };
   
                        return 1; # properly set $fail to false
                };
   
                # copy $@ to $error; when we leave this scope, local $@ will revert $@
                # back to its previous value
                $error = $@;
        }
   
        # set up a scope guard to invoke the finally block at the end
        my @guards =
      map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) }
      @finally;
   
        # at this point $failed contains a true value if the eval died, even if some
        # destructor overwrote $@ as the eval was unwinding.
        if ( $failed ) {
                # if we got an error, invoke the catch block.
                if ( $catch ) {
                        # This works like given($error), but is backwards compatible and
                        # sets $_ in the dynamic scope for the body of C<$catch>
                        for ($error) {
                                return $catch->($error);
                        }
   
                        # in case when() was used without an explicit return, the C<for>
                        # loop will be aborted and there's no useful return value
                }
   
                return;
        } else {
                # no failure, $@ is back to what it was, everything is fine
                return $wantarray ? @ret : $ret[0];
        }
  }
   
  sub catch (&;@) {
        my ( $block, @rest ) = @_;
   
        return (
                bless(\$block, 'Try::Tiny::Catch'),
                @rest,
        );
  }
   
  sub finally (&;@) {
        my ( $block, @rest ) = @_;
   
        return (
                bless(\$block, 'Try::Tiny::Finally'),
                @rest,
        );
  }
   
  {
    package Try::Tiny::ScopeGuard;
   
    sub _new {
      shift;
      bless [ @_ ];
    }
   
    sub DESTROY {
      my @guts = @{ shift() };
      my $code = shift @guts;
      $code->(@guts);
    }
  }
   
  __PACKAGE__
   
  __END__
   
  =pod
   
  =head1 NAME
   
  Try::Tiny - minimal try/catch with proper localization of $@
   
  =head1 SYNOPSIS
   
        # handle errors with a catch handler
        try {
                die "foo";
        } catch {
                warn "caught error: $_"; # not $@
        };
   
        # just silence errors
        try {
                die "foo";
        };
   
  =head1 DESCRIPTION
   
  This module provides bare bones C<try>/C<catch>/C<finally> statements that are designed to
  minimize common mistakes with eval blocks, and NOTHING else.
   
  This is unlike L<TryCatch> which provides a nice syntax and avoids adding
  another call stack layer, and supports calling C<return> from the try block to
  return from the parent subroutine. These extra features come at a cost of a few
  dependencies, namely L<Devel::Declare> and L<Scope::Upper> which are
  occasionally problematic, and the additional catch filtering uses L<Moose>
  type constraints which may not be desirable either.
   
  The main focus of this module is to provide simple and reliable error handling
  for those having a hard time installing L<TryCatch>, but who still want to
  write correct C<eval> blocks without 5 lines of boilerplate each time.
   
  It's designed to work as correctly as possible in light of the various
  pathological edge cases (see L<BACKGROUND>) and to be compatible with any style
  of error values (simple strings, references, objects, overloaded objects, etc).
   
  If the try block dies, it returns the value of the last statement executed in
  the catch block, if there is one. Otherwise, it returns C<undef> in scalar
  context or the empty list in list context. The following two examples both
  assign C<"bar"> to C<$x>.
   
        my $x = try { die "foo" } catch { "bar" };
   
        my $x = eval { die "foo" } || "bar";
   
  You can add finally blocks making the following true.
   
        my $x;
        try { die 'foo' } finally { $x = 'bar' };
        try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' };
   
  Finally blocks are always executed making them suitable for cleanup code
  which cannot be handled using local.  You can add as many finally blocks to a
  given try block as you like.
   
  =head1 EXPORTS
   
  All functions are exported by default using L<Exporter>.
   
  If you need to rename the C<try>, C<catch> or C<finally> keyword consider using
  L<Sub::Import> to get L<Sub::Exporter>'s flexibility.
   
  =over 4
   
  =item try (&;@)
   
  Takes one mandatory try subroutine, an optional catch subroutine & finally
  subroutine.
   
  The mandatory subroutine is evaluated in the context of an C<eval> block.
   
  If no error occurred the value from the first block is returned, preserving
  list/scalar context.
   
  If there was an error and the second subroutine was given it will be invoked
  with the error in C<$_> (localized) and as that block's first and only
  argument.
   
  C<$@> does B<not> contain the error. Inside the C<catch> block it has the same
  value it had before the C<try> block was executed.
   
  Note that the error may be false, but if that happens the C<catch> block will
  still be invoked.
   
  Once all execution is finished then the finally block if given will execute.
   
  =item catch (&;$)
   
  Intended to be used in the second argument position of C<try>.
   
  Returns a reference to the subroutine it was given but blessed as
  C<Try::Tiny::Catch> which allows try to decode correctly what to do
  with this code reference.
   
        catch { ... }
   
  Inside the catch block the caught error is stored in C<$_>, while previous
  value of C<$@> is still available for use.  This value may or may not be
  meaningful depending on what happened before the C<try>, but it might be a good
  idea to preserve it in an error stack.
   
  For code that captures C<$@> when throwing new errors (i.e.
  L<Class::Throwable>), you'll need to do:
   
        local $@ = $_;
   
  =item finally (&;$)
   
    try     { ... }
    catch   { ... }
    finally { ... };
   
  Or
   
    try     { ... }
    finally { ... };
   
  Or even
   
    try     { ... }
    finally { ... }
    catch   { ... };
   
  Intended to be the second or third element of C<try>. Finally blocks are always
  executed in the event of a successful C<try> or if C<catch> is run. This allows
  you to locate cleanup code which cannot be done via C<local()> e.g. closing a file
  handle.
   
  When invoked, the finally block is passed the error that was caught.  If no
  error was caught, it is passed nothing.  In other words, the following code
  does just what you would expect:
   
    try {
      die_sometimes();
    } catch {
      # ...code run in case of error
    } finally {
      if (@_) {
        print "The try block died with: @_\n";
      } else {
        print "The try block ran without error.\n";
      }
    };
   
  B<You must always do your own error handling in the finally block>. C<Try::Tiny> will
  not do anything about handling possible errors coming from code located in these
  blocks.
   
  In the same way C<catch()> blesses the code reference this subroutine does the same
  except it bless them as C<Try::Tiny::Finally>.
   
  =back
   
  =head1 BACKGROUND
   
  There are a number of issues with C<eval>.
   
  =head2 Clobbering $@
   
  When you run an eval block and it succeeds, C<$@> will be cleared, potentially
  clobbering an error that is currently being caught.
   
  This causes action at a distance, clearing previous errors your caller may have
  not yet handled.
   
  C<$@> must be properly localized before invoking C<eval> in order to avoid this
  issue.
   
  More specifically, C<$@> is clobbered at the beginning of the C<eval>, which
  also makes it impossible to capture the previous error before you die (for
  instance when making exception objects with error stacks).
   
  For this reason C<try> will actually set C<$@> to its previous value (before
  the localization) in the beginning of the C<eval> block.
   
  =head2 Localizing $@ silently masks errors
   
  Inside an eval block C<die> behaves sort of like:
   
        sub die {
                $@ = $_[0];
                return_undef_from_eval();
        }
   
  This means that if you were polite and localized C<$@> you can't die in that
  scope, or your error will be discarded (printing "Something's wrong" instead).
   
  The workaround is very ugly:
   
        my $error = do {
                local $@;
                eval { ... };
                $@;
        };
   
        ...
        die $error;
   
  =head2 $@ might not be a true value
   
  This code is wrong:
   
        if ( $@ ) {
                ...
        }
   
  because due to the previous caveats it may have been unset.
   
  C<$@> could also be an overloaded error object that evaluates to false, but
  that's asking for trouble anyway.
   
  The classic failure mode is:
   
        sub Object::DESTROY {
                eval { ... }
        }
   
        eval {
                my $obj = Object->new;
   
                die "foo";
        };
   
        if ( $@ ) {
   
        }
   
  In this case since C<Object::DESTROY> is not localizing C<$@> but still uses
  C<eval>, it will set C<$@> to C<"">.
   
  The destructor is called when the stack is unwound, after C<die> sets C<$@> to
  C<"foo at Foo.pm line 42\n">, so by the time C<if ( $@ )> is evaluated it has
  been cleared by C<eval> in the destructor.
   
  The workaround for this is even uglier than the previous ones. Even though we
  can't save the value of C<$@> from code that doesn't localize, we can at least
  be sure the eval was aborted due to an error:
   
        my $failed = not eval {
                ...
   
                return 1;
        };
   
  This is because an C<eval> that caught a C<die> will always return a false
  value.
   
  =head1 SHINY SYNTAX
   
  Using Perl 5.10 you can use L<perlsyn/"Switch statements">.
   
  The C<catch> block is invoked in a topicalizer context (like a C<given> block),
  but note that you can't return a useful value from C<catch> using the C<when>
  blocks without an explicit C<return>.
   
  This is somewhat similar to Perl 6's C<CATCH> blocks. You can use it to
  concisely match errors:
   
        try {
                require Foo;
        } catch {
                when (/^Can't locate .*?\.pm in \@INC/) { } # ignore
                default { die $_ }
        };
   
  =head1 CAVEATS
   
  =over 4
   
  =item *
   
  C<@_> is not available within the C<try> block, so you need to copy your
  arglist. In case you want to work with argument values directly via C<@_>
  aliasing (i.e. allow C<$_[1] = "foo">), you need to pass C<@_> by reference:
   
        sub foo {
                my ( $self, @args ) = @_;
                try { $self->bar(@args) }
        }
   
  or
   
        sub bar_in_place {
                my $self = shift;
                my $args = \@_;
                try { $_ = $self->bar($_) for @$args }
        }
   
  =item *
   
  C<return> returns from the C<try> block, not from the parent sub (note that
  this is also how C<eval> works, but not how L<TryCatch> works):
   
        sub bar {
                try { return "foo" };
                return "baz";
        }
   
        say bar(); # "baz"
   
  =item *
   
  C<try> introduces another caller stack frame. L<Sub::Uplevel> is not used. L<Carp>
  will not report this when using full stack traces, though, because
  C<%Carp::Internal> is used. This lack of magic is considered a feature.
   
  =item *
   
  The value of C<$_> in the C<catch> block is not guaranteed to be the value of
  the exception thrown (C<$@>) in the C<try> block.  There is no safe way to
  ensure this, since C<eval> may be used unhygenically in destructors.  The only
  guarantee is that the C<catch> will be called if an exception is thrown.
   
  =item *
   
  The return value of the C<catch> block is not ignored, so if testing the result
  of the expression for truth on success, be sure to return a false value from
  the C<catch> block:
   
        my $obj = try {
                MightFail->new;
        } catch {
                ...
   
                return; # avoid returning a true value;
        };
   
        return unless $obj;
   
  =item *
   
  C<$SIG{__DIE__}> is still in effect.
   
  Though it can be argued that C<$SIG{__DIE__}> should be disabled inside of
  C<eval> blocks, since it isn't people have grown to rely on it. Therefore in
  the interests of compatibility, C<try> does not disable C<$SIG{__DIE__}> for
  the scope of the error throwing code.
   
  =item *
   
  Lexical C<$_> may override the one set by C<catch>.
   
  For example Perl 5.10's C<given> form uses a lexical C<$_>, creating some
  confusing behavior:
   
        given ($foo) {
                when (...) {
                        try {
                                ...
                        } catch {
                                warn $_; # will print $foo, not the error
                                warn $_[0]; # instead, get the error like this
                        }
                }
        }
   
  =back
   
  =head1 SEE ALSO
   
  =over 4
   
  =item L<TryCatch>
   
  Much more feature complete, more convenient semantics, but at the cost of
  implementation complexity.
   
  =item L<autodie>
   
  Automatic error throwing for builtin functions and more. Also designed to
  work well with C<given>/C<when>.
   
  =item L<Throwable>
   
  A lightweight role for rolling your own exception classes.
   
  =item L<Error>
   
  Exception object implementation with a C<try> statement. Does not localize
  C<$@>.
   
  =item L<Exception::Class::TryCatch>
   
  Provides a C<catch> statement, but properly calling C<eval> is your
  responsibility.
   
  The C<try> keyword pushes C<$@> onto an error stack, avoiding some of the
  issues with C<$@>, but you still need to localize to prevent clobbering.
   
  =back
   
  =head1 LIGHTNING TALK
   
  I gave a lightning talk about this module, you can see the slides (Firefox
  only):
   
  L<http://nothingmuch.woobling.org/talks/takahashi.xul?data=yapc_asia_2009/try_tiny.txt>
   
  Or read the source:
   
  L<http://nothingmuch.woobling.org/talks/yapc_asia_2009/try_tiny.yml>
   
  =head1 VERSION CONTROL
   
  L<http://github.com/nothingmuch/try-tiny/>
   
  =head1 AUTHOR
   
  Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
   
  =head1 COPYRIGHT
   
        Copyright (c) 2009 Yuval Kogman. All rights reserved.
        This program is free software; you can redistribute
        it and/or modify it under the terms of the MIT license.
   
  =cut
   
TRY_TINY
$fatpacked{"strictures.pm"} = <<'STRICTURES';
  package strictures;
   
  use strict;
  use warnings FATAL => 'all';
   
  our $VERSION = '1.001001'; # 1.1.1
   
  sub VERSION {
    for ($_[1]) {
      last unless defined && !ref && int != 1;
      die "Major version specified as $_ - this is strictures version 1";
    }
    # disable this since Foo->VERSION(undef) correctly returns the version
    # and that can happen either if our caller passes undef explicitly or
    # because the for above autovivified $_[1] - I could make it stop but
    # it's pointless since we don't want to blow up if the caller does
    # something valid either.
    no warnings 'uninitialized';
    shift->SUPER::VERSION(@_);
  }
   
  sub import {
    strict->import;
    warnings->import(FATAL => 'all');
    my $do_indirect = do {
      if (exists $ENV{PERL_STRICTURES_EXTRA}) {
        $ENV{PERL_STRICTURES_EXTRA}
      } else {
        !!($0 =~ /^x?t\/.*(?:load|compile|coverage|use_ok).*\.t$/
           and (-e '.git' or -e '.svn'))
      }
    };
    if ($do_indirect) {
      if (eval { require indirect; 1 }) {
        indirect->unimport(':fatal');
      } else {
        die "strictures.pm extra testing active but couldn't load indirect.pm
  Extra testing is auto-enabled in checkouts only, so if you're the author
  of a strictures using module you should 'cpan indirect' but the module
  is not required by your users.
  Error loading indirect.pm was: $@";
      }
    }
  }
   
  1;
   
  __END__
  =head1 NAME
   
  strictures - turn on strict and make all warnings fatal
   
  =head1 SYNOPSIS
   
    use strictures 1;
   
  is equivalent to
   
    use strict;
    use warnings FATAL => 'all';
   
  except when called from a file where $0 matches:
   
    /^x?t\/.*(?:load|compile|coverage|use_ok).*\.t$/
   
  and when either '.git' or '.svn' is present in the current directory (with
  the intention of only forcing extra tests on the author side) - or when the
  PERL_STRICTURES_EXTRA environment variable is set, in which case
   
    use strictures 1;
   
  is equivalent to
   
    use strict;
    use warnings FATAL => 'all';
    no indirect 'fatal';
   
  Note that _EXTRA may at some point add even more tests, with only a minor
  version increase, but any changes to the effect of 'use strictures' in
  normal mode will involve a major version bump.
   
  Be aware: THIS MEANS INDIRECT IS REQUIRED FOR AUTHORS OF STRICTURES USING
  CODE - but not by end users thereof.
   
  =head1 DESCRIPTION
   
  I've been writing the equivalent of this module at the top of my code for
  about a year now. I figured it was time to make it shorter.
   
  Things like the importer in 'use Moose' don't help me because they turn
  warnings on but don't make them fatal - which from my point of view is
  useless because I want an exception to tell me my code isn't warnings clean.
   
  Any time I see a warning from my code, that indicates a mistake.
   
  Any time my code encounters a mistake, I want a crash - not spew to STDERR
  and then unknown (and probably undesired) subsequent behaviour.
   
  I also want to ensure that obvious coding mistakes, like indirect object
  syntax (and not so obvious mistakes that cause things to accidentally compile
  as such) get caught, but not at the cost of an XS dependency and not at the
  cost of blowing things up on another machine.
   
  Therefore, strictures turns on indirect checking only when it thinks it's
  running in a compilation (or pod coverage) test - though if this causes
  undesired behaviour this can be overriden by setting the
  PERL_STRICTURES_EXTRA environment variable.
   
  If additional useful author side checks come to mind, I'll add them to the
  _EXTRA code path only - this will result in a minor version increase (i.e.
  1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the mechanism of
  this code will result in a subversion increas (i.e. 1.000000 to 1.000001
  (1.0.1)).
   
  If the behaviour of 'use strictures' in normal mode changes in any way, that
  will constitute a major version increase - and the code already checks
  when its version is tested to ensure that
   
    use strictures 1;
   
  will continue to only introduce the current set of strictures even if 2.0 is
  installed.
   
  =head1 METHODS
   
  =head2 import
   
  This method does the setup work described above in L</DESCRIPTION>
   
  =head2 VERSION
   
  This method traps the strictures->VERSION(1) call produced by a use line
  with a version number on it and does the version check.
   
  =head1 COMMUNITY AND SUPPORT
   
  =head2 IRC channel
   
  irc.perl.org #toolchain
   
  (or bug 'mst' in query on there or freenode)
   
  =head2 Git repository
   
  Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is:
   
    git clone git://git.shadowcat.co.uk/p5sagit/strictures.git
   
  =head1 AUTHOR
   
  Matt S. Trout <mst@shadowcat.co.uk>
   
  =head1 CONTRIBUTORS
   
  None required yet. Maybe this module is perfect (hahahahaha ...).
   
  =head1 COPYRIGHT
   
  Copyright (c) 2010 the strictures L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
   
  =head1 LICENSE
   
  This library is free software and may be distributed under the same terms
  as perl itself.
   
  =cut
STRICTURES
s/^  //mg for values %fatpacked;
unshift @INC, sub {
  if (my $fat = $fatpacked{$_[1]}) {
    open my $fh, '<', \$fat
      or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
    return $fh;
  }
  return
};
} # END OF FATPACK CODE
package App::JSONPretty;
use strictures 1;
use JSON ();
use Try::Tiny;
our $VERSION = 1;
my $usage = "Usage:
  $0 <filename
  $0 filename
";
sub new_json_object {
  JSON->new->utf8->pretty->relaxed->canonical;
}
sub source_filehandle {
  if (@ARGV > 1) {
    die "Too many arguments.\n${usage}";
  } elsif (@ARGV == 1) {
    open my $fh, '<', $ARGV[0]
      or die "Couldn't open $ARGV[0]: $!";
    $fh;
  } else {
    *STDIN;
  }
}
sub source_data {
  my $src = source_filehandle;
  do { local $/; <$src> }
    or die "No source data supplied.\n${usage}";
}
sub decode_using {
  my ($json, $src_data) = @_;
  try {
    $json->decode($src_data)
  } catch {
    die "Error parsing JSON: $_\n";
  }
}
sub encode_using {
  my ($json, $data_structure) = @_;
  try {
    $json->encode($data_structure)
  } catch {
    die "Error generating JSON: $_\n";
  }
}
sub run {
  my $json = new_json_object;
  print STDOUT encode_using $json, decode_using $json, source_data;
  return 0;
}
exit run unless caller;
1;
HideShow 41 lines of Pod
=head1 NAME
jsonpretty - JSON prettification script
=head1 SYNOPSIS
  $ jsonpretty <file.json
  $ jsonpretty file.json
=head1 DESCRIPTION
The jsonpretty script reads the JSON file given on STDIN or as its first
argument, decodes it (allowing errors such as shell style comments and extra
trailing commas on lists), then pretty prints it.
The pretty printed form is indented and has hash keys sorted and as such is
suitable for diffing.
This program always works in utf8. If your JSON is not valid utf8, please ask
the nearest internationalisation expert to kill you with a big hammer.
=head1 AUTHOR
Matt S. Trout <mst@shadowcat.co.uk>
=head1 CONTRIBUTORS
None required yet. Maybe this code is perfect (hahahahaha ...).
=head1 COPYRIGHT
Copyright (c) 2011 the App::JSONPretty L</AUTHOR> and L</CONTRIBUTORS>
as listed above.
=head1 LICENSE
This library is free software and may be distributed under the same terms
as perl itself.
=cut