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

parameter access qualifiers in WSDL parsing and generation.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@884 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-06-30 16:34:57 +00:00
parent 8cb6651cbe
commit 207e8f389b
4 changed files with 190 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -49,6 +49,7 @@ type
function IsStrEmpty(Const AStr : String):Boolean; function IsStrEmpty(Const AStr : String):Boolean;
function ExtractIdentifier(const AValue : string) : string ; function ExtractIdentifier(const AValue : string) : string ;
function GetToken(var ABuffer : string; const ADelimiter : string) : string;
{$IFDEF WST_HANDLE_DOC} {$IFDEF WST_HANDLE_DOC}
function EncodeLineBreak(const AInStr : string) : string; function EncodeLineBreak(const AInStr : string) : string;
function DecodeLineBreak(const AInStr : string) : string; function DecodeLineBreak(const AInStr : string) : string;
@ -149,6 +150,33 @@ begin
end; end;
end; end;
function GetToken(
var ABuffer : string;
const ADelimiter : string
) : string;
var
locDelPos, locDelLength : Integer;
begin
Result := '';
if IsStrEmpty(ABuffer) then begin
ABuffer := '';
end else begin
locDelPos := Pos(ADelimiter,ABuffer);
if ( locDelPos < 1 ) then begin
Result := ABuffer;
ABuffer := '';
end else begin
locDelLength := Length(ADelimiter);
if ( locDelPos = 1 ) then begin
ABuffer := Copy(ABuffer,(locDelLength + 1),(Length(ABuffer) - locDelLength));
end else begin
Result := Copy(ABuffer,1,(locDelPos - 1));
ABuffer := Copy(ABuffer,(locDelPos + locDelLength),(Length(ABuffer) - locDelLength));
end;
end;
end;
end;
{$IFDEF WST_HANDLE_DOC} {$IFDEF WST_HANDLE_DOC}
const const
REPLACE_CHAR_A = '#'; TARGET_SEQUENCE_A = sLineBreak; REPLACE_CHAR_A = '#'; TARGET_SEQUENCE_A = sLineBreak;

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

