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

schema sparser => External type definitions referenced by <import> statement in XSD files or WSDL schema section are now handle. Note that the external files must reside in the same folder as the main schema being parsed. The external files are parsed and used in the main file.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1015 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-11-23 17:55:10 +00:00
parent d408e930fb
commit 7ff8d383ef
15 changed files with 369 additions and 1379 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
wst/trunk/tests/test_suite/files/import_base_library.wsdl Normal file
View File

@ -0,0 +1,23 @@
<?xml version="1.0"?>
<definitions name="import_base_library"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:base-library"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:urn:base-library">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:base-library">
<xsd:complexType name="SampleBase_Type">
<xsd:sequence>
<xsd:element name="Name" type="xsd:string"/>
<xsd:element name="Identifier" type="xsd:int"/>
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

11
wst/trunk/tests/test_suite/files/import_base_library.xsd Normal file
View File

@ -0,0 +1,11 @@
<?xml version="1.0"?>
<schema xmlns:tns="urn:base-library"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:base-library">
<xsd:complexType name="SampleBase_Type">
<xsd:sequence>
<xsd:element name="Name" type="xsd:string"/>
<xsd:element name="Identifier" type="xsd:int"/>
</xsd:sequence>
</xsd:complexType>
</schema>

27
wst/trunk/tests/test_suite/files/import_second_library.wsdl Normal file
View File

@ -0,0 +1,27 @@
<?xml version="1.0"?>
<definitions name="import_second_library"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:second-library"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:second-library">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" xmlns:bx="urn:base-library" targetNamespace="urn:second-library">
<xsd:import
namespace = "urn:base-library"
schemaLocation = "import_base_library.xsd"
/>
<xsd:complexType name="Second_Type">
<xsd:sequence>
<xsd:element name="SampleProperty" type="bx:SampleBase_Type"/>
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

16
wst/trunk/tests/test_suite/files/import_second_library.xsd Normal file
View File

@ -0,0 +1,16 @@
<?xml version="1.0"?>
<schema xmlns:tns="urn:second-library"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:bx="urn:base-library"
targetNamespace="urn:second-library">
<xsd:import
namespace = "urn:base-library"
schemaLocation = "import_base_library.xsd"
/>
<xsd:complexType name="Second_Type">
<xsd:sequence>
<xsd:element name="SampleProperty" type="bx:SampleBase_Type"/>
</xsd:sequence>
</xsd:complexType>
</schema>

73
wst/trunk/tests/test_suite/test_parsers.pas
View File

