pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

resync

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@304 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2007-12-29 17:21:48 +00:00
parent 4ac8b874cf
commit 683d9d9f9d
9 changed files with 582 additions and 251 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
wst/trunk/base_json_formatter.pas
View File

@ -33,11 +33,15 @@ const
s_json_name = 'name'; s_json_name = 'name';
s_json_params = 'params'; s_json_params = 'params';
s_json_result = 'result'; 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; stNilScope = stBase + 7;
type type
TJonRPCVersion = ( jsonRPC_10, jsonRPC_11 );
TJsonInteger = Integer; TJsonInteger = Integer;
TEnumIntType = Integer; TEnumIntType = Integer;

126
wst/trunk/json_formatter.pas
View File

@ -18,7 +18,7 @@ interface
uses uses
Classes, SysUtils, TypInfo, Classes, SysUtils, TypInfo,
base_service_intf, service_intf, imp_utils, base_service_intf, service_intf, imp_utils,
base_json_formatter, fpjson; base_json_formatter, fpjson, SyncObjs;
type type
@ -31,8 +31,12 @@ type
FPropMngr : IPropertyManager; FPropMngr : IPropertyManager;
FCallProcedureName : string; FCallProcedureName : string;
FCallTarget : string; FCallTarget : string;
protected FVersion : string;
FVersionEnum : TJonRPCVersion;
private
procedure SetVersion(const AValue : string);
public public
constructor Create();override;
function GetPropertyManager():IPropertyManager; function GetPropertyManager():IPropertyManager;
procedure BeginCall( procedure BeginCall(
@ -45,6 +49,9 @@ type
function GetCallProcedureName():string; function GetCallProcedureName():string;
function GetCallTarget():string; function GetCallTarget():string;
property VersionEnum : TJonRPCVersion read FVersionEnum;
published
property Version : string read FVersion write SetVersion;
end; end;
{ TJsonRpcCallMaker } { TJsonRpcCallMaker }
@ -62,12 +69,66 @@ type
); );
End; 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 RegisterJsonProtocol();
procedure SetIdManager(AValue : TJsonRpcCustomIdManager);{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetIdManager():TJsonRpcCustomIdManager ;{$IFDEF USE_INLINE}inline;{$ENDIF}
implementation implementation
uses
StrUtils;
var
FIdManager : TJsonRpcCustomIdManager;
function GetIdManager():TJsonRpcCustomIdManager ;
begin
Result := FIdManager;
end;
procedure SetIdManager(AValue : TJsonRpcCustomIdManager);
begin
FreeAndNil(FIdManager);
FIdManager := AValue;
end;
{ TJsonRpcFormatter } { 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; function TJsonRpcFormatter.GetPropertyManager() : IPropertyManager;
begin begin
If Not Assigned(FPropMngr) Then If Not Assigned(FPropMngr) Then
@ -83,14 +144,37 @@ begin
FCallProcedureName := AProcName; FCallProcedureName := AProcName;
FCallTarget := ATarget; FCallTarget := ATarget;
BeginObject('',Nil); case VersionEnum of
Put(s_json_method,TypeInfo(string),FCallProcedureName); jsonRPC_10 :
BeginArray(s_json_params,Nil,nil,[0,0],asScoped); 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; end;
procedure TJsonRpcFormatter.EndCall(); procedure TJsonRpcFormatter.EndCall();
var
i : PtrInt;
begin begin
EndScope(); // params 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 EndScope(); // Root object
end; end;
@ -116,7 +200,7 @@ begin
if ( i > -1 ) then if ( i > -1 ) then
errMsg := remoteErr.Items[i].AsString errMsg := remoteErr.Items[i].AsString
else else
errMsg := ''; errMsg := remoteErr.AsJSON;
e := EJsonRpcException.Create(errMsg); e := EJsonRpcException.Create(errMsg);
e.FaultCode := errCode; e.FaultCode := errCode;
e.FaultString := errMsg; e.FaultString := errMsg;
@ -197,7 +281,35 @@ begin
); );
end; 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(); RegisterJsonProtocol();
finalization
FreeAndNil(FIdManager);
end. end.

8
wst/trunk/library_protocol.pas
View File

