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