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

ws_helper code generation option -gEP : enum type''s items are prefixed with the enum name

Browse Source 
Add more Object Pascal keywords to the parser

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1020 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-11-26 10:39:50 +00:00
parent 1f8c09c225
commit 85e796e962
6 changed files with 131 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
wst/trunk/ws_helper/command_line_parser.pas
View File

@ -30,7 +30,7 @@ Type
cloInterface, cloProxy, cloImp, cloBinder, cloWsdl, cloXsd, cloInterface, cloProxy, cloImp, cloBinder, cloWsdl, cloXsd,
cloOutPutDirRelative, cloOutPutDirAbsolute, cloHandleWrappedParameters, cloOutPutDirRelative, cloOutPutDirAbsolute, cloHandleWrappedParameters,
cloGenerateDocAsComments, cloGenerateObjectCollection, cloGenerateDocAsComments, cloGenerateObjectCollection,
cloFileRenaming cloFileRenaming, cloPrefixEnum
); );
TComandLineOptions = set of TComandLineOption; TComandLineOptions = set of TComandLineOption;
@ -81,9 +81,14 @@ begin
'd' : Include(AAppOptions,cloGenerateDocAsComments); 'd' : Include(AAppOptions,cloGenerateDocAsComments);
'g' : 'g' :
begin begin
Include(AAppOptions,cloGenerateObjectCollection); if ( Pos('A',OptArg) = 1 ) or ( Pos('C',OptArg) = 1 ) then begin
OptionsArgsMAP[cloGenerateObjectCollection] := OptArg; Include(AAppOptions,cloGenerateObjectCollection);
end; OptionsArgsMAP[cloGenerateObjectCollection] := OptArg;
end else if ( Pos('E',OptArg) = 1 ) then begin
Include(AAppOptions,cloPrefixEnum);
OptionsArgsMAP[cloPrefixEnum] := OptArg;
end;
end;
'f' : 'f' :
begin begin
Include(AAppOptions,cloFileRenaming); Include(AAppOptions,cloFileRenaming);

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

