12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864 |
- {$ifdef USECSDL}
- unit csdl2pas;
- {$ELSE}
- unit edmx2pas;
- {$ENDIF}
- {$mode objfpc}{$H+}
- interface
- uses
- typinfo, Classes, contnrs, SysUtils, restcodegen, odatacodegen,
- {$IFDEF USECSDL} csdl, {$ELSE} edm, {$ENDIF} pastree, base_service_intf, xml_serializer;
- Const
- IndexShift = 3; // Number of bits reserved for flags.
- Type
- {$IFNDEF USECSDL}
- // EDM type names
- TSchema = Schema;
- EntityContainer = TEntityContainer;
- TComplexTypeProperty = TProperty;
- TEntityProperty = TProperty;
- {$ELSE}
- TEntitySet = EntityContainer_EntitySet_Type;
- TEntityType_KeyArray = TEntityKeyElement;
- TFunctionImport = EntityContainer_FunctionImport_Type;
- {$ENDIF}
- { TImplicitEntitySet }
- TImplicitEntitySet = CLass(TEntitySet)
- private
- FIsColl: Boolean;
- FNavigationProperty: TNavigationProperty;
- Public
- Constructor Create(AProperty : TNavigationProperty; ATypeName : String; AIsColl : Boolean); reintroduce;
- Property NavigationProperty : TNavigationProperty Read FNavigationProperty;
- Property IsColl : Boolean Read FIsColl;
- end;
- { TIdentifier }
- TIdentifier = Class(TObject)
- private
- FEL: TPasElement;
- FIsEntitySet: Boolean;
- FName: String;
- FSchema: TSchema;
- Public
- Constructor Create(Const AName : String; ASchema : TSchema; El : TPasElement);
- Destructor Destroy; override;
- Property IdentifierName : String Read FName;
- Property Schema : TSchema Read FSchema;
- Property Element : TPasElement Read FEL;
- Property IsEntitySet : Boolean Read FIsEntitySet Write FIsEntitySet;
- end;
- { TEDMX2PasConverter }
- TEDMX2PasConverter = Class(TODataCodeGenerator)
- private
- FXML: TStream;
- FFreeObjects : TFPObjectList;
- FSchemaList : TFPObjectList;
- FIdentifierList : TFPObjectList;
- FIdentifierHash : TFPObjectHashTable;
- Protected
- // Identifier management
- {$IFDEF USECSDL}
- Function FindAssociatedTypeInSchema(ASchema: TSchema; Const ARelation, ARole: String): String;
- Function FindAssociatedType(Var APreferredSchema: TSchema; Const ARelation, ARole: String): String;
- {$ENDIF}
- function UseExtraIdentifierProtection(D: TObject): TExtraKeywords;
- Function ExtractBaseTypeName(ASchema: TSchema; ATypeName: String; Out IsColl: Boolean): String;
- Function ExtractBaseTypeName(ASchema: TSchema; ATypeName: UnicodeString; Out IsColl: Boolean): String;
- Function FindEntitySetForEntity(ASchema: TSchema; AName: String): TIdentifier;
- Function FindProperty(C: TPasClassType; APropertyName: String): TEntityProperty;
- Function FindProperty(C: TPasClassType; APropertyName: UnicodeString): TEntityProperty;
- Function GetEntityKey(C: TPasClassType): TEntityType_KeyArray;
- Function FindQualifiedIdentifier(AName: String): TIdentifier;
- Function FindIdentifier(ASchema : TSchema; AName: String): TIdentifier;
- Function FindIdentifier(ASchema : TSchema; AName: UnicodeString): TIdentifier;
- Function GetNameSpace(ASchema: TSchema): String;
- Function GetNativeTypeName(O: TObject): String;
- Function NeedWriteSetter(P: TComplexTypeProperty): Boolean;
- Function ResolveNameSpace(ASchema: TSchema; ATypeName: String): String;
- Function ResolveType(ASchema: TSchema; Const ATypeName: String): TPasType;
- Function ResolveType(ASchema: TSchema; Const ATypeName: UnicodeString): TPasType;
- // EDMX
- // Identifier generation
- procedure SchemaToIdentifiers;virtual;
- Procedure AddIdentifier(AIDentifier : TIdentifier);
- Function AddIdentifier(Const AName : String; ASchema : TSchema; El : TPasElement) : TIdentifier;
- Function AddIdentifier(Const AName : UnicodeString; ASchema : TSchema; El : TPasElement) : TIdentifier;
- procedure EntityContainerToIdentifiers(ASchema: TSchema; EC: EntityContainer);virtual;
- Procedure CompleteIdentifiers;virtual;
- Procedure GenerateBaseClass(ID: TIDentifier);virtual;
- Procedure CheckNavigationPropertyEntity(ASchema: TSchema; AEntity: TEntityType);virtual;
- Procedure AddExportPropertyName(ID: TIdentifier);virtual;
- Procedure AddContainerToSchema(ID: TIdentifier; AIndex: Integer; E: EntityContainer);virtual;
- procedure AddEntitySet(ID: TIDentifier; ES: TEntitySet; AIndex : Integer);virtual;
- Procedure AddEntityGet(ID, EID: TIdentifier);virtual;
- Procedure AddEntityList(ID: TIdentifier; ArgType: String; ListAll: Boolean);virtual;
- Function AddGetStream(ID: TIDentifier): TGetStream;
- Function AddSetStream(ID: TIDentifier): TSetStream;
- Function AddGetKeyAsURLPart(ID: TIdentifier; Key: TEntityKeyElement ): TPasFunction;virtual;
- function CreateIdentifierName(ASchema: TSchema; const APrefix, AName: String): String;virtual;
- function CreateIdentifierName(ASchema: TSchema; const APrefix, AName: UnicodeString): String;virtual;
- function CreateIdentifierName(ASchema: TSchema; const APrefix : String; AName: UnicodeString): String;virtual;
- Function CreatePropertyGetter(AParent: TPasElement; PN: String; indexed: Boolean; T: TPasType): TPropertyGetter;virtual;
- Function CreatePropertySetter(AParent: TPasElement; PN: String; indexed: Boolean; T: TPasType): TPropertySetter;virtual;
- // Return true if the actual property name differs from the property name in the Edm
- Function AddProperty(ID: TIdentifier; APropertyIndex : integer; Const APropertyName, APropertyType: String; Flags: TPropertyFlags; ACustomData : TObject) : Boolean;virtual;
- Function AddNavigationProperty(ID: TIDentifier; P: TNavigationProperty): TPasFunction;virtual;
- procedure AddImportFunction(ID: TIdentifier; AFun: TFunctionImport);
- {$IFNDEF USECSDL}
- procedure AddImportAction(ID : TIdentifier; Act : TActionImport; AIndex : Integer);
- Function AddUnboundFunction(ID : TIdentifier; APath : String; Fun : TFunction; AIndex : Integer) : TPasFunction;
- Function CheckBoundFunction(ASchema: TSchema; Fun: TFunction): TPasFunction;
- Function AddUnboundAction(ID : TIdentifier; APath : String; Act : TAction; AIndex : integer) : TPasProcedure;
- Function CheckBoundAction(ASchema: TSchema; Act: TAction): TPasProcedure;
- procedure AddSingleTon(ID: TIDentifier; S: TSingleton; AIndex : integer);virtual;
- {$ENDIF}
- Procedure AddSetArrayLength(ID: TIdentifier); virtual;
- procedure CompleteContainer(ID: TIdentifier);virtual;
- Procedure CompleteEnumerator(ID: TIdentifier);virtual;
- Procedure CompleteComplexType(ID: TIdentifier);virtual;
- Procedure CompleteEntityType(ID: TIdentifier);virtual;
- Procedure CompleteEntitySet(ID: TIdentifier);virtual;
- procedure CompleteSchema(ID: TIdentifier);virtual;
- // Code generation
- procedure EmitInterface;virtual;
- procedure EmitImplementation;virtual;
- procedure EmitForwardDeclaration;virtual;
- procedure EmitEnumTypes;virtual;
- procedure EmitClassDeclarations;virtual;
- procedure EmitClassDeclaration(ID : TIDentifier);virtual;
- procedure EmitClassImplementation(ID : TIDentifier);virtual;
- procedure EmitClassDeclarationSection(El: TPasClassType; V: TPasMemberVisibility);virtual;
- Procedure EmitMethodHeader(AClassName, AMethodName: String; PT: TPasProcedureType; RT: String);
- procedure EmitObjectRestKind(CT: TPasClassType; R: TObjectRestKind);virtual;
- procedure EmitGetSingleton(CT: TPasClassType; S: TGetSingleTon);virtual;
- procedure EmitGetKeyAsURLPart(CT: TPasClassType; ASchema : TSchema; P: TKeyAsURLPart);virtual;
- procedure EmitPropertySetter(Const CN: String; P: TPropertySetter);virtual;
- procedure EmitPropertyGetter(Const CN: String; P: TPropertyGetter);virtual;
- procedure EmitCreateContainer(Const CN: String; CC: TCreateContainer);virtual;
- procedure EmitCreateEntitySet(Const CN: String; CE: TCreateEntitySet);virtual;
- Procedure EmitGetStream(Const CN: String; G: TGetStream);virtual;
- Procedure EmitSetStream(Const CN: String; G: TSetStream);virtual;
- Procedure EmitSetArrayLength(CT : TPasClassType; A : TSetArrayLength); virtual;
- {$IFNDEF USECSDL}
- Procedure EmitFunctionCall(ServiceName,ReturnType : String; ResultType : TResultType);
- Procedure EmitMethodPath(PT: TPasProcedureType; MethodPath : String; GlobalService : Boolean);
- Procedure EmitPreparePostObject(Act: TPasProcedure; ActionPath : String; GlobalService,AllocateArray : Boolean);
- Procedure EmitBoundFunction(CT: TPasClassType; ASchema : TSchema; Fun: TBoundFunction);virtual;
- Procedure EmitBoundAction(CT: TPasClassType; ASchema : TSchema; Act: TPasProcedure);virtual;
- Procedure EmitUnBoundFunction(CT: TPasClassType; Fun: TUnBoundFunction);virtual;
- Procedure EmitUnBoundAction(CT: TPasClassType; Act: TPasProcedure);virtual;
- Procedure EmitActionServiceCall(Const AReturnType,AElementType : String; GlobalService : Boolean; ResultType : TResultType);
- {$endif}
- procedure EmitEntityClassFunction(CT: TPasClassType; ASchema: TSchema; CE: TEntityClassFunction);virtual;
- procedure EmitGetContainedSingleton(CT: TPasClassType; E: TGetContainedSingleton);virtual;
- procedure EmitNavigationProperty(CT: TPasClassType; E: TGetNavigationProperty);virtual;
- procedure EmitExportPropertyName(CT: TPasClassType; E: TExportPropertyName);virtual;
- procedure EmitEntityGet(CT: TPasClassType; E: TEntityGet);virtual;
- procedure EmitEntityList(CT: TPasClassType; E: TEntityList);virtual;
- procedure EmitEntityMethod(CT: TPasClassType; E: TEntityMethod);virtual;
- // Function GetPropertyTypeName(Decl: TDOMELement): String;
- procedure AnalyseXML; virtual;
- Public
- Constructor Create(AOwner : TComponent); override;
- Destructor Destroy; override;
- Class Function ODataVersion : TODataVersion; override;
- Procedure LoadFromStream(Const AStream : TStream); override;
- Procedure Execute; override;
- end;
- implementation
- { TImplicitEntitySet }
- Constructor TImplicitEntitySet.Create(AProperty: TNavigationProperty;
- ATypeName: String; AIsColl: Boolean);
- begin
- Inherited Create;
- FNavigationProperty:=AProperty;
- EntityType:=ATypeName;
- FIsColl:=AIsColl;
- end;
- { TIdentifier }
- Constructor TIdentifier.Create(Const AName: String; ASchema: TSchema;
- El: TPasElement);
- Var
- N : String;
- begin
- FName:=AName;
- FSchema:=ASchema;
- FEl:=El;
- if (FName='') then
- begin
- if (FSchema=Nil) or (FEl=Nil) then
- Raise EEDMX2PasConverter.Create('No identifier name specified, no element and schema specified');
- N:=GetStrProp(EL.CustomData,'Name');
- if (N='') then
- N:=GetStrProp(EL.CustomData,'TypeName');
- FName:=TODataCodeGenerator.WTOA(FSchema.Namespace)+'.'+N;
- end;
- // Writeln('Identifier '+FName,' created (',El.ClassName,': ',el.Name,')');
- end;
- Destructor TIdentifier.Destroy;
- begin
- // Writeln('Destroying ',FEL.Name,' : ',Fel.RefCount);
- // Flush(output);
- FEl.Release;
- inherited Destroy;
- end;
- constructor TEDMX2PasConverter.Create(AOwner: TComponent);
- begin
- inherited Create(AOWner);
- FFreeObjects:=TFPObjectList.Create(True);
- FSchemaList:=TFPObjectList.Create(True);
- FIdentifierList:=TFPObjectList.Create(True);
- FIdentifierHash:=TFPObjectHashTable.Create(False);
- FXML:=TStringStream.Create('');
- end;
- destructor TEDMX2PasConverter.Destroy;
- begin
- FreeAndNil(FXML);
- FreeAndNil(FSchemaList);
- FreeAndNil(FIdentifierList);
- FreeAndNil(FFreeObjects);
- FreeAndNil(FIdentifierHash);
- inherited Destroy;
- end;
- procedure TEDMX2PasConverter.EmitClassDeclarations;
- Var
- I : Integer;
- ID : TIdentifier;
- begin
- For I:=0 to FIdentifierList.Count-1 do
- begin
- ID:=FIdentifierList[i] as TIdentifier;
- if ID.Element.InheritsFrom(TPasClassType) then
- EmitClassDeclaration(ID);
- end;
- end;
- procedure TEDMX2PasConverter.EmitClassDeclarationSection(El: TPasClassType; V: TPasMemberVisibility);
- Var
- I : integer;
- M : TPasElement;
- PP : TPasProperty;
- S : String;
- begin
- // Variables (fields);
- For I:=0 to El.Members.Count-1 do
- begin
- M:=TPasElement(El.Members[i]);
- if (M.Visibility=v) and (M.ClassType=TPasvariable) then // Do not use InheritsFrom or Is !!
- AddLn(M.GetDeclaration(True)+';');
- end;
- // Methods
- For I:=0 to El.Members.Count-1 do
- begin
- M:=TPasElement(El.Members[i]);
- if (M.Visibility=v) and (M is TPasProcedure) then
- WriteProcedureDecl(M as TPasProcedure);
- end;
- // Properties
- For I:=0 to El.Members.Count-1 do
- begin
- M:=TPasElement(El.Members[i]);
- if (M.Visibility=v) and (M is TPasProperty) then
- begin
- PP:=M as TPasProperty;
- S:=Format('Property %s : %s',[PP.Name,PP.VarType.Name]);
- if Assigned(PP.IndexExpr) then
- S:=S+Format(' index %s',[(PP.IndexExpr as TPrimitiveExpr).Value]);
- S:=S+Format(' read %s',[PP.ReadAccessorName]);
- if (PP.WriteAccessorName<>'') then
- S:=S+Format(' write %s',[PP.WriteAccessorName]);
- AddLn(S+';');
- end;
- end;
- end;
- function TEDMX2PasConverter.GetNativeTypeName(O: TObject): String;
- begin
- if O.InheritsFrom(TSchema) then
- Result:=WTOA(TSchema(O).Namespace)
- else
- Result:=GetStrProp(O,'Name');
- end;
- procedure TEDMX2PasConverter.EmitClassDeclaration(ID: TIDentifier);
- Function CountElementsForVisibility(Alist : TFPList; V : TPasMemberVisibility) : integer;
- Var
- I : Integer;
- begin
- Result:=0;
- For I:=0 to AList.Count-1 do
- if TPasElement(AList[I]).Visibility=V then
- Inc(Result);
- end;
- Var
- NN,PC,S : String;
- El : TPasClassType;
- Empty : Boolean;
- V : TPasMemberVisibility;
- begin
- EL:=ID.Element as TPasClassType;
- NN:=GetNativeTypeName(EL.CustomData);
- ClassHeader(WTOA(ID.Schema.NameSpace)+': '+NN);
- Empty:=not (Assigned(EL.Members) and (EL.Members.Count>0));
- PC:=GetBaseClassName(EL);
- S:=Format('%s = Class(%s)',[EL.Name,PC]);
- if empty then
- S:=S+';';
- AddLn(S);
- if Empty then
- exit;
- for v in TPasMemberVisibility do
- if CountElementsForVisibility(El.Members,V)>0 then
- begin
- if V<>visDefault then
- AddLn(VisibilityNames[v]);
- IncIndent;
- EmitClassDeclarationSection(EL,V);
- DecIndent;
- end;
- Addln('end;');
- AddLn('');
- end;
- procedure TEDMX2PasConverter.EmitPropertyGetter(const CN: String;
- P: TPropertyGetter);
- Var
- TN,FN : String;
- D : TObject;
- begin
- TN:=(P.TheProperty as TPasProperty).VarType.Name;
- EmitMethodHeader(CN,P.Name,P.ProcType,TN);
- AddLn('');
- AddLn('begin');
- IncIndent;
- FN:=FieldPrefix+P.TheProperty.Name;
- D:=P.TheProperty.CustomData;
- if (D is EntityContainer)
- or (D is TEntitySet)
- {$IFNDEF USECSDL} OR (D is TSingleton){$ENDIF} then
- begin
- AddLn('If Not Assigned(%s) then',[FN]);
- IncIndent;
- if D is EntityContainer then
- AddLn('%s:=%s(CreateEntityContainer(%s));',[FN,TN,TN])
- {$IFNDEF USECSDL}
- else if D is TSIngleton then
- AddLn('%s:=Fetch%s;',[FN,P.TheProperty.Name])
- {$ENDIF}
- else if D is TEntitySet then
- AddLn('%s:=%s(CreateEntitySet(%s));',[FN,TN,TN]);
- DecIndent;
- end;
- AddLn('Result:=%s;',[FN]);
- DecIndent;
- AddLn('end;');
- AddLn('');
- end;
- procedure TEDMX2PasConverter.EmitCreateContainer(const CN: String;
- CC: TCreateContainer);
- Var
- TN : String;
- begin
- TN:=(CC.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
- AddLn('Function %s.%s : %s; ',[CN,CC.Name,TN]);
- SimpleMethodBody([ Format('Result:=%s(CreateEntityContainer(%s));',[TN,TN])]);
- end;
- procedure TEDMX2PasConverter.EmitCreateEntitySet(const CN: String;
- CE: TCreateEntitySet);
- Var
- TN : String;
- begin
- TN:=(CE.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
- AddLn('Function %s.%s : %s; ',[CN,CE.Name,TN]);
- SimpleMethodBody([ Format('Result:=%s(CreateEntitySet(%s));',[TN,TN])]);
- end;
- procedure TEDMX2PasConverter.EmitGetStream(const CN: String; G: TGetStream);
- Var
- S : String;
- I : Integer;
- begin
- EmitMethodHeader(CN,G.Name,G.ProcType,'');
- S:='';
- For i:=0 to G.ProcType.Args.Count-1 do
- begin
- If (S<>'') then
- S:=S+',';
- S:=S+TPasArgument(G.ProcType.Args[i]).Name;
- end;
- SimpleMethodBody([Format('DoGetStream(%s);',[S])]);
- end;
- procedure TEDMX2PasConverter.EmitMethodHeader(AClassName, AMethodName: String;
- PT: TPasProcedureType; RT: String);
- Var
- Args : TStrings;
- I : Integer;
- S : String;
- begin
- Args:=TStringList.Create;
- try
- Args.Clear;
- Addln('');
- PT.GetArguments(Args);
- S:='';
- For i:=0 to Args.Count-1 do
- S:=S+Args[i];
- If (RT<>'') then
- AddLn('Function %s.%s%s : %s; ',[AClassName,AMethodName,S,RT])
- else
- AddLn('Procedure %s.%s%s; ',[AClassName,AMethodName,S]);
- Addln('');
- finally
- Args.Free;
- end;
- end;
- {$IFNDEF USECSDL}
- procedure TEDMX2PasConverter.EmitMethodPath(PT: TPasProcedureType;
- MethodPath: String; GlobalService: Boolean);
- Var
- FirstIndex,I : Integer;
- AP : TPasArgument;
- KP : String;
- begin
- Addln('Var');
- IncIndent;
- AddLn('_Res : String;');
- AddLn('_Path : String;');
- DecIndent;
- Addln('begin');
- IncIndent;
- if GLobalService then
- AddLn('CheckService;');
- FirstIndex:=Ord(Not GlobalService);
- // 0 is service
- For I:=FirstIndex to PT.Args.Count-1 do
- begin
- AP:=TPasArgument(PT.Args[i]);
- KP:=ConvertTypeToStringExpr(AP.Name,AP.argType.Name);
- KP:=''''+TActionFunctionParameter(AP.CustomData).Name+'=''+'+KP; // Do not add spaces !!
- if I>FirstIndex then
- AddLn('_Path:=_Path+'',''+'+KP+';')
- else
- AddLn('_Path:='+KP+';');
- end;
- AddLn('_Path:=''(''+_Path+'')'';');
- AddLn('_Path:='''+MethodPath+'''+_Path;');
- if Not GlobalService then
- AddLn('_Path:=BaseURL(AService)+''/''+_Path;');
- end;
- procedure TEDMX2PasConverter.EmitFunctionCall(ServiceName, ReturnType: String;
- ResultType: TResultType);
- Var
- P : Integer;
- begin
- if (ServiceName<>'') then
- ServiceName:=ServiceName+'.';
- if ResultType=rtSimple then
- begin
- Addln('_Res:='+ServiceName+'ServiceCall(''GET'',_Path,'''');');
- ReturnType:=ConvertTypeToStringExpr('_Res',ReturnType);
- Addln('Result:='+ReturnType+';');
- end
- else
- begin
- // Somewhat of a shortcut, need to use ExtractBaseTypeName and ResolveType
- P:=Pos('array',LowerCase(ReturnType));
- if (P<>0) then
- Addln('Result:=%s('+ServiceName+'GetMulti(_Path,'''',%s,True,_Res));',[ReturnType,Copy(ReturnType,1,P-1)])
- else
- Addln('Result:=%s('+ServiceName+'SingleServiceCall(_Path,'''',%s));',[ReturnType,ReturnType])
- end;
- end;
- procedure TEDMX2PasConverter.EmitBoundFunction(CT: TPasClassType;
- ASchema: TSchema; Fun: TBoundFunction);
- Var
- CN,RT : String;
- ResultType : TResultType;
- begin
- RT:=TPasFunctionType(Fun.ProcType).ResultEl.ResultType.Name;
- if IsSimpleType(RT) then
- ResultType:=rtSimple
- else
- ResultType:=rtObject;
- CN:=CT.Name;
- EmitMethodHeader(CN,Fun.Name,Fun.ProcType,RT);
- // Does indent
- EmitMethodPath(Fun.ProcType,ASchema.NameSpace+'.'+Fun.Name,False);
- EmitFunctionCall('AService',RT,ResultType);
- Decindent;
- AddLn('end;');
- AddLn('');
- end;
- procedure TEDMX2PasConverter.EmitUnBoundFunction(CT: TPasClassType;
- Fun: TUnBoundFunction);
- Var
- CN,RTN : String;
- ResultType : TResultType;
- begin
- RTN:=TPasFunctionType(Fun.ProcType).ResultEl.ResultType.Name;
- if IsSimpleType(RTN) then
- ResultType:=rtSimple
- else
- ResultType:=rtObject;
- CN:=CT.Name;
- EmitMethodHeader(CN,Fun.Name,Fun.ProcType,RTN);
- // Does indent
- EmitMethodPath(Fun.ProcType,Fun.ExportPath,True);
- EmitFunctionCall('Service',RTN,ResultType);
- Decindent;
- AddLn('end;');
- AddLn('');
- end;
- procedure TEDMX2PasConverter.EmitPreparePostObject(Act: TPasProcedure;
- ActionPath: String; GlobalService, AllocateArray: Boolean);
- Var
- I : Integer;
- AP : TPasArgument;
- MN,ETN : String;
- HaveData : Boolean;
- AT : TResultType;
- begin
- HaveData:= Ord(Not GlobalService) < Act.ProcType.Args.Count;
- Addln('Var');
- IncIndent;
- if HaveData then
- AddLn('_JSON : TJSONObject;');
- if AllocateArray then
- begin
- AddLn('_ARR : TJSONArray;');
- AddLn('_res : String;');
- end;
- AddLn('_data : String;');
- AddLn('_Path : String;');
- DecIndent;
- Addln('begin');
- IncIndent;
- if GLobalService then
- AddLn('CheckService;');
- if Not HaveData then
- AddLn('_data:='''';')
- else
- begin
- AddLn('_JSON:=TJSONObject.Create;');
- AddLn('try');
- IncIndent;
- // 0 is service
- For I:=Ord(Not GlobalService) to Act.ProcType.Args.Count-1 do
- begin
- AP:=TPasArgument(Act.ProcType.Args[i]);
- MN:=TActionFunctionParameter(AP.CustomData).Name;
- AT:=GetResultType(AP.ArgType.Name,ETN);
- Case AT of
- rtSimple :
- AddLn('_JSON.Add(''%s'',%s);',[MN,AP.Name]);
- rtObject :
- AddLn('_JSON.Add(''%s'',%s.SaveToJSON);',[MN,AP.Name]);
- rtArraySimple:
- AddLn('_JSON.Add(''%s'',DynArrayToJSONArray(Pointer(%s),''%s'',Nil));',[MN,AP.Name,ETN]);
- rtArrayObject:
- AddLn('_JSON.Add(''%s'',DynArrayToJSONArray(Pointer(%s),'''',%s));',[MN,AP.Name,ETN,ETN]);
- end;
- end;
- AddLn('_data:=_JSON.AsJSON;');
- DecIndent;
- Addln('finally');
- IncIndent;
- AddLn('FreeAndNil(_JSON);');
- DecIndent;
- Addln('end;');
- end;
- if GlobalService then
- AddLn('_Path:=''/%s'';',[ActionPath])
- else
- AddLn('_Path:=BaseURL(AService)+''/%s'';',[ActionPath]);
- end;
- procedure TEDMX2PasConverter.EmitActionServiceCall(const AReturnType,
- AElementType: String; GlobalService: Boolean; ResultType: TResultType);
- var
- SN,KP : String;
- begin
- SN:='Service';
- If Not GlobalService then
- SN:='A'+SN;
- Case ResultType of
- rtNone:
- Addln(SN+'.ServiceCall(''POST'',_Path,'''',_Data);');
- rtSimple:
- begin
- Addln('_Res:='+SN+'.ServiceCall(''POST'',_Path,'''',_Data);');
- KP:=ConvertTypeToStringExpr('_Res',AReturnType);
- Addln('Result:='+KP+';');
- end;
- rtArraySimple,
- rtArrayObject:
- begin
- // Delete(AElementType,1,1);
- Addln('_Res:='+SN+'.ServiceCall(''POST'',_Path,'''',_Data);');
- Addln('_arr:=GetJSON(_res) as TJSONArray;');
- Addln('try');
- IncIndent;
- if ResultType=rtArraySimple then
- Addln('Result:=%s(JSONArrayToDynArray(_arr,''%s'',Nil));',[AReturnType,AElementType])
- else
- Addln('Result:=%s(JSONArrayToDynArray(_arr,'''',%s));',[AReturnType,AElementType]);
- DecIndent;
- Addln('finally');
- IncIndent;
- Addln('_arr.Free;');
- DecIndent;
- Addln('end');
- end;
- rtObject:
- Addln('Result:=%s(%s.SingleServiceCall(''POST'',_Path,'''',_data,%s));',[AReturnType,SN,AReturnType]);
- end;
- end;
- procedure TEDMX2PasConverter.EmitUnBoundAction(CT: TPasClassType; Act: TPasProcedure);
- Var
- ETN,APath,CN,RTN : String;
- ResultType : TResultType;
- begin
- if Act.ProcType is TPasFunctionType then
- RTN:=TPasFunctionType(Act.ProcType).ResultEl.ResultType.Name
- else
- RTN:='';
- ResultType:=GetResultType(RTN,ETN);
- CN:=CT.Name;
- EmitMethodHeader(CN,Act.Name,Act.ProcType,RTN);
- if (Act is TUnboundActionProc) then
- APath:=TUnboundActionProc(Act).ExportPath
- else
- APath:=TUnboundActionFunc(Act).ExportPath;
- EmitPreparePostObject(Act,APath,True,ResultType=rtArraySimple);
- EmitActionServiceCall(RTN,ETN,True,ResultType);
- Decindent;
- AddLn('end;');
- AddLn('');
- end;
- procedure TEDMX2PasConverter.EmitBoundAction(CT: TPasClassType;
- ASchema: TSchema; Act: TPasProcedure);
- Var
- AEN,CN,RTN : String;
- ResultType : TResultType;
- begin
- if Act.ProcType is TPasFunctionType then
- RTN:=TPasFunctionType(Act.ProcType).ResultEl.ResultType.Name
- else
- RTN:='';
- ResultType:=GetResultType(RTN,AEN);
- CN:=CT.Name;
- EmitMethodHeader(CN,Act.Name,Act.ProcType,RTN);
- EmitPreparePostObject(Act,ASchema.NameSpace+'.'+Act.Name,False,ResultType=rtArraySimple);
- EmitActionServiceCall(RTN,AEN,False,ResultType);
- Decindent;
- AddLn('end;');
- AddLn('');
- end;
- {$endif}
- procedure TEDMX2PasConverter.EmitSetStream(const CN: String; G: TSetStream);
- Var
- S : String;
- I : Integer;
- begin
- EmitMethodHeader(CN,G.Name,G.ProcType,'');
- S:='';
- For i:=0 to G.ProcType.Args.Count-1 do
- begin
- If (S<>'') then
- S:=S+',';
- S:=S+TPasArgument(G.ProcType.Args[i]).Name;
- end;
- SimpleMethodBody([Format('DoSetStream(%s);',[S])]);
- end;
- procedure TEDMX2PasConverter.EmitSetArrayLength(CT: TPasClassType;
- A: TSetArrayLength);
- Var
- I : integer;
- P : TPasProperty;
- begin
- Addln('{$IFDEF VER2_6}');
- EmitMethodHeader(CT.Name,A.Name,A.ProcType,'');
- Addln('begin');
- IncIndent;
- AddLn('Case aName of');
- for I:=0 to CT.Members.Count-1 do
- if TObject(CT.Members[i]) is TPasProperty then
- begin
- P:=TPasProperty(CT.Members[i]);
- if (Copy(P.VarType.Name ,Length(P.VarType.Name)-4,5)='Array') then
- begin
- Addln('''%s'' : SetLength(%s,aLength);',[LowerCase(P.Name),P.ReadAccessorName]);
- end;
- end;
- AddLn('else');
- incIndent;
- AddLn('inherited SetArrayLength(aName,ALength);');
- decIndent;
- AddLn('end;');
- decIndent;
- AddLn('end;');
- Addln('{$ENDIF VER2_6}');
- AddLn('');
- end;
- procedure TEDMX2PasConverter.EmitEntityClassFunction(CT: TPasClassType; ASchema: TSchema; CE: TEntityClassFunction);
- Var
- ES:TEntitySet;
- TN : String;
- P : TPasType;
- begin
- TN:=(CE.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
- ES:=CE.CustomData as TEntitySet;
- AddLn('Class Function %s.%s : %s; ',[CT.Name,CE.Name,TN]);
- P:=ResolveType(ASchema,ES.EntityType);
- try
- SimpleMethodBody([Format('Result:=%s;',[P.Name])]);
- finally
- P.Release;
- end;
- end;
- procedure TEDMX2PasConverter.EmitPropertySetter(const CN: String;
- P: TPropertySetter);
- Var
- FN: String;
- begin
- EmitMethodHeader(CN,P.Name,P.ProcType,'');
- FN:=FieldPrefix+P.TheProperty.Name;
- SimpleMethodBody([Format('If (%s=AValue) then exit;',[FN]),
- Format('%s:=AValue;',[FN]),
- 'MarkPropertyChanged(AIndex);']);
- end;
- procedure TEDMX2PasConverter.EmitObjectRestKind(CT: TPasClassType; R : TObjectRestKind);
- Var
- NN,CN : string;
- O : TObject;
- begin
- CN:=CT.Name;
- O:=CT.CustomData;
- NN:=GetNativeTypeName(O);
- Addln('');
- AddLn('Class Function %s.%s : String; ',[CN,R.Name]);
- SimpleMethodBody([Format('Result:=%s;',[MakePascalString(NN,True)])]);
- end;
- procedure TEDMX2PasConverter.EmitGetSingleton(CT: TPasClassType; S: TGetSingleTon);
- Var
- PN,TN,NN,CN : string;
- O : TObject;
- begin
- CN:=CT.Name;
- O:=S.CustomData;
- NN:=GetNativeTypeName(O);
- TN:=(S.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
- Addln('');
- AddLn('Function %s.%s : %s; ',[CN,S.Name,TN]);
- PN:=MakePascalString(NN,True);
- SimpleMethodBody(['CheckService;',
- Format('Result:=%s(Service.SingleServiceCall(%s,'''',%s));',[TN,PN,TN]),
- Format('Result.BasePath:=%s;',[PN])]);
- end;
- procedure TEDMX2PasConverter.EmitGetKeyAsURLPart(CT: TPasClassType;
- ASchema: TSchema; P: TKeyAsURLPart);
- Var
- CN,KP : String;
- EK : TEntityKeyElement;
- I : integer;
- EP : TEntityProperty;
- T : TPasType;
- begin
- CN:=CT.Name;
- EK:=P.CustomData as TEntityKeyElement;
- Addln('');
- AddLn('Function %s.KeyAsURLPart : string;',[CN]);
- Addln('');
- Addln('begin');
- IncIndent;
- For I:=0 to EK.Length-1 do
- begin
- EP:=FindProperty(CT,EK[i].Name);
- T:=ResolveType(ASchema,EP._Type);
- KP:=ConvertTypeToStringExpr(CleanPropertyName(EK[i].Name,ekwNone),T.Name);
- T.Release;
- if I>0 then
- AddLn('Result:=Result+'',''+'+KP+';')
- else
- AddLn('Result:='+KP+';');
- end;
- Decindent;
- Addln('end;');
- Addln('');
- end;
- procedure TEDMX2PasConverter.EmitExportPropertyName(CT: TPasClassType; E : TExportPropertyName);
- Var
- PN,CN : String;
- P : TPasProperty;
- D : TObject;
- I : integer;
- begin
- CN:=CT.Name;
- Addln('');
- AddLn('Class Function %s.%s(Const AName : String) :String;',[CN,E.Name]);
- Addln('');
- AddLn('begin');
- IncIndent;
- AddLn('Case AName of');
- for I:=0 to CT.Members.Count-1 do
- if TObject(CT.Members[i]).InheritsFrom(TPasProperty) then
- begin
- P:=TPasProperty(CT.Members[i]);
- D:=P.CustomData;
- if D is TEntityProperty then
- PN:=WTOA(TEntityProperty(D).Name)
- else if D is TComplexTypeProperty then
- PN:=WTOA(TComplexTypeProperty(D).Name)
- else if D=Nil then
- Raise EEDMX2PasConverter.CreateFmt('Unrecognized property type for %d %s.%s : NIL',[I,CN,P.Name])
- else
- Raise EEDMX2PasConverter.CreateFmt('Unrecognized property type for %d %s.%s : NIL',[I,CN,P.Name,D.ClassName]);
- if (CompareText(PN,P.Name)<>0) then
- AddLn('''%s'' : Result:=''%s'';',[P.Name,PN]);
- end;
- AddLn('else');
- IncIndent;
- AddLn('Result:=Inherited ExportPropertyName(AName);');
- DecIndent;
- AddLn('end;');
- DecIndent;
- AddLn('end;');
- Addln('');
- end;
- procedure TEDMX2PasConverter.EmitClassImplementation(ID: TIDentifier);
- Var
- CN : String;
- I : Integer;
- E : TPasElement;
- CT : TPasClassType;
- begin
- CN:=ID.Element.Name;
- DoLog('Generating class implementation for %s',[CN]);
- ClassHeader(CN);
- CT:=ID.Element as TPasClassType;
- for I:=0 to CT.Members.Count-1 do
- begin
- E:=TPasElement(CT.Members[i]);
- If E is TPropertySetter then
- EmitPropertySetter(CN,E as TPropertySetter)
- else if E is TPropertyGetter then
- EmitPropertyGetter(CN,E as TPropertyGetter)
- else if E is TCreateContainer then
- EmitCreateContainer(CN,E as TCreateContainer)
- else if E is TCreateEntitySet then
- EmitCreateEntitySet(CN,E as TCreateEntitySet)
- else If E is TObjectRestKind then
- EmitObjectRestKind(CT,E as TObjectRestKind)
- else If E is TGetSingleton then
- EmitGetSingleTon(CT,E as TGetSingleton)
- else If E is TENtityClassFunction then
- EmitEntityClassFunction(CT,ID.Schema,E as TENtityClassFunction)
- else If E is TExportPropertyName then
- EmitExportPropertyName(CT,E As TExportPropertyName)
- else If E is TGetNavigationProperty then
- EmitNavigationProperty(CT,E as TGetNavigationProperty)
- else If E is TGetContainedSingleton then
- EmitGetContainedSingleton(CT,E as TGetContainedSingleton)
- else If E is TKeyAsURLPart then
- EmitGetKeyAsURLPart(CT,ID.Schema,E as TKeyAsURLPart)
- else If E is TGetStream then
- EmitGetStream(CN,E as TGetStream)
- else If E is TSetStream then
- EmitSetStream(CN,E as TSetStream)
- else If E is TSetArrayLength then
- EmitSetArrayLength(CT,E as TSetArrayLength)
- {$IFNDEF USECSDL}
- else If E is TUnBoundFunction then
- EmitUnBoundFunction(CT,E as TUnBoundFunction)
- else If E is TBoundFunction then
- EmitBoundFunction(CT,ID.Schema,E as TBoundFunction)
- else If (E is TUnBoundActionProc) or (E is TUnBoundActionFunc) then
- EmitUnBoundAction(CT,E as TPasProcedure)
- else If (E is TBoundActionProc) or (E is TBoundActionFunc) then
- EmitBoundAction(CT,ID.Schema,E as TPasProcedure)
- {$ENDIF }
- else If E is TEntityMethod then
- EmitEntityMethod(CT,E As TEntityMethod);
- end;
- end;
- procedure TEDMX2PasConverter.EmitGetContainedSingleton(CT: TPasClassType; E: TGetContainedSingleton);
- Var
- CN,TN,PN : String;
- begin
- CN:=CT.Name;
- TN:=(E.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
- PN:=WTOA((E.CustomData as TNavigationProperty).Name);
- EmitMethodHeader(CN,E.Name,E.ProcType,TN);
- SimpleMethodBody([Format('Result:=%s(GetContainedSingleTon(AService,''%s'', %s));',[TN,PN,TN])]);
- end;
- procedure TEDMX2PasConverter.EmitNavigationProperty(CT : TPasClassType; E : TGetNavigationProperty);
- Var
- CN,TN,PN : String;
- begin
- CN:=CT.Name;
- TN:=(E.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
- PN:=WTOA((E.CustomData as TNavigationProperty).Name);
- EmitMethodHeader(CN,E.Name,E.ProcType,TN);
- SimpleMethodBody([Format('Result:=%s(CreateContainedEntitySet(AService,''%s'', %s));',[TN,PN,TN])]);
- end;
- procedure TEDMX2PasConverter.EmitEntityMethod(CT : TPasClassType; E : TEntityMethod);
- begin
- if E is TEntityGet then
- EmitEntityGet(CT,E as TEntityGet)
- else if E is TEntityList then
- EmitEntityList(CT,E as TEntityList);
- end;
- procedure TEDMX2PasConverter.EmitEntityGet(CT : TPasClassType; E : TEntityGet);
- Var
- CN,TN,S,SV,AN : String;
- I : integer;
- Arg : TPasArgument;
- begin
- CN:=CT.Name;
- TN:=(E.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
- EmitMethodHeader(CN,E.Name,E.ProcType,TN);
- S:='';
- For I:=0 to E.ProcType.Args.Count-1 do
- begin
- Arg:=TPasArgument(E.ProcType.Args[i]);
- AN:=Arg.Name;
- SV:=AN;
- SV:=ConvertTypeToStringExpr(AN,Arg.ArgType.Name);
- if (S<>'') then
- S:=S+'+'',''+';
- S:=S+SV;
- end;
- if S='' then
- S:='''''';
- SimpleMethodBody([ Format('Result:=%s(GetSingle(%s));',[TN,S])]);
- end;
- procedure TEDMX2PasConverter.EmitEntityList(CT: TPasClassType; E: TEntityList);
- Var
- CN,TN: String;
- isListAll : Boolean;
- F,NL : String;
- begin
- isListAll:=E is TEntityListAll;
- CN:=CT.Name;
- TN:=(E.ProcType as TPasFunctionType).ResultEl.ResultType.Name;
- EmitMethodHeader(CN,E.Name,E.ProcType,TN);
- if isListAll then
- begin
- AddLn('var N : String;');
- NL:='N';
- F:='True';
- end
- else
- begin
- NL:='NextLink';
- F:='False';
- end;
- SimpleMethodBody([Format('Result:=%s(GetMulti(AQuery,%s,%s));',[TN,F,NL])]);
- end;
- procedure TEDMX2PasConverter.EmitForwardDeclaration;
- Var
- CN : String;
- I : Integer;
- ID : TIdentifier;
- begin
- For I:=0 to FIdentifierList.Count-1 do
- begin
- ID:=FIdentifierList[i] as TIdentifier;
- If ID.Element.InheritsFrom(TPasClassType) then
- begin
- CN:=ID.Element.Name;
- AddLn('%s = class;',[CN]);
- AddLn('%sArray = Array of %s;',[CN,CN]);
- end;
- end;
- end;
- procedure TEDMX2PasConverter.EmitInterface;
- begin
- Addln('type');
- IncIndent;
- Comment(' Needed for binary data');
- Addln('TByteArray = Array of byte;');
- Addln('TInt16Array = Array of SmallInt;');
- Comment('');
- EmitForwardDeclaration;
- Comment('');
- EmitEnumTypes;
- EmitClassDeclarations;
- DecIndent;
- end;
- class function TEDMX2PasConverter.ODataVersion: TODataVersion;
- begin
- {$IFDEF USECSDL}
- Result:=oDataV2;
- {$ELSE}
- Result:=ODataV4;
- {$ENDIF USECSDL}
- end;
- procedure TEDMX2PasConverter.EmitEnumTypes;
- Var
- Id : TIdentifier;
- PE : TPasEnumType;
- I : integer;
- begin
- AddLn('');
- Comment(' Enumerations');
- AddLn('');
- if EnumerationMode=emScoped then
- AddLn('{$SCOPEDENUMS ON}');
- For I:=0 to FIdentifierList.Count-1 do
- begin
- Id:=TIdentifier(FIdentifierList[i]);
- if ID.Element.InheritsFrom(TPasEnumType) then
- begin
- PE:=ID.Element as TPasEnumType;
- AddLn(PE.GetDeclaration(True)+';');
- AddLn(PE.Name+'Array = Array of '+PE.Name+';');
- end;
- end;
- end;
- procedure TEDMX2PasConverter.AnalyseXML;
- Const
- EdmxScopeOld ='http://schemas.microsoft.com/ado/2007/06/edmx';
- DataservicesScopeOld ='http://schemas.microsoft.com/ado/2007/06/edmx';
- EdmxScopeNew ='http://docs.oasis-open.org/odata/ns/edmx';
- DataservicesScopeNew ='http://docs.oasis-open.org/odata/ns/edm';
- Var
- F : IXMLFormatter;
- Count : Integer;
- i : Integer;
- ScopeName :String;
- ASchema : TSchema;
- EdmxScope,
- DataservicesScope: String;
- begin
- F:=TXmlFormatter.Create();
- f.LoadFromStream(FXml);
- f.PrepareForRead();
- if ODataVersion=ODataV2 then
- begin
- EdmxScope:=EdmxScopeOld;
- DataservicesScope:=DataservicesScopeOld;
- end
- else
- begin
- EdmxScope:=EdmxScopeNew;
- DataservicesScope:=DataservicesScopeNew;
- end;
- if (f.BeginScopeRead('Edmx',EdmxScope) <= 0) then
- Raise EEDMX2PasConverter.Create('Not a valid Edmx XML document');
- Count:=f.BeginScopeRead('DataServices',EdmxScope );
- if Count<=0 then
- Raise EEDMX2PasConverter.Create('No DataServices found');
- ScopeName:=DataservicesScope;
- Count:=f.BeginArrayRead(ScopeName,TypeInfo(Schema),asEmbeded,'Schema');
- if Count<=0 then
- Raise EEDMX2PasConverter.Create('No schema found');
- for i := 0 to Count-1 do
- begin
- ASchema:=TSchema.Create();
- FSchemaList.Add(ASchema);
- end;
- for i := 0 to Count-1 do
- begin
- ASchema:=TSchema(FSchemaList[i]);
- if Not f.Get(TypeInfo(TSchema),ScopeName,ASchema) then
- Raise EEDMX2PasConverter.CreateFmt('Schema[%d] not found',[i]);
- DoLog('Found schema : %s',[ASchema.Namespace]);
- end;
- end;
- function TEDMX2PasConverter.GetNameSpace(ASchema: TSchema): String;
- begin
- Result:=WTOA(Aschema.Namespace);
- If Aliases.IndexOfName(Result)<>-1 then
- Result:=Aliases.Values[Result];
- end;
- function TEDMX2PasConverter.CreateIdentifierName(ASchema: TSchema;
- const APrefix, AName: String): String;
- Var
- N : String;
- begin
- Result:='T'+APrefix+ServiceSuffix+CleanPropertyName(AName,ekwNone);
- N:=LowerCase(GetNameSpace(ASchema)+'.'+AName);
- IdentifierMap.Add(N+'='+Result);
- // Add array as wel, for collection.
- IdentifierMap.Add('collection('+N+')='+Result+'Array');
- end;
- function TEDMX2PasConverter.CreateIdentifierName(ASchema: TSchema;
- const APrefix, AName: UnicodeString): String;
- begin
- Result:=CreateIdentifierName(ASchema,WTOA(APrefix),WTOA(AName));
- end;
- function TEDMX2PasConverter.CreateIdentifierName(ASchema: TSchema;
- const APrefix: String; AName: UnicodeString): String;
- begin
- Result:=CreateIdentifierName(ASchema,APrefix,WTOA(AName));
- end;
- function TEDMX2PasConverter.NeedWriteSetter(P: TComplexTypeProperty): Boolean;
- begin
- Result:=(P<>Nil)
- end;
- function TEDMX2PasConverter.ResolveNameSpace(ASchema: TSchema; ATypeName: String
- ): String;
- Const
- SCollection = 'Collection(';
- LCollection = Length(SCollection);
- Var
- NS : String;
- IsColl : Boolean;
- L : Integer;
- begin
- Result:=ATypeName;
- NS:=GetNameSpace(Aschema);
- if NS=ASchema.Namespace then
- exit;
- IsColl:=Copy(Result,1,LCollection)=SCollection;
- if IsColl then
- Delete(Result,1,LCollection);
- L:=Length(ASchema.Namespace);
- if (Copy(Result,1,L)=ASchema.Namespace) then
- begin
- Delete(Result,1,L);
- Result:=NS+Result;
- end;
- if isColl then
- Result:=SCollection+Result;
- end;
- function TEDMX2PasConverter.ResolveType(ASchema: TSchema;
- const ATypeName: String): TPasType;
- Var
- CN,RN : String;
- begin
- CN:=IdentifierMap.Values[LowerCase(ATypeName)];
- if (CN='') then
- begin
- RN:=ResolveNameSpace(ASchema,ATypeName);
- if RN<>ATypeName then
- CN:=IdentifierMap.Values[LowerCase(RN)]
- else
- begin
- RN:=GetNameSpace(ASchema)+'.'+ATypeName;
- CN:=IdentifierMap.Values[LowerCase(RN)];
- end;
- end;
- if (CN='') then
- Raise EEDMX2PasConverter.CreateFmt('Could not resolve Type %s (Schema: %s)',[ATypeName,ASchema.NameSpace]);
- Result:=TPasUnresolvedSymbolRef.Create(CN,Nil);
- end;
- function TEDMX2PasConverter.ResolveType(ASchema: TSchema;
- const ATypeName: UnicodeString): TPasType;
- begin
- Result:=ResolveType(ASchema,WTOA(ATypeName));
- end;
- function TEDMX2PasConverter.CreatePropertyGetter(AParent: TPasElement;
- PN: String; indexed: Boolean; T: TPasType): TPropertyGetter;
- Var
- PA : TPasArgument;
- GN : String;
- F : TPasFunctionType;
- begin
- GN:='Get'+PN;
- Result:=TPropertyGetter.Create(GN,AParent);
- Result.Visibility:=visPrivate;
- F:=TPasFunctionType.Create('',Result);
- Result.ProcType:=F;
- if Indexed then
- begin
- // AIndex
- PA:=TPasArgument.Create('AIndex',Result.ProcType);
- PA.ArgType:=TPasUnresolvedTypeRef.Create('Integer',PA);
- Result.ProcType.Args.Add(PA);
- end;
- // Result
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=T;
- end;
- function TEDMX2PasConverter.CreatePropertySetter(AParent: TPasElement;
- PN: String; indexed: Boolean; T: TPasType): TPropertySetter;
- Var
- PA : TPasArgument;
- SN : String;
- begin
- SN:='Set'+PN;
- Result:=TPropertySetter.Create(SN,AParent);
- Result.Visibility:=visPrivate;
- Result.ProcType:=TPasProcedureType.Create('',Result);
- if Indexed then
- begin
- // AIndex
- PA:=TPasArgument.Create('AIndex',Result.ProcType);
- PA.ArgType:=TPasUnresolvedTypeRef.Create('Integer',PA);
- Result.ProcType.Args.Add(PA);
- end;
- // Actual argument
- PA:=TPasArgument.Create('AValue',Result.ProcType);
- PA.ArgType:=T;
- PA.Access:=argConst;
- Result.ProcType.Args.Add(PA);
- end;
- function TEDMX2PasConverter.UseExtraIdentifierProtection(D: TObject
- ): TExtraKeywords;
- begin
- result:=ekwNone;
- if Assigned(D) then
- begin
- if D is EntityContainer then
- result:=ekwEntityContainer;
- if D is TEntitySet then
- Result:=ekwEntitySet
- else if D is TEntityType then
- Result:=ekwEntity
- else if D is TComplexType then
- Result:=ekwObject
- end;
- end;
- function TEDMX2PasConverter.AddProperty(ID: TIdentifier;
- APropertyIndex: integer; const APropertyName, APropertyType: String;
- Flags: TPropertyFlags; ACustomData: TObject): Boolean;
- Var
- PP : TPasProperty;
- PS : TPropertySetter;
- PG : TPropertyGetter;
- PV : TPasVariable;
- GN,SN,PN : String;
- T : TPasType;
- C : TPasClassType;
- begin
- DoLog('Adding property [%d] %s : %s',[APropertyIndex,APropertyName,APropertyType]);
- C:=ID.Element as TPasClassType;
- // Construct property.
- PN:=CleanPropertyName(APropertyName,UseExtraIdentifierProtection(C.CustomData));
- Result:=CompareText(PN,APropertyName)<>0;
- PG:=NIl;
- PS:=Nil;
- // Field
- PV:=TPasVariable.Create(FieldPrefix+PN,C);
- T:=ResolveType(ID.Schema,APropertyType);
- PS:=Nil;
- PV.VarType:=T;
- PV.Visibility:=visPrivate;
- C.Members.Add(PV);
- // Getter, if needed
- if Not (pfNeedGetter in Flags) then
- GN:=FieldPRefix+PN
- else
- begin
- T.AddRef;
- PG:=CreatePropertyGetter(C,PN,pfIndexed in flags,T);
- C.Members.Add(PG);
- GN:=PG.Name;
- end;
- if not (pfReadOnly in Flags) then
- begin
- if Not (pfNeedSetter in Flags) then // Setter, if needed
- SN:=FieldPRefix+PN
- else
- begin
- T.AddRef;
- PS:=CreatePropertySetter(C,PN,pfIndexed in flags,T);
- C.Members.Add(PS);
- SN:=PS.Name;
- end;
- end;
- // And finally, the actual property
- PP:=TPasProperty.Create(PN,C);
- PP.CustomData:=ACustomData;
- PP.ReadAccessorName:=GN;
- PP.WriteAccessorName:=SN;
- PP.Visibility:=visPublished;
- PP.VarType:=T;
- If (pfindexed in Flags) then
- begin
- PP.IndexExpr:=TPrimitiveExpr.Create(PP,pekNumber,eopNone);
- TPrimitiveExpr(PP.IndexExpr).Value:=IntToStr(APropertyIndex shl IndexShift);
- end;
- if Assigned(PS) then
- PS.TheProperty:=PP;
- if Assigned(PG) then
- PG.TheProperty:=PP;
- T.AddRef;
- C.Members.Add(PP);
- end;
- procedure TEDMX2PasConverter.AddExportPropertyName(ID: TIdentifier);
- Var
- PC : TPasClassType;
- E : TExportPropertyName;
- F : TPasFunctionType;
- PA : TPasArgument;
- begin
- // Class Function ExportPropertyName(Const AName : String) : string; virtual;
- PC:=ID.Element as TPasClassType;
- E:=TExportPropertyName.Create('ExportPropertyName',PC);
- E.Modifiers:=[pmOverride];
- E.Visibility:=visPublic;
- F:=TPasFunctionType.Create('ExportPropertyName',E);
- E.ProcType:=F;
- // Actual argument
- PA:=TPasArgument.Create('AName',F);
- PA.ArgType:=TPasUnresolvedTypeRef.Create('String',PA);
- PA.Access:=argConst;
- F.Args.Add(PA);
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=TPasUnresolvedTypeRef.Create('String',F.ResultEl);
- PC.Members.Add(E);
- end;
- procedure TEDMX2PasConverter.CompleteComplexType(ID: TIdentifier);
- Var
- P : TComplexTypeProperty;
- I : Integer;
- C : TPasClassType;
- CT : TComplexType;
- Flags : TPropertyFlags;
- isArray,HaveArray,B : Boolean;
- PropertyIndexOffset : Integer;
- PE : TPasType;
- {$IFNDEF USECSDL }
- PID : TIdentifier;
- {$ENDIF}
- begin
- B:=False;
- C:=ID.Element as TPasClassType;
- CT:=ID.Element.CustomData as TComplexType;
- {$IFNDEF USECSDL }
- if (CT.BaseType<>'') then
- begin
- PID:=FindIdentifier(Nil,CT.BaseType);
- if PID=NIl then
- Raise EEDMX2PasConverter.CreateFmt('Could not resolve parent type for entity type %s',[CT.Name]);
- PE:=PID.Element as TPasClassType;
- PropertyIndexOffset:=CountProperties(PE as TPasClassType);
- PE.AddRef;
- end
- else
- {$ENDIF}
- begin
- PE:=TPasUnresolvedTypeRef.Create(BaseEntityType,Nil);
- PropertyIndexOffset:=0;
- end;
- HaveArray:=False;
- C.AncestorType:=PE;
- B:=False;
- For I:=0 to CT._Property.Length-1 do
- begin
- P:=CT._Property[i];
- Flags:=[pfNeedSetter,pfIndexed];
- if not P.Nullable then
- Include(Flags,pfRequired);
- if P._Type='' then
- Raise EEDMX2PasConverter.CreateFmt('Identity type %s: No type for property: %s',[CT.Name,P.Name]);
- // Construct property.
- ExtractBaseTypeName(ID.Schema,P._Type,isArray);
- haveArray:=haveArray or isArray;
- B:=AddProperty(ID,PropertyIndexOffset+I,WTOA(P.Name),WTOA(P._Type),Flags,P) or B;
- end;
- if haveArray then
- AddSetArrayLength(ID);
- If B then
- AddExportPropertyName(ID);
- end;
- procedure TEDMX2PasConverter.CompleteEntityType(ID: TIdentifier);
- Var
- P : TEntityProperty;
- I,J : Integer;
- C : TPasClassType;
- CT : TEntityType;
- Flags : TPropertyFlags;
- PID : TIdentifier;
- PE : TPasType;
- PropertyIndexOffset : Integer;
- Key : TEntityKeyElement;
- B,isArray,HaveArray : Boolean;
- begin
- C:=ID.Element as TPasClassType;
- CT:=ID.Element.CustomData as TEntityType;
- if (CT.BaseType='') then
- begin
- PE:=TPasUnresolvedTypeRef.Create(BaseEntityType,Nil);
- PropertyIndexOffset:=0;
- end
- else
- begin
- PID:=FindIdentifier(Nil,CT.BaseType);
- if PID=NIl then
- Raise EEDMX2PasConverter.CreateFmt('Could not resolve parent type for entity type %s',[CT.Name]);
- PE:=PID.Element as TPasClassType;
- PropertyIndexOffset:=CountProperties(PE as TPasClassType);
- PE.AddRef;
- end;
- HaveArray:=False;
- C.AncestorType:=PE;
- B:=False;
- For I:=0 to CT._Property.Length-1 do
- begin
- P:=CT._Property[i];
- if (PE is TPasClassType) then
- if FindProperty(PE as TPasClassType,P.Name)<>Nil then
- continue;
- Flags:=[pfIndexed,pfNeedSetter];
- if not P.Nullable then
- Include(Flags,pfRequired);
- {$IFDEF USECSDL}
- if Assigned(CT.Key) then
- for J:=0 to CT.Key.Length-1 do
- if (CT.Key.Item[J].Name=P.Name) then
- Include(Flags,pfInKey);
- {$ELSE}
- if Assigned(CT.Key) and (CT.Key.Length=1) then
- for J:=0 to CT.Key.Item[0].Length-1 do
- if (CT.Key.Item[0].Item[J].Name=P.Name) then
- Include(Flags,pfInKey);
- {$ENDIF}
- // Construct property.
- if P._Type='' then
- Raise EEDMX2PasConverter.CreateFmt('Identity type %s: No type for property: %s',[CT.Name,P.Name]);
- ExtractBaseTypeName(ID.Schema,P._Type,isArray);
- haveArray:=haveArray or isArray;
- B:=AddProperty(ID,PropertyIndexOffset+I,WTOA(P.Name),WTOA(P._Type),Flags,P) or B;
- end;
- if haveArray then
- AddSetArrayLength(ID);
- if B then
- AddExportPropertyName(ID);
- Key:=Nil;
- if Assigned(CT.Key) then
- {$IFDEF USECSDL}
- if (CT.Key.Length>0) then
- Key:=CT.Key;
- {$ELSE}
- if (CT.Key.Length=1) then
- if (CT.Key.Item[0].Length>0) then
- Key:=CT.Key.Item[0];
- {$ENDIF}
- if Assigned(Key) then
- AddGetKeyAsURLPart(ID,Key);
- For I:=0 to CT.NavigationProperty.Length-1 do
- AddNavigationproperty(ID,CT.NavigationProperty[i]);
- {$IFNDEF USECSDL}
- if CT.HasStream then
- begin
- AddGetStream(ID);
- AddSetStream(ID);
- end;
- {$ENDIF}
- end;
- function TEDMX2PasConverter.AddGetStream(ID: TIDentifier): TGetStream;
- Var
- C : TPasClassType;
- F : TPasProcedureType;
- A : TPasArgument;
- begin
- C:=ID.Element as TPasClassType;
- Result:=TGetStream.Create('GetStream',C);
- C.Members.Add(Result);
- F:=TPasProcedureType.Create('GetStream',Result);
- Result.ProcType:=F;
- Result.Visibility:=visPublic;
- // Service argument
- A:=TPasArgument.Create('AService',F);
- A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
- F.Args.Add(A);
- // ContentType argument
- A:=TPasArgument.Create('AContentType',F);
- A.ArgType:=TPasUnresolvedTypeRef.Create('String',A);
- F.Args.Add(A);
- // Stream into which to copy the data.
- A:=TPasArgument.Create('AStream',F);
- A.ArgType:=TPasUnresolvedTypeRef.Create('TStream',A);
- F.Args.Add(A);
- end;
- function TEDMX2PasConverter.AddSetStream(ID: TIDentifier): TSetStream;
- Var
- C : TPasClassType;
- F : TPasProcedureType;
- A : TPasArgument;
- begin
- C:=ID.Element as TPasClassType;
- Result:=TSetStream.Create('SetStream',C);
- C.Members.Add(Result);
- F:=TPasProcedureType.Create('SetStream',Result);
- Result.ProcType:=F;
- Result.Visibility:=visPublic;
- // Service argument
- A:=TPasArgument.Create('AService',F);
- A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
- F.Args.Add(A);
- // ContentType argument
- A:=TPasArgument.Create('AContentType',F);
- A.ArgType:=TPasUnresolvedTypeRef.Create('String',A);
- F.Args.Add(A);
- // Stream into which to copy the data.
- A:=TPasArgument.Create('AStream',F);
- A.ArgType:=TPasUnresolvedTypeRef.Create('TStream',A);
- F.Args.Add(A);
- end;
- function TEDMX2PasConverter.AddGetKeyAsURLPart(ID: TIdentifier;
- Key: TEntityKeyElement): TPasFunction;
- Var
- C : TPasClassType;
- F : TPasFunctionType;
- begin
- C:=ID.Element as TPasClassType;
- Result:=TKeyAsURLPart.Create('KeyAsURLPart',C);
- Result.Visibility:=visPublic;
- Result.CustomData:=Key;
- F:=TPasFunctionType.Create('KeyAsURLPart',Result);
- Result.ProcType:=F;
- Result.Modifiers:=[pmOverride];
- // Result type
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=TPasUnresolvedTypeRef.Create('String',F.ResultEl);
- C.Members.Add(Result);
- end;
- {$IFDEF USECSDL}
- Function TEDMX2PasConverter.FindAssociatedTypeInSchema(ASchema : TSchema; Const ARelation,ARole : String) : String;
- Var
- I,J : integer;
- A : TAssociation;
- begin
- Result:='';
- I:=ASchema.Association.Length-1;
- While (Result='') and (I>=0) do
- begin
- A:=ASchema.Association[i];
- If (ASchema.NameSpace+'.'+A.Name=ARelation) then
- begin
- J:=A._End.Length-1;
- While (Result='') and (J>=0) do
- begin
- If A._End[j].Role=ARole then
- Result:=WTOA(A._End[j]._Type);
- Dec(J);
- end;
- end;
- Dec(I);
- end;
- end;
- Function TEDMX2PasConverter.FindAssociatedType(Var APreferredSchema : TSchema; Const ARelation,ARole : String) : String;
- Var
- i : Integer;
- S : TSchema;
- begin
- Result:=FindAssociatedTypeInSchema(APreferredSchema,ARelation,ARole);
- if (Result='') then
- begin
- I:=0;
- While (Result='') and (I<FSchemaList.Count) do
- begin
- S:=TSchema(FSchemaList[i]);
- if S<>APreferredSchema then
- begin
- Result:=FindAssociatedTypeInSchema(S,ARelation,ARole);
- If Result<>'' then
- APreferredSchema:=S;
- end;
- Inc(I);
- end;
- end;
- If (Result='') then
- Raise EEDMX2PasConverter.CreateFmt('Could not determine type of relation "%s", role "%s"',[ARelation,ARole]);
- end;
- {$ENDIF}
- function TEDMX2PasConverter.AddNavigationProperty(ID: TIDentifier;
- P: TNavigationProperty): TPasFunction;
- Var
- C : TPasClassType;
- F : TPasFunctionType;
- A : TPasArgument;
- ResType : TPasType;
- ATS : TSchema;
- BTN,TN,NP : String;
- ESI : TIDentifier;
- IsColl : Boolean;
- begin
- C:=ID.Element as TPasClassType;
- NP:=CleanPropertyName(P.Name,UseExtraIdentifierProtection(C.CustomData));
- ATS:=ID.Schema; // Schema of associated type
- {$IFNDEF USECSDL}
- TN:=WTOA(P._Type);
- ATS:=ID.Schema;
- {$ELSE}
- TN:=FindAssociatedType(ATS,WTOA(P.Relationship),WTOA(P.ToRole));
- {$ENDIF}
- BTN:=ExtractBaseTypeName(ID.Schema,TN,isColl);
- if Not IsColl then
- begin
- DoLog('Adding singleton navigation property %s (%s) : %s',[P.Name,NP,BTN]);
- Result:=TGetContainedSingleton.Create(NP,C);
- ResType:=ResolveType(ID.Schema,BTN);
- end
- else
- begin
- ESI:=FindEntitySetForEntity(ID.Schema,BTN);
- if (ESI = Nil) then
- Raise EEDMX2PasConverter.CreateFmt('Could not find navigation property %s : %s entity set.',[P.Name,TN]);
- DoLog('Adding navigation property %s (%s) : %s',[P.Name,NP,ESI.Element.Name]);
- Result:=TGetNavigationProperty.Create(NP,C);
- ResType:=ESI.Element as TPasClassType;
- ResType.AddRef;
- end;
- Result.Visibility:=visPublic;
- Result.CustomData:=P;
- F:=TPasFunctionType.Create(NP,Result);
- Result.ProcType:=F;
- // Service argument
- A:=TPasArgument.Create('AService',F);
- A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
- F.Args.Add(A);
- // Result type
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResType;
- C.Members.Add(Result);
- end;
- function TEDMX2PasConverter.FindEntitySetForEntity(ASchema: TSchema;
- AName: String): TIdentifier;
- Var
- I,C : Integer;
- S : String;
- ES : TEntitySet;
- begin
- if Pos('.',AName)<>0 then
- S:=AName
- else if Assigned(ASchema) then
- S:=WTOA(ASchema.Namespace)+'.'+AName
- else
- S:=AName;
- I:=0;
- C:=FIdentifierList.Count;
- Result:=Nil;
- While (I<C) and (Result=Nil) do
- begin
- Result:=TIdentifier(FIdentifierList[i]);
- if Not (Result.Element.CustomData is TEntitySet) then
- Result:=Nil
- else
- begin
- ES:=Result.Element.CustomData as TEntitySet;
- // Writeln('Comparing ',TIdentifier(FIdentifierList[i]).IdentifierName,'=',S,' ?');
- If CompareText(WTOA(ES.EntityType),S)<>0 then
- Result:=Nil;
- end;
- Inc(I);
- end;
- end;
- function TEDMX2PasConverter.FindQualifiedIdentifier(AName: String): TIdentifier;
- begin
- Result:=Nil;
- Result:=TIdentifier(FIdentifierHash.Items[LowerCase(AName)]);
- end;
- function TEDMX2PasConverter.FindIdentifier(ASchema: TSchema; AName: String
- ): TIdentifier;
- Var
- I : Integer;
- S : String;
- begin
- Result:=Nil;
- I:=0;
- if Pos('.',AName)<>0 then
- Result:=FindQualifiedIdentifier(AName);
- if Not Assigned(ASchema) then
- begin
- While (Result=Nil) and (I<FSchemaList.Count) do
- begin
- Result:=FindIdentifier(TSchema(FSchemaList[i]),AName);
- Inc(i);
- end;
- Exit;
- end;
- // Writeln('Searching namespace : ',ASchema.NameSpace,' for ',AName);
- S:=WTOA(ASchema.Namespace)+'.'+AName;
- Result:=FindQualifiedIdentifier(S);
- end;
- function TEDMX2PasConverter.FindIdentifier(ASchema: TSchema;
- AName: UnicodeString): TIdentifier;
- begin
- Result:=FindIdentifier(ASchema,WTOA(AName));
- end;
- function TEDMX2PasConverter.FindProperty(C: TPasClassType; APropertyName: String
- ): TEntityProperty;
- Var
- I : Integer;
- ET : TEntityType;
- begin
- Result:=Nil;
- Repeat
- ET:=C.CustomData as TEntityType;
- I:=ET._Property.Length-1;
- While (I>=0) and (Result=Nil) do
- begin
- if CompareText(WTOA(ET._Property[i].Name),APropertyName)=0 then
- Result:=ET._Property[i];
- Dec(i);
- end;
- if C.AncestorType is TPasClassType then
- C:=C.AncestorType as TPasClassType
- else
- C:=Nil;
- until (Result<>Nil) or (C=nil);
- end;
- function TEDMX2PasConverter.FindProperty(C: TPasClassType;
- APropertyName: UnicodeString): TEntityProperty;
- begin
- Result:=FindProperty(C,WTOA(APropertyName));
- end;
- function TEDMX2PasConverter.GetEntityKey(C: TPasClassType
- ): TEntityType_KeyArray;
- Var
- ET : TEntityType;
- begin
- Result:=Nil;
- Repeat
- // Writeln('Finding key of ',C.Name,' (',C.CustomData.ClassName,')');
- ET:=C.CustomData as TEntityType;
- Result:=ET.Key;
- if Result.Length=0 then
- Result:=Nil;
- if C.AncestorType is TPasClassType then
- C:=C.AncestorType as TPasClassType
- else
- C:=Nil;
- until (Result<>Nil) or (C=Nil);
- end;
- procedure TEDMX2PasConverter.AddEntityGet(ID, EID: TIdentifier);
- Var
- FN : String;
- F : TPasFunctionType;
- C : TPasClassType;
- EM : TEntityMethod;
- ES : TEntitySet;
- PA : TPasArgument;
- I : Integer;
- AN : String;
- EP : TEntityProperty;
- AKey : TEntityType_KeyArray;
- begin
- C:=ID.Element as TPasClassType;
- ES:=C.CustomData as TEntitySet;
- // Get function
- FN:='Get';
- EM:=TEntityGet.Create(FN,C);
- EM.CustomData:=ES;
- EM.Visibility:=visPublic;
- F:=TPasFunctionType.Create(FN,EM);
- // Construct arguments based on key, if available
- AKey:=GetEntityKey(EID.Element as TPasClassType);
- if Assigned(AKey) then
- begin
- for I:=0 to AKey.Length-1 do
- begin
- {$IFDEF USECSDL}
- AN:=WTOA(AKey.Item[I].Name);
- {$ELSE}
- if AKey.Item[i].Length>0 then
- AN:=WTOA(AKey.Item[I].Item[0].Name)
- else
- Raise EEDMX2PasConverter.CreateFmt('Empty key definition for %s type of entityset %s',[ES.EntityType,ES.Name]);
- {$ENDIF}
- PA:=TPasArgument.Create(CleanPropertyName(AN,ekwEntitySet),F);
- EP:=FindProperty(EID.Element as TPasClassType,AN);
- if Assigned(EP) then
- PA.ArgType:=ResolveType(ID.Schema,EP._Type)
- else
- PA.ArgType:=TPasUnresolvedTypeRef.Create('String',PA);
- PA.Access:=argConst;
- {$IFDEF USECSDL}
- PA.CustomData:=AKey.Item[I];
- {$ELSE}
- PA.CustomData:=AKey.Item[I].Item[0];
- {$ENDIF}
- F.Args.Add(PA);
- end;
- end
- else
- begin
- // Fake string argument
- PA:=TPasArgument.Create('AKey',F);
- PA.ArgType:=TPasUnresolvedTypeRef.Create('String',PA);
- PA.Access:=argConst;
- F.Args.Add(PA);
- end;
- EM.ProcType:=F;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ID.Schema,ES.EntityType);
- C.Members.Add(EM);
- end;
- procedure TEDMX2PasConverter.AddEntityList(ID: TIdentifier;
- ArgType: String; ListAll: Boolean);
- Var
- FN : String;
- F : TPasFunctionType;
- C : TPasClassType;
- EM : TEntityMethod;
- ES : TEntitySet;
- PA : TPasArgument;
- begin
- C:=ID.Element as TPasClassType;
- ES:=C.CustomData as TEntitySet;
- // List function, string version
- if ListAll then
- begin
- FN:='ListAll';
- EM:=TEntityListAll.Create(FN,C);
- end
- else
- begin
- FN:='List';
- EM:=TEntityList.Create(FN,C);
- end;
- EM.CustomData:=ES;
- EM.Visibility:=visPublic;
- F:=TPasFunctionType.Create(FN,EM);
- // Query argument (String or TQueryParam)
- PA:=TPasArgument.Create('AQuery',F);
- PA.ArgType:=TPasUnresolvedTypeRef.Create(ArgType,PA);
- PA.Access:=argConst;
- F.Args.Add(PA);
- if not ListAll then
- begin
- PA:=TPasArgument.Create('NextLink',F);
- PA.ArgType:=TPasUnresolvedTypeRef.Create('String',PA);
- PA.Access:=argOut;
- F.Args.Add(PA);
- end;
- EM.ProcType:=F;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ID.Schema,'Collection('+ES.EntityType+')');
- C.Members.Add(EM);
- end;
- procedure TEDMX2PasConverter.CompleteEntitySet(ID: TIdentifier);
- Var
- FN : String;
- EC : TEntityClassFunction;
- F : TPasFunctionType;
- C : TPasClassType;
- ES : TEntitySet;
- EID : TIDentifier;
- Multi : Boolean;
- begin
- C:=ID.Element as TPasClassType;
- ES:=C.CustomData as TEntitySet;
- Multi:=Not (ES is TImplicitEntitySet);
- If Not Multi then
- Multi:=TImplicitEntitySet(ES).IsColl;
- // Class function
- FN:='EntityClass';
- EC:=TEntityClassFunction.Create(FN,C);
- EC.CustomData:=ES;
- EC.Visibility:=visPublic;
- F:=TPasFunctionType.Create(FN,EC);
- EC.ProcType:=F;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=TPasUnresolvedTypeRef.Create('TODataEntityClass',F.ResultEl);
- EC.Modifiers:=[pmOverride];
- C.Members.Add(EC);
- EID:=FindIdentifier(Nil,ES.EntityType);// Qualified name
- if EID=Nil then
- Raise EEDMX2PasConverter.CreateFmt('Cannot find type definition %s for entityset %s, to add getter',[ES.EntityType,ES.Name]);
- AddEntityGet(ID,EID);
- if Multi then
- begin
- // List function, string version
- AddEntityList(ID,'String',False);
- AddEntityList(ID,'TQueryParams',False);
- // ListAll
- AddEntityList(ID,'String',True);
- AddEntityList(ID,'TQueryParams',True);
- end;
- end;
- procedure TEDMX2PasConverter.EntityContainerToIdentifiers(ASchema : TSchema; EC : EntityContainer);
- Var
- I : Integer;
- ONS,NS, CN, SchemaPrefix : String;
- P : TPasType;
- ES : TEntitySet;
- EID : TIdentifier;
- begin
- ONS:='"'+WTOA(ASchema.Namespace)+'"';
- NS:=GetNameSpace(ASchema);
- if NS<>ONS then
- ONS:=ONS+' as "'+NS+'"';
- SchemaPrefix:=FlattenName(NS);
- For i:=0 to EC.EntitySet.Length-1 do
- begin
- ES:=EC.EntitySet.Item[I];
- CN:=CreateIdentifierName(ASchema,SchemaPrefix,ES.Name+'EntitySet');
- P:=TEntitySetClass.Create(CN,Nil);
- P.CustomData:=ES;
- DoLog('Converting entity set (Schema %s, EntitySet: %s) to %s',[ONS,ES.Name,CN]);
- AddIdentifier(ASchema.Namespace+'.'+ES.Name+'.EntitySet',ASchema,P);
- EID:=Nil;
- EID:=FindIdentifier(Nil,ES.EntityType);// Qualified name
- if EID=Nil then
- Raise EEDMX2PasConverter.CreateFmt('Cannot find type definition %s for entityset %s to mark as identify set',[ES.EntityType,ES.Name]);
- EID.IsEntitySet:=True;
- end;
- end;
- procedure TEDMX2PasConverter.SchemaToIdentifiers;
- Var
- I,J : Integer;
- CN,SchemaPrefix : String;
- ASchema : TSchema;
- CT : TComplexType;
- ENUT : TEnumType;
- ET : TEntityType;
- EC : EntityContainer;
- B : Boolean;
- ONS,NS : String;
- P : TPasType;
- begin
- For I:=0 to FSchemaList.Count-1 do
- begin
- ASchema:=TSchema(FSchemaList[i]);
- ONS:='"'+WTOA(ASchema.NameSpace)+'"';
- DoLog('Converting Schema %s, pass 1, enums, complex and entitytypes',[ONS]);
- NS:=GetNameSpace(ASchema);
- if NS<>ONS then
- ONS:=ONS+' as "'+NS+'"';
- // Writeln('Examining ',NS);
- SchemaPrefix:=FlattenName(NS);
- For J:=0 to ASchema.EnumType.Length-1 do
- begin
- ENUT:=ASchema.EnumType.Item[J];
- CN:=CreateIdentifierName(ASchema,SchemaPrefix,ENUT.Name);
- P:=TPasEnumType.Create(CN,Nil);
- P.CustomData:=ENUT;
- AddIdentifier(ASchema.NameSpace+'.'+ENut.Name,ASchema,P);
- end;
- For J:=0 to ASchema.ComplexType.Length-1 do
- begin
- CT:=ASchema.ComplexType.Item[J];
- CN:=CreateIdentifierName(ASchema,SchemaPrefix,CT.Name);
- DoLog('Converting complex type (Schema %s, ComplexType: %s) to %s',[ONS,CT.Name,CN]);
- P:=TComplexClass.Create(CN,Nil);
- P.CustomData:=CT;
- AddIdentifier(ASchema.NameSpace+'.'+CT.Name,ASchema,P);
- end;
- For J:=0 to ASchema.EntityType.Length-1 do
- begin
- ET:=ASchema.EntityType.Item[J];
- CN:=CreateIdentifierName(ASchema,SchemaPrefix,WTOA(ET.Name));
- DoLog('Converted entity type (Schema: %s, EntityType: %s) to %s',[ONS,ET.Name,CN]);
- P:=TEntityClass.Create(CN,Nil);
- P.CustomData:=ET;
- AddIdentifier(ASchema.NameSpace+'.'+ET.Name,ASchema,P);
- end;
- end;
- For I:=0 to FSchemaList.Count-1 do
- begin
- ASchema:=TSchema(FSchemaList[i]);
- DoLog('Converting Schema %s, pass 2, containers,entitytypes, Navigation properties',[ONS]);
- NS:=GetNameSpace(ASchema);
- // Writeln('Examining ',NS);
- SchemaPrefix:=FlattenName(NS);
- {$IFDEF USECSDL}
- EC:=ASchema.EntityContainer;
- if Assigned(EC) and (EC.Name<>'') then
- begin
- CN:=CreateIdentifierName(ASchema,SchemaPrefix,WTOA(EC.Name));
- DoLog('Converted entity container (Schema: %s, EntityContainer: %s) to %s',[ONS,EC.Name,CN]);
- P:=TEntityContainerClass.Create(CN,Nil);
- P.CustomData:=EC;
- AddIdentifier(ASchema.NameSpace+'.'+EC.Name,ASchema,P);
- EntityContainerToIdentifiers(ASchema,EC);
- end;
- {$ELSE}
- For J:=0 to ASchema.EntityContainer.Length-1 do
- begin
- EC:=ASchema.EntityContainer.Item[j];
- CN:=CreateIdentifierName(ASchema,SchemaPrefix,EC.Name);
- DoLog('Converted entity container (Schema: %s", EntityContainer: %s) to %s',[ONS,EC.Name,CN]);
- P:=TEntityContainerClass.Create(CN,Nil);
- P.CustomData:=EC;
- AddIdentifier(ASchema.NameSpace+'.'+EC.Name,ASchema,P);
- EntityContainerToIdentifiers(ASchema,EC);
- end;
- {$ENDIF}
- // Extra loop: Implicit entity sets for contained entities
- For J:=0 to ASchema.EntityType.Length-1 do
- CheckNavigationPropertyEntity(ASchema,ASchema.EntityType[J]);
- {$IFNDEF USECSDL}
- For J:=0 to ASchema._Function.Length-1 do
- if ASchema._Function[J].isBound then
- CheckBoundFunction(ASchema,ASchema._Function[J]);
- For J:=0 to ASchema.Action.Length-1 do
- if ASchema.Action[J].isBound then
- CheckBoundAction(ASchema,ASchema.Action[J]);
- {$ENDIF USECSDL}
- end;
- For I:=0 to FSchemaList.Count-1 do
- begin
- ASchema:=TSchema(FSchemaList[i]);
- {$IFDEF USECSDL}
- B:=Assigned(ASchema.EntityContainer) and (ASchema.EntityContainer.Name<>'');
- {$ELSE}
- B:=ASchema.EntityContainer.Length>0;
- {$ENDIF}
- if B then
- begin
- // Add service.
- CN:='T'+FlattenName(GetNameSpace(ASchema))+'Service';
- DoLog('Service name : %s',[CN]);
- P:=TServiceClass.Create(CN,Nil);
- P.CustomData:=ASchema;
- AddIdentifier(ASchema.Namespace,ASchema,P);
- end;
- end;
- end;
- procedure TEDMX2PasConverter.AddIdentifier(AIDentifier: TIdentifier);
- begin
- //Writeln('Adding identifier : ',AIdentifier.IdentifierName);
- FIdentifierList.add(AIDentifier);
- FIdentifierHash.Add(LowerCase(AIDentifier.IdentifierName),AIdentifier);
- end;
- function TEDMX2PasConverter.AddIdentifier(const AName: String;
- ASchema: TSchema; El: TPasElement): TIdentifier;
- begin
- Result:=TIdentifier.Create(AName,ASchema,El);
- AddIdentifier(Result);
- end;
- function TEDMX2PasConverter.AddIdentifier(const AName: UnicodeString;
- ASchema: TSchema; El: TPasElement): TIdentifier;
- begin
- Result:=AddIdentifier(WTOA(ANAme),ASchema,El);
- end;
- {$IFNDEF USECSDL}
- function TEDMX2PasConverter.CheckBoundFunction(ASchema: TSchema; Fun: TFunction
- ): TPasFunction;
- Var
- I : Integer;
- FID : TIdentifier;
- CT : TPasClassType;
- F : TPasFunctionType;
- A : TPasArgument;
- FN : String;
- UEIP : TExtraKeyWords;
- begin
- DoLog('Bound function: %s ',[Fun.Name]);
- If Fun.Parameter.Length=0 then
- Raise EEDMX2PasConverter.CreateFmt('Error in EDMX : Bound function %s without parameters',[Fun.Name]);
- FID:=FindIdentifier(Nil,Fun.Parameter[0]._Type);
- If (FID=Nil) then
- Raise EEDMX2PasConverter.CreateFmt('Could not find type %s for bound function %s',[Fun.Parameter[0]._Type,Fun.Name]);
- CT:=FID.Element as TPasClassType;
- UEIP:=UseExtraIdentifierProtection(CT.CustomData);
- FN:=CleanPropertyName(Fun.Name,UEIP);
- Result:=TBoundFunction.Create(FN,CT);
- Result.visibility:=visPublic;
- Result.CustomData:=Fun;
- F:=TPasFunctionType.Create(FN,Result);
- Result.ProcType:=F;
- CT.Members.Add(Result);
- A:=TPasArgument.Create('AService',F);
- F.Args.Add(A);
- A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
- For I:=1 to Fun.Parameter.Length-1 do
- begin
- A:=TPasArgument.Create(CleanPropertyName(Fun.Parameter[I].Name,UEIP),F);
- F.Args.Add(A);
- A.ArgType:=ResolveType(ASchema,Fun.Parameter[i]._Type);
- A.CustomData:=Fun.Parameter[i];
- end;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ASchema,Fun.ReturnType._Type);
- end;
- function TEDMX2PasConverter.CheckBoundAction(ASchema: TSchema; Act: TAction
- ): TPasProcedure;
- Var
- I : Integer;
- FID : TIdentifier;
- CT : TPasClassType;
- HasResult : Boolean;
- F : TPasFunctionType;
- P : TPasProcedureType;
- A : TPasArgument;
- UEIP : TExtraKeywords;
- AN : String;
- begin
- DoLog('Adding Bound Action: %s ',[Act.Name]);
- If Act.Parameter.Length=0 then
- Raise EEDMX2PasConverter.CreateFmt('Error in EDMX : Bound action %s without parameters',[Act.Name]);
- FID:=FindIdentifier(Nil,WTOA(Act.Parameter[0]._Type));
- If (FID=Nil) then
- Raise EEDMX2PasConverter.CreateFmt('Could not find type %s for bound action %s',[Act.Parameter[0]._Type,Act.Name]);
- CT:=FID.Element as TPasClassType;
- UEIP:=UseExtraIdentifierProtection(CT.CustomData);
- AN:=CleanPropertyName(Act.Name,UEIP);
- HasResult:=Assigned(Act.ReturnType) and (Act.ReturnType._Type<>'');
- if HasResult then
- begin
- Result:=TBoundActionFunc.Create(AN,CT);
- F:=TPasFunctionType.Create(AN,Result);
- P:=F;
- end
- else
- begin
- Result:=TBoundActionProc.Create(AN,CT);
- F:=Nil;
- P:=TPasProcedureType.Create(AN,Result);
- end;
- Result.visibility:=visPublic;
- Result.CustomData:=Act;
- Result.ProcType:=P;
- CT.Members.Add(Result);
- A:=TPasArgument.Create('AService',P);
- P.Args.Add(A);
- A.ArgType:=TPasUnresolvedTypeRef.Create('TODataService',A);
- For I:=1 to Act.Parameter.Length-1 do
- begin
- A:=TPasArgument.Create(CleanPropertyName(WTOA(Act.Parameter[I].Name),UEIP),P);
- P.Args.Add(A);
- A.ArgType:=ResolveType(ASchema,Act.Parameter[i]._Type);
- A.CustomData:=Act.Parameter[i];
- end;
- if HasResult then
- begin
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ASchema,Act.ReturnType._Type);
- end;
- end;
- {$ENDIF}
- function TEDMX2PasConverter.ExtractBaseTypeName(ASchema: TSchema;
- ATypeName: String; out IsColl: Boolean): String;
- Const
- SCollection = 'Collection(';
- LCollection = Length(SCollection);
- Var
- L : Integer;
- begin
- Result:=ATypeName;
- IsColl:=Copy(Result,1,LCollection)=SCollection;
- if IsColl then
- begin
- Delete(Result,1,LCollection);
- Delete(Result,Length(Result),1);
- end;
- L:=Length(ASchema.Namespace);
- if (Copy(Result,1,L)=ASchema.Namespace) then
- Delete(Result,1,L+1);
- end;
- function TEDMX2PasConverter.ExtractBaseTypeName(ASchema: TSchema;
- ATypeName: UnicodeString; out IsColl: Boolean): String;
- begin
- Result:=ExtractBaseTypeName(ASchema,WTOA(ATypeName),isColl);
- end;
- procedure TEDMX2PasConverter.CheckNavigationPropertyEntity(ASchema: TSchema;
- AEntity: TEntityType);
- Var
- i : integer;
- NP : TNavigationProperty;
- BTN,SchemaPrefix,ONS,NS,ESN,CN,TN : String;
- ESI : TIDentifier;
- P : TEntitySetClass;
- IsColl : Boolean;
- ES : TImplicitEntitySet;
- ATS : TSchema;
- begin
- ONS:='"'+WTOA(ASchema.NameSpace)+'"';
- NS:=GetNameSpace(ASchema);
- if NS<>ONS then
- ONS:=ONS+' as "'+NS+'"';
- SchemaPrefix:=FlattenName(NS);
- For I:=0 to AEntity.NavigationProperty.Length-1 do
- begin
- ATS:=ASchema;
- NP:=AEntity.NavigationProperty[i];
- // Writeln('Schema ',ASchema.NameSpace,' type ',AEntity.Name,', Investigating ',I,' : ',NP.Name);
- {$IFNDEF USECSDL}
- TN:=WTOA(NP._Type);
- {$ELSE}
- TN:=FindAssociatedType(ATS,WTOA(NP.Relationship),WTOA(NP.ToRole));
- {$ENDIF}
- BTN:=ExtractBaseTypeName(ATS,TN,isColl);
- ESI:=FindEntitySetForEntity(ATS,BTN);
- If (ESI=Nil) then
- begin
- ESN:=BTN+'ImplicitEntitySet';
- CN:=CreateIdentifierName(ATS,SchemaPrefix,ESN);
- P:=TEntitySetClass.Create(CN,Nil);
- ES:=TImplicitEntitySet.Create(NP,WTOA(ATS.NameSpace)+'.'+BTN,isColl);
- FFreeObjects.Add(ES);
- ES.Name:=ESN;
- P.CustomData:=ES;
- 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]);
- AddIdentifier(NS+'.'+ESN,ATS,P);
- end;
- end;
- end;
- procedure TEDMX2PasConverter.CompleteEnumerator(ID: TIdentifier);
- Var
- I : integer;
- PE : TPasEnumType;
- PV : TPasEnumValue;
- XE : TEnumType;
- XM : TEnumTypeMember;
- EN : String;
- begin
- PE:=ID.Element as TPasEnumType;
- XE:=PE.CustomData as TEnumType;
- For I:=0 to XE.Member.Length-1 do
- begin
- XM:=XE.Member[I];
- EN:=WTOA(XM.Name);
- if EnumerationMode = emPrefixTypeName then
- EN:=PE.Name+'_'+EN;
- PV:=TPasEnumValue.Create(EN,PE);
- PE.Values.Add(PV);
- end;
- end;
- procedure TEDMX2PasConverter.GenerateBaseClass(ID: TIDentifier);
- Var
- PC : TPAsClassType;
- K : TObjectRestKind;
- F : TPasFunctionType;
- begin
- PC:=ID.Element as TPasClassType;
- K:=TObjectRestKind.Create('ObjectRestKind',PC);
- K.Modifiers:=[pmOverride];
- F:=TPasFunctionType.Create('ObjectRestKind',K);
- K.ProcType:=F;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=TPasUnresolvedTypeRef.Create('String',F);
- K.Visibility:=visPublic;
- PC.Members.Add(K);
- end;
- procedure TEDMX2PasConverter.CompleteIdentifiers;
- Var
- I : Integer;
- Id : TIdentifier;
- El : TPasElement;
- begin
- For I:=0 to FIdentifierList.Count-1 do
- begin
- Id:=FIdentifierList[i] as TIdentifier;
- El:=Id.Element;
- if Assigned(EL) then
- begin
- DoLog('Completing identifier %d : %s',[I,EL.Name]);
- if El.InheritsFrom(TPasEnumType) then
- CompleteEnumerator(ID);
- if El.InheritsFrom(TPasClassType) then
- begin
- GenerateBaseClass(ID);
- if El.CustomData.InheritsFrom(EntityContainer) then
- CompleteContainer(ID)
- else if El.CustomData.InheritsFrom(TComplexType) then
- CompleteComplexType(ID)
- else if El.CustomData.InheritsFrom(TEntityType) then
- CompleteEntityType(ID)
- end;
- end;
- end;
- For I:=0 to FIdentifierList.Count-1 do
- begin
- Id:=FIdentifierList[i] as TIdentifier;
- El:=Id.Element;
- if Assigned(EL) then
- begin
- DoLog('Completing identifier %d : %s',[I,EL.Name]);
- if El.CustomData.InheritsFrom(TEntitySet) then
- CompleteEntitySet(ID)
- else if El.CustomData.InheritsFrom(TSchema) then
- CompleteSchema(ID);
- end;
- end;
- DoLog('Done completing identifiers');
- end;
- procedure TEDMX2PasConverter.LoadFromStream(const AStream: TStream);
- begin
- FXML.CopyFrom(AStream,0);
- FXML.Position:=0;
- end;
- procedure TEDMX2PasConverter.AddContainerToSchema(ID: TIdentifier;
- AIndex: Integer; E: EntityContainer);
- Var
- F : TPasFunctionType;
- CC : TCreateContainer;
- CN,FN : string;
- ST : TPasClassType;
- begin
- CN:=CleanPropertyName(E.Name,ekwService);
- // Creator function
- ST:=ID.Element as TPasClassType;
- FN:='CreateNew'+CN;
- CC:=TCreateContainer.Create(FN,ST);
- CC.Visibility:=visPublic;
- F:=TPasFunctionType.Create(FN,CC);
- CC.ProcType:=F;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ST.CustomData as TSchema,E.Name);
- ST.Members.Add(CC);
- // Property
- AddProperty(ID,AIndex,CN,WTOA(E.Name),[pfNeedGetter,pfNeedSetter,pfReadOnly],E);
- end;
- procedure TEDMX2PasConverter.CompleteSchema(ID : TIdentifier);
- Var
- C : TPasClassType;
- ASchema : TSchema;
- EC : EntityContainer;
- {$IFNDEF USECSDL}
- I : Integer;
- {$ENDIF}
- begin
- C:=ID.Element as TPasClassType;
- ASchema:=C.CustomData as TSchema;
- {$IFDEF USECSDL}
- EC:=ASchema.EntityContainer;
- if Assigned(EC) then
- AddContainerToSchema(ID,0,EC);
- {$ELSE}
- For I:=0 to ASchema.EntityContainer.Length-1 do
- begin
- EC:=ASchema.EntityContainer.Item[I];
- AddContainerToSchema(ID,I,EC);
- end;
- {$ENDIF}
- end;
- procedure TEDMX2PasConverter.AddEntitySet(ID: TIDentifier; ES: TEntitySet;
- AIndex: Integer);
- Var
- C : TPasClassType;
- F : TPasFunctionType;
- CC : TCreateEntitySet;
- EN,FN : string;
- begin
- C:=ID.Element as TPasClassType;
- EN:=CleanPropertyName(ES.Name,ekwEntityContainer);
- // Creator function
- FN:='CreateNew'+EN;
- CC:=TCreateEntitySet.Create(FN,C);
- CC.Visibility:=visPublic;
- F:=TPasFunctionType.Create(FN,CC);
- CC.ProcType:=F;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ID.Schema,EN+'EntitySet');
- C.Members.Add(CC);
- // Property
- AddProperty(ID,AIndex,EN,EN+'EntitySet',[pfNeedGetter,pfReadOnly],ES);
- end;
- {$IFNDEF USECSDL}
- procedure TEDMX2PasConverter.AddSingleTon(ID: TIDentifier; S : TSingleton; AIndex : integer);
- Var
- C : TPasClassType;
- GS : TGetSingleton;
- SN,FN : string;
- F: TPasFunctionType;
- begin
- C:=ID.Element as TPasClassType;
- // Writeln('Examining ',NS);
- SN:=CleanPropertyName(S.Name,UseExtraIdentifierProtection(C.CustomData));
- FN:='Fetch'+SN;
- GS:=TGetSingleton.Create(FN,C);
- GS.Visibility:=visPublic;
- GS.CustomData:=S;
- F:=TPasFunctionType.Create(FN,GS);
- GS.ProcType:=F;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ID.Schema,S._type);
- C.Members.Add(GS);
- AddProperty(ID,Aindex,S.Name,S._type,[pfNeedGetter,pfReadOnly],S);
- end;
- {$ENDIF}
- procedure TEDMX2PasConverter.CompleteContainer(ID : TIdentifier);
- Var
- C : TPasClassType;
- CT : EntityContainer;
- I : integer;
- begin
- C:=ID.Element as TPasClassType;
- CT:=ID.Element.CustomData as EntityContainer;
- C.AncestorType:=TPasUnresolvedTypeRef.Create(BaseEntityContainerType,Nil);
- for I:=0 to CT.EntitySet.Length-1 do
- AddEntitySet(ID,CT.EntitySet[i],I);
- {$IFNDEF USECSDL}
- for I:=0 to CT.Singleton.Length-1 do
- AddSingleton(ID,CT.Singleton[i],I);
- For i:=0 to CT.ActionImport.Length-1 do
- AddImportAction(ID,CT.ActionImport[I],i);
- {$ENDIF}
- For i:=0 to CT.FunctionImport.Length-1 do
- AddImportFunction(ID,CT.FunctionImport[I]);
- end;
- procedure TEDMX2PasConverter.AddSetArrayLength(ID: TIdentifier);
- Var
- CT : TPasClassType;
- P : TPasProcedureType;
- A : TPasArgument;
- SAR : TSetArrayLength;
- begin
- DoLog('Adding AddSetArrayLength for class %s',[ID.Element.Name]);
- CT:=ID.Element as TPasClassType;
- // Procedure SetArrayLength(const AName : String; ALength : Longint); virtual;
- SAR:=TSetArrayLength.Create('SetArrayLength',CT);
- SAR.visibility:=visProtected;
- SAR.CustomData:=CT.CustomData;
- P:=TPasProcedureType.Create('SetArrayLength',SAR);
- SAR.ProcType:=P;
- SAR.Modifiers:=[pmOverride];
- CT.Members.Add(SAR);
- // Arguments: AName: String
- A:=TPasArgument.Create('AName',P);
- A.Access:=argConst;
- P.Args.Add(A);
- A.ArgType:=TPasUnresolvedTypeRef.Create('String',A);
- // Arguments: ALength : Longint;
- A:=TPasArgument.Create('ALength',P);
- P.Args.Add(A);
- A.ArgType:=TPasUnresolvedTypeRef.Create('Longint',A);
- end;
- {$IFDEF USECSDL}
- procedure TEDMX2PasConverter.AddImportFunction(ID : TIdentifier; AFun : TFunctionImport);
- begin
- // Just some code to make the compiler happy
- if Not (Assigned(ID) and Assigned(AFun)) then
- exit
- end;
- {$ELSE}
- function TEDMX2PasConverter.AddUnboundFunction(ID: TIdentifier; APath: String;
- Fun: TFunction; AIndex: Integer): TPasFunction;
- Var
- I : Integer;
- CT : TPasClassType;
- F : TPasFunctionType;
- A : TPasArgument;
- UEIP : TExtraKeywords;
- FN : String;
- begin
- DoLog('Adding Unbound function [%d]: %s ',[AIndex,Fun.Name]);
- CT:=ID.Element as TPasClassType;
- UEIP:=UseExtraIdentifierProtection(CT.CustomData);
- FN:=CleanPropertyName(Fun.Name,UEIP);
- Result:=TUnBoundFunction.Create(FN,CT);
- TUnBoundFunction(Result).ExportPath:=APath;
- Result.visibility:=visPublic;
- Result.CustomData:=Fun;
- F:=TPasFunctionType.Create(FN,Result);
- Result.ProcType:=F;
- CT.Members.Add(Result);
- For I:=0 to Fun.Parameter.Length-1 do
- begin
- A:=TPasArgument.Create(CleanPropertyName(WTOA(Fun.Parameter[I].Name),UEIP),F);
- F.Args.Add(A);
- A.ArgType:=ResolveType(ID.Schema,Fun.Parameter[i]._Type);
- A.CustomData:=Fun.Parameter[i];
- end;
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ID.Schema,Fun.ReturnType._Type);
- end;
- function TEDMX2PasConverter.AddUnboundAction(ID: TIdentifier; APath: String;
- Act: TAction; AIndex: integer): TPasProcedure;
- Var
- I : Integer;
- CT : TPasClassType;
- F : TPasFunctionType;
- P : TPasProcedureType;
- A : TPasArgument;
- HasResult : Boolean;
- UEIP : TExtraKeywords;
- AN : String;
- begin
- DoLog('Adding Unbound Action [%d]: %s ',[AIndex,Act.Name]);
- CT:=ID.Element as TPasClassType;
- UEIP:=UseExtraIdentifierProtection(CT.CustomData);
- AN:=CleanPropertyName(Act.Name,UEIP);
- HasResult:=Assigned(Act.ReturnType) and (Act.ReturnType._Type<>'');
- if HasResult then
- begin
- Result:=TUnBoundActionFunc.Create(AN,CT);
- TUnBoundActionFunc(Result).ExportPath:=APath;
- F:=TPasFunctionType.Create(AN,Result);
- P:=F;
- end
- else
- begin
- Result:=TUnBoundActionProc.Create(AN,CT);
- TUnBoundActionProc(Result).ExportPath:=APath;
- F:=Nil;
- P:=TPasProcedureType.Create(AN,Result);
- end;
- Result.visibility:=visPublic;
- Result.CustomData:=Act;
- Result.ProcType:=P;
- CT.Members.Add(Result);
- For I:=0 to Act.Parameter.Length-1 do
- begin
- A:=TPasArgument.Create(AN,F);
- F.Args.Add(A);
- A.ArgType:=ResolveType(ID.Schema,Act.Parameter[i]._Type);
- A.CustomData:=Act.Parameter[i];
- end;
- If Assigned(F) then
- begin
- F.ResultEl:=TPasResultElement.Create('Result',F);
- F.ResultEl.ResultType:=ResolveType(ID.Schema,Act.ReturnType._Type);
- end;
- end;
- procedure TEDMX2PasConverter.AddImportFunction(ID : TIdentifier; AFun : TFunctionImport);
- Var
- I : Integer;
- L : TFPList;
- begin
- L:=TFPList.Create;
- try
- For I:=0 to ID.Schema._Function.Length-1 do
- if (ID.Schema.Namespace+'.'+ID.Schema._Function[i].Name=AFun._Function) then
- L.Add(ID.Schema._Function[i]);
- if L.Count=0 then
- Raise EEDMX2PasConverter.CreateFmt('No function name %s found for importfunction %s',[AFun._Function,AFun.Name]);
- For I:=0 to L.Count-1 do
- AddUnBoundFunction(ID,AFun.Name,TFunction(L[i]),I);
- finally
- L.Free;
- end;
- end;
- procedure TEDMX2PasConverter.AddImportAction(ID : TIdentifier; Act : TActionImport; AIndex : Integer);
- Var
- I : Integer;
- L : TFPList;
- begin
- L:=TFPList.Create;
- try
- For I:=0 to ID.Schema.action.Length-1 do
- if (ID.Schema.Namespace+'.'+ID.Schema.action[i].Name=Act.Action) then
- L.Add(ID.Schema.Action[i]);
- if L.Count=0 then
- Raise EEDMX2PasConverter.CreateFmt('No Action name %s found for importaction %d: %s',[Act.Action,AIndex, Act.Name]);
- For I:=0 to L.Count-1 do
- AddUnBoundAction(ID,Act.Name,TAction(L[i]),I);
- finally
- L.Free;
- end;
- end;
- {$ENDIF}
- procedure TEDMX2PasConverter.EmitImplementation;
- Var
- ID : TIdentifier;
- I : integer;
- begin
- For I:=0 to FIdentifierList.Count-1 do
- begin
- ID:=TIdentifier(FIdentifierList[I]);
- If ID.Element is TPasClasstype then
- EmitClassImplementation(ID);
- end;
- end;
- procedure TEDMX2PasConverter.Execute;
- begin
- AnalyseXML;
- RegisterBaseTypes;
- SchemaToIdentifiers;
- CompleteIdentifiers;
- Source.Clear;
- Addln('unit '+OutputUnitName+';');
- CreateHeader;
- EmitOptions;
- EmitInterface;
- AddLn('');
- AddLn('implementation');
- AddLn('');
- EmitImplementation;
- AddLn('end.');
- DoLog('All done');
- end;
- end.
|