@ -221,21 +221,47 @@ procedure TWsdlGenerator.GenerateServiceMessages(
qryNode, rspNode : TDOMElement; qryNode, rspNode : TDOMElement;
ii, cc : Integer; ii, cc : Integer;
pp : TPasArgument; pp : TPasArgument;
prmAccessList : TStringList;
prmAccessStr : string;
docNode : TDOMNode;
begin begin
qryNode := CreateElement(s_message,ARootNode,Document); prmAccessList := TStringList.Create();
qryNode.SetAttribute(s_name,Format('%s',[ASymTable.GetExternalName(AOperation)])); try
rspNode := CreateElement(s_message,ARootNode,Document); qryNode := CreateElement(s_message,ARootNode,Document);
rspNode.SetAttribute(s_name,Format('%sResponse',[ASymTable.GetExternalName(AOperation)])); qryNode.SetAttribute(s_name,Format('%s',[ASymTable.GetExternalName(AOperation)]));
cc := AOperation.ProcType.Args.Count; rspNode := CreateElement(s_message,ARootNode,Document);
for ii := 0 to Pred(cc) do begin rspNode.SetAttribute(s_name,Format('%sResponse',[ASymTable.GetExternalName(AOperation)]));
pp := TPasArgument(AOperation.ProcType.Args[ii]); cc := AOperation.ProcType.Args.Count;
if ( pp.Access in [argDefault, argConst] ) then for ii := 0 to Pred(cc) do begin
GenerateParam(pp,qryNode) pp := TPasArgument(AOperation.ProcType.Args[ii]);
else if ( pp.Access in [argVar, argOut] ) then if ( pp.Access in [argDefault, argConst, argVar] ) then begin
GenerateParam(pp,rspNode); GenerateParam(pp,qryNode);
end; if ( pp.Access = argDefault ) then
if AOperation.InheritsFrom(TPasFunction) then begin prmAccessList.Add(Format('%s=%s',[ASymTable.GetExternalName(pp),GetEnumName(TypeInfo(TArgumentAccess),Ord(pp.Access))]));
GenerateResultParam(TPasFunctionType(AOperation.ProcType).ResultEl,rspNode); end;
if ( pp.Access in [argVar, argOut] ) then begin
GenerateParam(pp,rspNode);
end;
end;
if AOperation.InheritsFrom(TPasFunction) then begin
GenerateResultParam(TPasFunctionType(AOperation.ProcType).ResultEl,rspNode);
end;
if ( prmAccessList.Count > 0 ) then begin
docNode := Document.CreateElement(s_documentation);
if qryNode.HasChildNodes() then
qryNode.InsertBefore(docNode,qryNode.FirstChild)
else
qryNode.AppendChild(docNode);
prmAccessStr := '';
for ii := 0 to Pred(prmAccessList.Count) do begin
prmAccessStr := prmAccessStr + ';' +
prmAccessList.Names[ii] + '=' + prmAccessList.ValueFromIndex[ii];
end;
Delete(prmAccessStr,1,1);
CreateElement(s_paramAccess,docNode,Document).SetAttribute(s_value,prmAccessStr);
end;
finally
prmAccessList.Free();
end; end;
end; end;
@ -280,7 +306,7 @@ var
begin begin
prtTypeNode := CreateElement(s_portType,ARootNode,Document); prtTypeNode := CreateElement(s_portType,ARootNode,Document);
if ( Length(AContract.InterfaceGUID) > 0 ) then begin if ( Length(AContract.InterfaceGUID) > 0 ) then begin
docNode := CreateElement(s_document,prtTypeNode,Document); docNode := CreateElement(s_documentation,prtTypeNode,Document);
CreateElement(s_guid,docNode,Document).SetAttribute(s_value,AContract.InterfaceGUID); CreateElement(s_guid,docNode,Document).SetAttribute(s_value,AContract.InterfaceGUID);
end else begin end else begin
docNode := nil; docNode := nil;

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

@ -98,7 +98,8 @@ type
end; end;
implementation implementation
uses ws_parser_imp, dom_cursors, parserutils, StrUtils, xsd_consts; uses
ws_parser_imp, dom_cursors, parserutils, StrUtils, xsd_consts, TypInfo;
type type
@ -468,6 +469,48 @@ function TWsdlParser.ParseOperation(
end; end;
end; end;
procedure ParseParamAccess(AMessageNode : TDOMNode; AAccessList : TStrings);
var
nd : TDOMNode;
tmpCrs : IObjectCursor;
strBuffer, strToken : string;
begin
AAccessList.Clear();
tmpCrs := CreateCursorOn(
CreateChildrenCursor(AMessageNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,FWsdlShortNames),TDOMNodeRttiExposer)
);
tmpCrs.Reset();
if tmpCrs.MoveNext() then begin
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if nd.HasChildNodes() then begin
tmpCrs := CreateCursorOn(
CreateChildrenCursor(nd,cetRttiNode),
ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_paramAccess)]),TDOMNodeRttiExposer)
);
tmpCrs.Reset();
if tmpCrs.MoveNext() then begin
nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if ( nd.Attributes <> nil ) then begin
nd := nd.Attributes.GetNamedItem(s_value);
if Assigned(nd) then
strBuffer := Trim(nd.NodeValue);
end;
end;
end;
end;
if ( Length(strBuffer) > 0 ) then begin
while True do begin
strToken := Trim(GetToken(strBuffer,';'));
if ( Length(strToken) = 0 ) then
Break;
if ( Pos('=',strToken) < 1 ) then
Break;
AAccessList.Add(strToken);
end;
end;
end;
procedure ExtractMethod( procedure ExtractMethod(
const AMthdName : string; const AMthdName : string;
out AMthd : TPasProcedure out AMthd : TPasProcedure
@ -475,7 +518,7 @@ function TWsdlParser.ParseOperation(
var var
tmpMthd : TPasProcedure; tmpMthd : TPasProcedure;
tmpMthdType : TPasProcedureType; tmpMthdType : TPasProcedureType;
procedure ParseInputMessage(); procedure ParseInputMessage();
var var
inMsg, strBuffer : string; inMsg, strBuffer : string;
@ -486,6 +529,8 @@ function TWsdlParser.ParseOperation(
prmHasInternameName : Boolean; prmHasInternameName : Boolean;
prmDef : TPasArgument; prmDef : TPasArgument;
prmTypeDef : TPasType; prmTypeDef : TPasType;
prmAccess : TStringList;
intBuffer : Integer;
begin begin
tmpMthdType := TPasProcedureType(SymbolTable.CreateElement(TPasProcedureType,'',tmpMthd,visDefault,'',0)); tmpMthdType := TPasProcedureType(SymbolTable.CreateElement(TPasProcedureType,'',tmpMthd,visDefault,'',0));
tmpMthd.ProcType := tmpMthdType; tmpMthd.ProcType := tmpMthdType;
@ -495,68 +540,80 @@ function TWsdlParser.ParseOperation(
crs := CreatePartCursor(inMsgNode); crs := CreatePartCursor(inMsgNode);
if ( crs <> nil ) then begin if ( crs <> nil ) then begin
crs.Reset(); crs.Reset();
while crs.MoveNext() do begin prmAccess := TStringList.Create();
tmpNode := TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject; try
if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then begin ParseParamAccess(inMsgNode,prmAccess);
raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); while crs.MoveNext() do begin
end; tmpNode := TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject;
strBuffer := s_NODE_NAME + '=' + QuotedStr(s_name); if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then begin
tmpCrs := CreateCursorOn( raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
CreateAttributesCursor(tmpNode,cetRttiNode), end;
ParseFilter(strBuffer,TDOMNodeRttiExposer) strBuffer := s_NODE_NAME + '=' + QuotedStr(s_name);
); tmpCrs := CreateCursorOn(
tmpCrs.Reset(); CreateAttributesCursor(tmpNode,cetRttiNode),
if not tmpCrs.MoveNext() then begin ParseFilter(strBuffer,TDOMNodeRttiExposer)
raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); );
end; tmpCrs.Reset();
prmName := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeValue; if not tmpCrs.MoveNext() then begin
strBuffer := s_NODE_NAME + '=' + QuotedStr(s_element) + ' or ' + s_NODE_NAME + ' = ' + QuotedStr(s_type); raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
tmpCrs := CreateCursorOn( end;
CreateAttributesCursor(tmpNode,cetRttiNode), prmName := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeValue;
ParseFilter(strBuffer,TDOMNodeRttiExposer) strBuffer := s_NODE_NAME + '=' + QuotedStr(s_element) + ' or ' + s_NODE_NAME + ' = ' + QuotedStr(s_type);
); tmpCrs := CreateCursorOn(
tmpCrs.Reset(); CreateAttributesCursor(tmpNode,cetRttiNode),
if not tmpCrs.MoveNext() then begin ParseFilter(strBuffer,TDOMNodeRttiExposer)
raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); );
end; tmpCrs.Reset();
prmTypeName := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeValue; if not tmpCrs.MoveNext() then begin
prmTypeType := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeName; raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then begin end;
raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); prmTypeName := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeValue;
end; prmTypeType := TDOMNodeRttiExposer(tmpCrs.GetCurrent()).NodeName;
if SameText(s_document,ASoapBindingStyle) and if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then begin
AnsiSameText(prmTypeType,s_element) raise EXsdInvalidDefinitionException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
then begin end;
prmName := ExtractNameFromQName(prmTypeName); if SameText(s_document,ASoapBindingStyle) and
end; AnsiSameText(prmTypeType,s_element)
prmInternameName := Trim(prmName); then begin
if AnsiSameText(prmInternameName,tmpMthd.Name) then begin prmName := ExtractNameFromQName(prmTypeName);
prmInternameName := prmInternameName + 'Param'; end;
end; prmInternameName := Trim(prmName);
prmHasInternameName := IsReservedKeyWord(prmInternameName) or if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
( not IsValidIdent(prmInternameName) ) or prmInternameName := prmInternameName + 'Param';
( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 ); end;
if prmHasInternameName then begin prmHasInternameName := IsReservedKeyWord(prmInternameName) or
prmInternameName := '_' + prmInternameName; ( not IsValidIdent(prmInternameName) ) or
end; ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 );
prmHasInternameName := not AnsiSameText(prmInternameName,prmName); if prmHasInternameName then begin
prmTypeDef := GetDataType(prmTypeName,prmTypeType,ExtractTypeHint(tmpNode)); prmInternameName := '_' + prmInternameName;
prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0)); end;
tmpMthdType.Args.Add(prmDef); prmHasInternameName := not AnsiSameText(prmInternameName,prmName);
prmDef.ArgType := prmTypeDef; prmTypeDef := GetDataType(prmTypeName,prmTypeType,ExtractTypeHint(tmpNode));
prmTypeDef.AddRef(); prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0));
prmDef.Access := argConst; tmpMthdType.Args.Add(prmDef);
if prmHasInternameName or ( not AnsiSameText(prmName,prmInternameName) ) then begin prmDef.ArgType := prmTypeDef;
SymbolTable.RegisterExternalAlias(prmDef,prmName); prmTypeDef.AddRef();
end; prmDef.Access := argConst;
if AnsiSameText(tmpMthd.Name,prmTypeDef.Name) then begin strBuffer := Trim(prmAccess.Values[prmName]);
prmTypeInternalName := prmTypeDef.Name + '_Type'; if ( Length(strBuffer) > 0 ) then begin
while Assigned(FSymbols.FindElement(prmTypeInternalName)) do begin intBuffer := GetEnumValue(TypeInfo(TArgumentAccess),strBuffer);
prmTypeInternalName := '_' + prmTypeInternalName; if ( intBuffer > -1 ) then
prmDef.Access := TArgumentAccess(intBuffer);
end;
if prmHasInternameName or ( not AnsiSameText(prmName,prmInternameName) ) then begin
SymbolTable.RegisterExternalAlias(prmDef,prmName);
end;
if AnsiSameText(tmpMthd.Name,prmTypeDef.Name) then begin
prmTypeInternalName := prmTypeDef.Name + '_Type';
while Assigned(FSymbols.FindElement(prmTypeInternalName)) do begin
prmTypeInternalName := '_' + prmTypeInternalName;
end;
SymbolTable.RegisterExternalAlias(prmTypeDef,SymbolTable.GetExternalName(prmTypeDef));
prmTypeDef.Name := prmTypeInternalName;
end; end;
SymbolTable.RegisterExternalAlias(prmTypeDef,SymbolTable.GetExternalName(prmTypeDef));
prmTypeDef.Name := prmTypeInternalName;
end; end;
finally
prmAccess.Free();
end; end;
end; end;
end; end;
@ -1027,7 +1084,7 @@ var
Result := ''; Result := '';
tmpCrs := CreateCursorOn( tmpCrs := CreateCursorOn(
CreateChildrenCursor(ANode,cetRttiNode), CreateChildrenCursor(ANode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_document,FWsdlShortNames),TDOMNodeRttiExposer) ParseFilter(CreateQualifiedNameFilterStr(s_documentation,FWsdlShortNames),TDOMNodeRttiExposer)
); );
tmpCrs.Reset(); tmpCrs.Reset();
if tmpCrs.MoveNext() then begin if tmpCrs.MoveNext() then begin

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

@ -58,6 +58,7 @@ const
s_operation = 'operation'; s_operation = 'operation';
s_optional : WideString = 'optional'; s_optional : WideString = 'optional';
s_output : WideString = 'output'; s_output : WideString = 'output';
s_paramAccess = 'ParamAccess';
s_part : WideString = 'part'; s_part : WideString = 'part';
s_port : WideString = 'port'; s_port : WideString = 'port';
s_portType = 'portType'; s_portType = 'portType';