1package JSON; 2 3use strict; 4use base qw(Exporter); 5 6@JSON::EXPORT = qw(objToJson jsonToObj); 7 8use vars qw($AUTOCONVERT $VERSION $UnMapping $BareKey $QuotApos 9 $ExecCoderef $SkipInvalid $Pretty $Indent $Delimiter 10 $KeySort $ConvBlessed $SelfConvert $UTF8 $SingleQuote); 11 12$VERSION = '1.15'; 13 14$AUTOCONVERT = 1; 15$SkipInvalid = 0; 16$ExecCoderef = 0; 17$Pretty = 0; # pretty-print mode switch 18$Indent = 2; # (for pretty-print) 19$Delimiter = 2; # (for pretty-print) 0 => ':', 1 => ': ', 2 => ' : ' 20$UnMapping = 0; # 21$BareKey = 0; # 22$QuotApos = 0; # 23$KeySort = undef; # Code-ref to provide sort ordering in converter 24$UTF8 = 0; 25$SingleQuote = 0; 26 27my $USE_UTF8; 28 29BEGIN { 30 $USE_UTF8 = $] >= 5.008 ? 1 : 0; 31 sub USE_UTF8 { $USE_UTF8; } 32} 33 34use JSON::Parser; 35use JSON::Converter; 36 37my $parser; # JSON => Perl 38my $conv; # Perl => JSON 39 40 41############################################################################## 42# CONSTRCUTOR - JSON objects delegate all processes 43# to JSON::Converter and JSON::Parser. 44############################################################################## 45 46sub new { 47 my $class = shift; 48 my %opt = @_; 49 bless { 50 conv => undef, # JSON::Converter [perl => json] 51 parser => undef, # JSON::Parser [json => perl] 52 # below fields are for JSON::Converter 53 autoconv => $AUTOCONVERT, 54 skipinvalid => $SkipInvalid, 55 execcoderef => $ExecCoderef, 56 pretty => $Pretty , 57 indent => $Indent , 58 delimiter => $Delimiter , 59 keysort => $KeySort , 60 convblessed => $ConvBlessed, 61 selfconvert => $SelfConvert, 62 singlequote => $SingleQuote, 63 # below fields are for JSON::Parser 64 unmapping => $UnMapping, 65 quotapos => $QuotApos , 66 barekey => $BareKey , 67 # common options 68 utf8 => $UTF8 , 69 # overwrite 70 %opt, 71 }, $class; 72} 73 74 75############################################################################## 76# METHODS 77############################################################################## 78 79*parse_json = \&jsonToObj; 80 81*to_json = \&objToJson; 82 83sub jsonToObj { 84 my $self = shift; 85 my $js = shift; 86 87 if(!ref($self)){ # class method 88 my $opt = __PACKAGE__->_getParamsForParser($js); 89 $js = $self; 90 $parser ||= new JSON::Parser; 91 $parser->jsonToObj($js, $opt); 92 } 93 else{ # instance method 94 my $opt = $self->_getParamsForParser($_[0]); 95 $self->{parser} ||= ($parser ||= JSON::Parser->new); 96 $self->{parser}->jsonToObj($js, $opt); 97 } 98} 99 100 101sub objToJson { 102 my $self = shift || return; 103 my $obj = shift; 104 105 if(ref($self) !~ /JSON/){ # class method 106 my $opt = __PACKAGE__->_getParamsForConverter($obj); 107 $obj = $self; 108 $conv ||= JSON::Converter->new(); 109 $conv->objToJson($obj, $opt); 110 } 111 else{ # instance method 112 my $opt = $self->_getParamsForConverter($_[0]); 113 $self->{conv} 114 ||= JSON::Converter->new( %$opt ); 115 $self->{conv}->objToJson($obj, $opt); 116 } 117} 118 119 120####################### 121 122 123sub _getParamsForParser { 124 my ($self, $opt) = @_; 125 my $params; 126 127 if(ref($self)){ # instance 128 my @names = qw(unmapping quotapos barekey utf8); 129 my ($unmapping, $quotapos, $barekey, $utf8) = @{$self}{ @names }; 130 $params = { 131 unmapping => $unmapping, quotapos => $quotapos, 132 barekey => $barekey, utf8 => $utf8, 133 }; 134 } 135 else{ # class 136 $params = { 137 unmapping => $UnMapping, barekey => $BareKey, 138 quotapos => $QuotApos, utf8 => $UTF8, 139 }; 140 } 141 142 if($opt and ref($opt) eq 'HASH'){ 143 for my $key ( keys %$opt ){ 144 $params->{$key} = $opt->{$key}; 145 } 146 } 147 148 return $params; 149} 150 151 152sub _getParamsForConverter { 153 my ($self, $opt) = @_; 154 my $params; 155 156 if(ref($self)){ # instance 157 my @names 158 = qw(pretty indent delimiter autoconv keysort convblessed selfconvert utf8 singlequote); 159 my ($pretty, $indent, $delimiter, $autoconv, 160 $keysort, $convblessed, $selfconvert, $utf8, $singlequote) 161 = @{$self}{ @names }; 162 $params = { 163 pretty => $pretty, indent => $indent, 164 delimiter => $delimiter, autoconv => $autoconv, 165 keysort => $keysort, convblessed => $convblessed, 166 selfconvert => $selfconvert, utf8 => $utf8, 167 singlequote => $singlequote, 168 }; 169 } 170 else{ # class 171 $params = { 172 pretty => $Pretty, indent => $Indent, 173 delimiter => $Delimiter, autoconv => $AUTOCONVERT, 174 keysort => $KeySort, convblessed => $ConvBlessed, 175 selfconvert => $SelfConvert, utf8 => $UTF8, 176 singlequote => $SingleQuote, 177 }; 178 } 179 180 if($opt and ref($opt) eq 'HASH'){ 181 for my $key ( keys %$opt ){ 182 $params->{$key} = $opt->{$key}; 183 } 184 } 185 186 return $params; 187} 188 189############################################################################## 190# ACCESSOR 191############################################################################## 192BEGIN{ 193 for my $name (qw/autoconv pretty indent delimiter 194 unmapping keysort convblessed selfconvert singlequote/) 195 { 196 eval qq{ 197 sub $name { \$_[0]->{$name} = \$_[1] if(defined \$_[1]); \$_[0]->{$name} } 198 }; 199 } 200} 201 202############################################################################## 203# NON STRING DATA 204############################################################################## 205 206# See JSON::Parser for JSON::NotString. 207 208sub Number { 209 my $num = shift; 210 211 return undef if(!defined $num); 212 213 if( $num =~ /^-?(?:\d+)(?:\.\d*)?(?:[eE][-+]?\d+)?$/ 214 or $num =~ /^0[xX](?:[0-9a-zA-Z])+$/ ) 215 { 216 return bless {value => $num}, 'JSON::NotString'; 217 } 218 else{ 219 return undef; 220 } 221} 222 223sub True { 224 bless {value => 'true'}, 'JSON::NotString'; 225} 226 227sub False { 228 bless {value => 'false'}, 'JSON::NotString'; 229} 230 231sub Null { 232 bless {value => undef}, 'JSON::NotString'; 233} 234 235############################################################################## 2361; 237__END__ 238 239=pod 240 241=head1 NAME 242 243JSON - parse and convert to JSON (JavaScript Object Notation). 244 245=head1 SYNOPSIS 246 247 use JSON; 248 249 $obj = { 250 id => ["foo", "bar", { aa => 'bb'}], 251 hoge => 'boge' 252 }; 253 254 $js = objToJson($obj); 255 # this is {"id":["foo","bar",{"aa":"bb"}],"hoge":"boge"}. 256 $obj = jsonToObj($js); 257 # the data structure was restored. 258 259 # OOP 260 261 my $json = new JSON; 262 263 $obj = {id => 'foo', method => 'echo', params => ['a','b']}; 264 $js = $json->objToJson($obj); 265 $obj = $json->jsonToObj($js); 266 267 # pretty-printing 268 $js = $json->objToJson($obj, {pretty => 1, indent => 2}); 269 270 $json = JSON->new(pretty => 1, delimiter => 0); 271 $json->objToJson($obj); 272 273 274=head1 TRANSITION PLAN 275 276In the next large update version, JSON and JSONRPC modules are split. 277 278 JSON::Parser and JSON::Converter are deleted from JSON dist. 279 JSON and JSON::PP in JSON dist. 280 281 JSON becomes wrapper to JSON::XS and/or JSON::PP. 282 283 JSONRPC* and Apache::JSONRPC are deleted from JSON dist. 284 JSONRPC::Client, JSONRPC::Server and JSONRPC::Procedure in JSON::RPC dist. 285 286 Modules in JSON::RPC dist supports JSONRPC protocol v1.1 and 1.0. 287 288 289=head1 DESCRIPTION 290 291This module converts between JSON (JavaScript Object Notation) and Perl 292data structure into each other. 293For JSON, See to http://www.crockford.com/JSON/. 294 295 296=head1 METHODS 297 298=over 4 299 300=item new() 301 302=item new( %options ) 303 304returns a JSON object. The object delegates the converting and parsing process 305to L<JSON::Converter> and L<JSON::Parser>. 306 307 my $json = new JSON; 308 309C<new> can take some options. 310 311 my $json = new JSON (autoconv => 0, pretty => 1); 312 313Following options are supported: 314 315=over 4 316 317=item autoconv 318 319See L</AUTOCONVERT> for more info. 320 321=item skipinvalid 322 323C<objToJson()> does C<die()> when it encounters any invalid data 324(for instance, coderefs). If C<skipinvalid> is set with true, 325the function convets these invalid data into JSON format's C<null>. 326 327=item execcoderef 328 329C<objToJson()> does C<die()> when it encounters any code reference. 330However, if C<execcoderef> is set with true, executes the coderef 331and uses returned value. 332 333=item pretty 334 335See L</PRETTY PRINTING> for more info. 336 337=item indent 338 339See L</PRETTY PRINTING> for more info. 340 341=item delimiter 342 343See L</PRETTY PRINTING> for more info. 344 345=item keysort 346 347See L</HASH KEY SORT ORDER> for more info. 348 349=item convblessed 350 351See L</BLESSED OBJECT> for more info. 352 353=item selfconvert 354 355See L</BLESSED OBJECT> for more info. 356 357=item singlequote 358 359See L</CONVERT WITH SINGLE QUOTES> for more info. 360 361=item quotapos 362 363See L</SINGLE QUOTATION OPTION>. 364 365=back 366 367 368=item objToJson( $object ) 369 370=item objToJson( $object, $hashref ) 371 372takes perl data structure (basically, they are scalars, arrayrefs and hashrefs) 373and returns JSON formated string. 374 375 my $obj = [1, 2, {foo => bar}]; 376 my $js = $json->objToJson($obj); 377 # [1,2,{"foo":"bar"}] 378 379By default, returned string is one-line. However, you can get pretty-printed 380data with C<pretty> option. Please see below L</PRETTY PRINTING>. 381 382 my $js = $json->objToJson($obj, {pretty => 1, indent => 2}); 383 # [ 384 # 1, 385 # 2, 386 # { 387 # "foo" : "bar" 388 # } 389 # ] 390 391=item jsonToObj( $js ) 392 393takes a JSON formated data and returns a perl data structure. 394 395 396=item autoconv() 397 398=item autoconv($bool) 399 400This is an accessor to C<autoconv>. See L</AUTOCONVERT> for more info. 401 402=item pretty() 403 404=item pretty($bool) 405 406This is an accessor to C<pretty>. It takes true or false. 407When prrety is true, C<objToJson()> returns prrety-printed string. 408See L</PRETTY PRINTING> for more info. 409 410=item indent() 411 412=item indent($integer) 413 414This is an accessor to C<indent>. 415See L</PRETTY PRINTING> for more info. 416 417=item delimiter() 418 419This is an accessor to C<delimiter>. 420See L</PRETTY PRINTING> for more info. 421 422=item unmapping() 423 424=item unmapping($bool) 425 426This is an accessor to C<unmapping>. 427See L</UNMAPPING OPTION> for more info. 428 429=item keysort() 430 431=item keysort($coderef) 432 433This is an accessor to C<keysort>. 434See L</HASH KEY SORT ORDER> for more info. 435 436=item convblessed() 437 438=item convblessed($bool) 439 440This is an accessor to C<convblessed>. 441See L</BLESSED OBJECT> for more info. 442 443=item selfconvert() 444 445=item selfconvert($bool) 446 447This is an accessor to C<selfconvert>. 448See L</BLESSED OBJECT> for more info. 449 450=item singlequote() 451 452=item singlequote($bool) 453 454This is an accessor to C<singlequote>. 455See L</CONVERT WITH SINGLE QUOTES> for more info. 456 457 458=back 459 460=head1 MAPPING 461 462 (JSON) {"param" : []} 463 ( => Perl) {'param' => []}; 464 465 (JSON) {"param" : {}} 466 ( => Perl) {'param' => {}}; 467 468 (JSON) {"param" : "string"} 469 ( => Perl) {'param' => 'string'}; 470 471 JSON {"param" : null} 472 => Perl {'param' => bless( {'value' => undef}, 'JSON::NotString' )}; 473 or {'param' => undef} 474 475 (JSON) {"param" : true} 476 ( => Perl) {'param' => bless( {'value' => 'true'}, 'JSON::NotString' )}; 477 or {'param' => 1} 478 479 (JSON) {"param" : false} 480 ( => Perl) {'param' => bless( {'value' => 'false'}, 'JSON::NotString' )}; 481 or {'param' => 2} 482 483 (JSON) {"param" : 0xff} 484 ( => Perl) {'param' => 255}; 485 486 (JSON) {"param" : 010} 487 ( => Perl) {'param' => 8}; 488 489These JSON::NotString objects are overloaded so you don't care about. 490Since 1.00, L</UnMapping option> is added. When that option is set, 491{"param" : null} will be converted into {'param' => undef}, insted of 492{'param' => bless( {'value' => undef}, 'JSON::NotString' )}. 493 494 495Perl's C<undef> is converted to 'null'. 496 497 498=head1 PRETTY PRINTING 499 500If you'd like your JSON output to be pretty-printed, pass the C<pretty> 501parameter to objToJson(). You can affect the indentation (which defaults to 2) 502by passing the C<indent> parameter to objToJson(). 503 504 my $str = $json->objToJson($obj, {pretty => 1, indent => 4}); 505 506In addition, you can set some number to C<delimiter> option. 507The available numbers are only 0, 1 and 2. 508In pretty-printing mode, when C<delimiter> is 1, one space is added 509after ':' in object keys. If C<delimiter> is 2, it is ' : ' and 5100 is ':' (default is 2). If you give 3 or more to it, the value 511is taken as 2. 512 513 514=head1 AUTOCONVERT 515 516By default, $JSON::AUTOCONVERT is true. 517 518 (Perl) {num => 10.02} 519 ( => JSON) {"num" : 10.02} 520 521it is not C<{"num" : "10.02"}>. 522 523But set false value with $JSON::AUTOCONVERT: 524 525 (Perl) {num => 10.02} 526 ( => JSON) {"num" : "10.02"} 527 528it is not C<{"num" : 10.02}>. 529 530You can explicitly sepcify: 531 532 $obj = { 533 id => JSON::Number(10.02), 534 bool1 => JSON::True, 535 bool2 => JSON::False, 536 noval => JSON::Null, 537 }; 538 539 $json->objToJson($obj); 540 # {"noval" : null, "bool2" : false, "bool1" : true, "id" : 10.02} 541 542C<JSON::Number()> returns C<undef> when an argument invalid format. 543 544=head1 UNMAPPING OPTION 545 546By default, $JSON::UnMapping is false and JSON::Parser converts 547C<null>, C<true>, C<false> into C<JSON::NotString> objects. 548You can set true into $JSON::UnMapping to stop the mapping function. 549In that case, JSON::Parser will convert C<null>, C<true>, C<false> 550into C<undef>, 1, 0. 551 552=head1 BARE KEY OPTION 553 554You can set a true value into $JSON::BareKey for JSON::Parser to parse 555bare keys of objects. 556 557 local $JSON::BareKey = 1; 558 $obj = jsonToObj('{foo:"bar"}'); 559 560=head1 SINGLE QUOTATION OPTION 561 562You can set a true value into $JSON::QuotApos for JSON::Parser to parse 563any keys and values quoted by single quotations. 564 565 local $JSON::QuotApos = 1; 566 $obj = jsonToObj(q|{"foo":'bar'}|); 567 $obj = jsonToObj(q|{'foo':'bar'}|); 568 569With $JSON::BareKey: 570 571 local $JSON::BareKey = 1; 572 local $JSON::QuotApos = 1; 573 $obj = jsonToObj(q|{foo:'bar'}|); 574 575=head1 HASH KEY SORT ORDER 576 577By default objToJSON will serialize hashes with their keys in random 578order. To control the ordering of hash keys, you can provide a standard 579'sort' function that will be used to control how hashes are converted. 580 581You can provide either a fully qualified function name or a CODEREF to 582$JSON::KeySort or $obj->keysort. 583 584If you give any integers (excluded 0), the sort function will work as: 585 586 sub { $a cmp $b } 587 588Note that since the sort function is external to the JSON module the 589magical $a and $b arguments will not be in the same package. In order 590to gain access to the sorting arguments, you must either: 591 592 o use the ($$) prototype (slow) 593 o Fully qualify $a and $b from the JSON::Converter namespace 594 595See the documentation on sort for more information. 596 597 local $JSON::KeySort = 'My::Package::sort_function'; 598 599 or 600 601 local $JSON::KeySort = \&_some_function; 602 603 sub sort_function { 604 $JSON::Converter::a cmp $JSON::Converter::b; 605 } 606 607 or 608 609 sub sort_function ($$) { 610 my ($a, $b) = @_; 611 612 $a cmp $b 613 } 614 615=head1 BLESSED OBJECT 616 617By default, JSON::Converter doesn't deal with any blessed object 618(returns C<undef> or C<null> in the JSON format). 619If you use $JSON::ConvBlessed or C<convblessed> option, 620the module can convert most blessed object (hashref or arrayref). 621 622 local $JSON::ConvBlessed = 1; 623 print objToJson($blessed); 624 625This option slows down the converting speed. 626 627If you use $JSON::SelfConvert or C<selfconvert> option, 628the module will test for a C<toJson()> method on the object, 629and will rely on this method to obtain the converted value of 630the object. 631 632=head1 UTF8 633 634You can set a true value into $JSON::UTF8 for JSON::Parser 635and JSON::Converter to set UTF8 flag into strings contain utf8. 636 637 638=head1 CONVERT WITH SINGLE QUOTES 639 640You can set a true value into $JSON::SingleQuote for JSON::Converter 641to quote any keys and values with single quotations. 642 643You want to parse single quoted JSON data, See L</SINGLE QUOTATION OPTION>. 644 645 646=head1 EXPORT 647 648C<objToJson>, C<jsonToObj>. 649 650=head1 TODO 651 652Which name is more desirable? JSONRPC or JSON::RPC. 653 654SingleQuote and QuotApos... 655 656 657=head1 SEE ALSO 658 659L<http://www.crockford.com/JSON/>, L<JSON::Parser>, L<JSON::Converter> 660 661If you want the speed and the saving of memory usage, 662check L<JSON::Syck>. 663 664=head1 ACKNOWLEDGEMENTS 665 666I owe most JSONRPC idea to L<XMLRPC::Lite> and L<SOAP::Lite>. 667 668SHIMADA pointed out many problems to me. 669 670Mike Castle E<lt>dalgoda[at]ix.netcom.comE<gt> suggested 671better packaging way. 672 673Jeremy Muhlich E<lt>jmuhlich[at]bitflood.orgE<gt> help me 674escaped character handling in JSON::Parser. 675 676Adam Sussman E<lt>adam.sussman[at]ticketmaster.comE<gt> 677suggested the octal and hexadecimal formats as number. 678Sussman also sent the 'key sort' and 'hex number autoconv' patch 679and 'HASH KEY SORT ORDER' section. 680 681Tatsuhiko Miyagawa E<lt>miyagawa[at]bulknews.netE<gt> 682taught a terrible typo and gave some suggestions. 683 684David Wheeler E<lt>david[at]kineticode.comE<gt> 685suggested me supporting pretty-printing and 686gave a part of L<PRETTY PRINTING>. 687 688Rusty Phillips E<lt>rphillips[at]edats.comE<gt> 689suggested me supporting the query object other than CGI.pm 690for JSONRPC::Transport::HTTP::CGI. 691 692Felipe Gasper E<lt>gasperfm[at]uc.eduE<gt> 693pointed to a problem of JSON::NotString with undef. 694And show me patches for 'bare key option' & 'single quotation option'. 695 696Yaman Saqqa E<lt>abulyomon[at]gmail.comE<gt> 697helped my decision to support the bare key option. 698 699Alden DoRosario E<lt>adorosario[at]chitika.comE<gt> 700tought JSON::Conveter::_stringfy (<= 0.992) is very slow. 701 702Brad Baxter sent to 'key sort' patch and thought a bug in JSON. 703 704Jacob and Jay Buffington sent 'blessed object conversion' patch. 705 706Thanks to Peter Edwards, IVAN, and all testers for bug reports. 707 708Yann Kerherve sent 'selfconverter' patch(code, document and test). 709 710Annocpan users comment on JSON pod. See http://annocpan.org/pod/JSON 711 712And Thanks very much to JSON by JSON.org (Douglas Crockford) and 713JSON-RPC by http://json-rpc.org/ 714 715 716=head1 AUTHOR 717 718Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> 719 720=head1 COPYRIGHT AND LICENSE 721 722Copyright 2005-2007 by Makamaka Hannyaharamitu 723 724This library is free software; you can redistribute it and/or modify 725it under the same terms as Perl itself. 726 727=cut 728 729 730