From aa2c670376ee08b5ec7d95ae570c885fa705d298 Mon Sep 17 00:00:00 2001 From: skalogryz Date: Mon, 10 Nov 2014 02:30:09 +0000 Subject: [PATCH] iphonelazext: adding pbx file-xcode project sources git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3713 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/iphonelazext/pbx/pbxcontainer.pas | 752 ++++++++++++++++++ components/iphonelazext/pbx/pbxfile.pas | 715 +++++++++++++++++ .../iphonelazext/pbx/test/pbxreader.lpi | 74 ++ .../iphonelazext/pbx/test/pbxreader.lpr | 273 +++++++ components/iphonelazext/pbx/xcodeproj.pas | 577 ++++++++++++++ 5 files changed, 2391 insertions(+) create mode 100644 components/iphonelazext/pbx/pbxcontainer.pas create mode 100644 components/iphonelazext/pbx/pbxfile.pas create mode 100644 components/iphonelazext/pbx/test/pbxreader.lpi create mode 100644 components/iphonelazext/pbx/test/pbxreader.lpr create mode 100644 components/iphonelazext/pbx/xcodeproj.pas diff --git a/components/iphonelazext/pbx/pbxcontainer.pas b/components/iphonelazext/pbx/pbxcontainer.pas new file mode 100644 index 000000000..f31cc9051 --- /dev/null +++ b/components/iphonelazext/pbx/pbxcontainer.pas @@ -0,0 +1,752 @@ +unit pbxcontainer; +(*------------------------------------------------------------------------------- +* by Dmitry Boyarintsev - Oct 2014 * +* * +* license: free for use, but please leave a note to the origin of the library * +* * +* PBXcontainer unit is a library to read/write the pbx formatter file as a * +* whole The file structure is made to keep the reference in a complex objects * +* struture. Hierarchial trees, lists, cycles and so on. * +* * +* It's achieved by giving a full list of objects. With each object having an * +* "id" assigned. Later in the description, the reference is specifeid by the * +* object's id. * +* * +* Currently PBXContainer would read and try to build a structure based of * +* Object Pascal RTTI. (Not sure if Delphi compatible) * +* Following rules are used * +* read/write objects are going to join the list of objects (for the futher * +* reference) * +* read-only objects should be allocated in the constructor of the parent * +* they're "inlined" in the file * +* for array of objects TPBXObjectsList must be used * +* for array of strings TPBXStringArray must be used * +* for key-value set use TPBXKeyValue class * +* string and integer properties are supported... anything else? * +* * +* todo: add more documentions * +* * +* todo: memoty allocation and release. ObjC is using ref-counted structure. * +* do the same? similar? * +-------------------------------------------------------------------------------*) + +interface + +{$ifdef fpc}{$mode delphi}{$endif} + +uses + Classes, SysUtils, typinfo, pbxfile, contnrs; + +type + + { TPBXObject } + + { PBXObject } + + PBXObject = class(TObject) + private + _id : string; + _fheaderComment : string; + protected + // collects the name of string properties that should be written out + // even if their values is an empty string. + // if property value is an empty string, it would not be written to the file + class procedure _WriteEmpty(propnames: TStrings); virtual; + public + property __id: string read _id; + property _headerComment: string read _fheaderComment write _fheaderComment; + constructor Create; virtual; + + end; + PBXObjectClass = class of PBXObject; + + TPBXObjectsList = class(TObjectList); + TPBXStringArray = class(TStringList); + + TPBXKeyValue = class; + + TPBXValueType = (vtString, vtArrayOfStr, vtKeyVal); + + { TPBXValue } + + TPBXValue = class(TObject) + public + valType : TPBXValueType; + str : string; + arr : TPBXStringArray; + keyval : TPBXKeyValue; + destructor Destroy; override; + end; + + { TPBXKeyValue } + + TPBXKeyValue = class(TFPHashObjectList) + protected + function AddVal(const name: string; atype: TPBXValueType): TPBXValue; + public + function AddStr(const name: string; const avalue: string = ''): TPBXValue; + function AddStrArray(const name: string): TPBXValue; + function AddKeyVal(const name: string): TPBXValue; + end; + + TPBXFileInfo = record + archiveVersion : string; + objectVersion : string; + rootObject : PBXObject; + end; + + { TPBXReref } + + TPBXReref = class(TObject) + instance : TObject; + propname : string; + _id : string; + constructor Create(ainstance: TObject; const apropname, aref: string); + end; + + { TPBXContainer } + + TObjHashList = TFPHashObjectList; + + TPBXContainer = class(TObject) + protected + procedure ReadObjects(p: TPBXParser; objs: TObjHashList); + function AllocObject(const nm: string): PBXObject; + public + function ReadFile(s: TStream; var AFileInfo: TPBXFileInfo): Boolean; + end; + +procedure TestContainer(const buf: string); + +procedure PBXRegisterClass(aclass: PBXObjectClass); +function PBXFindClass(const aclassname: string): PBXObjectClass; + +function PBXReadObjectsListRef(p: TPBXParser; obj: PBXObject; propName: string; refs: TList): Boolean; +function PBXReadStringArray(p: TPBXParser; arr: TPBXStringArray): Boolean; +function PBXReadKeyValue(p: TPBXParser; kv: TPBXKeyValue): Boolean; +function PBXReadClass(p: TPBXParser; obj: PBXObject; refs: TList): Boolean; +procedure PBXReref(objs: TObjHashList; refs: TList); + +function PBXWriteContainer(const FileInfo: TPBXFileInfo; AssignRef: Boolean = true): string; +procedure PBXWriteObjArray( w: TPBXWriter; list: TPBXObjectsList ); +procedure PBXWriteStrArray( w: TPBXWriter; list: TPBXStringArray ); +procedure PBXWriteKeyValue( w: TPBXWriter; kv: TPBXKeyValue ); +procedure PBXWriteObj(pbx: PBXObject; w: TPBXWriter; WriteEmpty: TStrings); + +procedure PBXAssignRef(list: TList); + +procedure PBXGatherObjects(obj: TObject; srz: TList); + +implementation + +var + pbxClassList : TStringList; + +function PBXReadKeyValue(p: TPBXParser; kv: TPBXKeyValue): Boolean; +var + et : TPBXEntity; + v : TPBXValue; +begin + et:=p.FetchNextEntity; + while et<>etCloseObject do begin + case et of + etValue: kv.AddStr(p.Name, p.Value); + etOpenArray: begin + v:=kv.AddStrArray(p.Name); + PBXReadStringArray(p, v.arr); + end; + etOpenObject: begin + v:=kv.AddKeyVal(p.Name); + PBXReadKeyValue(p, v.keyval); + end; + else + Result:=false; + Exit; + end; + et:=p.FetchNextEntity; + end; + Result:=True; +end; + +procedure TestContainer(const buf: string); +var + c : TPBXContainer; + st : TStringStream; + info : TPBXFileInfo; +begin + c:= TPBXContainer.Create; + st := TStringStream.Create(buf); + try + c.ReadFile(st, info); + writeln('arch ver: ',info.archiveVersion); + writeln(' obj ver: ',info.objectVersion); + writeln('root obj: ', PtrUInt( info.rootObject )); + finally + st.Free; + c.Free; + end; +end; + +procedure PBXRegisterClass(aclass: PBXObjectClass); +begin + pbxClassList.AddObject(aclass.ClassName, TObject(aclass)); +end; + +function PBXFindClass(const aclassname: string): PBXObjectClass; +var + i : integer; +begin + i:=pbxClassList.IndexOf(aclassname); + if i<0 then Result:=nil + else Result:=PBXObjectClass(pbxClassList.Objects[i]); + +end; + +{ TPBXValue } + +destructor TPBXValue.Destroy; +begin + arr.Free; + keyval.Free; + inherited Destroy; +end; + +{ TPBXKeyValue } + +function TPBXKeyValue.AddVal(const name: string; atype: TPBXValueType): TPBXValue; +begin + Result:=TPBXValue.Create; + Result.valType:=atype; + case atype of + vtKeyVal: Result.keyval:=TPBXKeyValue.Create(true); + vtArrayOfStr: Result.arr:=TPBXStringArray.Create; + end; + Add(name, Result); +end; + +function TPBXKeyValue.AddStr(const name: string; const avalue: string): TPBXValue; +begin + Result:=AddVal(name, vtString); + Result.str:=avalue; +end; + +function TPBXKeyValue.AddStrArray(const name: string): TPBXValue; +begin + Result:=AddVal(name, vtArrayOfStr); +end; + +function TPBXKeyValue.AddKeyVal(const name: string): TPBXValue; +begin + Result:=AddVal(name, vtKeyVal); +end; + +{ TPBXReref } + +constructor TPBXReref.Create(ainstance: TObject; const apropname, aref: string); +begin + inherited Create; + instance := ainstance; + propname := apropname; + _id := aref; +end; + +{ TPBXObject } + +class procedure PBXObject._WriteEmpty(propnames: TStrings); +begin + +end; + +constructor PBXObject.Create; +begin + +end; + +{ TPBXContainer } + +procedure PBXReref(objs: TObjHashList; refs: TList); +var + i : integer; + refobj : TObject; + r : TPBXReref; + prp : PPropInfo; + pcls : TObject; +begin + for i:=0 to refs.Count-1 do begin + r := TPBXReref(refs[i]); + refobj:=objs.Find(r._id); + if Assigned(refobj) then begin + prp:=GetPropInfo(r.instance, r.propname); + if prp^.PropType^.Kind=tkClass then begin + pcls:=GetObjectProp(r.instance, r.propname); + if pcls is TPBXObjectsList then begin + TPBXObjectsList(pcls).Add(refobj); + end else begin + //writeln('setting prop: ', r.propname,' '); + SetObjectProp(r.instance, r.propname, refobj); + end; + end; + end; + //else writeln('no object found! ', r._id); + end; +end; + +procedure TPBXContainer.ReadObjects(p: TPBXParser; objs: TObjHashList); +var + tk : TPBXEntity; + id : string; + cls : string; + obj : PBXObject; + i : Integer; + refs : TList; + cmt : string; +begin + tk:=p.FetchNextEntity; + refs:=TList.Create; + try + while tk<>etCloseObject do begin + if tk=etOpenObject then begin + id:=p.Name; + cmt:=p.LastComment; + cls:=''; + p.FetchNextEntity; + if (p.CurEntity = etValue) and (p.Name = 'isa') then begin + cls:=p.Value; + obj:=AllocObject(cls); + if Assigned(obj) then begin + obj._headerComment:=cmt; + obj._id:=id; + PBXReadClass(p, obj, refs); + objs.Add(id, obj); + end else + PBXParserSkipLevel(p); + + end else + PBXParserSkipLevel(p); + end; + tk:=p.FetchNextEntity; + end; + + PBXReref(objs, refs); + + finally + for i:=0 to refs.Count-1 do TObject(refs[i]).Free; + refs.Free; + end; +end; + +function TPBXContainer.AllocObject(const nm: string): PBXObject; +var + cls : PBXObjectClass; +begin + cls:=PBXFindClass(nm); + if not Assigned(cls) then Result:=nil + else Result:=cls.Create; +end; + +function TPBXContainer.ReadFile(s: TStream; var AFileInfo: TPBXFileInfo): Boolean; +var + p : TPBXParser; + buf : string; + tk : TPBXEntity; + root : string; + objs : TObjHashList; + rt : TObject; +begin + Result:=false; + AFileInfo.archiveVersion:=''; + AFileInfo.objectVersion:=''; + AFileInfo.rootObject:=nil; + + if not Assigned(s) then Exit; + SetLength(buf, s.Size); + s.Read(buf[1], length(buf)); + + objs:=TObjHashList.Create(False); + p:=TPBXParser.Create; + try + p.scanner.SetBuf(buf); + if p.FetchNextEntity <> etOpenObject then Exit; + + + tk:=p.FetchNextEntity; + while tk <> etEOF do begin + if tk = etValue then begin + if p.Name='archiveVersion' then AFileInfo.archiveVersion:=p.Value + else if p.Name='objectVersion' then AFileInfo.objectVersion:=p.Value + else if p.Name='rootObject' then root:=p.Value; + end else if (tk=etOpenObject) and (p.Name = 'objects') then begin + ReadObjects(p, objs); + end; + tk:=p.FetchNextEntity; + end; + + rt:=objs.Find(root); + + if Assigned(rt) and (rt is PBXObject) then + AFileInfo.rootObject:=PBXObject(rt); + Result:=true; + finally + objs.Free; + p.Free; + end; +end; + +function PBXReadObjectsListRef(p: TPBXParser; obj: PBXObject; propName: string; refs: TList): Boolean; +begin + Result:=true; + p.FetchNextEntity; + while not (p.CurEntity in [etCloseArray, etEOF, etError]) do begin + if p.CurEntity <> etValue then begin + Result:=false; + Exit; + end; + if p.Value<>'' then + refs.Add ( TPBXReref.Create( obj, propName, p.Value )); + p.FetchNextEntity; + end; +end; + +function PBXReadStringArray(p: TPBXParser; arr: TPBXStringArray): Boolean; +begin + Result:=true; + p.FetchNextEntity; + while not (p.CurEntity in [etCloseArray, etEOF, etError]) do begin + if p.CurEntity <> etValue then begin + Result:=false; + Exit; + end; + arr.Add(p.Value); + p.FetchNextEntity; + end; +end; + +function PBXReadClass(p: TPBXParser; obj: PBXObject; refs: TList): Boolean; +var + tk : TPBXEntity; + lvl : Integer; + prp : PPropInfo; + pobj : TObject; + pk : TTypeKind; +begin + lvl:=p.Level; + tk:=p.FetchNextEntity; + while p.Level>=lvl {tk<>tkCurlyBraceClose} do begin + prp:=GetPropInfo(obj, p.Name); + if Assigned(prp) then begin + pk:=prp^.PropType^.Kind; + if pk=tkClass then + pobj:=GetObjectProp(obj, prp) + else + pobj:=nil; + + if tk=etValue then begin + + case pk of + tkClass: begin + //writeln('ref for: ',p.Name,' to ', p.Value); + refs.Add( TPBXReref.Create(obj, p.Name, p.Value)) + end; + tkInteger, tkInt64, tkQWord: begin + SetInt64Prop(obj, p.Name, StrToIntDef(p.Value, GetInt64Prop(obj, p.Name)) ); + end; + else + SetStrProp(obj, p.Name, p.Value); + end; + end else begin + {write( p.CurEntity,' ',p.Name,' ',PtrUInt(pobj)); + if Assigned(pobj) then write(' ', pobj.ClassName); + writeln;} + if (pobj is TPBXObjectsList) and (tk = etOpenArray) then begin + Result:=PBXReadObjectsListRef(p, obj, p.Name, refs); + if not Result then Exit; + end else if (pobj is TPBXStringArray) and (tk = etOpenArray) then begin + Result:=PBXReadStringArray(p, TPBXStringArray(pobj) ); + if not Result then Exit; + end else if (pobj is TPBXKeyValue) and (tk = etOpenObject) then begin + Result:=PBXReadKeyValue(p, TPBXKeyValue(pobj) ); + if not Result then Exit; + end else + // array of object + PBXParserSkipLevel(p); + end; + end else begin + writeln(obj.ClassName, ': property not found: ', p.Name); + if tk <> etValue then + PBXParserSkipLevel(p); + end; + + tk:=p.FetchNextEntity; + end; + Result:=true; +end; + +procedure PBXGatherObjects(obj: TObject; srz: TList); +var + plist : PPropList; + cnt : Integer; + i : Integer; + j : Integer; + k : Integer; + arr : TPBXObjectsList; + ch : TObject; + ach : TObject; + kind : TTypeKind; +const + FlagGet = 3; // 1 + 2 //ptField = 0; + FlagSet = 12; // 4 + 8 , 16 + 32 //ptStatic = 1; + FlagSP = 16 + 32; //ptVirtual = 2; + FlagIdx = 64; //ptConst = 3; } +begin + if (not Assigned(obj)) or (not Assigned(srz)) then Exit; + + srz.Add(obj); + j:=0; + while jtkClass) then Continue; + + ch:=GetObjectProp(obj, plist^[i] ); + if not Assigned(ch) then Continue; + + if (plist^[i]^.PropProcs and FlagSet <> FlagSet) then begin + if srz.IndexOf(ch)<0 then + srz.Add ( ch ); + end else if ch is TPBXObjectsList then begin + + arr:=TPBXObjectsList(ch); + for k:=0 to arr.Count-1 do begin + ach:=arr[k]; + if srz.IndexOf(ach)<0 then srz.Add(ach); + end; + end; + end; + Freemem(plist); + end; + inc(j); + end; +end; + +procedure PBXAssignRef(list: TList); +var + i : Integer; + p : PBXObject; + id: Int64; +begin + if not Assigned(list) then Exit; + id:=2; // root! :) + for i:=0 to list.Count-1 do begin + p:=PBXObject(list[i]); + if not Assigned(p) then Continue; + if (p._id='') then begin + p._id:=IntToHex(id, 24); + inc(id); + end; + end; + // 0AFA6EA519F60EFD004C8FD9 + // 123456789012345678901234 +end; + +procedure PBXWriteStrArray( w: TPBXWriter; list: TPBXStringArray ); +var + i : Integer; +begin + w.OpenBlock('('); + for i:=0 to list.Count-1 do + w.WriteArrValue(list.Strings[i]); + w.CloseBlock(')'); +end; + + +procedure PBXWriteObjArray( w: TPBXWriter; list: TPBXObjectsList ); +var + i : Integer; + pbx : PBXObject; +begin + for i:=0 to list.Count-1 do begin + pbx:=PBXObject(list[i]); + w.WriteArrValue(pbx._id, pbx._headerComment); + end; +end; + +procedure PBXWriteKeyValue( w: TPBXWriter; kv: TPBXKeyValue ); +var + i : Integer; + v : TPBXValue; + nm : string; +begin + w.OpenBlock( '{' ); + for i:=0 to kv.Count-1 do begin + v:=TPBXValue(kv.Items[i]); + nm:=kv.NameOfIndex(i); + w.WriteName(nm); + case v.valType of + vtString: w.WriteValue(v.str); + vtArrayOfStr: PBXWriteStrArray(w, v.arr); + vtKeyVal: PBXWriteKeyValue(w, v.keyval); + end; + end; + w.CloseBlock( '}' ); +end; + +procedure PBXWriteObj(pbx: PBXObject; w: TPBXWriter; WriteEmpty: TStrings); +var + p : PPropList; + cnt : Integer; + i,j : Integer; + isMan : Boolean; + vl : string; + sobj : TObject; + nm : string; + vcmt : string; + isstr : Boolean; + + // used for sorting. todo: find a better way for sort by names! + names : TStringList; +begin + + w.WriteName(pbx._id, pbx._headerComment); + + isMan:=(pbx.ClassName='PBXFileReference') or (pbx.ClassName='PBXBuildFile'); + if isMan then w.ManualLineBreak:=true; + + w.OpenBlock('{'); + w.WriteNamedValue('isa', pbx.ClassName); + + p:=nil; + cnt:=GetPropList(pbx, p); + + //todo: I don't like this soritng at all! + // but it appears to be the most common available + names:=TStringList.Create; + try + for i:=0 to cnt-1 do names.AddObject(p^[i].Name, TObject(PtrUInt(i))); + names.Sort; + + for j:=0 to names.Count-1 do begin + i:=Integer(PtrUInt(names.Objects[j])); + + vl:=''; + vcmt:=''; + isstr:=false; + + nm:=p^[i].Name; + if p^[i].PropType.Kind=tkClass then begin + sobj:=GetObjectProp(pbx, p^[i]); + if sobj is PBXObject then begin + vl:=PBXObject(sobj)._id; + vcmt:=PBXObject(sobj)._headerComment; + isstr:=vl<>''; + end else if sobj is TPBXObjectsList then begin + w.WriteName(nm); w.OpenBlock('('); + PBXWriteObjArray( w, TPBXObjectsList(sobj) ); + w.CloseBlock(')'); + end else if sobj is TPBXStringArray then begin + w.WriteName(nm); + PBXWriteStrArray( w, TPBXStringArray(sobj) ); + end else if sobj is TPBXKeyValue then begin + w.WriteName(nm); + PBXWriteKeyValue(w, TPBXKeyValue(sobj)); + end; + end else if p^[i].PropType.Kind in [tkAString, tkString] then begin + vl:=GetStrProp(pbx,p^[i]); + isstr:=(vl<>'') or (WriteEmpty.indexOf(nm)>=0); + end else if p^[i].PropType.Kind in [tkInteger, tkInt64, tkQWord] then begin + vl:=IntToStr(GetInt64Prop(pbx, p^[i])); + isstr:=(vl<>'') or (WriteEmpty.indexOf(nm)>=0); + end; + + if isstr then begin + w.WriteName(nm); + w.WriteValue(vl,vcmt); + end; + + end; + + if isMan then w.ManualLineBreak:=false; + w.CloseBlock('}'); + finally + names.Free; + if Assigned(p) then Freemem(p); + end; +end; + +function PBXWriteContainer(const FileInfo: TPBXFileInfo; AssignRef: Boolean = true): string; +var + lst : TList; + st : TStringList; + i : Integer; + w : TPBXWriter; + sc : string; + pbx : PBXObject; + emp : TStringList; +begin + lst:=TList.Create; + st:=TStringList.Create; + emp:=TStringList.Create; + try + PBXGatherObjects(fileInfo.rootObject, lst); + if AssignRef then PBXAssignRef(lst); + + for i:=0 to lst.Count-1 do begin + st.AddObject( PBXObject(lst[i]).ClassName+' '+PBXObject(lst[i])._id, PBXObject(lst[i])); + end; + st.Sort; + + w:=TPBXWriter.Create; + try + sc:=''; + w.WriteRaw('// !$*UTF8*$!'); + w.WriteLineBreak; + w.OpenBlock('{'); + w.WriteNamedValue('archiveVersion', FileInfo.archiveVersion); + w.WriteName('classes'); w.OpenBlock('{'); w.CloseBlock('}'); + w.WriteNamedValue('objectVersion', FileInfo.objectVersion); + w.WriteName('objects'); w.OpenBlock('{'); + for i:=0 to st.Count-1 do begin + pbx:=PBXObject(st.Objects[i]); + if sc<>pbx.ClassName then begin + if sc<>'' then begin + w.WriteLineComment('End '+sc+' section'); + end; + sc:=pbx.ClassName; + w.WriteLineBreak(); + w.WriteLineComment('Begin '+sc+' section'); + emp.Clear; + pbx._WriteEmpty(emp); + end; + PBXWriteObj(pbx, w, emp); + end; + + if sc<>'' then w.WriteLineComment('End '+sc+' section'); + w.CloseBlock('}'); + + w.WriteNamedValue('rootObject', FileInfo.rootObject._id, FileInfo.rootObject._headerComment); + w.CloseBlock('}'); + Result:=w.Buffer; + finally + w.Free; + end; + + finally + st.Free; + lst.Free; + emp.Free; + end; +end; + +initialization + pbxClassList := TStringList.Create; + +finalization + pbxClassList.Free; + + + +end. diff --git a/components/iphonelazext/pbx/pbxfile.pas b/components/iphonelazext/pbx/pbxfile.pas new file mode 100644 index 000000000..a43104fa0 --- /dev/null +++ b/components/iphonelazext/pbx/pbxfile.pas @@ -0,0 +1,715 @@ +unit pbxfile; + +interface + +(*------------------------------------------------------------------------------- +* by Dmitry Boyarintsev - Oct 2014 * +* * +* license: free for use, but please leave a note to the origin of the library * +* * +* pbxfile is JSON file format by Apple. Unlike JSON, it allows to add comments. * +* (was it introduced in NextStep system?) * +* other differences * +* no explicit type in values/identifiers * +* . and / are valud value/identifier character * +* ; - is a separator in values * +* () - is an array. the last element can (should?) end up with comma * +* {} - is an object (just like json) * +* escaping characters with C-style escaping: * +* * quotes (") * +* * line breaks (note OSX is typically using \n, unline Unix \r) * +* * +* PBXScanner - scans through the file * +* PBXParser - parses the file, returning a higher level entities of the file: * +* values, open/close of object/array * +* The parser doesn't produce any kind of structure. Instead it only allows to * +* build one. i.e. PBXContainer * +-------------------------------------------------------------------------------*) + +{$ifdef fpc}{$mode delphi}{$endif} + +uses + SysUtils, StrUtils; + +type + TPBXToken = ( + tkEOF, + tkComma, // ',' + tkSemiColon, // ';' + tkEqual, // '=' + tkCurlyBraceOpen, // '{' + tkCurlyBraceClose, // '}' + tkRoundBraceOpen, // '(' + tkRoundBraceClose, // ')' + tkIdentifier, + tkUnknown + ); + + + TCommentEvent = procedure (Sender: TObject; const cmtText: string) of object; + { TPBXScanner } + + TPBXScanner = class(TObject) + private + buf : string; + idx : Integer; + FCurLine : string; + FCurRow : Integer; + FCurToken : TPBXToken; + FCurTokenString: string; + function GetCurColumn: Integer; + protected + procedure DoComment(const cmt: string); + procedure SkipComment(const EndOfLine: Boolean); + function DoFetchToken: TPBXToken; + public + OnComment: TCommentEvent; + procedure SetBuf(const abuf: string); + function FetchToken: TPBXToken; + + property CurLine: string read FCurLine; + property CurRow: Integer read FCurRow; + property CurColumn: Integer read GetCurColumn; + + property CurToken: TPBXToken read FCurToken; + property CurTokenString: string read FCurTokenString; + end; + + TPBXEntity = ( + etOpenArray, etCloseArray + , etOpenObject, etCloseObject + , etValue + , etEOF + , etError + ); + TPBXParserState = (stInit, stObject, stObjectNext, stArray, stArrayNext, stError); + + { TPBXParser } + + TPBXParser = class(TObject) + private + fState : TPBXParserState; + fStStack : array of TPBXParserState; + fStCount : Integer; + + fFetchComment: TCommentEvent; + procedure PushState(AState: TPBXParserState); + function PopState: TPBXParserState; + + function DefaultFetch(tk: TPBXToken): TPBXEntity; + procedure DoScanComment(sender: TObject; const acomment: string); + public + scanner : TPBXScanner; + Name : string; + Value : string; + CurEntity : TPBXEntity; + LastComment : string; + procedure Reset; + function FetchNextEntity: TPBXEntity; + constructor Create; + destructor Destroy; override; + property Level: Integer read fStCount; + end; + + { TPBXWriter } + + TPBXWriter = class(TObject) + private + fbuf : string; + idx : Integer; + protected + fprefix : Integer; + fManualLineBreak : Boolean; + fisNewLine : Boolean; + //fstack : array of fstack; + procedure IncPrefix; + procedure DecPrefix; + function GetBuf: string; + procedure DoWriteRaw(const s: string); + procedure DoWrite(const s: string); + procedure DoLineBreak; + public + constructor Create; + procedure OpenBlock(const openchar: string); + procedure CloseBlock(const closechar: string); + procedure WriteRaw(const s: string); + procedure WriteLineBreak; + procedure WriteLineComment(const s: string); + procedure WriteName(const nm: string; const cmt: string = ''); + procedure WriteValue(const v: string; const cmt: string = ''); + procedure WriteArrValue(const v: string; const cmt: string = ''); + procedure WriteNamedValue(const nm, v: string; const cmt: string = ''); + property Buffer: string read GetBuf; + property ManualLineBreak: Boolean read fManualLineBreak write fManualLineBreak; + end; + +const + CharOffset = #$09; + CharLineBreak = #$0A; + CharSeparator = ';'; + CharArrSeparator = ','; + CharSpace = #$20; + +procedure ScanAString(const test: string); +procedure ParseAString(const test: string); + +function PBXParserSkipLevel(p: TPBXParser): Boolean; +function PBXRawWriteValue(const v: string): string; + +implementation + +type + TCharSet = set of char; + +const + LineBreaks = [#10, #13]; + WhiteSpace = [#9,#8,#32]; + WhiteSpaceBreaks = LineBreaks+WhiteSpace; + Alpha = ['a'..'z','A'..'Z']; + Numeric = ['0'..'9']; + AlphaNumeric = Alpha+Numeric; + IdentName = AlphaNumeric+['_','.','/']; // . and / are allowed in values + ToEscape = ['"',#13,#9,#10,'\']; + // commas are not + +function PBXRawWriteValue(const v: string): string; +var + i : Integer; + k : Integer; +begin + k:=0; + for i:=1 to length(v) do begin + if not (v[i] in IdentName) then begin + if Result='' then begin + SetLength(Result, length(v)*2+2); + Result[1]:='"'; + Move(v[1], Result[2], i); + k:=i+1; + end; + if (v[i] in ToEscape) then begin + Result[k]:='\'; + inc(k); + case v[i] of + '"': Result[k]:='"'; + #13: Result[k]:='n'; + #10: Result[k]:='r'; + #9: Result[k]:='t'; + '\': Result[k]:='\'; + end; + inc(k); + end else begin + Result[k]:=v[i]; + inc(k); + end; + end else if k>0 then begin + Result[k]:=v[i]; + inc(k); + end; + end; + if k=0 then + Result:=v + else begin + Result[k]:='"'; + SetLength(Result,k); + end; +end; + +function ScanTo(const s: string; var idx: Integer; ToChars: TCharSet): string; +var + i : integer; +begin + i:=idx; + while (idx<=length(s)) and not (s[idx] in ToChars) do inc(idx); + Result:=Copy(s, i, idx-i); +end; + +function ScanWhile(const s: string; var idx: Integer; WhileChars: TCharSet): string; +var + i : integer; +begin + i:=idx; + while (idx<=length(s)) and (s[idx] in WhileChars) do + inc(idx); + Result:=Copy(s, i, idx-i); +end; + +{ TPBXWriter } + +procedure TPBXWriter.IncPrefix; +begin + inc(fprefix); +end; + +procedure TPBXWriter.DecPrefix; +begin + dec(fprefix); +end; + +function TPBXWriter.GetBuf: string; +begin + Result:=fbuf; + SetLength(Result, idx-1); +end; + +procedure TPBXWriter.DoWriteRaw(const s: string); +var + sz : Integer; + bufsz : Integer; +begin + if s ='' then Exit; + sz:=length(s)+idx-1; + bufsz:=length(fbuf); + while bufsz0) then begin + SetLength(pfx, fprefix); + FillChar(pfx[1], fprefix, CharOffset); + DoWriteRaw(pfx); + end; + DoWriteRaw(s); +end; + +procedure TPBXWriter.DoLineBreak; +begin + DoWriteRaw(CharLineBreak); + fisNewLine:=true; +end; + +constructor TPBXWriter.Create; +begin + idx:=1; +end; + +procedure TPBXWriter.OpenBlock(const openchar: string); +begin + DoWrite(openchar); + IncPrefix; + if not fManualLineBreak then DoLineBreak; +end; + +procedure TPBXWriter.CloseBlock(const closechar: string); +begin + DecPrefix; + DoWrite(closechar); + if fprefix>0 then DoWriteRaw(CharSeparator); + if not fManualLineBreak then DoLineBreak; +end; + +procedure TPBXWriter.WriteRaw(const s: string); +begin + DoWriteRaw(s); +end; + +procedure TPBXWriter.WriteLineBreak; +begin + DoLineBreak; +end; + +procedure TPBXWriter.WriteLineComment(const s: string); +begin + DoWriteRaw('/* '); + DoWriteRaw(s); + DoWriteRaw(' */'); + DoLineBreak; +end; + +procedure TPBXWriter.WriteName(const nm: string; const cmt: string = ''); +begin + if nm='' then Exit; + DoWrite(PBXRawWriteValue(nm)); + if cmt<>'' then begin + DoWriteRaw(' /* '); + DoWriteRaw(cmt); + DoWriteRaw(' */'); + end; + DoWriteRaw(' = '); +end; + +procedure TPBXWriter.WriteValue(const v: string; const cmt: string = ''); +begin + if v ='' then DoWriteRaw('""') + else DoWriteRaw(PBXRawWriteValue(v)); + if cmt<>'' then begin + DoWriteRaw(' /* '); + DoWriteRaw(cmt); + DoWriteRaw(' */'); + end; + DoWriteRaw(CharSeparator); + if not fManualLineBreak then DoLineBreak + else DoWriteRaw(CharSpace); +end; + +procedure TPBXWriter.WriteArrValue(const v: string; const cmt: string); +begin + DoWrite(PBXRawWriteValue(v)); + if cmt<>'' then begin + DoWriteRaw(' /* '); + DoWriteRaw(cmt); + DoWriteRaw(' */'); + end; + DoWriteRaw(CharArrSeparator); + if not fManualLineBreak then DoLineBreak + else DoWriteRaw(CharSpace); +end; + +procedure TPBXWriter.WriteNamedValue(const nm, v: string; const cmt: string); +begin + WriteName(nm); + WriteValue(v, cmt); +end; + +{ TPBXParser } + +procedure TPBXParser.PushState(AState: TPBXParserState); +begin + if fStCount=length(fStStack) then begin + if fStCount=0 then SetLength(fStStack, 4) + else SetLength(fStStack, fStCount*2); + end; + fStStack[fStcount]:=AState; + inc(fStcount); + fState:=AState; +end; + +function TPBXParser.PopState: TPBXParserState; +begin + dec(fStCount); + if fStCount>0 then begin + fState:=fStStack[fStCount-1]; + if fState = stObject then fState:=stObjectNext + else if fState = stArray then fState:=stArrayNext; + end else + fState:=stInit; + Result:=fState; +end; + +function TPBXParser.DefaultFetch(tk: TPBXToken): TPBXEntity; +begin + case tk of + tkIdentifier: begin + Value:=scanner.CurTokenString; + Result:=etValue; + end; + tkCurlyBraceOpen: begin + Result:=etOpenObject; + PushState(stObject) + end; + tkRoundBraceOpen: begin + Result:=etOpenArray; + PushState(stArray) + end; + else + Result:=etError; + end; +end; + +procedure TPBXParser.DoScanComment(sender: TObject; const acomment: string); +begin + LastComment:=acomment; + if Assigned(fFetchComment) then + fFetchComment(sender, acomment); +end; + +procedure TPBXParser.Reset; +begin + fState:=stInit; +end; + +function TPBXParser.FetchNextEntity: TPBXEntity; +var + tk : TPBXToken; + done : Boolean; +begin + LastComment:=''; + Name:=''; + Value:=''; + case fState of + stInit : + case scanner.FetchToken of + tkCurlyBraceOpen: + begin + PushState(stObject); + Result:=etOpenObject; + end; + tkEOF: + Result:=etEOF; + else + Result:=etError; + end; + stObject, stObjectNext: + repeat + done:=true; + case scanner.FetchToken of + tkSemiColon: begin + if fState = stObjectNext then begin + done:=false; + fState:=stObject; + end else + Result:=etError; + end; + tkCurlyBraceClose: begin + PopState; + Result:=etCloseObject; + end; + tkIdentifier: + begin + Name:=scanner.CurTokenString; + LastComment:=''; + if scanner.FetchToken <> tkEqual then begin + Result:=etError; + end else begin + tk:=scanner.FetchToken; + Result:=DefaultFetch(tk); + if Result=etValue then fState:=stObjectNext; + end; + end; + end; + until done; + stArray, stArrayNext: begin + repeat + done:=true; + tk:=scanner.FetchToken; + case tk of + tkComma: begin + if fState = stArrayNext then begin + fState:=stArray; + done:=false; + end else + Result:=etError; // unexpected comma + end; + tkRoundBraceClose: begin + PopState; + Result:=etCloseArray; + end; + else + Result:=DefaultFetch(tk); + if Result=etValue then fState:=stArrayNext; + end; + until done; + end; + stError: + Result:=etError; + end; + if Result=etError then + fState:=stError; + CurEntity:=Result; +end; + +constructor TPBXParser.Create; +begin + inherited Create; + scanner:=TPBXScanner.Create; + scanner.OnComment:=DoScanComment; + Reset; +end; + +destructor TPBXParser.Destroy; +begin + scanner.Free; + inherited Destroy; +end; + + +{ TPBXScanner } + +function TPBXScanner.GetCurColumn: Integer; +begin + Result:=0; +end; + +procedure TPBXScanner.DoComment(const cmt: string); +begin + if Assigned(OnComment) then OnComment(Self, cmt); +end; + +procedure TPBXScanner.SkipComment(const EndOfLine: Boolean); +var + cmt : string; + i : integer; + cnt : string; +begin + if EndOfLine then begin + cmt:=ScanTo(buf, idx, LineBreaks); + cnt:=trim(cmt); + end else begin + i:=PosEx('*/', buf, idx+2); + cnt:=trim(Copy(buf, idx+2, i-idx-2)); + if i>0 then inc(i,2); + cmt:=Copy(buf, idx, i-idx); + inc(idx, length(cmt)); + end; + DoComment(cnt); +end; + +function TPBXScanner.DoFetchToken: TPBXToken; +begin + if idx>length(buf) then begin + Result:=tkEOF; + Exit; + end; + + // skipping comments + while true do begin + ScanWhile(buf, idx, WhiteSpaceBreaks); + if (idxlength(buf) then begin + Result:=tkEOF; + Exit; + end; + + if buf[idx] in IdentName then begin + Result:=tkIdentifier; + FCurTokenString:=ScanWhile(buf, idx, IdentName); + end else + case buf[idx] of + '"': begin + inc(idx); + Result:=tkIdentifier; + FCurTokenString:=ScanTo(buf, idx, ['"']); + inc(idx); + end; + '=': begin + Result:= tkEqual; + FCurTokenString:=buf[idx]; + inc(idx); + end; + '{': begin + Result:=tkCurlyBraceOpen; + FCurTokenString:=buf[idx]; + inc(idx); + end; + '}': begin + Result:=tkCurlyBraceClose; + FCurTokenString:=buf[idx]; + inc(idx); + end; + ')': begin + Result:=tkRoundBraceClose; + FCurTokenString:=buf[idx]; + inc(idx); + end; + '(': begin + Result:=tkRoundBraceOpen; + FCurTokenString:=buf[idx]; + inc(idx); + end; + ';': begin + Result:=tkSemiColon; + FCurTokenString:=buf[idx]; + inc(idx); + end; + ',': begin + Result:=tkComma; + FCurTokenString:=buf[idx]; + inc(idx); + end; + else + Result:= tkUnknown; + FCurTokenString:=buf[idx]; + inc(idx); + end; + +end; + +procedure TPBXScanner.SetBuf(const abuf: string); +begin + buf:=abuf; + idx:=1; +end; + +function TPBXScanner.FetchToken: TPBXToken; +begin + Result:=DoFetchToken; + FCurToken:=Result; +end; + +procedure ScanAString(const test: string); +var + sc : TPBXScanner; +begin + sc := TPBXScanner.Create; + try + sc.SetBuf(test); + while sc.FetchToken<>tkEOF do begin + if sc.CurToken=tkUnknown then begin + writeln(sc.CurToken:20,' ', IntToHex( byte(sc.CurTokenString[1]), 2 ) ); + writeln('idx = ', sc.idx); + end else + ; + //writeln(sc.CurToken:20,' ', sc.CurTokenString); + end; + finally + sc.Free; + end; +end; + +procedure ParseAString(const test: string); +var + pr : TPBXParser; + et : TPBXEntity; +begin + pr := TPBXParser.Create; + try + pr.scanner.SetBuf(test); + et:=pr.FetchNextEntity; + while et <> etEOF do begin + if pr.Name<>'' then write('"',pr.Name,'":'); + + case et of + etValue: writeln('"',pr.Value,'",'); + etCloseObject: writeln('},'); + etOpenObject: writeln('{'); + etOpenArray: writeln('['); + etCloseArray: writeln('],'); + else + writeln(et); + end; + if et = etError then Break; + //writeln(pr.fState); + et:=pr.FetchNextEntity; + end; + finally + pr.Free; + end; +end; + +function PBXParserSkipLevel(p: TPBXParser): Boolean; +var + lvl : Integer; + tk : TPBXEntity; +begin + if not Assigned(p) then Exit; + lvl:=p.Level; + while (p.Level>=lvl) do begin + tk:=p.FetchNextEntity; + if tk=etError then begin + Result:=false; + Exit; + end; + end; + Result:=true; +end; + +end. diff --git a/components/iphonelazext/pbx/test/pbxreader.lpi b/components/iphonelazext/pbx/test/pbxreader.lpi new file mode 100644 index 000000000..444b80149 --- /dev/null +++ b/components/iphonelazext/pbx/test/pbxreader.lpi @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="1"> + <Unit0> + <Filename Value="pbxreader.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="pbxreader"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value=".."/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <Checks> + <RangeChecks Value="True"/> + <OverflowChecks Value="True"/> + <StackChecks Value="True"/> + </Checks> + <TargetCPU Value="i386"/> + </CodeGeneration> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/iphonelazext/pbx/test/pbxreader.lpr b/components/iphonelazext/pbx/test/pbxreader.lpr new file mode 100644 index 000000000..624733d2a --- /dev/null +++ b/components/iphonelazext/pbx/test/pbxreader.lpr @@ -0,0 +1,273 @@ +program pbxreader; + +{$mode delphi}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + heaptrc, + Classes, SysUtils, pbxfile, pbxcontainer, xcodeproj + { you can add units after this }; + +function ReadFileToString(const fn: string): string; +var + fs : TFileStream; +begin + fs:=TFileStream.Create(fn, fmOpenRead or fmShareDenyNone); + try + SetLength(Result, fs.Size); + fs.Read(Result[1], fs.Size); + finally + fs.Free; + end; +end; + +procedure WriteStringToFile(const s, fn: string); +var + fs : TFileStream; +begin + fs:=TFileStream.Create(fn, fmCreate); + try + if length(s)>0 then begin + fs.Write(s[1], length(s)); + fs.Size:=length(s); + end; + finally + fs.Free; + end; +end; + +procedure TestProject(const buf: string); +var + c : TPBXContainer; + st : TStringStream; + info : TPBXFileInfo; + prj : PBXProject; + i : Integer; +begin + c:= TPBXContainer.Create; + st := TStringStream.Create(buf); + try + c.ReadFile(st, info); + writeln('arch ver: ',info.archiveVersion); + writeln(' obj ver: ',info.objectVersion); + writeln('root obj: ', PtrUInt( info.rootObject )); + + if info.rootObject is PBXProject then begin + writeln('project!'); + prj:=PBXProject(info.rootObject); + writeln(prj.knownRegions.Text); + writeln('targets: ', prj.targets.Count ); + for i:=0 to prj.targets.Count-1 do begin + writeln(prj.targets.Items[i].ClassName); + writeln(PBXNativeTarget(prj.targets.Items[i]).name); + end; + + writeln(PtrUInt(prj.buildConfigurationList)); + writeln('build configuration:'); + for i:=0 to prj.buildConfigurationList.buildConfigurations.Count-1 do begin + writeln(' ',XCBuildConfiguration(prj.buildConfigurationList.buildConfigurations[i]).name); + end; + end; + finally + st.Free; + c.Free; + end; +end; + +type + + { MyClass } + + MyClass = class(TObject) + private + fInt: Integer; + fInt2: Integer; + fInt3: Integer; + fRO: TList; + fRW: TList; + protected + function GetInt3: Integer; + procedure SetInt3(AValue: Integer); + function GetInt2: Integer; + public + constructor Create; + published + property Int: Integer read fInt write fInt; + property Int2: Integer read GetInt2 write fInt2; + property Int3: Integer read GetInt3 write SetInt3; + property RO: TList read fRO; + property RW: TList read fRW write fRW; + + end; + +var + lst : TList; + m : MyClass; + +{ MyClass } + +function MyClass.GetInt3: Integer; +begin + Result:=fInt3; +end; + +procedure MyClass.SetInt3(AValue: Integer); +begin + fInt3:=AValue; +end; + +function MyClass.GetInt2: Integer; +begin + Result:=fInt2; +end; + +constructor MyClass.Create; +begin + fRO:=TList.Create; + fRW:=TList.Create; +end; + +procedure TestRTTI; +var + lst : TList; + m : MyClass; +begin + lst:=TList.Create; + m:=MyClass.Create; + PBXGatherObjects(m, lst); +end; + +procedure TestWriter; +var + w : TPBXWriter; +begin + w := TPBXWriter.Create; + try + w.OpenBlock('{'); + w.WriteName('archiveVersion'); + w.WriteValue('1'); + w.WriteName('classes'); + w.OpenBlock('{'); + w.CloseBlock('}'); + w.WriteName('objectVersion'); + w.WriteValue('46'); + w.WriteName('objects'); + w.OpenBlock('{'); + w.CloseBlock('}'); + w.WriteName('rootObject'); + w.WriteValue('aaaa','Project object'); + w.CloseBlock('}'); + write(w.Buffer); + finally + w.Free; + end; +end; + + +procedure TestReadThenWrite; +var + prj : PBXProject; + list : TList; + i : Integer; + st : TStringList; +begin + if ParamCount=0 then begin + writeln('please provide pbx file'); + Exit; + end; + //ScanAString( ReadFileToString(ParamStr(1))); + //ParseAString( ReadFileToString(ParamStr(1))); + //TestProject( ReadFileToString(ParamStr(1))); + if LoadProjectFromFile(ParamStr(1), prj) then begin + //list:=TList.Create; + //PBXGatherObjects(prj, list); + Write(ProjectWrite(prj)); + + prj.Free; + {st:=TStringList.Create; + try + for i:=0 to list.Count-1 do begin + st.AddObject( PBXObject(list[i]).ClassName, PBXObject(list[i])); + end; + st.Sort; + for i:=0 to st.Count-1 do begin + writeln(PBXObject(st.Objects[i]).__id,' : ',PBXObject(st.Objects[i]).ClassName); + end; + + finally + st.Free; + end;} + + //list.Free; + end else + writeln('not a project'); +end; + +procedure TestWriteAProject; +var + p : PBXProject; + s : string; + t : PBXNativeTarget; + prd : PBXGroup; + //cfg : XCBuildConfiguration; + ph : PBXShellScriptBuildPhase; +begin + p:=CreateMinProject; + p.buildConfigurationList._headerComment:=p.buildConfigurationList._headerComment+' for PBXProject "test"'; + p.attributes.AddStr('LastUpgradeCheck','0610'); + t:=ProjectAddTarget(p,'targetto'); + ph:=TargetAddRunScript(t); + ph.shellScript:='echo "hello world"'; + //ph.buildActionMask:='0'; + + ph.runOnlyForDeploymentPostprocessing:='0'; + t.productReference:=CreateFileRef('targetto', FILETYPE_EXEC); + PBXFileReference(t.productReference).sourceTree:='BUILT_PRODUCTS_DIR'; + t.productName:='targetto'; + t.productType:=PRODTYPE_TOOL; + + // at least one configuration is added ! + //todo: a target should automatically copy project's building settings + t.buildConfigurationList:=XCConfigurationList.Create; + t.buildConfigurationList._headerComment:='Build configuration list for PBXNativeTarget "targetto"'; + t.buildConfigurationList.addConfig('Default').buildSettings.AddStr('PRODUCT_NAME','targetto'); + t.buildConfigurationList.addConfig('Release').buildSettings.AddStr('PRODUCT_NAME','targetto'); + t.buildConfigurationList.defaultConfigurationIsVisible:='0'; + t.buildConfigurationList.defaultConfigurationName:='Release'; + + +{ cfg:=XCBuildConfiguration(p.buildConfigurationList.buildConfigurations[0]); + cfg.buildSettings.AddStr('COPY_PHASE_STRIP', 'NO'); + cfg.buildSettings.AddStr('GCC_DYNAMIC_NO_PIC', 'NO'); + cfg.buildSettings.AddStr('GCC_OPTIMIZATION_LEVEL', '0'); + cfg.buildSettings.AddStr('PRODUCT_NAME', 'targetto'); } + + + p.mainGroup:=CreateRootGroup('/Users/dmitry/pbx/utils/test.xcodeproj'); + // requirements ? + prd:=p.mainGroup.addSubGroup('Products'); + prd.children.Add(t.productReference); + + p.productRefGroup:=prd; + + p.compatibilityVersion:='Xcode 3.2'; + + s:=ProjectWrite(p); + WriteStringToFile(s, 'test.xcodeproj/project.pbxproj'); + p.Free; +end; + +begin + if FileExists('leaks.txt') then DeleteFile('leaks.txt'); + SetHeapTraceOutput('leaks.txt'); + try + TestReadThenWrite; + except + on e: exception do + writeln(e.Message); + end; +end. + + diff --git a/components/iphonelazext/pbx/xcodeproj.pas b/components/iphonelazext/pbx/xcodeproj.pas new file mode 100644 index 000000000..c16443522 --- /dev/null +++ b/components/iphonelazext/pbx/xcodeproj.pas @@ -0,0 +1,577 @@ +unit xcodeproj; +{-------------------------------------------------------------------------------- +* by Dmitry Boyarintsev - Oct 2014 * +* * +* license: free for use, but please leave a note to the origin of the library * +* * +* PBXcontainer unit is a library to read/write the pbx formatter file as a * +* whole The file structure is made to keep the reference in a complex objects * +* * +* Memory Management. * +* Cocoa is reference - counted library, thus the usage of an object * +* controlled natively by ref counting. * +* A bit trickier for pascal * +* Following rules are applied * +* * read-only property objects are freed by the host (obviously) * +* * other "freeing" operations are noted at "mmgr" comments * +* * any objects within key-value tables are freed * +* Alternative solution - implement ref counting! * +* * +--------------------------------------------------------------------------------} + +interface + +uses + Classes, SysUtils, + typinfo, pbxcontainer; + +type + { XCBuildConfiguration } + + XCBuildConfiguration = class(PBXObject) + private + fname : string; + fbuildSettings: TPBXKeyValue; + public + constructor Create; override; + destructor Destroy; override; + published + property buildSettings : TPBXKeyValue read fbuildSettings; + property name: string read fname write fname; + end; + + { XCConfigurationList } + + // mmgr: XCConfigurationList frees + // * content of buildConfigurations + XCConfigurationList = class(PBXObject) + private + fdefaultConfigurationIsVisible: string; + fdefaultConfigurationName: string; + fbuildConfigurations: TPBXObjectsList; + public + constructor Create; override; + destructor Destroy; override; + function addConfig(const aname: string): XCBuildConfiguration; + published + property buildConfigurations: TPBXObjectsList read fbuildConfigurations; + property defaultConfigurationIsVisible: string read fdefaultConfigurationIsVisible write fdefaultConfigurationIsVisible; + property defaultConfigurationName: string read fdefaultConfigurationName write fdefaultConfigurationName; + end; + + { PBXContainerItemProxy } + + PBXContainerItemProxy = class(PBXObject) + private + FcontainerPortal : PBXObject; + fproxyType : string; + fremoteGlobalIDString: string; + fremoteInfo: string; + published + property containerPortal: PBXObject read fcontainerPortal write fcontainerPortal; // Object = 0AFA6EA519F60EFD004C8FD9 /* Project object */; + property proxyType: string read FproxyType write fproxyType; + property remoteGlobalIDString: string read fremoteGlobalIDString write fremoteGlobalIDString; //object = 0AFA6EAC19F60EFD004C8FD9; + property remoteInfo : string read fremoteInfo write fremoteInfo; // ttestGame; + end; + + { PBXFileReference } + + PBXFileReference = class(PBXObject) + private + FexplicitFileType: string; + FincludeInIndex: string; + FlastKnownFileType: string; + Fname: string; + Fpath: string; + FsourceTree: string; + published + property explicitFileType: string read FexplicitFileType write FexplicitFileType; + property includeInIndex: string read FincludeInIndex write FincludeInIndex; + property lastKnownFileType: string read flastKnownFileType write flastKnownFileType; + property name: string read Fname write Fname; + property path: string read Fpath write Fpath; + property sourceTree: string read FsourceTree write FsourceTree; + end; + + { PBXBuildFile } + + PBXBuildFile = class(PBXObject) + private + fFileRef : PBXFileReference; + published + property fileRef : PBXFileReference read ffileRef write ffileRef; // obj + end; + + { PBXBuildPhase } + + // mmgr: on free + // * content of files + PBXBuildPhase = class(PBXObject) + private + fbuildActionMask : Integer; + ffiles: TPBXObjectsList; + frunOnlyForDeploymentPostprocessing: string; + fname: string; + public + constructor Create; override; + destructor Destroy; override; + published + property buildActionMask: Integer read fbuildActionMask write fbuildActionMask; + property files: TPBXObjectsList read ffiles; + property name: string read fname write fname; + property runOnlyForDeploymentPostprocessing: string read frunOnlyForDeploymentPostprocessing write frunOnlyForDeploymentPostprocessing; + end; + { PBXFrameworksBuildPhase } + + PBXFrameworksBuildPhase = class(PBXBuildPhase); + PBXResourcesBuildPhase = class(PBXBuildPhase); + PBXSourcesBuildPhase = class(PBXBuildPhase); + + { PBXShellScriptBuildPhase } + + PBXShellScriptBuildPhase = class(PBXBuildPhase) + private + finputPaths: TPBXStringArray; + foutputPaths: TPBXStringArray; + fshellpath: string; + fshellScript: string; + public + constructor Create; override; + destructor Destroy; override; + published + property inputPaths: TPBXStringArray read finputPaths; + property outputPaths: TPBXStringArray read foutputPaths; + property shellPath: string read fshellpath write fshellPath; + property shellScript: string read fshellScript write fshellScript; + end; + + { PBXGroup } + + // mmgt: PBXGroup owns children object (PBXGroup and PBXFileRefernece) + // and would free then on release; + // note, that PBXFileReference objects might be used in other places + PBXGroup = class(PBXObject) + private + fsourceTree : string; + fchildren: TPBXObjectsList; + fname: string; + fpath: string; + public + constructor Create; override; + destructor Destroy; override; + function addSubGroup(const aname: string): PBXGroup; + published + property children: TPBXObjectsList read fchildren; + property name: string read fname write fname; + property path: string read fpath write fpath; + property sourceTree: string read fsourceTree write fsourceTree; + end; + + PBXVariantGroup = class(PBXGroup); + + { PBXNativeTarget } + + // mmgr: PBXNativeTarget + // * buildConfigurationList + // * contents of buildPhases + // * contents of buildRules + // * content of dependencies + PBXNativeTarget = class(PBXObject) + private + fbuildConfigurationList: XCConfigurationList; + fname : string; + fproductName : string; + fproductReference : PBXObject; + fproductType : string; + fbuildPhases : TPBXObjectsList; + fbuildRules : TPBXObjectsList; + fdependencies : TPBXObjectsList; + public + constructor Create; override; + destructor Destroy; override; + published + property buildConfigurationList : XCConfigurationList read fbuildConfigurationList write fbuildConfigurationList; //= 0AFA6ED419F60F01004C8FD9 /* Build configuration list for PBXNativeTarget "ttestGame" */; + property buildPhases: TPBXObjectsList read fbuildPhases; + property buildRules: TPBXObjectsList read fbuildRules; + property dependencies: TPBXObjectsList read fdependencies; + property name: string read fname write fname; + property productName: string read fproductName write fproductName; // = ttestGame; + property productReference: PBXObject read fproductReference write fproductReference; // = 0AFA6EAD19F60EFE004C8FD9 /* ttestGame.app */; + property productType: string read fproductType write fproductType; // = "com.apple.product-type.application"; + end; + + { PBXTargetDependency } + + // mmgt: + // targetProxy - is freed + PBXTargetDependency = class(PBXObject) + private + ftargetProxy: PBXContainerItemProxy; + ftarget: PBXNativeTarget; + public + destructor Destroy; override; + published + property target : PBXNativeTarget read ftarget write ftarget; + property targetProxy: PBXContainerItemProxy read ftargetProxy write ftargetProxy; {* PBXContainerItemProxy *} + end; + + { PBXProject } + + // mmgt: PBXProject frees the following property objects, if assigned: + // * mainGroup + // * buildConfigurationList + // * contents of targets + PBXProject = class(PBXObject) + private + fattributes : TPBXKeyValue; + fcompatibilityVersion : string; + fdevelopmentRegion : string; + fhasScannedForEncodings: string; + fmainGroup: PBXGroup; + fknownRegions: TPBXStringArray; + fproductRefGroup: PBXGroup; + fprojectDirPath: string; + fprojectRoot : string; + ftargets: TPBXObjectsList; + fbuildConfigurationList: XCConfigurationList; + protected + class procedure _WriteEmpty(propnames: TStrings); override; + public + constructor Create; override; + destructor Destroy; override; + function addTarget(const aname: string): PBXNativeTarget; + published + property attributes: TPBXKeyValue read fattributes; + property buildConfigurationList: XCConfigurationList read fbuildConfigurationList write fbuildConfigurationList; + property compatibilityVersion: string read fcompatibilityVersion write fcompatibilityVersion; + property developmentRegion: string read fdevelopmentRegion write fdevelopmentRegion; + property hasScannedForEncodings: string read fhasScannedForEncodings write fhasScannedForEncodings; + property knownRegions: TPBXStringArray read fknownRegions; + property mainGroup: PBXGroup read fmainGroup write fmainGroup; + property productRefGroup: PBXGroup read fproductRefGroup write fproductRefGroup; + property projectDirPath: string read fprojectDirPath write fprojectDirPath; + property projectRoot: string read fprojectRoot write fprojectRoot; + property targets: TPBXObjectsList read ftargets; + end; + +function LoadProjectFromStream(st: TStream; var prj: PBXProject): Boolean; +function LoadProjectFromFile(const fn: string; var prj: PBXProject): Boolean; + +function ProjectWrite(prj: PBXProject): string; + +function CreateMinProject: PBXProject; +function ProjectAddTarget(prj: PBXProject; const ATargetName: string): PBXNativeTarget; + +const + SCRIPT_RUNPATH = '/bin/sh'; + SCRIPT_DEFAULT = ''; + SCRIPT_DEFNAME = 'Run Script'; + +function TargetAddRunScript(atarget: PBXNativeTarget): PBXShellScriptBuildPhase; + +const + //FILETYPE_SCRIPT = 'text.script.sh'; + FILETYPE_EXEC = 'compiled.mach-o.executable'; + FILETYPE_MACHO = FILETYPE_EXEC; + +function CreateFileRef(const afilename: string; const filetype: string = ''): PBXFileReference; + +const + GROUPSRC_ABSOLUTE = '<absolute>'; + GROUPSRC_GROUP = '<group>'; + +function CreateGroup(const aname: string; const srcTree: string = GROUPSRC_GROUP): PBXGroup; +//todo: need a rountine to update the path whenever the project is saved +function CreateRootGroup(const projectfolder: string): PBXGroup; + +const + PRODTYPE_TOOL = 'com.apple.product-type.tool'; + +// +// PBXSourcesBuildPhase (sources) - is part of a PBXNativeTarget +// PBXNativeTarget - is part of Target +// PBXNativeTarget +//buildPhases = ( + //0AA67B651A04929900CF0DD7 /* Sources */, + //0AA67B661A04929900CF0DD7 /* Frameworks */, + //0AA67B671A04929900CF0DD7 /* CopyFiles */, + //); + + +implementation + +{ PBXTargetDependency } + +destructor PBXTargetDependency.Destroy; +begin + ftargetProxy.Free; + inherited Destroy; +end; + +{ PBXShellScriptBuildPhase } + +constructor PBXShellScriptBuildPhase.Create; +begin + inherited Create; + finputPaths:=TPBXStringArray.Create; + foutputPaths:=TPBXStringArray.Create; +end; + +destructor PBXShellScriptBuildPhase.Destroy; +begin + finputPaths.Free; + foutputPaths.Free; + inherited Destroy; +end; + +{ PBXNativeTarget } + +constructor PBXNativeTarget.Create; +begin + inherited Create; + fbuildPhases := TPBXObjectsList.Create(true); + fdependencies := TPBXObjectsList.Create(true); + fbuildRules := TPBXObjectsList.Create(true); +end; + +destructor PBXNativeTarget.Destroy; +begin + fbuildConfigurationList.Free; + fbuildRules.Free; + fbuildPhases.Free; + fdependencies.Free; + inherited Destroy; +end; + +{ PBXProject } + +class procedure PBXProject._WriteEmpty(propnames: TStrings); +begin + propnames.Add('projectDirPath'); + propnames.Add('projectRoot'); +end; + +constructor PBXProject.Create; +begin + inherited Create; + ftargets:=TPBXObjectsList.create(true); + fknownRegions:=TPBXStringArray.Create; + fattributes:=TPBXKeyValue.Create(true); +end; + +destructor PBXProject.Destroy; +begin + fattributes.Free; + fknownRegions.Free; + ftargets.Free; + + fmainGroup.Free; + fbuildConfigurationList.Free; + inherited Destroy; +end; + +function PBXProject.addTarget(const aname: string): PBXNativeTarget; +begin + Result:=PBXNativeTarget.Create; + targets.Add(Result); + Result._headerComment:=aname; + Result.name:=aname; + // productName? + // productReference - is a resulting file +end; + +{ XCConfigurationList } + +constructor XCConfigurationList.Create; +begin + inherited Create; + fbuildConfigurations:=TPBXObjectsList.Create(true); +end; + +destructor XCConfigurationList.Destroy; +begin + fbuildConfigurations.Free; + inherited Destroy; +end; + +function XCConfigurationList.AddConfig(const aname: string): XCBuildConfiguration; +begin + Result:=XCBuildConfiguration.Create; + Result.name:=aname; + Result._headerComment:=aname; + fbuildConfigurations.Add(Result); +end; + +{ XCBuildConfiguration } + +constructor XCBuildConfiguration.Create; +begin + inherited Create; + fbuildSettings:=TPBXKeyValue.Create(true); +end; + +destructor XCBuildConfiguration.Destroy; +begin + fbuildSettings.Free; + inherited Destroy; +end; + +{ PBXGroup } + +constructor PBXGroup.Create; +begin + inherited Create; + fchildren:=TPBXObjectsList.Create(true); +end; + +destructor PBXGroup.Destroy; +begin + fchildren.Free; + inherited Destroy; +end; + +function PBXGroup.addSubGroup(const aname: string): PBXGroup; +begin + Result:=PBXGroup.Create; + fchildren.Add(Result); + Result.name:=aname; + Result._headerComment:=aname; + Result.sourceTree:=GROUPSRC_GROUP; +end; + +{ PBXBuildPhase } + +constructor PBXBuildPhase.Create; +begin + inherited Create; + ffiles:=TPBXObjectsList.Create(true); +end; + +destructor PBXBuildPhase.Destroy; +begin + ffiles.Free; +end; + +function LoadProjectFromStream(st: TStream; var prj: PBXProject): Boolean; +var + c : TPBXContainer; + info : TPBXFileInfo; +begin + prj:=nil; + c:= TPBXContainer.Create; + try + Result:=c.ReadFile(st, info); + if Result then begin + if not (info.rootObject is PBXProject) then begin + info.rootObject.Free; + end else begin + prj:=PBXProject(info.rootObject); + end; + end + finally + c.Free; + end; +end; + +function LoadProjectFromFile(const fn: string; var prj: PBXProject): Boolean; +var + fs :TFileStream; +begin + fs:=TFileStream.Create(fn, fmOpenRead or fmShareDenyNone); + try + Result:=LoadProjectFromStream(fs, prj); + finally + fs.Free; + end; +end; + +function ProjectWrite(prj: PBXProject): string; +var + info : TPBXFileInfo; +begin + info.archiveVersion:='1'; + info.objectVersion:='46'; + info.rootObject:=prj; + Result:=PBXWriteContainer(info); +end; + +function CreateMinProject: PBXProject; +var + p : PBXProject; + cfg : XCBuildConfiguration; +begin + // requirements: + // * at least one build configuration + p := PBXProject.Create; + p._headerComment:='Project object'; + + p.buildConfigurationList:=XCConfigurationList.Create; + p.buildConfigurationList._headerComment:='Build configuration list'; + p.buildConfigurationList.defaultConfigurationIsVisible:='0'; + + cfg:=p.buildConfigurationList.addConfig('Default'); + cfg:=p.buildConfigurationList.addConfig('Release'); + // default name must be present + p.buildConfigurationList.defaultConfigurationName:='Release'; + Result:=p; +end; + +function ProjectAddTarget(prj: PBXProject; const ATargetName: string): PBXNativeTarget; +begin + Result:=nil; + if not Assigned(prj) then Exit; + Result:=prj.addTarget(ATargetName); +end; + +function TargetAddRunScript(atarget: PBXNativeTarget): PBXShellScriptBuildPhase; +begin + Result:=PBXShellScriptBuildPhase.Create; + Result.name:=SCRIPT_DEFNAME; + Result._headerComment:=SCRIPT_DEFNAME; + Result.shellScript:=SCRIPT_DEFAULT; + Result.shellPath:=SCRIPT_RUNPATH; + atarget.buildPhases.Add(Result); +end; + +function CreateFileRef(const afilename: string; const filetype: string ): PBXFileReference; +begin + Result:=PBXFileReference.Create; + Result.path:=afilename; + Result._headerComment:=afilename; + Result.explicitFileType:=FILETYPE_EXEC; +end; + +function CreateGroup(const aname, srcTree: string): PBXGroup; +begin + Result:=PBXGroup.Create; + Result.name:=aname; + Result.sourceTree:=srcTree; + Result._headerComment:=aname; +end; + +function CreateRootGroup(const projectfolder: string): PBXGroup; +begin + Result:=CreateGroup('', GROUPSRC_ABSOLUTE); + Result.path:=projectfolder; + Result._headerComment:=projectfolder; +end; + +initialization + PBXRegisterClass(PBXBuildFile); + PBXRegisterClass(PBXContainerItemProxy); + PBXRegisterClass(PBXFileReference); + PBXRegisterClass(PBXFrameworksBuildPhase); + PBXRegisterClass(PBXGroup); + PBXRegisterClass(PBXNativeTarget); + PBXRegisterClass(PBXProject); + PBXRegisterClass(PBXResourcesBuildPhase); + PBXRegisterClass(PBXSourcesBuildPhase); + PBXRegisterClass(PBXTargetDependency); + PBXRegisterClass(PBXVariantGroup); + PBXRegisterClass(XCBuildConfiguration); + PBXRegisterClass(XCConfigurationList); + +end. + + +