@ -21,7 +21,7 @@ uses
{$ELSE} {$ELSE}
TestFrameWork, xmldom, wst_delphi_xml, TestFrameWork, xmldom, wst_delphi_xml,
{$ENDIF} {$ENDIF}
pastree, pascal_parser_intf, xsd_parser, wsdl_parser, test_suite_utils; pastree, pascal_parser_intf, xsd_parser, wsdl_parser, test_suite_utils, wst_types;
type type
@ -61,6 +61,8 @@ type
function load_class_ansichar_property() : TwstPasTreeContainer;virtual;abstract; function load_class_ansichar_property() : TwstPasTreeContainer;virtual;abstract;
function load_class_widechar_property() : TwstPasTreeContainer;virtual;abstract; function load_class_widechar_property() : TwstPasTreeContainer;virtual;abstract;
function load_class_currency_property() : TwstPasTreeContainer;virtual;abstract; function load_class_currency_property() : TwstPasTreeContainer;virtual;abstract;
function load_schema_import() : TwstPasTreeContainer;virtual;abstract;
published published
procedure EmptySchema(); procedure EmptySchema();
@ -98,6 +100,8 @@ type
procedure class_ansichar_property(); procedure class_ansichar_property();
procedure class_widechar_property(); procedure class_widechar_property();
procedure class_currency_property(); procedure class_currency_property();
procedure schema_import();
end; end;
{ TTest_XsdParser } { TTest_XsdParser }
@ -139,6 +143,8 @@ type
function load_class_ansichar_property() : TwstPasTreeContainer;override; function load_class_ansichar_property() : TwstPasTreeContainer;override;
function load_class_widechar_property() : TwstPasTreeContainer;override; function load_class_widechar_property() : TwstPasTreeContainer;override;
function load_class_currency_property() : TwstPasTreeContainer;override; function load_class_currency_property() : TwstPasTreeContainer;override;
function load_schema_import() : TwstPasTreeContainer;override;
end; end;
{ TTest_WsdlParser } { TTest_WsdlParser }
@ -179,7 +185,9 @@ type
function load_class_widestring_property() : TwstPasTreeContainer;override; function load_class_widestring_property() : TwstPasTreeContainer;override;
function load_class_ansichar_property() : TwstPasTreeContainer;override; function load_class_ansichar_property() : TwstPasTreeContainer;override;
function load_class_widechar_property() : TwstPasTreeContainer;override; function load_class_widechar_property() : TwstPasTreeContainer;override;
function load_class_currency_property() : TwstPasTreeContainer;override; function load_class_currency_property() : TwstPasTreeContainer;override;
function load_schema_import() : TwstPasTreeContainer;override;
published published
procedure no_binding_style(); procedure no_binding_style();
procedure signature_last(); procedure signature_last();
@ -193,7 +201,7 @@ type
end; end;
implementation implementation
uses parserutils, xsd_consts, typinfo; uses parserutils, xsd_consts, typinfo, locators;
const const
x_complexType_SampleArrayIntFieldType = 'TArrayIntFieldType'; x_complexType_SampleArrayIntFieldType = 'TArrayIntFieldType';
@ -1904,12 +1912,56 @@ begin
end; end;
end; end;
procedure TTest_CustomXsdParser.schema_import();
const
s_base_namespace = 'urn:base-library';
s_base_type = 'SampleBase_Type';
s_second_namespace = 'urn:second-library';
s_second_type = 'Second_Type';
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
ls : TList;
elt, prpElt : TPasElement;
prp : TPasProperty;
baseType, scdClass : TPasClassType;
begin
tr := load_schema_import();
mdl := tr.FindModule(s_base_namespace);
CheckNotNull(mdl,s_base_namespace);
ls := mdl.InterfaceSection.Declarations;
CheckEquals(1,ls.Count);
elt := tr.FindElement(s_base_type);
CheckNotNull(elt,s_base_type);
CheckIs(elt,TPasClassType);
baseType := TPasClassType(elt);
mdl := tr.FindModule(s_second_namespace);
CheckNotNull(mdl,s_second_namespace);
ls := mdl.InterfaceSection.Declarations;
CheckEquals(1,ls.Count);
elt := tr.FindElement(s_second_type);
CheckNotNull(elt,s_second_type);
CheckIs(elt,TPasClassType);
scdClass := TPasClassType(elt);
prpElt := FindMember(scdClass,'SampleProperty');
CheckNotNull(prpElt);
CheckIs(prpElt,TPasProperty);
prp := TPasProperty(prpElt);
CheckNotNull(prp.VarType);
CheckEquals(PtrUInt(prp.VarType),PtrUInt(prp.VarType));
FreeAndNil(tr);
end;
{ TTest_XsdParser } { TTest_XsdParser }
function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer;
var var
locDoc : TXMLDocument; locDoc : TXMLDocument;
prs : IXsdPaser; prs : IXsdPaser;
prsCtx : IParserContext;
fileName : string; fileName : string;
begin begin
fileName := wstExpandLocalFileName(TestFilesPath + ADoc + '.xsd'); fileName := wstExpandLocalFileName(TestFilesPath + ADoc + '.xsd');
@ -1918,6 +1970,8 @@ begin
Result := TwstPasTreeContainer.Create(); Result := TwstPasTreeContainer.Create();
CreateWstInterfaceSymbolTable(Result); CreateWstInterfaceSymbolTable(Result);
prs := TXsdParser.Create(locDoc,Result,ADoc); prs := TXsdParser.Create(locDoc,Result,ADoc);
prsCtx := prs as IParserContext;
prsCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(fileName)));
prs.ParseTypes(); prs.ParseTypes();
finally finally
ReleaseDomNode(locDoc); ReleaseDomNode(locDoc);
@ -2039,6 +2093,11 @@ begin
Result := ParseDoc('class_currency_property'); Result := ParseDoc('class_currency_property');
end; end;
function TTest_XsdParser.load_schema_import(): TwstPasTreeContainer;
begin
Result := ParseDoc('import_second_library');
end;
function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer; function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer;
begin begin
Result := ParseDoc('class_widechar_property'); Result := ParseDoc('class_widechar_property');
@ -2060,6 +2119,7 @@ function TTest_WsdlParser.ParseDoc(const ADoc: string): TwstPasTreeContainer;
var var
locDoc : TXMLDocument; locDoc : TXMLDocument;
prs : IParser; prs : IParser;
prsCtx : IParserContext;
fileName : string; fileName : string;
begin begin
fileName := wstExpandLocalFileName(TestFilesPath + ADoc + '.wsdl'); fileName := wstExpandLocalFileName(TestFilesPath + ADoc + '.wsdl');
@ -2068,6 +2128,8 @@ begin
Result := TwstPasTreeContainer.Create(); Result := TwstPasTreeContainer.Create();
CreateWstInterfaceSymbolTable(Result); CreateWstInterfaceSymbolTable(Result);
prs := TWsdlParser.Create(locDoc,Result); prs := TWsdlParser.Create(locDoc,Result);
prsCtx := prs as IParserContext;
prsCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(fileName)));
prs.Execute(pmAllTypes,ADoc); prs.Execute(pmAllTypes,ADoc);
finally finally
ReleaseDomNode(locDoc); ReleaseDomNode(locDoc);
@ -2633,6 +2695,11 @@ begin
Result := ParseDoc('class_currency_property'); Result := ParseDoc('class_currency_property');
end; end;
function TTest_WsdlParser.load_schema_import(): TwstPasTreeContainer;
begin
Result := ParseDoc('import_second_library');
end;
initialization initialization
RegisterTest('XSD parser',TTest_XsdParser.Suite); RegisterTest('XSD parser',TTest_XsdParser.Suite);
RegisterTest('WSDL parser',TTest_WsdlParser.Suite); RegisterTest('WSDL parser',TTest_WsdlParser.Suite);

