summaryrefslogtreecommitdiffstats
path: root/qooxdoo/source/perl/JSON/PP.pm
diff options
context:
space:
mode:
Diffstat (limited to 'qooxdoo/source/perl/JSON/PP.pm')
-rwxr-xr-xqooxdoo/source/perl/JSON/PP.pm1355
1 files changed, 0 insertions, 1355 deletions
diff --git a/qooxdoo/source/perl/JSON/PP.pm b/qooxdoo/source/perl/JSON/PP.pm
deleted file mode 100755
index dc2d39a..0000000
--- a/qooxdoo/source/perl/JSON/PP.pm
+++ /dev/null
@@ -1,1355 +0,0 @@
-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 = '0.96';
-
-@JSON::PP::EXPORT = qw(from_json to_json jsonToObj objToJson);
-
-*jsonToObj = *from_json;
-*objToJson = *to_json;
-
-
-
-BEGIN {
- my @properties = qw(
- utf8 allow_nonref indent space_before space_after canonical max_depth shrink
- allow_tied self_encode singlequote allow_bigint disable_UTF8 strict
- allow_barekey escape_slash literal_value
- );
-
- # Perl version check, ascii() is enable?
- # Helper module may set @JSON::PP::_properties.
- if ($] >= 5.008) {
- require Encode;
- push @properties, 'ascii', 'latin1';
-
- *utf8::is_utf8 = *Encode::is_utf8 if ($] == 5.008);
-
- *JSON_encode_ascii = *_encode_ascii;
- *JSON_encode_latin1 = *_encode_latin1;
- *JSON_decode_unicode = *_decode_unicode;
- }
- else {
- my $helper = $] >= 5.006 ? 'JSON::PP56' : 'JSON::PP5005';
- eval qq| require $helper |;
- if ($@) { Carp::croak $@; }
- push @properties, @JSON::PP::_properties;
- }
-
- for my $name (@properties) {
- eval qq|
- sub $name {
- \$_[0]->{$name} = defined \$_[1] ? \$_[1] : 1;
- \$_[0];
- }
- |;
- }
-
-}
-
-
-
-# Functions
-
-my %encode_allow_method
- = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 allow_tied self_encode escape_slash/;
-my %decode_allow_method
- = map {($_ => 1)} qw/utf8 allow_nonref disable_UTF8 strict singlequote allow_bigint
- allow_barekey literal_value/;
-
-
-sub to_json { # encode
- my ($obj, $opt) = @_;
-
- if ($opt) {
- my $json = JSON::PP->new->utf8;
-
- for my $method (keys %$opt) {
- Carp::croak("non acceptble option")
- unless (exists $encode_allow_method{$method});
- $json->$method($opt->{$method});
- }
-
- return $json->encode($obj);
- }
- else {
- return __PACKAGE__->new->utf8->encode($obj);
- }
-
-}
-
-
-sub from_json { # decode
- my ($obj, $opt) = @_;
-
- if ($opt) {
- my $json = JSON::PP->new->utf8;
-
- for my $method (keys %$opt) {
- Carp::croak("non acceptble option")
- unless (exists $decode_allow_method{$method});
- $json->$method($opt->{$method});
- }
-
- return $json->decode($obj);
- }
- else {
- __PACKAGE__->new->utf8->decode(shift);
- }
-}
-
-
-# Methods
-
-sub new {
- my $class = shift;
- my $self = {
- max_depth => 32,
- unmap => 1,
- indent => 0,
- fallback => sub { encode_error('Invalid value. JSON can only reference.') },
- };
-
- bless $self, $class;
-}
-
-
-sub encode {
- return $_[0]->encode_json($_[1]);
-}
-
-
-sub decode {
- return $_[0]->decode_json($_[1], 0x00000000);
-}
-
-
-sub decode_prefix {
- return $_[0]->decode_json($_[1], 0x00000001);
-}
-
-
-# accessor
-
-sub property {
- my ($self, $name, $value) = @_;
-
- if (@_ == 1) {
- Carp::croak('property() requires 1 or 2 arguments.');
- }
- elsif (@_ == 2) {
- $self->{$name};
- }
- else {
- $self->$name($value);
- }
-}
-
-
-# pretty printing
-
-sub pretty {
- my ($self, $v) = @_;
- $self->{pretty} = defined $v ? $v : 1;
-
- if ($v) { # JSON::XS compati
- $self->indent(3);
- $self->space_before(1);
- $self->space_after(1);
- }
- else {
- $self->indent(0);
- $self->space_before(0);
- $self->space_after(0);
- }
-
- $self;
-}
-
-###############################
-
-sub JSON::true () { JSON::Literal::true->new; }
-
-sub JSON::false () { JSON::Literal::false->new; }
-
-sub JSON::null () { JSON::Literal::null->new; }
-
-###############################
-
-###
-### Perl => JSON
-###
-
-{ # Convert
-
- my $depth;
- my $max_depth;
- my $keysort;
- my $indent;
- my $indent_count;
- my $ascii;
- my $utf8;
- my $self_encode;
- my $disable_UTF8;
- my $escape_slash;
-
- my $latin1;
-
-
- sub encode_json {
- my $self = shift;
- my $obj = shift;
-
- $indent_count = 0;
- $depth = 0;
-
- ($indent, $ascii, $utf8, $self_encode, $max_depth, $disable_UTF8, $escape_slash, $latin1)
- = @{$self}{qw/indent ascii utf8 self_encode max_depth disable_UTF8 escape_slash latin1/};
-
- $keysort = !$self->{canonical} ? undef
- : ref($self->{canonical}) eq 'CODE' ? $self->{canonical}
- : $self->{canonical} =~ /\D+/ ? $self->{canonical}
- : sub { $a cmp $b };
-
- my $str = $self->toJson($obj);
-
- if (!defined $str and $self->{allow_nonref}){
- $str = $self->valueToJson($obj);
- }
-
- encode_error("non ref") unless(defined $str);
-
- return $str;
- }
-
-
- sub toJson {
- my ($self, $obj) = @_;
- my $type = ref($obj);
-
- if($type eq 'HASH'){
- return $self->hashToJson($obj);
- }
- elsif($type eq 'ARRAY'){
- return $self->arrayToJson($obj);
- }
- elsif ($type) { # blessed object?
- if (blessed($obj)) {
- if ($self->{self_encode} and $obj->can('toJson')) {
- return $self->selfToJson($obj);
- }
- elsif (!$obj->isa('JSON::Literal')) { # handling in valueToJson
- ($type) = B::svref_2object($obj) =~ /(.+)=/;
- return $type eq 'B::AV' ? $self->arrayToJson($obj)
- : $type eq 'B::HV' ? $self->hashToJson($obj)
- : undef;
- }
- }
- else {
- return $self->valueToJson($obj);
- }
- }
- else{
- return;
- }
- }
-
-
- sub hashToJson {
- my ($self, $obj) = @_;
- my ($k,$v);
- my %res;
-
- encode_error("data structure too deep (hit recursion limit)")
- if (++$depth > $max_depth);
-
- $self->_tie_object($obj, \%res) if ($self->{allow_tied});
-
- my ($pre, $post) = $indent ? $self->_upIndent() : ('', '');
- my $del = ($self->{space_before} ? ' ' : '') . ':' . ($self->{space_after} ? ' ' : '');
-
- for my $k (keys %$obj) {
- my $v = $obj->{$k};
- $res{$k} = $self->toJson($v) || $self->valueToJson($v);
- }
-
- $self->_downIndent() if ($indent);
-
- return '{' . $pre
- . join(",$pre", map { utf8::decode($_) if ($] < 5.008);
- _stringfy($self, $_)
- . $del . $res{$_} } _sort($self, \%res))
- . $post
- . '}';
- }
-
-
- sub arrayToJson {
- my ($self, $obj) = @_;
- my @res;
-
- encode_error("data structure too deep (hit recursion limit)")
- if (++$depth > $max_depth);
-
- $self->_tie_object($obj, \@res) if ($self->{allow_tied});
-
- my ($pre, $post) = $indent ? $self->_upIndent() : ('', '');
-
- for my $v (@$obj){
- push @res, $self->toJson($v) || $self->valueToJson($v);
- }
-
- $self->_downIndent() if ($indent);
-
- return '[' . $pre . join(",$pre" ,@res) . $post . ']';
- }
-
-
- sub valueToJson {
- my ($self, $value) = @_;
-
- return 'null' if(!defined $value);
-
- my $b_obj = B::svref_2object(\$value); # for round trip problem
- # SvTYPE is IV or NV?
- return $value # as is
- if ($b_obj->FLAGS & B::SVf_IOK or $b_obj->FLAGS & B::SVf_NOK);
-
- my $type = ref($value);
-
- if(!$type){
- return _stringfy($self, $value);
- }
- elsif( blessed($value) and $value->isa('JSON::Literal') ){
- return $value->{str};
- }
- elsif ($type) {
- if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
- return $self->valueToJson("$value");
- }
-
- if ($type eq 'SCALAR' and defined $$value) {
- return $$value eq '1' ? 'true'
- : $$value eq '0' ? 'false' : encode_error("cannot encode reference.");
- }
-
- if ($type eq 'CODE') {
- encode_error("JSON can only reference.");
- }
- else {
- encode_error("cannot encode reference.");
- }
-
- }
- 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 _stringfy {
- my ($self, $arg) = @_;
-
- $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/eg;
- $arg =~ s/\//\\\//g if ($escape_slash);
- $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
-
- if ($ascii) {
- $arg = JSON_encode_ascii($arg);
- }
-
- if ($latin1) {
- $arg = JSON_encode_latin1($arg);
- }
-
- if ($utf8 or $disable_UTF8) {
- utf8::encode($arg);
- }
-
- return '"' . $arg . '"';
- }
-
-
- sub selfToJson {
- my ($self, $obj) = @_;
- return $obj->toJson($self);
- }
-
-
- sub encode_error {
- my $error = shift;
- Carp::croak "$error";
- }
-
-
- sub _sort {
- my ($self, $res) = @_;
- defined $keysort ? (sort $keysort (keys %$res)) : keys %$res;
- }
-
-
- sub _tie_object {
- my ($self, $obj, $res) = @_;
- my $class;
- # by ddascalescu+perl [at] gmail.com
- if (ref($obj) eq 'ARRAY' and $class = tied @$obj) {
- $class =~ s/=.*//;
- tie @$res, $class;
- }
- elsif (ref($obj) eq 'HASH' and $class = tied %$obj) {
- $class =~ s/=.*//;
- tie %$res, $class;
- }
- }
-
-
- sub _upIndent {
- my $self = shift;
- my $space = ' ' x $indent;
-
- my ($pre,$post) = ('','');
-
- $post = "\n" . $space x $indent_count;
-
- $indent_count++;
-
- $pre = "\n" . $space x $indent_count;
-
- return ($pre,$post);
- }
-
-
- sub _downIndent { $_[0]->{indent_count}--; }
-
-} # Convert
-
-
-
-sub _encode_ascii {
- join('',
- map {
- $_ <= 127 ?
- chr($_) :
- $_ <= 65535 ?
- sprintf('\u%04x', $_) :
- join("", map { '\u' . $_ }
- unpack("H4H4", Encode::encode('UTF-16BE', pack("U", $_))));
- } unpack('U*', $_[0])
- );
-}
-
-
-sub _encode_latin1 {
- join('',
- map {
- $_ <= 255 ?
- chr($_) :
- $_ <= 65535 ?
- sprintf('\u%04x', $_) :
- join("", map { '\u' . $_ }
- unpack("H4H4", Encode::encode('UTF-16BE', pack("U", $_))));
- } unpack('U*', $_[0])
- );
-}
-
-
-
-#
-# JSON => Perl
-#
-
-# from Adam Sussman
-use Config;
-my $max_intsize = length(((1 << (8 * $Config{intsize} - 2))-1)*2 + 1) - 1;
-#my $max_intsize = length(2 ** ($Config{intsize} * 8)) - 1;
-
-
-{ # 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)
-
- my $is_utf8;
- my $depth;
- my $encoding;
-
- my $literal_value; # unmmaping
- my $utf8; #
- my $max_depth; # max nest nubmer of objects and arrays
- my $allow_bigint; # using Math::BigInt
- my $disable_UTF8; # don't flag UTF8 on
- my $singlequote; # loosely quoting
- my $strict; #
- my $allow_barekey; # bareKey
-
- # $opt flag
- # 0x00000001 .... decode_prefix
-
- sub 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 text data.");
- }
-
- $is_utf8 = 1 if (utf8::is_utf8($text));
-
- $len = length $text;
-
- ($utf8, $literal_value, $max_depth, $allow_bigint, $disable_UTF8, $strict, $singlequote, $allow_barekey)
- = @{$self}{qw/utf8 literal_value max_depth allow_bigint disable_UTF8 strict singlequote allow_barekey/};
-
- unless ($self->{allow_nonref}) {
- white();
- unless (defined $ch and ($ch eq '{' or $ch eq '[')) {
- 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);
- }
- }
-
- # Currently no effective
- 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';
-
- my $result = value();
-
- if ($len > $at) {
- my $consumed = $at - 1;
- white();
- if ($ch) {
- decode_error("garbage after JSON object") unless ($opt & 0x00000001);
- return ($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 eq '-');
- return $ch =~ /\d/ ? number() : word();
- }
-
-
- sub string {
- my ($i,$s,$t,$u);
- my @utf16;
-
- $s = ''; # basically UTF8 flag on
-
- if($ch eq '"' or ($singlequote and $ch eq "'")){
- my $boundChar = $ch if ($singlequote);
-
- OUTER: while( defined(next_chr()) ){
-
- if((!$singlequote and $ch eq '"') or ($singlequote and $ch eq $boundChar)){
- next_chr();
-
- if (@utf16) {
- decode_error("missing low surrogate character in surrogate pair");
- }
-
- if($disable_UTF8) {
- utf8::encode($s) if (utf8::is_utf8($s));
- }
- else {
- utf8::decode($s);
- }
-
- 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;
- }
-
- $s .= JSON_decode_unicode($u, \@utf16) || next;
-
- }
- else{
- $s .= $ch;
- }
- }
- else{
- if ($utf8 and $is_utf8) {
- if( hex(unpack('H*', $ch)) > 255 ) {
- decode_error("malformed UTF-8 character in JSON string");
- }
- }
- elsif ($strict) {
- if ($ch =~ /[\x00-\x1f\x22\x2f\x5c]/) {
- decode_error('invalid character');
- }
- }
-
- $s .= $ch;
- }
- }
- }
-
- decode_error("Bad string (unexpected end)");
- }
-
-
- sub white {
- while( defined $ch ){
- if($ch le ' '){
- next_chr();
- }
- elsif($ch eq '/'){
- next_chr();
- if($ch eq '/'){
- 1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
- }
- elsif($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{
- decode_error("Syntax decode_error (whitespace)");
- }
- }
- else{
- last;
- }
- }
- }
-
-
- sub object {
- my $o = {};
- my $k;
-
- if($ch eq '{'){
- decode_error('json structure too deep (hit recursion limit)', )
- if (++$depth > $max_depth);
- next_chr();
- white();
- if(defined $ch and $ch eq '}'){
- next_chr();
- return $o;
- }
- while(defined $ch){
- $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
- white();
-
- if(!defined $ch or $ch ne ':'){
- decode_error("Bad object ; ':' expected");
- }
-
- next_chr();
- $o->{$k} = value();
- white();
-
- last if (!defined $ch);
-
- if($ch eq '}'){
- next_chr();
- return $o;
- }
- elsif($ch ne ','){
- last;
- }
- next_chr();
- white();
- }
-
- decode_error("Bad object ; ,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 $literal_value ? JSON::true : 1;
- }
- elsif($word eq 'null'){
- $at += 3;
- next_chr;
- return $literal_value ? JSON::null : undef;
- }
- elsif($word eq 'fals'){
- $at += 3;
- if(substr($text,$at,1) eq 'e'){
- $at++;
- next_chr;
- return $literal_value ? JSON::false : 0;
- }
- }
-
- $at--; # for decode_error report
-
- decode_error("Syntax decode_error (word) 'null' expected") if ($word =~ /^n/);
- decode_error("Syntax decode_error (word) 'true' expected") if ($word =~ /^t/);
- decode_error("Syntax decode_error (word) 'false' expected") if ($word =~ /^f/);
- decode_error("Syntax decode_error (word)" .
- " 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){
- ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
- }
- else{ # oct
- ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
- }
-
- 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 '-' or $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 ($allow_bigint) { # from Adam Sussman
- require Math::BigInt;
- return Math::BigInt->new($v) if ($v !~ /[.eE]/ and length $v > $max_intsize);
- }
-
- return 0+$v;
- }
-
-
- sub array {
- my $a = [];
-
- if ($ch eq '[') {
- decode_error('json structure too deep (hit recursion limit)', 1)
- if (++$depth > $max_depth);
- next_chr();
- white();
- if(defined $ch and $ch eq ']'){
- next_chr();
- return $a;
- }
-
- while(defined($ch)){
- push @$a, value();
- white();
-
- if (!defined $ch) {
- last;
- }
-
- if($ch eq ']'){
- next_chr();
- return $a;
- }
- elsif($ch ne ','){
- last;
- }
- next_chr();
- white();
- }
- }
-
- decode_error(", or ] expected while parsing array");
- }
-
-
- sub decode_error {
- my $error = shift;
- my $no_rep = shift;
- my $str = defined $text ? substr($text, $at) : '';
-
- unless (length $str) { $str = '(end of string)'; }
-
- if ($no_rep) {
- Carp::croak "$error";
- }
- else {
- Carp::croak "$error, at character offset $at ($str)";
- }
- }
-
-} # PARSE
-
-
-sub _decode_unicode {
- my $u = $_[0];
- my $utf16 = $_[1];
-
- # U+10000 - U+10FFFF
-
- # U+D800 - U+DBFF
- if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
- push @$utf16, $u;
- }
- # U+DC00 - U+DFFF
- elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
- unless (scalar(@$utf16)) {
- decode_error("missing high surrogate character in surrogate pair");
- }
- my $str = pack('H4H4', @$utf16, $u);
- @$utf16 = ();
- return Encode::decode('UTF-16BE', $str); # UTF-8 flag on
- }
- else {
- if (scalar(@$utf16)) {
- decode_error("surrogate pair expected");
- }
-
- return chr(hex($u));
- }
-
- return;
-}
-
-
-###############################
-# Utilities
-#
-
-BEGIN {
- eval 'require Scalar::Util';
- unless($@){
- *JSON::PP::blessed = \&Scalar::Util::blessed;
- }
- 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;
- };
- }
-}
-
-
-###############################
-
-package JSON::Literal;
-use overload (
- '""' => sub { $_[0]->{str} },
- 'bool' => sub { $_[0]->{value} },
- 'eq' => sub { $_[0]->{str} eq $_[1] },
- 'ne' => sub { $_[0]->{str} ne $_[1] },
-);
-
-
-package JSON::Literal::true;
-use base qw(JSON::Literal);
-
-use overload (
- '==' => sub { 1 == $_[1] },
- '!=' => sub { 1 != $_[1] },
-);
-
-sub new { bless { str => 'true', value => 1 }; }
-
-
-package JSON::Literal::false;
-use base qw(JSON::Literal);
-
-use overload (
- '==' => sub { 0 == $_[1] },
- '!=' => sub { 0 != $_[1] },
-);
-
-sub new { bless { str => 'false', value => 0 }; }
-
-package JSON::Literal::null;
-use base qw(JSON::Literal);
-
-use overload (
- '==' => sub { -1 == $_[1] },
- '!=' => sub { -1 != $_[1] },
-);
-
-sub new { bless { str => 'null', value => undef }; }
-
-###############################
-
-
-1;
-__END__
-=pod
-
-=head1 NAME
-
-JSON::PP - An experimental JSON::XS compatible Pure Perl module.
-
-=head1 SYNOPSIS
-
- use JSON::PP;
-
- $obj = from_json($json_text);
- $json_text = to_json($obj);
-
- # or
-
- $obj = jsonToObj($json_text);
- $json_text = objToJson($obj);
-
- $json = new JSON;
- $json_text = $json->ascii->pretty($obj);
-
- # you can set options to functions.
-
- $json_text = to_json($obj, {ascii => 1, intend => 2});
- $obj = from_json($json_text, {utf8 => 0});
-
-
-=head1 DESCRIPTION
-
-This module is L<JSON::XS> compatible Pure Perl module.
-( Perl better than 5.008 is recommended)
-
-Module variables ($JSON::*) were abolished.
-
-JSON::PP will be renamed JSON (JSON-2.0).
-
-Many things including error handling are learned from L<JSON::XS>.
-For t/02_error.t compatible, error messages was copied partially from JSON::XS.
-
-
-=head2 FEATURES
-
-=over
-
-=item * perhaps correct unicode handling
-
-This module knows how to handle Unicode (perhaps),
-but not yet documents how and when it does so.
-
-In Perl5.6x, Unicode handling requires L<Unicode::String> module.
-
-Perl 5.005_xx, Unicode handling is disable currenlty.
-
-
-=item * round-trip integrity
-
-This module solved the problem pointed out by JSON::XS
-using L<B> module.
-
-=item * strict checking of JSON correctness
-
-I want to bring close to XS.
-How do you want to carry out?
-
-you can set C<strict> decoding method.
-
-=item * slow
-
-Compared to other JSON modules, this module does not compare
-favourably in terms of speed. Very slowly!
-
-=item * simple to use
-
-This module became very simple.
-Since its interface were anyway made the same as JSON::XS.
-
-
-=item * reasonably versatile output formats
-
-See to L<JSON::XS>.
-
-=back
-
-=head1 FUNCTIONS
-
-=over
-
-=item to_json
-
-See to JSON::XS.
-C<objToJson> is an alias.
-
-=item from_json
-
-See to JSON::XS.
-C<jsonToObj> is an alias.
-
-
-=item JSON::true
-
-Returns JSON true value which is blessed object.
-It C<isa> JSON::Literal object.
-
-=item JSON::false
-
-Returns JSON false value which is blessed object.
-It C<isa> JSON::Literal object.
-
-
-=item JSON::null
-
-Returns JSON null value which is blessed object.
-It C<isa> JSON::Literal object.
-
-
-=back
-
-
-=head1 METHODS
-
-=over
-
-=item new
-
-Returns JSON::PP object.
-
-=item ascii
-
-See to JSON::XS.
-
-In Perl 5.6, this method requires L<Unicode::String>.
-If you don't have Unicode::String,
-the method is always set to false and warns.
-
-In Perl 5.005, this option is currently disable.
-
-
-=item latin1
-
-See to JSON::XS.
-
-In Perl 5.6, this method requires L<Unicode::String>.
-If you don't have Unicode::String,
-the method is always set to false and warns.
-
-In Perl 5.005, this option is currently disable.
-
-
-=item utf8
-
-See to JSON::XS.
-
-Currently this module always handles UTF-16 as UTF-16BE.
-
-=item pretty
-
-See to JSON::XS.
-
-=item indent
-
-See to JSON::XS.
-Strictly, this module does not carry out equivalent to XS.
-
- $json->indent(4);
-
-is not the same as this:
-
- $json->indent();
-
-
-=item space_before
-
-See to JSON::XS.
-
-=item space_after
-
-See JSON::XS.
-
-=item canonical
-
-See to JSON::XS.
-Strictly, this module does not carry out equivalent to XS.
-This method can take a subref for sorting (see to L<JSON>).
-
-
-=item allow_nonref
-
-See to JSON::XS.
-
-=item shrink
-
-Not yet implemented.
-
-=item max_depth
-
-See to JSON::XS.
-Strictly, this module does not carry out equivalent to XS.
-By default, not 512 (JSON::XS) but 32.
-
-=item encode
-
-See to JSON::XS.
-
-=item decode
-
-See to JSON::XS.
-In Perl 5.6, if you don't have Unicode::String,
-the method can't handle UTF-16(BE) char and returns as is.
-
-
-=item property
-
-Accessor.
-
- $json->property(utf8 => 1); # $json->utf8(1);
-
- $value = $json->property('utf8'); # returns 1.
-
-
-=item self_encode
-
-See L<JSON/BLESSED OBJECT>'s I<self convert> function.
-
-
-=item disable_UTF8
-
-If this option is set, UTF8 flag in strings generated
-by C<encode>/C<decode> is off.
-
-
-=item allow_tied
-
-Enable.
-
-This option will be obsoleted.
-
-
-=item singlequote
-
-Allows to decode single quoted strings.
-
-Unlike L<JSON> module, this module does not encode
-Perl string into single quoted string any longer.
-
-
-=item allow_barekey
-
-Allows to decode bare key of member.
-
-
-=item allow_bigint
-
-When json text has any integer in decoding more than Perl can't handle,
-If this option is on, they are converted into L<Math::BigInt> objects.
-
-
-=item strict
-
-For JSON format, unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid and
-JSON::XS decodes just like that. While this module can deocde thoese.
-But if this option is set, the module strictly decodes.
-
-
-=item escape_slash
-
-By default, JSON::PP encodes strings without escaping slash (U+002F).
-Setting the option to escape slash.
-
-
-=item literal_value
-
-
-
-=back
-
-
-=head1 MAPPING
-
-
-
-=head1 COMPARISON
-
-Using a benchmark program in the JSON::XS (v1.11) distribution.
-
- module | encode | decode |
- -----------|------------|------------|
- JSON::PP | 11092.260 | 4482.033 |
- -----------+------------+------------+
- JSON::XS | 341513.380 | 226138.509 |
- -----------+------------+------------+
-
-In case t/12_binary.t (JSON::XS distribution).
-(shrink of JSON::PP has no effect.)
-
-JSON::PP takes 147 (sec).
-
-JSON::XS takes 4.
-
-
-=head1 TODO
-
-=over
-
-=item Document!
-
-It is troublesome.
-
-=item clean up
-
-Under the cleaning.
-
-=back
-
-
-=head1 SEE ALSO
-
-L<JSON>, L<JSON::XS>
-
-RFC4627
-
-=head1 AUTHOR
-
-Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
-
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2007 by Makamaka Hannyaharamitu
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-07-29 06:02:07 +0200