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

Allow customization of namespace alias

Browse Source 
Properties's extended metadata
Add Option to not generate embedded arrays
code cleaning

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@465 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-06-06 14:59:24 +00:00
parent 1dc0744989
commit aa9c003b61
6 changed files with 256 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
wst/trunk/ws_helper/pascal_parser_intf.pas
View File

@ -325,7 +325,7 @@ function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPas
function AddAlias(const AName, ABaseType : string; ATable : TPasModule) : TPasTypeAliasType;
begin
Result := TPasTypeAliasType(AContainer.CreateElement(TPasAliasType,AName,ATable,visPublic,'',0));
Result := TPasTypeAliasType(AContainer.CreateElement(TPasAliasType,AName,ATable.InterfaceSection,visPublic,'',0));
Result.DestType := AContainer.FindElementInModule(ABaseType,ATable) as TPasType;
if Assigned(Result.DestType) then
Result.DestType.AddRef();
@ -446,7 +446,7 @@ function FindParameter(
var
i : Integer;
begin
i := GetParameterIndex(AProcType,AParamName,i);
i := GetParameterIndex(AProcType,AParamName,AStartPos);
if ( i >= 0 ) then begin
Result := TPasArgument(AProcType.Args[i]);
end else begin

35
wst/trunk/ws_helper/ws_parser_imp.pas
View File

@ -16,7 +16,7 @@ unit ws_parser_imp;
interface
uses
Classes, SysUtils,
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM, wst_fpc_xml{$ENDIF},
cursor_intf, rtti_filters,
pastree, pascal_parser_intf, logger_intf,
xsd_parser;
@ -464,6 +464,34 @@ var
isArrayDef : Boolean;
arrayItems : TObjectList;
procedure ExtractExtendedMetadata(const AItem : TPasElement; const ANode : TDOMNode);
var
ls : TDOMNamedNodeMap;
e : TDOMNode;
k, q : PtrInt;
ns_short, ns_long, localName, locBuffer, locBufferNS, locBufferNS_long, locBufferLocalName : string;
begin
if ( ANode.Attributes <> nil ) and ( GetNodeListCount(ANode.Attributes) > 0 ) then begin
ls := ANode.Attributes;
q := GetNodeListCount(ANode.Attributes);
for k := 0 to ( q - 1 ) do begin
e := ls.Item[k];
if ( Pos(':', e.NodeName) > 1 ) then begin
ExplodeQName(e.NodeName,localName,ns_short);
if FContext.FindNameSpace(ns_short, ns_long) then begin
locBuffer := e.NodeValue;
ExplodeQName(locBuffer,locBufferLocalName,locBufferNS);
if IsStrEmpty(locBufferNS) then
locBuffer := locBufferLocalName
else if FContext.FindNameSpace(locBufferNS, locBufferNS_long) then
locBuffer := Format('%s#%s',[locBufferNS_long,locBufferLocalName]);
FSymbols.Properties.SetValue(AItem,Format('%s#%s',[ns_long,localName]),locBuffer);
end;
end;
end;
end;
end;
procedure ParseElement(AElement : TDOMNode);
var
locAttCursor, locPartCursor : IObjectCursor;
@ -618,6 +646,11 @@ var
if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin
FSymbols.SetPropertyAsAttribute(locProp,True);
end;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_default)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then
locProp.DefaultValue := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
ExtractExtendedMetadata(locProp,AElement);
end;
procedure GenerateArrayTypes(

4
wst/trunk/ws_helper/wsdl_generator.pas
View File

@ -184,7 +184,7 @@ procedure TWsdlGenerator.GenerateServiceMessages(
s := ASymTable.GetExternalName(typItm.Parent.Parent)
else
s := ASymTable.GetExternalName(AModule);
ns_shortName := GetNameSpaceShortName(s,Document);
ns_shortName := GetNameSpaceShortName(s,Document,nil);
s := Format('%s:%s',[ns_shortName,ASymTable.GetExternalName(typItm)]);
tmpNode.SetAttribute(s_type,s);
end;
@ -202,7 +202,7 @@ procedure TWsdlGenerator.GenerateServiceMessages(
s := ASymTable.GetExternalName(typItm.Parent.Parent)
else
s := ASymTable.GetExternalName(AModule);
ns_shortName := GetNameSpaceShortName(s,Document);
ns_shortName := GetNameSpaceShortName(s,Document,nil);
s := Format('%s:%s',[ns_shortName,ASymTable.GetExternalName(typItm)]);
tmpNode.SetAttribute(s_type,s);
end;

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

@ -451,7 +451,6 @@ function TWsdlParser.ParseOperation(
function GetDataType(const AName, ATypeOrElement : string):TPasType;
begin
Result := nil;
try
Result := ParseType(AName);
except
@ -694,7 +693,6 @@ var
locMthd : TPasProcedure;
mthdName : string;
begin
Result := nil;
locMthd := nil;
if not ExtractOperationName(mthdName) then
raise EXsdParserAssertException.CreateFmt('Operation Attribute not found : "%s"',[s_name]);
@ -1019,7 +1017,6 @@ var
ansiStrBuffer : ansistring;
elt : TPasElement;
begin
locIntf := nil;
locAttCursor := CreateAttributesCursor(ANode,cetRttiNode);
locCursor := CreateCursorOn(locAttCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
locCursor.Reset();

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

@ -24,8 +24,8 @@ interface
const
s_address : WideString = 'address';
s_all : WideString = 'all';
//s_any : WideString = 'any';
s_annotation : WideString = 'annotation';
s_anyURI = 'anyURI';
s_appinfo : WideString = 'appinfo';
s_array : WideString = 'array';
s_arrayType : WideString = 'arrayType';
@ -37,6 +37,7 @@ const
s_complexType : WideString = 'complexType';
s_customAttributes : WideString = 'customAttributes';
s_definitions = 'definitions';
s_default = 'default';
s_document : WideString = 'document';
s_element : WideString = 'element';
s_enumeration : WideString = 'enumeration';

278
wst/trunk/ws_helper/xsd_generator.pas
View File

@ -22,6 +22,9 @@ uses
type
TGeneratorOption = ( xgoIgnorembeddedArray );
TGeneratorOptions = set of TGeneratorOption;
EXsdGeneratorException = class(Exception) end;
TBaseTypeHandler = class;
TBaseTypeHandlerClass = class of TBaseTypeHandler;
@ -37,6 +40,8 @@ type
IXsdGenerator = interface(IGenerator)
['{FBFF92BC-B72B-4B85-8D16-379F9E548DDB}']
function GetSchemaNode(ADocument : TDOMDocument) : TDOMNode;
procedure SetPreferedShortNames(const ALongName, AShortName : string);
function GetPreferedShortNames() : TStrings;
end;
IXsdTypeHandler = interface
@ -69,8 +74,12 @@ type
)
private
FDocument : TDOMDocument;
FOptions: TGeneratorOptions;
FShortNames : TStrings;
protected
function GetSchemaNode(ADocument : TDOMDocument) : TDOMNode;virtual;abstract;
procedure SetPreferedShortNames(const ALongName, AShortName : string);
function GetPreferedShortNames() : TStrings;
procedure Execute(
ASymTable : TwstPasTreeContainer;
AModuleName : string
@ -81,8 +90,14 @@ type
AModule : TPasModule
);virtual;
property Document : TDOMDocument read FDocument;
property Options : TGeneratorOptions read FOptions;
public
constructor Create(ADocument : TDOMDocument);
constructor Create(const ADocument : TDOMDocument);overload;
constructor Create(
const ADocument : TDOMDocument;
const AOptions : TGeneratorOptions
);overload;
destructor Destroy();override;
end;
{ TXsdGenerator }
@ -114,14 +129,16 @@ type
function GetNameSpaceShortName(
const ANameSpace : string;
ADocument : TDOMDocument
ADocument : TDOMDocument;
const APreferedList : TStrings
):string;
function GetXsdTypeHandlerRegistry():IXsdTypeHandlerRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
function CreateElement(const ANodeName : DOMString; AParent : TDOMNode; ADoc : TDOMDocument):TDOMElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
implementation
uses xsd_consts, Contnrs, StrUtils;
uses
xsd_consts, Contnrs, StrUtils, wst_types;
type
@ -277,8 +294,8 @@ begin
if Assigned(ANode) and Assigned(ANode.Attributes) then begin
b := ( Length(AStartingWith) = 0);
c := Pred(ANode.Attributes.Length);
if ( AStartIndex >= 0 ) then
i := AStartIndex;
// if ( AStartIndex >= 0 ) then
// i := AStartIndex;
for i := AStartIndex to c do begin
if AnsiSameText(AAttValue,ANode.Attributes.Item[i].NodeValue) and
( b or ( Pos(AStartingWith,ANode.Attributes.Item[i].NodeName) = 1 ))
@ -294,12 +311,16 @@ end;
function GetNameSpaceShortName(
const ANameSpace : string;
ADocument : TDOMDocument
ADocument : TDOMDocument;
const APreferedList : TStrings
):string;
begin
if FindAttributeByValueInNode(ANameSpace,ADocument.DocumentElement,Result,0, s_xmlns) then begin
Result := Copy(Result,Length(s_xmlns+':')+1,MaxInt);
end else begin
if ( APreferedList <> nil ) then
Result := Trim(APreferedList.Values[ANameSpace]);
if ( Result = '' ) then
Result := Format('ns%d',[GetNodeListCount(ADocument.DocumentElement.Attributes)]) ;
ADocument.DocumentElement.SetAttribute(Format('%s:%s',[s_xmlns,Result]),ANameSpace);
end;
@ -426,7 +447,7 @@ begin
resNode.SetAttribute(s_name, AContainer.GetExternalName(typItm)) ;
baseUnitExternalName := GetTypeNameSpace(AContainer,typItm.DestType);
s := GetNameSpaceShortName(baseUnitExternalName,ADocument);
s := GetNameSpaceShortName(baseUnitExternalName,ADocument,GetOwner().GetPreferedShortNames());
s := Format('%s:%s',[s,AContainer.GetExternalName(typItm.DestType)]);
resNode.SetAttribute(s_type,s) ;
end;
@ -491,86 +512,73 @@ procedure TClassTypeDefinition_TypeHandler.Generate(
const ASymbol : TPasElement;
ADocument : TDOMDocument
);
var
cplxNode : TDOMElement;
typItm : TPasClassType;
propTypItm : TPasType;
s, prop_ns_shortName : string;
defSchemaNode, sqcNode, propNode, derivationNode : TDOMElement;
i : Integer;
function TypeHasSequence(const AClassType : TPasClassType; const ACategory : TTypeCategory) : Boolean;
var
k : PtrInt;
p : TPasProperty;
typeCategory : TTypeCategory;
hasSequence : Boolean;
trueParent : TPasType;
isEmbeddedArray : Boolean;
propItmUltimeType : TPasType;
begin
inherited;
typItm := ASymbol as TPasClassType;
if Assigned(typItm) then begin
GetNameSpaceShortName(AContainer.GetExternalName(AContainer.CurrentModule) ,ADocument);
defSchemaNode := GetSchemaNode(ADocument) as TDOMElement;
s := Format('%s:%s',[s_xs_short,s_complexType]);
cplxNode := CreateElement(s,defSchemaNode,ADocument);
cplxNode.SetAttribute(s_name, AContainer.GetExternalName(typItm)) ;
typeCategory := tcComplexContent;
derivationNode := nil;
hasSequence := True;
if Assigned(typItm.AncestorType) then begin
trueParent := typItm.AncestorType;
if trueParent.InheritsFrom(TPasNativeClassType) and AnsiSameText('THeaderBlock',trueParent.Name) then begin
cplxNode.SetAttribute(s_WST_headerBlock,'true');
end;
if trueParent.InheritsFrom(TPasAliasType) then begin
trueParent := GetUltimeType(trueParent);
end;
if trueParent.InheritsFrom(TPasNativeSimpleContentClassType) or
trueParent.InheritsFrom(TPasNativeSimpleType)
then begin
typeCategory := tcSimpleContent;
end;
derivationNode := CreateElement(Format('%s:%s',[s_xs_short,s_extension]),cplxNode,ADocument);
s := Trim(GetNameSpaceShortName(GetTypeNameSpace(AContainer,trueParent),ADocument));
if ( Length(s) > 0 ) then begin
s := s + ':';
end;
s := s + AContainer.GetExternalName(trueParent);
derivationNode.SetAttribute(s_base,s);
hasSequence := False;
end;
if ( typItm.Members.Count > 0 ) then begin
hasSequence := False;
for i := 0 to Pred(typItm.Members.Count) do begin
if TPasElement(typItm.Members[i]).InheritsFrom(TPasProperty) then begin
p := TPasProperty(typItm.Members[i]);
begin
Result := False;
if ( AClassType.Members.Count > 0 ) then begin
for k := 0 to Pred(AClassType.Members.Count) do begin
if TPasElement(AClassType.Members[k]).InheritsFrom(TPasProperty) then begin
p := TPasProperty(AClassType.Members[k]);
if not AContainer.IsAttributeProperty(p) then begin
if ( typeCategory = tcSimpleContent ) then begin
raise EXsdGeneratorException.CreateFmt('Invalid type definition, a simple type cannot have "not attribute" properties : "%s"',[AContainer.GetExternalName(ASymbol)]);
if ( ACategory = tcSimpleContent ) then begin
raise EXsdGeneratorException.CreateFmt('Invalid type definition, a simple type cannot have "not attribute" properties : "%s"',[AContainer.GetExternalName(AClassType)]);
end;
hasSequence := True;
Result := True;
end;
end;
end;
end;
if hasSequence then begin
s := Format('%s:%s',[s_xs_short,s_sequence]);
if Assigned(derivationNode) then begin
sqcNode := CreateElement(s,derivationNode,ADocument);
end else begin
sqcNode := CreateElement(s,cplxNode,ADocument);
end;
end else begin
sqcNode := nil;
end;
procedure ProcessPropertyExtendedMetadata(const AProp : TPasProperty; const APropNode : TDOMElement);
var
ls : TStrings;
line, ns, ns_short, localName, attName, attValue : string;
k, q : PtrInt;
begin
ls := AContainer.Properties.GetList(AProp);
if ( ls <> nil ) and ( ls.Count > 0 ) then begin
for k := 0 to Pred(ls.Count) do begin
line := ls.Names[k];
q := Pos('#',line);
if ( q > 0 ) then begin
ns := Copy(line,1,Pred(q));
localName := Copy(line,Succ(q),MaxInt);
ns_short := GetNameSpaceShortName(ns,ADocument,GetOwner().GetPreferedShortNames());
attName := Format('%s:%s',[ns_short,localName]);
line := ls.Values[line];
q := Pos('#',line);
if ( q > 0 ) then begin
ns := Copy(line,1,Pred(q));
localName := Copy(line,Succ(q),MaxInt);
ns_short := GetNameSpaceShortName(ns,ADocument,GetOwner().GetPreferedShortNames());
attValue := Format('%s:%s',[ns_short,localName]);
end else begin
attValue := line;
end;
APropNode.SetAttribute(attName,attValue);
end;
end;
end;
end;
for i := 0 to Pred(typItm.Members.Count) do begin
if TPasElement(typItm.Members[i]).InheritsFrom(TPasProperty) then begin
p := TPasProperty(typItm.Members[i]);
var
cplxNode, sqcNode, derivationNode : TDOMElement;
procedure ProcessProperty(const AProp : TPasProperty);
var
p : TPasProperty;
s : string;
propNode : TDOMElement;
propTypItm, propItmUltimeType : TPasType;
prop_ns_shortName : string;
isEmbeddedArray : Boolean;
begin
p := AProp;
if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) or AnsiSameText('True',p.StoredAccessorName) then begin
if AContainer.IsAttributeProperty(p) then begin
s := Format('%s:%s',[s_xs_short,s_attribute]);
@ -585,7 +593,7 @@ begin
propNode.SetAttribute(s_name,AContainer.GetExternalName(p));
propTypItm := p.VarType;
if Assigned(propTypItm) then begin
prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm),ADocument);
prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm),ADocument,GetOwner().GetPreferedShortNames());
propItmUltimeType := GetUltimeType(propTypItm);
isEmbeddedArray := propItmUltimeType.InheritsFrom(TPasArrayType) and
( AContainer.GetArrayStyle(TPasArrayType(propItmUltimeType)) = asEmbeded );
@ -594,6 +602,8 @@ begin
else
s := AContainer.GetExternalName(propTypItm);
propNode.SetAttribute(s_type,Format('%s:%s',[prop_ns_shortName,s]));
if ( Length(p.DefaultValue) > 0 ) then
propNode.SetAttribute(s_default,p.DefaultValue);
if AContainer.IsAttributeProperty(p) then begin
if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) then
propNode.SetAttribute(s_use,'optional')
@ -610,8 +620,67 @@ begin
propNode.SetAttribute(s_maxOccurs,'1');}
end;
end;
ProcessPropertyExtendedMetadata(p,propNode);
end;
end;
var
typItm : TPasClassType;
s : string;
defSchemaNode : TDOMElement;
i : Integer;
typeCategory : TTypeCategory;
hasSequence : Boolean;
trueParent : TPasType;
begin
inherited;
typItm := ASymbol as TPasClassType;
if Assigned(typItm) then begin
GetNameSpaceShortName(AContainer.GetExternalName(AContainer.CurrentModule) ,ADocument,GetOwner().GetPreferedShortNames());
defSchemaNode := GetSchemaNode(ADocument) as TDOMElement;
s := Format('%s:%s',[s_xs_short,s_complexType]);
cplxNode := CreateElement(s,defSchemaNode,ADocument);
cplxNode.SetAttribute(s_name, AContainer.GetExternalName(typItm)) ;
typeCategory := tcComplexContent;
derivationNode := nil;
hasSequence := True;
if Assigned(typItm.AncestorType) then begin
trueParent := typItm.AncestorType;
if trueParent.InheritsFrom(TPasNativeClassType) and AnsiSameText('THeaderBlock',trueParent.Name) then begin
cplxNode.SetAttribute(s_WST_headerBlock,'true');
end;
if trueParent.InheritsFrom(TPasAliasType) then
trueParent := GetUltimeType(trueParent);
if trueParent.InheritsFrom(TPasNativeSimpleContentClassType) or
trueParent.InheritsFrom(TPasNativeSimpleType)
then begin
typeCategory := tcSimpleContent;
end;
derivationNode := CreateElement(Format('%s:%s',[s_xs_short,s_extension]),cplxNode,ADocument);
s := Trim(GetNameSpaceShortName(GetTypeNameSpace(AContainer,trueParent),ADocument,GetOwner().GetPreferedShortNames()));
if ( Length(s) > 0 ) then
s := s + ':';
s := s + AContainer.GetExternalName(trueParent);
derivationNode.SetAttribute(s_base,s);
hasSequence := False;
end;
if ( typItm.Members.Count > 0 ) then
hasSequence := TypeHasSequence(typItm,typeCategory);
if hasSequence then begin
s := Format('%s:%s',[s_xs_short,s_sequence]);
if Assigned(derivationNode) then
sqcNode := CreateElement(s,derivationNode,ADocument)
else
sqcNode := CreateElement(s,cplxNode,ADocument);
end else begin
sqcNode := nil;
end;
for i := 0 to Pred(typItm.Members.Count) do begin
if TPasElement(typItm.Members[i]).InheritsFrom(TPasProperty) then
ProcessProperty(TPasProperty(typItm.Members[i]));
end;
end;
end;
@ -643,7 +712,7 @@ begin
inherited;
typItm := ASymbol as TPasRecordType;
if Assigned(typItm) then begin
GetNameSpaceShortName(AContainer.GetExternalName(AContainer.CurrentModule) ,ADocument);
GetNameSpaceShortName(AContainer.GetExternalName(AContainer.CurrentModule) ,ADocument,GetOwner().GetPreferedShortNames());
defSchemaNode := GetSchemaNode(ADocument) as TDOMElement;
s := Format('%s:%s',[s_xs_short,s_complexType]);
@ -683,7 +752,7 @@ begin
propNode.SetAttribute(s_name,AContainer.GetExternalName(p));
propTypItm := p.VarType;
if Assigned(propTypItm) then begin
prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm),ADocument);
prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm),ADocument,GetOwner().GetPreferedShortNames());
propNode.SetAttribute(s_type,Format('%s:%s',[prop_ns_shortName,AContainer.GetExternalName(propTypItm)]));
storeOption := Trim(AContainer.Properties.GetValue(p,s_WST_storeType));
if AContainer.IsAttributeProperty(p) then begin
@ -795,6 +864,21 @@ begin
gr := GetXsdTypeHandlerRegistry();
typeList := mdl.InterfaceSection.Declarations;
k := typeList.Count;
if ( xgoIgnorembeddedArray in Options ) then begin
for j := 0 to Pred(k) do begin
tri := TPasElement(typeList[j]);
if tri.InheritsFrom(TPasType) and
( not tri.InheritsFrom(TPasNativeClassType) ) and
( not tri.InheritsFrom(TPasNativeSimpleType) ) and
( ( not tri.InheritsFrom(TPasArrayType) ) or
( ASymTable.GetArrayStyle(TPasArrayType(tri)) <> asEmbeded )
)
then begin
if gr.Find(tri,Self,g) then
g.Generate(ASymTable,tri,Self.Document);
end;
end;
end else begin
for j := 0 to Pred(k) do begin
tri := TPasElement(typeList[j]);
if tri.InheritsFrom(TPasType) and
@ -805,6 +889,7 @@ begin
g.Generate(ASymTable,tri,Self.Document);
end;
end;
end;
end;
procedure TCustomXsdGenerator.Prepare(ASymTable : TwstPasTreeContainer; AModule : TPasModule);
@ -812,11 +897,42 @@ begin
end;
constructor TCustomXsdGenerator.Create(ADocument : TDOMDocument);
constructor TCustomXsdGenerator.Create(const ADocument : TDOMDocument);
begin
Create(ADocument,[]);
end;
constructor TCustomXsdGenerator.Create(
const ADocument: TDOMDocument;
const AOptions: TGeneratorOptions
);
var
sl : TStringList;
begin
if ( ADocument = nil ) then
raise EXsdGeneratorException.Create('Invalid document.');
FDocument := ADocument;
FOptions := AOptions;
FShortNames := TStringList.Create();
sl := TStringList(FShortNames);
//sl.Sorted := True;
sl.Duplicates := dupIgnore;
end;
procedure TCustomXsdGenerator.SetPreferedShortNames(const ALongName, AShortName: string);
begin
FShortNames.Values[ALongName] := AShortName;
end;
function TCustomXsdGenerator.GetPreferedShortNames() : TStrings;
begin
Result := FShortNames;
end;
destructor TCustomXsdGenerator.Destroy();
begin
FreeAndNil(FShortNames);
inherited;
end;
{ TXsdGenerator }