diff options
author | Tobi Oetiker <tobi@oetiker.ch> | 2007-11-14 18:33:19 +0100 |
---|---|---|
committer | Tobi Oetiker <tobi@oetiker.ch> | 2007-11-14 18:33:19 +0100 |
commit | ff7b9de82908baf1d5f9af71e35dad2369bfdc2f (patch) | |
tree | 1f9821bf2323786cbe68b4d3b0964ca449332766 /qooxdoo/source/perl/JSON.pm | |
parent | d546419d19b89633f8ac3c461eb900f4c4f29b90 (diff) | |
download | smokeping-ff7b9de82908baf1d5f9af71e35dad2369bfdc2f.tar.gz smokeping-ff7b9de82908baf1d5f9af71e35dad2369bfdc2f.tar.xz |
initial qooxdoo drop for smokeping
Diffstat (limited to 'qooxdoo/source/perl/JSON.pm')
-rwxr-xr-x | qooxdoo/source/perl/JSON.pm | 725 |
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 + + |