@ -13,12 +13,12 @@
{$INCLUDE wst_global.inc} {$INCLUDE wst_global.inc}
unit library_protocol; unit library_protocol;
//{$DEFINE WST_DBG} {$DEFINE WST_DBG}
interface interface
uses uses
Classes, SysUtils,{$IFDEF WST_DBG}Dialogs,{$ENDIF} Classes, SysUtils,
service_intf, imp_utils, base_service_intf, library_base_intf, service_intf, imp_utils, base_service_intf, library_base_intf,
library_imp_utils; library_imp_utils;
@ -148,9 +148,7 @@ begin
SetLength(s,AResponse.Size); SetLength(s,AResponse.Size);
AResponse.Read(s[1],AResponse.Size); AResponse.Read(s[1],AResponse.Size);
if IsConsole then if IsConsole then
WriteLn(s) WriteLn(s);
{else
ShowMessage(s);}
{$ENDIF WST_DBG} {$ENDIF WST_DBG}
finally finally
buffStream.Free(); buffStream.Free();

166
wst/trunk/samples/library_server/lib_server.lpi
View File

@ -7,7 +7,7 @@
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value=".\"/> <IconPath Value=".\"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="3"/> <ActiveEditorIndexAtStart Value="2"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
@ -25,15 +25,15 @@
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<Units Count="13"> <Units Count="14">
<Unit0> <Unit0>
<Filename Value="lib_server.lpr"/> <Filename Value="lib_server.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="lib_server"/> <UnitName Value="lib_server"/>
<CursorPos X="19" Y="22"/> <CursorPos X="1" Y="47"/>
<TopLine Value="19"/> <TopLine Value="20"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="28"/> <UsageCount Value="31"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -42,7 +42,7 @@
<CursorPos X="32" Y="91"/> <CursorPos X="32" Y="91"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="6"/> <EditorIndex Value="6"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
@ -51,7 +51,7 @@
<CursorPos X="43" Y="179"/> <CursorPos X="43" Y="179"/>
<TopLine Value="157"/> <TopLine Value="157"/>
<EditorIndex Value="9"/> <EditorIndex Value="9"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
@ -60,7 +60,7 @@
<CursorPos X="53" Y="43"/> <CursorPos X="53" Y="43"/>
<TopLine Value="184"/> <TopLine Value="184"/>
<EditorIndex Value="11"/> <EditorIndex Value="11"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
@ -69,7 +69,7 @@
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="5"/> <EditorIndex Value="5"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
@ -78,7 +78,7 @@
<CursorPos X="3" Y="133"/> <CursorPos X="3" Y="133"/>
<TopLine Value="119"/> <TopLine Value="119"/>
<EditorIndex Value="10"/> <EditorIndex Value="10"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
@ -87,7 +87,7 @@
<CursorPos X="1" Y="137"/> <CursorPos X="1" Y="137"/>
<TopLine Value="113"/> <TopLine Value="113"/>
<EditorIndex Value="8"/> <EditorIndex Value="8"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
@ -96,7 +96,7 @@
<CursorPos X="2" Y="13"/> <CursorPos X="2" Y="13"/>
<TopLine Value="34"/> <TopLine Value="34"/>
<EditorIndex Value="7"/> <EditorIndex Value="7"/>
<UsageCount Value="11"/> <UsageCount Value="13"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
@ -109,19 +109,19 @@
<Unit9> <Unit9>
<Filename Value="..\..\server_service_json.pas"/> <Filename Value="..\..\server_service_json.pas"/>
<UnitName Value="server_service_json"/> <UnitName Value="server_service_json"/>
<CursorPos X="104" Y="54"/> <CursorPos X="3" Y="209"/>
<TopLine Value="34"/> <TopLine Value="200"/>
<EditorIndex Value="3"/> <EditorIndex Value="2"/>
<UsageCount Value="10"/> <UsageCount Value="12"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit9> </Unit9>
<Unit10> <Unit10>
<Filename Value="..\..\base_json_formatter.pas"/> <Filename Value="..\..\base_json_formatter.pas"/>
<UnitName Value="base_json_formatter"/> <UnitName Value="base_json_formatter"/>
<CursorPos X="48" Y="177"/> <CursorPos X="3" Y="181"/>
<TopLine Value="163"/> <TopLine Value="307"/>
<EditorIndex Value="4"/> <EditorIndex Value="4"/>
<UsageCount Value="10"/> <UsageCount Value="12"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit10> </Unit10>
<Unit11> <Unit11>
@ -130,7 +130,7 @@
<CursorPos X="95" Y="200"/> <CursorPos X="95" Y="200"/>
<TopLine Value="177"/> <TopLine Value="177"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<UsageCount Value="10"/> <UsageCount Value="12"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit11> </Unit11>
<Unit12> <Unit12>
@ -138,12 +138,132 @@
<UnitName Value="base_soap_formatter"/> <UnitName Value="base_soap_formatter"/>
<CursorPos X="57" Y="129"/> <CursorPos X="57" Y="129"/>
<TopLine Value="115"/> <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"/> <UsageCount Value="10"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit12> </Unit13>
</Units> </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> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="5"/>

