edmx2pas.pp 80 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864
  1. {$ifdef USECSDL}
  2. unit csdl2pas;
  3. {$ELSE}
  4. unit edmx2pas;
  5. {$ENDIF}
  6. {$mode objfpc}{$H+}
  7. interface
  8. uses
  9. typinfo, Classes, contnrs, SysUtils, restcodegen, odatacodegen,
  10. {$IFDEF USECSDL} csdl, {$ELSE} edm, {$ENDIF} pastree, base_service_intf, xml_serializer;
  11. Const
  12. IndexShift = 3; // Number of bits reserved for flags.
  13. Type
  14. {$IFNDEF USECSDL}
  15. // EDM type names
  16. TSchema = Schema;
  17. EntityContainer = TEntityContainer;
  18. TComplexTypeProperty = TProperty;
  19. TEntityProperty = TProperty;
  20. {$ELSE}
  21. TEntitySet = EntityContainer_EntitySet_Type;
  22. TEntityType_KeyArray = TEntityKeyElement;
  23. TFunctionImport = EntityContainer_FunctionImport_Type;
  24. {$ENDIF}
  25. { TImplicitEntitySet }
  26. TImplicitEntitySet = CLass(TEntitySet)
  27. private
  28. FIsColl: Boolean;
  29. FNavigationProperty: TNavigationProperty;
  30. Public
  31. Constructor Create(AProperty : TNavigationProperty; ATypeName : String; AIsColl : Boolean); reintroduce;
  32. Property NavigationProperty : TNavigationProperty Read FNavigationProperty;
  33. Property IsColl : Boolean Read FIsColl;
  34. end;
  35. { TIdentifier }
  36. TIdentifier = Class(TObject)
  37. private
  38. FEL: TPasElement;
  39. FIsEntitySet: Boolean;
  40. FName: String;
  41. FSchema: TSchema;
  42. Public
  43. Constructor Create(Const AName : String; ASchema : TSchema; El : TPasElement);
  44. Destructor Destroy; override;
  45. Property IdentifierName : String Read FName;
  46. Property Schema : TSchema Read FSchema;
  47. Property Element : TPasElement Read FEL;
  48. Property IsEntitySet : Boolean Read FIsEntitySet Write FIsEntitySet;
  49. end;
  50. { TEDMX2PasConverter }
  51. TEDMX2PasConverter = Class(TODataCodeGenerator)
  52. private
  53. FXML: TStream;
  54. FFreeObjects : TFPObjectList;
  55. FSchemaList : TFPObjectList;
  56. FIdentifierList : TFPObjectList;
  57. FIdentifierHash : TFPObjectHashTable;
  58. Protected
  59. // Identifier management
  60. {$IFDEF USECSDL}
  61. Function FindAssociatedTypeInSchema(ASchema: TSchema; Const ARelation, ARole: String): String;
  62. Function FindAssociatedType(Var APreferredSchema: TSchema; Const ARelation, ARole: String): String;
  63. {$ENDIF}
  64. function UseExtraIdentifierProtection(D: TObject): TExtraKeywords;
  65. Function ExtractBaseTypeName(ASchema: TSchema; ATypeName: String; Out IsColl: Boolean): String;
  66. Function ExtractBaseTypeName(ASchema: TSchema; ATypeName: UnicodeString; Out IsColl: Boolean): String;
  67. Function FindEntitySetForEntity(ASchema: TSchema; AName: String): TIdentifier;
  68. Function FindProperty(C: TPasClassType; APropertyName: String): TEntityProperty;
  69. Function FindProperty(C: TPasClassType; APropertyName: UnicodeString): TEntityProperty;
  70. Function GetEntityKey(C: TPasClassType): TEntityType_KeyArray;
  71. Function FindQualifiedIdentifier(AName: String): TIdentifier;
  72. Function FindIdentifier(ASchema : TSchema; AName: String): TIdentifier;
  73. Function FindIdentifier(ASchema : TSchema; AName: UnicodeString): TIdentifier;
  74. Function GetNameSpace(ASchema: TSchema): String;
  75. Function GetNativeTypeName(O: TObject): String;
  76. Function NeedWriteSetter(P: TComplexTypeProperty): Boolean;
  77. Function ResolveNameSpace(ASchema: TSchema; ATypeName: String): String;
  78. Function ResolveType(ASchema: TSchema; Const ATypeName: String): TPasType;
  79. Function ResolveType(ASchema: TSchema; Const ATypeName: UnicodeString): TPasType;
  80. // EDMX
  81. // Identifier generation
  82. procedure SchemaToIdentifiers;virtual;
  83. Procedure AddIdentifier(AIDentifier : TIdentifier);
  84. Function AddIdentifier(Const AName : String; ASchema : TSchema; El : TPasElement) : TIdentifier;
  85. Function AddIdentifier(Const AName : UnicodeString; ASchema : TSchema; El : TPasElement) : TIdentifier;
  86. procedure EntityContainerToIdentifiers(ASchema: TSchema; EC: EntityContainer);virtual;
  87. Procedure CompleteIdentifiers;virtual;
  88. Procedure GenerateBaseClass(ID: TIDentifier);virtual;
  89. Procedure CheckNavigationPropertyEntity(ASchema: TSchema; AEntity: TEntityType);virtual;
  90. Procedure AddExportPropertyName(ID: TIdentifier);virtual;
  91. Procedure AddContainerToSchema(ID: TIdentifier; AIndex: Integer; E: EntityContainer);virtual;
  92. procedure AddEntitySet(ID: TIDentifier; ES: TEntitySet; AIndex : Integer);virtual;
  93. Procedure AddEntityGet(ID, EID: TIdentifier);virtual;
  94. Procedure AddEntityList(ID: TIdentifier; ArgType: String; ListAll: Boolean);virtual;
  95. Function AddGetStream(ID: TIDentifier): TGetStream;
  96. Function AddSetStream(ID: TIDentifier): TSetStream;
  97. Function AddGetKeyAsURLPart(ID: TIdentifier; Key: TEntityKeyElement ): TPasFunction;virtual;
  98. function CreateIdentifierName(ASchema: TSchema; const APrefix, AName: String): String;virtual;
  99. function CreateIdentifierName(ASchema: TSchema; const APrefix, AName: UnicodeString): String;virtual;
  100. function CreateIdentifierName(ASchema: TSchema; const APrefix : String; AName: UnicodeString): String;virtual;
  101. Function CreatePropertyGetter(AParent: TPasElement; PN: String; indexed: Boolean; T: TPasType): TPropertyGetter;virtual;
  102. Function CreatePropertySetter(AParent: TPasElement; PN: String; indexed: Boolean; T: TPasType): TPropertySetter;virtual;
  103. // Return true if the actual property name differs from the property name in the Edm
  104. Function AddProperty(ID: TIdentifier; APropertyIndex : integer; Const APropertyName, APropertyType: String; Flags: TPropertyFlags; ACustomData : TObject) : Boolean;virtual;
  105. Function AddNavigationProperty(ID: TIDentifier; P: TNavigationProperty): TPasFunction;virtual;
  106. procedure AddImportFunction(ID: TIdentifier; AFun: TFunctionImport);
  107. {$IFNDEF USECSDL}
  108. procedure AddImportAction(ID : TIdentifier; Act : TActionImport; AIndex : Integer);
  109. Function AddUnboundFunction(ID : TIdentifier; APath : String; Fun : TFunction; AIndex : Integer) : TPasFunction;
  110. Function CheckBoundFunction(ASchema: TSchema; Fun: TFunction): TPasFunction;
  111. Function AddUnboundAction(ID : TIdentifier; APath : String; Act : TAction; AIndex : integer) : TPasProcedure;
  112. Function CheckBoundAction(ASchema: TSchema; Act: TAction): TPasProcedure;
  113. procedure AddSingleTon(ID: TIDentifier; S: TSingleton; AIndex : integer);virtual;
  114. {$ENDIF}
  115. Procedure AddSetArrayLength(ID: TIdentifier); virtual;
  116. procedure CompleteContainer(ID: TIdentifier);virtual;
  117. Procedure CompleteEnumerator(ID: TIdentifier);virtual;
  118. Procedure CompleteComplexType(ID: TIdentifier);virtual;
  119. Procedure CompleteEntityType(ID: TIdentifier);virtual;
  120. Procedure CompleteEntitySet(ID: TIdentifier);virtual;
  121. procedure CompleteSchema(ID: TIdentifier);virtual;
  122. // Code generation
  123. procedure EmitInterface;virtual;
  124. procedure EmitImplementation;virtual;
  125. procedure EmitForwardDeclaration;virtual;
  126. procedure EmitEnumTypes;virtual;
  127. procedure EmitClassDeclarations;virtual;
  128. procedure EmitClassDeclaration(ID : TIDentifier);virtual;
  129. procedure EmitClassImplementation(ID : TIDentifier);virtual;
  130. procedure EmitClassDeclarationSection(El: TPasClassType; V: TPasMemberVisibility);virtual;
  131. Procedure EmitMethodHeader(AClassName, AMethodName: String; PT: TPasProcedureType; RT: String);
  132. procedure EmitObjectRestKind(CT: TPasClassType; R: TObjectRestKind);virtual;
  133. procedure EmitGetSingleton(CT: TPasClassType; S: TGetSingleTon);virtual;
  134. procedure EmitGetKeyAsURLPart(CT: TPasClassType; ASchema : TSchema; P: TKeyAsURLPart);virtual;
  135. procedure EmitPropertySetter(Const CN: String; P: TPropertySetter);virtual;
  136. procedure EmitPropertyGetter(Const CN: String; P: TPropertyGetter);virtual;
  137. procedure EmitCreateContainer(Const CN: String; CC: TCreateContainer);virtual;
  138. procedure EmitCreateEntitySet(Const CN: String; CE: TCreateEntitySet);virtual;
  139. Procedure EmitGetStream(Const CN: String; G: TGetStream);virtual;
  140. Procedure EmitSetStream(Const CN: String; G: TSetStream);virtual;
  141. Procedure EmitSetArrayLength(CT : TPasClassType; A : TSetArrayLength); virtual;
  142. {$IFNDEF USECSDL}
  143. Procedure EmitFunctionCall(ServiceName,ReturnType : String; ResultType : TResultType);
  144. Procedure EmitMethodPath(PT: TPasProcedureType; MethodPath : String; GlobalService : Boolean);
  145. Procedure EmitPreparePostObject(Act: TPasProcedure; ActionPath : String; GlobalService,AllocateArray : Boolean);
  146. Procedure EmitBoundFunction(CT: TPasClassType; ASchema : TSchema; Fun: TBoundFunction);virtual;
  147. Procedure EmitBoundAction(CT: TPasClassType; ASchema : TSchema; Act: TPasProcedure);virtual;
  148. Procedure EmitUnBoundFunction(CT: TPasClassType; Fun: TUnBoundFunction);virtual;
  149. Procedure EmitUnBoundAction(CT: TPasClassType; Act: TPasProcedure);virtual;
  150. Procedure EmitActionServiceCall(Const AReturnType,AElementType : String; GlobalService : Boolean; ResultType : TResultType);
  151. {$endif}
  152. procedure EmitEntityClassFunction(CT: TPasClassType; ASchema: TSchema; CE: TEntityClassFunction);virtual;
  153. procedure EmitGetContainedSingleton(CT: TPasClassType; E: TGetContainedSingleton);virtual;
  154. procedure EmitNavigationProperty(CT: TPasClassType; E: TGetNavigationProperty);virtual;
  155. procedure EmitExportPropertyName(CT: TPasClassType; E: TExportPropertyName);virtual;
  156. procedure EmitEntityGet(CT: TPasClassType; E: TEntityGet);virtual;
  157. procedure EmitEntityList(CT: TPasClassType; E: TEntityList);virtual;
  158. procedure EmitEntityMethod(CT: TPasClassType; E: TEntityMethod);virtual;
  159. // Function GetPropertyTypeName(Decl: TDOMELement): String;
  160. procedure AnalyseXML; virtual;
  161. Public
  162. Constructor Create(AOwner : TComponent); override;
  163. Destructor Destroy; override;
  164. Class Function ODataVersion : TODataVersion; override;
  165. Procedure LoadFromStream(Const AStream : TStream); override;
  166. Procedure Execute; override;
  167. end;
  168. implementation
  169. { TImplicitEntitySet }
  170. Constructor TImplicitEntitySet.Create(AProperty: TNavigationProperty;
  171. ATypeName: String; AIsColl: Boolean);
  172. begin
  173. Inherited Create;
  174. FNavigationProperty:=AProperty;
  175. EntityType:=ATypeName;
  176. FIsColl:=AIsColl;
  177. end;
  178. { TIdentifier }
  179. Constructor TIdentifier.Create(Const AName: String; ASchema: TSchema;
  180. El: TPasElement);
  181. Var
  182. N : String;
  183. begin
  184. FName:=AName;
  185. FSchema:=ASchema;
  186. FEl:=El;
  187. if (FName='') then
  188. begin
  189. if (FSchema=Nil) or (FEl=Nil) then
  190. Raise EEDMX2PasConverter.Create('No identifier name specified, no element and schema specified');
  191. N:=GetStrProp(EL.CustomData,'Name');
  192. if (N='') then
  193. N:=GetStrProp(EL.CustomData,'TypeName');
  194. FName:=TODataCodeGenerator.WTOA(FSchema.Namespace)+'.'+N;
  195. end;
  196. // Writeln('Identifier '+FName,' created (',El.ClassName,': ',el.Name,')');
  197. end;
  198. Destructor TIdentifier.Destroy;
  199. begin
  200. // Writeln('Destroying ',FEL.Name,' : ',Fel.RefCount);
  201. // Flush(output);
  202. FEl.Release;
  203. inherited Destroy;
  204. end;
  205. constructor TEDMX2PasConverter.Create(AOwner: TComponent);
  206. begin
  207. inherited Create(AOWner);
  208. FFreeObjects:=TFPObjectList.Create(True);
  209. FSchemaList:=TFPObjectList.Create(True);
  210. FIdentifierList:=TFPObjectList.Create(True);
  211. FIdentifierHash:=TFPObjectHashTable.Create(False);
  212. FXML:=TStringStream.Create('');
  213. end;
  214. destructor TEDMX2PasConverter.Destroy;
  215. begin
  216. FreeAndNil(FXML);
  217. FreeAndNil(FSchemaList);
  218. FreeAndNil(FIdentifierList);
  219. FreeAndNil(FFreeObjects);
  220. FreeAndNil(FIdentifierHash);
  221. inherited Destroy;
  222. end;
  223. procedure TEDMX2PasConverter.EmitClassDeclarations;
  224. Var
  225. I : Integer;
  226. ID : TIdentifier;
  227. begin
  228. For I:=0 to FIdentifierList.Count-1 do
  229. begin
  230. ID:=FIdentifierList[i] as TIdentifier;
  231. if ID.Element.InheritsFrom(TPasClassType) then
  232. EmitClassDeclaration(ID);
  233. end;
  234. end;
  235. procedure TEDMX2PasConverter.EmitClassDeclarationSection(El: TPasClassType; V: TPasMemberVisibility);
  236. Var
  237. I : integer;
  238. M : TPasElement;
  239. PP : TPasProperty;
  240. S : String;
  241. begin
  242. // Variables (fields);
  243. For I:=0 to El.Members.Count-1 do
  244. begin
  245. M:=TPasElement(El.Members[i]);
  246. if (M.Visibility=v) and (M.ClassType=TPasvariable) then // Do not use InheritsFrom or Is !!
  247. AddLn(M.GetDeclaration(True)+';');
  248. end;
  249. // Methods
  250. For I:=0 to El.Members.Count-1 do
  251. begin
  252. M:=TPasElement(El.Members[i]);
  253. if (M.Visibility=v) and (M is TPasProcedure) then
  254. WriteProcedureDecl(M as TPasProcedure);
  255. end;
  256. // Properties
  257. For I:=0 to El.Members.Count-1 do
  258. begin
  259. M:=TPasElement(El.Members[i]);
  260. if (M.Visibility=v) and (M is TPasProperty) then
  261. begin
  262. PP:=M as TPasProperty;
  263. S:=Format('Property %s : %s',[PP.Name,PP.VarType.Name]);
  264. if Assigned(PP.IndexExpr) then
  265. S:=S+Format(' index %s',[(PP.IndexExpr as TPrimitiveExpr).Value]);
  266. S:=S+Format(' read %s',[PP.ReadAccessorName]);
  267. if (PP.WriteAccessorName<>'') then
  268. S:=S+Format(' write %s',[PP.WriteAccessorName]);
  269. AddLn(S+';');
  270. end;
  271. end;
  272. end;
  273. function TEDMX2PasConverter.GetNativeTypeName(O: TObject): String;
  274. begin
  275. if O.InheritsFrom(TSchema) then
  276. Result:=WTOA(TSchema(O).Namespace)
  277. else
  278. Result:=GetStrProp(O,'Name');
  279. end;
  280. procedure TEDMX2PasConverter.EmitClassDeclaration(ID: TIDentifier);
  281. Function CountElementsForVisibility(Alist : TFPList; V : TPasMemberVisibility) : integer;
  282. Var
  283. I : Integer;
  284. begin
  285. Result:=0;
  286. For I:=0 to AList.Count-1 do
  287. if TPasElement(AList[I]).Visibility=V then
  288. Inc(Result);
  289. end;
  290. Var
  291. NN,PC,S : String;
  292. El : TPasClassType;
  293. Empty : Boolean;
  294. V : TPasMemberVisibility;
  295. begin
  296. EL:=ID.Element as TPasClassType;
  297. NN:=GetNativeTypeName(EL.CustomData);
  298. ClassHeader(WTOA(ID.Schema.NameSpace)+': '+NN);
  299. Empty:=not (Assigned(EL.Members) and (EL.Members.Count>0));
  300. PC:=GetBaseClassName(EL);
  301. S:=Format('%s = Class(%s)',[EL.Name,PC]);
  302. if empty then
  303. S:=S+';';
  304. AddLn(S);
  305. if Empty then
  306. exit;
  307. for v in TPasMemberVisibility do
  308. if CountElementsForVisibility(El.Members,V)>0 then
  309. begin
  310. if V<>visDefault then
  311. AddLn(VisibilityNames[v]);
  312. IncIndent;
  313. EmitClassDeclarationSection(EL,V);
  314. DecIndent;
  315. end;
  316. Addln('end;');
  317. AddLn('');
  318. end;
  319. procedure TEDMX2PasConverter.EmitPropertyGetter(const CN: String;
  320. P: TPropertyGetter);
  321. Var
  322. TN,FN : String;
  323. D : TObject;
  324. begin
  325. TN:=(P.TheProperty as TPasProperty).VarType.Name;
  326. EmitMethodHeader(CN,P.Name,P.ProcType,TN);
  327. AddLn('');
  328. AddLn('begin');
  329. IncIndent;
  330. FN:=FieldPrefix+P.TheProperty.Name;
  331. D:=P.TheProperty.CustomData;
  332. if (D is EntityContainer)
  333. or (D is TEntitySet)
  334. {$IFNDEF USECSDL} OR (D is TSingleton){$ENDIF} then
  335. begin
  336. AddLn('If Not Assigned(%s) then',[FN]);
  337. IncIndent;
  338. if D is EntityContainer then
  339. AddLn('%s:=%s(CreateEntityContainer(%s));',[FN,TN,TN])
  340. {$IFNDEF USECSDL}
  341. else if D is TSIngleton then
  342. AddLn('%s:=Fetch%s;',[FN,P.TheProperty.Name])
  343. {$ENDIF}
  344. else if D is TEntitySet then
  345. AddLn('%s:=%s(CreateEntitySet(%s));',[FN,TN,TN]);
  346. DecIndent;
  347. end;
  348. AddLn('Result:=%s;',[FN]);
  349. DecIndent;
  350. AddLn('end;');
  351. AddLn('');
  352. end;
  353. procedure TEDMX2PasConverter.EmitCreateContainer(const CN: String;
  354. CC: TCreateContainer);
  355. Var
  356. TN : String;
  357. begin
  358. TN:=(CC.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
  359. AddLn('Function %s.%s : %s; ',[CN,CC.Name,TN]);
  360. SimpleMethodBody([ Format('Result:=%s(CreateEntityContainer(%s));',[TN,TN])]);
  361. end;
  362. procedure TEDMX2PasConverter.EmitCreateEntitySet(const CN: String;
  363. CE: TCreateEntitySet);
  364. Var
  365. TN : String;
  366. begin
  367. TN:=(CE.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
  368. AddLn('Function %s.%s : %s; ',[CN,CE.Name,TN]);
  369. SimpleMethodBody([ Format('Result:=%s(CreateEntitySet(%s));',[TN,TN])]);
  370. end;
  371. procedure TEDMX2PasConverter.EmitGetStream(const CN: String; G: TGetStream);
  372. Var
  373. S : String;
  374. I : Integer;
  375. begin
  376. EmitMethodHeader(CN,G.Name,G.ProcType,'');
  377. S:='';
  378. For i:=0 to G.ProcType.Args.Count-1 do
  379. begin
  380. If (S<>'') then
  381. S:=S+',';
  382. S:=S+TPasArgument(G.ProcType.Args[i]).Name;
  383. end;
  384. SimpleMethodBody([Format('DoGetStream(%s);',[S])]);
  385. end;
  386. procedure TEDMX2PasConverter.EmitMethodHeader(AClassName, AMethodName: String;
  387. PT: TPasProcedureType; RT: String);
  388. Var
  389. Args : TStrings;
  390. I : Integer;
  391. S : String;
  392. begin
  393. Args:=TStringList.Create;
  394. try
  395. Args.Clear;
  396. Addln('');
  397. PT.GetArguments(Args);
  398. S:='';
  399. For i:=0 to Args.Count-1 do
  400. S:=S+Args[i];
  401. If (RT<>'') then
  402. AddLn('Function %s.%s%s : %s; ',[AClassName,AMethodName,S,RT])
  403. else
  404. AddLn('Procedure %s.%s%s; ',[AClassName,AMethodName,S]);
  405. Addln('');
  406. finally
  407. Args.Free;
  408. end;
  409. end;
  410. {$IFNDEF USECSDL}
  411. procedure TEDMX2PasConverter.EmitMethodPath(PT: TPasProcedureType;
  412. MethodPath: String; GlobalService: Boolean);
  413. Var
  414. FirstIndex,I : Integer;
  415. AP : TPasArgument;
  416. KP : String;
  417. begin
  418. Addln('Var');
  419. IncIndent;
  420. AddLn('_Res : String;');
  421. AddLn('_Path : String;');
  422. DecIndent;
  423. Addln('begin');
  424. IncIndent;
  425. if GLobalService then
  426. AddLn('CheckService;');
  427. FirstIndex:=Ord(Not GlobalService);
  428. // 0 is service
  429. For I:=FirstIndex to PT.Args.Count-1 do
  430. begin
  431. AP:=TPasArgument(PT.Args[i]);
  432. KP:=ConvertTypeToStringExpr(AP.Name,AP.argType.Name);
  433. KP:=''''+TActionFunctionParameter(AP.CustomData).Name+'=''+'+KP; // Do not add spaces !!
  434. if I>FirstIndex then
  435. AddLn('_Path:=_Path+'',''+'+KP+';')
  436. else
  437. AddLn('_Path:='+KP+';');
  438. end;
  439. AddLn('_Path:=''(''+_Path+'')'';');
  440. AddLn('_Path:='''+MethodPath+'''+_Path;');
  441. if Not GlobalService then
  442. AddLn('_Path:=BaseURL(AService)+''/''+_Path;');
  443. end;
  444. procedure TEDMX2PasConverter.EmitFunctionCall(ServiceName, ReturnType: String;
  445. ResultType: TResultType);
  446. Var
  447. P : Integer;
  448. begin
  449. if (ServiceName<>'') then
  450. ServiceName:=ServiceName+'.';
  451. if ResultType=rtSimple then
  452. begin
  453. Addln('_Res:='+ServiceName+'ServiceCall(''GET'',_Path,'''');');
  454. ReturnType:=ConvertTypeToStringExpr('_Res',ReturnType);
  455. Addln('Result:='+ReturnType+';');
  456. end
  457. else
  458. begin
  459. // Somewhat of a shortcut, need to use ExtractBaseTypeName and ResolveType
  460. P:=Pos('array',LowerCase(ReturnType));
  461. if (P<>0) then
  462. Addln('Result:=%s('+ServiceName+'GetMulti(_Path,'''',%s,True,_Res));',[ReturnType,Copy(ReturnType,1,P-1)])
  463. else
  464. Addln('Result:=%s('+ServiceName+'SingleServiceCall(_Path,'''',%s));',[ReturnType,ReturnType])
  465. end;
  466. end;
  467. procedure TEDMX2PasConverter.EmitBoundFunction(CT: TPasClassType;
  468. ASchema: TSchema; Fun: TBoundFunction);
  469. Var
  470. CN,RT : String;
  471. ResultType : TResultType;
  472. begin
  473. RT:=TPasFunctionType(Fun.ProcType).ResultEl.ResultType.Name;
  474. if IsSimpleType(RT) then
  475. ResultType:=rtSimple
  476. else
  477. ResultType:=rtObject;
  478. CN:=CT.Name;
  479. EmitMethodHeader(CN,Fun.Name,Fun.ProcType,RT);
  480. // Does indent
  481. EmitMethodPath(Fun.ProcType,ASchema.NameSpace+'.'+Fun.Name,False);
  482. EmitFunctionCall('AService',RT,ResultType);
  483. Decindent;
  484. AddLn('end;');
  485. AddLn('');
  486. end;
  487. procedure TEDMX2PasConverter.EmitUnBoundFunction(CT: TPasClassType;
  488. Fun: TUnBoundFunction);
  489. Var
  490. CN,RTN : String;
  491. ResultType : TResultType;
  492. begin
  493. RTN:=TPasFunctionType(Fun.ProcType).ResultEl.ResultType.Name;
  494. if IsSimpleType(RTN) then
  495. ResultType:=rtSimple
  496. else
  497. ResultType:=rtObject;
  498. CN:=CT.Name;
  499. EmitMethodHeader(CN,Fun.Name,Fun.ProcType,RTN);
  500. // Does indent
  501. EmitMethodPath(Fun.ProcType,Fun.ExportPath,True);
  502. EmitFunctionCall('Service',RTN,ResultType);
  503. Decindent;
  504. AddLn('end;');
  505. AddLn('');
  506. end;
  507. procedure TEDMX2PasConverter.EmitPreparePostObject(Act: TPasProcedure;
  508. ActionPath: String; GlobalService, AllocateArray: Boolean);
  509. Var
  510. I : Integer;
  511. AP : TPasArgument;
  512. MN,ETN : String;
  513. HaveData : Boolean;
  514. AT : TResultType;
  515. begin
  516. HaveData:= Ord(Not GlobalService) < Act.ProcType.Args.Count;
  517. Addln('Var');
  518. IncIndent;
  519. if HaveData then
  520. AddLn('_JSON : TJSONObject;');
  521. if AllocateArray then
  522. begin
  523. AddLn('_ARR : TJSONArray;');
  524. AddLn('_res : String;');
  525. end;
  526. AddLn('_data : String;');
  527. AddLn('_Path : String;');
  528. DecIndent;
  529. Addln('begin');
  530. IncIndent;
  531. if GLobalService then
  532. AddLn('CheckService;');
  533. if Not HaveData then
  534. AddLn('_data:='''';')
  535. else
  536. begin
  537. AddLn('_JSON:=TJSONObject.Create;');
  538. AddLn('try');
  539. IncIndent;
  540. // 0 is service
  541. For I:=Ord(Not GlobalService) to Act.ProcType.Args.Count-1 do
  542. begin
  543. AP:=TPasArgument(Act.ProcType.Args[i]);
  544. MN:=TActionFunctionParameter(AP.CustomData).Name;
  545. AT:=GetResultType(AP.ArgType.Name,ETN);
  546. Case AT of
  547. rtSimple :
  548. AddLn('_JSON.Add(''%s'',%s);',[MN,AP.Name]);
  549. rtObject :
  550. AddLn('_JSON.Add(''%s'',%s.SaveToJSON);',[MN,AP.Name]);
  551. rtArraySimple:
  552. AddLn('_JSON.Add(''%s'',DynArrayToJSONArray(Pointer(%s),''%s'',Nil));',[MN,AP.Name,ETN]);
  553. rtArrayObject:
  554. AddLn('_JSON.Add(''%s'',DynArrayToJSONArray(Pointer(%s),'''',%s));',[MN,AP.Name,ETN,ETN]);
  555. end;
  556. end;
  557. AddLn('_data:=_JSON.AsJSON;');
  558. DecIndent;
  559. Addln('finally');
  560. IncIndent;
  561. AddLn('FreeAndNil(_JSON);');
  562. DecIndent;
  563. Addln('end;');
  564. end;
  565. if GlobalService then
  566. AddLn('_Path:=''/%s'';',[ActionPath])
  567. else
  568. AddLn('_Path:=BaseURL(AService)+''/%s'';',[ActionPath]);
  569. end;
  570. procedure TEDMX2PasConverter.EmitActionServiceCall(const AReturnType,
  571. AElementType: String; GlobalService: Boolean; ResultType: TResultType);
  572. var
  573. SN,KP : String;
  574. begin
  575. SN:='Service';
  576. If Not GlobalService then
  577. SN:='A'+SN;
  578. Case ResultType of
  579. rtNone:
  580. Addln(SN+'.ServiceCall(''POST'',_Path,'''',_Data);');
  581. rtSimple:
  582. begin
  583. Addln('_Res:='+SN+'.ServiceCall(''POST'',_Path,'''',_Data);');
  584. KP:=ConvertTypeToStringExpr('_Res',AReturnType);
  585. Addln('Result:='+KP+';');
  586. end;
  587. rtArraySimple,
  588. rtArrayObject:
  589. begin
  590. // Delete(AElementType,1,1);
  591. Addln('_Res:='+SN+'.ServiceCall(''POST'',_Path,'''',_Data);');
  592. Addln('_arr:=GetJSON(_res) as TJSONArray;');
  593. Addln('try');
  594. IncIndent;
  595. if ResultType=rtArraySimple then
  596. Addln('Result:=%s(JSONArrayToDynArray(_arr,''%s'',Nil));',[AReturnType,AElementType])
  597. else
  598. Addln('Result:=%s(JSONArrayToDynArray(_arr,'''',%s));',[AReturnType,AElementType]);
  599. DecIndent;
  600. Addln('finally');
  601. IncIndent;
  602. Addln('_arr.Free;');
  603. DecIndent;
  604. Addln('end');
  605. end;
  606. rtObject:
  607. Addln('Result:=%s(%s.SingleServiceCall(''POST'',_Path,'''',_data,%s));',[AReturnType,SN,AReturnType]);
  608. end;
  609. end;
  610. procedure TEDMX2PasConverter.EmitUnBoundAction(CT: TPasClassType; Act: TPasProcedure);
  611. Var
  612. ETN,APath,CN,RTN : String;
  613. ResultType : TResultType;
  614. begin
  615. if Act.ProcType is TPasFunctionType then
  616. RTN:=TPasFunctionType(Act.ProcType).ResultEl.ResultType.Name
  617. else
  618. RTN:='';
  619. ResultType:=GetResultType(RTN,ETN);
  620. CN:=CT.Name;
  621. EmitMethodHeader(CN,Act.Name,Act.ProcType,RTN);
  622. if (Act is TUnboundActionProc) then
  623. APath:=TUnboundActionProc(Act).ExportPath
  624. else
  625. APath:=TUnboundActionFunc(Act).ExportPath;
  626. EmitPreparePostObject(Act,APath,True,ResultType=rtArraySimple);
  627. EmitActionServiceCall(RTN,ETN,True,ResultType);
  628. Decindent;
  629. AddLn('end;');
  630. AddLn('');
  631. end;
  632. procedure TEDMX2PasConverter.EmitBoundAction(CT: TPasClassType;
  633. ASchema: TSchema; Act: TPasProcedure);
  634. Var
  635. AEN,CN,RTN : String;
  636. ResultType : TResultType;
  637. begin
  638. if Act.ProcType is TPasFunctionType then
  639. RTN:=TPasFunctionType(Act.ProcType).ResultEl.ResultType.Name
  640. else
  641. RTN:='';
  642. ResultType:=GetResultType(RTN,AEN);
  643. CN:=CT.Name;
  644. EmitMethodHeader(CN,Act.Name,Act.ProcType,RTN);
  645. EmitPreparePostObject(Act,ASchema.NameSpace+'.'+Act.Name,False,ResultType=rtArraySimple);
  646. EmitActionServiceCall(RTN,AEN,False,ResultType);
  647. Decindent;
  648. AddLn('end;');
  649. AddLn('');
  650. end;
  651. {$endif}
  652. procedure TEDMX2PasConverter.EmitSetStream(const CN: String; G: TSetStream);
  653. Var
  654. S : String;
  655. I : Integer;
  656. begin
  657. EmitMethodHeader(CN,G.Name,G.ProcType,'');
  658. S:='';
  659. For i:=0 to G.ProcType.Args.Count-1 do
  660. begin
  661. If (S<>'') then
  662. S:=S+',';
  663. S:=S+TPasArgument(G.ProcType.Args[i]).Name;
  664. end;
  665. SimpleMethodBody([Format('DoSetStream(%s);',[S])]);
  666. end;
  667. procedure TEDMX2PasConverter.EmitSetArrayLength(CT: TPasClassType;
  668. A: TSetArrayLength);
  669. Var
  670. I : integer;
  671. P : TPasProperty;
  672. begin
  673. Addln('{$IFDEF VER2_6}');
  674. EmitMethodHeader(CT.Name,A.Name,A.ProcType,'');
  675. Addln('begin');
  676. IncIndent;
  677. AddLn('Case aName of');
  678. for I:=0 to CT.Members.Count-1 do
  679. if TObject(CT.Members[i]) is TPasProperty then
  680. begin
  681. P:=TPasProperty(CT.Members[i]);
  682. if (Copy(P.VarType.Name ,Length(P.VarType.Name)-4,5)='Array') then
  683. begin
  684. Addln('''%s'' : SetLength(%s,aLength);',[LowerCase(P.Name),P.ReadAccessorName]);
  685. end;
  686. end;
  687. AddLn('else');
  688. incIndent;
  689. AddLn('inherited SetArrayLength(aName,ALength);');
  690. decIndent;
  691. AddLn('end;');
  692. decIndent;
  693. AddLn('end;');
  694. Addln('{$ENDIF VER2_6}');
  695. AddLn('');
  696. end;
  697. procedure TEDMX2PasConverter.EmitEntityClassFunction(CT: TPasClassType; ASchema: TSchema; CE: TEntityClassFunction);
  698. Var
  699. ES:TEntitySet;
  700. TN : String;
  701. P : TPasType;
  702. begin
  703. TN:=(CE.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
  704. ES:=CE.CustomData as TEntitySet;
  705. AddLn('Class Function %s.%s : %s; ',[CT.Name,CE.Name,TN]);
  706. P:=ResolveType(ASchema,ES.EntityType);
  707. try
  708. SimpleMethodBody([Format('Result:=%s;',[P.Name])]);
  709. finally
  710. P.Release;
  711. end;
  712. end;
  713. procedure TEDMX2PasConverter.EmitPropertySetter(const CN: String;
  714. P: TPropertySetter);
  715. Var
  716. FN: String;
  717. begin
  718. EmitMethodHeader(CN,P.Name,P.ProcType,'');
  719. FN:=FieldPrefix+P.TheProperty.Name;
  720. SimpleMethodBody([Format('If (%s=AValue) then exit;',[FN]),
  721. Format('%s:=AValue;',[FN]),
  722. 'MarkPropertyChanged(AIndex);']);
  723. end;
  724. procedure TEDMX2PasConverter.EmitObjectRestKind(CT: TPasClassType; R : TObjectRestKind);
  725. Var
  726. NN,CN : string;
  727. O : TObject;
  728. begin
  729. CN:=CT.Name;
  730. O:=CT.CustomData;
  731. NN:=GetNativeTypeName(O);
  732. Addln('');
  733. AddLn('Class Function %s.%s : String; ',[CN,R.Name]);
  734. SimpleMethodBody([Format('Result:=%s;',[MakePascalString(NN,True)])]);
  735. end;
  736. procedure TEDMX2PasConverter.EmitGetSingleton(CT: TPasClassType; S: TGetSingleTon);
  737. Var
  738. PN,TN,NN,CN : string;
  739. O : TObject;
  740. begin
  741. CN:=CT.Name;
  742. O:=S.CustomData;
  743. NN:=GetNativeTypeName(O);
  744. TN:=(S.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
  745. Addln('');
  746. AddLn('Function %s.%s : %s; ',[CN,S.Name,TN]);
  747. PN:=MakePascalString(NN,True);
  748. SimpleMethodBody(['CheckService;',
  749. Format('Result:=%s(Service.SingleServiceCall(%s,'''',%s));',[TN,PN,TN]),
  750. Format('Result.BasePath:=%s;',[PN])]);
  751. end;
  752. procedure TEDMX2PasConverter.EmitGetKeyAsURLPart(CT: TPasClassType;
  753. ASchema: TSchema; P: TKeyAsURLPart);
  754. Var
  755. CN,KP : String;
  756. EK : TEntityKeyElement;
  757. I : integer;
  758. EP : TEntityProperty;
  759. T : TPasType;
  760. begin
  761. CN:=CT.Name;
  762. EK:=P.CustomData as TEntityKeyElement;
  763. Addln('');
  764. AddLn('Function %s.KeyAsURLPart : string;',[CN]);
  765. Addln('');
  766. Addln('begin');
  767. IncIndent;
  768. For I:=0 to EK.Length-1 do
  769. begin
  770. EP:=FindProperty(CT,EK[i].Name);
  771. T:=ResolveType(ASchema,EP._Type);
  772. KP:=ConvertTypeToStringExpr(CleanPropertyName(EK[i].Name,ekwNone),T.Name);
  773. T.Release;
  774. if I>0 then
  775. AddLn('Result:=Result+'',''+'+KP+';')
  776. else
  777. AddLn('Result:='+KP+';');
  778. end;
  779. Decindent;
  780. Addln('end;');
  781. Addln('');
  782. end;
  783. procedure TEDMX2PasConverter.EmitExportPropertyName(CT: TPasClassType; E : TExportPropertyName);
  784. Var
  785. PN,CN : String;
  786. P : TPasProperty;
  787. D : TObject;
  788. I : integer;
  789. begin
  790. CN:=CT.Name;
  791. Addln('');
  792. AddLn('Class Function %s.%s(Const AName : String) :String;',[CN,E.Name]);
  793. Addln('');
  794. AddLn('begin');
  795. IncIndent;
  796. AddLn('Case AName of');
  797. for I:=0 to CT.Members.Count-1 do
  798. if TObject(CT.Members[i]).InheritsFrom(TPasProperty) then
  799. begin
  800. P:=TPasProperty(CT.Members[i]);
  801. D:=P.CustomData;
  802. if D is TEntityProperty then
  803. PN:=WTOA(TEntityProperty(D).Name)
  804. else if D is TComplexTypeProperty then
  805. PN:=WTOA(TComplexTypeProperty(D).Name)
  806. else if D=Nil then
  807. Raise EEDMX2PasConverter.CreateFmt('Unrecognized property type for %d %s.%s : NIL',[I,CN,P.Name])
  808. else
  809. Raise EEDMX2PasConverter.CreateFmt('Unrecognized property type for %d %s.%s : NIL',[I,CN,P.Name,D.ClassName]);
  810. if (CompareText(PN,P.Name)<>0) then
  811. AddLn('''%s'' : Result:=''%s'';',[P.Name,PN]);
  812. end;
  813. AddLn('else');
  814. IncIndent;
  815. AddLn('Result:=Inherited ExportPropertyName(AName);');
  816. DecIndent;
  817. AddLn('end;');
  818. DecIndent;
  819. AddLn('end;');
  820. Addln('');
  821. end;
  822. procedure TEDMX2PasConverter.EmitClassImplementation(ID: TIDentifier);
  823. Var
  824. CN : String;
  825. I : Integer;
  826. E : TPasElement;
  827. CT : TPasClassType;
  828. begin
  829. CN:=ID.Element.Name;
  830. DoLog('Generating class implementation for %s',[CN]);
  831. ClassHeader(CN);
  832. CT:=ID.Element as TPasClassType;
  833. for I:=0 to CT.Members.Count-1 do
  834. begin
  835. E:=TPasElement(CT.Members[i]);
  836. If E is TPropertySetter then
  837. EmitPropertySetter(CN,E as TPropertySetter)
  838. else if E is TPropertyGetter then
  839. EmitPropertyGetter(CN,E as TPropertyGetter)
  840. else if E is TCreateContainer then
  841. EmitCreateContainer(CN,E as TCreateContainer)
  842. else if E is TCreateEntitySet then
  843. EmitCreateEntitySet(CN,E as TCreateEntitySet)
  844. else If E is TObjectRestKind then
  845. EmitObjectRestKind(CT,E as TObjectRestKind)
  846. else If E is TGetSingleton then
  847. EmitGetSingleTon(CT,E as TGetSingleton)
  848. else If E is TENtityClassFunction then
  849. EmitEntityClassFunction(CT,ID.Schema,E as TENtityClassFunction)
  850. else If E is TExportPropertyName then
  851. EmitExportPropertyName(CT,E As TExportPropertyName)
  852. else If E is TGetNavigationProperty then
  853. EmitNavigationProperty(CT,E as TGetNavigationProperty)
  854. else If E is TGetContainedSingleton then
  855. EmitGetContainedSingleton(CT,E as TGetContainedSingleton)
  856. else If E is TKeyAsURLPart then
  857. EmitGetKeyAsURLPart(CT,ID.Schema,E as TKeyAsURLPart)
  858. else If E is TGetStream then
  859. EmitGetStream(CN,E as TGetStream)
  860. else If E is TSetStream then
  861. EmitSetStream(CN,E as TSetStream)
  862. else If E is TSetArrayLength then
  863. EmitSetArrayLength(CT,E as TSetArrayLength)
  864. {$IFNDEF USECSDL}
  865. else If E is TUnBoundFunction then
  866. EmitUnBoundFunction(CT,E as TUnBoundFunction)
  867. else If E is TBoundFunction then
  868. EmitBoundFunction(CT,ID.Schema,E as TBoundFunction)
  869. else If (E is TUnBoundActionProc) or (E is TUnBoundActionFunc) then
  870. EmitUnBoundAction(CT,E as TPasProcedure)
  871. else If (E is TBoundActionProc) or (E is TBoundActionFunc) then
  872. EmitBoundAction(CT,ID.Schema,E as TPasProcedure)
  873. {$ENDIF }
  874. else If E is TEntityMethod then
  875. EmitEntityMethod(CT,E As TEntityMethod);
  876. end;
  877. end;
  878. procedure TEDMX2PasConverter.EmitGetContainedSingleton(CT: TPasClassType; E: TGetContainedSingleton);
  879. Var
  880. CN,TN,PN : String;
  881. begin
  882. CN:=CT.Name;
  883. TN:=(E.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
  884. PN:=WTOA((E.CustomData as TNavigationProperty).Name);
  885. EmitMethodHeader(CN,E.Name,E.ProcType,TN);
  886. SimpleMethodBody([Format('Result:=%s(GetContainedSingleTon(AService,''%s'', %s));',[TN,PN,TN])]);
  887. end;
  888. procedure TEDMX2PasConverter.EmitNavigationProperty(CT : TPasClassType; E : TGetNavigationProperty);
  889. Var
  890. CN,TN,PN : String;
  891. begin
  892. CN:=CT.Name;
  893. TN:=(E.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
  894. PN:=WTOA((E.CustomData as TNavigationProperty).Name);
  895. EmitMethodHeader(CN,E.Name,E.ProcType,TN);
  896. SimpleMethodBody([Format('Result:=%s(CreateContainedEntitySet(AService,''%s'', %s));',[TN,PN,TN])]);
  897. end;
  898. procedure TEDMX2PasConverter.EmitEntityMethod(CT : TPasClassType; E : TEntityMethod);
  899. begin
  900. if E is TEntityGet then
  901. EmitEntityGet(CT,E as TEntityGet)
  902. else if E is TEntityList then
  903. EmitEntityList(CT,E as TEntityList);
  904. end;
  905. procedure TEDMX2PasConverter.EmitEntityGet(CT : TPasClassType; E : TEntityGet);
  906. Var
  907. CN,TN,S,SV,AN : String;
  908. I : integer;
  909. Arg : TPasArgument;
  910. begin
  911. CN:=CT.Name;
  912. TN:=(E.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
  913. EmitMethodHeader(CN,E.Name,E.ProcType,TN);
  914. S:='';
  915. For I:=0 to E.ProcType.Args.Count-1 do
  916. begin
  917. Arg:=TPasArgument(E.ProcType.Args[i]);
  918. AN:=Arg.Name;
  919. SV:=AN;
  920. SV:=ConvertTypeToStringExpr(AN,Arg.ArgType.Name);
  921. if (S<>'') then
  922. S:=S+'+'',''+';
  923. S:=S+SV;
  924. end;
  925. if S='' then
  926. S:='''''';
  927. SimpleMethodBody([ Format('Result:=%s(GetSingle(%s));',[TN,S])]);
  928. end;
  929. procedure TEDMX2PasConverter.EmitEntityList(CT: TPasClassType; E: TEntityList);
  930. Var
  931. CN,TN: String;
  932. isListAll : Boolean;
  933. F,NL : String;
  934. begin
  935. isListAll:=E is TEntityListAll;
  936. CN:=CT.Name;
  937. TN:=(E.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
  938. EmitMethodHeader(CN,E.Name,E.ProcType,TN);
  939. if isListAll then
  940. begin
  941. AddLn('var N : String;');
  942. NL:='N';
  943. F:='True';
  944. end
  945. else
  946. begin
  947. NL:='NextLink';
  948. F:='False';
  949. end;
  950. SimpleMethodBody([Format('Result:=%s(GetMulti(AQuery,%s,%s));',[TN,F,NL])]);
  951. end;
  952. procedure TEDMX2PasConverter.EmitForwardDeclaration;
  953. Var
  954. CN : String;
  955. I : Integer;
  956. ID : TIdentifier;
  957. begin
  958. For I:=0 to FIdentifierList.Count-1 do
  959. begin
  960. ID:=FIdentifierList[i] as TIdentifier;
  961. If ID.Element.InheritsFrom(TPasClassType) then
  962. begin
  963. CN:=ID.Element.Name;
  964. AddLn('%s = class;',[CN]);
  965. AddLn('%sArray = Array of %s;',[CN,CN]);
  966. end;
  967. end;
  968. end;
  969. procedure TEDMX2PasConverter.EmitInterface;
  970. begin
  971. Addln('type');
  972. IncIndent;
  973. Comment(' Needed for binary data');
  974. Addln('TByteArray = Array of byte;');
  975. Addln('TInt16Array = Array of SmallInt;');
  976. Comment('');
  977. EmitForwardDeclaration;
  978. Comment('');
  979. EmitEnumTypes;
  980. EmitClassDeclarations;
  981. DecIndent;
  982. end;
  983. class function TEDMX2PasConverter.ODataVersion: TODataVersion;
  984. begin
  985. {$IFDEF USECSDL}
  986. Result:=oDataV2;
  987. {$ELSE}
  988. Result:=ODataV4;
  989. {$ENDIF USECSDL}
  990. end;
  991. procedure TEDMX2PasConverter.EmitEnumTypes;
  992. Var
  993. Id : TIdentifier;
  994. PE : TPasEnumType;
  995. I : integer;
  996. begin
  997. AddLn('');
  998. Comment(' Enumerations');
  999. AddLn('');
  1000. if EnumerationMode=emScoped then
  1001. AddLn('{$SCOPEDENUMS ON}');
  1002. For I:=0 to FIdentifierList.Count-1 do
  1003. begin
  1004. Id:=TIdentifier(FIdentifierList[i]);
  1005. if ID.Element.InheritsFrom(TPasEnumType) then
  1006. begin
  1007. PE:=ID.Element as TPasEnumType;
  1008. AddLn(PE.GetDeclaration(True)+';');
  1009. AddLn(PE.Name+'Array = Array of '+PE.Name+';');
  1010. end;
  1011. end;
  1012. end;
  1013. procedure TEDMX2PasConverter.AnalyseXML;
  1014. Const
  1015. EdmxScopeOld ='http://schemas.microsoft.com/ado/2007/06/edmx';
  1016. DataservicesScopeOld ='http://schemas.microsoft.com/ado/2007/06/edmx';
  1017. EdmxScopeNew ='http://docs.oasis-open.org/odata/ns/edmx';
  1018. DataservicesScopeNew ='http://docs.oasis-open.org/odata/ns/edm';
  1019. Var
  1020. F : IXMLFormatter;
  1021. Count : Integer;
  1022. i : Integer;
  1023. ScopeName :String;
  1024. ASchema : TSchema;
  1025. EdmxScope,
  1026. DataservicesScope: String;
  1027. begin
  1028. F:=TXmlFormatter.Create();
  1029. f.LoadFromStream(FXml);
  1030. f.PrepareForRead();
  1031. if ODataVersion=ODataV2 then
  1032. begin
  1033. EdmxScope:=EdmxScopeOld;
  1034. DataservicesScope:=DataservicesScopeOld;
  1035. end
  1036. else
  1037. begin
  1038. EdmxScope:=EdmxScopeNew;
  1039. DataservicesScope:=DataservicesScopeNew;
  1040. end;
  1041. if (f.BeginScopeRead('Edmx',EdmxScope) <= 0) then
  1042. Raise EEDMX2PasConverter.Create('Not a valid Edmx XML document');
  1043. Count:=f.BeginScopeRead('DataServices',EdmxScope );
  1044. if Count<=0 then
  1045. Raise EEDMX2PasConverter.Create('No DataServices found');
  1046. ScopeName:=DataservicesScope;
  1047. Count:=f.BeginArrayRead(ScopeName,TypeInfo(Schema),asEmbeded,'Schema');
  1048. if Count<=0 then
  1049. Raise EEDMX2PasConverter.Create('No schema found');
  1050. for i := 0 to Count-1 do
  1051. begin
  1052. ASchema:=TSchema.Create();
  1053. FSchemaList.Add(ASchema);
  1054. end;
  1055. for i := 0 to Count-1 do
  1056. begin
  1057. ASchema:=TSchema(FSchemaList[i]);
  1058. if Not f.Get(TypeInfo(TSchema),ScopeName,ASchema) then
  1059. Raise EEDMX2PasConverter.CreateFmt('Schema[%d] not found',[i]);
  1060. DoLog('Found schema : %s',[ASchema.Namespace]);
  1061. end;
  1062. end;
  1063. function TEDMX2PasConverter.GetNameSpace(ASchema: TSchema): String;
  1064. begin
  1065. Result:=WTOA(Aschema.Namespace);
  1066. If Aliases.IndexOfName(Result)<>-1 then
  1067. Result:=Aliases.Values[Result];
  1068. end;
  1069. function TEDMX2PasConverter.CreateIdentifierName(ASchema: TSchema;
  1070. const APrefix, AName: String): String;
  1071. Var
  1072. N : String;
  1073. begin
  1074. Result:='T'+APrefix+ServiceSuffix+CleanPropertyName(AName,ekwNone);
  1075. N:=LowerCase(GetNameSpace(ASchema)+'.'+AName);
  1076. IdentifierMap.Add(N+'='+Result);
  1077. // Add array as wel, for collection.
  1078. IdentifierMap.Add('collection('+N+')='+Result+'Array');
  1079. end;
  1080. function TEDMX2PasConverter.CreateIdentifierName(ASchema: TSchema;
  1081. const APrefix, AName: UnicodeString): String;
  1082. begin
  1083. Result:=CreateIdentifierName(ASchema,WTOA(APrefix),WTOA(AName));
  1084. end;
  1085. function TEDMX2PasConverter.CreateIdentifierName(ASchema: TSchema;
  1086. const APrefix: String; AName: UnicodeString): String;
  1087. begin
  1088. Result:=CreateIdentifierName(ASchema,APrefix,WTOA(AName));
  1089. end;
  1090. function TEDMX2PasConverter.NeedWriteSetter(P: TComplexTypeProperty): Boolean;
  1091. begin
  1092. Result:=(P<>Nil)
  1093. end;
  1094. function TEDMX2PasConverter.ResolveNameSpace(ASchema: TSchema; ATypeName: String
  1095. ): String;
  1096. Const
  1097. SCollection = 'Collection(';
  1098. LCollection = Length(SCollection);
  1099. Var
  1100. NS : String;
  1101. IsColl : Boolean;
  1102. L : Integer;
  1103. begin
  1104. Result:=ATypeName;
  1105. NS:=GetNameSpace(Aschema);
  1106. if NS=ASchema.Namespace then
  1107. exit;
  1108. IsColl:=Copy(Result,1,LCollection)=SCollection;
  1109. if IsColl then
  1110. Delete(Result,1,LCollection);
  1111. L:=Length(ASchema.Namespace);
  1112. if (Copy(Result,1,L)=ASchema.Namespace) then
  1113. begin
  1114. Delete(Result,1,L);
  1115. Result:=NS+Result;
  1116. end;
  1117. if isColl then
  1118. Result:=SCollection+Result;
  1119. end;
  1120. function TEDMX2PasConverter.ResolveType(ASchema: TSchema;
  1121. const ATypeName: String): TPasType;
  1122. Var
  1123. CN,RN : String;
  1124. begin
  1125. CN:=IdentifierMap.Values[LowerCase(ATypeName)];
  1126. if (CN='') then
  1127. begin
  1128. RN:=ResolveNameSpace(ASchema,ATypeName);
  1129. if RN<>ATypeName then
  1130. CN:=IdentifierMap.Values[LowerCase(RN)]
  1131. else
  1132. begin
  1133. RN:=GetNameSpace(ASchema)+'.'+ATypeName;
  1134. CN:=IdentifierMap.Values[LowerCase(RN)];
  1135. end;
  1136. end;
  1137. if (CN='') then
  1138. Raise EEDMX2PasConverter.CreateFmt('Could not resolve Type %s (Schema: %s)',[ATypeName,ASchema.NameSpace]);
  1139. Result:=TPasUnresolvedSymbolRef.Create(CN,Nil);
  1140. end;
  1141. function TEDMX2PasConverter.ResolveType(ASchema: TSchema;
  1142. const ATypeName: UnicodeString): TPasType;
  1143. begin
  1144. Result:=ResolveType(ASchema,WTOA(ATypeName));
  1145. end;
  1146. function TEDMX2PasConverter.CreatePropertyGetter(AParent: TPasElement;
  1147. PN: String; indexed: Boolean; T: TPasType): TPropertyGetter;
  1148. Var
  1149. PA : TPasArgument;
  1150. GN : String;
  1151. F : TPasFunctionType;
  1152. begin
  1153. GN:='Get'+PN;
  1154. Result:=TPropertyGetter.Create(GN,AParent);
  1155. Result.Visibility:=visPrivate;
  1156. F:=TPasFunctionType.Create('',Result);
  1157. Result.ProcType:=F;
  1158. if Indexed then
  1159. begin
  1160. // AIndex
  1161. PA:=TPasArgument.Create('AIndex',Result.ProcType);
  1162. PA.ArgType:=TPasUnresolvedTypeRef.Create('Integer',PA);
  1163. Result.ProcType.Args.Add(PA);
  1164. end;
  1165. // Result
  1166. F.ResultEl:=TPasResultElement.Create('Result',F);
  1167. F.ResultEl.ResultType:=T;
  1168. end;
  1169. function TEDMX2PasConverter.CreatePropertySetter(AParent: TPasElement;
  1170. PN: String; indexed: Boolean; T: TPasType): TPropertySetter;
  1171. Var
  1172. PA : TPasArgument;
  1173. SN : String;
  1174. begin
  1175. SN:='Set'+PN;
  1176. Result:=TPropertySetter.Create(SN,AParent);
  1177. Result.Visibility:=visPrivate;
  1178. Result.ProcType:=TPasProcedureType.Create('',Result);
  1179. if Indexed then
  1180. begin
  1181. // AIndex
  1182. PA:=TPasArgument.Create('AIndex',Result.ProcType);
  1183. PA.ArgType:=TPasUnresolvedTypeRef.Create('Integer',PA);
  1184. Result.ProcType.Args.Add(PA);
  1185. end;
  1186. // Actual argument
  1187. PA:=TPasArgument.Create('AValue',Result.ProcType);
  1188. PA.ArgType:=T;
  1189. PA.Access:=argConst;
  1190. Result.ProcType.Args.Add(PA);
  1191. end;
  1192. function TEDMX2PasConverter.UseExtraIdentifierProtection(D: TObject
  1193. ): TExtraKeywords;
  1194. begin
  1195. result:=ekwNone;
  1196. if Assigned(D) then
  1197. begin
  1198. if D is EntityContainer then
  1199. result:=ekwEntityContainer;
  1200. if D is TEntitySet then
  1201. Result:=ekwEntitySet
  1202. else if D is TEntityType then
  1203. Result:=ekwEntity
  1204. else if D is TComplexType then
  1205. Result:=ekwObject
  1206. end;
  1207. end;
  1208. function TEDMX2PasConverter.AddProperty(ID: TIdentifier;
  1209. APropertyIndex: integer; const APropertyName, APropertyType: String;
  1210. Flags: TPropertyFlags; ACustomData: TObject): Boolean;
  1211. Var
  1212. PP : TPasProperty;
  1213. PS : TPropertySetter;
  1214. PG : TPropertyGetter;
  1215. PV : TPasVariable;
  1216. GN,SN,PN : String;
  1217. T : TPasType;
  1218. C : TPasClassType;
  1219. begin
  1220. DoLog('Adding property [%d] %s : %s',[APropertyIndex,APropertyName,APropertyType]);
  1221. C:=ID.Element as TPasClassType;
  1222. // Construct property.
  1223. PN:=CleanPropertyName(APropertyName,UseExtraIdentifierProtection(C.CustomData));
  1224. Result:=CompareText(PN,APropertyName)<>0;
  1225. PG:=NIl;
  1226. PS:=Nil;
  1227. // Field
  1228. PV:=TPasVariable.Create(FieldPrefix+PN,C);
  1229. T:=ResolveType(ID.Schema,APropertyType);
  1230. PS:=Nil;
  1231. PV.VarType:=T;
  1232. PV.Visibility:=visPrivate;
  1233. C.Members.Add(PV);
  1234. // Getter, if needed
  1235. if Not (pfNeedGetter in Flags) then
  1236. GN:=FieldPRefix+PN
  1237. else
  1238. begin
  1239. T.AddRef;
  1240. PG:=CreatePropertyGetter(C,PN,pfIndexed in flags,T);
  1241. C.Members.Add(PG);
  1242. GN:=PG.Name;
  1243. end;
  1244. if not (pfReadOnly in Flags) then
  1245. begin
  1246. if Not (pfNeedSetter in Flags) then // Setter, if needed
  1247. SN:=FieldPRefix+PN
  1248. else
  1249. begin
  1250. T.AddRef;
  1251. PS:=CreatePropertySetter(C,PN,pfIndexed in flags,T);
  1252. C.Members.Add(PS);
  1253. SN:=PS.Name;
  1254. end;
  1255. end;
  1256. // And finally, the actual property
  1257. PP:=TPasProperty.Create(PN,C);
  1258. PP.CustomData:=ACustomData;
  1259. PP.ReadAccessorName:=GN;
  1260. PP.WriteAccessorName:=SN;
  1261. PP.Visibility:=visPublished;
  1262. PP.VarType:=T;
  1263. If (pfindexed in Flags) then
  1264. begin
  1265. PP.IndexExpr:=TPrimitiveExpr.Create(PP,pekNumber,eopNone);
  1266. TPrimitiveExpr(PP.IndexExpr).Value:=IntToStr(APropertyIndex shl IndexShift);
  1267. end;
  1268. if Assigned(PS) then
  1269. PS.TheProperty:=PP;
  1270. if Assigned(PG) then
  1271. PG.TheProperty:=PP;
  1272. T.AddRef;
  1273. C.Members.Add(PP);
  1274. end;
  1275. procedure TEDMX2PasConverter.AddExportPropertyName(ID: TIdentifier);
  1276. Var
  1277. PC : TPasClassType;
  1278. E : TExportPropertyName;
  1279. F : TPasFunctionType;
  1280. PA : TPasArgument;
  1281. begin
  1282. // Class Function ExportPropertyName(Const AName : String) : string; virtual;
  1283. PC:=ID.Element as TPasClassType;
  1284. E:=TExportPropertyName.Create('ExportPropertyName',PC);
  1285. E.Modifiers:=[pmOverride];
  1286. E.Visibility:=visPublic;
  1287. F:=TPasFunctionType.Create('ExportPropertyName',E);
  1288. E.ProcType:=F;
  1289. // Actual argument
  1290. PA:=TPasArgument.Create('AName',F);
  1291. PA.ArgType:=TPasUnresolvedTypeRef.Create('String',PA);
  1292. PA.Access:=argConst;
  1293. F.Args.Add(PA);
  1294. F.ResultEl:=TPasResultElement.Create('Result',F);
  1295. F.ResultEl.ResultType:=TPasUnresolvedTypeRef.Create('String',F.ResultEl);
  1296. PC.Members.Add(E);
  1297. end;
  1298. procedure TEDMX2PasConverter.CompleteComplexType(ID: TIdentifier);
  1299. Var
  1300. P : TComplexTypeProperty;
  1301. I : Integer;
  1302. C : TPasClassType;
  1303. CT : TComplexType;
  1304. Flags : TPropertyFlags;
  1305. isArray,HaveArray,B : Boolean;
  1306. PropertyIndexOffset : Integer;
  1307. PE : TPasType;
  1308. {$IFNDEF USECSDL }
  1309. PID : TIdentifier;
  1310. {$ENDIF}
  1311. begin
  1312. B:=False;
  1313. C:=ID.Element as TPasClassType;
  1314. CT:=ID.Element.CustomData as TComplexType;
  1315. {$IFNDEF USECSDL }
  1316. if (CT.BaseType<>'') then
  1317. begin
  1318. PID:=FindIdentifier(Nil,CT.BaseType);
  1319. if PID=NIl then
  1320. Raise EEDMX2PasConverter.CreateFmt('Could not resolve parent type for entity type %s',[CT.Name]);
  1321. PE:=PID.Element as TPasClassType;
  1322. PropertyIndexOffset:=CountProperties(PE as TPasClassType);
  1323. PE.AddRef;
  1324. end
  1325. else
  1326. {$ENDIF}
  1327. begin
  1328. PE:=TPasUnresolvedTypeRef.Create(BaseEntityType,Nil);
  1329. PropertyIndexOffset:=0;
  1330. end;
  1331. HaveArray:=False;
  1332. C.AncestorType:=PE;
  1333. B:=False;
  1334. For I:=0 to CT._Property.Length-1 do
  1335. begin
  1336. P:=CT._Property[i];
  1337. Flags:=[pfNeedSetter,pfIndexed];
  1338. if not P.Nullable then
  1339. Include(Flags,pfRequired);
  1340. if P._Type='' then
  1341. Raise EEDMX2PasConverter.CreateFmt('Identity type %s: No type for property: %s',[CT.Name,P.Name]);
  1342. // Construct property.
  1343. ExtractBaseTypeName(ID.Schema,P._Type,isArray);
  1344. haveArray:=haveArray or isArray;
  1345. B:=AddProperty(ID,PropertyIndexOffset+I,WTOA(P.Name),WTOA(P._Type),Flags,P) or B;
  1346. end;
  1347. if haveArray then
  1348. AddSetArrayLength(ID);
  1349. If B then
  1350. AddExportPropertyName(ID);
  1351. end;
  1352. procedure TEDMX2PasConverter.CompleteEntityType(ID: TIdentifier);
  1353. Var
  1354. P : TEntityProperty;
  1355. I,J : Integer;
  1356. C : TPasClassType;
  1357. CT : TEntityType;
  1358. Flags : TPropertyFlags;
  1359. PID : TIdentifier;
  1360. PE : TPasType;
  1361. PropertyIndexOffset : Integer;
  1362. Key : TEntityKeyElement;
  1363. B,isArray,HaveArray : Boolean;
  1364. begin
  1365. C:=ID.Element as TPasClassType;
  1366. CT:=ID.Element.CustomData as TEntityType;
  1367. if (CT.BaseType='') then
  1368. begin
  1369. PE:=TPasUnresolvedTypeRef.Create(BaseEntityType,Nil);
  1370. PropertyIndexOffset:=0;
  1371. end
  1372. else
  1373. begin
  1374. PID:=FindIdentifier(Nil,CT.BaseType);
  1375. if PID=NIl then
  1376. Raise EEDMX2PasConverter.CreateFmt('Could not resolve parent type for entity type %s',[CT.Name]);
  1377. PE:=PID.Element as TPasClassType;
  1378. PropertyIndexOffset:=CountProperties(PE as TPasClassType);
  1379. PE.AddRef;
  1380. end;
  1381. HaveArray:=False;
  1382. C.AncestorType:=PE;
  1383. B:=False;
  1384. For I:=0 to CT._Property.Length-1 do
  1385. begin
  1386. P:=CT._Property[i];
  1387. if (PE is TPasClassType) then
  1388. if FindProperty(PE as TPasClassType,P.Name)<>Nil then
  1389. continue;
  1390. Flags:=[pfIndexed,pfNeedSetter];
  1391. if not P.Nullable then
  1392. Include(Flags,pfRequired);
  1393. {$IFDEF USECSDL}
  1394. if Assigned(CT.Key) then
  1395. for J:=0 to CT.Key.Length-1 do
  1396. if (CT.Key.Item[J].Name=P.Name) then
  1397. Include(Flags,pfInKey);
  1398. {$ELSE}
  1399. if Assigned(CT.Key) and (CT.Key.Length=1) then
  1400. for J:=0 to CT.Key.Item[0].Length-1 do
  1401. if (CT.Key.Item[0].Item[J].Name=P.Name) then
  1402. Include(Flags,pfInKey);
  1403. {$ENDIF}
  1404. // Construct property.
  1405. if P._Type='' then
  1406. Raise EEDMX2PasConverter.CreateFmt('Identity type %s: No type for property: %s',[CT.Name,P.Name]);
  1407. ExtractBaseTypeName(ID.Schema,P._Type,isArray);
  1408. haveArray:=haveArray or isArray;
  1409. B:=AddProperty(ID,PropertyIndexOffset+I,WTOA(P.Name),WTOA(P._Type),Flags,P) or B;
  1410. end;
  1411. if haveArray then
  1412. AddSetArrayLength(ID);
  1413. if B then
  1414. AddExportPropertyName(ID);
  1415. Key:=Nil;
  1416. if Assigned(CT.Key) then
  1417. {$IFDEF USECSDL}
  1418. if (CT.Key.Length>0) then
  1419. Key:=CT.Key;
  1420. {$ELSE}
  1421. if (CT.Key.Length=1) then
  1422. if (CT.Key.Item[0].Length>0) then
  1423. Key:=CT.Key.Item[0];
  1424. {$ENDIF}
  1425. if Assigned(Key) then
  1426. AddGetKeyAsURLPart(ID,Key);
  1427. For I:=0 to CT.NavigationProperty.Length-1 do
  1428. AddNavigationproperty(ID,CT.NavigationProperty[i]);
  1429. {$IFNDEF USECSDL}
  1430. if CT.HasStream then
  1431. begin
  1432. AddGetStream(ID);
  1433. AddSetStream(ID);
  1434. end;
  1435. {$ENDIF}
  1436. end;
  1437. function TEDMX2PasConverter.AddGetStream(ID: TIDentifier): TGetStream;
  1438. Var
  1439. C : TPasClassType;
  1440. F : TPasProcedureType;
  1441. A : TPasArgument;
  1442. begin
  1443. C:=ID.Element as TPasClassType;
  1444. Result:=TGetStream.Create('GetStream',C);
  1445. C.Members.Add(Result);
  1446. F:=TPasProcedureType.Create('GetStream',Result);
  1447. Result.ProcType:=F;
  1448. Result.Visibility:=visPublic;
  1449. // Service argument
  1450. A:=TPasArgument.Create('AService',F);
  1451. A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
  1452. F.Args.Add(A);
  1453. // ContentType argument
  1454. A:=TPasArgument.Create('AContentType',F);
  1455. A.ArgType:=TPasUnresolvedTypeRef.Create('String',A);
  1456. F.Args.Add(A);
  1457. // Stream into which to copy the data.
  1458. A:=TPasArgument.Create('AStream',F);
  1459. A.ArgType:=TPasUnresolvedTypeRef.Create('TStream',A);
  1460. F.Args.Add(A);
  1461. end;
  1462. function TEDMX2PasConverter.AddSetStream(ID: TIDentifier): TSetStream;
  1463. Var
  1464. C : TPasClassType;
  1465. F : TPasProcedureType;
  1466. A : TPasArgument;
  1467. begin
  1468. C:=ID.Element as TPasClassType;
  1469. Result:=TSetStream.Create('SetStream',C);
  1470. C.Members.Add(Result);
  1471. F:=TPasProcedureType.Create('SetStream',Result);
  1472. Result.ProcType:=F;
  1473. Result.Visibility:=visPublic;
  1474. // Service argument
  1475. A:=TPasArgument.Create('AService',F);
  1476. A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
  1477. F.Args.Add(A);
  1478. // ContentType argument
  1479. A:=TPasArgument.Create('AContentType',F);
  1480. A.ArgType:=TPasUnresolvedTypeRef.Create('String',A);
  1481. F.Args.Add(A);
  1482. // Stream into which to copy the data.
  1483. A:=TPasArgument.Create('AStream',F);
  1484. A.ArgType:=TPasUnresolvedTypeRef.Create('TStream',A);
  1485. F.Args.Add(A);
  1486. end;
  1487. function TEDMX2PasConverter.AddGetKeyAsURLPart(ID: TIdentifier;
  1488. Key: TEntityKeyElement): TPasFunction;
  1489. Var
  1490. C : TPasClassType;
  1491. F : TPasFunctionType;
  1492. begin
  1493. C:=ID.Element as TPasClassType;
  1494. Result:=TKeyAsURLPart.Create('KeyAsURLPart',C);
  1495. Result.Visibility:=visPublic;
  1496. Result.CustomData:=Key;
  1497. F:=TPasFunctionType.Create('KeyAsURLPart',Result);
  1498. Result.ProcType:=F;
  1499. Result.Modifiers:=[pmOverride];
  1500. // Result type
  1501. F.ResultEl:=TPasResultElement.Create('Result',F);
  1502. F.ResultEl.ResultType:=TPasUnresolvedTypeRef.Create('String',F.ResultEl);
  1503. C.Members.Add(Result);
  1504. end;
  1505. {$IFDEF USECSDL}
  1506. Function TEDMX2PasConverter.FindAssociatedTypeInSchema(ASchema : TSchema; Const ARelation,ARole : String) : String;
  1507. Var
  1508. I,J : integer;
  1509. A : TAssociation;
  1510. begin
  1511. Result:='';
  1512. I:=ASchema.Association.Length-1;
  1513. While (Result='') and (I>=0) do
  1514. begin
  1515. A:=ASchema.Association[i];
  1516. If (ASchema.NameSpace+'.'+A.Name=ARelation) then
  1517. begin
  1518. J:=A._End.Length-1;
  1519. While (Result='') and (J>=0) do
  1520. begin
  1521. If A._End[j].Role=ARole then
  1522. Result:=WTOA(A._End[j]._Type);
  1523. Dec(J);
  1524. end;
  1525. end;
  1526. Dec(I);
  1527. end;
  1528. end;
  1529. Function TEDMX2PasConverter.FindAssociatedType(Var APreferredSchema : TSchema; Const ARelation,ARole : String) : String;
  1530. Var
  1531. i : Integer;
  1532. S : TSchema;
  1533. begin
  1534. Result:=FindAssociatedTypeInSchema(APreferredSchema,ARelation,ARole);
  1535. if (Result='') then
  1536. begin
  1537. I:=0;
  1538. While (Result='') and (I<FSchemaList.Count) do
  1539. begin
  1540. S:=TSchema(FSchemaList[i]);
  1541. if S<>APreferredSchema then
  1542. begin
  1543. Result:=FindAssociatedTypeInSchema(S,ARelation,ARole);
  1544. If Result<>'' then
  1545. APreferredSchema:=S;
  1546. end;
  1547. Inc(I);
  1548. end;
  1549. end;
  1550. If (Result='') then
  1551. Raise EEDMX2PasConverter.CreateFmt('Could not determine type of relation "%s", role "%s"',[ARelation,ARole]);
  1552. end;
  1553. {$ENDIF}
  1554. function TEDMX2PasConverter.AddNavigationProperty(ID: TIDentifier;
  1555. P: TNavigationProperty): TPasFunction;
  1556. Var
  1557. C : TPasClassType;
  1558. F : TPasFunctionType;
  1559. A : TPasArgument;
  1560. ResType : TPasType;
  1561. ATS : TSchema;
  1562. BTN,TN,NP : String;
  1563. ESI : TIDentifier;
  1564. IsColl : Boolean;
  1565. begin
  1566. C:=ID.Element as TPasClassType;
  1567. NP:=CleanPropertyName(P.Name,UseExtraIdentifierProtection(C.CustomData));
  1568. ATS:=ID.Schema; // Schema of associated type
  1569. {$IFNDEF USECSDL}
  1570. TN:=WTOA(P._Type);
  1571. ATS:=ID.Schema;
  1572. {$ELSE}
  1573. TN:=FindAssociatedType(ATS,WTOA(P.Relationship),WTOA(P.ToRole));
  1574. {$ENDIF}
  1575. BTN:=ExtractBaseTypeName(ID.Schema,TN,isColl);
  1576. if Not IsColl then
  1577. begin
  1578. DoLog('Adding singleton navigation property %s (%s) : %s',[P.Name,NP,BTN]);
  1579. Result:=TGetContainedSingleton.Create(NP,C);
  1580. ResType:=ResolveType(ID.Schema,BTN);
  1581. end
  1582. else
  1583. begin
  1584. ESI:=FindEntitySetForEntity(ID.Schema,BTN);
  1585. if (ESI = Nil) then
  1586. Raise EEDMX2PasConverter.CreateFmt('Could not find navigation property %s : %s entity set.',[P.Name,TN]);
  1587. DoLog('Adding navigation property %s (%s) : %s',[P.Name,NP,ESI.Element.Name]);
  1588. Result:=TGetNavigationProperty.Create(NP,C);
  1589. ResType:=ESI.Element as TPasClassType;
  1590. ResType.AddRef;
  1591. end;
  1592. Result.Visibility:=visPublic;
  1593. Result.CustomData:=P;
  1594. F:=TPasFunctionType.Create(NP,Result);
  1595. Result.ProcType:=F;
  1596. // Service argument
  1597. A:=TPasArgument.Create('AService',F);
  1598. A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
  1599. F.Args.Add(A);
  1600. // Result type
  1601. F.ResultEl:=TPasResultElement.Create('Result',F);
  1602. F.ResultEl.ResultType:=ResType;
  1603. C.Members.Add(Result);
  1604. end;
  1605. function TEDMX2PasConverter.FindEntitySetForEntity(ASchema: TSchema;
  1606. AName: String): TIdentifier;
  1607. Var
  1608. I,C : Integer;
  1609. S : String;
  1610. ES : TEntitySet;
  1611. begin
  1612. if Pos('.',AName)<>0 then
  1613. S:=AName
  1614. else if Assigned(ASchema) then
  1615. S:=WTOA(ASchema.Namespace)+'.'+AName
  1616. else
  1617. S:=AName;
  1618. I:=0;
  1619. C:=FIdentifierList.Count;
  1620. Result:=Nil;
  1621. While (I<C) and (Result=Nil) do
  1622. begin
  1623. Result:=TIdentifier(FIdentifierList[i]);
  1624. if Not (Result.Element.CustomData is TEntitySet) then
  1625. Result:=Nil
  1626. else
  1627. begin
  1628. ES:=Result.Element.CustomData as TEntitySet;
  1629. // Writeln('Comparing ',TIdentifier(FIdentifierList[i]).IdentifierName,'=',S,' ?');
  1630. If CompareText(WTOA(ES.EntityType),S)<>0 then
  1631. Result:=Nil;
  1632. end;
  1633. Inc(I);
  1634. end;
  1635. end;
  1636. function TEDMX2PasConverter.FindQualifiedIdentifier(AName: String): TIdentifier;
  1637. begin
  1638. Result:=Nil;
  1639. Result:=TIdentifier(FIdentifierHash.Items[LowerCase(AName)]);
  1640. end;
  1641. function TEDMX2PasConverter.FindIdentifier(ASchema: TSchema; AName: String
  1642. ): TIdentifier;
  1643. Var
  1644. I : Integer;
  1645. S : String;
  1646. begin
  1647. Result:=Nil;
  1648. I:=0;
  1649. if Pos('.',AName)<>0 then
  1650. Result:=FindQualifiedIdentifier(AName);
  1651. if Not Assigned(ASchema) then
  1652. begin
  1653. While (Result=Nil) and (I<FSchemaList.Count) do
  1654. begin
  1655. Result:=FindIdentifier(TSchema(FSchemaList[i]),AName);
  1656. Inc(i);
  1657. end;
  1658. Exit;
  1659. end;
  1660. // Writeln('Searching namespace : ',ASchema.NameSpace,' for ',AName);
  1661. S:=WTOA(ASchema.Namespace)+'.'+AName;
  1662. Result:=FindQualifiedIdentifier(S);
  1663. end;
  1664. function TEDMX2PasConverter.FindIdentifier(ASchema: TSchema;
  1665. AName: UnicodeString): TIdentifier;
  1666. begin
  1667. Result:=FindIdentifier(ASchema,WTOA(AName));
  1668. end;
  1669. function TEDMX2PasConverter.FindProperty(C: TPasClassType; APropertyName: String
  1670. ): TEntityProperty;
  1671. Var
  1672. I : Integer;
  1673. ET : TEntityType;
  1674. begin
  1675. Result:=Nil;
  1676. Repeat
  1677. ET:=C.CustomData as TEntityType;
  1678. I:=ET._Property.Length-1;
  1679. While (I>=0) and (Result=Nil) do
  1680. begin
  1681. if CompareText(WTOA(ET._Property[i].Name),APropertyName)=0 then
  1682. Result:=ET._Property[i];
  1683. Dec(i);
  1684. end;
  1685. if C.AncestorType is TPasClassType then
  1686. C:=C.AncestorType as TPasClassType
  1687. else
  1688. C:=Nil;
  1689. until (Result<>Nil) or (C=nil);
  1690. end;
  1691. function TEDMX2PasConverter.FindProperty(C: TPasClassType;
  1692. APropertyName: UnicodeString): TEntityProperty;
  1693. begin
  1694. Result:=FindProperty(C,WTOA(APropertyName));
  1695. end;
  1696. function TEDMX2PasConverter.GetEntityKey(C: TPasClassType
  1697. ): TEntityType_KeyArray;
  1698. Var
  1699. ET : TEntityType;
  1700. begin
  1701. Result:=Nil;
  1702. Repeat
  1703. // Writeln('Finding key of ',C.Name,' (',C.CustomData.ClassName,')');
  1704. ET:=C.CustomData as TEntityType;
  1705. Result:=ET.Key;
  1706. if Result.Length=0 then
  1707. Result:=Nil;
  1708. if C.AncestorType is TPasClassType then
  1709. C:=C.AncestorType as TPasClassType
  1710. else
  1711. C:=Nil;
  1712. until (Result<>Nil) or (C=Nil);
  1713. end;
  1714. procedure TEDMX2PasConverter.AddEntityGet(ID, EID: TIdentifier);
  1715. Var
  1716. FN : String;
  1717. F : TPasFunctionType;
  1718. C : TPasClassType;
  1719. EM : TEntityMethod;
  1720. ES : TEntitySet;
  1721. PA : TPasArgument;
  1722. I : Integer;
  1723. AN : String;
  1724. EP : TEntityProperty;
  1725. AKey : TEntityType_KeyArray;
  1726. begin
  1727. C:=ID.Element as TPasClassType;
  1728. ES:=C.CustomData as TEntitySet;
  1729. // Get function
  1730. FN:='Get';
  1731. EM:=TEntityGet.Create(FN,C);
  1732. EM.CustomData:=ES;
  1733. EM.Visibility:=visPublic;
  1734. F:=TPasFunctionType.Create(FN,EM);
  1735. // Construct arguments based on key, if available
  1736. AKey:=GetEntityKey(EID.Element as TPasClassType);
  1737. if Assigned(AKey) then
  1738. begin
  1739. for I:=0 to AKey.Length-1 do
  1740. begin
  1741. {$IFDEF USECSDL}
  1742. AN:=WTOA(AKey.Item[I].Name);
  1743. {$ELSE}
  1744. if AKey.Item[i].Length>0 then
  1745. AN:=WTOA(AKey.Item[I].Item[0].Name)
  1746. else
  1747. Raise EEDMX2PasConverter.CreateFmt('Empty key definition for %s type of entityset %s',[ES.EntityType,ES.Name]);
  1748. {$ENDIF}
  1749. PA:=TPasArgument.Create(CleanPropertyName(AN,ekwEntitySet),F);
  1750. EP:=FindProperty(EID.Element as TPasClassType,AN);
  1751. if Assigned(EP) then
  1752. PA.ArgType:=ResolveType(ID.Schema,EP._Type)
  1753. else
  1754. PA.ArgType:=TPasUnresolvedTypeRef.Create('String',PA);
  1755. PA.Access:=argConst;
  1756. {$IFDEF USECSDL}
  1757. PA.CustomData:=AKey.Item[I];
  1758. {$ELSE}
  1759. PA.CustomData:=AKey.Item[I].Item[0];
  1760. {$ENDIF}
  1761. F.Args.Add(PA);
  1762. end;
  1763. end
  1764. else
  1765. begin
  1766. // Fake string argument
  1767. PA:=TPasArgument.Create('AKey',F);
  1768. PA.ArgType:=TPasUnresolvedTypeRef.Create('String',PA);
  1769. PA.Access:=argConst;
  1770. F.Args.Add(PA);
  1771. end;
  1772. EM.ProcType:=F;
  1773. F.ResultEl:=TPasResultElement.Create('Result',F);
  1774. F.ResultEl.ResultType:=ResolveType(ID.Schema,ES.EntityType);
  1775. C.Members.Add(EM);
  1776. end;
  1777. procedure TEDMX2PasConverter.AddEntityList(ID: TIdentifier;
  1778. ArgType: String; ListAll: Boolean);
  1779. Var
  1780. FN : String;
  1781. F : TPasFunctionType;
  1782. C : TPasClassType;
  1783. EM : TEntityMethod;
  1784. ES : TEntitySet;
  1785. PA : TPasArgument;
  1786. begin
  1787. C:=ID.Element as TPasClassType;
  1788. ES:=C.CustomData as TEntitySet;
  1789. // List function, string version
  1790. if ListAll then
  1791. begin
  1792. FN:='ListAll';
  1793. EM:=TEntityListAll.Create(FN,C);
  1794. end
  1795. else
  1796. begin
  1797. FN:='List';
  1798. EM:=TEntityList.Create(FN,C);
  1799. end;
  1800. EM.CustomData:=ES;
  1801. EM.Visibility:=visPublic;
  1802. F:=TPasFunctionType.Create(FN,EM);
  1803. // Query argument (String or TQueryParam)
  1804. PA:=TPasArgument.Create('AQuery',F);
  1805. PA.ArgType:=TPasUnresolvedTypeRef.Create(ArgType,PA);
  1806. PA.Access:=argConst;
  1807. F.Args.Add(PA);
  1808. if not ListAll then
  1809. begin
  1810. PA:=TPasArgument.Create('NextLink',F);
  1811. PA.ArgType:=TPasUnresolvedTypeRef.Create('String',PA);
  1812. PA.Access:=argOut;
  1813. F.Args.Add(PA);
  1814. end;
  1815. EM.ProcType:=F;
  1816. F.ResultEl:=TPasResultElement.Create('Result',F);
  1817. F.ResultEl.ResultType:=ResolveType(ID.Schema,'Collection('+ES.EntityType+')');
  1818. C.Members.Add(EM);
  1819. end;
  1820. procedure TEDMX2PasConverter.CompleteEntitySet(ID: TIdentifier);
  1821. Var
  1822. FN : String;
  1823. EC : TEntityClassFunction;
  1824. F : TPasFunctionType;
  1825. C : TPasClassType;
  1826. ES : TEntitySet;
  1827. EID : TIDentifier;
  1828. Multi : Boolean;
  1829. begin
  1830. C:=ID.Element as TPasClassType;
  1831. ES:=C.CustomData as TEntitySet;
  1832. Multi:=Not (ES is TImplicitEntitySet);
  1833. If Not Multi then
  1834. Multi:=TImplicitEntitySet(ES).IsColl;
  1835. // Class function
  1836. FN:='EntityClass';
  1837. EC:=TEntityClassFunction.Create(FN,C);
  1838. EC.CustomData:=ES;
  1839. EC.Visibility:=visPublic;
  1840. F:=TPasFunctionType.Create(FN,EC);
  1841. EC.ProcType:=F;
  1842. F.ResultEl:=TPasResultElement.Create('Result',F);
  1843. F.ResultEl.ResultType:=TPasUnresolvedTypeRef.Create('TODataEntityClass',F.ResultEl);
  1844. EC.Modifiers:=[pmOverride];
  1845. C.Members.Add(EC);
  1846. EID:=FindIdentifier(Nil,ES.EntityType);// Qualified name
  1847. if EID=Nil then
  1848. Raise EEDMX2PasConverter.CreateFmt('Cannot find type definition %s for entityset %s, to add getter',[ES.EntityType,ES.Name]);
  1849. AddEntityGet(ID,EID);
  1850. if Multi then
  1851. begin
  1852. // List function, string version
  1853. AddEntityList(ID,'String',False);
  1854. AddEntityList(ID,'TQueryParams',False);
  1855. // ListAll
  1856. AddEntityList(ID,'String',True);
  1857. AddEntityList(ID,'TQueryParams',True);
  1858. end;
  1859. end;
  1860. procedure TEDMX2PasConverter.EntityContainerToIdentifiers(ASchema : TSchema; EC : EntityContainer);
  1861. Var
  1862. I : Integer;
  1863. ONS,NS, CN, SchemaPrefix : String;
  1864. P : TPasType;
  1865. ES : TEntitySet;
  1866. EID : TIdentifier;
  1867. begin
  1868. ONS:='"'+WTOA(ASchema.Namespace)+'"';
  1869. NS:=GetNameSpace(ASchema);
  1870. if NS<>ONS then
  1871. ONS:=ONS+' as "'+NS+'"';
  1872. SchemaPrefix:=FlattenName(NS);
  1873. For i:=0 to EC.EntitySet.Length-1 do
  1874. begin
  1875. ES:=EC.EntitySet.Item[I];
  1876. CN:=CreateIdentifierName(ASchema,SchemaPrefix,ES.Name+'EntitySet');
  1877. P:=TEntitySetClass.Create(CN,Nil);
  1878. P.CustomData:=ES;
  1879. DoLog('Converting entity set (Schema %s, EntitySet: %s) to %s',[ONS,ES.Name,CN]);
  1880. AddIdentifier(ASchema.Namespace+'.'+ES.Name+'.EntitySet',ASchema,P);
  1881. EID:=Nil;
  1882. EID:=FindIdentifier(Nil,ES.EntityType);// Qualified name
  1883. if EID=Nil then
  1884. Raise EEDMX2PasConverter.CreateFmt('Cannot find type definition %s for entityset %s to mark as identify set',[ES.EntityType,ES.Name]);
  1885. EID.IsEntitySet:=True;
  1886. end;
  1887. end;
  1888. procedure TEDMX2PasConverter.SchemaToIdentifiers;
  1889. Var
  1890. I,J : Integer;
  1891. CN,SchemaPrefix : String;
  1892. ASchema : TSchema;
  1893. CT : TComplexType;
  1894. ENUT : TEnumType;
  1895. ET : TEntityType;
  1896. EC : EntityContainer;
  1897. B : Boolean;
  1898. ONS,NS : String;
  1899. P : TPasType;
  1900. begin
  1901. For I:=0 to FSchemaList.Count-1 do
  1902. begin
  1903. ASchema:=TSchema(FSchemaList[i]);
  1904. ONS:='"'+WTOA(ASchema.NameSpace)+'"';
  1905. DoLog('Converting Schema %s, pass 1, enums, complex and entitytypes',[ONS]);
  1906. NS:=GetNameSpace(ASchema);
  1907. if NS<>ONS then
  1908. ONS:=ONS+' as "'+NS+'"';
  1909. // Writeln('Examining ',NS);
  1910. SchemaPrefix:=FlattenName(NS);
  1911. For J:=0 to ASchema.EnumType.Length-1 do
  1912. begin
  1913. ENUT:=ASchema.EnumType.Item[J];
  1914. CN:=CreateIdentifierName(ASchema,SchemaPrefix,ENUT.Name);
  1915. P:=TPasEnumType.Create(CN,Nil);
  1916. P.CustomData:=ENUT;
  1917. AddIdentifier(ASchema.NameSpace+'.'+ENut.Name,ASchema,P);
  1918. end;
  1919. For J:=0 to ASchema.ComplexType.Length-1 do
  1920. begin
  1921. CT:=ASchema.ComplexType.Item[J];
  1922. CN:=CreateIdentifierName(ASchema,SchemaPrefix,CT.Name);
  1923. DoLog('Converting complex type (Schema %s, ComplexType: %s) to %s',[ONS,CT.Name,CN]);
  1924. P:=TComplexClass.Create(CN,Nil);
  1925. P.CustomData:=CT;
  1926. AddIdentifier(ASchema.NameSpace+'.'+CT.Name,ASchema,P);
  1927. end;
  1928. For J:=0 to ASchema.EntityType.Length-1 do
  1929. begin
  1930. ET:=ASchema.EntityType.Item[J];
  1931. CN:=CreateIdentifierName(ASchema,SchemaPrefix,WTOA(ET.Name));
  1932. DoLog('Converted entity type (Schema: %s, EntityType: %s) to %s',[ONS,ET.Name,CN]);
  1933. P:=TEntityClass.Create(CN,Nil);
  1934. P.CustomData:=ET;
  1935. AddIdentifier(ASchema.NameSpace+'.'+ET.Name,ASchema,P);
  1936. end;
  1937. end;
  1938. For I:=0 to FSchemaList.Count-1 do
  1939. begin
  1940. ASchema:=TSchema(FSchemaList[i]);
  1941. DoLog('Converting Schema %s, pass 2, containers,entitytypes, Navigation properties',[ONS]);
  1942. NS:=GetNameSpace(ASchema);
  1943. // Writeln('Examining ',NS);
  1944. SchemaPrefix:=FlattenName(NS);
  1945. {$IFDEF USECSDL}
  1946. EC:=ASchema.EntityContainer;
  1947. if Assigned(EC) and (EC.Name<>'') then
  1948. begin
  1949. CN:=CreateIdentifierName(ASchema,SchemaPrefix,WTOA(EC.Name));
  1950. DoLog('Converted entity container (Schema: %s, EntityContainer: %s) to %s',[ONS,EC.Name,CN]);
  1951. P:=TEntityContainerClass.Create(CN,Nil);
  1952. P.CustomData:=EC;
  1953. AddIdentifier(ASchema.NameSpace+'.'+EC.Name,ASchema,P);
  1954. EntityContainerToIdentifiers(ASchema,EC);
  1955. end;
  1956. {$ELSE}
  1957. For J:=0 to ASchema.EntityContainer.Length-1 do
  1958. begin
  1959. EC:=ASchema.EntityContainer.Item[j];
  1960. CN:=CreateIdentifierName(ASchema,SchemaPrefix,EC.Name);
  1961. DoLog('Converted entity container (Schema: %s", EntityContainer: %s) to %s',[ONS,EC.Name,CN]);
  1962. P:=TEntityContainerClass.Create(CN,Nil);
  1963. P.CustomData:=EC;
  1964. AddIdentifier(ASchema.NameSpace+'.'+EC.Name,ASchema,P);
  1965. EntityContainerToIdentifiers(ASchema,EC);
  1966. end;
  1967. {$ENDIF}
  1968. // Extra loop: Implicit entity sets for contained entities
  1969. For J:=0 to ASchema.EntityType.Length-1 do
  1970. CheckNavigationPropertyEntity(ASchema,ASchema.EntityType[J]);
  1971. {$IFNDEF USECSDL}
  1972. For J:=0 to ASchema._Function.Length-1 do
  1973. if ASchema._Function[J].isBound then
  1974. CheckBoundFunction(ASchema,ASchema._Function[J]);
  1975. For J:=0 to ASchema.Action.Length-1 do
  1976. if ASchema.Action[J].isBound then
  1977. CheckBoundAction(ASchema,ASchema.Action[J]);
  1978. {$ENDIF USECSDL}
  1979. end;
  1980. For I:=0 to FSchemaList.Count-1 do
  1981. begin
  1982. ASchema:=TSchema(FSchemaList[i]);
  1983. {$IFDEF USECSDL}
  1984. B:=Assigned(ASchema.EntityContainer) and (ASchema.EntityContainer.Name<>'');
  1985. {$ELSE}
  1986. B:=ASchema.EntityContainer.Length>0;
  1987. {$ENDIF}
  1988. if B then
  1989. begin
  1990. // Add service.
  1991. CN:='T'+FlattenName(GetNameSpace(ASchema))+'Service';
  1992. DoLog('Service name : %s',[CN]);
  1993. P:=TServiceClass.Create(CN,Nil);
  1994. P.CustomData:=ASchema;
  1995. AddIdentifier(ASchema.Namespace,ASchema,P);
  1996. end;
  1997. end;
  1998. end;
  1999. procedure TEDMX2PasConverter.AddIdentifier(AIDentifier: TIdentifier);
  2000. begin
  2001. //Writeln('Adding identifier : ',AIdentifier.IdentifierName);
  2002. FIdentifierList.add(AIDentifier);
  2003. FIdentifierHash.Add(LowerCase(AIDentifier.IdentifierName),AIdentifier);
  2004. end;
  2005. function TEDMX2PasConverter.AddIdentifier(const AName: String;
  2006. ASchema: TSchema; El: TPasElement): TIdentifier;
  2007. begin
  2008. Result:=TIdentifier.Create(AName,ASchema,El);
  2009. AddIdentifier(Result);
  2010. end;
  2011. function TEDMX2PasConverter.AddIdentifier(const AName: UnicodeString;
  2012. ASchema: TSchema; El: TPasElement): TIdentifier;
  2013. begin
  2014. Result:=AddIdentifier(WTOA(ANAme),ASchema,El);
  2015. end;
  2016. {$IFNDEF USECSDL}
  2017. function TEDMX2PasConverter.CheckBoundFunction(ASchema: TSchema; Fun: TFunction
  2018. ): TPasFunction;
  2019. Var
  2020. I : Integer;
  2021. FID : TIdentifier;
  2022. CT : TPasClassType;
  2023. F : TPasFunctionType;
  2024. A : TPasArgument;
  2025. FN : String;
  2026. UEIP : TExtraKeyWords;
  2027. begin
  2028. DoLog('Bound function: %s ',[Fun.Name]);
  2029. If Fun.Parameter.Length=0 then
  2030. Raise EEDMX2PasConverter.CreateFmt('Error in EDMX : Bound function %s without parameters',[Fun.Name]);
  2031. FID:=FindIdentifier(Nil,Fun.Parameter[0]._Type);
  2032. If (FID=Nil) then
  2033. Raise EEDMX2PasConverter.CreateFmt('Could not find type %s for bound function %s',[Fun.Parameter[0]._Type,Fun.Name]);
  2034. CT:=FID.Element as TPasClassType;
  2035. UEIP:=UseExtraIdentifierProtection(CT.CustomData);
  2036. FN:=CleanPropertyName(Fun.Name,UEIP);
  2037. Result:=TBoundFunction.Create(FN,CT);
  2038. Result.visibility:=visPublic;
  2039. Result.CustomData:=Fun;
  2040. F:=TPasFunctionType.Create(FN,Result);
  2041. Result.ProcType:=F;
  2042. CT.Members.Add(Result);
  2043. A:=TPasArgument.Create('AService',F);
  2044. F.Args.Add(A);
  2045. A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
  2046. For I:=1 to Fun.Parameter.Length-1 do
  2047. begin
  2048. A:=TPasArgument.Create(CleanPropertyName(Fun.Parameter[I].Name,UEIP),F);
  2049. F.Args.Add(A);
  2050. A.ArgType:=ResolveType(ASchema,Fun.Parameter[i]._Type);
  2051. A.CustomData:=Fun.Parameter[i];
  2052. end;
  2053. F.ResultEl:=TPasResultElement.Create('Result',F);
  2054. F.ResultEl.ResultType:=ResolveType(ASchema,Fun.ReturnType._Type);
  2055. end;
  2056. function TEDMX2PasConverter.CheckBoundAction(ASchema: TSchema; Act: TAction
  2057. ): TPasProcedure;
  2058. Var
  2059. I : Integer;
  2060. FID : TIdentifier;
  2061. CT : TPasClassType;
  2062. HasResult : Boolean;
  2063. F : TPasFunctionType;
  2064. P : TPasProcedureType;
  2065. A : TPasArgument;
  2066. UEIP : TExtraKeywords;
  2067. AN : String;
  2068. begin
  2069. DoLog('Adding Bound Action: %s ',[Act.Name]);
  2070. If Act.Parameter.Length=0 then
  2071. Raise EEDMX2PasConverter.CreateFmt('Error in EDMX : Bound action %s without parameters',[Act.Name]);
  2072. FID:=FindIdentifier(Nil,WTOA(Act.Parameter[0]._Type));
  2073. If (FID=Nil) then
  2074. Raise EEDMX2PasConverter.CreateFmt('Could not find type %s for bound action %s',[Act.Parameter[0]._Type,Act.Name]);
  2075. CT:=FID.Element as TPasClassType;
  2076. UEIP:=UseExtraIdentifierProtection(CT.CustomData);
  2077. AN:=CleanPropertyName(Act.Name,UEIP);
  2078. HasResult:=Assigned(Act.ReturnType) and (Act.ReturnType._Type<>'');
  2079. if HasResult then
  2080. begin
  2081. Result:=TBoundActionFunc.Create(AN,CT);
  2082. F:=TPasFunctionType.Create(AN,Result);
  2083. P:=F;
  2084. end
  2085. else
  2086. begin
  2087. Result:=TBoundActionProc.Create(AN,CT);
  2088. F:=Nil;
  2089. P:=TPasProcedureType.Create(AN,Result);
  2090. end;
  2091. Result.visibility:=visPublic;
  2092. Result.CustomData:=Act;
  2093. Result.ProcType:=P;
  2094. CT.Members.Add(Result);
  2095. A:=TPasArgument.Create('AService',P);
  2096. P.Args.Add(A);
  2097. A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
  2098. For I:=1 to Act.Parameter.Length-1 do
  2099. begin
  2100. A:=TPasArgument.Create(CleanPropertyName(WTOA(Act.Parameter[I].Name),UEIP),P);
  2101. P.Args.Add(A);
  2102. A.ArgType:=ResolveType(ASchema,Act.Parameter[i]._Type);
  2103. A.CustomData:=Act.Parameter[i];
  2104. end;
  2105. if HasResult then
  2106. begin
  2107. F.ResultEl:=TPasResultElement.Create('Result',F);
  2108. F.ResultEl.ResultType:=ResolveType(ASchema,Act.ReturnType._Type);
  2109. end;
  2110. end;
  2111. {$ENDIF}
  2112. function TEDMX2PasConverter.ExtractBaseTypeName(ASchema: TSchema;
  2113. ATypeName: String; out IsColl: Boolean): String;
  2114. Const
  2115. SCollection = 'Collection(';
  2116. LCollection = Length(SCollection);
  2117. Var
  2118. L : Integer;
  2119. begin
  2120. Result:=ATypeName;
  2121. IsColl:=Copy(Result,1,LCollection)=SCollection;
  2122. if IsColl then
  2123. begin
  2124. Delete(Result,1,LCollection);
  2125. Delete(Result,Length(Result),1);
  2126. end;
  2127. L:=Length(ASchema.Namespace);
  2128. if (Copy(Result,1,L)=ASchema.Namespace) then
  2129. Delete(Result,1,L+1);
  2130. end;
  2131. function TEDMX2PasConverter.ExtractBaseTypeName(ASchema: TSchema;
  2132. ATypeName: UnicodeString; out IsColl: Boolean): String;
  2133. begin
  2134. Result:=ExtractBaseTypeName(ASchema,WTOA(ATypeName),isColl);
  2135. end;
  2136. procedure TEDMX2PasConverter.CheckNavigationPropertyEntity(ASchema: TSchema;
  2137. AEntity: TEntityType);
  2138. Var
  2139. i : integer;
  2140. NP : TNavigationProperty;
  2141. BTN,SchemaPrefix,ONS,NS,ESN,CN,TN : String;
  2142. ESI : TIDentifier;
  2143. P : TEntitySetClass;
  2144. IsColl : Boolean;
  2145. ES : TImplicitEntitySet;
  2146. ATS : TSchema;
  2147. begin
  2148. ONS:='"'+WTOA(ASchema.NameSpace)+'"';
  2149. NS:=GetNameSpace(ASchema);
  2150. if NS<>ONS then
  2151. ONS:=ONS+' as "'+NS+'"';
  2152. SchemaPrefix:=FlattenName(NS);
  2153. For I:=0 to AEntity.NavigationProperty.Length-1 do
  2154. begin
  2155. ATS:=ASchema;
  2156. NP:=AEntity.NavigationProperty[i];
  2157. // Writeln('Schema ',ASchema.NameSpace,' type ',AEntity.Name,', Investigating ',I,' : ',NP.Name);
  2158. {$IFNDEF USECSDL}
  2159. TN:=WTOA(NP._Type);
  2160. {$ELSE}
  2161. TN:=FindAssociatedType(ATS,WTOA(NP.Relationship),WTOA(NP.ToRole));
  2162. {$ENDIF}
  2163. BTN:=ExtractBaseTypeName(ATS,TN,isColl);
  2164. ESI:=FindEntitySetForEntity(ATS,BTN);
  2165. If (ESI=Nil) then
  2166. begin
  2167. ESN:=BTN+'ImplicitEntitySet';
  2168. CN:=CreateIdentifierName(ATS,SchemaPrefix,ESN);
  2169. P:=TEntitySetClass.Create(CN,Nil);
  2170. ES:=TImplicitEntitySet.Create(NP,WTOA(ATS.NameSpace)+'.'+BTN,isColl);
  2171. FFreeObjects.Add(ES);
  2172. ES.Name:=ESN;
  2173. P.CustomData:=ES;
  2174. DoLog('Converting implicit entity set for navigation property (Schema: %s, Entity: %s, Property: %s, Type: %s, Type namespace: %s) to %s',[ONS,AEntity.Name, NP.Name,TN,ATS.Namespace,CN]);
  2175. AddIdentifier(NS+'.'+ESN,ATS,P);
  2176. end;
  2177. end;
  2178. end;
  2179. procedure TEDMX2PasConverter.CompleteEnumerator(ID: TIdentifier);
  2180. Var
  2181. I : integer;
  2182. PE : TPasEnumType;
  2183. PV : TPasEnumValue;
  2184. XE : TEnumType;
  2185. XM : TEnumTypeMember;
  2186. EN : String;
  2187. begin
  2188. PE:=ID.Element as TPasEnumType;
  2189. XE:=PE.CustomData as TEnumType;
  2190. For I:=0 to XE.Member.Length-1 do
  2191. begin
  2192. XM:=XE.Member[I];
  2193. EN:=WTOA(XM.Name);
  2194. if EnumerationMode = emPrefixTypeName then
  2195. EN:=PE.Name+'_'+EN;
  2196. PV:=TPasEnumValue.Create(EN,PE);
  2197. PE.Values.Add(PV);
  2198. end;
  2199. end;
  2200. procedure TEDMX2PasConverter.GenerateBaseClass(ID: TIDentifier);
  2201. Var
  2202. PC : TPAsClassType;
  2203. K : TObjectRestKind;
  2204. F : TPasFunctionType;
  2205. begin
  2206. PC:=ID.Element as TPasClassType;
  2207. K:=TObjectRestKind.Create('ObjectRestKind',PC);
  2208. K.Modifiers:=[pmOverride];
  2209. F:=TPasFunctionType.Create('ObjectRestKind',K);
  2210. K.ProcType:=F;
  2211. F.ResultEl:=TPasResultElement.Create('Result',F);
  2212. F.ResultEl.ResultType:=TPasUnresolvedTypeRef.Create('String',F);
  2213. K.Visibility:=visPublic;
  2214. PC.Members.Add(K);
  2215. end;
  2216. procedure TEDMX2PasConverter.CompleteIdentifiers;
  2217. Var
  2218. I : Integer;
  2219. Id : TIdentifier;
  2220. El : TPasElement;
  2221. begin
  2222. For I:=0 to FIdentifierList.Count-1 do
  2223. begin
  2224. Id:=FIdentifierList[i] as TIdentifier;
  2225. El:=Id.Element;
  2226. if Assigned(EL) then
  2227. begin
  2228. DoLog('Completing identifier %d : %s',[I,EL.Name]);
  2229. if El.InheritsFrom(TPasEnumType) then
  2230. CompleteEnumerator(ID);
  2231. if El.InheritsFrom(TPasClassType) then
  2232. begin
  2233. GenerateBaseClass(ID);
  2234. if El.CustomData.InheritsFrom(EntityContainer) then
  2235. CompleteContainer(ID)
  2236. else if El.CustomData.InheritsFrom(TComplexType) then
  2237. CompleteComplexType(ID)
  2238. else if El.CustomData.InheritsFrom(TEntityType) then
  2239. CompleteEntityType(ID)
  2240. end;
  2241. end;
  2242. end;
  2243. For I:=0 to FIdentifierList.Count-1 do
  2244. begin
  2245. Id:=FIdentifierList[i] as TIdentifier;
  2246. El:=Id.Element;
  2247. if Assigned(EL) then
  2248. begin
  2249. DoLog('Completing identifier %d : %s',[I,EL.Name]);
  2250. if El.CustomData.InheritsFrom(TEntitySet) then
  2251. CompleteEntitySet(ID)
  2252. else if El.CustomData.InheritsFrom(TSchema) then
  2253. CompleteSchema(ID);
  2254. end;
  2255. end;
  2256. DoLog('Done completing identifiers');
  2257. end;
  2258. procedure TEDMX2PasConverter.LoadFromStream(const AStream: TStream);
  2259. begin
  2260. FXML.CopyFrom(AStream,0);
  2261. FXML.Position:=0;
  2262. end;
  2263. procedure TEDMX2PasConverter.AddContainerToSchema(ID: TIdentifier;
  2264. AIndex: Integer; E: EntityContainer);
  2265. Var
  2266. F : TPasFunctionType;
  2267. CC : TCreateContainer;
  2268. CN,FN : string;
  2269. ST : TPasClassType;
  2270. begin
  2271. CN:=CleanPropertyName(E.Name,ekwService);
  2272. // Creator function
  2273. ST:=ID.Element as TPasClassType;
  2274. FN:='CreateNew'+CN;
  2275. CC:=TCreateContainer.Create(FN,ST);
  2276. CC.Visibility:=visPublic;
  2277. F:=TPasFunctionType.Create(FN,CC);
  2278. CC.ProcType:=F;
  2279. F.ResultEl:=TPasResultElement.Create('Result',F);
  2280. F.ResultEl.ResultType:=ResolveType(ST.CustomData as TSchema,E.Name);
  2281. ST.Members.Add(CC);
  2282. // Property
  2283. AddProperty(ID,AIndex,CN,WTOA(E.Name),[pfNeedGetter,pfNeedSetter,pfReadOnly],E);
  2284. end;
  2285. procedure TEDMX2PasConverter.CompleteSchema(ID : TIdentifier);
  2286. Var
  2287. C : TPasClassType;
  2288. ASchema : TSchema;
  2289. EC : EntityContainer;
  2290. {$IFNDEF USECSDL}
  2291. I : Integer;
  2292. {$ENDIF}
  2293. begin
  2294. C:=ID.Element as TPasClassType;
  2295. ASchema:=C.CustomData as TSchema;
  2296. {$IFDEF USECSDL}
  2297. EC:=ASchema.EntityContainer;
  2298. if Assigned(EC) then
  2299. AddContainerToSchema(ID,0,EC);
  2300. {$ELSE}
  2301. For I:=0 to ASchema.EntityContainer.Length-1 do
  2302. begin
  2303. EC:=ASchema.EntityContainer.Item[I];
  2304. AddContainerToSchema(ID,I,EC);
  2305. end;
  2306. {$ENDIF}
  2307. end;
  2308. procedure TEDMX2PasConverter.AddEntitySet(ID: TIDentifier; ES: TEntitySet;
  2309. AIndex: Integer);
  2310. Var
  2311. C : TPasClassType;
  2312. F : TPasFunctionType;
  2313. CC : TCreateEntitySet;
  2314. EN,FN : string;
  2315. begin
  2316. C:=ID.Element as TPasClassType;
  2317. EN:=CleanPropertyName(ES.Name,ekwEntityContainer);
  2318. // Creator function
  2319. FN:='CreateNew'+EN;
  2320. CC:=TCreateEntitySet.Create(FN,C);
  2321. CC.Visibility:=visPublic;
  2322. F:=TPasFunctionType.Create(FN,CC);
  2323. CC.ProcType:=F;
  2324. F.ResultEl:=TPasResultElement.Create('Result',F);
  2325. F.ResultEl.ResultType:=ResolveType(ID.Schema,EN+'EntitySet');
  2326. C.Members.Add(CC);
  2327. // Property
  2328. AddProperty(ID,AIndex,EN,EN+'EntitySet',[pfNeedGetter,pfReadOnly],ES);
  2329. end;
  2330. {$IFNDEF USECSDL}
  2331. procedure TEDMX2PasConverter.AddSingleTon(ID: TIDentifier; S : TSingleton; AIndex : integer);
  2332. Var
  2333. C : TPasClassType;
  2334. GS : TGetSingleton;
  2335. SN,FN : string;
  2336. F: TPasFunctionType;
  2337. begin
  2338. C:=ID.Element as TPasClassType;
  2339. // Writeln('Examining ',NS);
  2340. SN:=CleanPropertyName(S.Name,UseExtraIdentifierProtection(C.CustomData));
  2341. FN:='Fetch'+SN;
  2342. GS:=TGetSingleton.Create(FN,C);
  2343. GS.Visibility:=visPublic;
  2344. GS.CustomData:=S;
  2345. F:=TPasFunctionType.Create(FN,GS);
  2346. GS.ProcType:=F;
  2347. F.ResultEl:=TPasResultElement.Create('Result',F);
  2348. F.ResultEl.ResultType:=ResolveType(ID.Schema,S._type);
  2349. C.Members.Add(GS);
  2350. AddProperty(ID,Aindex,S.Name,S._type,[pfNeedGetter,pfReadOnly],S);
  2351. end;
  2352. {$ENDIF}
  2353. procedure TEDMX2PasConverter.CompleteContainer(ID : TIdentifier);
  2354. Var
  2355. C : TPasClassType;
  2356. CT : EntityContainer;
  2357. I : integer;
  2358. begin
  2359. C:=ID.Element as TPasClassType;
  2360. CT:=ID.Element.CustomData as EntityContainer;
  2361. C.AncestorType:=TPasUnresolvedTypeRef.Create(BaseEntityContainerType,Nil);
  2362. for I:=0 to CT.EntitySet.Length-1 do
  2363. AddEntitySet(ID,CT.EntitySet[i],I);
  2364. {$IFNDEF USECSDL}
  2365. for I:=0 to CT.Singleton.Length-1 do
  2366. AddSingleton(ID,CT.Singleton[i],I);
  2367. For i:=0 to CT.ActionImport.Length-1 do
  2368. AddImportAction(ID,CT.ActionImport[I],i);
  2369. {$ENDIF}
  2370. For i:=0 to CT.FunctionImport.Length-1 do
  2371. AddImportFunction(ID,CT.FunctionImport[I]);
  2372. end;
  2373. procedure TEDMX2PasConverter.AddSetArrayLength(ID: TIdentifier);
  2374. Var
  2375. CT : TPasClassType;
  2376. P : TPasProcedureType;
  2377. A : TPasArgument;
  2378. SAR : TSetArrayLength;
  2379. begin
  2380. DoLog('Adding AddSetArrayLength for class %s',[ID.Element.Name]);
  2381. CT:=ID.Element as TPasClassType;
  2382. // Procedure SetArrayLength(const AName : String; ALength : Longint); virtual;
  2383. SAR:=TSetArrayLength.Create('SetArrayLength',CT);
  2384. SAR.visibility:=visProtected;
  2385. SAR.CustomData:=CT.CustomData;
  2386. P:=TPasProcedureType.Create('SetArrayLength',SAR);
  2387. SAR.ProcType:=P;
  2388. SAR.Modifiers:=[pmOverride];
  2389. CT.Members.Add(SAR);
  2390. // Arguments: AName: String
  2391. A:=TPasArgument.Create('AName',P);
  2392. A.Access:=argConst;
  2393. P.Args.Add(A);
  2394. A.ArgType:=TPasUnresolvedTypeRef.Create('String',A);
  2395. // Arguments: ALength : Longint;
  2396. A:=TPasArgument.Create('ALength',P);
  2397. P.Args.Add(A);
  2398. A.ArgType:=TPasUnresolvedTypeRef.Create('Longint',A);
  2399. end;
  2400. {$IFDEF USECSDL}
  2401. procedure TEDMX2PasConverter.AddImportFunction(ID : TIdentifier; AFun : TFunctionImport);
  2402. begin
  2403. // Just some code to make the compiler happy
  2404. if Not (Assigned(ID) and Assigned(AFun)) then
  2405. exit
  2406. end;
  2407. {$ELSE}
  2408. function TEDMX2PasConverter.AddUnboundFunction(ID: TIdentifier; APath: String;
  2409. Fun: TFunction; AIndex: Integer): TPasFunction;
  2410. Var
  2411. I : Integer;
  2412. CT : TPasClassType;
  2413. F : TPasFunctionType;
  2414. A : TPasArgument;
  2415. UEIP : TExtraKeywords;
  2416. FN : String;
  2417. begin
  2418. DoLog('Adding Unbound function [%d]: %s ',[AIndex,Fun.Name]);
  2419. CT:=ID.Element as TPasClassType;
  2420. UEIP:=UseExtraIdentifierProtection(CT.CustomData);
  2421. FN:=CleanPropertyName(Fun.Name,UEIP);
  2422. Result:=TUnBoundFunction.Create(FN,CT);
  2423. TUnBoundFunction(Result).ExportPath:=APath;
  2424. Result.visibility:=visPublic;
  2425. Result.CustomData:=Fun;
  2426. F:=TPasFunctionType.Create(FN,Result);
  2427. Result.ProcType:=F;
  2428. CT.Members.Add(Result);
  2429. For I:=0 to Fun.Parameter.Length-1 do
  2430. begin
  2431. A:=TPasArgument.Create(CleanPropertyName(WTOA(Fun.Parameter[I].Name),UEIP),F);
  2432. F.Args.Add(A);
  2433. A.ArgType:=ResolveType(ID.Schema,Fun.Parameter[i]._Type);
  2434. A.CustomData:=Fun.Parameter[i];
  2435. end;
  2436. F.ResultEl:=TPasResultElement.Create('Result',F);
  2437. F.ResultEl.ResultType:=ResolveType(ID.Schema,Fun.ReturnType._Type);
  2438. end;
  2439. function TEDMX2PasConverter.AddUnboundAction(ID: TIdentifier; APath: String;
  2440. Act: TAction; AIndex: integer): TPasProcedure;
  2441. Var
  2442. I : Integer;
  2443. CT : TPasClassType;
  2444. F : TPasFunctionType;
  2445. P : TPasProcedureType;
  2446. A : TPasArgument;
  2447. HasResult : Boolean;
  2448. UEIP : TExtraKeywords;
  2449. AN : String;
  2450. begin
  2451. DoLog('Adding Unbound Action [%d]: %s ',[AIndex,Act.Name]);
  2452. CT:=ID.Element as TPasClassType;
  2453. UEIP:=UseExtraIdentifierProtection(CT.CustomData);
  2454. AN:=CleanPropertyName(Act.Name,UEIP);
  2455. HasResult:=Assigned(Act.ReturnType) and (Act.ReturnType._Type<>'');
  2456. if HasResult then
  2457. begin
  2458. Result:=TUnBoundActionFunc.Create(AN,CT);
  2459. TUnBoundActionFunc(Result).ExportPath:=APath;
  2460. F:=TPasFunctionType.Create(AN,Result);
  2461. P:=F;
  2462. end
  2463. else
  2464. begin
  2465. Result:=TUnBoundActionProc.Create(AN,CT);
  2466. TUnBoundActionProc(Result).ExportPath:=APath;
  2467. F:=Nil;
  2468. P:=TPasProcedureType.Create(AN,Result);
  2469. end;
  2470. Result.visibility:=visPublic;
  2471. Result.CustomData:=Act;
  2472. Result.ProcType:=P;
  2473. CT.Members.Add(Result);
  2474. For I:=0 to Act.Parameter.Length-1 do
  2475. begin
  2476. A:=TPasArgument.Create(AN,F);
  2477. F.Args.Add(A);
  2478. A.ArgType:=ResolveType(ID.Schema,Act.Parameter[i]._Type);
  2479. A.CustomData:=Act.Parameter[i];
  2480. end;
  2481. If Assigned(F) then
  2482. begin
  2483. F.ResultEl:=TPasResultElement.Create('Result',F);
  2484. F.ResultEl.ResultType:=ResolveType(ID.Schema,Act.ReturnType._Type);
  2485. end;
  2486. end;
  2487. procedure TEDMX2PasConverter.AddImportFunction(ID : TIdentifier; AFun : TFunctionImport);
  2488. Var
  2489. I : Integer;
  2490. L : TFPList;
  2491. begin
  2492. L:=TFPList.Create;
  2493. try
  2494. For I:=0 to ID.Schema._Function.Length-1 do
  2495. if (ID.Schema.Namespace+'.'+ID.Schema._Function[i].Name=AFun._Function) then
  2496. L.Add(ID.Schema._Function[i]);
  2497. if L.Count=0 then
  2498. Raise EEDMX2PasConverter.CreateFmt('No function name %s found for importfunction %s',[AFun._Function,AFun.Name]);
  2499. For I:=0 to L.Count-1 do
  2500. AddUnBoundFunction(ID,AFun.Name,TFunction(L[i]),I);
  2501. finally
  2502. L.Free;
  2503. end;
  2504. end;
  2505. procedure TEDMX2PasConverter.AddImportAction(ID : TIdentifier; Act : TActionImport; AIndex : Integer);
  2506. Var
  2507. I : Integer;
  2508. L : TFPList;
  2509. begin
  2510. L:=TFPList.Create;
  2511. try
  2512. For I:=0 to ID.Schema.action.Length-1 do
  2513. if (ID.Schema.Namespace+'.'+ID.Schema.action[i].Name=Act.Action) then
  2514. L.Add(ID.Schema.Action[i]);
  2515. if L.Count=0 then
  2516. Raise EEDMX2PasConverter.CreateFmt('No Action name %s found for importaction %d: %s',[Act.Action,AIndex, Act.Name]);
  2517. For I:=0 to L.Count-1 do
  2518. AddUnBoundAction(ID,Act.Name,TAction(L[i]),I);
  2519. finally
  2520. L.Free;
  2521. end;
  2522. end;
  2523. {$ENDIF}
  2524. procedure TEDMX2PasConverter.EmitImplementation;
  2525. Var
  2526. ID : TIdentifier;
  2527. I : integer;
  2528. begin
  2529. For I:=0 to FIdentifierList.Count-1 do
  2530. begin
  2531. ID:=TIdentifier(FIdentifierList[I]);
  2532. If ID.Element is TPasClasstype then
  2533. EmitClassImplementation(ID);
  2534. end;
  2535. end;
  2536. procedure TEDMX2PasConverter.Execute;
  2537. begin
  2538. AnalyseXML;
  2539. RegisterBaseTypes;
  2540. SchemaToIdentifiers;
  2541. CompleteIdentifiers;
  2542. Source.Clear;
  2543. Addln('unit '+OutputUnitName+';');
  2544. CreateHeader;
  2545. EmitOptions;
  2546. EmitInterface;
  2547. AddLn('');
  2548. AddLn('implementation');
  2549. AddLn('');
  2550. EmitImplementation;
  2551. AddLn('end.');
  2552. DoLog('All done');
  2553. end;
  2554. end.