* json-rpc examples, and compile it as well

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15361 3ad0048d-3df7-0310-abae-a5850022a9f2

9 files changed, 563 insertions, 0 deletions

diff --git a/packages/fcl-web/examples/jsonrpc/demo1/demo.lpi b/packages/fcl-web/examples/jsonrpc/demo1/demo.lpi
new file mode 100644
index 0000000000..f799e0bd88
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/demo.lpi
@@ -0,0 +1,93 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <Runnable Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <Title Value="FPC JSON-RPC demo "/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <VersionInfo>
+      <Language Value=""/>
+      <CharSet Value=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="WebLaz"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="demo.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="demo"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="wmdemo.pp"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="FPWebModule1"/>
+        <ResourceBaseClass Value="DataModule"/>
+        <UnitName Value="wmdemo"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)/"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/packages/fcl-web/examples/jsonrpc/demo1/demo.lpr b/packages/fcl-web/examples/jsonrpc/demo1/demo.lpr
new file mode 100644
index 0000000000..de1a7daf3d
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/demo.lpr
@@ -0,0 +1,16 @@
+program demo;
+
+{$mode objfpc}{$H+}
+
+uses
+  fpCGI, wmdemo;
+
+// {$R *.res}
+
+
+begin
+  Application.Title:='FPC JSON-RPC demo';
+  Application.Initialize;
+  Application.Run;
+end.
+
diff --git a/packages/fcl-web/examples/jsonrpc/demo1/echo.in b/packages/fcl-web/examples/jsonrpc/demo1/echo.in
new file mode 100644
index 0000000000..8976b3f750
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/echo.in
@@ -0,0 +1 @@
+{ "method": "echo", "params": ["Hello JSON-RPC"], "id": 1 }
diff --git a/packages/fcl-web/examples/jsonrpc/demo1/echobatch.in b/packages/fcl-web/examples/jsonrpc/demo1/echobatch.in
new file mode 100644
index 0000000000..169ffedec0
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/echobatch.in
@@ -0,0 +1,4 @@
+[
+  { "method": "echo", "params": ["Hello JSON-RPC 1"], "id": 1 },
+  { "method": "echo", "params": ["Hello JSON-RPC 2"], "id": 2 }
+]
\ No newline at end of file
diff --git a/packages/fcl-web/examples/jsonrpc/demo1/extdirect.in b/packages/fcl-web/examples/jsonrpc/demo1/extdirect.in
new file mode 100644
index 0000000000..831536e29d
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/extdirect.in
@@ -0,0 +1,4 @@
+[
+  { "action": "test", "method": "echo", "data": ["Hello JSON-RPC 1"], "tid": 1 },
+  { "action": "test", "method": "echo", "data": ["Hello JSON-RPC 2"], "tid": 2 }
+]
\ No newline at end of file
diff --git a/packages/fcl-web/examples/jsonrpc/demo1/notification.in b/packages/fcl-web/examples/jsonrpc/demo1/notification.in
new file mode 100644
index 0000000000..97398bd3bc
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/notification.in
@@ -0,0 +1 @@
+{ "method": "echo", "params": ["Hello JSON-RPC"], "id": null }
diff --git a/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.lfm b/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.lfm
new file mode 100644
index 0000000000..22c8cc75b7
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.lfm
@@ -0,0 +1,46 @@
+object FPWebModule1: TFPWebModule1
+  OnCreate = DataModuleCreate
+  OldCreateOrder = False
+  Actions = <  
+    item
+      Name = 'Manual'
+      Default = True
+      OnRequest = TFPWebActions0Request
+    end  
+    item
+      Name = 'Dispatch'
+      Default = False
+      OnRequest = TFPWebActions1Request
+    end  
+    item
+      Name = 'Registered'
+      Default = False
+      OnRequest = TFPWebActions2Request
+    end  
+    item
+      Name = 'ExtDirect'
+      Default = False
+      OnRequest = TFPWebActions3Request
+    end  
+    item
+      Name = 'Content'
+      Default = False
+      OnRequest = TFPWebActions4Request
+    end  
+    item
+      Name = 'ExtDirectAPI'
+      Default = False
+      OnRequest = TFPWebActions5Request
+    end  
+    item
+      Name = 'Module'
+      Default = False
+      OnRequest = TFPWebActions6Request
+    end>
+  ActionVar = 'Action'
+  CreateSession = False
+  Height = 260
+  HorizontalOffset = 578
+  VerticalOffset = 373
+  Width = 442
+end
diff --git a/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.lrs b/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.lrs
new file mode 100644
index 0000000000..baec1d8e5c
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.lrs
@@ -0,0 +1,15 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TFPWebModule1','FORMDATA',[
+  'TPF0'#13'TFPWebModule1'#12'FPWebModule1'#8'OnCreate'#7#16'DataModuleCreate'
+  +#14'OldCreateOrder'#8#7'Actions'#14#1#4'Name'#6#6'Manual'#7'Default'#9#9'OnR'
+  +'equest'#7#21'TFPWebActions0Request'#0#1#4'Name'#6#8'Dispatch'#7'Default'#8#9
+  +'OnRequest'#7#21'TFPWebActions1Request'#0#1#4'Name'#6#10'Registered'#7'Defau'
+  +'lt'#8#9'OnRequest'#7#21'TFPWebActions2Request'#0#1#4'Name'#6#9'ExtDirect'#7
+  +'Default'#8#9'OnRequest'#7#21'TFPWebActions3Request'#0#1#4'Name'#6#7'Content'
+  +#7'Default'#8#9'OnRequest'#7#21'TFPWebActions4Request'#0#1#4'Name'#6#12'ExtD'
+  +'irectAPI'#7'Default'#8#9'OnRequest'#7#21'TFPWebActions5Request'#0#1#4'Name'
+  +#6#6'Module'#7'Default'#8#9'OnRequest'#7#21'TFPWebActions6Request'#0#0#9'Act'
+  +'ionVar'#6#6'Action'#13'CreateSession'#8#6'Height'#3#4#1#16'HorizontalOffset'
+  +#3'B'#2#14'VerticalOffset'#3'u'#1#5'Width'#3#186#1#0#0
+]);
diff --git a/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.pp b/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.pp
new file mode 100644
index 0000000000..907f7a2bed
--- /dev/null
+++ b/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.pp
@@ -0,0 +1,383 @@
+unit wmdemo; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, HTTPDefs, websession, fpHTTP, fpWeb; 
+
+type
+
+  { TFPWebModule1 }
+
+  TFPWebModule1 = class(TFPWebModule)
+    procedure DataModuleCreate(Sender: TObject);
+    procedure TFPWebActions0Request(Sender: TObject; ARequest: TRequest;
+      AResponse: TResponse; var Handled: Boolean);
+    procedure TFPWebActions1Request(Sender: TObject; ARequest: TRequest;
+      AResponse: TResponse; var Handled: Boolean);
+    procedure TFPWebActions2Request(Sender: TObject; ARequest: TRequest;
+      AResponse: TResponse; var Handled: Boolean);
+    procedure TFPWebActions3Request(Sender: TObject; ARequest: TRequest;
+      AResponse: TResponse; var Handled: Boolean);
+    procedure TFPWebActions4Request(Sender: TObject; ARequest: TRequest;
+      AResponse: TResponse; var Handled: Boolean);
+    procedure TFPWebActions5Request(Sender: TObject; ARequest: TRequest;
+      AResponse: TResponse; var Handled: Boolean);
+    procedure TFPWebActions6Request(Sender: TObject; ARequest: TRequest;
+      AResponse: TResponse; var Handled: Boolean);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  FPWebModule1: TFPWebModule1; 
+
+implementation
+
+Uses fpjson,jsonparser,fpjsonrpc,webjsonrpc, fpextdirect;
+
+{ TFPWebModule1 }
+
+procedure TFPWebModule1.DataModuleCreate(Sender: TObject);
+begin
+end;
+
+procedure TFPWebModule1.TFPWebActions0Request(Sender: TObject;
+  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
+{
+  Demo 1. Manually do everything.
+  Only a single method call is supported.
+}
+Var
+  P : TJSONParser;
+  Req,Res : TJSONData;
+  Env,O : TJSONObject;
+  M : TJSONStringType;
+  E : TJSONRPCEcho;
+  I : Integer;
+  ID : TJSONData;
+  Err : TJSONData;
+
+begin
+  Res:=Nil;
+  Err:=Nil;
+  ID:=Nil;
+  try
+    P:=TJSONParser.Create(ARequest.Content);
+    try
+      Req:=P.Parse;
+      try
+        If Not (Req is TJSONObject) then
+          JSONRPCError(SErrRequestMustBeObject);
+        O:=(Req as TJSONObject);
+        I:=O.IndexOfName('id');
+        If (I=-1) then
+          JSONRPCError(SErrNoIDProperty);
+        ID:=O.Items[i].Clone;
+        if O.IndexOfName('method')=-1 then
+          JSONRPCError(SErrNoMethodName);
+        M:=O.Strings['method'];
+        If (m<>'echo') then
+          JSONRPCError('Only echo method is supported');
+        E:=TJSONRPCEcho.Create(Self);
+        try
+          I:=O.IndexOfName('params');
+          Res:=E.Execute(O.Items[i],Nil);
+        finally
+          E.Free;
+        end;
+      finally
+        Req.Free;
+      end;
+    finally
+      P.Free;
+    end;
+  except
+    On E : Exception do
+      Err:=TJSONObject.Create(['message',E.Message,'name',E.ClassName,'code',-1]);
+  end;
+  If Assigned(ID) and (ID.JSONType<>jtNull) then
+    begin
+    Env:=TJSONObject.Create();
+    try
+      If not Assigned(Res) then
+        Res:=TJSONNull.Create;
+      Env.Add('result',Res);
+      If (Err=Nil) then
+        Err:=TJSONNull.Create;
+      Env.Add('error',Err);
+      Env.Add('id',ID);
+      AResponse.Content:=Env.AsJSON;
+    finally
+      Env.Free;
+    end;
+    end;
+  AResponse.SendContent;
+  Handled:=True;
+end;
+
+procedure TFPWebModule1.TFPWebActions1Request(Sender: TObject;
+  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
+
+{
+  Demo 2. Use a dispatcher to dispatch the requests.
+  The handler is located on the owner module
+  (it is created run-time, though)
+}
+
+Var
+  Echohandler:TJSONRPCEcho;
+  Disp : TJSONRPCDispatcher;
+  P : TJSONParser;
+  Req,res : TJSONData;
+  O : TJSONRPCDispatchOptions;
+
+begin
+  Echohandler:=TJSONRPCEcho.Create(Self);
+  try
+    EchoHandler.Name:='echo';
+    Disp:=TJSONRPCDispatcher.Create(Self);
+    try
+      O:=Disp.Options;
+      Include(O,jdoRequireClass);
+      Disp.Options:=O;
+      P:= TJSONParser.Create(ARequest.Content);
+      try
+        Req:=P.Parse;
+        try
+          Res:=Nil;
+          Res:=Disp.Execute(Req,Nil);
+          try
+            If Assigned(Res) then
+              begin
+              AResponse.Content:=Res.AsJSON;
+              end;
+            AResponse.SendContent;
+            Handled:=True;
+          finally
+            FreeAndNil(Res);
+          end;
+        finally
+          Req.Free;
+        end;
+      finally
+        P.Free;
+      end;
+    finally
+      Disp.Free;
+    end;
+  finally
+    EchoHandler.Free;
+  end;
+
+end;
+
+procedure TFPWebModule1.TFPWebActions2Request(Sender: TObject;
+  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
+{
+  Demo 3. Use a dispatcher to dispatch the requests,
+  The handler is registered in the JSONFPCHandlerManager.
+  (it is created run-time, though)
+}
+
+Var
+  Disp : TJSONRPCDispatcher;
+  P : TJSONParser;
+  Req,res : TJSONData;
+  O : TJSONRPCDispatchOptions;
+
+begin
+  JSONRpcHandlerManager.RegisterHandler('','echo',TJSONRPCEcho);
+  try
+    Disp:=TJSONRPCDispatcher.Create(Self);
+    try
+      O:=Disp.Options;
+      Include(O,jdoSearchRegistry);
+      Disp.Options:=O;
+      P:= TJSONParser.Create(ARequest.Content);
+      try
+        Req:=P.Parse;
+        try
+          Res:=Nil;
+          Res:=Disp.Execute(Req,Nil);
+          try
+            If Assigned(Res) then
+              begin
+              AResponse.Content:=Res.AsJSON;
+              end;
+            AResponse.SendContent;
+            Handled:=True;
+          finally
+            FreeAndNil(Res);
+          end;
+        finally
+          Req.Free;
+        end;
+      finally
+        P.Free;
+      end;
+    finally
+      Disp.Free;
+    end;
+  finally
+    JSONRpcHandlerManager.UnRegisterHandler('','echo');
+  end;
+end;
+
+procedure TFPWebModule1.TFPWebActions3Request(Sender: TObject;
+  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
+
+{
+  Demo 4. Ext.Direct dispatcher
+  The handler is registered in the JSONFPCHandlerManager.
+  (it is created run-time, though)
+}
+
+Var
+  Disp : TExtDirectDispatcher;
+  P : TJSONParser;
+  Req,res : TJSONData;
+  O : TJSONRPCDispatchOptions;
+
+begin
+  JSONRpcHandlerManager.RegisterHandler('test','echo',TJSONRPCEcho);
+  try
+    Disp:=TExtDirectDispatcher.Create(Self);
+    try
+      O:=Disp.Options;
+      Include(O,jdoSearchRegistry);
+      Disp.Options:=O;
+      P:= TJSONParser.Create(ARequest.Content);
+      try
+        Req:=P.Parse;
+        try
+          Res:=Nil;
+          Res:=Disp.Execute(Req,Nil);
+          try
+            If Assigned(Res) then
+              begin
+              AResponse.Content:=Res.AsJSON;
+              end;
+            AResponse.ContentLength:=Length(AResponse.Content);
+            AResponse.SendContent;
+            Handled:=True;
+          finally
+            FreeAndNil(Res);
+          end;
+        finally
+          Req.Free;
+        end;
+      finally
+        P.Free;
+      end;
+    finally
+      Disp.Free;
+    end;
+  finally
+    JSONRpcHandlerManager.UnRegisterHandler('','echo');
+  end;
+end;
+
+procedure TFPWebModule1.TFPWebActions4Request(Sender: TObject;
+  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
+
+{
+  Demo 5. Using a TJSONRPCContentProducer.
+  The handler is registered in the JSONFPCHandlerManager.
+  (it is created run-time, though)
+}
+
+Var
+  Cont : TJSONRPCContentProducer;
+  disp : TJSONRPCDispatcher;
+
+begin
+  JSONRpcHandlerManager.RegisterHandler('test','echo',TJSONRPCEcho);
+  try
+    Cont:=TJSONRPCContentProducer.Create(Self);
+    try
+      disp:=TJSONRPCDispatcher.Create(Cont);
+      Disp.Options:=Disp.OPtions+[jdoSearchRegistry];
+      Cont.Dispatcher:=Disp;
+      AResponse.ContentStream:=TMemoryStream.Create;
+      try
+        Cont.GetContent(ARequest,AResponse.ContentStream,Handled);
+        AResponse.ContentLength:=AResponse.ContentStream.Size;
+        If Handled then
+          AResponse.SendContent;
+      finally
+        AResponse.ContentStream.Free;
+      end;
+    finally
+      Cont.Free;
+    end;
+  finally
+    JSONRpcHandlerManager.UnRegisterHandler('','echo');
+  end;
+end;
+
+procedure TFPWebModule1.TFPWebActions5Request(Sender: TObject;
+  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
+{
+  Demo 6. creating an API response for Ext.Direct
+  The handler is registered in the JSONFPCHandlerManager.
+  (it is created run-time, though)
+}
+
+Var
+  D : TExtDirectDispatcher;
+  I : Integer;
+
+begin
+  JSONRpcHandlerManager.RegisterHandler('test','echo',TJSONRPCEcho);
+  try
+    D:=TExtDirectDispatcher.Create(Self);
+    try
+      D.URL:=BaseURL+'ExtDirect';
+      D.Options:=D.Options+[jdoSearchRegistry];
+      AResponse.Content:=D.APIAsString;
+      AResponse.ContentLength:=Length(AResponse.Content);
+    finally
+      D.Free;
+    end;
+  finally
+    JSONRpcHandlerManager.UnRegisterHandler('','echo');
+  end;
+end;
+
+procedure TFPWebModule1.TFPWebActions6Request(Sender: TObject;
+  ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
+{
+  Demo 6. Using a TJSONRPCModule instance to handle the request.
+  The handler is registered in the JSONFPCHandlerManager.
+  (it is created run-time, though)
+}
+
+Var
+  M : TJSONRPCModule;
+
+begin
+  JSONRpcHandlerManager.RegisterHandler('test','echo',TJSONRPCEcho);
+  try
+    M:=TJSONRPCModule.CreateNew(Self,0);
+    try
+      M.HandleRequest(ARequest,AResponse);
+      Handled:=True;
+    finally
+      M.Free;
+    end;
+  finally
+    JSONRpcHandlerManager.UnRegisterHandler('','echo');
+  end;
+end;
+
+initialization
+  {$I wmdemo.lrs}
+
+  RegisterHTTPModule('echo', TFPWebModule1);
+end.
+