@ -95,24 +95,27 @@ type
implementation implementation
uses StrUtils, rtti_filters; uses StrUtils, rtti_filters;
const LANGAGE_TOKEN : array[0..108] of string = ( const LANGAGE_TOKEN : array[0..127] of string = (
'ABSTRACT', 'AND', 'ARRAY', 'AS', 'ASM', 'ABSOLUTE', 'ABSTRACT', 'AND', 'ARRAY', 'AS', 'ASM',
'BEGIN', 'BOOLEAN', 'BYTE', 'BEGIN', 'BOOLEAN', 'BYTE',
'CASE', 'CDECL', 'CHAR', 'CLASS', 'COMP', 'CONST', 'CONSTRUCTOR', 'CONTAINS', 'CURRENCY', 'CASE', 'CDECL', 'CHAR', 'CLASS', 'COMP', 'CONST', 'CONSTRUCTOR', 'CONTAINS',
'DEFAULT', 'DESTRUCTOR', 'DIV', 'DO', 'DOUBLE', 'DOWNTO', 'DYNAMIC', 'CURRENCY', 'DEFAULT', 'DEPRECATED', 'DESTRUCTOR', 'DISPINTERFACE', 'DISPOSE', 'DIV', 'DO',
'END', 'EXPORT', 'EXPORTS', 'EXTERNAL', 'DOUBLE', 'DOWNTO', 'DYNAMIC', 'END', 'EXCEPT', 'EXIT', 'EXPORT', 'EXPORTS',
'FAR', 'FILE', 'FINALLY', 'FOR', 'FORWARD', 'FUNCTION', 'GOTO', 'EXTERNAL', 'FALSE', 'FAR', 'FILE', 'FINALIZATION', 'FINALLY', 'FOR',
'ELSE', 'EXCEPT', 'EXTENDED', 'FORWARD', 'FUNCTION', 'GOTO', 'ELSE', 'EXCEPT', 'EXTENDED',
'IF', 'IMPLEMENTATION', 'IMPLEMENTS', 'IN', 'INHERITED', 'INT64', 'INITIALIZATION', 'IF', 'IMPLEMENTATION', 'IMPLEMENTS', 'IN', 'INHERITED', 'INLINE', 'INT64',
'INTEGER', 'INTERFACE', 'IS', 'INITIALIZATION', 'INTEGER', 'INTERFACE', 'IS',
'LABEL', 'LIBRARY', 'LOCAL', 'LONGINT', 'LONGWORD', 'LABEL', 'LIBRARY', 'LOCAL', 'LONGINT', 'LONGWORD',
'MOD', 'NEAR', 'NIL', 'NODEFAULT', 'NOT', 'MOD', 'NEAR', 'NEW', 'NIL', 'NODEFAULT', 'NOT',
'OBJECT', 'OF', 'OLEVARIANT', 'OR', 'OUT', 'OVERLOAD', 'OVERRIDE', 'OBJECT', 'OF', 'OLEVARIANT', 'ON', 'OPERATOR', 'OR', 'OUT', 'OVERLOAD',
'PACKAGE', 'PACKED', 'PASCAL', 'PCHAR', 'PRIVATE', 'PROCEDURE', 'PROGRAM', 'PUBLISHED', 'OVERRIDE','PACKAGE', 'PACKED', 'PASCAL', 'PCHAR', 'PRIVATE', 'PROCEDURE',
'RAISE', 'READ', 'REAL', 'RECORD', 'REGISTER', 'REINTRODUCE', 'REPEAT', 'REQUIRES', 'RESULT', 'PROGRAM', 'PROPERTY', 'PROTECTED', 'PUBLIC', 'PUBLISHED',
'SAFECALL', 'SET', 'SHL', 'SHORTINT', 'SHR', 'SINGLE', 'SMALLINT', 'STDCALL', 'STORED', 'STRING', 'RAISE', 'READ', 'REAL', 'RECORD', 'REGISTER', 'REINTRODUCE', 'REPEAT',
'THEN', 'TO', 'TRY', 'TYPE', 'UNIT', 'UNTIL', 'USES', 'REQUIRES', 'RESOURCESTRING', 'RESULT', 'SAFECALL', 'SELF', 'SET', 'SHL',
'VAR', 'VARARGS', 'VARIANT', 'VIRTUAL', 'WHILE', 'WIDECHAR', 'WITH', 'WORD', 'WRITE', 'XOR' 'SHORTINT', 'SHR', 'SINGLE', 'SMALLINT', 'STDCALL', 'STORED', 'STRING',
'THEN', 'THREADVAR', 'TO', 'TRUE', 'TRY', 'TYPE', 'UNIT', 'UNTIL', 'USES',
'VAR', 'VARARGS', 'VARIANT', 'VIRTUAL', 'WHILE', 'WIDECHAR', 'WITH', 'WORD',
'WRITE', 'XOR'
); );
const WST_RESERVED_TOKEN : array[0..1] of string = ( 'Item', 'Item' ); const WST_RESERVED_TOKEN : array[0..1] of string = ( 'Item', 'Item' );
function IsReservedKeyWord(const AValue : string):Boolean ; function IsReservedKeyWord(const AValue : string):Boolean ;

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