184
wst/trunk/samples/user_client_console/user_client_console.lpi
View File

@ -12,7 +12,7 @@
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value=".\"/> <IconPath Value=".\"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="3"/> <ActiveEditorIndexAtStart Value="1"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
@ -30,15 +30,15 @@
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<Units Count="48"> <Units Count="55">
<Unit0> <Unit0>
<Filename Value="user_client_console.pas"/> <Filename Value="user_client_console.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="user_client_console"/> <UnitName Value="user_client_console"/>
<CursorPos X="73" Y="8"/> <CursorPos X="15" Y="153"/>
<TopLine Value="1"/> <TopLine Value="146"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="82"/> <UsageCount Value="86"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -46,8 +46,8 @@
<UnitName Value="user_service_intf_proxy"/> <UnitName Value="user_service_intf_proxy"/>
<CursorPos X="1" Y="65"/> <CursorPos X="1" Y="65"/>
<TopLine Value="51"/> <TopLine Value="51"/>
<EditorIndex Value="9"/> <EditorIndex Value="10"/>
<UsageCount Value="33"/> <UsageCount Value="35"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
@ -55,8 +55,8 @@
<UnitName Value="synapse_tcp_protocol"/> <UnitName Value="synapse_tcp_protocol"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="17"/> <EditorIndex Value="18"/>
<UsageCount Value="40"/> <UsageCount Value="42"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
@ -64,17 +64,17 @@
<UnitName Value="service_intf"/> <UnitName Value="service_intf"/>
<CursorPos X="1" Y="251"/> <CursorPos X="1" Y="251"/>
<TopLine Value="237"/> <TopLine Value="237"/>
<EditorIndex Value="15"/> <EditorIndex Value="16"/>
<UsageCount Value="36"/> <UsageCount Value="38"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="..\user_service_intf.pas"/> <Filename Value="..\user_service_intf.pas"/>
<UnitName Value="user_service_intf"/> <UnitName Value="user_service_intf"/>
<CursorPos X="53" Y="11"/> <CursorPos X="27" Y="2"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="10"/> <EditorIndex Value="11"/>
<UsageCount Value="32"/> <UsageCount Value="34"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
@ -87,17 +87,19 @@
<Unit6> <Unit6>
<Filename Value="..\..\base_service_intf.pas"/> <Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/> <UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="1"/> <CursorPos X="15" Y="394"/>
<TopLine Value="1"/> <TopLine Value="405"/>
<UsageCount Value="32"/> <EditorIndex Value="2"/>
<UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="..\..\library_protocol.pas"/> <Filename Value="..\..\library_protocol.pas"/>
<UnitName Value="library_protocol"/> <UnitName Value="library_protocol"/>
<CursorPos X="5" Y="165"/> <CursorPos X="1" Y="152"/>
<TopLine Value="138"/> <TopLine Value="105"/>
<EditorIndex Value="3"/> <EditorIndex Value="5"/>
<UsageCount Value="28"/> <UsageCount Value="30"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
@ -142,8 +144,8 @@
<UnitName Value="synapse_http_protocol"/> <UnitName Value="synapse_http_protocol"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="13"/> <TopLine Value="13"/>
<EditorIndex Value="14"/> <EditorIndex Value="15"/>
<UsageCount Value="22"/> <UsageCount Value="24"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit14> </Unit14>
<Unit15> <Unit15>
@ -164,8 +166,8 @@
<UnitName Value="library_imp_utils"/> <UnitName Value="library_imp_utils"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="89"/> <TopLine Value="89"/>
<EditorIndex Value="5"/> <EditorIndex Value="6"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit17> </Unit17>
<Unit18> <Unit18>
@ -179,8 +181,8 @@
<UnitName Value="semaphore"/> <UnitName Value="semaphore"/>
<CursorPos X="1" Y="137"/> <CursorPos X="1" Y="137"/>
<TopLine Value="113"/> <TopLine Value="113"/>
<EditorIndex Value="8"/> <EditorIndex Value="9"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit19> </Unit19>
<Unit20> <Unit20>
@ -196,15 +198,15 @@
<UnitName Value="xmlrpc_formatter"/> <UnitName Value="xmlrpc_formatter"/>
<CursorPos X="54" Y="21"/> <CursorPos X="54" Y="21"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="68"/> <UsageCount Value="72"/>
</Unit21> </Unit21>
<Unit22> <Unit22>
<Filename Value="..\..\binary_formatter.pas"/> <Filename Value="..\..\binary_formatter.pas"/>
<UnitName Value="binary_formatter"/> <UnitName Value="binary_formatter"/>
<CursorPos X="20" Y="21"/> <CursorPos X="20" Y="21"/>
<TopLine Value="12"/> <TopLine Value="12"/>
<EditorIndex Value="16"/> <EditorIndex Value="17"/>
<UsageCount Value="33"/> <UsageCount Value="35"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit22> </Unit22>
<Unit23> <Unit23>
@ -257,9 +259,11 @@
<Unit30> <Unit30>
<Filename Value="..\..\imp_utils.pas"/> <Filename Value="..\..\imp_utils.pas"/>
<UnitName Value="imp_utils"/> <UnitName Value="imp_utils"/>
<CursorPos X="41" Y="3"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="2"/>
<UsageCount Value="15"/> <EditorIndex Value="3"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit30> </Unit30>
<Unit31> <Unit31>
<Filename Value="..\..\wst_fpc_xml.pas"/> <Filename Value="..\..\wst_fpc_xml.pas"/>
@ -308,8 +312,8 @@
<UnitName Value="indy_http_protocol"/> <UnitName Value="indy_http_protocol"/>
<CursorPos X="1" Y="16"/> <CursorPos X="1" Y="16"/>
<TopLine Value="109"/> <TopLine Value="109"/>
<EditorIndex Value="13"/> <EditorIndex Value="14"/>
<UsageCount Value="18"/> <UsageCount Value="20"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit37> </Unit37>
<Unit38> <Unit38>
@ -331,8 +335,8 @@
<UnitName Value="ics_http_protocol"/> <UnitName Value="ics_http_protocol"/>
<CursorPos X="1" Y="25"/> <CursorPos X="1" Y="25"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="12"/> <EditorIndex Value="13"/>
<UsageCount Value="17"/> <UsageCount Value="19"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit40> </Unit40>
<Unit41> <Unit41>
@ -340,8 +344,8 @@
<UnitName Value="same_process_protocol"/> <UnitName Value="same_process_protocol"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="13"/> <TopLine Value="13"/>
<EditorIndex Value="11"/> <EditorIndex Value="12"/>
<UsageCount Value="17"/> <UsageCount Value="19"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit41> </Unit41>
<Unit42> <Unit42>
@ -359,8 +363,8 @@
<UnitName Value="binary_streamer"/> <UnitName Value="binary_streamer"/>
<CursorPos X="1" Y="270"/> <CursorPos X="1" Y="270"/>
<TopLine Value="256"/> <TopLine Value="256"/>
<EditorIndex Value="7"/> <EditorIndex Value="8"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit43> </Unit43>
<Unit44> <Unit44>
@ -368,50 +372,104 @@
<UnitName Value="library_base_intf"/> <UnitName Value="library_base_intf"/>
<CursorPos X="25" Y="17"/> <CursorPos X="25" Y="17"/>
<TopLine Value="5"/> <TopLine Value="5"/>
<EditorIndex Value="6"/> <EditorIndex Value="7"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit44> </Unit44>
<Unit45> <Unit45>
<Filename Value="..\..\json_formatter.pas"/> <Filename Value="..\..\json_formatter.pas"/>
<UnitName Value="json_formatter"/> <UnitName Value="json_formatter"/>
<CursorPos X="1" Y="123"/> <CursorPos X="54" Y="157"/>
<TopLine Value="109"/> <TopLine Value="139"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<UsageCount Value="10"/> <UsageCount Value="12"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit45> </Unit45>
<Unit46> <Unit46>
<Filename Value="..\..\base_json_formatter.pas"/> <Filename Value="..\..\base_json_formatter.pas"/>
<UnitName Value="base_json_formatter"/> <UnitName Value="base_json_formatter"/>
<CursorPos X="69" Y="1105"/> <CursorPos X="17" Y="44"/>
<TopLine Value="1088"/> <TopLine Value="33"/>
<EditorIndex Value="2"/> <EditorIndex Value="4"/>
<UsageCount Value="10"/> <UsageCount Value="12"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit46> </Unit46>
<Unit47> <Unit47>
<Filename Value="..\..\wst_global.inc"/> <Filename Value="..\..\wst_global.inc"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="4"/> <TopLine Value="4"/>
<EditorIndex Value="4"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit47> </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> </Units>
<JumpHistory Count="3" HistoryIndex="2"> <JumpHistory Count="6" HistoryIndex="5">
<Position1> <Position1>
<Filename Value="..\..\library_protocol.pas"/> <Filename Value="user_client_console.pas"/>
<Caret Line="120" Column="8" TopLine="117"/> <Caret Line="162" Column="7" TopLine="138"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="..\..\library_protocol.pas"/> <Filename Value="user_client_console.pas"/>
<Caret Line="16" Column="3" TopLine="1"/> <Caret Line="163" Column="1" TopLine="138"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="..\..\library_protocol.pas"/> <Filename Value="user_client_console.pas"/>
<Caret Line="1" Column="2" TopLine="1"/> <Caret Line="153" Column="16" TopLine="145"/>
</Position3> </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> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -456,12 +514,12 @@
<Line Value="606"/> <Line Value="606"/>
</Item4> </Item4>
<Item5> <Item5>
<Source Value="..\..\json_formatter.pas"/>
<Line Value="184"/>
</Item5>
<Item6>
<Source Value="..\user_service_intf_proxy.pas"/> <Source Value="..\user_service_intf_proxy.pas"/>
<Line Value="65"/> <Line Value="65"/>
</Item5>
<Item6>
<Source Value="user_client_console.pas"/>
<Line Value="163"/>
</Item6> </Item6>
</BreakPoints> </BreakPoints>
<Watches Count="2"> <Watches Count="2">

