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