You've already forked lazarus-ccr
resync
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@304 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
@ -33,11 +33,15 @@ const
|
||||
s_json_name = 'name';
|
||||
s_json_params = 'params';
|
||||
s_json_result = 'result';
|
||||
s_json_version = 'version';
|
||||
s_json_rpc_version_10 = '1.0';
|
||||
s_json_rpc_version_11 = '1.1';
|
||||
|
||||
stNilScope = stBase + 7;
|
||||
|
||||
type
|
||||
|
||||
TJonRPCVersion = ( jsonRPC_10, jsonRPC_11 );
|
||||
TJsonInteger = Integer;
|
||||
TEnumIntType = Integer;
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, TypInfo,
|
||||
base_service_intf, service_intf, imp_utils,
|
||||
base_json_formatter, fpjson;
|
||||
base_json_formatter, fpjson, SyncObjs;
|
||||
|
||||
type
|
||||
|
||||
@ -31,8 +31,12 @@ type
|
||||
FPropMngr : IPropertyManager;
|
||||
FCallProcedureName : string;
|
||||
FCallTarget : string;
|
||||
protected
|
||||
FVersion : string;
|
||||
FVersionEnum : TJonRPCVersion;
|
||||
private
|
||||
procedure SetVersion(const AValue : string);
|
||||
public
|
||||
constructor Create();override;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
|
||||
procedure BeginCall(
|
||||
@ -45,6 +49,9 @@ type
|
||||
|
||||
function GetCallProcedureName():string;
|
||||
function GetCallTarget():string;
|
||||
property VersionEnum : TJonRPCVersion read FVersionEnum;
|
||||
published
|
||||
property Version : string read FVersion write SetVersion;
|
||||
end;
|
||||
|
||||
{ TJsonRpcCallMaker }
|
||||
@ -62,12 +69,66 @@ type
|
||||
);
|
||||
End;
|
||||
|
||||
TJsonRpcCustomIdManager = class
|
||||
public
|
||||
function GetNewID() : PtrInt;virtual;abstract;
|
||||
end;
|
||||
|
||||
{ TJsonRpcSequencedIdManager }
|
||||
|
||||
TJsonRpcSequencedIdManager = class(TJsonRpcCustomIdManager)
|
||||
private
|
||||
FIdSequence : PtrInt;
|
||||
FIdSequenceLock : TCriticalSection;
|
||||
public
|
||||
constructor Create();
|
||||
destructor Destroy();override;
|
||||
function GetNewID() : PtrInt;override;
|
||||
end;
|
||||
|
||||
procedure RegisterJsonProtocol();
|
||||
procedure SetIdManager(AValue : TJsonRpcCustomIdManager);{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function GetIdManager():TJsonRpcCustomIdManager ;{$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
|
||||
implementation
|
||||
uses
|
||||
StrUtils;
|
||||
|
||||
var
|
||||
FIdManager : TJsonRpcCustomIdManager;
|
||||
|
||||
function GetIdManager():TJsonRpcCustomIdManager ;
|
||||
begin
|
||||
Result := FIdManager;
|
||||
end;
|
||||
|
||||
procedure SetIdManager(AValue : TJsonRpcCustomIdManager);
|
||||
begin
|
||||
FreeAndNil(FIdManager);
|
||||
FIdManager := AValue;
|
||||
end;
|
||||
|
||||
{ TJsonRpcFormatter }
|
||||
|
||||
procedure TJsonRpcFormatter.SetVersion(const AValue : string);
|
||||
var
|
||||
i : PtrInt;
|
||||
begin
|
||||
if ( FVersion = AValue ) then
|
||||
Exit;
|
||||
i := AnsiIndexStr(AValue,[s_json_rpc_version_10,s_json_rpc_version_11]);
|
||||
if ( i < 0 ) then
|
||||
Error('JSON-RPC version not supported : %s',[AValue]);
|
||||
FVersion := AValue;
|
||||
FVersionEnum := TJonRPCVersion(i);
|
||||
end;
|
||||
|
||||
constructor TJsonRpcFormatter.Create();
|
||||
begin
|
||||
inherited Create();
|
||||
SetVersion(s_json_rpc_version_10);
|
||||
end;
|
||||
|
||||
function TJsonRpcFormatter.GetPropertyManager() : IPropertyManager;
|
||||
begin
|
||||
If Not Assigned(FPropMngr) Then
|
||||
@ -83,14 +144,37 @@ begin
|
||||
FCallProcedureName := AProcName;
|
||||
FCallTarget := ATarget;
|
||||
|
||||
case VersionEnum of
|
||||
jsonRPC_10 :
|
||||
begin
|
||||
BeginObject('',Nil);
|
||||
Put(s_json_method,TypeInfo(string),FCallProcedureName);
|
||||
BeginArray(s_json_params,Nil,nil,[0,0],asScoped);
|
||||
end;
|
||||
jsonRPC_11 :
|
||||
begin
|
||||
BeginObject('',Nil);
|
||||
Put(s_json_version,TypeInfo(string),Version);
|
||||
Put(s_json_method,TypeInfo(string),FCallProcedureName);
|
||||
BeginArray(s_json_params,Nil,nil,[0,0],asScoped);
|
||||
end;
|
||||
else
|
||||
Error('JSON-RPC version not supported : %s',[Version]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJsonRpcFormatter.EndCall();
|
||||
var
|
||||
i : PtrInt;
|
||||
begin
|
||||
EndScope(); // params
|
||||
if ( VersionEnum = jsonRPC_10 ) then begin
|
||||
if Assigned(FIdManager) then
|
||||
i := FIdManager.GetNewID()
|
||||
else
|
||||
i := 0;
|
||||
Put(s_json_id,TypeInfo(PtrInt),i);
|
||||
end;
|
||||
EndScope(); // Root object
|
||||
end;
|
||||
|
||||
@ -116,7 +200,7 @@ begin
|
||||
if ( i > -1 ) then
|
||||
errMsg := remoteErr.Items[i].AsString
|
||||
else
|
||||
errMsg := '';
|
||||
errMsg := remoteErr.AsJSON;
|
||||
e := EJsonRpcException.Create(errMsg);
|
||||
e.FaultCode := errCode;
|
||||
e.FaultString := errMsg;
|
||||
@ -197,7 +281,35 @@ begin
|
||||
);
|
||||
end;
|
||||
|
||||
Initialization
|
||||
{ TJsonRpcSequencedIdManager }
|
||||
|
||||
constructor TJsonRpcSequencedIdManager.Create();
|
||||
begin
|
||||
FIdSequenceLock := TCriticalSection.Create();
|
||||
end;
|
||||
|
||||
destructor TJsonRpcSequencedIdManager.Destroy();
|
||||
begin
|
||||
FreeAndNil(FIdSequenceLock);
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
||||
function TJsonRpcSequencedIdManager.GetNewID() : PtrInt;
|
||||
begin
|
||||
FIdSequenceLock.Acquire();
|
||||
try
|
||||
Inc(FIdSequence);
|
||||
Result := FIdSequence;
|
||||
finally
|
||||
FIdSequenceLock.Release();
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
SetIdManager(TJsonRpcSequencedIdManager.Create());
|
||||
RegisterJsonProtocol();
|
||||
|
||||
finalization
|
||||
FreeAndNil(FIdManager);
|
||||
|
||||
end.
|
||||
|
||||
@ -13,12 +13,12 @@
|
||||
{$INCLUDE wst_global.inc}
|
||||
unit library_protocol;
|
||||
|
||||
//{$DEFINE WST_DBG}
|
||||
{$DEFINE WST_DBG}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,{$IFDEF WST_DBG}Dialogs,{$ENDIF}
|
||||
Classes, SysUtils,
|
||||
service_intf, imp_utils, base_service_intf, library_base_intf,
|
||||
library_imp_utils;
|
||||
|
||||
@ -148,9 +148,7 @@ begin
|
||||
SetLength(s,AResponse.Size);
|
||||
AResponse.Read(s[1],AResponse.Size);
|
||||
if IsConsole then
|
||||
WriteLn(s)
|
||||
{else
|
||||
ShowMessage(s);}
|
||||
WriteLn(s);
|
||||
{$ENDIF WST_DBG}
|
||||
finally
|
||||
buffStream.Free();
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value=".\"/>
|
||||
<TargetFileExt Value=".exe"/>
|
||||
<ActiveEditorIndexAtStart Value="3"/>
|
||||
<ActiveEditorIndexAtStart Value="2"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
@ -25,15 +25,15 @@
|
||||
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="13">
|
||||
<Units Count="14">
|
||||
<Unit0>
|
||||
<Filename Value="lib_server.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="lib_server"/>
|
||||
<CursorPos X="19" Y="22"/>
|
||||
<TopLine Value="19"/>
|
||||
<CursorPos X="1" Y="47"/>
|
||||
<TopLine Value="20"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="28"/>
|
||||
<UsageCount Value="31"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
@ -42,7 +42,7 @@
|
||||
<CursorPos X="32" Y="91"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="13"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
@ -51,7 +51,7 @@
|
||||
<CursorPos X="43" Y="179"/>
|
||||
<TopLine Value="157"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<UsageCount Value="13"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
@ -60,7 +60,7 @@
|
||||
<CursorPos X="53" Y="43"/>
|
||||
<TopLine Value="184"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<UsageCount Value="13"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
@ -69,7 +69,7 @@
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<UsageCount Value="13"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
@ -78,7 +78,7 @@
|
||||
<CursorPos X="3" Y="133"/>
|
||||
<TopLine Value="119"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<UsageCount Value="13"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
@ -87,7 +87,7 @@
|
||||
<CursorPos X="1" Y="137"/>
|
||||
<TopLine Value="113"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<UsageCount Value="13"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
@ -96,7 +96,7 @@
|
||||
<CursorPos X="2" Y="13"/>
|
||||
<TopLine Value="34"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<UsageCount Value="11"/>
|
||||
<UsageCount Value="13"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
@ -109,19 +109,19 @@
|
||||
<Unit9>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<UnitName Value="server_service_json"/>
|
||||
<CursorPos X="104" Y="54"/>
|
||||
<TopLine Value="34"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="10"/>
|
||||
<CursorPos X="3" Y="209"/>
|
||||
<TopLine Value="200"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="..\..\base_json_formatter.pas"/>
|
||||
<UnitName Value="base_json_formatter"/>
|
||||
<CursorPos X="48" Y="177"/>
|
||||
<TopLine Value="163"/>
|
||||
<CursorPos X="3" Y="181"/>
|
||||
<TopLine Value="307"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="10"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
@ -130,7 +130,7 @@
|
||||
<CursorPos X="95" Y="200"/>
|
||||
<TopLine Value="177"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="10"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
@ -138,12 +138,132 @@
|
||||
<UnitName Value="base_soap_formatter"/>
|
||||
<CursorPos X="57" Y="129"/>
|
||||
<TopLine Value="115"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="11"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<UnitName Value="fpjson"/>
|
||||
<CursorPos X="31" Y="1213"/>
|
||||
<TopLine Value="1199"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="10"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit12>
|
||||
</Unit13>
|
||||
</Units>
|
||||
<JumpHistory Count="0" HistoryIndex="-1"/>
|
||||
<JumpHistory Count="28" HistoryIndex="27">
|
||||
<Position1>
|
||||
<Filename Value="lib_server.lpr"/>
|
||||
<Caret Line="22" Column="19" TopLine="19"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="45" Column="34" TopLine="32"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="27" Column="38" TopLine="19"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="32" Column="35" TopLine="31"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="102" Column="1" TopLine="70"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="187" Column="6" TopLine="170"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="188" Column="8" TopLine="171"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="109" Column="1" TopLine="98"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="102" Column="3" TopLine="98"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="32" Column="23" TopLine="31"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="49" Column="36" TopLine="34"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="105" Column="20" TopLine="91"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="lib_server.lpr"/>
|
||||
<Caret Line="47" Column="1" TopLine="20"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="150" Column="37" TopLine="136"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="59" Column="14" TopLine="45"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="63" Column="45" TopLine="49"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="151" Column="29" TopLine="136"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="63" Column="42" TopLine="49"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="40" Column="23" TopLine="26"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="63" Column="45" TopLine="49"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="169" Column="14" TopLine="155"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="177" Column="23" TopLine="163"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="273" Column="23" TopLine="259"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="328" Column="60" TopLine="314"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="466" Column="29" TopLine="452"/>
|
||||
</Position25>
|
||||
<Position26>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<Caret Line="673" Column="29" TopLine="659"/>
|
||||
</Position26>
|
||||
<Position27>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="178" Column="36" TopLine="151"/>
|
||||
</Position27>
|
||||
<Position28>
|
||||
<Filename Value="..\..\server_service_json.pas"/>
|
||||
<Caret Line="140" Column="22" TopLine="137"/>
|
||||
</Position28>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
|
||||
@ -12,7 +12,7 @@
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value=".\"/>
|
||||
<TargetFileExt Value=".exe"/>
|
||||
<ActiveEditorIndexAtStart Value="3"/>
|
||||
<ActiveEditorIndexAtStart Value="1"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
@ -30,15 +30,15 @@
|
||||
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="48">
|
||||
<Units Count="55">
|
||||
<Unit0>
|
||||
<Filename Value="user_client_console.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="user_client_console"/>
|
||||
<CursorPos X="73" Y="8"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="15" Y="153"/>
|
||||
<TopLine Value="146"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="82"/>
|
||||
<UsageCount Value="86"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
@ -46,8 +46,8 @@
|
||||
<UnitName Value="user_service_intf_proxy"/>
|
||||
<CursorPos X="1" Y="65"/>
|
||||
<TopLine Value="51"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<UsageCount Value="33"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<UsageCount Value="35"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
@ -55,8 +55,8 @@
|
||||
<UnitName Value="synapse_tcp_protocol"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="17"/>
|
||||
<UsageCount Value="40"/>
|
||||
<EditorIndex Value="18"/>
|
||||
<UsageCount Value="42"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
@ -64,17 +64,17 @@
|
||||
<UnitName Value="service_intf"/>
|
||||
<CursorPos X="1" Y="251"/>
|
||||
<TopLine Value="237"/>
|
||||
<EditorIndex Value="15"/>
|
||||
<UsageCount Value="36"/>
|
||||
<EditorIndex Value="16"/>
|
||||
<UsageCount Value="38"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="..\user_service_intf.pas"/>
|
||||
<UnitName Value="user_service_intf"/>
|
||||
<CursorPos X="53" Y="11"/>
|
||||
<CursorPos X="27" Y="2"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="10"/>
|
||||
<UsageCount Value="32"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<UsageCount Value="34"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
@ -87,17 +87,19 @@
|
||||
<Unit6>
|
||||
<Filename Value="..\..\base_service_intf.pas"/>
|
||||
<UnitName Value="base_service_intf"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="32"/>
|
||||
<CursorPos X="15" Y="394"/>
|
||||
<TopLine Value="405"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="33"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="..\..\library_protocol.pas"/>
|
||||
<UnitName Value="library_protocol"/>
|
||||
<CursorPos X="5" Y="165"/>
|
||||
<TopLine Value="138"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="28"/>
|
||||
<CursorPos X="1" Y="152"/>
|
||||
<TopLine Value="105"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<UsageCount Value="30"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
@ -142,8 +144,8 @@
|
||||
<UnitName Value="synapse_http_protocol"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="13"/>
|
||||
<EditorIndex Value="14"/>
|
||||
<UsageCount Value="22"/>
|
||||
<EditorIndex Value="15"/>
|
||||
<UsageCount Value="24"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit14>
|
||||
<Unit15>
|
||||
@ -164,8 +166,8 @@
|
||||
<UnitName Value="library_imp_utils"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="89"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<UsageCount Value="13"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit17>
|
||||
<Unit18>
|
||||
@ -179,8 +181,8 @@
|
||||
<UnitName Value="semaphore"/>
|
||||
<CursorPos X="1" Y="137"/>
|
||||
<TopLine Value="113"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<UsageCount Value="13"/>
|
||||
<EditorIndex Value="9"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit19>
|
||||
<Unit20>
|
||||
@ -196,15 +198,15 @@
|
||||
<UnitName Value="xmlrpc_formatter"/>
|
||||
<CursorPos X="54" Y="21"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="68"/>
|
||||
<UsageCount Value="72"/>
|
||||
</Unit21>
|
||||
<Unit22>
|
||||
<Filename Value="..\..\binary_formatter.pas"/>
|
||||
<UnitName Value="binary_formatter"/>
|
||||
<CursorPos X="20" Y="21"/>
|
||||
<TopLine Value="12"/>
|
||||
<EditorIndex Value="16"/>
|
||||
<UsageCount Value="33"/>
|
||||
<EditorIndex Value="17"/>
|
||||
<UsageCount Value="35"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit22>
|
||||
<Unit23>
|
||||
@ -257,9 +259,11 @@
|
||||
<Unit30>
|
||||
<Filename Value="..\..\imp_utils.pas"/>
|
||||
<UnitName Value="imp_utils"/>
|
||||
<CursorPos X="41" Y="3"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="15"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="2"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="16"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit30>
|
||||
<Unit31>
|
||||
<Filename Value="..\..\wst_fpc_xml.pas"/>
|
||||
@ -308,8 +312,8 @@
|
||||
<UnitName Value="indy_http_protocol"/>
|
||||
<CursorPos X="1" Y="16"/>
|
||||
<TopLine Value="109"/>
|
||||
<EditorIndex Value="13"/>
|
||||
<UsageCount Value="18"/>
|
||||
<EditorIndex Value="14"/>
|
||||
<UsageCount Value="20"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit37>
|
||||
<Unit38>
|
||||
@ -331,8 +335,8 @@
|
||||
<UnitName Value="ics_http_protocol"/>
|
||||
<CursorPos X="1" Y="25"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="12"/>
|
||||
<UsageCount Value="17"/>
|
||||
<EditorIndex Value="13"/>
|
||||
<UsageCount Value="19"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit40>
|
||||
<Unit41>
|
||||
@ -340,8 +344,8 @@
|
||||
<UnitName Value="same_process_protocol"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="13"/>
|
||||
<EditorIndex Value="11"/>
|
||||
<UsageCount Value="17"/>
|
||||
<EditorIndex Value="12"/>
|
||||
<UsageCount Value="19"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit41>
|
||||
<Unit42>
|
||||
@ -359,8 +363,8 @@
|
||||
<UnitName Value="binary_streamer"/>
|
||||
<CursorPos X="1" Y="270"/>
|
||||
<TopLine Value="256"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<UsageCount Value="13"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit43>
|
||||
<Unit44>
|
||||
@ -368,50 +372,104 @@
|
||||
<UnitName Value="library_base_intf"/>
|
||||
<CursorPos X="25" Y="17"/>
|
||||
<TopLine Value="5"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="13"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<UsageCount Value="15"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit44>
|
||||
<Unit45>
|
||||
<Filename Value="..\..\json_formatter.pas"/>
|
||||
<UnitName Value="json_formatter"/>
|
||||
<CursorPos X="1" Y="123"/>
|
||||
<TopLine Value="109"/>
|
||||
<CursorPos X="54" Y="157"/>
|
||||
<TopLine Value="139"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="10"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit45>
|
||||
<Unit46>
|
||||
<Filename Value="..\..\base_json_formatter.pas"/>
|
||||
<UnitName Value="base_json_formatter"/>
|
||||
<CursorPos X="69" Y="1105"/>
|
||||
<TopLine Value="1088"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="10"/>
|
||||
<CursorPos X="17" Y="44"/>
|
||||
<TopLine Value="33"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit46>
|
||||
<Unit47>
|
||||
<Filename Value="..\..\wst_global.inc"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="4"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="10"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit47>
|
||||
<Unit48>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-json\src\fpjson.pp"/>
|
||||
<UnitName Value="fpjson"/>
|
||||
<CursorPos X="23" Y="267"/>
|
||||
<TopLine Value="243"/>
|
||||
<UsageCount Value="11"/>
|
||||
</Unit48>
|
||||
<Unit49>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\packages\fcl-base\src\inc\contnrs.pp"/>
|
||||
<UnitName Value="contnrs"/>
|
||||
<CursorPos X="14" Y="311"/>
|
||||
<TopLine Value="269"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit49>
|
||||
<Unit50>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\rtl\inc\systemh.inc"/>
|
||||
<CursorPos X="10" Y="719"/>
|
||||
<TopLine Value="705"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit50>
|
||||
<Unit51>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\rtl\i386\i386.inc"/>
|
||||
<CursorPos X="10" Y="890"/>
|
||||
<TopLine Value="876"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit51>
|
||||
<Unit52>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\rtl\objpas\sysutils\sysutilh.inc"/>
|
||||
<CursorPos X="13" Y="181"/>
|
||||
<TopLine Value="223"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit52>
|
||||
<Unit53>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\rtl\objpas\sysutils\sysutils.inc"/>
|
||||
<CursorPos X="3" Y="326"/>
|
||||
<TopLine Value="318"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit53>
|
||||
<Unit54>
|
||||
<Filename Value="..\..\..\..\..\..\..\lazarus\fpc\2.2.1\source\rtl\objpas\sysutils\osutilsh.inc"/>
|
||||
<CursorPos X="11" Y="20"/>
|
||||
<TopLine Value="20"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit54>
|
||||
</Units>
|
||||
<JumpHistory Count="3" HistoryIndex="2">
|
||||
<JumpHistory Count="6" HistoryIndex="5">
|
||||
<Position1>
|
||||
<Filename Value="..\..\library_protocol.pas"/>
|
||||
<Caret Line="120" Column="8" TopLine="117"/>
|
||||
<Filename Value="user_client_console.pas"/>
|
||||
<Caret Line="162" Column="7" TopLine="138"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="..\..\library_protocol.pas"/>
|
||||
<Caret Line="16" Column="3" TopLine="1"/>
|
||||
<Filename Value="user_client_console.pas"/>
|
||||
<Caret Line="163" Column="1" TopLine="138"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="..\..\library_protocol.pas"/>
|
||||
<Caret Line="1" Column="2" TopLine="1"/>
|
||||
<Filename Value="user_client_console.pas"/>
|
||||
<Caret Line="153" Column="16" TopLine="145"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="user_client_console.pas"/>
|
||||
<Caret Line="156" Column="18" TopLine="142"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="user_client_console.pas"/>
|
||||
<Caret Line="158" Column="18" TopLine="144"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="user_client_console.pas"/>
|
||||
<Caret Line="167" Column="37" TopLine="146"/>
|
||||
</Position6>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
@ -456,12 +514,12 @@
|
||||
<Line Value="606"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Source Value="..\..\json_formatter.pas"/>
|
||||
<Line Value="184"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Source Value="..\user_service_intf_proxy.pas"/>
|
||||
<Line Value="65"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Source Value="user_client_console.pas"/>
|
||||
<Line Value="163"/>
|
||||
</Item6>
|
||||
</BreakPoints>
|
||||
<Watches Count="2">
|
||||
|
||||
@ -135,7 +135,7 @@ end;
|
||||
|
||||
type
|
||||
TTransportType = ( ttLibrary, ttTCP, ttHTTP );
|
||||
TFormatType = ( ftBinary, ftSoap, ftXmlRPC, ftJSON );
|
||||
TFormatType = ( ftBinary, ftSoap, ftXmlRPC, ftJSON_10, ftJSON_11 );
|
||||
var
|
||||
TransportType : TTransportType;
|
||||
FormatValue : TFormatType;
|
||||
@ -148,20 +148,23 @@ const ADDRESS_MAP : array[TTransportType] of string = (
|
||||
'http:Address=http://127.0.0.1:8888/wst/services/lib_server/UserService'
|
||||
//'http:Address=http://127.0.0.1:8000/services/UserService'
|
||||
);
|
||||
FORMAT_MAP : array[TFormatType] of string =( 'binary', 'soap', 'xmlrpc', 'json' );
|
||||
FORMAT_MAP : array[TFormatType] of string =( 'binary', 'soap', 'xmlrpc', 'json', 'json' );
|
||||
var
|
||||
buff : string;
|
||||
buffTransport, buffFormat : string;
|
||||
begin
|
||||
if ( TransportType = ttHTTP ) then
|
||||
buff := Format('%s/?format=%s',[ADDRESS_MAP[TransportType],FORMAT_MAP[FormatValue]])
|
||||
buffTransport := Format('%s/?format=%s',[ADDRESS_MAP[TransportType],FORMAT_MAP[FormatValue]])
|
||||
else
|
||||
buff := ADDRESS_MAP[TransportType];
|
||||
buffTransport := ADDRESS_MAP[TransportType];
|
||||
if ( TransportType = ttLibrary ) then
|
||||
buff := StringReplace(buff,'\',DirectorySeparator,[rfReplaceAll, rfIgnoreCase]);
|
||||
buffTransport := StringReplace(buffTransport,'\',DirectorySeparator,[rfReplaceAll, rfIgnoreCase]);
|
||||
buffFormat := FORMAT_MAP[FormatValue] + ':';
|
||||
if ( FormatValue = ftJSON_11 ) then
|
||||
buffFormat := Format('%sversion=%s',[buffFormat,'1.1']);
|
||||
UserServiceInst := TUserService_Proxy.Create(
|
||||
'UserService',
|
||||
FORMAT_MAP[FormatValue] + ':',
|
||||
buff
|
||||
buffFormat,
|
||||
buffTransport
|
||||
);
|
||||
end;
|
||||
|
||||
@ -197,7 +200,8 @@ begin
|
||||
WriteLn();
|
||||
WriteLn('Select a messaging format : ');
|
||||
WriteLn(' B : binary ( binary_formatter.pas )');
|
||||
WriteLn(' J : JSON ( json_formatter.pas )');
|
||||
WriteLn(' J : JSON-RPC 1.0 ( json_formatter.pas )');
|
||||
WriteLn(' K : JSON-RPC 1.1 ( json_formatter.pas )');
|
||||
WriteLn(' S : soap ( soap_formatter.pas )');
|
||||
WriteLn(' X : XmlRpc ( xmlrpc_formatter.pas )');
|
||||
WriteLn();
|
||||
@ -205,10 +209,11 @@ begin
|
||||
while True do begin
|
||||
ReadLn(buff);
|
||||
buff := UpperCase(Trim(buff));
|
||||
if ( Length(buff) > 0 ) and ( buff[1] in ['B', 'J', 'S', 'X'] ) then begin
|
||||
if ( Length(buff) > 0 ) and ( buff[1] in ['B', 'J', 'K', 'S', 'X'] ) then begin
|
||||
case buff[1] of
|
||||
'B' : FormatValue := ftBinary;
|
||||
'J' : FormatValue := ftJSON;
|
||||
'J' : FormatValue := ftJSON_10;
|
||||
'K' : FormatValue := ftJSON_11;
|
||||
'S' : FormatValue := ftSoap;
|
||||
'X' : FormatValue := ftXmlRPC;
|
||||
end;
|
||||
|
||||
@ -71,6 +71,7 @@ end;
|
||||
|
||||
procedure TBinaryFormatter.BeginCallResponse(const AProcName, ATarget: string);
|
||||
begin
|
||||
Clear();
|
||||
BeginObject('Body',Nil);
|
||||
BeginObject(ATarget,Nil);
|
||||
BeginObject(AProcName + 'Response',Nil);
|
||||
@ -118,6 +119,7 @@ procedure TBinaryFormatter.BeginExceptionList(
|
||||
const AErrorMsg: string
|
||||
);
|
||||
begin
|
||||
Clear();
|
||||
BeginObject('Body',Nil);
|
||||
BeginObject('Fault',Nil);
|
||||
Put('faultcode',TypeInfo(string),AErrorCode);
|
||||
|
||||
173
wst/trunk/tests/test_suite/test_json.pas
Normal file
173
wst/trunk/tests/test_suite/test_json.pas
Normal file
@ -0,0 +1,173 @@
|
||||
{
|
||||
This file is part of the Web Service Toolkit
|
||||
Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO
|
||||
|
||||
This file is provide under modified LGPL licence
|
||||
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
||||
|
||||
|
||||
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.
|
||||
}
|
||||
{$INCLUDE wst_global.inc}
|
||||
unit test_json;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
{$IFDEF FPC}
|
||||
fpcunit, testutils, testregistry,
|
||||
{$ENDIF}
|
||||
{$IFDEF WST_DELPHI}
|
||||
TestFrameWork, ActiveX,
|
||||
{$ENDIF}
|
||||
TypInfo,
|
||||
base_service_intf, wst_types, server_service_intf, service_intf,
|
||||
fpjson, jsonparser, base_json_formatter, json_formatter, server_service_json,
|
||||
testformatter_unit;
|
||||
|
||||
type
|
||||
|
||||
{ TTestJsonRpcFormatter }
|
||||
|
||||
TTestJsonRpcFormatter= class(TTestFormatter)
|
||||
protected
|
||||
class function GetFormaterName() : string;override;
|
||||
function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override;
|
||||
function Support_ComplextType_with_SimpleContent():Boolean;override;
|
||||
function Support_nil():Boolean;override;
|
||||
published
|
||||
//procedure test_WriteBuffer();
|
||||
end;
|
||||
|
||||
{ TTest_JsonRpcFormatterExceptionBlock }
|
||||
|
||||
TTest_JsonRpcFormatterExceptionBlock = class(TTestCase)
|
||||
protected
|
||||
function CreateFormatter():IFormatterResponse;
|
||||
function CreateFormatterClient():IFormatterClient;
|
||||
published
|
||||
procedure ExceptBlock_server();
|
||||
procedure ExceptBlock_client();
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestJsonRpcFormatter }
|
||||
|
||||
class function TTestJsonRpcFormatter.GetFormaterName() : string;
|
||||
begin
|
||||
Result := 'json';
|
||||
end;
|
||||
|
||||
function TTestJsonRpcFormatter.CreateFormatter(ARootType : PTypeInfo) : IFormatterBase;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
Result := TJsonRpcBaseFormatter.Create();
|
||||
Result.BeginObject('root',nil);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TTestJsonRpcFormatter.Support_ComplextType_with_SimpleContent() : Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TTestJsonRpcFormatter.Support_nil() : Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{ TTest_JsonRpcFormatterExceptionBlock }
|
||||
|
||||
function TTest_JsonRpcFormatterExceptionBlock.CreateFormatter() : IFormatterResponse;
|
||||
begin
|
||||
Result := server_service_json.TJsonRpcFormatter.Create() as IFormatterResponse;
|
||||
end;
|
||||
|
||||
function TTest_JsonRpcFormatterExceptionBlock.CreateFormatterClient() : IFormatterClient;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
Result := json_formatter.TJsonRpcFormatter.Create() as IFormatterClient;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TTest_JsonRpcFormatterExceptionBlock.ExceptBlock_server();
|
||||
const VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.';
|
||||
var
|
||||
f : IFormatterResponse;
|
||||
strm : TMemoryStream;
|
||||
locParser : TJSONParser;
|
||||
root, errorNodeObj : TJSONObject;
|
||||
errorNode, tmpNode : TJSONData;
|
||||
excpt_code, excpt_msg : string;
|
||||
begin
|
||||
root := nil;
|
||||
f := CreateFormatter();
|
||||
f.BeginExceptionList(VAL_CODE,VAL_MSG);
|
||||
f.EndExceptionList();
|
||||
locParser := nil;
|
||||
strm := TMemoryStream.Create();
|
||||
try
|
||||
f.SaveToStream(strm); strm.SaveToFile('TTest_JsonRpcFormatterExceptionBlock.ExceptBlock_server.txt');
|
||||
strm.Position := 0;
|
||||
locParser := TJSONParser.Create(strm);
|
||||
root := locParser.Parse() as TJSONObject;
|
||||
Check(Assigned(root));
|
||||
errorNode := root.Elements[s_json_error];
|
||||
Check(Assigned(errorNode),'Error');
|
||||
Check(errorNode.JSONType() = jtObject);
|
||||
errorNodeObj := errorNode as TJSONObject;
|
||||
Check(errorNodeObj.IndexOfName(s_json_code) >= 0, s_json_code);
|
||||
Check(errorNodeObj.IndexOfName(s_json_message) >= 0, s_json_message);
|
||||
excpt_code := errorNodeObj.Elements[s_json_code].AsString;
|
||||
excpt_msg := errorNodeObj.Elements[s_json_message].AsString;
|
||||
CheckEquals(VAL_CODE,excpt_code,'faultCode');
|
||||
CheckEquals(VAL_MSG,excpt_msg,'faultString');
|
||||
finally
|
||||
locParser.Free();
|
||||
FreeAndNil(strm);
|
||||
root.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_JsonRpcFormatterExceptionBlock.ExceptBlock_client();
|
||||
const
|
||||
VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.';
|
||||
VAL_STREAM = '{ "result" : null, "error" : { "code" : ' + VAL_CODE + ', "message" : "' + VAL_MSG + '" } }';
|
||||
var
|
||||
f : IFormatterClient;
|
||||
strm : TStringStream;
|
||||
excpt_code, excpt_msg : string;
|
||||
begin
|
||||
excpt_code := '';
|
||||
excpt_msg := '';
|
||||
f := CreateFormatterClient();
|
||||
strm := TStringStream.Create(VAL_STREAM);
|
||||
try
|
||||
strm.Position := 0;
|
||||
f.LoadFromStream(strm);
|
||||
try
|
||||
f.BeginCallRead(nil);
|
||||
Check(False,'BeginCallRead() should raise an exception.');
|
||||
except
|
||||
on e : EJsonRpcException do begin
|
||||
excpt_code := e.FaultCode;
|
||||
excpt_msg := e.FaultString;
|
||||
end;
|
||||
end;
|
||||
CheckEquals(VAL_CODE,excpt_code,'faultCode');
|
||||
CheckEquals(VAL_MSG,excpt_msg,'faultString');
|
||||
finally
|
||||
FreeAndNil(strm);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest('Serializer',TTestJsonRpcFormatter.Suite);
|
||||
RegisterTest('Serializer',TTest_JsonRpcFormatterExceptionBlock.Suite);
|
||||
|
||||
end.
|
||||
@ -24,11 +24,7 @@ uses
|
||||
TestFrameWork, ActiveX,
|
||||
{$ENDIF}
|
||||
TypInfo,
|
||||
base_service_intf, wst_types, server_service_intf, service_intf
|
||||
{$IFDEF FPC}
|
||||
, fpjson, jsonparser, base_json_formatter, json_formatter, server_service_json
|
||||
{$ENDIF}
|
||||
;
|
||||
base_service_intf, wst_types, server_service_intf, service_intf;
|
||||
|
||||
type
|
||||
|
||||
@ -445,18 +441,6 @@ type
|
||||
procedure test_WriteBuffer();
|
||||
end;
|
||||
|
||||
{ TTestJsonRpcFormatter }
|
||||
|
||||
TTestJsonRpcFormatter= class(TTestFormatter)
|
||||
protected
|
||||
class function GetFormaterName() : string;override;
|
||||
function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override;
|
||||
function Support_ComplextType_with_SimpleContent():Boolean;override;
|
||||
function Support_nil():Boolean;override;
|
||||
published
|
||||
//procedure test_WriteBuffer();
|
||||
end;
|
||||
|
||||
{ TTestArray }
|
||||
|
||||
TTestArray= class(TTestCase)
|
||||
@ -526,17 +510,6 @@ type
|
||||
procedure ExceptBlock_client();
|
||||
end;
|
||||
|
||||
{ TTest_JsonRpcFormatterExceptionBlock }
|
||||
|
||||
TTest_JsonRpcFormatterExceptionBlock = class(TTestCase)
|
||||
protected
|
||||
function CreateFormatter():IFormatterResponse;
|
||||
function CreateFormatterClient():IFormatterClient;
|
||||
published
|
||||
procedure ExceptBlock_server();
|
||||
procedure ExceptBlock_client();
|
||||
end;
|
||||
|
||||
{ TTest_TStringBufferRemotable }
|
||||
|
||||
TTest_TStringBufferRemotable = class(TTestCase)
|
||||
@ -4244,116 +4217,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTestJsonRpcFormatter }
|
||||
|
||||
class function TTestJsonRpcFormatter.GetFormaterName() : string;
|
||||
begin
|
||||
Result := 'json';
|
||||
end;
|
||||
|
||||
function TTestJsonRpcFormatter.CreateFormatter(ARootType : PTypeInfo) : IFormatterBase;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
Result := TJsonRpcBaseFormatter.Create();
|
||||
Result.BeginObject('root',nil);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TTestJsonRpcFormatter.Support_ComplextType_with_SimpleContent() : Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TTestJsonRpcFormatter.Support_nil() : Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{ TTest_JsonRpcFormatterExceptionBlock }
|
||||
|
||||
function TTest_JsonRpcFormatterExceptionBlock.CreateFormatter() : IFormatterResponse;
|
||||
begin
|
||||
Result := server_service_json.TJsonRpcFormatter.Create() as IFormatterResponse;
|
||||
end;
|
||||
|
||||
function TTest_JsonRpcFormatterExceptionBlock.CreateFormatterClient() : IFormatterClient;
|
||||
begin
|
||||
{$IFDEF FPC}
|
||||
Result := json_formatter.TJsonRpcFormatter.Create() as IFormatterClient;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TTest_JsonRpcFormatterExceptionBlock.ExceptBlock_server();
|
||||
const VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.';
|
||||
var
|
||||
f : IFormatterResponse;
|
||||
strm : TMemoryStream;
|
||||
locParser : TJSONParser;
|
||||
root, errorNodeObj : TJSONObject;
|
||||
errorNode, tmpNode : TJSONData;
|
||||
excpt_code, excpt_msg : string;
|
||||
begin
|
||||
root := nil;
|
||||
f := CreateFormatter();
|
||||
f.BeginExceptionList(VAL_CODE,VAL_MSG);
|
||||
f.EndExceptionList();
|
||||
locParser := nil;
|
||||
strm := TMemoryStream.Create();
|
||||
try
|
||||
f.SaveToStream(strm); strm.SaveToFile('TTest_JsonRpcFormatterExceptionBlock.ExceptBlock_server.txt');
|
||||
strm.Position := 0;
|
||||
locParser := TJSONParser.Create(strm);
|
||||
root := locParser.Parse() as TJSONObject;
|
||||
Check(Assigned(root));
|
||||
errorNode := root.Elements[s_json_error];
|
||||
Check(Assigned(errorNode),'Error');
|
||||
Check(errorNode.JSONType() = jtObject);
|
||||
errorNodeObj := errorNode as TJSONObject;
|
||||
Check(errorNodeObj.IndexOfName(s_json_code) >= 0, s_json_code);
|
||||
Check(errorNodeObj.IndexOfName(s_json_message) >= 0, s_json_message);
|
||||
excpt_code := errorNodeObj.Elements[s_json_code].AsString;
|
||||
excpt_msg := errorNodeObj.Elements[s_json_message].AsString;
|
||||
CheckEquals(VAL_CODE,excpt_code,'faultCode');
|
||||
CheckEquals(VAL_MSG,excpt_msg,'faultString');
|
||||
finally
|
||||
locParser.Free();
|
||||
FreeAndNil(strm);
|
||||
root.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest_JsonRpcFormatterExceptionBlock.ExceptBlock_client();
|
||||
const
|
||||
VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.';
|
||||
VAL_STREAM = '{ "result" : null, "error" : { "code" : ' + VAL_CODE + ', "message" : "' + VAL_MSG + '" } }';
|
||||
var
|
||||
f : IFormatterClient;
|
||||
strm : TStringStream;
|
||||
excpt_code, excpt_msg : string;
|
||||
begin
|
||||
excpt_code := '';
|
||||
excpt_msg := '';
|
||||
f := CreateFormatterClient();
|
||||
strm := TStringStream.Create(VAL_STREAM);
|
||||
try
|
||||
strm.Position := 0;
|
||||
f.LoadFromStream(strm);
|
||||
try
|
||||
f.BeginCallRead(nil);
|
||||
Check(False,'BeginCallRead() should raise an exception.');
|
||||
except
|
||||
on e : EJsonRpcException do begin
|
||||
excpt_code := e.FaultCode;
|
||||
excpt_msg := e.FaultString;
|
||||
end;
|
||||
end;
|
||||
CheckEquals(VAL_CODE,excpt_code,'faultCode');
|
||||
CheckEquals(VAL_MSG,excpt_msg,'faultString');
|
||||
finally
|
||||
FreeAndNil(strm);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterStdTypes();
|
||||
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TTestEnum),'TTestEnum').RegisterExternalPropertyName('teOne', '1');
|
||||
@ -4418,9 +4281,5 @@ initialization
|
||||
RegisterTest('Serializer',TTest_XmlRpcFormatterExceptionBlock.Suite);
|
||||
RegisterTest('Serializer',TTest_BinaryFormatterExceptionBlock.Suite);
|
||||
RegisterTest('Serializer',TTest_TStringBufferRemotable.Suite);
|
||||
{$IFDEF FPC}
|
||||
RegisterTest('Serializer',TTestJsonRpcFormatter.Suite);
|
||||
RegisterTest('Serializer',TTest_JsonRpcFormatterExceptionBlock.Suite);
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user