From 3c12d5aa39e35a0964c0d8f37f861c049db88345 Mon Sep 17 00:00:00 2001 From: inoussa Date: Mon, 11 Oct 2010 12:28:07 +0000 Subject: [PATCH] XSD "import" handling. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1341 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/ws_helper/parserutils.pas | 25 ++++ wst/trunk/ws_helper/ws_helper_prog.inc | 1 + wst/trunk/ws_helper/wsdl_parser.pas | 53 ++++---- wst/trunk/ws_helper/xsd_parser.pas | 162 ++++++++++++++++++------- 4 files changed, 169 insertions(+), 72 deletions(-) diff --git a/wst/trunk/ws_helper/parserutils.pas b/wst/trunk/ws_helper/parserutils.pas index 62f20fd6a..49f8abaca 100644 --- a/wst/trunk/ws_helper/parserutils.pas +++ b/wst/trunk/ws_helper/parserutils.pas @@ -35,6 +35,17 @@ const type + { TIntfObjectRef } + + TIntfObjectRef = class + private + FIntf: IInterface; + public + constructor Create(AIntf : IInterface); + destructor Destroy();override; + property Intf : IInterface read FIntf; + end; + { TQualifiedNameObjectFilter } TQualifiedNameObjectFilter = class(TInterfacedObject,IObjectFilter) @@ -518,4 +529,18 @@ begin FNameSpace := ANameSpace;; end; +{ TIntfObjectRef } + +constructor TIntfObjectRef.Create(AIntf: IInterface); +begin + Assert(Assigned(AIntf)); + FIntf := AIntf; +end; + +destructor TIntfObjectRef.Destroy(); +begin + FIntf := nil; + inherited Destroy(); +end; + end. diff --git a/wst/trunk/ws_helper/ws_helper_prog.inc b/wst/trunk/ws_helper/ws_helper_prog.inc index a60e92ea0..2d5d185c2 100644 --- a/wst/trunk/ws_helper/ws_helper_prog.inc +++ b/wst/trunk/ws_helper/ws_helper_prog.inc @@ -108,6 +108,7 @@ var {$ENDIF} prsrW := TWsdlParser.Create(locDoc,symtable);// as IParser; prsrCtx := prsrW as IParserContext; + prsrCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(ExpandFileName(inFileName)))); prsrCtx.SetSimpleOptions(GetParserSimpleOptions()); prsrW.Execute(parserMode,ChangeFileExt(ExtractFileName(inFileName),'')); {$IFNDEF WST_INTF_DOM} diff --git a/wst/trunk/ws_helper/wsdl_parser.pas b/wst/trunk/ws_helper/wsdl_parser.pas index 4201e0b64..8755b15fe 100644 --- a/wst/trunk/ws_helper/wsdl_parser.pas +++ b/wst/trunk/ws_helper/wsdl_parser.pas @@ -113,18 +113,6 @@ implementation uses ws_parser_imp, dom_cursors, parserutils, StrUtils, xsd_consts, TypInfo; -type - - { TIntfObjectRef } - - TIntfObjectRef = class - private - FIntf: IInterface; - public - constructor Create(AIntf : IInterface); - destructor Destroy();override; - property Intf : IInterface read FIntf; - end; function StrToBindingStyle(const AStr : string):TBindingStyle; begin @@ -739,10 +727,13 @@ function TWsdlParser.ParseOperation( then begin prmName := ExtractNameFromQName(prmTypeName); end; - prmInternameName := Trim(prmName); - if AnsiSameText(prmInternameName,tmpMthd.Name) then begin + prmInternameName := Trim(prmName); + if AnsiSameText(prmInternameName,tmpMthd.Name) or + AnsiSameText(prmInternameName,ExtractNameFromQName(prmTypeName)) + then begin prmInternameName := prmInternameName + 'Param'; - end; + end; + prmInternameName := ExtractIdentifier(prmInternameName); prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) ); @@ -1391,25 +1382,25 @@ end; function TWsdlParser.GetParser(const ANamespace: string): IXsdPaser; var i : PtrInt; + p, p1 : IXsdPaser; begin - i := FXsdParsers.IndexOf(ANamespace); - if ( i < 0 ) then + Result := nil; + i := FXsdParsers.IndexOf(ANamespace); + if ( i >= 0 ) then begin + Result := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser; + end else begin + for i := 0 to Pred(FXsdParsers.Count) do begin + p := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser; + p1 := p.FindParser(ANamespace); + if (p1 <> nil) then begin + Result := p1; + Break; + end; + end; + end; + if (Result = nil) then raise EXsdParserAssertException.CreateFmt('Unable to find the parser, namespace : "%s".',[ANamespace]); - Result := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser; end; -{ TIntfObjectRef } - -constructor TIntfObjectRef.Create(AIntf: IInterface); -begin - Assert(Assigned(AIntf)); - FIntf := AIntf; -end; - -destructor TIntfObjectRef.Destroy(); -begin - FIntf := nil; - inherited Destroy(); -end; end. diff --git a/wst/trunk/ws_helper/xsd_parser.pas b/wst/trunk/ws_helper/xsd_parser.pas index 78fdd4ace..2a506f009 100644 --- a/wst/trunk/ws_helper/xsd_parser.pas +++ b/wst/trunk/ws_helper/xsd_parser.pas @@ -70,6 +70,7 @@ type IXsdPaser = interface ['{F0CEC726-A068-4CCC-B1E7-D31F018415B2}'] + function FindParser(const ANamespace : string) : IXsdPaser; function ParseType( const AName, ATypeKind : string { ATypeKind "ComplexType", "SimpleType", "Element" } @@ -101,6 +102,7 @@ type FDocumentLocator : IDocumentLocator; FSimpleOptions : TParserOptions; FImportParsed : Boolean; + FXsdParsers : TStringList; private procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); private @@ -124,6 +126,7 @@ type const AName : string; const ATypeNode : TDOMNode ) : TPasType; + procedure CreateImportParsers(); procedure ParseImportDocuments(); virtual; public constructor Create( @@ -133,6 +136,7 @@ type AParentContext : IParserContext ); virtual; destructor Destroy();override; + function FindParser(const ANamespace : string) : IXsdPaser; function ParseType( const AName, ATypeKind : string { ATypeKind "ComplexType", "SimpleType", "Element" } @@ -209,17 +213,56 @@ begin end; destructor TCustomXsdSchemaParser.Destroy(); -var - i : PtrInt; + + procedure FreeList(AList : TStrings); + var + j : PtrInt; + begin + if Assigned(AList) then begin + for j := 0 to Pred(AList.Count) do begin + AList.Objects[j].Free(); + AList.Objects[j] := nil; + end; + AList.Free(); + end; + end; + begin FParentContext := nil; - for i := 0 to Pred(FNameSpaceList.Count) do begin - FNameSpaceList.Objects[i].Free(); - end; - FreeAndNil(FNameSpaceList); + FreeList(FNameSpaceList); + FreeList(FXsdParsers); inherited; end; +function TCustomXsdSchemaParser.FindParser(const ANamespace : string) : IXsdPaser; +var + i : PtrInt; + p, p1 : IXsdPaser; +begin + Result := nil; + if (ANamespace = FTargetNameSpace) then begin + Result := Self; + Exit; + end; + if (FXsdParsers = nil) then + CreateImportParsers(); + if (FXsdParsers = nil) then + Exit; + i := FXsdParsers.IndexOf(ANamespace); + if ( i >= 0 ) then begin + Result := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser; + end else begin + for i := 0 to Pred(FXsdParsers.Count) do begin + p := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser; + p1 := p.FindParser(ANamespace); + if (p1 <> nil) then begin + Result := p1; + Break; + end; + end; + end; +end; + procedure TCustomXsdSchemaParser.DoOnMessage( const AMsgType: TMessageType; const AMsg: string @@ -241,48 +284,23 @@ end; procedure TCustomXsdSchemaParser.ParseImportDocuments(); var - crsSchemaChild, typTmpCrs : IObjectCursor; - strFilter, locFileName, locNameSpace : string; - importNode : TDOMElement; - importDoc : TXMLDocument; - locParser : IXsdPaser; - locOldCurrentModule : TPasModule; - locContinue : Boolean; + locOldCurrentModule : TPasModule; + i : Integer; + p : IXsdPaser; begin if FImportParsed then Exit; - if ( FDocumentLocator = nil ) then + CreateImportParsers(); + if (FXsdParsers = 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; + for i := 0 to FXsdParsers.Count - 1 do begin + p := TIntfObjectRef(FXsdParsers.Objects[i]).Intf as IXsdPaser; + p.ParseTypes(); end; finally SymbolTable.SetCurrentModule(locOldCurrentModule); @@ -365,6 +383,8 @@ end; function TCustomXsdSchemaParser.GetDocumentLocator(): IDocumentLocator; begin Result := FDocumentLocator; + if (Result = nil) and (FParentContext <> nil) then + Result := GetParentContext().GetDocumentLocator(); end; procedure TCustomXsdSchemaParser.SetDocumentLocator(const ALocator: IDocumentLocator); @@ -599,6 +619,8 @@ begin if ( typeModule = nil ) then raise EXsdTypeNotFoundException.Create(AName); Result := SymbolTable.FindElementInModule(localTypeName,typeModule) as TPasType; + if (Result <> nil) and (not Result.InheritsFrom(TPasUnresolvedTypeRef)) then + Exit; Init(); locTypeNodeFound := FindTypeNode(aliasType); if ( Result <> nil ) and ( typeModule = FModule ) and @@ -653,6 +675,64 @@ begin end; end; +procedure TCustomXsdSchemaParser.CreateImportParsers(); +var + crsSchemaChild, typTmpCrs : IObjectCursor; + strFilter, locFileName, locNameSpace : string; + importNode : TDOMElement; + importDoc : TXMLDocument; + locParser : IXsdPaser; + locOldCurrentModule : TPasModule; + locContinue : Boolean; + locLocator : IDocumentLocator; +begin + if FImportParsed then + Exit; + locLocator := GetDocumentLocator(); + if (locLocator = nil) then + Exit; + + 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 + locLocator.Find(locFileName,importDoc) + then begin + locNameSpace := NodeValue(importNode.Attributes.GetNamedItem(s_namespace)); + locContinue := IsStrEmpty(locNameSpace) or (FXsdParsers = nil) or (FXsdParsers.IndexOf(locNameSpace) = -1);//( SymbolTable.FindModule(locNameSpace) = nil ); + if locContinue then begin + if (FXsdParsers = nil) then begin + FXsdParsers := TStringList.Create(); + FXsdParsers.Duplicates := dupIgnore; + FXsdParsers.Sorted := True; + end; + locParser := TCustomXsdSchemaParserClass(Self.ClassType).Create( + importDoc, + importDoc.DocumentElement, + SymbolTable, + Self as IParserContext + ); + FXsdParsers.AddObject(locNameSpace,TIntfObjectRef.Create(locParser)); + locParser.SetNotifier(FOnMessage); + //locParser.ParseTypes(); + end; + end; + end; + end; + finally + SymbolTable.SetCurrentModule(locOldCurrentModule); + end; + end; +end; + procedure TCustomXsdSchemaParser.ParseTypes(); var crsSchemaChild, typTmpCrs : IObjectCursor; @@ -697,10 +777,10 @@ var ls : TStrings; begin if ( FSchemaNode.Attributes = nil ) or ( GetNodeListCount(FSchemaNode.Attributes) = 0 ) then - raise EXsdParserAssertException.CreateFmt('The Schema node has at least the "%s" attribute.',[s_targetNamespace]); + raise EXsdParserAssertException.CreateFmt('The Schema node must have at least the "%s" attribute.',[s_targetNamespace]); nd := FSchemaNode.Attributes.GetNamedItem(s_targetNamespace); if ( nd = nil ) then - raise EXsdParserAssertException.CreateFmt('The Schema node has at least the "%s" attribute.',[s_targetNamespace]); + raise EXsdParserAssertException.CreateFmt('The Schema node must have at least the "%s" attribute.',[s_targetNamespace]); FTargetNameSpace := nd.NodeValue; if IsStrEmpty(FModuleName) then FModuleName := ExtractIdentifier(FTargetNameSpace);