@ -4,8 +4,10 @@ resourcestring
' -u MODE Generate the pascal translation of the WSDL input file ' + sNEW_LINE + ' -u MODE Generate the pascal translation of the WSDL input file ' + sNEW_LINE +
' MODE value may be U for used types or A for all types' + sNEW_LINE + ' MODE value may be U for used types or A for all types' + sNEW_LINE +
' -g Code generation option, with the following options : ' + sNEW_LINE + ' -g Code generation option, with the following options : ' + sNEW_LINE +
' A : object arrays are generated as "array" derived from TBaseObjectArrayRemotable' + sNEW_LINE + ' A : object arrays are generated as "array" derived from TBaseObjectArrayRemotable' + sNEW_LINE +
' C : object arrays are generated as "collection" derived from TObjectCollectionRemotable' + sNEW_LINE + ' C : object arrays are generated as "collection" derived from TObjectCollectionRemotable' + sNEW_LINE +
' EP : enum type''s items are prefixed with the enum name' + sNEW_LINE +
' EN : enum type''s items are not prefixed with the enum name, the default' + sNEW_LINE +
' -p Generate service proxy' + sNEW_LINE + ' -p Generate service proxy' + sNEW_LINE +
' -b Generate service binder' + sNEW_LINE + ' -b Generate service binder' + sNEW_LINE +
' -i Generate service minimal implementation. This will erase any existing implementation file!' + sNEW_LINE + ' -i Generate service minimal implementation. This will erase any existing implementation file!' + sNEW_LINE +
@ -82,17 +84,29 @@ var
begin begin
ParseSource(symtable,inFileName,osParam,targetParam); ParseSource(symtable,inFileName,osParam,targetParam);
end; end;
function GetParserSimpleOptions( ) : TParserOptions;
begin
Result := [];
if ( cloPrefixEnum in AppOptions ) then begin
if ( Pos('P',GetOptionArg(cloPrefixEnum)) = 2 ) then
Result := Result + [poEnumAlwaysPrefix];
end;
end;
procedure ParseWsdlFile(); procedure ParseWsdlFile();
var var
locDoc : TXMLDocument; locDoc : TXMLDocument;
prsrW : IParser; prsrW : IParser;
prsrCtx : IParserContext;
begin begin
ReadXMLFile(locDoc,inFileName); ReadXMLFile(locDoc,inFileName);
{$IFNDEF WST_INTF_DOM} {$IFNDEF WST_INTF_DOM}
try try
{$ENDIF} {$ENDIF}
prsrW := TWsdlParser.Create(locDoc,symtable);// as IParser; prsrW := TWsdlParser.Create(locDoc,symtable);// as IParser;
prsrCtx := prsrW as IParserContext;
prsrCtx.SetSimpleOptions(GetParserSimpleOptions());
prsrW.Execute(parserMode,ChangeFileExt(ExtractFileName(inFileName),'')); prsrW.Execute(parserMode,ChangeFileExt(ExtractFileName(inFileName),''));
{$IFNDEF WST_INTF_DOM} {$IFNDEF WST_INTF_DOM}
finally finally
@ -116,6 +130,7 @@ var
prsr := TXsdParser.Create(locDoc,symtable,ChangeFileExt(ExtractFileName(inFileName),'')) as IXsdPaser; prsr := TXsdParser.Create(locDoc,symtable,ChangeFileExt(ExtractFileName(inFileName),'')) as IXsdPaser;
prsrCtx := prsr as IParserContext; prsrCtx := prsr as IParserContext;
prsrCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(ExpandFileName(inFileName)))); prsrCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(ExpandFileName(inFileName))));
prsrCtx.SetSimpleOptions(GetParserSimpleOptions());
prsr.ParseTypes(); prsr.ParseTypes();
{$IFNDEF WST_INTF_DOM} {$IFNDEF WST_INTF_DOM}
finally finally

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