1
wst/trunk/tests/test_suite/wst_test_suite_gui.lpi
View File

@ -172,7 +172,6 @@
</Parsing> </Parsing>
<CodeGeneration> <CodeGeneration>
<Checks> <Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/> <OverflowChecks Value="True"/>
</Checks> </Checks>
</CodeGeneration> </CodeGeneration>

3
wst/trunk/ws_helper/delphi/ws_helper.dpr
View File

@ -42,7 +42,8 @@ uses
xsd_parser, xsd_parser,
ws_parser_imp, ws_parser_imp,
wsdl_parser, wsdl_parser,
xsd_generator; xsd_generator,
locators;
{$INCLUDE ws_helper_prog.inc} {$INCLUDE ws_helper_prog.inc}

70
wst/trunk/ws_helper/locators.pas Normal file
View File

@ -0,0 +1,70 @@
{
This file is part of the Web Service Toolkit
Copyright (c) 2009 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 locators;
interface
uses
Classes, SysUtils
{$IFDEF WST_DELPHI}
, xmldom, wst_delphi_xml
{$ENDIF WST_DELPHI}
{$IFDEF FPC}
, DOM, XMLRead
{$ENDIF FPC}
, xsd_parser;
type
{ TFileDocumentLocator }
TFileDocumentLocator = class(TInterfacedObject,IDocumentLocator)
private
FBasePath : string;
protected
property BasePath : string read FBasePath;
protected
function Find(
const ADocLocation : string;
out ADoc : TXMLDocument
) : Boolean;
public
constructor Create(const ABasePath : string);
end;
implementation
{ TFileDocumentLocator }
function TFileDocumentLocator.Find(
const ADocLocation: string;
out ADoc: TXMLDocument
) : Boolean;
var
locFileName : string;
begin
locFileName := BasePath + ExtractFileName(ADocLocation);
locFileName := ExpandFileName(locFileName);
Result := FileExists(locFileName);
if Result then
ReadXMLFile(ADoc,locFileName);
end;
constructor TFileDocumentLocator.Create(const ABasePath: string);
begin
FBasePath := IncludeTrailingPathDelimiter(ABasePath);
end;
end.

1337
wst/trunk/ws_helper/parserdefs.pas
View File

File diff suppressed because it is too large Load Diff

66
wst/trunk/ws_helper/ws_helper.lpi
View File

@ -43,83 +43,83 @@
<UnitName Value="generator"/> <UnitName Value="generator"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="parserdefs.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parserdefs"/>
</Unit2>
<Unit3>
<Filename Value="parserutils.pas"/> <Filename Value="parserutils.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="parserutils"/> <UnitName Value="parserutils"/>
</Unit3> </Unit2>
<Unit4> <Unit3>
<Filename Value="source_utils.pas"/> <Filename Value="source_utils.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="source_utils"/> <UnitName Value="source_utils"/>
</Unit4> </Unit3>
<Unit5> <Unit4>
<Filename Value="command_line_parser.pas"/> <Filename Value="command_line_parser.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="command_line_parser"/> <UnitName Value="command_line_parser"/>
</Unit5> </Unit4>
<Unit6> <Unit5>
<Filename Value="metadata_generator.pas"/> <Filename Value="metadata_generator.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="metadata_generator"/> <UnitName Value="metadata_generator"/>
</Unit6> </Unit5>
<Unit7> <Unit6>
<Filename Value="..\binary_streamer.pas"/> <Filename Value="..\binary_streamer.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="binary_streamer"/> <UnitName Value="binary_streamer"/>
</Unit7> </Unit6>
<Unit8> <Unit7>
<Filename Value="wst_resources_utils.pas"/> <Filename Value="wst_resources_utils.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="wst_resources_utils"/> <UnitName Value="wst_resources_utils"/>
</Unit8> </Unit7>
<Unit9> <Unit8>
<Filename Value="pascal_parser_intf.pas"/> <Filename Value="pascal_parser_intf.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="pascal_parser_intf"/> <UnitName Value="pascal_parser_intf"/>
</Unit9> </Unit8>
<Unit10> <Unit9>
<Filename Value="logger_intf.pas"/> <Filename Value="logger_intf.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="logger_intf"/> <UnitName Value="logger_intf"/>
</Unit10> </Unit9>
<Unit11> <Unit10>
<Filename Value="wsdl_generator.pas"/> <Filename Value="wsdl_generator.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="wsdl_generator"/> <UnitName Value="wsdl_generator"/>
</Unit11> </Unit10>
<Unit12> <Unit11>
<Filename Value="ws_helper_prog.inc"/> <Filename Value="ws_helper_prog.inc"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit12> </Unit11>
<Unit13> <Unit12>
<Filename Value="xsd_parser.pas"/> <Filename Value="xsd_parser.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="xsd_parser"/> <UnitName Value="xsd_parser"/>
</Unit13> </Unit12>
<Unit14> <Unit13>
<Filename Value="wsdl_parser.pas"/> <Filename Value="wsdl_parser.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="wsdl_parser"/> <UnitName Value="wsdl_parser"/>
</Unit14> </Unit13>
<Unit15> <Unit14>
<Filename Value="ws_parser_imp.pas"/> <Filename Value="ws_parser_imp.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="ws_parser_imp"/> <UnitName Value="ws_parser_imp"/>
</Unit15> </Unit14>
<Unit16> <Unit15>
<Filename Value="xsd_generator.pas"/> <Filename Value="xsd_generator.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="xsd_generator"/> <UnitName Value="xsd_generator"/>
</Unit16> </Unit15>
<Unit17> <Unit16>
<Filename Value="xsd_consts.pas"/> <Filename Value="xsd_consts.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="xsd_consts"/> <UnitName Value="xsd_consts"/>
</Unit16>
<Unit17>
<Filename Value="locators.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="locators"/>
</Unit17> </Unit17>
</Units> </Units>
</ProjectOptions> </ProjectOptions>

3
wst/trunk/ws_helper/ws_helper.pas
View File

@ -43,7 +43,8 @@ uses
xsd_parser, xsd_parser,
ws_parser_imp, ws_parser_imp,
wsdl_parser, wsdl_parser,
xsd_generator, wsdl_generator; xsd_generator, wsdl_generator,
locators;
{$INCLUDE ws_helper_prog.inc} {$INCLUDE ws_helper_prog.inc}

7
wst/trunk/ws_helper/ws_helper_prog.inc
View File

@ -106,14 +106,17 @@ var
var var
locDoc : TXMLDocument; locDoc : TXMLDocument;
prsr : IXsdPaser; prsr : IXsdPaser;
prsrCtx : IParserContext;
begin begin
prsr := nil; prsr := nil;
ReadXMLFile(locDoc,inFileName); ReadXMLFile(locDoc,inFileName);
{$IFNDEF WST_INTF_DOM} {$IFNDEF WST_INTF_DOM}
try try
{$ENDIF} {$ENDIF}
prsr := TXsdParser.Create(locDoc,symtable,ChangeFileExt(ExtractFileName(inFileName),'')) as IXsdPaser; prsr := TXsdParser.Create(locDoc,symtable,ChangeFileExt(ExtractFileName(inFileName),'')) as IXsdPaser;
prsr.ParseTypes(); prsrCtx := prsr as IParserContext;
prsrCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(ExpandFileName(inFileName))));
prsr.ParseTypes();
{$IFNDEF WST_INTF_DOM} {$IFNDEF WST_INTF_DOM}
finally finally
ReleaseDomNode(locDoc); ReleaseDomNode(locDoc);

