Build.PL100644000766000024 350312414644342 13413 0ustar00JP11194staff000000000000JSON-RPC-1.06# ========================================================================= # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. # DO NOT EDIT DIRECTLY. # ========================================================================= use 5.008_001; use strict; use warnings; use utf8; use Module::Build; use File::Basename; use File::Spec; use CPAN::Meta; use CPAN::Meta::Prereqs; my %args = ( license => 'perl', dynamic_config => 0, configure_requires => { 'Module::Build' => 0.38, }, name => 'JSON-RPC', module_name => 'JSON::RPC', allow_pureperl => 0, script_files => [glob('script/*'), glob('bin/*')], c_source => [qw()], PL_files => {}, test_files => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/', recursive_test_files => 1, ); if (-d 'share') { $args{share_dir} = 'share'; } my $builder = Module::Build->subclass( class => 'MyBuilder', code => q{ sub ACTION_distmeta { die "Do not run distmeta. Install Minilla and `minil install` instead.\n"; } sub ACTION_installdeps { die "Do not run installdeps. Run `cpanm --installdeps .` instead.\n"; } } )->new(%args); $builder->create_build_script(); my $mbmeta = CPAN::Meta->load_file('MYMETA.json'); my $meta = CPAN::Meta->load_file('META.json'); my $prereqs_hash = CPAN::Meta::Prereqs->new( $meta->prereqs )->with_merged_prereqs( CPAN::Meta::Prereqs->new($mbmeta->prereqs) )->as_string_hash; my $mymeta = CPAN::Meta->new( { %{$meta->as_struct}, prereqs => $prereqs_hash } ); print "Merging cpanfile prereqs to MYMETA.yml\n"; $mymeta->save('MYMETA.yml', { version => 1.4 }); print "Merging cpanfile prereqs to MYMETA.json\n"; $mymeta->save('MYMETA.json', { version => 2 }); Changes100644000766000024 672112414644342 13417 0ustar00JP11194staff000000000000JSON-RPC-1.06Changes ======= 1.06 2014-10-07T01:58:56Z - Messed up previous release. Re-releasing 1.05 2014-10-07T01:57:38Z - Work better with batch requests: Now responses are properly returned as list as long as the request is a list as well (Arata Makoto) 1.04 2014-05-29T11:42:19Z - Work with notifications, which are procedures without an id (Kirill Bogdanov) 1.03 2012 Jun 15 - Allow die \%hash from handlers (ka2u) 1.02 2012 Jun 14 - Fix the finalization of the response (0xAF) 1.01 2011 Dec 01 - Use require instead of Class::Load. Subclass in your app if you need that kind of ability, but it seems unlikely that we'd need anything more than eval require here. 1.00 2011 Nov 22 - No code change. 1.00_02 2011 Nov 16 - JSON::RPC::Dispatcher already existed on CPAN. s/Dispatcher/Dispatch/g 1.00_01 2011 Nov 16 - New maintainer, completely new code for PSGI apps and JSON RPC 2.0 - If you are using old JSON::RPC code (up to 0.96), DO NOT EXPECT YOUR CODE TO WORK. THIS VERSION IS BACKWARDS INCOMPATIBLE ---------- Old Change Log ----------- Revision history for Perl extension JSON::RPC. ###### In the next large version up ###################################### * JSON::RPC::Server::Apache will be renamed to JSON::RPC::Server::Apache2 and split into another distribution. * JSON::RPC::Server::Apache really supports apache 1.3x and the maintainer will be changed. ########################################################################## 0.96 Mon Feb 25 11:06:25 2008 - JSON::RPC::Server::FastCGI was split into the independent distribution. the new maintainer is Faiz Kazi. - JSON::RPC::Server::Apache was renamed to JSON::RPC::Server::Apache2 it will split into another distribution. - added and updated docs. 0.95 Fri Feb 15 16:01:04 2008 - sample codes were indexed...! fixed package for avoiding the indexer. 0.94 Fri Feb 15 15:16:32 2008 - no change but examples was forgotten. 0.93 Fri Feb 15 14:46:17 2008 - added example codes. - now AUTOLOAD method after prepare() can support built-in methods. $client -> __VERSION__ ( => $client calls the name 'VERSION' procedure ) - Your application can set subroutines allowable by allowable_procedure(). (Thanks to seagull's suggestion) - JSON::RPC::Server::Apache config supports 'return_die_message'. - require LWP::UserAgent 2.001 or later. 0.92 Thu Feb 14 13:12:40 2008 - modified the JSON::RPC::Client prepare mode to check response errors. (Thanks to Colin Meyer) - fixed retrieve_json_from_get in JSON::RPC::Server::CGI. - implemented JSON::RPC::Server::Apache to support the GET method call. - fixed JSON::RPC::ReturnObject decoding JSON data with utf8 mode. ($client -> call() ->result will return Unicode characters (if contained).) - added some descriptions to the JSON::RPC::Client pod. 0.91 Wed Dec 19 15:51:53 2007 - JSON::RPC::Client used JSON::PP. - added create_json_coder() to JSON::RPC::Client. 0.90 Wed Dec 19 13:26:15 2007 - Now default JSON coder is JSON! (1.99 or later) - added JSON::RPC::Server::FastCGI written by Faiz Kazi, thanks! - added JSONRPC for guide to this distribution. - cleaned up JSON::RPC::Server::CGI - added create_json_coder() to JSON::RPC::Server. - modified J::R::Server::* as base.pm does not work well in Perl 5.005 0.01 Mon May 21 14:18:33 2007 - original versionLICENSE100644000766000024 4365212414644342 13155 0ustar00JP11194staff000000000000JSON-RPC-1.06This software is copyright (c) 2014 by Daisuke Maki. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2014 by Daisuke Maki. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2014 by Daisuke Maki. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End META.json100644000766000024 1033412414644342 13560 0ustar00JP11194staff000000000000JSON-RPC-1.06{ "abstract" : "JSON RPC 2.0 Server Implementation", "author" : [ "Daisuke Maki" ], "dynamic_config" : 0, "generated_by" : "Minilla/v1.1.0", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "JSON-RPC", "no_index" : { "directory" : [ "t", "xt", "inc", "share", "eg", "examples", "author", "builder" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "6.36", "Plack::Request" : "0", "Plack::Test" : "0", "Test::More" : "0" } }, "configure" : { "requires" : { "CPAN::Meta" : "0", "CPAN::Meta::Prereqs" : "0", "Module::Build" : "0.38" } }, "develop" : { "requires" : { "Test::CPAN::Meta" : "0", "Test::MinimumVersion::Fast" : "0.04", "Test::PAUSE::Permissions" : "0.04", "Test::Pod" : "1.41", "Test::Spellunker" : "v0.2.7" } }, "runtime" : { "recommends" : { "JSON::XS" : "0" }, "requires" : { "CGI" : "0", "Class::Accessor::Lite" : "0", "HTTP::Request" : "0", "HTTP::Response" : "0", "JSON" : "0", "LWP::UserAgent" : "0", "Plack" : "0", "Router::Simple" : "0", "parent" : "0" } } }, "provides" : { "JSON::RPC" : { "file" : "lib/JSON/RPC.pm", "version" : "1.06" }, "JSON::RPC::Constants" : { "file" : "lib/JSON/RPC/Constants.pm" }, "JSON::RPC::Dispatch" : { "file" : "lib/JSON/RPC/Dispatch.pm" }, "JSON::RPC::Legacy" : { "file" : "lib/JSON/RPC/Legacy.pm" }, "JSON::RPC::Legacy::Client" : { "file" : "lib/JSON/RPC/Legacy/Client.pm", "version" : "1.06" }, "JSON::RPC::Legacy::Procedure" : { "file" : "lib/JSON/RPC/Legacy/Procedure.pm", "version" : "1.06" }, "JSON::RPC::Legacy::ReturnObject" : { "file" : "lib/JSON/RPC/Legacy/Client.pm", "version" : "0" }, "JSON::RPC::Legacy::Server" : { "file" : "lib/JSON/RPC/Legacy/Server.pm", "version" : "1.06" }, "JSON::RPC::Legacy::Server::Apache" : { "file" : "lib/JSON/RPC/Legacy/Server/Apache2.pm", "version" : "1.06" }, "JSON::RPC::Legacy::Server::Apache2" : { "file" : "lib/JSON/RPC/Legacy/Server/Apache2.pm" }, "JSON::RPC::Legacy::Server::CGI" : { "file" : "lib/JSON/RPC/Legacy/Server/CGI.pm", "version" : "1.06" }, "JSON::RPC::Legacy::Server::Daemon" : { "file" : "lib/JSON/RPC/Legacy/Server/Daemon.pm", "version" : "1.06" }, "JSON::RPC::Legacy::Server::system" : { "file" : "lib/JSON/RPC/Legacy/Server.pm" }, "JSON::RPC::Legacy::ServiceObject" : { "file" : "lib/JSON/RPC/Legacy/Client.pm" }, "JSON::RPC::Parser" : { "file" : "lib/JSON/RPC/Parser.pm" }, "JSON::RPC::Procedure" : { "file" : "lib/JSON/RPC/Procedure.pm" }, "JSON::RPC::Test" : { "file" : "lib/JSON/RPC/Test.pm" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "ssh://git@github.com/lestrrat/JSON-RPC/issues" }, "homepage" : "ssh://git@github.com/lestrrat/JSON-RPC", "repository" : { "url" : "ssh://git@github.com/lestrrat/JSON-RPC.git", "web" : "ssh://git@github.com/lestrrat/JSON-RPC" } }, "version" : "1.06", "x_contributors" : [ "Yoshimitsu Torii ", "Stanislav Lechev [AngelFire] ", "Kazuhiro Shibuya ", "David Steinbrunner ", "ThePeePs ", "Kirill Bogdanov ", "ar_tama ", "Daisuke Maki " ] } Makefile100644000766000024 6657012414644342 13614 0ustar00JP11194staff000000000000JSON-RPC-1.06# This Makefile is for the JSON::RPC extension to perl. # # It was generated automatically by MakeMaker version # 6.74 (Revision: 67400) from the contents of # Makefile.PL. Don't edit this file, edit Makefile.PL instead. # # ANY CHANGES MADE HERE WILL BE LOST! # # MakeMaker ARGV: () # # MakeMaker Parameters: # ABSTRACT => q[JSON RPC 2.0 Server Implementation] # AUTHOR => [q[Daisuke Maki]] # BUILD_REQUIRES => { Test::More=>q[0], Plack::Test=>q[0], ExtUtils::MakeMaker=>q[6.36], Plack::Request=>q[0] } # CONFIGURE_REQUIRES => { } # DISTNAME => q[JSON-RPC] # LICENSE => q[perl] # NAME => q[JSON::RPC] # NO_META => q[1] # PREREQ_PM => { parent=>q[0], Plack=>q[0], Router::Simple=>q[0], ExtUtils::MakeMaker=>q[6.36], CGI=>q[0], Class::Accessor::Lite=>q[0], Test::More=>q[0], Plack::Test=>q[0], LWP::UserAgent=>q[0], HTTP::Response=>q[0], Plack::Request=>q[0], JSON=>q[0], HTTP::Request=>q[0] } # TEST_REQUIRES => { } # VERSION => q[1.03] # VERSION_FROM => q[lib/JSON/RPC.pm] # dist => { } # realclean => { FILES=>q[MYMETA.yml] } # test => { TESTS=>q[t/*.t t/*/*.t] } # --- MakeMaker post_initialize section: # --- MakeMaker const_config section: # These definitions are from config.sh (via /Users/daisuke/.plenv/versions/5.16/lib/perl5/5.16.3/darwin-2level/Config.pm). # They may have been overridden via Makefile.PL or on the command line. AR = ar CC = cc CCCDLFLAGS = CCDLFLAGS = DLEXT = bundle DLSRC = dl_dlopen.xs EXE_EXT = FULL_AR = /usr/bin/ar LD = env MACOSX_DEPLOYMENT_TARGET=10.3 cc LDDLFLAGS = -bundle -undefined dynamic_lookup -L/usr/local/lib -fstack-protector LDFLAGS = -fstack-protector -L/usr/local/lib LIBC = LIB_EXT = .a OBJ_EXT = .o OSNAME = darwin OSVERS = 12.4.0 RANLIB = ranlib SITELIBEXP = /Users/daisuke/.plenv/versions/5.16/lib/perl5/site_perl/5.16.3 SITEARCHEXP = /Users/daisuke/.plenv/versions/5.16/lib/perl5/site_perl/5.16.3/darwin-2level SO = dylib VENDORARCHEXP = VENDORLIBEXP = # --- MakeMaker constants section: AR_STATIC_ARGS = cr DIRFILESEP = / DFSEP = $(DIRFILESEP) NAME = JSON::RPC NAME_SYM = JSON_RPC VERSION = 1.03 VERSION_MACRO = VERSION VERSION_SYM = 1_03 DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" XS_VERSION = 1.03 XS_VERSION_MACRO = XS_VERSION XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" INST_ARCHLIB = blib/arch INST_SCRIPT = blib/script INST_BIN = blib/bin INST_LIB = blib/lib INST_MAN1DIR = blib/man1 INST_MAN3DIR = blib/man3 MAN1EXT = 1 MAN3EXT = 3 INSTALLDIRS = site DESTDIR = PREFIX = $(SITEPREFIX) PERLPREFIX = /Users/daisuke/.plenv/versions/5.16 SITEPREFIX = /Users/daisuke/.plenv/versions/5.16 VENDORPREFIX = INSTALLPRIVLIB = /Users/daisuke/.plenv/versions/5.16/lib/perl5/5.16.3 DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) INSTALLSITELIB = /Users/daisuke/.plenv/versions/5.16/lib/perl5/site_perl/5.16.3 DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) INSTALLVENDORLIB = DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) INSTALLARCHLIB = /Users/daisuke/.plenv/versions/5.16/lib/perl5/5.16.3/darwin-2level DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) INSTALLSITEARCH = /Users/daisuke/.plenv/versions/5.16/lib/perl5/site_perl/5.16.3/darwin-2level DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) INSTALLVENDORARCH = DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) INSTALLBIN = /Users/daisuke/.plenv/versions/5.16/bin DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) INSTALLSITEBIN = /Users/daisuke/.plenv/versions/5.16/bin DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) INSTALLVENDORBIN = DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) INSTALLSCRIPT = /Users/daisuke/.plenv/versions/5.16/bin DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) INSTALLSITESCRIPT = /Users/daisuke/.plenv/versions/5.16/bin DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT) INSTALLVENDORSCRIPT = DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT) INSTALLMAN1DIR = /Users/daisuke/.plenv/versions/5.16/man/man1 DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) INSTALLSITEMAN1DIR = /Users/daisuke/.plenv/versions/5.16/man/man1 DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) INSTALLVENDORMAN1DIR = DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) INSTALLMAN3DIR = /Users/daisuke/.plenv/versions/5.16/man/man3 DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) INSTALLSITEMAN3DIR = /Users/daisuke/.plenv/versions/5.16/man/man3 DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) INSTALLVENDORMAN3DIR = DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) PERL_LIB = PERL_ARCHLIB = /Users/daisuke/.plenv/versions/5.16/lib/perl5/5.16.3/darwin-2level LIBPERL_A = libperl.a FIRST_MAKEFILE = Makefile MAKEFILE_OLD = Makefile.old MAKE_APERL_FILE = Makefile.aperl PERLMAINCC = $(CC) PERL_INC = /Users/daisuke/.plenv/versions/5.16/lib/perl5/5.16.3/darwin-2level/CORE PERL = /Users/daisuke/.plenv/versions/5.16/bin/perl "-Iinc" FULLPERL = /Users/daisuke/.plenv/versions/5.16/bin/perl "-Iinc" ABSPERL = $(PERL) PERLRUN = $(PERL) FULLPERLRUN = $(FULLPERL) ABSPERLRUN = $(ABSPERL) PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)" FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)" ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)" PERL_CORE = 0 PERM_DIR = 755 PERM_RW = 644 PERM_RWX = 755 MAKEMAKER = /Users/daisuke/.plenv/versions/5.16/lib/perl5/site_perl/5.16.3/ExtUtils/MakeMaker.pm MM_VERSION = 6.74 MM_REVISION = 67400 # FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) # PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) # DLBASE = Basename part of dynamic library. May be just equal BASEEXT. MAKE = make FULLEXT = JSON/RPC BASEEXT = RPC PARENT_NAME = JSON DLBASE = $(BASEEXT) VERSION_FROM = lib/JSON/RPC.pm OBJECT = LDFROM = $(OBJECT) LINKTYPE = dynamic BOOTDEP = # Handy lists of source code files: XS_FILES = C_FILES = O_FILES = H_FILES = MAN1PODS = MAN3PODS = lib/JSON/RPC.pm \ lib/JSON/RPC/Constants.pm \ lib/JSON/RPC/Dispatch.pm \ lib/JSON/RPC/Legacy.pm \ lib/JSON/RPC/Legacy/Client.pm \ lib/JSON/RPC/Legacy/Procedure.pm \ lib/JSON/RPC/Legacy/Server.pm \ lib/JSON/RPC/Legacy/Server/Apache2.pm \ lib/JSON/RPC/Legacy/Server/CGI.pm \ lib/JSON/RPC/Legacy/Server/Daemon.pm \ lib/JSON/RPC/Parser.pm \ lib/JSON/RPC/Procedure.pm \ lib/JSON/RPC/Test.pm # Where is the Config information that we are using/depend on CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h # Where to build things INST_LIBDIR = $(INST_LIB)/JSON INST_ARCHLIBDIR = $(INST_ARCHLIB)/JSON INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) INST_STATIC = INST_DYNAMIC = INST_BOOT = # Extra linker info EXPORT_LIST = PERL_ARCHIVE = PERL_ARCHIVE_AFTER = TO_INST_PM = lib/JSON/RPC.pm \ lib/JSON/RPC/Constants.pm \ lib/JSON/RPC/Dispatch.pm \ lib/JSON/RPC/Legacy.pm \ lib/JSON/RPC/Legacy/Client.pm \ lib/JSON/RPC/Legacy/Procedure.pm \ lib/JSON/RPC/Legacy/Server.pm \ lib/JSON/RPC/Legacy/Server/Apache2.pm \ lib/JSON/RPC/Legacy/Server/CGI.pm \ lib/JSON/RPC/Legacy/Server/Daemon.pm \ lib/JSON/RPC/Parser.pm \ lib/JSON/RPC/Procedure.pm \ lib/JSON/RPC/Test.pm PM_TO_BLIB = lib/JSON/RPC/Legacy/Server.pm \ blib/lib/JSON/RPC/Legacy/Server.pm \ lib/JSON/RPC/Legacy/Server/Daemon.pm \ blib/lib/JSON/RPC/Legacy/Server/Daemon.pm \ lib/JSON/RPC/Legacy/Server/Apache2.pm \ blib/lib/JSON/RPC/Legacy/Server/Apache2.pm \ lib/JSON/RPC.pm \ blib/lib/JSON/RPC.pm \ lib/JSON/RPC/Constants.pm \ blib/lib/JSON/RPC/Constants.pm \ lib/JSON/RPC/Procedure.pm \ blib/lib/JSON/RPC/Procedure.pm \ lib/JSON/RPC/Parser.pm \ blib/lib/JSON/RPC/Parser.pm \ lib/JSON/RPC/Legacy/Client.pm \ blib/lib/JSON/RPC/Legacy/Client.pm \ lib/JSON/RPC/Legacy.pm \ blib/lib/JSON/RPC/Legacy.pm \ lib/JSON/RPC/Legacy/Procedure.pm \ blib/lib/JSON/RPC/Legacy/Procedure.pm \ lib/JSON/RPC/Dispatch.pm \ blib/lib/JSON/RPC/Dispatch.pm \ lib/JSON/RPC/Legacy/Server/CGI.pm \ blib/lib/JSON/RPC/Legacy/Server/CGI.pm \ lib/JSON/RPC/Test.pm \ blib/lib/JSON/RPC/Test.pm # --- MakeMaker platform_constants section: MM_Unix_VERSION = 6.74 PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc # --- MakeMaker tool_autosplit section: # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$$$ARGV[0], $$$$ARGV[1], 0, 1, 1)' -- # --- MakeMaker tool_xsubpp section: # --- MakeMaker tools_other section: SHELL = /bin/sh CHMOD = chmod CP = cp MV = mv NOOP = $(TRUE) NOECHO = @ RM_F = rm -f RM_RF = rm -rf TEST_F = test -f TOUCH = touch UMASK_NULL = umask 0 DEV_NULL = > /dev/null 2>&1 MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' -- EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' -- FALSE = false TRUE = true ECHO = echo ECHO_N = echo -n UNINST = 0 VERBINST = 0 MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' -- DOC_INSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'perllocal_install' -- UNINSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'uninstall' -- WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'warn_if_old_packlist' -- MACROSTART = MACROEND = USEMAKEFILE = -f FIXIN = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' -- # --- MakeMaker makemakerdflt section: makemakerdflt : all $(NOECHO) $(NOOP) # --- MakeMaker dist section: TAR = COPY_EXTENDED_ATTRIBUTES_DISABLE=1 COPYFILE_DISABLE=1 tar TARFLAGS = cvf ZIP = zip ZIPFLAGS = -r COMPRESS = gzip --best SUFFIX = .gz SHAR = shar PREOP = $(NOECHO) $(NOOP) POSTOP = $(NOECHO) $(NOOP) TO_UNIX = $(NOECHO) $(NOOP) CI = ci -u RCS_LABEL = rcs -Nv$(VERSION_SYM): -q DIST_CP = best DIST_DEFAULT = tardist DISTNAME = JSON-RPC DISTVNAME = JSON-RPC-1.03 # --- MakeMaker macro section: # --- MakeMaker depend section: # --- MakeMaker cflags section: # --- MakeMaker const_loadlibs section: # --- MakeMaker const_cccmd section: # --- MakeMaker post_constants section: # --- MakeMaker pasthru section: PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ LINKTYPE="$(LINKTYPE)"\ PREFIX="$(PREFIX)" # --- MakeMaker special_targets section: .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) .PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir # --- MakeMaker c_o section: # --- MakeMaker xs_c section: # --- MakeMaker xs_o section: # --- MakeMaker top_targets section: all :: pure_all manifypods $(NOECHO) $(NOOP) pure_all :: config pm_to_blib subdirs linkext $(NOECHO) $(NOOP) subdirs :: $(MYEXTLIB) $(NOECHO) $(NOOP) config :: $(FIRST_MAKEFILE) blibdirs $(NOECHO) $(NOOP) help : perldoc ExtUtils::MakeMaker # --- MakeMaker blibdirs section: blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists $(NOECHO) $(NOOP) # Backwards compat with 6.18 through 6.25 blibdirs.ts : blibdirs $(NOECHO) $(NOOP) $(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_LIBDIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_LIBDIR) $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_ARCHLIB) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB) $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_AUTODIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR) $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR) $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_BIN) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN) $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_SCRIPT) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT) $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_MAN1DIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR) $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL $(NOECHO) $(MKPATH) $(INST_MAN3DIR) $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR) $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists # --- MakeMaker linkext section: linkext :: $(LINKTYPE) $(NOECHO) $(NOOP) # --- MakeMaker dlsyms section: # --- MakeMaker dynamic section: dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) $(NOECHO) $(NOOP) # --- MakeMaker dynamic_bs section: BOOTSTRAP = # --- MakeMaker dynamic_lib section: # --- MakeMaker static section: ## $(INST_PM) has been moved to the all: target. ## It remains here for awhile to allow for old usage: "make static" static :: $(FIRST_MAKEFILE) $(INST_STATIC) $(NOECHO) $(NOOP) # --- MakeMaker static_lib section: # --- MakeMaker manifypods section: POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" POD2MAN = $(POD2MAN_EXE) manifypods : pure_all \ lib/JSON/RPC/Legacy/Server.pm \ lib/JSON/RPC/Legacy/Server/Daemon.pm \ lib/JSON/RPC/Legacy/Server/Apache2.pm \ lib/JSON/RPC.pm \ lib/JSON/RPC/Constants.pm \ lib/JSON/RPC/Procedure.pm \ lib/JSON/RPC/Parser.pm \ lib/JSON/RPC/Legacy/Client.pm \ lib/JSON/RPC/Legacy.pm \ lib/JSON/RPC/Legacy/Procedure.pm \ lib/JSON/RPC/Dispatch.pm \ lib/JSON/RPC/Legacy/Server/CGI.pm \ lib/JSON/RPC/Test.pm $(NOECHO) $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) \ lib/JSON/RPC/Legacy/Server.pm $(INST_MAN3DIR)/JSON::RPC::Legacy::Server.$(MAN3EXT) \ lib/JSON/RPC/Legacy/Server/Daemon.pm $(INST_MAN3DIR)/JSON::RPC::Legacy::Server::Daemon.$(MAN3EXT) \ lib/JSON/RPC/Legacy/Server/Apache2.pm $(INST_MAN3DIR)/JSON::RPC::Legacy::Server::Apache2.$(MAN3EXT) \ lib/JSON/RPC.pm $(INST_MAN3DIR)/JSON::RPC.$(MAN3EXT) \ lib/JSON/RPC/Constants.pm $(INST_MAN3DIR)/JSON::RPC::Constants.$(MAN3EXT) \ lib/JSON/RPC/Procedure.pm $(INST_MAN3DIR)/JSON::RPC::Procedure.$(MAN3EXT) \ lib/JSON/RPC/Parser.pm $(INST_MAN3DIR)/JSON::RPC::Parser.$(MAN3EXT) \ lib/JSON/RPC/Legacy/Client.pm $(INST_MAN3DIR)/JSON::RPC::Legacy::Client.$(MAN3EXT) \ lib/JSON/RPC/Legacy.pm $(INST_MAN3DIR)/JSON::RPC::Legacy.$(MAN3EXT) \ lib/JSON/RPC/Legacy/Procedure.pm $(INST_MAN3DIR)/JSON::RPC::Legacy::Procedure.$(MAN3EXT) \ lib/JSON/RPC/Dispatch.pm $(INST_MAN3DIR)/JSON::RPC::Dispatch.$(MAN3EXT) \ lib/JSON/RPC/Legacy/Server/CGI.pm $(INST_MAN3DIR)/JSON::RPC::Legacy::Server::CGI.$(MAN3EXT) \ lib/JSON/RPC/Test.pm $(INST_MAN3DIR)/JSON::RPC::Test.$(MAN3EXT) # --- MakeMaker processPL section: # --- MakeMaker installbin section: # --- MakeMaker subdirs section: # none # --- MakeMaker clean_subdirs section: clean_subdirs : $(NOECHO) $(NOOP) # --- MakeMaker clean section: # Delete temporary files but do not touch installed files. We don't delete # the Makefile here so a later make realclean still has a makefile to use. clean :: clean_subdirs - $(RM_F) \ *$(LIB_EXT) core \ core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \ core.[0-9][0-9] $(BASEEXT).bso \ pm_to_blib.ts MYMETA.json \ core.[0-9][0-9][0-9][0-9] MYMETA.yml \ $(BASEEXT).x $(BOOTSTRAP) \ perl$(EXE_EXT) tmon.out \ *$(OBJ_EXT) pm_to_blib \ $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \ core.[0-9][0-9][0-9][0-9][0-9] *perl.core \ core.*perl.*.? $(MAKE_APERL_FILE) \ $(BASEEXT).def perl \ core.[0-9][0-9][0-9] mon.out \ lib$(BASEEXT).def perlmain.c \ perl.exe so_locations \ $(BASEEXT).exp - $(RM_RF) \ blib $(NOECHO) $(RM_F) $(MAKEFILE_OLD) - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) # --- MakeMaker realclean_subdirs section: realclean_subdirs : $(NOECHO) $(NOOP) # --- MakeMaker realclean section: # Delete temporary files (via clean) and also delete dist files realclean purge :: clean realclean_subdirs - $(RM_F) \ $(MAKEFILE_OLD) $(FIRST_MAKEFILE) - $(RM_RF) \ MYMETA.yml $(DISTVNAME) # --- MakeMaker metafile section: metafile : $(NOECHO) $(NOOP) # --- MakeMaker signature section: signature : cpansign -s # --- MakeMaker dist_basics section: distclean :: realclean distcheck $(NOECHO) $(NOOP) distcheck : $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck skipcheck : $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck manifest : $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest veryclean : realclean $(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old # --- MakeMaker dist_core section: dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \ -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' -- tardist : $(DISTVNAME).tar$(SUFFIX) $(NOECHO) $(NOOP) uutardist : $(DISTVNAME).tar$(SUFFIX) uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu' $(DISTVNAME).tar$(SUFFIX) : distdir $(PREOP) $(TO_UNIX) $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) $(RM_RF) $(DISTVNAME) $(COMPRESS) $(DISTVNAME).tar $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)' $(POSTOP) zipdist : $(DISTVNAME).zip $(NOECHO) $(NOOP) $(DISTVNAME).zip : distdir $(PREOP) $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) $(RM_RF) $(DISTVNAME) $(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip' $(POSTOP) shdist : distdir $(PREOP) $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar $(RM_RF) $(DISTVNAME) $(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar' $(POSTOP) # --- MakeMaker distdir section: create_distdir : $(RM_RF) $(DISTVNAME) $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" distdir : create_distdir $(NOECHO) $(NOOP) # --- MakeMaker dist_test section: disttest : distdir cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL cd $(DISTVNAME) && $(MAKE) $(PASTHRU) cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) # --- MakeMaker dist_ci section: ci : $(PERLRUN) "-MExtUtils::Manifest=maniread" \ -e "@all = keys %{ maniread() };" \ -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \ -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});" # --- MakeMaker distmeta section: distmeta : create_distdir metafile $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{META.yml};' \ -e 'eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }' \ -e ' or print "Could not add META.yml to MANIFEST: $$$${'\''@'\''}\n"' -- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \ -e 'eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }' \ -e ' or print "Could not add META.json to MANIFEST: $$$${'\''@'\''}\n"' -- # --- MakeMaker distsignature section: distsignature : create_distdir $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) }' \ -e ' or print "Could not add SIGNATURE to MANIFEST: $$$${'\''@'\''}\n"' -- $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE cd $(DISTVNAME) && cpansign -s # --- MakeMaker install section: install :: pure_install doc_install $(NOECHO) $(NOOP) install_perl :: pure_perl_install doc_perl_install $(NOECHO) $(NOOP) install_site :: pure_site_install doc_site_install $(NOECHO) $(NOOP) install_vendor :: pure_vendor_install doc_vendor_install $(NOECHO) $(NOOP) pure_install :: pure_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) doc_install :: doc_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) pure__install : pure_site_install $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site doc__install : doc_site_install $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site pure_perl_install :: all $(NOECHO) $(MOD_INSTALL) \ read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \ write $(DESTINSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \ $(INST_LIB) $(DESTINSTALLPRIVLIB) \ $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ $(INST_BIN) $(DESTINSTALLBIN) \ $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \ $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ $(SITEARCHEXP)/auto/$(FULLEXT) pure_site_install :: all $(NOECHO) $(MOD_INSTALL) \ read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ $(INST_LIB) $(DESTINSTALLSITELIB) \ $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ $(INST_BIN) $(DESTINSTALLSITEBIN) \ $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \ $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \ $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ $(PERL_ARCHLIB)/auto/$(FULLEXT) pure_vendor_install :: all $(NOECHO) $(MOD_INSTALL) \ read $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist \ write $(DESTINSTALLVENDORARCH)/auto/$(FULLEXT)/.packlist \ $(INST_LIB) $(DESTINSTALLVENDORLIB) \ $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ $(INST_BIN) $(DESTINSTALLVENDORBIN) \ $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \ $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) doc_perl_install :: all $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLPRIVLIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> $(DESTINSTALLARCHLIB)/perllocal.pod doc_site_install :: all $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLSITELIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> $(DESTINSTALLARCHLIB)/perllocal.pod doc_vendor_install :: all $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLVENDORLIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ >> $(DESTINSTALLARCHLIB)/perllocal.pod uninstall :: uninstall_from_$(INSTALLDIRS)dirs $(NOECHO) $(NOOP) uninstall_from_perldirs :: $(NOECHO) $(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist uninstall_from_sitedirs :: $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist uninstall_from_vendordirs :: $(NOECHO) $(UNINSTALL) $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist # --- MakeMaker force section: # Phony target to force checking subdirectories. FORCE : $(NOECHO) $(NOOP) # --- MakeMaker perldepend section: # --- MakeMaker makefile section: # We take a very conservative approach here, but it's worth it. # We move Makefile to Makefile.old here to avoid gnu make looping. $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) $(PERLRUN) Makefile.PL $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" $(FALSE) # --- MakeMaker staticmake section: # --- MakeMaker makeaperl section --- MAP_TARGET = perl FULLPERL = /Users/daisuke/.plenv/versions/5.16/bin/perl $(MAP_TARGET) :: static $(MAKE_APERL_FILE) $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) $(NOECHO) $(PERLRUNINST) \ Makefile.PL DIR= \ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= # --- MakeMaker test section: TEST_VERBOSE=0 TEST_TYPE=test_$(LINKTYPE) TEST_FILE = test.pl TEST_FILES = t/*.t t/*/*.t TESTDB_SW = -d testdb :: testdb_$(LINKTYPE) test :: $(TEST_TYPE) subdirs-test subdirs-test :: $(NOECHO) $(NOOP) test_dynamic :: pure_all PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), 'inc', '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) testdb_dynamic :: pure_all PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-Iinc" "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) test_ : test_dynamic test_static :: test_dynamic testdb_static :: testdb_dynamic # --- MakeMaker ppd section: # Creates a PPD (Perl Package Description) for a binary distribution. ppd : $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd $(NOECHO) $(ECHO) ' JSON RPC 2.0 Server Implementation' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' Daisuke Maki' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd # --- MakeMaker pm_to_blib section: pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM) $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \ lib/JSON/RPC/Legacy/Server.pm blib/lib/JSON/RPC/Legacy/Server.pm \ lib/JSON/RPC/Legacy/Server/Daemon.pm blib/lib/JSON/RPC/Legacy/Server/Daemon.pm \ lib/JSON/RPC/Legacy/Server/Apache2.pm blib/lib/JSON/RPC/Legacy/Server/Apache2.pm \ lib/JSON/RPC.pm blib/lib/JSON/RPC.pm \ lib/JSON/RPC/Constants.pm blib/lib/JSON/RPC/Constants.pm \ lib/JSON/RPC/Procedure.pm blib/lib/JSON/RPC/Procedure.pm \ lib/JSON/RPC/Parser.pm blib/lib/JSON/RPC/Parser.pm \ lib/JSON/RPC/Legacy/Client.pm blib/lib/JSON/RPC/Legacy/Client.pm \ lib/JSON/RPC/Legacy.pm blib/lib/JSON/RPC/Legacy.pm \ lib/JSON/RPC/Legacy/Procedure.pm blib/lib/JSON/RPC/Legacy/Procedure.pm \ lib/JSON/RPC/Dispatch.pm blib/lib/JSON/RPC/Dispatch.pm \ lib/JSON/RPC/Legacy/Server/CGI.pm blib/lib/JSON/RPC/Legacy/Server/CGI.pm \ lib/JSON/RPC/Test.pm blib/lib/JSON/RPC/Test.pm $(NOECHO) $(TOUCH) pm_to_blib # --- MakeMaker selfdocument section: # --- MakeMaker postamble section: # End. # Postamble by Module::Install 1.06 README.md100644000766000024 1642012414644342 13420 0ustar00JP11194staff000000000000JSON-RPC-1.06# NAME JSON::RPC - JSON RPC 2.0 Server Implementation # SYNOPSIS # app.psgi use strict; use JSON::RPC::Dispatch; my $dispatch = JSON::RPC::Dispatch->new( prefix => "MyApp::JSONRPC::Handler", router => Router::Simple->new( ... ) ); sub { my $env = shift; $dispatch->handle_psgi($env); }; # DESCRIPTION JSON::RPC is a set of modules that implement JSON RPC 2.0 protocol. If you are using old JSON::RPC code (up to 0.96), DO NOT EXPECT YOUR CODE TO WORK WITH THIS VERSION. THIS VERSION IS ****BACKWARDS INCOMPATIBLE**** # BASIC USAGE The JSON::RPC::Dispatch object is responsible for marshalling the request. my $dispatch = JSON::RPC::Dispatch->new( router => ..., ); The routing between the JSON RPC methods and their implementors are handled by Router::Simple. For example, if you want to map method "foo" to a "MyApp::JSONRPC::Handler" object instance's "handle\_foo" method, you specify something like the following in your router instance: use Router::Simple::Declare; my $router = router { connect "foo" => { handler => "+MyApp::JSONRPC::Handler", action => "handle_foo" }; }; my $dispatch = JSON::RPC::Dispatch->new( router => $router, ); The "+" prefix in the handler classname denotes that it is already a fully qualified classname. Without the prefix, the value of "prefix" in the dispatch object will be used to qualify the classname. If you specify it in your Dispatch instance, you may omit the prefix part to save you some typing: use JSON::RPC::Dispatch; use Router::Simple::Declare; my $router = router { connect "foo" => { handler => "Foo", action => "process", }; connect "bar" => { handler => "Bar", action => "process" } }; my $dispatch = JSON::RPC::Dispatch->new( prefix => "MyApp::JSONRPC::Handler", router => $router, ); # The above will roughly translate to the following: # # for method "foo" # my $handler = MyApp::JSONRPC::Handler::Foo->new; # $handler->process( ... ); # # for method "bar" # my $handler = MyApp::JSONRPC::Handler::Bar->new; # $handler->process( ... ); The implementors are called handlers. Handlers are simple objects, and will be instantiated automatically for you. Their return values are converted to JSON objects automatically. You may also choose to pass objects in the handler argument to connect in your router. This will save you the cost of instantiating the handler object, and you also don't have to rely on us instantiating your handler object. use Router::Simple::Declare; use MyApp::JSONRPC::Handler; my $handler = MyApp::JSONRPC::Handler->new; my $router = router { connect "foo" => { handler => $handler, action => "handle_foo" }; }; # HANDLERS Your handlers are objects responsible for returning some sort of reference structure that can be properly encoded via JSON/JSON::XS. The handler only needs to implement the methods that you specified in your router. The handler methods will receive the following parameters: sub your_handler_method { my ($self, $params, $procedure, @extra_args) = @_; return $some_structure; } In most cases you will only need the parameters. The exact format of the $params is dependent on the caller -- you will be passed whatever JSON structure that caller used to call your handler. $procedure is an instance of JSON::RPC::Procedure. Use it if you need to figure out more about the procedure. @extra\_args is optional, and will be filled with whatever extra arguments you passed to handle\_psgi(). For example, # app.psgi sub { $dispatch->handle_psgi($env, "arg1", "arg2", "arg3"); } will cause your handlers to receive the following arguments: sub your_handler_method { my ($self, $params, $procedure, $arg1, $arg2, $arg3) = @_; } This is convenient if you have application-specific data that needs to be passed to your handlers. # EMBED IT IN YOUR WEBAPP If you already have a web app (and whatever framework you might already have), you may choose to embed JSON::RPC in your webapp instead of directly calling it in your PSGI application. For example, if you would like to your webapp's "rpc" handler to marshall the JSON RPC request, you can do something like the following: package MyApp; use My::Favorite::WebApp; sub rpc { my ($self, $context) = @_; my $dispatch = ...; # grab it from somewhere $dispatch->handle_psgi( $context->env ); } # ERRORS When your handler dies, it is automatically included in the response hash, unless no response was requested (see ["NOTIFICATIONS"](#notifications)). For example, something like below sub rpc { ... if ($bad_thing_happend) { die "Argh! I failed!"; } } Would result in a response like { error => { code => -32603, message => "Argh! I failed! at ...", } } However, you can include custom data by die()'ing with a hash: sub rpc { ... if ($bad_thing_happend) { die { message => "Argh! I failed!", data => time() }; } } This would result in: { error => { code => -32603, message => "Argh! I failed! at ...", data => 1339817722, } } # NOTIFICATIONS Notifications are defined as procedures without an id. Notification handling does not produce a response. When all procedures are notifications no content is returned (if the request is valid). To maintain some basic compatibility with relaxed client implementations, JSON::RPC::Dispatch includes responses when procedures do not have a "jsonrpc" field set to "2.0". Note that no error is returned in response to a notification when the handler dies or when the requested method is not available. For example, a request structure like this: [ {"jsonrpc": "2.0", "method": "sum", "params": [1,2,4], "id": "1"}, {"jsonrpc": "2.0", "method": "notify_hello", "params": [7]}, {"jsonrpc": "2.0", "method": "keep_alive"}, {"jsonrpc": "2.0", "method": "get_data", "id": "9"} ] Would result in a response like [ {"jsonrpc": "2.0", "result": 7, "id": "1"}, {"jsonrpc": "2.0", "result": ["hello", 5], "id": "9"} ] # BACKWARDS COMPATIBILITY Eh, not compatible at all. JSON RPC 0.xx was fine, but it predates PSGI, and things are just... different before and after PSGI. Code at version 0.96 has been moved to JSON::RPC::Legacy namespace, so change your application to use JSON::RPC::Legacy if you were using the old version. # AUTHORS Daisuke Maki Shinichiro Aska Yoshimitsu Torii # AUTHOR EMERITUS Makamaka Hannyaharamitu, - JSON::RPC modules up to 0.96 # COPYRIGHT AND LICENSE The JSON::RPC module is Copyright (C) 2011 by Daisuke Maki This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. See JSON::RPC::Legacy for copyrights and license for previous versions. cpanfile100644000766000024 60212414644342 13600 0ustar00JP11194staff000000000000JSON-RPC-1.06requires 'CGI'; requires 'Class::Accessor::Lite'; requires 'HTTP::Request'; requires 'HTTP::Response'; requires 'JSON'; requires 'LWP::UserAgent'; requires 'Plack'; requires 'Router::Simple'; requires 'parent'; recommends 'JSON::XS'; on build => sub { requires 'ExtUtils::MakeMaker', '6.36'; requires 'Plack::Request'; requires 'Plack::Test'; requires 'Test::More'; }; RPC.pm100644000766000024 1661212414644342 14445 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSONpackage JSON::RPC; use strict; our $VERSION = '1.06'; 1; __END__ =head1 NAME JSON::RPC - JSON RPC 2.0 Server Implementation =head1 SYNOPSIS # app.psgi use strict; use JSON::RPC::Dispatch; my $dispatch = JSON::RPC::Dispatch->new( prefix => "MyApp::JSONRPC::Handler", router => Router::Simple->new( ... ) ); sub { my $env = shift; $dispatch->handle_psgi($env); }; =head1 DESCRIPTION JSON::RPC is a set of modules that implement JSON RPC 2.0 protocol. If you are using old JSON::RPC code (up to 0.96), DO NOT EXPECT YOUR CODE TO WORK WITH THIS VERSION. THIS VERSION IS ****BACKWARDS INCOMPATIBLE**** =head1 BASIC USAGE The JSON::RPC::Dispatch object is responsible for marshalling the request. my $dispatch = JSON::RPC::Dispatch->new( router => ..., ); The routing between the JSON RPC methods and their implementors are handled by Router::Simple. For example, if you want to map method "foo" to a "MyApp::JSONRPC::Handler" object instance's "handle_foo" method, you specify something like the following in your router instance: use Router::Simple::Declare; my $router = router { connect "foo" => { handler => "+MyApp::JSONRPC::Handler", action => "handle_foo" }; }; my $dispatch = JSON::RPC::Dispatch->new( router => $router, ); The "+" prefix in the handler classname denotes that it is already a fully qualified classname. Without the prefix, the value of "prefix" in the dispatch object will be used to qualify the classname. If you specify it in your Dispatch instance, you may omit the prefix part to save you some typing: use JSON::RPC::Dispatch; use Router::Simple::Declare; my $router = router { connect "foo" => { handler => "Foo", action => "process", }; connect "bar" => { handler => "Bar", action => "process" } }; my $dispatch = JSON::RPC::Dispatch->new( prefix => "MyApp::JSONRPC::Handler", router => $router, ); # The above will roughly translate to the following: # # for method "foo" # my $handler = MyApp::JSONRPC::Handler::Foo->new; # $handler->process( ... ); # # for method "bar" # my $handler = MyApp::JSONRPC::Handler::Bar->new; # $handler->process( ... ); The implementors are called handlers. Handlers are simple objects, and will be instantiated automatically for you. Their return values are converted to JSON objects automatically. You may also choose to pass objects in the handler argument to connect in your router. This will save you the cost of instantiating the handler object, and you also don't have to rely on us instantiating your handler object. use Router::Simple::Declare; use MyApp::JSONRPC::Handler; my $handler = MyApp::JSONRPC::Handler->new; my $router = router { connect "foo" => { handler => $handler, action => "handle_foo" }; }; =head1 HANDLERS Your handlers are objects responsible for returning some sort of reference structure that can be properly encoded via JSON/JSON::XS. The handler only needs to implement the methods that you specified in your router. The handler methods will receive the following parameters: sub your_handler_method { my ($self, $params, $procedure, @extra_args) = @_; return $some_structure; } In most cases you will only need the parameters. The exact format of the $params is dependent on the caller -- you will be passed whatever JSON structure that caller used to call your handler. $procedure is an instance of JSON::RPC::Procedure. Use it if you need to figure out more about the procedure. @extra_args is optional, and will be filled with whatever extra arguments you passed to handle_psgi(). For example, # app.psgi sub { $dispatch->handle_psgi($env, "arg1", "arg2", "arg3"); } will cause your handlers to receive the following arguments: sub your_handler_method { my ($self, $params, $procedure, $arg1, $arg2, $arg3) = @_; } This is convenient if you have application-specific data that needs to be passed to your handlers. =head1 EMBED IT IN YOUR WEBAPP If you already have a web app (and whatever framework you might already have), you may choose to embed JSON::RPC in your webapp instead of directly calling it in your PSGI application. For example, if you would like to your webapp's "rpc" handler to marshall the JSON RPC request, you can do something like the following: package MyApp; use My::Favorite::WebApp; sub rpc { my ($self, $context) = @_; my $dispatch = ...; # grab it from somewhere $dispatch->handle_psgi( $context->env ); } =head1 ERRORS When your handler dies, it is automatically included in the response hash, unless no response was requested (see L). For example, something like below sub rpc { ... if ($bad_thing_happend) { die "Argh! I failed!"; } } Would result in a response like { error => { code => -32603, message => "Argh! I failed! at ...", } } However, you can include custom data by die()'ing with a hash: sub rpc { ... if ($bad_thing_happend) { die { message => "Argh! I failed!", data => time() }; } } This would result in: { error => { code => -32603, message => "Argh! I failed! at ...", data => 1339817722, } } =head1 NOTIFICATIONS Notifications are defined as procedures without an id. Notification handling does not produce a response. When all procedures are notifications no content is returned (if the request is valid). To maintain some basic compatibility with relaxed client implementations, JSON::RPC::Dispatch includes responses when procedures do not have a "jsonrpc" field set to "2.0". Note that no error is returned in response to a notification when the handler dies or when the requested method is not available. For example, a request structure like this: [ {"jsonrpc": "2.0", "method": "sum", "params": [1,2,4], "id": "1"}, {"jsonrpc": "2.0", "method": "notify_hello", "params": [7]}, {"jsonrpc": "2.0", "method": "keep_alive"}, {"jsonrpc": "2.0", "method": "get_data", "id": "9"} ] Would result in a response like [ {"jsonrpc": "2.0", "result": 7, "id": "1"}, {"jsonrpc": "2.0", "result": ["hello", 5], "id": "9"} ] =head1 BACKWARDS COMPATIBILITY Eh, not compatible at all. JSON RPC 0.xx was fine, but it predates PSGI, and things are just... different before and after PSGI. Code at version 0.96 has been moved to JSON::RPC::Legacy namespace, so change your application to use JSON::RPC::Legacy if you were using the old version. =head1 AUTHORS Daisuke Maki Shinichiro Aska Yoshimitsu Torii =head1 AUTHOR EMERITUS Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE - JSON::RPC modules up to 0.96 =head1 COPYRIGHT AND LICENSE The JSON::RPC module is Copyright (C) 2011 by Daisuke Maki This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. See JSON::RPC::Legacy for copyrights and license for previous versions. =cut Constants.pm100644000766000024 227512414644342 16401 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPCpackage JSON::RPC::Constants; use strict; use parent qw(Exporter); our @EXPORT_OK = qw( JSONRPC_DEBUG RPC_PARSE_ERROR RPC_INVALID_REQUEST RPC_METHOD_NOT_FOUND RPC_INVALID_PARAMS RPC_INTERNAL_ERROR ); our %EXPORT_TAGS = (all => \@EXPORT_OK); my %constants; BEGIN { %constants = ( JSONRPC_DEBUG => $ENV{PERL_JSONRPC_DEBUG} ? 1 : 0, RPC_PARSE_ERROR => -32700, RPC_INVALID_REQUEST => -32600, RPC_METHOD_NOT_FOUND => -32601, RPC_INVALID_PARAMS => -32602, RPC_INTERNAL_ERROR => -32603, ); require constant; constant->import( \%constants ); } 1; __END__ =head1 NAME JSON::RPC::Constants - Constants =head1 SYNOPSIS use JSON::RPC::Constants qw(:all); # or, import one by one =head1 DEBUG =over 4 =item B Set to true if PERL_JSONRPC_DEBUG environmental variable is set to a value that evaluates to true. False otherwise. This controls debug output of the module. =back =head1 JSON RPC VALUES These values are defined as per JSON RPC RFC. =head2 RPC_PARSE_ERROR =head2 RPC_INVALID_REQUEST =head2 RPC_METHOD_NOT_FOUND =head2 RPC_INVALID_PARAMS =head2 RPC_INTERNAL_ERROR =cut Dispatch.pm100644000766000024 1646712414644342 16214 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPCpackage JSON::RPC::Dispatch; use strict; use JSON::RPC::Constants qw(:all); use JSON::RPC::Parser; use JSON::RPC::Procedure; use Router::Simple; use Scalar::Util; use Try::Tiny; use Class::Accessor::Lite rw => [ qw( coder handlers parser prefix router ) ] ; sub new { my ($class, @args) = @_; my $self = bless { handlers => {}, @args, }, $class; if (! $self->{coder}) { require JSON; $self->{coder} = JSON->new->utf8; } if (! $self->{parser}) { $self->{parser} = JSON::RPC::Parser->new( coder => $self->coder ) } if (! $self->{router}) { $self->{router} = Router::Simple->new; } return $self; } sub guess_handler_class { my ($self, $klass) = @_; my $prefix = $self->prefix || ''; return "$prefix\::$klass"; } sub construct_handler { my ($self, $klass) = @_; my $handler = $self->handlers->{ $klass }; if (! $handler) { eval "require $klass"; die if $@; $handler = $klass->new(); $self->handlers->{$klass} = $handler; } return $handler; } sub get_handler { my ($self, $klass) = @_; if ( Scalar::Util::blessed( $klass )){ if (JSONRPC_DEBUG > 1) { warn "Handler is already object : $klass"; } return $klass; } if ($klass !~ s/^\+//) { $klass = $self->guess_handler_class( $klass ); } my $handler = $self->construct_handler( $klass ); if (JSONRPC_DEBUG > 1) { warn "$klass -> $handler"; } return $handler; } sub handle_psgi { my ($self, $req, @args) = @_; if ( ! Scalar::Util::blessed($req) ) { # assume it's a PSGI hash require Plack::Request; $req = Plack::Request->new($req); } my $is_batch = 0; my @response; my $procedures; try { $procedures = $self->parser->construct_from_req( $req ); if (ref $procedures eq 'ARRAY') { $is_batch = 1; } else { $procedures = [$procedures]; } if (@$procedures <= 0 || not defined $procedures->[0]) { $is_batch = 0; push @response, { error => { code => RPC_INVALID_REQUEST, message => "Could not find any procedures" } }; } } catch { my $e = $_; if (JSONRPC_DEBUG) { warn "error while creating jsonrpc request: $e"; } if ($e =~ /Invalid parameter/) { push @response, { error => { code => RPC_INVALID_PARAMS, message => "Invalid parameters", } }; } elsif ( $e =~ /parse error/ ) { push @response, { error => { code => RPC_PARSE_ERROR, message => "Failed to parse json", } }; } else { push @response, { error => { code => RPC_INVALID_REQUEST, message => $e } } } }; my $router = $self->router; foreach my $procedure (@$procedures) { if ( ! $procedure->{method} ) { my $message = "Procedure name not given"; if (JSONRPC_DEBUG) { warn $message; } push @response, { error => { code => RPC_METHOD_NOT_FOUND, message => $message, } }; next; } my $is_notification = defined $procedure->jsonrpc && $procedure->jsonrpc eq '2.0' && !$procedure->has_id; my $matched = $router->match( $procedure->{method} ); if (! $matched) { my $message = "Procedure '$procedure->{method}' not found"; if (JSONRPC_DEBUG) { warn $message; } if (!$is_notification) { # must not respond to a valid JSON-RPC notification push @response, { error => { code => RPC_METHOD_NOT_FOUND, message => $message, } }; } next; } my $action = $matched->{action}; try { my ($ip, $ua); if (JSONRPC_DEBUG > 1) { warn "Procedure '$procedure->{method}' maps to action $action"; $ip = $req->address || 'N/A'; $ua = $req->user_agent || 'N/A'; } my $params = $procedure->params; my $handler = $self->get_handler( $matched->{handler} ); my $code = $handler->can( $action ); if (! $code) { if ( JSONRPC_DEBUG ) { warn "[INFO] handler $handler does not implement method $action!."; } die "Internal Error"; } my $result = $code->( $handler, $procedure->params, $procedure, @args ); if (JSONRPC_DEBUG) { warn "[INFO] action=$action " . "params=[" . (ref $params ? $self->{coder}->encode($params) : $params) . "] ret=" . (ref $result ? $self->{coder}->encode($result) : $result) . " IP=$ip UA=$ua"; } # respond unless we are sure a procedure is a notification if (!$is_notification) { push @response, { jsonrpc => '2.0', result => $result, id => $procedure->id, }; } } catch { my $e = $_; if (JSONRPC_DEBUG) { warn "Error while executing $action: $e"; } # can't respond to notifications even in case of errors if (!$is_notification) { my $error = {code => RPC_INTERNAL_ERROR} ; if (ref $e eq "HASH") { $error->{message} = $e->{message}, $error->{data} = $e->{data}, } else { $error->{message} = $e, } push @response, { jsonrpc => '2.0', id => $procedure->id, error => $error, }; } }; } my $res; if (scalar @response) { $res = $req->new_response(200); $res->content_type( 'application/json; charset=utf8' ); $res->body( $self->coder->encode( ($is_batch) ? \@response : $response[0] ) ); return $res->finalize; } else { # no content $res = $req->new_response(204); } return $res->finalize; } no Try::Tiny; 1; __END__ =head1 NAME JSON::RPC::Dispatch - Dispatch JSON RPC Requests To Handlers =head1 SYNOPSIS use JSON::RPC::Dispatch; my $router = Router::Simple->new; # or use Router::Simple::Declare $router->connect( method_name => { handler => $class_name_or_instance, action => $method_name_to_invoke ); my $dispatch = JSON::RPC::Dispatch->new( router => $router ); sub psgi_app { $dispatch->handle_psgi( $env ); } =head1 DESCRIPTION See docs in L for details =cut Legacy.pm100644000766000024 556112414644342 15632 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPCpackage JSON::RPC::Legacy; use strict; 1; __END__ =pod =head1 NAME JSON::RPC - Perl implementation of JSON-RPC 1.1 protocol =head1 DESCRIPTION JSON-RPC is a stateless and light-weight remote procedure call (RPC) protocol for inter-networking applications over HTTP. It uses JSON as the data format for of all facets of a remote procedure call, including all application data carried in parameters. quoted from L. This module was in JSON package on CPAN before. Now its interfaces was completely changed. The old modules - L and L are deprecated. Please try to use JSON::RPC::Server and JSON::RPC::Client which support both JSON-RPC protocol version 1.1 and 1.0. =head1 EXAMPLES CGI version. #-------------------------- # In your application class package MyApp; use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than sub echo : Public { # new version style. called by clients # first argument is JSON::RPC::Server object. return $_[1]; } sub sum : Public(a:num, b:num) { # sets value into object member a, b. my ($s, $obj) = @_; # return a scalar value or a hashref or an arryaref. return $obj->{a} + $obj->{b}; } sub a_private_method : Private { # ... can't be called by client } sub sum_old_style { # old version style. taken as Public my ($s, @arg) = @_; return $arg[0] + $arg[1]; } #-------------------------- # In your triger script. use JSON::RPC::Server::CGI; use MyApp; # simple JSON::RPC::Server::CGI->dispatch('MyApp')->handle(); # or JSON::RPC::Server::CGI->dispatch([qw/MyApp FooBar/])->handle(); # or INFO_PATH version JSON::RPC::Server::CGI->dispatch({'/Test' => 'MyApp'})->handle(); #-------------------------- # Client use JSON::RPC::Client; my $client = new JSON::RPC::Client; my $uri = 'http://www.example.com/jsonrpc/Test'; my $obj = { method => 'sum', # or 'MyApp.sum' params => [10, 20], }; my $res = $client->call( $uri, $obj ) if($res){ if ($res->is_error) { print "Error : ", $res->error_message; } else { print $res->result; } } else { print $client->status_line; } # or $client->prepare($uri, ['sum', 'echo']); print $client->sum(10, 23); See to L, L, L L and L. =head1 ABOUT NEW VERSION =over =item supports JSON-RPC protocol v1.1 =back =head1 TODO =over =item Document =item Examples =item More Tests =back =head1 AUTHOR Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2007-2008 by Makamaka Hannyaharamitu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Client.pm100644000766000024 2231712414644342 17066 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPC/Legacy############################################################################## # JSONRPC version 1.1 # http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html ############################################################################## use strict; use JSON (); use Carp (); ############################################################################## package JSON::RPC::Legacy::Client; $JSON::RPC::Legacy::Client::VERSION = '1.06'; use LWP::UserAgent; BEGIN { for my $method (qw/uri ua json content_type version id allow_call status_line/) { eval qq| sub $method { \$_[0]->{$method} = \$_[1] if defined \$_[1]; \$_[0]->{$method}; } |; } } sub AUTOLOAD { my $self = shift; my $method = $JSON::RPC::Legacy::Client::AUTOLOAD; $method =~ s/.*:://; return if ($method eq 'DESTROY'); $method =~ s/^__(\w+)__$/$1/; # avoid to call built-in methods (ex. __VERSION__ => VERSION) unless ( exists $self->allow_call->{ $method } ) { Carp::croak("Can't call the method not allowed by prepare()."); } my @params = @_; my $obj = { method => $method, params => (ref $_[0] ? $_[0] : [@_]), }; my $ret = $self->call($self->uri, $obj); if ( $ret and $ret->is_success ) { return $ret->result; } else { Carp::croak ( $ret ? '(Procedure error) ' . $ret->error_message : $self->status_line ); } } sub create_json_coder { JSON->new->allow_nonref->utf8; } sub new { my $proto = shift; my $self = bless {}, (ref $proto ? ref $proto : $proto); my $ua = LWP::UserAgent->new( agent => 'JSON::RPC::Legacy::Client/' . $JSON::RPC::Legacy::Client::VERSION . ' beta ', timeout => 10, ); $self->ua($ua); $self->json( $proto->create_json_coder ); $self->version('1.1'); $self->content_type('application/json'); return $self; } sub prepare { my ($self, $uri, $procedures) = @_; $self->uri($uri); $self->allow_call({ map { ($_ => 1) } @$procedures }); } sub call { my ($self, $uri, $obj) = @_; my $result; if ($uri =~ /\?/) { $result = $self->_get($uri); } else { Carp::croak "not hashref." unless (ref $obj eq 'HASH'); $result = $self->_post($uri, $obj); } my $service = $obj->{method} =~ /^system\./ if ( $obj ); $self->status_line($result->status_line); return unless($result->content); # notification? if ($service) { return JSON::RPC::Legacy::ServiceObject->new($result, $self->json); } return JSON::RPC::Legacy::ReturnObject->new($result, $self->json); } sub _post { my ($self, $uri, $obj) = @_; my $json = $self->json; $obj->{version} ||= $self->{version} || '1.1'; if ($obj->{version} eq '1.0') { delete $obj->{version}; if (exists $obj->{id}) { $self->id($obj->{id}) if ($obj->{id}); # if undef, it is notification. } else { $obj->{id} = $self->id || ($self->id('JSON::RPC::Legacy::Client')); } } else { $obj->{id} = $self->id if (defined $self->id); } my $content = $json->encode($obj); $self->ua->post( $uri, Content_Type => $self->{content_type}, Content => $content, Accept => 'application/json', ); } sub _get { my ($self, $uri) = @_; $self->ua->get( $uri, Accept => 'application/json', ); } ############################################################################## package JSON::RPC::Legacy::ReturnObject; $JSON::RPC::Legacy::ReturnObject::VERSION = $JSON::RPC::Legacy::VERSION; BEGIN { for my $method (qw/is_success content jsontext version/) { eval qq| sub $method { \$_[0]->{$method} = \$_[1] if defined \$_[1]; \$_[0]->{$method}; } |; } } sub new { my ($class, $obj, $json) = @_; my $content = ( $json || JSON->new->utf8 )->decode( $obj->content ); my $self = bless { jsontext => $obj->content, content => $content, }, $class; $content->{error} ? $self->is_success(0) : $self->is_success(1); $content->{version} ? $self->version(1.1) : $self->version(0) ; $self; } sub is_error { !$_[0]->is_success; } sub error_message { $_[0]->version ? $_[0]->{content}->{error}->{message} : $_[0]->{content}->{error}; } sub result { $_[0]->{content}->{result}; } ############################################################################## package JSON::RPC::Legacy::ServiceObject; use base qw(JSON::RPC::Legacy::ReturnObject); sub sdversion { $_[0]->{content}->{sdversion} || ''; } sub name { $_[0]->{content}->{name} || ''; } sub result { $_[0]->{content}->{summary} || ''; } 1; __END__ =pod =head1 NAME JSON::RPC::Legacy::Client - Perl implementation of JSON-RPC client =head1 SYNOPSIS use JSON::RPC::Legacy::Client; my $client = new JSON::RPC::Legacy::Client; my $url = 'http://www.example.com/jsonrpc/API'; my $callobj = { method => 'sum', params => [ 17, 25 ], # ex.) params => { a => 20, b => 10 } for JSON-RPC v1.1 }; my $res = $client->call($uri, $callobj); if($res) { if ($res->is_error) { print "Error : ", $res->error_message; } else { print $res->result; } } else { print $client->status_line; } # Easy access $client->prepare($uri, ['sum', 'echo']); print $client->sum(10, 23); =head1 DESCRIPTION This is JSON-RPC Client. See L. Gets a perl object and convert to a JSON request data. Sends the request to a server. Gets a response returned by the server. Converts the JSON response data to the perl object. =head1 JSON::RPC::Legacy::Client =head2 METHODS =over =item $client = JSON::RPC::Legacy::Client->new Creates new JSON::RPC::Legacy::Client object. =item $response = $client->call($uri, $procedure_object) Calls to $uri with $procedure_object. The request method is usually C. If $uri has query string, method is C. About 'GET' method, see to L. Return value is L. =item $client->prepare($uri, $arrayref_of_procedure) Allow to call methods in contents of $arrayref_of_procedure. Then you can call the prepared methods with an array reference or a list. The return value is a result part of JSON::RPC::Legacy::ReturnObject. $client->prepare($uri, ['sum', 'echo']); $res = $client->echo('foobar'); # $res is 'foobar'. $res = $client->sum(10, 20); # sum up $res = $client->sum( [10, 20] ); # same as above If you call a method which is not prepared, it will C. Currently, B. =item version Sets the JSON-RPC protocol version. 1.1 by default. =item id Sets a request identifier. In JSON-RPC 1.1, it is optional. If you set C 1.0 and don't set id, the module sets 'JSON::RPC::Legacy::Client' to it. =item ua Setter/getter to L object. =item json Setter/getter to the JSON coder object. Default is L, likes this: $self->json( JSON->new->allow_nonref->utf8 ); $json = $self->json; This object serializes/deserializes JSON data. By default, returned JSON data assumes UTF-8 encoded. =item status_line Returns status code; After C a remote procedure, the status code is set. =item create_json_coder (Class method) Returns a JSON de/encoder in C. You can override it to use your favorite JSON de/encoder. =back =head1 JSON::RPC::Legacy::ReturnObject C method or the methods set by C returns this object. (The returned JSON data is decoded by the JSON coder object which was passed by the client object.) =head2 METHODS =over =item is_success If the call is successful, returns a true, otherwise a false. =item is_error If the call is not successful, returns a true, otherwise a false. =item error_message If the response contains an error message, returns it. =item result Returns the result part of a data structure returned by the called server. =item content Returns the whole data structure returned by the called server. =item jsontext Returns the row JSON data. =item version Returns the version of this response data. =back =head1 JSON::RPC::Legacy::ServiceObject =head1 RESERVED PROCEDURE When a client call a procedure (method) name 'system.foobar', JSON::RPC::Legacy::Server look up MyApp::system::foobar. L L There is JSON::RPC::Legacy::Server::system::describe for default response of 'system.describe'. =head1 SEE ALSO L L =head1 AUTHOR Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2007-2008 by Makamaka Hannyaharamitu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Procedure.pm100644000766000024 657712414644342 17572 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPC/Legacypackage JSON::RPC::Legacy::Procedure; # # http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html # $JSON::RPC::Legacy::Procedure::VERSION = '1.06'; use strict; use attributes; use Carp (); my $Procedure = {}; sub check { $Procedure->{$_[0]} ? attributes::get($_[1]) : {}; } sub FETCH_CODE_ATTRIBUTES { my ($pkg, $code) = @_; my $procedure = $Procedure->{$pkg}{$code} || { return_type => undef, argument_type => undef }; return { return_type => $procedure->{return_type}, argument_type => $procedure->{argument_type}, }; } sub MODIFY_CODE_ATTRIBUTES { my ($pkg, $code, $attr) = @_; my ($ret_type, $args); if ($attr =~ /^([A-Z][a-z]+)(?:\(\s*([^)]*)\s*\))?$/) { $ret_type = $1 if (defined $1); $args = $2 if (defined $2); } unless ($ret_type =~ /^Private|Public|Arr|Obj|Bit|Bool|Num|Str|Nil|None/) { Carp::croak("Invalid type '$attr'. Specify 'Parivate' or 'Public' or One of JSONRPC Return Types."); } if ($ret_type ne 'Private' and defined $args) { $Procedure->{$pkg}{$code}{argument_type} = _parse_argument_type($args); } $Procedure->{$pkg}{$code}{return_type} = $ret_type; return; } sub _parse_argument_type { my $text = shift; my $declaration; my $pos; my $name; $text =~ /^([,: a-zA-Z0-9]*)?$/; unless ( defined($declaration = $1) ) { Carp::croak("Invalid argument type."); } my @args = split/\s*,\s*/, $declaration; my $i = 0; $pos = []; $name = {}; for my $arg (@args) { if ($arg =~ /([_0-9a-zA-Z]+)(?::([a-z]+))?/) { push @$pos, $1; $name->{$1} = $2; } } return { position => $pos, names => $name, }; } 1; __END__ =pod =head1 NAME JSON::RPC::Legacy::Procedure - JSON-RPC Service attributes =head1 SYNOPSIS package MyApp; use base ('JSON::RPC::Legacy::Procedure'); sub sum : Public { my ($s, @arg) = @_; return $arg[0] + $arg[1]; } # or sub sum : Public(a, b) { my ($s, $obj) = @_; return $obj->{a} + $obj->{b}; } # or sub sum : Number(a:num, b:num) { my ($s, $obj) = @_; return $obj->{a} + $obj->{b}; } # private method can't be called by clients sub _foobar : Private { # ... } =head1 DESCRIPTION Using this module, you can write a subroutine with a special attribute. Currently, in below attributes, only Public and Private are available. Others are same as Public. =over =item Public Means that a client can call this procedure. =item Private Means that a client can't call this procedure. =item Arr Means that its return values is an array object. =item Obj Means that its return values is a member object. =item Bit =item Bool Means that a return values is a C or C. =item Num Means that its return values is a number. =item Str Means that its return values is a string. =item Nil =item None Means that its return values is a C. =back =head1 TODO =over =item Auto Service Description =item Type check =back =head1 SEE ALSO L =head1 AUTHOR Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE =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 Server.pm100644000766000024 3564712414644342 17130 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPC/Legacy############################################################################## # JSONRPC version 1.1 # http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html ############################################################################## use strict; use JSON (); use Carp (); use HTTP::Request (); use HTTP::Response (); ############################################################################## package JSON::RPC::Legacy::Server; my $JSONRPC_Procedure_Able; BEGIN { if ($] >= 5.006) { require JSON::RPC::Legacy::Procedure; $JSONRPC_Procedure_Able = 1; } } $JSON::RPC::Legacy::Server::VERSION = '1.06'; BEGIN { for my $method (qw/request path_info json version error_message max_length charset content_type error_response_header return_die_message/) { eval qq| sub $method { \$_[0]->{$method} = \$_[1] if defined \$_[1]; \$_[0]->{$method}; } |; } } sub create_json_coder { JSON->new->utf8; # assumes UTF8 } sub new { my $class = shift; bless { max_length => 1024 * 100, charset => 'UTF-8', content_type => 'application/json', json => $class->create_json_coder, loaded_module => { name => {}, order => [], }, @_, }, $class; } *dispatch_to = *dispatch; # Alias sub dispatch { my ($self, @arg) = @_; if (@arg == 0){ Carp::carp "Run test mode..."; } elsif (@arg > 1) { for my $pkg (@arg) { $self->_load_module($pkg); } } else { if (ref $arg[0] eq 'ARRAY') { for my $pkg (@{$arg[0]}) { $self->_load_module($pkg); } } elsif (ref $arg[0] eq 'HASH') { # Lazy loading for my $path (keys %{$arg[0]}) { my $pkg = $arg[0]->{$path}; $self->{dispatch_path}->{$path} = $pkg; } } elsif (ref $arg[0]) { Carp::croak 'Invalid dispatch value.'; } else { # Single module $self->_load_module($arg[0]); } } $self; } sub handle { my ($self) = @_; my ($obj, $res, $jsondata); if ($self->request->method eq 'POST') { $jsondata = $self->retrieve_json_from_post(); } elsif ($self->request->method eq 'GET') { $jsondata = $self->retrieve_json_from_get(); } if ( $jsondata ) { $obj = eval q| $self->json->decode($jsondata) |; if ($@) { $self->raise_error(code => 201, message => "Can't parse JSON data."); } } else { # may have error_response_header at retroeve_json_from_post / get unless ($self->error_response_header) { $self->error_response_header($self->response_header(403, 'No data.')); } } if ($obj) { $res = $self->_handle($obj); unless ($self->error_response_header) { return $self->response( $self->response_header(200, $res) ); } } $self->response( $self->error_response_header ); } sub retrieve_json_from_post { } # must be implemented in subclass sub retrieve_json_from_get { } # must be implemented in subclass sub response { } # must be implemented in subclass sub raise_error { my ($self, %opt) = @_; my $status_code = $opt{status_code} || 200; if (exists $opt{version} and $opt{version} ne '1.1') { $self->version(0); } else { $self->version(1.1); } my $res = $self->_error($opt{id}, $opt{code}, $opt{message}); $self->error_response_header($self->response_header($status_code, $res)); return; } sub response_header { my ($self, $code, $result) = @_; my $h = HTTP::Headers->new; $h->header('Content-Type' => $self->content_type . '; charset=' . $self->charset); HTTP::Response->new($code => undef, $h, $result); } sub _handle { my ($self, $obj) = @_; $obj->{version} ? $self->version(1.1) : $self->version(0); my $method = $obj->{method}; if (!defined $method) { return $self->_error($obj->{id}, 300, "method is nothing."); } elsif ($method =~ /[^-._a-zA-Z0-9]/) { return $self->_error($obj->{id}, 301, "method is invalid."); } my $procedure = $self->_find_procedure($method); unless ($procedure) { return $self->_error($obj->{id}, 302, "No such a method : '$method'."); } my $params; unless ($obj->{version}) { unless ($obj->{params} and ref($obj->{params}) eq 'ARRAY') { return $self->_error($obj->{id}, 400, "Invalid params for JSONRPC 1.0."); } } unless ($params = $self->_argument_type_check($procedure->{argument_type}, $obj->{params})) { return $self->_error($obj->{id}, 401, $self->error_message); } my $result; if ($obj->{version}) { $result = ref $params ? eval q| $procedure->{code}->($self, $params) | : eval q| $procedure->{code}->($self) | ; } else { my @params; if(ref($params) eq 'ARRAY') { @params = @$params; } else { $params[0] = $params; } $result = eval q| $procedure->{code}->($self, @params) |; } if ($self->error_response_header) { return; } elsif ($@) { return $self->_error($obj->{id}, 500, ($self->return_die_message ? $@ : 'Procedure error.')); } if (!$obj->{version} and !defined $obj->{id}) { # notification return ''; } my $return_obj = {result => $result}; if ($obj->{version}) { $return_obj->{version} = '1.1'; } else { $return_obj->{error} = undef; $return_obj->{id} = $obj->{id}; } return $self->json->encode($return_obj); } sub _find_procedure { my ($self, $method) = @_; my $found; my $classname; my $system_call; if ($method =~ /^system\.(\w+)$/) { $system_call = 1; $method = $1; } elsif ($method =~ /\./) { my @p = split/\./, $method; $method = pop @p; $classname= join('::', @p); } if ($self->{dispatch_path}) { my $path = $self->{path_info}; if (my $pkg = $self->{dispatch_path}->{$path}) { return if ( $classname and $pkg ne $classname ); return if ( $JSONRPC_Procedure_Able and JSON::RPC::Legacy::Procedure->can( $method ) ); $self->_load_module($pkg); if ($system_call) { $pkg .= '::system' } return $self->_method_is_ebable($pkg, $method, $system_call); } } else { for my $pkg (@{$self->{loaded_module}->{order}}) { next if ( $classname and $pkg ne $classname ); next if ( $JSONRPC_Procedure_Able and JSON::RPC::Legacy::Procedure->can( $method ) ); if ($system_call) { $pkg .= '::system' } if ( my $ret = $self->_method_is_ebable($pkg, $method, $system_call) ) { return $ret; } } } return; } sub _method_is_ebable { my ($self, $pkg, $method, $system_call) = @_; my $allowable_procedure = $pkg->can('allowable_procedure'); my $code; if ( $allowable_procedure ) { if ( exists $allowable_procedure->()->{ $method } ) { $code = $allowable_procedure->()->{ $method }; } else { return; } } if ( $code or ( $code = $pkg->can($method) ) ) { return {code => $code} if ($system_call or !$JSONRPC_Procedure_Able); if ( my $procedure = JSON::RPC::Legacy::Procedure::check($pkg, $code) ) { return if ($procedure->{return_type} and $procedure->{return_type} eq 'Private'); $procedure->{code} = $code; return $procedure; } } if ($system_call) { # if not found, default system.foobar if ( my $code = 'JSON::RPC::Legacy::Server::system'->can($method) ) { return {code => $code}; } } return; } sub _argument_type_check { my ($self, $type, $params) = @_; unless (defined $type) { return defined $params ? $params : 1; } my $regulated; if (ref $params eq 'ARRAY') { if (@{$type->{position}} != @$params) { $self->error_message("Number of params is mismatch."); return; } if (my $hash = $type->{names}) { my $i = 0; for my $name (keys %$hash) { $regulated->{$name} = $params->[$i++]; } } } elsif (ref $params eq 'HASH') { if (@{$type->{position}} != keys %$params) { $self->error_message("Number of params is mismatch."); return; } if (my $hash = $type->{names}) { my $i = 0; for my $name (keys %$params) { if ($name =~ /^\d+$/) { my $realname = $type->{position}[$name]; $regulated->{$realname} = $params->{$name}; } else { $regulated->{$name} = $params->{$name}; } } } } elsif (!defined $params) { if (@{$type->{position}} != 0) { $self->error_message("Number of params is mismatch."); return; } return 1; } else { $self->error_message("the params member is any other type except JSON Object or Array."); return; } return $regulated ? $regulated : $params; } sub _load_module { my ($self, $pkg) = @_; eval qq| require $pkg |; if ($@) { Carp::croak $@; } $self->{loaded_module}->{name}->{$pkg} = $pkg; push @{ $self->{loaded_module}->{order} }, $pkg; } # Error Handling sub _error { my ($self, $id, $code, $message) = @_; if ($self->can('translate_error_message')) { $message = $self->translate_error_message($code, $message); } my $error_obj = { name => 'JSONRPCError', code => $code, message => $message, }; my $obj; if ($self->version) { $obj = { version => "1.1", error => $error_obj, }; $obj->{id} = $id if (defined $id); } else { return '' if (!defined $id); $obj = { result => undef, error => $message, id => $id, }; } return $self->json->encode($obj); } ############################################################################## package JSON::RPC::Legacy::Server::system; sub describe { { sdversion => "1.0", name => __PACKAGE__, summary => 'Default system description', } } 1; __END__ =pod =head1 NAME JSON::RPC::Server - Perl implementation of JSON-RPC sever =head1 SYNOPSIS # CGI version use JSON::RPC::Legacy::Server::CGI; my $server = JSON::RPC::Legacy::Server::CGI->new; $server->dispatch_to('MyApp')->handle(); # Apache version # In apache conf PerlRequire /your/path/start.pl PerlModule MyApp SetHandler perl-script PerlResponseHandler JSON::RPC::Legacy::Server::Apache PerlSetVar dispatch "MyApp" PerlSetVar return_die_message 0 # Daemon version use JSON::RPC::Legacy::Server::Daemon; JSON::RPC::Legacy::Server::Daemon->new(LocalPort => 8080); ->dispatch({'/jsonrpc/API' => 'MyApp'}) ->handle(); # FastCGI version use JSON::RPC::Legacy::Server::FastCGI; my $server = JSON::RPC::Legacy::Server::FastCGI->new; $server->dispatch_to('MyApp')->handle(); =head1 DESCRIPTION Gets a client request. Parses its JSON data. Passes the server object and the object decoded from the JSON data to your procedure (method). Takes your returned value (scalar or arrayref or hashref). Sends a response. Well, you write your procedure code only. =head1 METHODS =over =item new Creates new JSON::RPC::Legacy::Server object. =item dispatch($package) =item dispatch([$package1, $package1, ...]) =item dispatch({$path => $package, ...}) Sets your procedure module using package name list or arrayref or hashref. Hashref version is used for path_info access. =item dispatch_to An alias to C. =item handle Runs server object and returns a response. =item raise_error(%hash) return $server->raise_error( code => 501, message => "This is error in my procedure." ); Sets an error. An error code number in your procedure is an integer between 501 and 899. =item json Setter/Getter to json encoder/decoder object. The default value is L object in the below way: JSON->new->utf8 In your procedure, changes its behaviour. $server->json->utf8(0); The JSON coder creating method is C. =item version Setter/Getter to JSON-RPC protocol version used by a client. If version is 1.1, returns 1.1. Otherwise returns 0. =item charset Setter/Getter to charset. Default is 'UTF-8'. =item content_type Setter/Getter to content type. Default is 'application/json'. =item return_die_message When your program dies in your procedure, sends a return object with error message 'Procedure error' by default. If this option is set, uses C message. sub your_procedure { my ($s) = @_; $s->return_die_message(1); die "This is test."; } =item retrieve_json_from_post It is used by JSON::RPC::Legacy::Server subclass. =item retrieve_json_from_get In the protocol v1.1, 'GET' request method is also allowable. It is used by JSON::RPC::Legacy::Server subclass. =item response It is used by JSON::RPC::Legacy::Server subclass. =item request Returns L object. =item path_info Returns PATH_INFO. =item max_length Returns max content-length to your application. =item translate_error_message Implemented in your subclass. Three arguments (server object, error code and error message) are passed. It must return a message. sub translate_error_message { my ($s, $code, $message) = @_; return $translation_jp_message{$code}; } =item create_json_coder (Class method) Returns a JSON de/encoder in C. You can override it to use your favorite JSON de/encode. =back =head1 RESERVED PROCEDURE When a client call a procedure (method) name 'system.foobar', JSON::RPC::Legacy::Server look up MyApp::system::foobar. L L There is JSON::RPC::Legacy::Server::system::describe for default response of 'system.describe'. =head1 SEE ALSO L L L =head1 AUTHOR Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2007-2008 by Makamaka Hannyaharamitu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Apache2.pm100644000766000024 1133412414644342 20356 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPC/Legacy/Server############################################################################## package JSON::RPC::Legacy::Server::Apache2; use strict; use lib qw(/var/www/cgi-bin/json/); use base qw(JSON::RPC::Legacy::Server); use Apache2::Const -compile => qw(OK HTTP_BAD_REQUEST SERVER_ERROR); use APR::Table (); use Apache2::RequestRec (); use Apache2::RequestIO (); use Apache2::RequestUtil (); $JSON::RPC::Legacy::Server::Apache::VERSION = '1.06'; sub handler { my($r) = @_; my $s = __PACKAGE__->new; $s->request($r); $s->{path_info} = $r->path_info; my @modules = $r->dir_config('dispatch') || $r->dir_config('dispatch_to'); $s->return_die_message( $r->dir_config('return_die_message') ); $s->dispatch([@modules]); $s->handle(@_); Apache2::Const::OK; } sub new { my $class = shift; return $class->SUPER::new(); } sub retrieve_json_from_post { my $self = shift; my $r = $self->request; my $len = $r->headers_in()->get('Content-Length'); return if($r->method ne 'POST'); return if($len > $self->max_length); my ($buf, $content); while( $r->read($buf,$len) ){ $content .= $buf; } $content; } sub retrieve_json_from_get { my $self = shift; my $r = $self->request; my $args = $r->args; $args = '' if (!defined $args); $self->{path_info} = $r->path_info; my $params = {}; $self->version(1.1); for my $pair (split/&/, $args) { my ($key, $value) = split/=/, $pair; if ( defined ( my $val = $params->{ $key } ) ) { if ( ref $val ) { push @{ $params->{ $key } }, $value; } else { # change a scalar into an arrayref $params->{ $key } = []; push @{ $params->{ $key } }, $val, $value; } } else { $params->{ $key } = $value; } } my $method = $r->path_info; $method =~ s{^.*/}{}; $self->{path_info} =~ s{/?[^/]+$}{}; $self->json->encode({ version => '1.1', method => $method, params => $params, }); } sub response { my ($self, $response) = @_; my $r = $self->request; $r->content_type($self->content_type); $r->print($response->content); return ($response->code == 200) ? Apache2::Const::OK : Apache2::Const::SERVER_ERROR; } 1; __END__ =pod =head1 NAME JSON::RPC::Legacy::Server::Apache2 - JSON-RPC sever for mod_perl2 =head1 SYNOPSIS # In apache conf PerlRequire /your/path/start.pl PerlModule MyApp SetHandler perl-script PerlResponseHandler JSON::RPC::Legacy::Server::Apache PerlSetVar dispatch "MyApp" PerlSetVar return_die_message 0 #-------------------------- # In your application class package MyApp; use base qw(JSON::RPC::Legacy::Procedure); # Perl 5.6 or more than sub echo : Public { # new version style. called by clients # first argument is JSON::RPC::Legacy::Server object. return $_[1]; } sub sum : Public(a:num, b:num) { # sets value into object member a, b. my ($s, $obj) = @_; # return a scalar value or a hashref or an arryaref. return $obj->{a} + $obj->{b}; } sub a_private_method : Private { # ... can't be called by client } sub sum_old_style { # old version style. taken as Public my ($s, @arg) = @_; return $arg[0] + $arg[1]; } =head1 DESCRIPTION Gets a client request. Parses its JSON data. Passes the server object and the object decoded from the JSON data to your procedure (method). Takes your returned value (scalar or arrayref or hashref). Sends a response. Well, you write your procedure code only. =head1 METHODS They are inherited from the L methods basically. The below methods are implemented in JSON::RPC::Legacy::Server::Apache2. =over =item new Creates new JSON::RPC::Legacy::Server::Apache2 object. =item handle Runs server object and returns a response. =item retrieve_json_from_post retrieves a JSON request from the body in POST method. =item retrieve_json_from_get In the protocol v1.1, 'GET' request method is also allowable. it retrieves a JSON request from the query string in GET method. =item response returns a response JSON data to a client. =back =head1 SEE ALSO L, L, L, L, L, =head1 AUTHOR Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2007-2008 by Makamaka Hannyaharamitu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut CGI.pm100644000766000024 740412414644342 17500 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPC/Legacy/Server############################################################################## package JSON::RPC::Legacy::Server::CGI; use strict; use CGI; use JSON::RPC::Legacy::Server; # for old Perl 5.005 use base qw(JSON::RPC::Legacy::Server); $JSON::RPC::Legacy::Server::CGI::VERSION = '1.06'; sub new { my $class = shift; my $self = $class->SUPER::new(); my $cgi = $self->cgi; $self->request( HTTP::Request->new($cgi->request_method, $cgi->url) ); $self->path_info($cgi->path_info); $self; } sub retrieve_json_from_post { my $json = $_[0]->cgi->param('POSTDATA'); return $json; } sub retrieve_json_from_get { my $self = shift; my $cgi = $self->cgi; my $params = {}; $self->version(1.1); for my $name ($cgi->param) { my @values = $cgi->param($name); $params->{$name} = @values > 1 ? [@values] : $values[0]; } my $method = $cgi->path_info; $method =~ s{^.*/}{}; $self->{path_info} =~ s{/?[^/]+$}{}; $self->json->encode({ version => '1.1', method => $method, params => $params, }); } sub response { my ($self, $response) = @_; print "Status: " . $response->code . "\015\012" . $response->headers_as_string("\015\012") . "\015\012" . $response->content; } sub cgi { $_[0]->{cgi} ||= new CGI; } 1; __END__ =head1 NAME JSON::RPC::Legacy::Server::CGI - JSON-RPC sever for CGI =head1 SYNOPSIS # CGI version #-------------------------- # In your CGI script use JSON::RPC::Legacy::Server::CGI; my $server = JSON::RPC::Legacy::Server::CGI->new; $server->dispatch('MyApp')->handle(); # or an array ref setting $server->dispatch( [qw/MyApp MyApp::Subclass/] )->handle(); # or a hash ref setting $server->dispatch( {'/jsonrpc/API' => 'MyApp'} )->handle(); #-------------------------- # In your application class package MyApp; use base qw(JSON::RPC::Legacy::Procedure); # Perl 5.6 or more than sub echo : Public { # new version style. called by clients # first argument is JSON::RPC::Legacy::Server object. return $_[1]; } sub sum : Public(a:num, b:num) { # sets value into object member a, b. my ($s, $obj) = @_; # return a scalar value or a hashref or an arryaref. return $obj->{a} + $obj->{b}; } sub a_private_method : Private { # ... can't be called by client } sub sum_old_style { # old version style. taken as Public my ($s, @arg) = @_; return $arg[0] + $arg[1]; } =head1 DESCRIPTION Gets a client request. Parses its JSON data. Passes the server object and the object decoded from the JSON data to your procedure (method). Takes your returned value (scalar or arrayref or hashref). Sends a response. Well, you write your procedure code only. =head1 METHODS They are inherited from the L methods basically. The below methods are implemented in JSON::RPC::Legacy::Server::CGI. =over =item new Creates new JSON::RPC::Legacy::Server::CGI object. =item retrieve_json_from_post retrieves a JSON request from the body in POST method. =item retrieve_json_from_get In the protocol v1.1, 'GET' request method is also allowable. it retrieves a JSON request from the query string in GET method. =item response returns a response JSON data to a client. =item cgi returns the L object. =back =head1 SEE ALSO L, L, L, L, L, =head1 AUTHOR Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2007-2008 by Makamaka Hannyaharamitu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Daemon.pm100644000766000024 706612414644342 20305 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPC/Legacy/Server############################################################################## package JSON::RPC::Legacy::Server::Daemon; use strict; use JSON::RPC::Legacy::Server; # for old Perl 5.005 use base qw(JSON::RPC::Legacy::Server); $JSON::RPC::Legacy::Server::Daemon::VERSION = '1.06'; use Data::Dumper; sub new { my $class = shift; my $self = $class->SUPER::new(); my $pkg; if( grep { $_ =~ /^SSL_/ } @_ ){ $self->{_daemon_pkg} = $pkg = 'HTTP::Daemon::SSL'; } else{ $self->{_daemon_pkg} = $pkg = 'HTTP::Daemon'; } eval qq| require $pkg; |; if($@){ die $@ } $self->{_daemon} ||= $pkg->new(@_) or die; return $self; } sub handle { my $self = shift; my %opt = @_; my $d = $self->{_daemon} ||= $self->{_daemon_pkg}->new(@_) or die; while (my $c = $d->accept) { $self->{con} = $c; while (my $r = $c->get_request) { $self->request($r); $self->path_info($r->url->path); $self->SUPER::handle(); last; } $c->close; } } sub retrieve_json_from_post { return $_[0]->request->content; } sub retrieve_json_from_get { } sub response { my ($self, $response) = @_; $self->{con}->send_response($response); } 1; __END__ =head1 NAME JSON::RPC::Legacy::Server::Daemon - JSON-RPC sever for daemon =head1 SYNOPSIS # Daemon version #-------------------------- # In your daemon server script use JSON::RPC::Legacy::Server::Daemon; JSON::RPC::Legacy::Server::Daemon->new(LocalPort => 8080); ->dispatch({'/jsonrpc/API' => 'MyApp'}) ->handle(); #-------------------------- # In your application class package MyApp; use base qw(JSON::RPC::Legacy::Procedure); # Perl 5.6 or more than sub echo : Public { # new version style. called by clients # first argument is JSON::RPC::Legacy::Server object. return $_[1]; } sub sum : Public(a:num, b:num) { # sets value into object member a, b. my ($s, $obj) = @_; # return a scalar value or a hashref or an arryaref. return $obj->{a} + $obj->{b}; } sub a_private_method : Private { # ... can't be called by client } sub sum_old_style { # old version style. taken as Public my ($s, @arg) = @_; return $arg[0] + $arg[1]; } =head1 DESCRIPTION This module is for http daemon servers using L or L. =head1 METHODS They are inherited from the L methods basically. The below methods are implemented in JSON::RPC::Legacy::Server::Daemon. =over =item new Creates new JSON::RPC::Legacy::Server::Daemon object. Arguments are passed to L or L. =item handle Runs server object and returns a response. =item retrieve_json_from_post retrieves a JSON request from the body in POST method. =item retrieve_json_from_get In the protocol v1.1, 'GET' request method is also allowable. it retrieves a JSON request from the query string in GET method. =item response returns a response JSON data to a client. =back =head1 SEE ALSO L, L, L, L, L, L, L, =head1 AUTHOR Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2007-2008 by Makamaka Hannyaharamitu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Parser.pm100644000766000024 466512414644342 15666 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPCpackage JSON::RPC::Parser; use strict; use JSON::RPC::Procedure; use Carp (); use Plack::Request; use Class::Accessor::Lite new => 1, rw => [ qw( coder ) ] ; sub construct_procedure { my $self = shift; JSON::RPC::Procedure->new( @_ ); } sub construct_from_req { my ($self, $req) = @_; my $method = $req->method; my $proc; if ($method eq 'POST') { $proc = $self->construct_from_post_req( $req ); } elsif ($method eq 'GET') { $proc = $self->construct_from_get_req( $req ); } else { Carp::croak( "Invalid method: $method" ); } return $proc; } sub construct_from_post_req { my ($self, $req) = @_; my $request = eval { $self->coder->decode( $req->content ) }; if ($@) { Carp::croak( "JSON parse error: $@" ); } my $ref = ref $request; if ($ref ne 'ARRAY') { # is not a batch request return $self->construct_procedure( method => $request->{method}, id => $request->{id}, params => $request->{params}, jsonrpc => $request->{jsonrpc}, has_id => exists $request->{id}, ); } my @procs; foreach my $req ( @$request ) { Carp::croak( "Invalid parameter") unless ref $req eq 'HASH'; push @procs, $self->construct_procedure( method => $req->{method}, id => $req->{id}, params => $req->{params}, jsonrpc => $req->{jsonrpc}, has_id => exists $req->{id}, # when not true it's a notification in JSON-RPC 2.0 ); } return \@procs; } sub construct_from_get_req { my ($self, $req) = @_; my $params = $req->query_parameters; my $decoded_params; if ($params->{params}) { $decoded_params = eval { $self->coder->decode( $params->{params} ) }; } return $self->construct_procedure( method => $params->{method}, id => $params->{id}, params => $decoded_params, jsonrpc => $params->{jsonrpc}, has_id => exists $params->{id}, ); } 1; __END__ =head1 NAME JSON::RPC::Parser - Parse JSON RPC Requests from Plack::Request =head1 SYNOPSIS use JSON::RPC::Parser; my $parser = JSON::RPC::Parser->new( coder => JSON->new ); my $procedure = $parser->construct_from_req( $request ); =head1 DESCRIPTION Constructs a L object from a Plack::Request object =cut Procedure.pm100644000766000024 116712414644342 16354 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPCpackage JSON::RPC::Procedure; use strict; use Carp (); use Class::Accessor::Lite new => 1, rw => [ qw( id method params has_id jsonrpc ) ] ; 1; __END__ =head1 NAME JSON::RPC::Procedure - A JSON::RPC Procedure =head1 SYNOPSIS use JSON::RPC::Procedure; my $procedure = JSON::RPC::Procedure->new( id => ..., method => ... params => ... jsonrpc => ... has_id => ... (a flag that signals that a procedure appears to be a notification when not set) ); =head1 DESCRIPTION A container for JSON RPC procedure information =cut Test.pm100644000766000024 122712414644342 15340 0ustar00JP11194staff000000000000JSON-RPC-1.06/lib/JSON/RPCpackage JSON::RPC::Test; use strict; use parent qw(Exporter); our @EXPORT = qw(test_rpc); sub test_rpc { if (ref $_[0] && @_ == 2) { @_ = (dispatch => $_[0], client => $_[1]); } my %args = @_; my $dispatch = delete $args{dispatch}; $args{app} = sub { $dispatch->handle_psgi(@_); }; @_ = %args; goto \&Plack::Test::test_psgi; } 1; =head1 NAME JSON::RPC::Test - Simple Wrapper To Test Your JSON::RPC =head1 SYNOPSIS use JSON::RPC::Test; test_rpc $dispatch, sub { ... }; # or test_rpc dispatch => $dispatch, client => sub { ... } ; =cut 001_compile.t100644000766000024 24512414644342 14537 0ustar00JP11194staff000000000000JSON-RPC-1.06/tuse strict; use Test::More; use_ok $_ for qw( JSON::RPC::Constants JSON::RPC::Dispatch JSON::RPC::Parser JSON::RPC::Procedure ); done_testing; 1; 002_basic.t100644000766000024 2766512414644342 14250 0ustar00JP11194staff000000000000JSON-RPC-1.06/tuse strict; use warnings; use Test::More; use Plack::Test; use HTTP::Request; use JSON; BEGIN { use_ok "JSON::RPC::Dispatch"; use_ok "JSON::RPC::Constants", ':all'; use_ok "JSON::RPC::Test"; use_ok "t::JSON::RPC::Test::Handler::Sum"; } subtest 'defaults' => sub { my $dispatch = JSON::RPC::Dispatch->new(); if (ok $dispatch->coder) { isa_ok $dispatch->coder, 'JSON'; } if (ok $dispatch->router) { isa_ok $dispatch->router, "Router::Simple"; } if (ok $dispatch->parser) { isa_ok $dispatch->parser, "JSON::RPC::Parser"; } }; subtest 'normal dispatch' => sub { my $coder = JSON->new; my $router = Router::Simple->new; $router->connect( blowup => { handler => "Sum", action => "blowup", } ); $router->connect( 'sum' => { handler => 'Sum', action => 'sum', } ); $router->connect( tidy_error => { handler => "Sum", action => "tidy_error", } ); $router->connect( 'sum_obj' => { handler => t::JSON::RPC::Test::Handler::Sum->new, action => 'sum', } ); my $dispatch = JSON::RPC::Dispatch->new( coder => $coder, parser => JSON::RPC::Parser->new( coder => $coder ), prefix => 't::JSON::RPC::Test::Handler', router => $router, ); ok $dispatch, "dispatch ok"; my $request_get = sub { my $cb = shift; my ($req, $res, $json); my $uri = URI->new( "http://localhost" ); # no such method... $uri->query_form( method => 'not_found' ); $req = HTTP::Request->new( GET => $uri ); $res = $cb->( $req ); if (! ok $res->is_success, "response is success") { diag $res->as_string; } $json = $coder->decode( $res->decoded_content ); if ( ! ok $json->{error}, "I should have gotten an error" ) { diag explain $json; } if (! is $json->{error}->{code}, JSON::RPC::Constants::RPC_METHOD_NOT_FOUND(), "code is RPC_METHOD_NOT_FOUND" ) { diag explain $json; } my @params = ( 1, 2, 3, 4, 5 ); foreach my $method ( qw(sum sum_obj) ){ $uri->query_form( method => $method, params => $coder->encode(\@params) ); $req = HTTP::Request->new( GET => $uri ); $res = $cb->( $req ); if (! ok $res->is_success, "response is success") { diag $res->as_string; } $json = $coder->decode( $res->decoded_content ); if (! ok ! $json->{error}, "no errors") { diag explain $json; } my $sum = 0; foreach my $p (@params) { $sum += $p; } is $json->{result}, $sum, "sum matches"; } my $id = time(); $uri->query_form( jsonrpc => '2.0', id => $id, method => 'blowup', params => "fuga", ); $req = HTTP::Request->new( GET => $uri ); $res = $cb->( $req ); if (! ok $res->is_success, "response is success") { diag $res->as_string; } $json = $coder->decode( $res->decoded_content ); is $json->{jsonrpc}, '2.0'; is $json->{id}, $id; ok $json->{error}; }; my $request_post = sub { my $cb = shift; my ($req, $res, $post_content, $json); my $headers = HTTP::Headers->new( Content_Type => 'application/json',); my $uri = URI->new( "http://localhost" ); $post_content = $coder->encode( { method => 'not_found' } ); # no such method... $req = HTTP::Request->new( POST => $uri, $headers, $post_content); $res = $cb->($req); if (! ok $res->is_success, "response is success") { diag $res->as_string; } $json = $coder->decode( $res->decoded_content ); if ( ! ok $json->{error}, "I should have gotten an error" ) { diag explain $json; } if (! is $json->{error}->{code}, JSON::RPC::Constants::RPC_METHOD_NOT_FOUND(), "code is RPC_METHOD_NOT_FOUND" ) { diag explain $json; } my @params = ( 1, 2, 3, 4, 5 ); foreach my $method ( qw(sum sum_obj) ){ $post_content = $coder->encode( { method => $method, params => \@params, }, ); $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->( $req ); if (! ok $res->is_success, "response is success") { diag $res->as_string; } $json = $coder->decode( $res->decoded_content ); if (! ok ! $json->{error}, "no errors") { diag explain $json; } my $sum = 0; foreach my $p (@params) { $sum += $p; } is $json->{result}, $sum, "sum matches"; } my $id = time(); $post_content = $coder->encode( { jsonrpc => '2.0', id => $id, method => 'blowup', params => "fuga", }, ); $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->( $req ); if (! ok $res->is_success, "response is success") { diag $res->as_string; } $json = $coder->decode( $res->decoded_content ); is $json->{jsonrpc}, '2.0'; is $json->{id}, $id; ok $json->{error}; }; my $request_post_batch = sub { my $cb = shift; my ($req, $res, $post_content, $json); my $headers = HTTP::Headers->new( Content_Type => 'application/json',); my $uri = URI->new( "http://localhost" ); $post_content = $coder->encode( [ { jsonrpc => '2.0', id => 1, method => 'sum', params => [(1..3)], } ], ); $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->( $req ); if (! ok $res->is_success, "response is success") { diag $res->as_string; } $json = $coder->decode( $res->decoded_content ); is ref $json, 'ARRAY', 'response is array-ref'; }; # XXX I want to test both Plack::Request and raw env, but test_rpc # makes it kinda hard... oh well, it's not /that/ much of a problem test_rpc $dispatch, sub { my $cb = shift; subtest 'JSONRPC via GET' => sub { $request_get->($cb) }; subtest 'JSONRPC via POST' => sub { $request_post->($cb) }; subtest 'JSONRPC via POST (Batch)' => sub { $request_post_batch->($cb) }; subtest 'JSONRPC Error' => sub { my ($post_content, $req, $res, $json); my $headers = HTTP::Headers->new( Content_Type => 'application/json',); my $uri = URI->new( "http://localhost" ); $post_content = $coder->encode( [ method => "hoge"] ); $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->($req); $json = $coder->decode( $res->decoded_content ); if (! is $json->{error}->{code}, RPC_INVALID_PARAMS ){ diag explain $json; } $post_content = "{ [[ broken json }"; $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->($req); $json = $coder->decode( $res->decoded_content ); if (! is $json->{error}->{code}, RPC_PARSE_ERROR ) { diag explain $json; } $post_content = "[]"; $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->($req); $json = $coder->decode( $res->decoded_content ); if (! is $json->{error}->{code}, RPC_INVALID_REQUEST ){ diag explain $json; } # invalid method 'PUT' $req = HTTP::Request->new( PUT => $uri ); $res = $cb->($req); $json = $coder->decode( $res->decoded_content ); if (! is $json->{error}->{code}, RPC_INVALID_REQUEST ){ diag explain $json; } my $id = time(); $post_content = $coder->encode( { jsonrpc => '2.0', id => $id, method => 'tidy_error', params => "foo", } ); $req = HTTP::Request->new( POST => $uri, $headers, $post_content); $res = $cb->($req); $json = $coder->decode( $res->decoded_content ); if (! is $json->{error}->{code}, RPC_INTERNAL_ERROR) { diag explain $json; } is $json->{error}->{message}, 'short description of the error'; is $json->{error}->{data}, 'additional information about the error'; }; subtest 'JSONRPC Notification handling' => sub { my ($post_content, $req, $res, $json); my $headers = HTTP::Headers->new( Content_Type => 'application/json',); my $uri = URI->new( "http://localhost" ); $post_content = $coder->encode( { method => "hoge", jsonrpc => '2.0' } ); $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->($req); if (! ok $res->is_success, "Notification with nonexistent method: response is success") { diag $res->as_string; } if (! is $res->code, 204, "Notification with nonexistent method: code is 204 for no content") { diag $res->as_string; } if (! ok !length($res->content), "Notification with nonexistent method: content has no length") { diag $res->as_string; } $post_content = $coder->encode( [ { jsonrpc => '2.0', method => 'blowup', params => "fuga", }, { jsonrpc => '2.0', id => undef, method => 'blowup', params => "fuga", }, ] ); $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->($req); if (! ok $res->is_success, "Notification and a NULL id call: response is success") { diag $res->as_string; } $json = $coder->decode( $res->decoded_content ); is scalar @$json, 1, "Notification and a NULL id call: response has one element"; ok (exists $json->[0]->{id} && !defined $json->[0]->{id}, "Notification and a NULL id call: response element has NULL id"); ok ($json->[0]->{error}, "Notification and a NULL id call: response element has an error"); $post_content = $coder->encode( [ { jsonrpc => '2.0', method => 'blowup', params => "fuga", }, { jsonrpc => '2.0', method => 'blowup', params => "fuga2", }, ] ); $req = HTTP::Request->new( POST => $uri, $headers, $post_content ); $res = $cb->($req); if (! ok $res->is_success, "Notification batch: response is success") { diag $res->as_string; } if (! is $res->code, 204, "Notification batch: code is 204 for no content") { diag $res->as_string; } if (! ok !length($res->content), "Notification batch: content has no length") { diag $res->as_string; } }; }; }; done_testing; 003_parser.t100644000766000024 522212414644342 14425 0ustar00JP11194staff000000000000JSON-RPC-1.06/tuse strict; use Test::More; use Plack::Request; use JSON; use_ok "JSON::RPC::Parser"; use_ok "JSON::RPC::Procedure"; subtest 'basic' => sub { my $req = Plack::Request->new( { QUERY_STRING => 'method=sum¶ms=[1,2,3]&id=1', REQUEST_METHOD => "GET", } ); my $parser = JSON::RPC::Parser->new( coder => JSON->new, ); my $procedure = $parser->construct_from_req( $req ); ok $procedure, "procedure is defined"; isa_ok $procedure, "JSON::RPC::Procedure"; is $procedure->id, 1, "id matches"; is $procedure->method, "sum", "method matches"; is_deeply $procedure->params, [ 1, 2, 3 ], "parameters match"; my $request_hash = { "method" => "sum", "params" => [1, 2, 3], "id" => 2, "jsonrpc" => "2.0" }; my $request_json = to_json($request_hash); open my $input, "<", \$request_json; my $cl = length $request_json; $req = Plack::Request->new( { 'psgi.input' => $input, REQUEST_METHOD => "POST", CONTENT_LENGTH => $cl, CONTENT_TYPE => 'application/json' } ); $procedure = $parser->construct_from_req( $req ); is $procedure->jsonrpc, "2.0", "jsonrpc matches"; ok $procedure->has_id, "has id"; close $input; delete $request_hash->{id}; $request_json = to_json($request_hash); open $input, "<", \$request_json; $cl = length $request_json; $req = Plack::Request->new( { 'psgi.input' => $input, REQUEST_METHOD => "POST", CONTENT_LENGTH => $cl, CONTENT_TYPE => 'application/json' } ); $procedure = $parser->construct_from_req( $req ); ok !$procedure->has_id, "does not have an id"; close $input; my $request_array = [ { "method" => "ping", "id" => undef, "jsonrpc" => "2.0" }, { "method" => "ping", "id" => 3, "jsonrpc" => "2.0" }, ]; $request_json = to_json($request_array); open $input, "<", \$request_json; $cl = length $request_json; $req = Plack::Request->new( { 'psgi.input' => $input, REQUEST_METHOD => "POST", CONTENT_LENGTH => $cl, CONTENT_TYPE => 'application/json' } ); my $procedures = $parser->construct_from_req( $req ); ok $procedures, "procedures are defined"; is @$procedures, 2, "should be 2 procedures"; ok (($procedures->[0]->has_id && $procedures->[1]->has_id), "both procedures have ids"); ok ((!defined $procedures->[0]->id), "first procedure has NULL id"); is $procedures->[1]->id, 3, "second procedure id matches"; close $input; }; done_testing; Sum.pm100644000766000024 70312414644342 17134 0ustar00JP11194staff000000000000JSON-RPC-1.06/t/JSON/RPC/Test/Handlerpackage t::JSON::RPC::Test::Handler::Sum; use strict; use Class::Accessor::Lite new => 1; sub blowup { die "I blew up!"; } sub sum { my ($self, $params, $proc, @args) = @_; $params ||= []; my $sum = 0; foreach my $p (@$params) { $sum += $p; } return $sum; } sub tidy_error { die { message => "short description of the error", data => "additional information about the error" }; } 1; 00_pod.t100644000766000024 23112414644342 15047 0ustar00JP11194staff000000000000JSON-RPC-1.06/t/legacyuse strict; $^W = 1; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok (); 01_use.t100644000766000024 44512414644342 15071 0ustar00JP11194staff000000000000JSON-RPC-1.06/t/legacyuse Test::More; use strict; BEGIN { plan tests => 1 }; use CGI; use JSON::RPC::Legacy::Client; use JSON::RPC::Legacy::Server; ok(1); # If we made it this far, we're ok. END { warn "\nJSON::RPC::nLegacy::Server::CGI requires CGI.pm (>= 2.9.2)." if(CGI->VERSION < 2.92); } 02_server.t100644000766000024 101612414644342 15617 0ustar00JP11194staff000000000000JSON-RPC-1.06/t/legacyuse Test::More; use strict; BEGIN { plan tests => 4 }; use JSON::RPC::Legacy::Server; my $server = JSON::RPC::Legacy::Server->new; isa_ok($server, 'JSON::RPC::Legacy::Server'); isa_ok($server->json, 'JSON'); my $test = JSON::RPC::Legacy::Server::Test->new; isa_ok($test, 'JSON::RPC::Legacy::Server'); isa_ok($test->json, 'DummyJSONCoder'); #### package JSON::RPC::Legacy::Server::Test; use base qw(JSON::RPC::Legacy::Server); sub create_json_coder { bless {}, 'DummyJSONCoder'; } META.yml100644000766000024 520112414644342 13365 0ustar00JP11194staff000000000000JSON-RPC-1.06--- abstract: 'JSON RPC 2.0 Server Implementation' author: - 'Daisuke Maki' build_requires: ExtUtils::MakeMaker: '6.36' Plack::Request: '0' Plack::Test: '0' Test::More: '0' configure_requires: CPAN::Meta: '0' CPAN::Meta::Prereqs: '0' Module::Build: '0.38' dynamic_config: 0 generated_by: 'Minilla/v1.1.0, CPAN::Meta::Converter version 2.141520' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: JSON-RPC no_index: directory: - t - xt - inc - share - eg - examples - author - builder provides: JSON::RPC: file: lib/JSON/RPC.pm version: '1.06' JSON::RPC::Constants: file: lib/JSON/RPC/Constants.pm JSON::RPC::Dispatch: file: lib/JSON/RPC/Dispatch.pm JSON::RPC::Legacy: file: lib/JSON/RPC/Legacy.pm JSON::RPC::Legacy::Client: file: lib/JSON/RPC/Legacy/Client.pm version: '1.06' JSON::RPC::Legacy::Procedure: file: lib/JSON/RPC/Legacy/Procedure.pm version: '1.06' JSON::RPC::Legacy::ReturnObject: file: lib/JSON/RPC/Legacy/Client.pm version: '0' JSON::RPC::Legacy::Server: file: lib/JSON/RPC/Legacy/Server.pm version: '1.06' JSON::RPC::Legacy::Server::Apache: file: lib/JSON/RPC/Legacy/Server/Apache2.pm version: '1.06' JSON::RPC::Legacy::Server::Apache2: file: lib/JSON/RPC/Legacy/Server/Apache2.pm JSON::RPC::Legacy::Server::CGI: file: lib/JSON/RPC/Legacy/Server/CGI.pm version: '1.06' JSON::RPC::Legacy::Server::Daemon: file: lib/JSON/RPC/Legacy/Server/Daemon.pm version: '1.06' JSON::RPC::Legacy::Server::system: file: lib/JSON/RPC/Legacy/Server.pm JSON::RPC::Legacy::ServiceObject: file: lib/JSON/RPC/Legacy/Client.pm JSON::RPC::Parser: file: lib/JSON/RPC/Parser.pm JSON::RPC::Procedure: file: lib/JSON/RPC/Procedure.pm JSON::RPC::Test: file: lib/JSON/RPC/Test.pm recommends: JSON::XS: '0' requires: CGI: '0' Class::Accessor::Lite: '0' HTTP::Request: '0' HTTP::Response: '0' JSON: '0' LWP::UserAgent: '0' Plack: '0' Router::Simple: '0' parent: '0' resources: bugtracker: ssh://git@github.com/lestrrat/JSON-RPC/issues homepage: ssh://git@github.com/lestrrat/JSON-RPC repository: ssh://git@github.com/lestrrat/JSON-RPC.git version: '1.06' x_contributors: - 'Yoshimitsu Torii ' - 'Stanislav Lechev [AngelFire] ' - 'Kazuhiro Shibuya ' - 'David Steinbrunner ' - 'ThePeePs ' - 'Kirill Bogdanov ' - 'ar_tama ' - 'Daisuke Maki ' MANIFEST100644000766000024 107712414644342 13254 0ustar00JP11194staff000000000000JSON-RPC-1.06Build.PL Changes LICENSE META.json Makefile README.md cpanfile lib/JSON/RPC.pm lib/JSON/RPC/Constants.pm lib/JSON/RPC/Dispatch.pm lib/JSON/RPC/Legacy.pm lib/JSON/RPC/Legacy/Client.pm lib/JSON/RPC/Legacy/Procedure.pm lib/JSON/RPC/Legacy/Server.pm lib/JSON/RPC/Legacy/Server/Apache2.pm lib/JSON/RPC/Legacy/Server/CGI.pm lib/JSON/RPC/Legacy/Server/Daemon.pm lib/JSON/RPC/Parser.pm lib/JSON/RPC/Procedure.pm lib/JSON/RPC/Test.pm t/001_compile.t t/002_basic.t t/003_parser.t t/JSON/RPC/Test/Handler/Sum.pm t/legacy/00_pod.t t/legacy/01_use.t t/legacy/02_server.t META.yml MANIFEST