@ -51,7 +51,7 @@ type
) : TPasElement;{$IFDEF USE_INLINE}inline;{$ENDIF} ) : TPasElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
function FindElementWithHint(const AName, AHint : string; const ASpace : TSearchSpace) : TPasElement; function FindElementWithHint(const AName, AHint : string; const ASpace : TSearchSpace) : TPasElement;
function ExtractTypeHint(AElement : TDOMNode) : string;{$IFDEF USE_INLINE}inline;{$ENDIF} function ExtractTypeHint(AElement : TDOMNode) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure SetAsEmbeddedType(AType : TPasType); procedure SetAsEmbeddedType(AType : TPasType; const AValue : Boolean);
function IsEmbeddedType(AType : TPasType) : Boolean; function IsEmbeddedType(AType : TPasType) : Boolean;
{$IFDEF WST_HANDLE_DOC} {$IFDEF WST_HANDLE_DOC}
procedure ParseDocumentation(AType : TPasType); procedure ParseDocumentation(AType : TPasType);
@ -75,6 +75,7 @@ type
class function GetRegisteredParser(const AIndex : Integer):TAbstractTypeParserClass; class function GetRegisteredParser(const AIndex : Integer):TAbstractTypeParserClass;
function Parse():TPasType;virtual;abstract; function Parse():TPasType;virtual;abstract;
property Module : TPasModule read GetModule; property Module : TPasModule read GetModule;
property Context : IParserContext read FContext;
end; end;
TDerivationMode = ( dmNone, dmExtension, dmRestriction ); TDerivationMode = ( dmNone, dmExtension, dmRestriction );
@ -310,7 +311,7 @@ begin
if ( ASpaceType = nvtExpandValue ) then begin if ( ASpaceType = nvtExpandValue ) then begin
locNS := ANameSpace locNS := ANameSpace
end else begin end else begin
if not FContext.FindNameSpace(ANameSpace,locNS) then if not Context.FindNameSpace(ANameSpace,locNS) then
raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[ANameSpace]); raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[ANameSpace]);
end; end;
Result := FSymbols.FindElementNS(ALocalName,locNS); Result := FSymbols.FindElementNS(ALocalName,locNS);
@ -318,7 +319,7 @@ end;
function TAbstractTypeParser.GetModule : TPasModule; function TAbstractTypeParser.GetModule : TPasModule;
begin begin
Result := FContext.GetTargetModule(); Result := Context.GetTargetModule();
end; end;
function TAbstractTypeParser.FindElement( function TAbstractTypeParser.FindElement(
@ -351,13 +352,19 @@ end;
function TAbstractTypeParser.ExtractTypeHint(AElement: TDOMNode): string; function TAbstractTypeParser.ExtractTypeHint(AElement: TDOMNode): string;
begin begin
if not wst_findCustomAttributeXsd(FContext.GetXsShortNames(),AElement,s_WST_typeHint,Result) then if not wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_typeHint,Result) then
Result := ''; Result := '';
end; end;
procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType); procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType; const AValue : Boolean);
var
s : string;
begin begin
FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,'1'); if AValue then
s := '1'
else
s := '';
FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,s);
end; end;
function TAbstractTypeParser.IsEmbeddedType(AType : TPasType) : Boolean; function TAbstractTypeParser.IsEmbeddedType(AType : TPasType) : Boolean;
@ -377,14 +384,14 @@ begin
if FTypeNode.HasChildNodes() then begin if FTypeNode.HasChildNodes() then begin
tmpCursor := CreateCursorOn( tmpCursor := CreateCursorOn(
CreateChildrenCursor(FTypeNode,cetRttiNode), CreateChildrenCursor(FTypeNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_annotation,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_annotation,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
if ( tmpCursor <> nil ) then begin if ( tmpCursor <> nil ) then begin
tmpCursor.Reset(); tmpCursor.Reset();
if tmpCursor.MoveNext() then begin if tmpCursor.MoveNext() then begin
tmpCursor := CreateCursorOn( tmpCursor := CreateCursorOn(
CreateChildrenCursor(TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject,cetRttiNode), CreateChildrenCursor(TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_documentation,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
if ( tmpCursor <> nil ) then begin if ( tmpCursor <> nil ) then begin
tmpCursor.Reset(); tmpCursor.Reset();
@ -430,7 +437,7 @@ var
begin begin
locTmpCrs := CreateCursorOn( locTmpCrs := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor, frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_all,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_all,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
locTmpCrs.Reset(); locTmpCrs.Reset();
if locTmpCrs.MoveNext() then begin if locTmpCrs.MoveNext() then begin
@ -439,7 +446,7 @@ var
if locTmpNode.HasChildNodes() then begin if locTmpNode.HasChildNodes() then begin
locTmpCrs := CreateCursorOn( locTmpCrs := CreateCursorOn(
CreateChildrenCursor(locTmpNode,cetRttiNode), CreateChildrenCursor(locTmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
Result := locTmpCrs; Result := locTmpCrs;
end; end;
@ -454,7 +461,7 @@ var
ARes := nil; ARes := nil;
tmpCursor := CreateCursorOn( tmpCursor := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor, frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_sequence,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_sequence,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
tmpCursor.Reset(); tmpCursor.Reset();
Result := tmpCursor.MoveNext(); Result := tmpCursor.MoveNext();
@ -464,12 +471,12 @@ var
if tmpNode.HasChildNodes() then begin if tmpNode.HasChildNodes() then begin
tmpCursor := CreateCursorOn( tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode), CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
ARes := tmpCursor; ARes := tmpCursor;
tmpCursor := CreateCursorOn( tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode), CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_any,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_any,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
tmpCursor.Reset(); tmpCursor.Reset();
if tmpCursor.MoveNext() then if tmpCursor.MoveNext() then
@ -494,13 +501,13 @@ begin
if parentNode.HasChildNodes() then begin; if parentNode.HasChildNodes() then begin;
AAttCursor := CreateCursorOn( AAttCursor := CreateCursorOn(
CreateChildrenCursor(parentNode,cetRttiNode), CreateChildrenCursor(parentNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
crs := CreateChildrenCursor(parentNode,cetRttiNode); crs := CreateChildrenCursor(parentNode,cetRttiNode);
if ( crs <> nil ) then begin if ( crs <> nil ) then begin
crs := CreateCursorOn( crs := CreateCursorOn(
crs, crs,
ParseFilter(CreateQualifiedNameFilterStr(s_anyAttribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_anyAttribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
if ( crs <> nil ) then begin if ( crs <> nil ) then begin
crs.Reset(); crs.Reset();
@ -531,12 +538,12 @@ begin
e := ls.Item[k]; e := ls.Item[k];
if ( Pos(':', e.NodeName) > 1 ) then begin if ( Pos(':', e.NodeName) > 1 ) then begin
ExplodeQName(e.NodeName,localName,ns_short); ExplodeQName(e.NodeName,localName,ns_short);
if FContext.FindNameSpace(ns_short, ns_long) then begin if Context.FindNameSpace(ns_short, ns_long) then begin
locBuffer := e.NodeValue; locBuffer := e.NodeValue;
ExplodeQName(locBuffer,locBufferLocalName,locBufferNS); ExplodeQName(locBuffer,locBufferLocalName,locBufferNS);
if IsStrEmpty(locBufferNS) then if IsStrEmpty(locBufferNS) then
locBuffer := locBufferLocalName locBuffer := locBufferLocalName
else if FContext.FindNameSpace(locBufferNS, locBufferNS_long) then else if Context.FindNameSpace(locBufferNS, locBufferNS_long) then
locBuffer := Format('%s#%s',[locBufferNS_long,locBufferLocalName]); locBuffer := Format('%s#%s',[locBufferNS_long,locBufferLocalName]);
FSymbols.Properties.SetValue(AItem,Format('%s#%s',[ns_long,localName]),locBuffer); FSymbols.Properties.SetValue(AItem,Format('%s#%s',[ns_long,localName]),locBuffer);
end; end;
@ -596,7 +603,7 @@ begin
end; end;
crs := CreateCursorOn( crs := CreateCursorOn(
CreateChildrenCursor(FDerivationNode,cetRttiNode), CreateChildrenCursor(FDerivationNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
ls := TStringList.Create(); ls := TStringList.Create();
try try
@ -650,14 +657,14 @@ function TComplexTypeParser.IsHeaderBlock() : Boolean;
var var
strBuffer : string; strBuffer : string;
begin begin
Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer)); Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end; end;
function TComplexTypeParser.IsSimpleContentHeaderBlock() : Boolean; function TComplexTypeParser.IsSimpleContentHeaderBlock() : Boolean;
var var
strBuffer : string; strBuffer : string;
begin begin
Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer)); Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end; end;
procedure TComplexTypeParser.CreateNodeCursors(); procedure TComplexTypeParser.CreateNodeCursors();
@ -692,7 +699,7 @@ begin
if Assigned(FChildCursor) then begin if Assigned(FChildCursor) then begin
locCrs := CreateCursorOn( locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor, FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_complexContent,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_complexContent,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
if Assigned(locCrs) then begin if Assigned(locCrs) then begin
locCrs.Reset(); locCrs.Reset();
@ -702,7 +709,7 @@ begin
end else begin end else begin
locCrs := CreateCursorOn( locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor, FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_simpleContent,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_simpleContent,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
locCrs.Reset(); locCrs.Reset();
if locCrs.MoveNext() then begin if locCrs.MoveNext() then begin
@ -725,7 +732,7 @@ var
locBaseTypeLocalSpace, locBaseTypeLocalName, locBaseTypeInternalName, locFilterStr : string; locBaseTypeLocalSpace, locBaseTypeLocalName, locBaseTypeInternalName, locFilterStr : string;
locBaseTypeLocalSpaceExpanded : string; locBaseTypeLocalSpaceExpanded : string;
begin begin
locFilterStr := CreateQualifiedNameFilterStr(s_extension,FContext.GetXsShortNames()); locFilterStr := CreateQualifiedNameFilterStr(s_extension,Context.GetXsShortNames());
locContentChildCrs := CreateChildrenCursor(FContentNode,cetRttiNode); locContentChildCrs := CreateChildrenCursor(FContentNode,cetRttiNode);
locCrs := CreateCursorOn( locCrs := CreateCursorOn(
locContentChildCrs.Clone() as IObjectCursor, locContentChildCrs.Clone() as IObjectCursor,
@ -736,7 +743,7 @@ begin
FDerivationMode := dmExtension; FDerivationMode := dmExtension;
FDerivationNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; FDerivationNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
end else begin end else begin
locFilterStr := CreateQualifiedNameFilterStr(s_restriction,FContext.GetXsShortNames()); locFilterStr := CreateQualifiedNameFilterStr(s_restriction,Context.GetXsShortNames());
locCrs := CreateCursorOn( locCrs := CreateCursorOn(
locContentChildCrs.Clone() as IObjectCursor, locContentChildCrs.Clone() as IObjectCursor,
ParseFilter(locFilterStr,TDOMNodeRttiExposer) ParseFilter(locFilterStr,TDOMNodeRttiExposer)
@ -779,7 +786,7 @@ begin
end else begin end else begin
if ( FDerivationMode = dmRestriction ) and if ( FDerivationMode = dmRestriction ) and
( locBaseTypeLocalName = 'Array' ) and ( locBaseTypeLocalName = 'Array' ) and
( FContext.FindNameSpace(locBaseTypeLocalSpace,locBaseTypeLocalSpaceExpanded) and ( Context.FindNameSpace(locBaseTypeLocalSpace,locBaseTypeLocalSpaceExpanded) and
( locBaseTypeLocalSpaceExpanded = s_soapEncodingNameSpace ) ( locBaseTypeLocalSpaceExpanded = s_soapEncodingNameSpace )
) )
then begin then begin
@ -808,7 +815,7 @@ var
var var
strBuffer : string; strBuffer : string;
begin begin
Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer)); Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end; end;
procedure ParseElement(AElement : TDOMNode); procedure ParseElement(AElement : TDOMNode);
@ -856,7 +863,7 @@ var
locTypeHint := ExtractTypeHint(AElement); locTypeHint := ExtractTypeHint(AElement);
end else begin end else begin
locTypeName := Format('%s_%s_Type',[FTypeName,locName]); locTypeName := Format('%s_%s_Type',[FTypeName,locName]);
locType := TAbstractTypeParser.ExtractEmbeddedTypeFromElement(FContext,AElement,FSymbols,locTypeName); locType := TAbstractTypeParser.ExtractEmbeddedTypeFromElement(Context,AElement,FSymbols,locTypeName);
if ( locType = nil ) then begin if ( locType = nil ) then begin
raise EXsdInvalidElementDefinitionException.CreateFmt('Invalid <element> definition : unable to determine the type.'#13'Type name : "%s"; Element name :"%s".',[FTypeName,locName]); raise EXsdInvalidElementDefinitionException.CreateFmt('Invalid <element> definition : unable to determine the type.'#13'Type name : "%s"; Element name :"%s".',[FTypeName,locName]);
end; end;
@ -979,7 +986,7 @@ var
var var
strBuffer : string; strBuffer : string;
begin begin
Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer)); Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end; end;
procedure ParseElementsAndAttributes(AEltCrs, AEltAttCrs : IObjectCursor); procedure ParseElementsAndAttributes(AEltCrs, AEltAttCrs : IObjectCursor);
@ -1213,7 +1220,7 @@ function TComplexTypeParser.ParseSimpleContent(const ATypeName : string) : TPasT
Result := nil; Result := nil;
parentNode := FContentNode; parentNode := FContentNode;
if parentNode.HasChildNodes() then begin; if parentNode.HasChildNodes() then begin;
xsShortNameList := FContext.GetXsShortNames(); xsShortNameList := Context.GetXsShortNames();
frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode); frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode);
locFilterStr := CreateQualifiedNameFilterStr(s_extension,xsShortNameList) + ' or ' + locFilterStr := CreateQualifiedNameFilterStr(s_extension,xsShortNameList) + ' or ' +
CreateQualifiedNameFilterStr(s_restriction,xsShortNameList) ; CreateQualifiedNameFilterStr(s_restriction,xsShortNameList) ;
@ -1407,6 +1414,10 @@ begin
else else
Result := ParseSimpleContent(FTypeName); Result := ParseSimpleContent(FTypeName);
end; end;
if ( Result <> nil ) then begin
if ( IsEmbeddedType(Result) <> FEmbededDef ) then
SetAsEmbeddedType(Result,FEmbededDef);
end;
{$IFDEF WST_HANDLE_DOC} {$IFDEF WST_HANDLE_DOC}
if ( Result <> nil ) then if ( Result <> nil ) then
ParseDocumentation(Result); ParseDocumentation(Result);
@ -1448,7 +1459,7 @@ var
begin begin
locCrs := CreateCursorOn( locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor, FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_restriction,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_restriction,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
locCrs.Reset(); locCrs.Reset();
if locCrs.MoveNext() then begin if locCrs.MoveNext() then begin
@ -1466,14 +1477,14 @@ begin
FBaseNameSpace := ''; FBaseNameSpace := '';
if Assigned(tmpNode) then begin if Assigned(tmpNode) then begin
ExplodeQName(tmpNode.NodeValue,FBaseName,spaceShort); ExplodeQName(tmpNode.NodeValue,FBaseName,spaceShort);
if not FContext.FindNameSpace(spaceShort,FBaseNameSpace) then if not Context.FindNameSpace(spaceShort,FBaseNameSpace) then
raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[spaceShort]); raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[spaceShort]);
end; end;
locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor; locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor;
if Assigned(locCrs) then begin if Assigned(locCrs) then begin
locCrs := CreateCursorOn( locCrs := CreateCursorOn(
locCrs, locCrs,
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
locCrs.Reset(); locCrs.Reset();
if locCrs.MoveNext() then begin if locCrs.MoveNext() then begin
@ -1501,13 +1512,14 @@ function TSimpleTypeParser.ParseEnumContent(): TPasType;
begin begin
Result := CreateCursorOn( Result := CreateCursorOn(
CreateChildrenCursor(FRestrictionNode,cetRttiNode), CreateChildrenCursor(FRestrictionNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FContext.GetXsShortNames()),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,Context.GetXsShortNames()),TDOMNodeRttiExposer)
); );
end; end;
var var
locRes : TPasEnumType; locRes : TPasEnumType;
locOrder : Integer; locOrder : Integer;
prefixItems : Boolean;
procedure ParseEnumItem(AItemNode : TDOMNode); procedure ParseEnumItem(AItemNode : TDOMNode);
var var
@ -1533,7 +1545,8 @@ var
locInternalItemName := ExtractIdentifier(locItemName); locInternalItemName := ExtractIdentifier(locItemName);
if IsStrEmpty(locInternalItemName) then if IsStrEmpty(locInternalItemName) then
locInternalItemName := 'EmptyItem'; locInternalItemName := 'EmptyItem';
locHasInternalName := IsReservedKeyWord(locInternalItemName) or locHasInternalName := prefixItems or
IsReservedKeyWord(locInternalItemName) or
( not IsValidIdent(locInternalItemName) ) or ( not IsValidIdent(locInternalItemName) ) or
( FSymbols.FindElementInModule(locInternalItemName,Self.Module) <> nil ) or ( FSymbols.FindElementInModule(locInternalItemName,Self.Module) <> nil ) or
FSymbols.IsEnumItemNameUsed(locInternalItemName,Self.Module) or FSymbols.IsEnumItemNameUsed(locInternalItemName,Self.Module) or
@ -1559,6 +1572,7 @@ var
intrName : string; intrName : string;
hasIntrnName : Boolean; hasIntrnName : Boolean;
begin begin
prefixItems := ( poEnumAlwaysPrefix in Context.GetSimpleOptions() );
locEnumCrs := ExtractEnumCursor(); locEnumCrs := ExtractEnumCursor();
intrName := FTypeName; intrName := FTypeName;

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

@ -59,6 +59,7 @@ type
FTypesCursor : IObjectCursor; FTypesCursor : IObjectCursor;
FSchemaCursor : IObjectCursor; FSchemaCursor : IObjectCursor;
FOnMessage: TOnParserMessage; FOnMessage: TOnParserMessage;
FSimpleOptions : TParserOptions;
private private
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
function AddNameSpace(const AValue : string) : TStrings; function AddNameSpace(const AValue : string) : TStrings;
@ -93,6 +94,8 @@ type
function GetTargetModule() : TPasModule; function GetTargetModule() : TPasModule;
function GetDocumentLocator() : IDocumentLocator; function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator); procedure SetDocumentLocator(const ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions);
public public
constructor Create( constructor Create(
ADoc : TXMLDocument; ADoc : TXMLDocument;
@ -299,6 +302,17 @@ begin
FDocumentLocator := ALocator; FDocumentLocator := ALocator;
end; end;
function TWsdlParser.GetSimpleOptions(): TParserOptions;
begin
Result := FSimpleOptions;
end;
procedure TWsdlParser.SetSimpleOptions(const AValue: TParserOptions);
begin
if ( AValue <> FSimpleOptions ) then
FSimpleOptions := AValue;
end;
function TWsdlParser.GetTargetNameSpace() : string; function TWsdlParser.GetTargetNameSpace() : string;
begin begin
Result := FTargetNameSpace; Result := FTargetNameSpace;
@ -819,6 +833,7 @@ begin
locMthd := nil; locMthd := nil;
if not ExtractOperationName(mthdName) then if not ExtractOperationName(mthdName) then
raise EXsdParserAssertException.CreateFmt('Operation Attribute not found : "%s"',[s_name]); raise EXsdParserAssertException.CreateFmt('Operation Attribute not found : "%s"',[s_name]);
DoOnMessage(mtInfo,Format('Parsing operation "%s"',[mthdName]));
if SameText(s_document,ASoapBindingStyle) then begin if SameText(s_document,ASoapBindingStyle) then begin
ExtractMethod(mthdName,locMthd); ExtractMethod(mthdName,locMthd);
if ( locMthd <> nil ) then begin if ( locMthd <> nil ) then begin
@ -1151,6 +1166,7 @@ begin
ansiStrBuffer := locObj.NodeValue; ansiStrBuffer := locObj.NodeValue;
elt := SymbolTable.FindElementInModule(ansiStrBuffer,SymbolTable.CurrentModule); elt := SymbolTable.FindElementInModule(ansiStrBuffer,SymbolTable.CurrentModule);
if ( elt = nil ) then begin if ( elt = nil ) then begin
DoOnMessage(mtInfo,Format('Parsing the port type "%s"',[ansiStrBuffer]));
locIntf := TPasClassType(SymbolTable.CreateElement(TPasClassType,ansiStrBuffer,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); locIntf := TPasClassType(SymbolTable.CreateElement(TPasClassType,ansiStrBuffer,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0));
FModule.InterfaceSection.Declarations.Add(locIntf); FModule.InterfaceSection.Declarations.Add(locIntf);
FModule.InterfaceSection.Types.Add(locIntf); FModule.InterfaceSection.Types.Add(locIntf);
@ -1276,6 +1292,7 @@ procedure TWsdlParser.Prepare(const AModuleName: string);
locPrs.SetNotifier(FOnMessage); locPrs.SetNotifier(FOnMessage);
locPrsCtx := locPrs as IParserContext; locPrsCtx := locPrs as IParserContext;
locPrsCtx.SetDocumentLocator(locDocLocator); locPrsCtx.SetDocumentLocator(locDocLocator);
locPrsCtx.SetSimpleOptions(Self.GetSimpleOptions());
ns := (locPrs as IParserContext).GetTargetNameSpace(); ns := (locPrs as IParserContext).GetTargetNameSpace();
FXsdParsers.AddObject(ns,TIntfObjectRef.Create(locPrs)); FXsdParsers.AddObject(ns,TIntfObjectRef.Create(locPrs));
end; end;

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

@ -50,6 +50,10 @@ type
) : Boolean; ) : Boolean;
end; end;
TParserOption = (
poEnumAlwaysPrefix // Always prefix enum item with the enum name
);
TParserOptions = set of TParserOption;
IParserContext = interface IParserContext = interface
['{F400BA9E-41AC-456C-ABF9-CEAA75313685}'] ['{F400BA9E-41AC-456C-ABF9-CEAA75313685}']
function GetXsShortNames() : TStrings; function GetXsShortNames() : TStrings;
@ -60,6 +64,8 @@ type
function GetTargetModule() : TPasModule; function GetTargetModule() : TPasModule;
function GetDocumentLocator() : IDocumentLocator; function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator); procedure SetDocumentLocator(const ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions);
end; end;
IXsdPaser = interface IXsdPaser = interface
@ -93,6 +99,7 @@ type
FChildCursor : IObjectCursor; FChildCursor : IObjectCursor;
FOnMessage: TOnParserMessage; FOnMessage: TOnParserMessage;
FDocumentLocator : IDocumentLocator; FDocumentLocator : IDocumentLocator;
FSimpleOptions : TParserOptions;
FImportParsed : Boolean; FImportParsed : Boolean;
private private
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
@ -109,6 +116,8 @@ type
function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
function GetDocumentLocator() : IDocumentLocator; function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator); procedure SetDocumentLocator(const ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions);
procedure SetNotifier(ANotifier : TOnParserMessage); procedure SetNotifier(ANotifier : TOnParserMessage);
function InternalParseType( function InternalParseType(
@ -363,6 +372,17 @@ begin
FDocumentLocator := ALocator; FDocumentLocator := ALocator;
end; end;
function TCustomXsdSchemaParser.GetSimpleOptions(): TParserOptions;
begin
Result := FSimpleOptions;
end;
procedure TCustomXsdSchemaParser.SetSimpleOptions(const AValue: TParserOptions);
begin
if ( AValue <> FSimpleOptions ) then
FSimpleOptions := AValue;
end;
procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage); procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage);
begin begin
FOnMessage := ANotifier; FOnMessage := ANotifier;