summaryrefslogtreecommitdiffstats
path: root/qooxdoo/source/perl/JSON.pm
diff options
context:
space:
mode:
Diffstat (limited to 'qooxdoo/source/perl/JSON.pm')
-rwxr-xr-xqooxdoo/source/perl/JSON.pm725
1 files changed, 725 insertions, 0 deletions
diff --git a/qooxdoo/source/perl/JSON.pm b/qooxdoo/source/perl/JSON.pm
new file mode 100755
index 0000000..59686e0
--- /dev/null
+++ b/qooxdoo/source/perl/JSON.pm
@@ -0,0 +1,725 @@
+package JSON;
+
+use strict;
+use base qw(Exporter);
+
+@JSON::EXPORT = qw(objToJson jsonToObj);
+
+use vars qw($AUTOCONVERT $VERSION $UnMapping $BareKey $QuotApos
+ $ExecCoderef $SkipInvalid $Pretty $Indent $Delimiter
+ $KeySort $ConvBlessed $SelfConvert $UTF8 $SingleQuote);
+
+$VERSION = '1.14';
+
+$AUTOCONVERT = 1;
+$SkipInvalid = 0;
+$ExecCoderef = 0;
+$Pretty = 0; # pretty-print mode switch
+$Indent = 2; # (for pretty-print)
+$Delimiter = 2; # (for pretty-print) 0 => ':', 1 => ': ', 2 => ' : '
+$UnMapping = 0; #
+$BareKey = 0; #
+$QuotApos = 0; #
+$KeySort = undef; # Code-ref to provide sort ordering in converter
+$UTF8 = 0;
+$SingleQuote = 0;
+
+my $USE_UTF8;
+
+BEGIN {
+ $USE_UTF8 = $] >= 5.008 ? 1 : 0;
+ sub USE_UTF8 { $USE_UTF8; }
+}
+
+use JSON::Parser;
+use JSON::Converter;
+
+my $parser; # JSON => Perl
+my $conv; # Perl => JSON
+
+
+##############################################################################
+# CONSTRCUTOR - JSON objects delegate all processes
+# to JSON::Converter and JSON::Parser.
+##############################################################################
+
+sub new {
+ my $class = shift;
+ my %opt = @_;
+ bless {
+ conv => undef, # JSON::Converter [perl => json]
+ parser => undef, # JSON::Parser [json => perl]
+ # below fields are for JSON::Converter
+ autoconv => $AUTOCONVERT,
+ skipinvalid => $SkipInvalid,
+ execcoderef => $ExecCoderef,
+ pretty => $Pretty ,
+ indent => $Indent ,
+ delimiter => $Delimiter ,
+ keysort => $KeySort ,
+ convblessed => $ConvBlessed,
+ selfconvert => $SelfConvert,
+ singlequote => $SingleQuote,
+ # below fields are for JSON::Parser
+ unmapping => $UnMapping,
+ quotapos => $QuotApos ,
+ barekey => $BareKey ,
+ # common options
+ utf8 => $UTF8 ,
+ # overwrite
+ %opt,
+ }, $class;
+}
+
+
+##############################################################################
+# METHODS
+##############################################################################
+
+*parse_json = \&jsonToObj;
+
+*to_json = \&objToJson;
+
+sub jsonToObj {
+ my $self = shift;
+ my $js = shift;
+
+ if(!ref($self)){ # class method
+ my $opt = __PACKAGE__->_getParamsForParser($js);
+ $js = $self;
+ $parser ||= new JSON::Parser;
+ $parser->jsonToObj($js, $opt);
+ }
+ else{ # instance method
+ my $opt = $self->_getParamsForParser($_[0]);
+ $self->{parser} ||= ($parser ||= JSON::Parser->new);
+ $self->{parser}->jsonToObj($js, $opt);
+ }
+}
+
+
+sub objToJson {
+ my $self = shift || return;
+ my $obj = shift;
+
+ if(ref($self) !~ /JSON/){ # class method
+ my $opt = __PACKAGE__->_getParamsForConverter($obj);
+ $obj = $self;
+ $conv ||= JSON::Converter->new();
+ $conv->objToJson($obj, $opt);
+ }
+ else{ # instance method
+ my $opt = $self->_getParamsForConverter($_[0]);
+ $self->{conv}
+ ||= JSON::Converter->new( %$opt );
+ $self->{conv}->objToJson($obj, $opt);
+ }
+}
+
+
+#######################
+
+
+sub _getParamsForParser {
+ my ($self, $opt) = @_;
+ my $params;
+
+ if(ref($self)){ # instance
+ my @names = qw(unmapping quotapos barekey utf8);
+ my ($unmapping, $quotapos, $barekey, $utf8) = @{$self}{ @names };
+ $params = {
+ unmapping => $unmapping, quotapos => $quotapos,
+ barekey => $barekey, utf8 => $utf8,
+ };
+ }
+ else{ # class
+ $params = {
+ unmapping => $UnMapping, barekey => $BareKey,
+ quotapos => $QuotApos, utf8 => $UTF8,
+ };
+ }
+
+ if($opt and ref($opt) eq 'HASH'){
+ for my $key ( keys %$opt ){
+ $params->{$key} = $opt->{$key};
+ }
+ }
+
+ return $params;
+}
+
+
+sub _getParamsForConverter {
+ my ($self, $opt) = @_;
+ my $params;
+
+ if(ref($self)){ # instance
+ my @names
+ = qw(pretty indent delimiter autoconv keysort convblessed selfconvert utf8 singlequote);
+ my ($pretty, $indent, $delimiter, $autoconv,
+ $keysort, $convblessed, $selfconvert, $utf8, $singlequote)
+ = @{$self}{ @names };
+ $params = {
+ pretty => $pretty, indent => $indent,
+ delimiter => $delimiter, autoconv => $autoconv,
+ keysort => $keysort, convblessed => $convblessed,
+ selfconvert => $selfconvert, utf8 => $utf8,
+ singlequote => $singlequote,
+ };
+ }
+ else{ # class
+ $params = {
+ pretty => $Pretty, indent => $Indent,
+ delimiter => $Delimiter, autoconv => $AUTOCONVERT,
+ keysort => $KeySort, convblessed => $ConvBlessed,
+ selfconvert => $SelfConvert, utf8 => $UTF8,
+ singlequote => $SingleQuote,
+ };
+ }
+
+ if($opt and ref($opt) eq 'HASH'){
+ for my $key ( keys %$opt ){
+ $params->{$key} = $opt->{$key};
+ }
+ }
+
+ return $params;
+}
+
+##############################################################################
+# ACCESSOR
+##############################################################################
+BEGIN{
+ for my $name (qw/autoconv pretty indent delimiter
+ unmapping keysort convblessed selfconvert singlequote/)
+ {
+ eval qq{
+ sub $name { \$_[0]->{$name} = \$_[1] if(defined \$_[1]); \$_[0]->{$name} }
+ };
+ }
+}
+
+##############################################################################
+# NON STRING DATA
+##############################################################################
+
+# See JSON::Parser for JSON::NotString.
+
+sub Number {
+ my $num = shift;
+
+ return undef if(!defined $num);
+
+ if( $num =~ /^-?(?:\d+)(?:\.\d*)?(?:[eE][-+]?\d+)?$/
+ or $num =~ /^0[xX](?:[0-9a-zA-Z])+$/ )
+ {
+ return bless {value => $num}, 'JSON::NotString';
+ }
+ else{
+ return undef;
+ }
+}
+
+sub True {
+ bless {value => 'true'}, 'JSON::NotString';
+}
+
+sub False {
+ bless {value => 'false'}, 'JSON::NotString';
+}
+
+sub Null {
+ bless {value => undef}, 'JSON::NotString';
+}
+
+##############################################################################
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+JSON - parse and convert to JSON (JavaScript Object Notation).
+
+=head1 SYNOPSIS
+
+ use JSON;
+
+ $obj = {
+ id => ["foo", "bar", { aa => 'bb'}],
+ hoge => 'boge'
+ };
+
+ $js = objToJson($obj);
+ # this is {"id":["foo","bar",{"aa":"bb"}],"hoge":"boge"}.
+ $obj = jsonToObj($js);
+ # the data structure was restored.
+
+ # OOP
+
+ my $json = new JSON;
+
+ $obj = {id => 'foo', method => 'echo', params => ['a','b']};
+ $js = $json->objToJson($obj);
+ $obj = $json->jsonToObj($js);
+
+ # pretty-printing
+ $js = $json->objToJson($obj, {pretty => 1, indent => 2});
+
+ $json = JSON->new(pretty => 1, delimiter => 0);
+ $json->objToJson($obj);
+
+
+=head1 TRANSITION PLAN
+
+In the next large update version, JSON and JSONRPC modules are split.
+
+ JSON::Parser and JSON::Converter are deleted from JSON dist.
+ JSON and JSON::PP in JSON dist.
+
+ JSON becomes wrapper to JSON::XS and/or JSON::PP.
+
+ JSONRPC* and Apache::JSONRPC are deleted from JSON dist.
+ JSONRPC::Client, JSONRPC::Server and JSONRPC::Procedure in JSON::RPC dist.
+
+ Modules in JSON::RPC dist supports JSONRPC protocol v1.1 and 1.0.
+
+
+=head1 DESCRIPTION
+
+This module converts between JSON (JavaScript Object Notation) and Perl
+data structure into each other.
+For JSON, See to http://www.crockford.com/JSON/.
+
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+=item new( %options )
+
+returns a JSON object. The object delegates the converting and parsing process
+to L<JSON::Converter> and L<JSON::Parser>.
+
+ my $json = new JSON;
+
+C<new> can take some options.
+
+ my $json = new JSON (autoconv => 0, pretty => 1);
+
+Following options are supported:
+
+=over 4
+
+=item autoconv
+
+See L</AUTOCONVERT> for more info.
+
+=item skipinvalid
+
+C<objToJson()> does C<die()> when it encounters any invalid data
+(for instance, coderefs). If C<skipinvalid> is set with true,
+the function convets these invalid data into JSON format's C<null>.
+
+=item execcoderef
+
+C<objToJson()> does C<die()> when it encounters any code reference.
+However, if C<execcoderef> is set with true, executes the coderef
+and uses returned value.
+
+=item pretty
+
+See L</PRETTY PRINTING> for more info.
+
+=item indent
+
+See L</PRETTY PRINTING> for more info.
+
+=item delimiter
+
+See L</PRETTY PRINTING> for more info.
+
+=item keysort
+
+See L</HASH KEY SORT ORDER> for more info.
+
+=item convblessed
+
+See L</BLESSED OBJECT> for more info.
+
+=item selfconvert
+
+See L</BLESSED OBJECT> for more info.
+
+=item singlequote
+
+See L</CONVERT WITH SINGLE QUOTES> for more info.
+
+=back
+
+
+=item objToJson( $object )
+
+=item objToJson( $object, $hashref )
+
+takes perl data structure (basically, they are scalars, arrayrefs and hashrefs)
+and returns JSON formated string.
+
+ my $obj = [1, 2, {foo => bar}];
+ my $js = $json->objToJson($obj);
+ # [1,2,{"foo":"bar"}]
+
+By default, returned string is one-line. However, you can get pretty-printed
+data with C<pretty> option. Please see below L</PRETTY PRINTING>.
+
+ my $js = $json->objToJson($obj, {pretty => 1, indent => 2});
+ # [
+ # 1,
+ # 2,
+ # {
+ # "foo" : "bar"
+ # }
+ # ]
+
+=item jsonToObj( $js )
+
+takes a JSON formated data and returns a perl data structure.
+
+
+=item autoconv()
+
+=item autoconv($bool)
+
+This is an accessor to C<autoconv>. See L</AUTOCONVERT> for more info.
+
+=item pretty()
+
+=item pretty($bool)
+
+This is an accessor to C<pretty>. It takes true or false.
+When prrety is true, C<objToJson()> returns prrety-printed string.
+See L</PRETTY PRINTING> for more info.
+
+=item indent()
+
+=item indent($integer)
+
+This is an accessor to C<indent>.
+See L</PRETTY PRINTING> for more info.
+
+=item delimiter()
+
+This is an accessor to C<delimiter>.
+See L</PRETTY PRINTING> for more info.
+
+=item unmapping()
+
+=item unmapping($bool)
+
+This is an accessor to C<unmapping>.
+See L</UNMAPPING OPTION> for more info.
+
+=item keysort()
+
+=item keysort($coderef)
+
+This is an accessor to C<keysort>.
+See L</HASH KEY SORT ORDER> for more info.
+
+=item convblessed()
+
+=item convblessed($bool)
+
+This is an accessor to C<convblessed>.
+See L</BLESSED OBJECT> for more info.
+
+=item selfconvert()
+
+=item selfconvert($bool)
+
+This is an accessor to C<selfconvert>.
+See L</BLESSED OBJECT> for more info.
+
+=item singlequote()
+
+=item singlequote($bool)
+
+This is an accessor to C<singlequote>.
+See L</CONVERT WITH SINGLE QUOTES> for more info.
+
+
+=back
+
+=head1 MAPPING
+
+ (JSON) {"param" : []}
+ ( => Perl) {'param' => []};
+
+ (JSON) {"param" : {}}
+ ( => Perl) {'param' => {}};
+
+ (JSON) {"param" : "string"}
+ ( => Perl) {'param' => 'string'};
+
+ JSON {"param" : null}
+ => Perl {'param' => bless( {'value' => undef}, 'JSON::NotString' )};
+ or {'param' => undef}
+
+ (JSON) {"param" : true}
+ ( => Perl) {'param' => bless( {'value' => 'true'}, 'JSON::NotString' )};
+ or {'param' => 1}
+
+ (JSON) {"param" : false}
+ ( => Perl) {'param' => bless( {'value' => 'false'}, 'JSON::NotString' )};
+ or {'param' => 2}
+
+ (JSON) {"param" : 0xff}
+ ( => Perl) {'param' => 255};
+
+ (JSON) {"param" : 010}
+ ( => Perl) {'param' => 8};
+
+These JSON::NotString objects are overloaded so you don't care about.
+Since 1.00, L</UnMapping option> is added. When that option is set,
+{"param" : null} will be converted into {'param' => undef}, insted of
+{'param' => bless( {'value' => undef}, 'JSON::NotString' )}.
+
+
+Perl's C<undef> is converted to 'null'.
+
+
+=head1 PRETTY PRINTING
+
+If you'd like your JSON output to be pretty-printed, pass the C<pretty>
+parameter to objToJson(). You can affect the indentation (which defaults to 2)
+by passing the C<indent> parameter to objToJson().
+
+ my $str = $json->objToJson($obj, {pretty => 1, indent => 4});
+
+In addition, you can set some number to C<delimiter> option.
+The available numbers are only 0, 1 and 2.
+In pretty-printing mode, when C<delimiter> is 1, one space is added
+after ':' in object keys. If C<delimiter> is 2, it is ' : ' and
+0 is ':' (default is 2). If you give 3 or more to it, the value
+is taken as 2.
+
+
+=head1 AUTOCONVERT
+
+By default, $JSON::AUTOCONVERT is true.
+
+ (Perl) {num => 10.02}
+ ( => JSON) {"num" : 10.02}
+
+it is not C<{"num" : "10.02"}>.
+
+But set false value with $JSON::AUTOCONVERT:
+
+ (Perl) {num => 10.02}
+ ( => JSON) {"num" : "10.02"}
+
+it is not C<{"num" : 10.02}>.
+
+You can explicitly sepcify:
+
+ $obj = {
+ id => JSON::Number(10.02),
+ bool1 => JSON::True,
+ bool2 => JSON::False,
+ noval => JSON::Null,
+ };
+
+ $json->objToJson($obj);
+ # {"noval" : null, "bool2" : false, "bool1" : true, "id" : 10.02}
+
+C<JSON::Number()> returns C<undef> when an argument invalid format.
+
+=head1 UNMAPPING OPTION
+
+By default, $JSON::UnMapping is false and JSON::Parser converts
+C<null>, C<true>, C<false> into C<JSON::NotString> objects.
+You can set true into $JSON::UnMapping to stop the mapping function.
+In that case, JSON::Parser will convert C<null>, C<true>, C<false>
+into C<undef>, 1, 0.
+
+=head1 BARE KEY OPTION
+
+You can set a true value into $JSON::BareKey for JSON::Parser to parse
+bare keys of objects.
+
+ local $JSON::BareKey = 1;
+ $obj = jsonToObj('{foo:"bar"}');
+
+=head1 SINGLE QUOTATION OPTION
+
+You can set a true value into $JSON::QuotApos for JSON::Parser to parse
+any keys and values quoted by single quotations.
+
+ local $JSON::QuotApos = 1;
+ $obj = jsonToObj(q|{"foo":'bar'}|);
+ $obj = jsonToObj(q|{'foo':'bar'}|);
+
+With $JSON::BareKey:
+
+ local $JSON::BareKey = 1;
+ local $JSON::QuotApos = 1;
+ $obj = jsonToObj(q|{foo:'bar'}|);
+
+=head1 HASH KEY SORT ORDER
+
+By default objToJSON will serialize hashes with their keys in random
+order. To control the ordering of hash keys, you can provide a standard
+'sort' function that will be used to control how hashes are converted.
+
+You can provide either a fully qualified function name or a CODEREF to
+$JSON::KeySort or $obj->keysort.
+
+If you give any integers (excluded 0), the sort function will work as:
+
+ sub { $a cmp $b }
+
+Note that since the sort function is external to the JSON module the
+magical $a and $b arguments will not be in the same package. In order
+to gain access to the sorting arguments, you must either:
+
+ o use the ($$) prototype (slow)
+ o Fully qualify $a and $b from the JSON::Converter namespace
+
+See the documentation on sort for more information.
+
+ local $JSON::KeySort = 'My::Package::sort_function';
+
+ or
+
+ local $JSON::KeySort = \&_some_function;
+
+ sub sort_function {
+ $JSON::Converter::a cmp $JSON::Converter::b;
+ }
+
+ or
+
+ sub sort_function ($$) {
+ my ($a, $b) = @_;
+
+ $a cmp $b
+ }
+
+=head1 BLESSED OBJECT
+
+By default, JSON::Converter doesn't deal with any blessed object
+(returns C<undef> or C<null> in the JSON format).
+If you use $JSON::ConvBlessed or C<convblessed> option,
+the module can convert most blessed object (hashref or arrayref).
+
+ local $JSON::ConvBlessed = 1;
+ print objToJson($blessed);
+
+This option slows down the converting speed.
+
+If you use $JSON::SelfConvert or C<selfconvert> option,
+the module will test for a C<toJson()> method on the object,
+and will rely on this method to obtain the converted value of
+the object.
+
+=head1 UTF8
+
+You can set a true value into $JSON::UTF8 for JSON::Parser
+and JSON::Converter to set UTF8 flag into strings contain utf8.
+
+
+=head1 CONVERT WITH SINGLE QUOTES
+
+You can set a true value into $JSON::SingleQuote for JSON::Converter
+to quote any keys and values with single quotations.
+
+You want to parse single quoted JSON data, See L</SINGLE QUOTATION OPTION>.
+
+
+=head1 EXPORT
+
+C<objToJson>, C<jsonToObj>.
+
+=head1 TODO
+
+Which name is more desirable? JSONRPC or JSON::RPC.
+
+SingleQuote and QuotApos...
+
+
+=head1 SEE ALSO
+
+L<http://www.crockford.com/JSON/>, L<JSON::Parser>, L<JSON::Converter>
+
+If you want the speed and the saving of memory usage,
+check L<JSON::Syck>.
+
+=head1 ACKNOWLEDGEMENTS
+
+I owe most JSONRPC idea to L<XMLRPC::Lite> and L<SOAP::Lite>.
+
+SHIMADA pointed out many problems to me.
+
+Mike Castle E<lt>dalgoda[at]ix.netcom.comE<gt> suggested
+better packaging way.
+
+Jeremy Muhlich E<lt>jmuhlich[at]bitflood.orgE<gt> help me
+escaped character handling in JSON::Parser.
+
+Adam Sussman E<lt>adam.sussman[at]ticketmaster.comE<gt>
+suggested the octal and hexadecimal formats as number.
+Sussman also sent the 'key sort' and 'hex number autoconv' patch
+and 'HASH KEY SORT ORDER' section.
+
+Tatsuhiko Miyagawa E<lt>miyagawa[at]bulknews.netE<gt>
+taught a terrible typo and gave some suggestions.
+
+David Wheeler E<lt>david[at]kineticode.comE<gt>
+suggested me supporting pretty-printing and
+gave a part of L<PRETTY PRINTING>.
+
+Rusty Phillips E<lt>rphillips[at]edats.comE<gt>
+suggested me supporting the query object other than CGI.pm
+for JSONRPC::Transport::HTTP::CGI.
+
+Felipe Gasper E<lt>gasperfm[at]uc.eduE<gt>
+pointed to a problem of JSON::NotString with undef.
+And show me patches for 'bare key option' & 'single quotation option'.
+
+Yaman Saqqa E<lt>abulyomon[at]gmail.comE<gt>
+helped my decision to support the bare key option.
+
+Alden DoRosario E<lt>adorosario[at]chitika.comE<gt>
+tought JSON::Conveter::_stringfy (<= 0.992) is very slow.
+
+Brad Baxter sent to 'key sort' patch and thought a bug in JSON.
+
+Jacob and Jay Buffington sent 'blessed object conversion' patch.
+
+Thanks to Peter Edwards, IVAN, and all testers for bug reports.
+
+Yann Kerherve sent 'selfconverter' patch(code, document and test).
+
+Annocpan users comment on JSON pod. See http://annocpan.org/pod/JSON
+
+And Thanks very much to JSON by JSON.org (Douglas Crockford) and
+JSON-RPC by http://json-rpc.org/
+
+
+=head1 AUTHOR
+
+Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2005-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-19 11:12:58 +0200