20
wst/trunk/ws_helper/wsdl_parser.pas
View File

@ -36,11 +36,14 @@ type
procedure Execute(const AMode : TParserMode; const AModuleName : string); procedure Execute(const AMode : TParserMode; const AModuleName : string);
end; end;
{ TWsdlParser }
TWsdlParser = class(TInterfacedObject, IInterface, IParserContext, IParser) TWsdlParser = class(TInterfacedObject, IInterface, IParserContext, IParser)
private private
FDoc : TXMLDocument; FDoc : TXMLDocument;
FSymbols : TwstPasTreeContainer; FSymbols : TwstPasTreeContainer;
FModule : TPasModule; FModule : TPasModule;
FDocumentLocator : IDocumentLocator;
private private
FTargetNameSpace : string; FTargetNameSpace : string;
FNameSpaceList : TStringList; FNameSpaceList : TStringList;
@ -88,6 +91,8 @@ type
function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
function GetTargetNameSpace() : string; function GetTargetNameSpace() : string;
function GetTargetModule() : TPasModule; function GetTargetModule() : TPasModule;
function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator);
public public
constructor Create( constructor Create(
ADoc : TXMLDocument; ADoc : TXMLDocument;
@ -284,6 +289,16 @@ begin
Result := FModule; Result := FModule;
end; end;
function TWsdlParser.GetDocumentLocator(): IDocumentLocator;
begin
Result := FDocumentLocator;
end;
procedure TWsdlParser.SetDocumentLocator(const ALocator: IDocumentLocator);
begin
FDocumentLocator := ALocator;
end;
function TWsdlParser.GetTargetNameSpace() : string; function TWsdlParser.GetTargetNameSpace() : string;
begin begin
Result := FTargetNameSpace; Result := FTargetNameSpace;
@ -1248,14 +1263,19 @@ procedure TWsdlParser.Prepare(const AModuleName: string);
var var
locDomObj : TDOMNode; locDomObj : TDOMNode;
locPrs : IXsdPaser; locPrs : IXsdPaser;
locPrsCtx : IParserContext;
ns : string; ns : string;
locDocLocator : IDocumentLocator;
begin begin
if Assigned(FSchemaCursor) then begin if Assigned(FSchemaCursor) then begin
locDocLocator := GetDocumentLocator();
FSchemaCursor.Reset(); FSchemaCursor.Reset();
while FSchemaCursor.MoveNext() do begin while FSchemaCursor.MoveNext() do begin
locDomObj := (FSchemaCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; locDomObj := (FSchemaCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
locPrs := TWsdlSchemaParser.Create(FDoc,locDomObj,FSymbols,Self); locPrs := TWsdlSchemaParser.Create(FDoc,locDomObj,FSymbols,Self);
locPrs.SetNotifier(FOnMessage); locPrs.SetNotifier(FOnMessage);
locPrsCtx := locPrs as IParserContext;
locPrsCtx.SetDocumentLocator(locDocLocator);
ns := (locPrs as IParserContext).GetTargetNameSpace(); ns := (locPrs as IParserContext).GetTargetNameSpace();
FXsdParsers.AddObject(ns,TIntfObjectRef.Create(locPrs)); FXsdParsers.AddObject(ns,TIntfObjectRef.Create(locPrs));
end; end;

2
wst/trunk/ws_helper/xsd_consts.pas
View File

@ -46,6 +46,7 @@ const
s_enumeration : WideString = 'enumeration'; s_enumeration : WideString = 'enumeration';
s_extension : WideString = 'extension'; s_extension : WideString = 'extension';
s_guid : WideString = 'GUID'; s_guid : WideString = 'GUID';
s_import = 'import';
s_input : WideString = 'input'; s_input : WideString = 'input';
s_item : WideString = 'item'; s_item : WideString = 'item';
s_literal = 'literal'; s_literal = 'literal';
@ -71,6 +72,7 @@ const
//s_return : WideString = 'return'; //s_return : WideString = 'return';
s_rpc = 'rpc'; s_rpc = 'rpc';
s_schema : WideString = 'schema'; s_schema : WideString = 'schema';
s_schemaLocation = 'schemaLocation';
s_xs : WideString = 'http://www.w3.org/2001/XMLSchema'; s_xs : WideString = 'http://www.w3.org/2001/XMLSchema';
s_xs_short = 'xsd'; s_xs_short = 'xsd';
s_sequence : WideString = 'sequence'; s_sequence : WideString = 'sequence';

89
wst/trunk/ws_helper/xsd_parser.pas
View File

@ -42,6 +42,13 @@ type
TOnParserMessage = procedure (const AMsgType : TMessageType; const AMsg : string) of object; TOnParserMessage = procedure (const AMsgType : TMessageType; const AMsg : string) of object;
IDocumentLocator = interface
['{F063700B-C0ED-4C54-9A54-C97030E80BD4}']
function Find(
const ADocLocation : string;
out ADoc : TXMLDocument
) : Boolean;
end;
IParserContext = interface IParserContext = interface
['{F400BA9E-41AC-456C-ABF9-CEAA75313685}'] ['{F400BA9E-41AC-456C-ABF9-CEAA75313685}']
@ -51,6 +58,8 @@ type
function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
function GetTargetNameSpace() : string; function GetTargetNameSpace() : string;
function GetTargetModule() : TPasModule; function GetTargetModule() : TPasModule;
function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator);
end; end;
IXsdPaser = interface IXsdPaser = interface
@ -83,6 +92,8 @@ type
FXSShortNames : TStrings; FXSShortNames : TStrings;
FChildCursor : IObjectCursor; FChildCursor : IObjectCursor;
FOnMessage: TOnParserMessage; FOnMessage: TOnParserMessage;
FDocumentLocator : IDocumentLocator;
FImportParsed : Boolean;
private private
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
private private
@ -96,18 +107,22 @@ type
function FindNameSpace(const AShortName : string; out AResult : string) : Boolean; function FindNameSpace(const AShortName : string; out AResult : string) : Boolean;
function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings;
function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator);
procedure SetNotifier(ANotifier : TOnParserMessage); procedure SetNotifier(ANotifier : TOnParserMessage);
function InternalParseType( function InternalParseType(
const AName : string; const AName : string;
const ATypeNode : TDOMNode const ATypeNode : TDOMNode
) : TPasType; ) : TPasType;
procedure ParseImportDocuments(); virtual;
public public
constructor Create( constructor Create(
ADoc : TXMLDocument; ADoc : TXMLDocument;
ASchemaNode : TDOMNode; ASchemaNode : TDOMNode;
ASymbols : TwstPasTreeContainer; ASymbols : TwstPasTreeContainer;
AParentContext : IParserContext AParentContext : IParserContext
); ); virtual;
destructor Destroy();override; destructor Destroy();override;
function ParseType( function ParseType(
const AName, const AName,
@ -127,6 +142,7 @@ type
property Module : TPasModule read FModule; property Module : TPasModule read FModule;
property OnMessage : TOnParserMessage read FOnMessage write FOnMessage; property OnMessage : TOnParserMessage read FOnMessage write FOnMessage;
end; end;
TCustomXsdSchemaParserClass = class of TCustomXsdSchemaParser;
TXsdParser = class(TCustomXsdSchemaParser) TXsdParser = class(TCustomXsdSchemaParser)
public public
@ -145,6 +161,14 @@ uses ws_parser_imp, dom_cursors, parserutils, xsd_consts
{$ENDIF} {$ENDIF}
; ;
function NodeValue(const ANode : TDOMNode) : DOMString;{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
if ( ANode = nil ) then
Result := ''
else
Result := ANode.NodeValue;
end;
{ TCustomXsdSchemaParser } { TCustomXsdSchemaParser }
constructor TCustomXsdSchemaParser.Create( constructor TCustomXsdSchemaParser.Create(
@ -206,6 +230,57 @@ begin
Result := SymbolTable.FindElement(AName); Result := SymbolTable.FindElement(AName);
end; end;
procedure TCustomXsdSchemaParser.ParseImportDocuments();
var
crsSchemaChild, typTmpCrs : IObjectCursor;
strFilter, locFileName, locNameSpace : string;
importNode : TDOMElement;
importDoc : TXMLDocument;
locParser : IXsdPaser;
locOldCurrentModule : TPasModule;
locContinue : Boolean;
begin
if FImportParsed then
Exit;
if ( FDocumentLocator = nil ) then
Exit;
FImportParsed := True;
if Assigned(FChildCursor) then begin
locOldCurrentModule := SymbolTable.CurrentModule;
try
crsSchemaChild := FChildCursor.Clone() as IObjectCursor;
strFilter := CreateQualifiedNameFilterStr(s_import,FXSShortNames);
crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(strFilter,TDOMNodeRttiExposer));
crsSchemaChild.Reset();
while crsSchemaChild.MoveNext() do begin
importNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject as TDOMElement;
if ( importNode.Attributes <> nil ) and ( importNode.Attributes.Length > 0 ) then begin
locFileName := NodeValue(importNode.Attributes.GetNamedItem(s_schemaLocation));
if ( not IsStrEmpty(locFileName) ) and
FDocumentLocator.Find(locFileName,importDoc)
then begin
locNameSpace := NodeValue(importNode.Attributes.GetNamedItem(s_namespace));
locContinue := IsStrEmpty(locNameSpace) or ( SymbolTable.FindModule(locNameSpace) = nil );
if locContinue then begin
locParser := TCustomXsdSchemaParserClass(Self.ClassType).Create(
importDoc,
importDoc.DocumentElement,
SymbolTable,
Self as IParserContext
);
locParser.SetNotifier(FOnMessage);
locParser.ParseTypes();
end;
end;
end;
end;
finally
SymbolTable.SetCurrentModule(locOldCurrentModule);
end;
end;
end;
function TCustomXsdSchemaParser.FindNamedNode( function TCustomXsdSchemaParser.FindNamedNode(
AList : IObjectCursor; AList : IObjectCursor;
const AName : WideString; const AName : WideString;
@ -278,6 +353,16 @@ begin
end; end;
end; end;
function TCustomXsdSchemaParser.GetDocumentLocator(): IDocumentLocator;
begin
Result := FDocumentLocator;
end;
procedure TCustomXsdSchemaParser.SetDocumentLocator(const ALocator: IDocumentLocator);
begin
FDocumentLocator := ALocator;
end;
procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage); procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage);
begin begin
FOnMessage := ANotifier; FOnMessage := ANotifier;
@ -476,6 +561,8 @@ var
typeModule : TPasModule; typeModule : TPasModule;
locTypeNodeFound : Boolean; locTypeNodeFound : Boolean;
begin begin
if not FImportParsed then
ParseImportDocuments();
sct := nil; sct := nil;
DoOnMessage(mtInfo, Format('Parsing "%s" ...',[AName])); DoOnMessage(mtInfo, Format('Parsing "%s" ...',[AName]));
try try