27
wst/trunk/samples/user_client_console/user_client_console.pas
View File

@ -135,7 +135,7 @@ end;
type type
TTransportType = ( ttLibrary, ttTCP, ttHTTP ); TTransportType = ( ttLibrary, ttTCP, ttHTTP );
TFormatType = ( ftBinary, ftSoap, ftXmlRPC, ftJSON ); TFormatType = ( ftBinary, ftSoap, ftXmlRPC, ftJSON_10, ftJSON_11 );
var var
TransportType : TTransportType; TransportType : TTransportType;
FormatValue : TFormatType; 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:8888/wst/services/lib_server/UserService'
//'http:Address=http://127.0.0.1:8000/services/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 var
buff : string; buffTransport, buffFormat : string;
begin begin
if ( TransportType = ttHTTP ) then 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 else
buff := ADDRESS_MAP[TransportType]; buffTransport := ADDRESS_MAP[TransportType];
if ( TransportType = ttLibrary ) then 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( UserServiceInst := TUserService_Proxy.Create(
'UserService', 'UserService',
FORMAT_MAP[FormatValue] + ':', buffFormat,
buff buffTransport
); );
end; end;
@ -197,7 +200,8 @@ begin
WriteLn(); WriteLn();
WriteLn('Select a messaging format : '); WriteLn('Select a messaging format : ');
WriteLn(' B : binary ( binary_formatter.pas )'); 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(' S : soap ( soap_formatter.pas )');
WriteLn(' X : XmlRpc ( xmlrpc_formatter.pas )'); WriteLn(' X : XmlRpc ( xmlrpc_formatter.pas )');
WriteLn(); WriteLn();
@ -205,10 +209,11 @@ begin
while True do begin while True do begin
ReadLn(buff); ReadLn(buff);
buff := UpperCase(Trim(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 case buff[1] of
'B' : FormatValue := ftBinary; 'B' : FormatValue := ftBinary;
'J' : FormatValue := ftJSON; 'J' : FormatValue := ftJSON_10;
'K' : FormatValue := ftJSON_11;
'S' : FormatValue := ftSoap; 'S' : FormatValue := ftSoap;
'X' : FormatValue := ftXmlRPC; 'X' : FormatValue := ftXmlRPC;
end; end;

2
wst/trunk/server_binary_formatter.pas
View File

@ -71,6 +71,7 @@ end;
procedure TBinaryFormatter.BeginCallResponse(const AProcName, ATarget: string); procedure TBinaryFormatter.BeginCallResponse(const AProcName, ATarget: string);
begin begin
Clear();
BeginObject('Body',Nil); BeginObject('Body',Nil);
BeginObject(ATarget,Nil); BeginObject(ATarget,Nil);
BeginObject(AProcName + 'Response',Nil); BeginObject(AProcName + 'Response',Nil);
@ -118,6 +119,7 @@ procedure TBinaryFormatter.BeginExceptionList(
const AErrorMsg: string const AErrorMsg: string
); );
begin begin
Clear();
BeginObject('Body',Nil); BeginObject('Body',Nil);
BeginObject('Fault',Nil); BeginObject('Fault',Nil);
Put('faultcode',TypeInfo(string),AErrorCode); Put('faultcode',TypeInfo(string),AErrorCode);

173
wst/trunk/tests/test_suite/test_json.pas Normal file
View 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.

143
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

@ -24,11 +24,7 @@ uses
TestFrameWork, ActiveX, TestFrameWork, ActiveX,
{$ENDIF} {$ENDIF}
TypInfo, TypInfo,
base_service_intf, wst_types, server_service_intf, service_intf base_service_intf, wst_types, server_service_intf, service_intf;
{$IFDEF FPC}
, fpjson, jsonparser, base_json_formatter, json_formatter, server_service_json
{$ENDIF}
;
type type
@ -445,18 +441,6 @@ type
procedure test_WriteBuffer(); procedure test_WriteBuffer();
end; 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 }
TTestArray= class(TTestCase) TTestArray= class(TTestCase)
@ -526,17 +510,6 @@ type
procedure ExceptBlock_client(); procedure ExceptBlock_client();
end; 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 }
TTest_TStringBufferRemotable = class(TTestCase) TTest_TStringBufferRemotable = class(TTestCase)
@ -4244,116 +4217,6 @@ begin
end; end;
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 initialization
RegisterStdTypes(); RegisterStdTypes();
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TTestEnum),'TTestEnum').RegisterExternalPropertyName('teOne', '1'); GetTypeRegistry().Register(sXSD_NS,TypeInfo(TTestEnum),'TTestEnum').RegisterExternalPropertyName('teOne', '1');
@ -4418,9 +4281,5 @@ initialization
RegisterTest('Serializer',TTest_XmlRpcFormatterExceptionBlock.Suite); RegisterTest('Serializer',TTest_XmlRpcFormatterExceptionBlock.Suite);
RegisterTest('Serializer',TTest_BinaryFormatterExceptionBlock.Suite); RegisterTest('Serializer',TTest_BinaryFormatterExceptionBlock.Suite);
RegisterTest('Serializer',TTest_TStringBufferRemotable.Suite); RegisterTest('Serializer',TTest_TStringBufferRemotable.Suite);
{$IFDEF FPC}
RegisterTest('Serializer',TTestJsonRpcFormatter.Suite);
RegisterTest('Serializer',TTest_JsonRpcFormatterExceptionBlock.Suite);
{$ENDIF}
end. end.