unit uRODLTemplateBasedConverterUtils; {----------------------------------------------------------------------------} { RemObjects SDK Library - CodeGen2 } { } { compiler: Delphi 5 and up, Kylix 2 and up } { platform: Win32, Linux } { } { (c)opyright RemObjects Software. all rights reserved. } { } { Using this code requires a valid license of the RemObjects SDK } { which can be obtained at http://www.remobjects.com. } {----------------------------------------------------------------------------} {$IFDEF LINUX} {$I ../RemObjects.inc} {$ELSE} {$I ..\RemObjects.inc} {$ENDIF LINUX} interface uses uRODLLineStream, uRODL; const COLLECTION_SUFFIX = 'Collection'; DEFAULT_STRUCT_ANCESTOR = 'TROComplexType'; DEFAULT_STRUCT_COLLECTION_ANCESTOR = 'TROCollection'; DEFAULT_EXCEPTION_ANCESTOR = 'EROException'; DEFAULT_SERVICE_PROXY_ANCESTOR_NAME = 'TROProxy'; DEFAULT_SERVICE_INVOKER_ANCESTOR_NAME = 'ROInvoker'; DEFAULT_EVENT_SINK_WRITER_ANCESTOR_NAME = 'ROEventWriter'; DEFAULT_EVENT_SINK_INVOKER_ANCESTOR_NAME = 'ROEventInvoker'; DEFAULT_SERVICE_ASYNC_ANCESTOR_NAME = 'IROAsyncInterface'; DEFAULT_SERVICE_ASYNC_PROXY_ANCESTOR_NAME = 'TROAsyncProxy'; SERVICE_PROXY_SUFFIX = '_Proxy'; SERVICE_INVOKER_SUFFIX = '_Invoker'; EVENT_SINK_WRITER_SUFFIX = '_Writer'; EVENT_SINK_INVOKER_SUFFIX = '_Invoker'; DEFAULT_INTF_SUFFIX = '_Intf'; DEFAULT_INVK_SUFFIX = '_Invk'; DEFAULT_IMPL_SUFFIX = '_Impl'; DEFAULT_ASYNC_SUFFIX = '_Async'; DEFAULT_ASYNC_PROXY_SUFFIX = '_AsyncProxy'; IN_FLAGS = [fIn, fInOut]; OUT_FLAGS = [fOut, fInOut, fResult]; function MacroReplace(var Text: string; MacroChar: Char; const Macros: array of string; CaseSensitive: Boolean = True): Boolean; function SectionStart(const Line: string; SectionName: string): Boolean; function SectionEnd(const Line: string; SectionName: string): Boolean; function FinishSection(const SectionName: string; SourceTemplate: TLineStream): string; overload; procedure FinishSection(const SectionName: string; SourceTemplate: TLineStream; DestTemplate: TLineStream); overload; function StrEnsureNoSuffix(const Suffix, Text: string): string; function StrEnsureSuffix(const Suffix, Text: string): string; // The functions below should be moved to uRODLGenTools function CachedIsImplementedAsClass(const aTypeName: string; aLibrary: TRODLLibrary): Boolean; function CachedDataTypeToCSharpType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; function CachedDataTypeToDelphiType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; function CachedDataTypeToDelphiDotNetType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; function CachedDataTypeToCppType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; function CachedArrayExists(const aArrayName: string; aLibrary:TRODLLibrary): Boolean; procedure ClearIsImplementedAsClassCache(aLibrary: TRODLLibrary = nil); procedure ClearArrayExistsCache(aLibrary:TRODLLibrary = nil); procedure ClearDataTypeCaches(aLibrary: TRODLLibrary = nil); procedure ClearAllCaches(aLibrary: TRODLLibrary = nil); function DataTypeToCSharpType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; function DataTypeToCppType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; function DataTypeToDelphiType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; function ArrayExists(const aArrayName: string; aLibrary:TRODLLibrary): Boolean; implementation uses SysUtils, Classes, Contnrs, IniFiles, uROTypes, uRODLGenTools; type TBooleanCacheElement = class private FLibrary: TRODLLibrary; FCachedTypes: {$IFDEF FPC}TStringList{$ELSE}THashedStringList{$ENDIF}; protected function GetUncachedIsSet(const aTypeName: string): Boolean; virtual; abstract; public constructor Create(aLibrary: TRODLLibrary); destructor Destroy; override; function IsSet(const aTypeName: string): Boolean; procedure Clear; end; TBooleanCacheElementClass = class of TBooleanCacheElement; TBooleanCacheList = class(TObjectList) private function GetItemByLibrary( aLibrary: TRODLLibrary): TBooleanCacheElement; function GetItem(Index: Integer): TBooleanCacheElement; protected function GetElementType: TBooleanCacheElementClass; virtual; abstract; public property ItemsByLibrary[aLibrary: TRODLLibrary]: TBooleanCacheElement read GetItemByLibrary; property Items[Index: Integer]: TBooleanCacheElement read GetItem; default; end; TIdentifierTypeCacheList = class; TIdentifierTypeCacheElement = class private FLibrary: TRODLLibrary; FCachedTypes: {$IFDEF FPC}TStringList{$ELSE}THashedStringList{$ENDIF}; FParent: TIdentifierTypeCacheList; public constructor Create(aParent: TIdentifierTypeCacheList; aLibrary: TRODLLibrary); destructor Destroy; override; function TypeIdentifier(const aTypeName: string; const AForNew: Boolean): string; procedure Clear; end; TGetTypeIdentifier = function (const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string; TIdentifierTypeCacheList = class (TObjectList) private FGetTypeIdentifier: TGetTypeIdentifier; function GetItem(Index: Integer): TIdentifierTypeCacheElement; function GetItemByLibrary( aLibrary: TRODLLibrary): TIdentifierTypeCacheElement; public constructor Create(aGetTypeIdentifier: TGetTypeIdentifier; AOwnsObjects: Boolean = True); property ItemsByLibrary[aLibrary: TRODLLibrary]: TIdentifierTypeCacheElement read GetItemByLibrary; property Items[Index: Integer]: TIdentifierTypeCacheElement read GetItem; default; end; TIsImplementedAsClassCacheElement = class(TBooleanCacheElement) protected function GetUncachedIsSet(const aTypeName: string): Boolean; override; end; TIsImplementedAsClassCacheList = class(TBooleanCacheList) protected function GetElementType: TBooleanCacheElementClass; override; end; TArrayExistsCacheElement = class(TBooleanCacheElement) protected function GetUncachedIsSet(const aTypeName: string): Boolean; override; end; TArrayExistsCacheList = class(TBooleanCacheList) protected function GetElementType: TBooleanCacheElementClass; override; end; var FIsImplementedAsClassCache: TIsImplementedAsClassCacheList; FArrayExistsCache: TArrayExistsCacheList; FDataTypeToCSharpTypeCache: TIdentifierTypeCacheList; FDataTypeToDelphiTypeCache: TIdentifierTypeCacheList; FDataTypeToDelphiDotNetTypeCache: TIdentifierTypeCacheList; FDataTypeToCppTypeCache: TIdentifierTypeCacheList; type CmpFunc = function(const Str1, Str2: PChar; MaxLen: {$IFDEF FPC}LongInt{$ELSE}Cardinal{$ENDIF}): Integer; function MacroReplace(var Text: string; MacroChar: Char; const Macros: array of string; CaseSensitive: Boolean = True): Boolean; const Delta = 1024; var Index, i, Count, Len, SLen, MacroHigh: Integer; S: string; Found: Boolean; Cmp: CmpFunc; begin Result := False; if CaseSensitive then Cmp := {$IFDEF FPC}@{$ENDIF}StrLComp else Cmp := {$IFDEF FPC}@{$ENDIF}StrLIComp; MacroHigh := Length(Macros) div 2 - 1; Len := Length(Text); i := 1; SetLength(S, Delta); SLen := 0; while i <= Len do begin Count := 0; // add normal chars in one step while (i <= Len) and (Text[i] <> MacroChar) do begin Inc(Count); Inc(i); end; if Count > 0 then begin if SLen + Count > Length(S) then SetLength(S, SLen + Count + Delta); Move(Text[i - Count], S[SLen + 1], Count); Inc(SLen, Count); end; if i <= Len then begin // replace macros Found := False; for Index := 0 to MacroHigh do begin Count := Length(Macros[Index * 2]) + 1; // Plus one to eat the trailing macro char if Cmp(PChar(Pointer(Text)) + i, PChar(Macros[Index * 2] + MacroChar), Count) = 0 then begin Inc(i, Count); Count := Length(Macros[Index * 2 + 1]); if Count > 0 then begin if SLen + Count > Length(S) then SetLength(S, SLen + Count + Delta); Move(Macros[Index * 2 + 1][1], S[SLen + 1], Count); Inc(SLen, Count); end; Result := True; Found := True; Break; end; end; if not Found then begin // copy macro-text if Macros[0][Length(Macros[0])] = MacroChar then begin Count := 1; while (i + Count <= Len) and (Text[i + Count] <> MacroChar) do Inc(Count); end else begin Count := 0; end; Inc(Count); if SLen + Count > Length(S) then SetLength(S, SLen + Count + Delta); Move(Text[i], S[SLen + 1], Count); Inc(SLen, Count); Inc(i, Count - 1); end; end; Inc(i); end; SetLength(S, SLen); Text := S; end; function SectionStart(const Line: string; SectionName: string): Boolean; begin Result := Trim(Line) = '// <%%% START ' + SectionName + ' %%%>'; end; function SectionEnd(const Line: string; SectionName: string): Boolean; begin Result := Trim(Line) = '// <%%% END ' + SectionName + ' %%%>'; end; function FinishSection(const SectionName: string; SourceTemplate: TLineStream): string; overload; var curLine: string; prevLine: string; begin Result := ''; prevLine := ''; curLine := SourceTemplate.ReadLine; while not SourceTemplate.Eof and not SectionEnd(curLine, SectionName) do begin Result := Result + curLine + #13#10; prevLine := curLine; curLine := SourceTemplate.ReadLine; end; if SourceTemplate.Eof and not SectionEnd(curLine, SectionName) then Result := Result + curLine + #13#10; if Length(prevLine) <> 0 then Result := StrEnsureNoSuffix(#13#10, Result); end; procedure FinishSection(const SectionName: string; SourceTemplate: TLineStream; DestTemplate: TLineStream); overload; var content: string; begin content := FinishSection(SectionName, SourceTemplate); DestTemplate.Position := 0; DestTemplate.Size := Length(content); DestTemplate.WriteString(content); DestTemplate.Position := 0; end; // Extracted from the JCL (under MPL licence) function StrEnsureNoSuffix(const Suffix, Text: string): string; var SuffixLen : Integer; StrLength : Integer; begin SuffixLen := Length(Suffix); StrLength := Length(Text); if Copy(Text, StrLength - SuffixLen + 1, SuffixLen) = Suffix then Result := Copy(Text, 1, StrLength - SuffixLen) else Result := Text; end; // Extracted from the JCL (under MPL licence) function StrEnsureSuffix(const Suffix, Text: string): string; var SuffixLen: Integer; begin SuffixLen := Length(Suffix); if Copy(Text, Length(Text) - SuffixLen + 1, SuffixLen) = Suffix then Result := Text else Result := Text + Suffix; end; { TBooleanCacheElement } procedure TBooleanCacheElement.Clear; begin FCachedTypes.Clear; end; constructor TBooleanCacheElement.Create(aLibrary: TRODLLibrary); begin inherited Create; FLibrary := aLibrary; FCachedTypes := {$IFDEF FPC}TStringList{$ELSE}THashedStringList{$ENDIF}.Create; FCachedTypes.CaseSensitive := True; FCachedTypes.Capacity := 20; FCachedTypes.Sorted := True; end; destructor TBooleanCacheElement.Destroy; begin FCachedTypes.Free; inherited Destroy; end; function TBooleanCacheElement.IsSet( const aTypeName: string): Boolean; var typeNameIndex: Integer; begin typeNameIndex := FCachedTypes.IndexOf(aTypeName); if typeNameIndex > -1 then begin Result := Boolean(cardinal(FCachedTypes.Objects[typeNameIndex])); end else begin Result := GetUncachedIsSet(aTypeName); FCachedTypes.AddObject(aTypeName, TObject(Result)); end; end; { TBooleanCacheList } function TBooleanCacheList.GetItemByLibrary( aLibrary: TRODLLibrary): TBooleanCacheElement; var I: Integer; begin I := 0; Result := nil; while not Assigned(Result) and (I < Count) do begin if Items[I].FLibrary = aLibrary then Result := Items[I]; Inc(I); end; if not Assigned(Result) then begin Result := GetElementType.Create(aLibrary); Add(Result); end; end; function TBooleanCacheList.GetItem( Index: Integer): TBooleanCacheElement; begin Result := inherited Items[Index] as TBooleanCacheElement; end; { TIdentifierTypeCacheElement } procedure TIdentifierTypeCacheElement.Clear; begin FCachedTypes.Clear; end; constructor TIdentifierTypeCacheElement.Create(aParent: TIdentifierTypeCacheList; aLibrary: TRODLLibrary); begin inherited Create; FLibrary := aLibrary; FParent := aParent; FCachedTypes := {$IFDEF FPC}TStringList{$ELSE}THashedStringList{$ENDIF}.Create; FCachedTypes.CaseSensitive := True; FCachedTypes.Capacity := 20; end; destructor TIdentifierTypeCacheElement.Destroy; begin FCachedTypes.Free; inherited Destroy; end; function TIdentifierTypeCacheElement.TypeIdentifier( const aTypeName: string; const AForNew: Boolean): string; begin Result := FCachedTypes.Values[aTypeName + ',' + BoolToStr(AForNew)]; if Length(Result) = 0 then begin Result := FParent.FGetTypeIdentifier(aTypeName, FLibrary, AForNew); FCachedTypes.Values[aTypeName + ',' + BoolToStr(AForNew)] := Result; end; end; { TIdentifierTypeCacheList } constructor TIdentifierTypeCacheList.Create( aGetTypeIdentifier: TGetTypeIdentifier; AOwnsObjects: Boolean); begin inherited Create(AOwnsObjects); FGetTypeIdentifier := aGetTypeIdentifier; end; function TIdentifierTypeCacheList.GetItem( Index: Integer): TIdentifierTypeCacheElement; begin Result := inherited Items[Index] as TIdentifierTypeCacheElement; end; function TIdentifierTypeCacheList.GetItemByLibrary( aLibrary: TRODLLibrary): TIdentifierTypeCacheElement; var I: Integer; begin I := 0; Result := nil; while not Assigned(Result) and (I < Count) do begin if Items[I].FLibrary = aLibrary then Result := Items[I]; Inc(I); end; if not Assigned(Result) then begin Result := TIdentifierTypeCacheElement.Create(Self, aLibrary); Add(Result); end; end; { TIsImplementedAsClassCacheElement } function TIsImplementedAsClassCacheElement.GetUncachedIsSet( const aTypeName: string): Boolean; begin Result := IsImplementedAsClass(aTypeName, FLibrary); end; { TIsImplementedAsClassCacheList } function TIsImplementedAsClassCacheList.GetElementType: TBooleanCacheElementClass; begin Result := TIsImplementedAsClassCacheElement; end; { TArrayExistsCacheElement } function TArrayExistsCacheElement.GetUncachedIsSet( const aTypeName: string): Boolean; begin Result := ArrayExists(aTypeName, FLibrary); end; { TArrayExistsCacheList } function TArrayExistsCacheList.GetElementType: TBooleanCacheElementClass; begin Result := TArrayExistsCacheElement; end; function CachedIsImplementedAsClass(const aTypeName:string; aLibrary:TRODLLibrary):boolean; begin if not Assigned(FIsImplementedAsClassCache) then begin FIsImplementedAsClassCache := TIsImplementedAsClassCacheList.Create(True); end; Result := FIsImplementedAsClassCache.ItemsByLibrary[aLibrary].IsSet(aTypeName); end; procedure ClearIsImplementedAsClassCache(aLibrary: TRODLLibrary); begin if Assigned(FIsImplementedAsClassCache) then begin if Assigned(aLibrary) then FIsImplementedAsClassCache.ItemsByLibrary[aLibrary].Clear else FIsImplementedAsClassCache.Clear; end; end; function CachedDataTypeToCSharpType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; begin if not Assigned(FDataTypeToCSharpTypeCache) then begin FDataTypeToCSharpTypeCache := TIdentifierTypeCacheList.Create(DataTypeToCSharpType, True); end; Result := FDataTypeToCSharpTypeCache.ItemsByLibrary[aLibrary].TypeIdentifier(aTypeName, aForNew); end; function CachedDataTypeToDelphiType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; begin if not Assigned(FDataTypeToDelphiTypeCache) then begin FDataTypeToDelphiTypeCache := TIdentifierTypeCacheList.Create(DataTypeToDelphiType, True); end; Result := FDataTypeToDelphiTypeCache.ItemsByLibrary[aLibrary].TypeIdentifier(aTypeName, aForNew); end; function DataTypeToDelphiType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; begin case StrToDataType(aTypeName) of rtXML: Result:= 'IXmlNode'; else Result := aTypeName; end; end; function CachedDataTypeToDelphiDotNetType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; begin if not Assigned(FDataTypeToDelphiDotNetTypeCache) then begin FDataTypeToDelphiDotNetTypeCache := TIdentifierTypeCacheList.Create(uRODLGenTools.DataTypeToDelphiDotNetType, True); end; Result := FDataTypeToDelphiDotNetTypeCache.ItemsByLibrary[aLibrary].TypeIdentifier(aTypeName, aForNew); end; function CachedDataTypeToCppType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; begin if not Assigned(FDataTypeToCppTypeCache) then begin FDataTypeToCppTypeCache := TIdentifierTypeCacheList.Create(DataTypeToCppType, True); end; Result := FDataTypeToCppTypeCache.ItemsByLibrary[aLibrary].TypeIdentifier(aTypeName, aForNew); end; function DataTypeToCppType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; const CppSimpleTypes: array[TRODataType] of string = ('int', 'TDateTime', 'double', 'Currency', 'WideString', 'AnsiString', '__int64', 'bool', 'Variant', 'Binary', '_di_IXMLNode', 'TGuidString','TDecimalVariant',''); // TRODataType = // (rtInteger, rtDateTime, rtDouble, rtCurrency, rtWidestring, rtString, rtInt64, rtBoolean, rtVariant, rtBinary, rtUserDefined); // TODO: Need to finish these if possible - in their proper place - if needed- else we need something // in the Macros like %IFCONST% that is replaced by "const" and %IFVAR% and/or %IFOUT% that is replaced with "&" // PasFlagNames : array[TRODLParamFlag] of string = // ('const', 'out', 'var', 'result'); // Also these must be translated to "False" and "True" - case sensitively // BoolStr : array[boolean] of string = ('false','true'); var aType: TRODataType; begin for aType := Low(DataTypeNames) to High(DataTypeNames) do if SameText(aTypeName, DataTypeNames[aType]) and (aType in [Low(CppSimpletypes)..High(CppSimpleTypes)]) then begin Result:= CppSimpleTypes[aType]; exit; end; // Not found case Result:= aTypeName; end; function DataTypeToCSharpType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string; const CSharpSimpleTypes: array[TRODataType] of string = ('int', 'System.DateTime', 'double', 'decimal', 'string', 'string', 'Int64', 'bool', 'Variant', 'Binary', 'IXMLNode', 'TGuidString','TDecimalVariant', ''); var aType: TRODataType; begin for aType := Low(DataTypeNames) to High(DataTypeNames) do if SameText(aTypeName, DataTypeNames[aType]) and (aType in [Low(CSharpSimpleTypes)..High(CSharpSimpleTypes)]) then begin Result := CSharpSimpleTypes[aType]; Exit; end; // Not found case Result := uRODLGenTools.DataTypeToCSharpType(aTypeName, aLibrary, aForNew); end; function ArrayExists(const aArrayName: string; aLibrary:TRODLLibrary): Boolean; begin Result := Assigned(aLibrary.FindArray(aArrayName)); end; function CachedArrayExists(const aArrayName: string; aLibrary:TRODLLibrary): Boolean; begin if not Assigned(FArrayExistsCache) then begin FArrayExistsCache := TArrayExistsCacheList.Create(True); end; Result := FArrayExistsCache.ItemsByLibrary[aLibrary].IsSet(aArrayName); end; procedure ClearArrayExistsCache(aLibrary:TRODLLibrary = nil); begin if Assigned(FArrayExistsCache) then begin if Assigned(aLibrary) then FArrayExistsCache.ItemsByLibrary[aLibrary].Clear else FArrayExistsCache.Clear; end; end; procedure ClearDataTypeCaches(aLibrary: TRODLLibrary = nil); begin if Assigned(FDataTypeToCSharpTypeCache) then begin if Assigned(aLibrary) then FDataTypeToCSharpTypeCache.ItemsByLibrary[aLibrary].Clear else FDataTypeToCSharpTypeCache.Clear; end; if Assigned(FDataTypeToDelphiTypeCache) then begin if Assigned(aLibrary) then FDataTypeToDelphiTypeCache.ItemsByLibrary[aLibrary].Clear else FDataTypeToDelphiTypeCache.Clear; end; if Assigned(FDataTypeToDelphiDotNetTypeCache) then begin if Assigned(aLibrary) then FDataTypeToDelphiDotNetTypeCache.ItemsByLibrary[aLibrary].Clear else FDataTypeToDelphiDotNetTypeCache.Clear; end; if Assigned(FDataTypeToCppTypeCache) then begin if Assigned(aLibrary) then FDataTypeToCppTypeCache.ItemsByLibrary[aLibrary].Clear else FDataTypeToCppTypeCache.Clear; end; end; procedure ClearAllCaches(aLibrary: TRODLLibrary = nil); begin ClearDataTypeCaches(aLibrary); ClearIsImplementedAsClassCache(aLibrary); ClearArrayExistsCache(aLibrary); end; initialization finalization FIsImplementedAsClassCache.Free; FArrayExistsCache.Free; FDataTypeToCSharpTypeCache.Free; FDataTypeToDelphiTypeCache.Free; FDataTypeToDelphiDotNetTypeCache.Free; FDataTypeToCppTypeCache.Free; end.