fpmkunit.pp 72 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779
  1. {$Mode objfpc}
  2. {$H+}
  3. {$define debug}
  4. unit fpmkunit;
  5. Interface
  6. uses SysUtils,Classes;
  7. Type
  8. TFileType = (ftSource,ftUnit,ftObject,ftResource,ftExecutable,ftStaticLibrary,
  9. ftSharedLibrary);
  10. TFileTypes = set of TFileType;
  11. TOS = (Amiga,Atari,Darwin,FreeBSD,Go32v2,Linux,MacOS,MorphOS,NetBSD,
  12. Netware,NetwLibc,OpenBSD,OS2,PalmOS,Solaris,Win32,Emx);
  13. TOSes = Set of TOS;
  14. TCPU = (Arm,I386,PPC,SPARC,X86_64);
  15. TCPUS = Set of TCPU;
  16. TCompilerMode = (FPC,TP,ObjFPC,Delphi,MacPas);
  17. TCompilerModes = Set of TCompilerMode;
  18. TTargetType = (ttUnit,ttProgram,ttExampleUnit,ttExampleProgram);
  19. TTargetTypes = set of TTargetType;
  20. TTargetState = (tsNeutral,tsCompiling,tsCompiled,tsInstalled);
  21. TTargetStates = Set of TTargetState;
  22. TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload);
  23. TVerboseLevel = (vlError,vlWarning,vlInfo,vlCompare,vlCommand,vldebug);
  24. TVerboseLevels = Set of TVerboseLevel;
  25. TLogEvent = Procedure (Level : TVerboseLevel; Const Msg : String) of Object;
  26. { TNamedItem }
  27. TNamedItem = Class(TCollectionItem)
  28. private
  29. FName: String;
  30. procedure SetName(const AValue: String);virtual;
  31. Public
  32. property Name : String Read FName Write SetName;
  33. end;
  34. { TNamedCollection }
  35. TNamedCollection = Class(TCollection)
  36. private
  37. FUniqueNames: Boolean;
  38. Public
  39. Function IndexOfName(AName : String) : Integer;
  40. Function ItemByName(AName : String) : TNamedItem;
  41. Property UniqueNames : Boolean Read FUniqueNames;
  42. end;
  43. { TNamedItemList }
  44. TNamedItemList = Class(TList)
  45. private
  46. function GetNamedItem(Index : Integer): TNamedItem;
  47. procedure SetNamedItem(Index : Integer; const AValue: TNamedItem);
  48. public
  49. Function IndexOfName(AName : String) : Integer;
  50. Function ItemByName(ANAme : String) : TNamedItem;
  51. Property NamedItems[Index : Integer] : TNamedItem Read GetNamedItem Write SetNamedItem; default;
  52. end;
  53. { TFileItem }
  54. TFileItem = Class(TNamedItem)
  55. private
  56. FFileType: TFileType;
  57. function GetExtension: String;
  58. function GetPath: String;
  59. Public
  60. Property Extension : String Read GetExtension;
  61. Property FileType : TFileType Read FFileType Write FFileType;
  62. Property Path : String Read GetPath;
  63. end;
  64. { TFileItems }
  65. TFileItems = Class(TNamedCollection)
  66. end;
  67. { TTarget }
  68. TTarget = Class(TNamedItem)
  69. private
  70. FInstall : Boolean;
  71. FAfterClean: TNotifyEvent;
  72. FAfterCompile: TNotifyEvent;
  73. FBeforeClean: TNotifyEvent;
  74. FBeforeCompile: TNotifyEvent;
  75. FCPUs: TCPUs;
  76. FMode: TCompilerMode;
  77. FResourceStrings: Boolean;
  78. FObjectPath,
  79. FUnitPath,
  80. FIncludePath,
  81. FDependencies: TStrings;
  82. FDirectory: String;
  83. FExtension: String;
  84. FFileType: TFileType;
  85. FOptions: String;
  86. FOSes: TOSes;
  87. FFPCTarget: String;
  88. FTargetState: TTargetState;
  89. FTargetType: TTargetType;
  90. function GetHasStrings(AIndex: integer): Boolean;
  91. function GetStrings(AIndex: integer): TStrings;
  92. procedure SetStrings(AIndex: integer; const AValue: TStrings);
  93. Protected
  94. Function GetSourceFileName : String; virtual;
  95. Function GetUnitFileName : String; virtual;
  96. Function GetObjectFileName : String; virtual;
  97. Function GetRSTFileName : String; Virtual;
  98. Function GetProgramFileName(AnOS : TOS) : String; Virtual;
  99. Public
  100. Constructor Create(ACollection : TCollection); override;
  101. Destructor Destroy; override;
  102. Function GetOutputFileName (AOs : TOS) : String; Virtual;
  103. Function NeedsCompile(ATargetDir : String;AOs : TOS) : Boolean; virtual;
  104. procedure SetName(const AValue: String);override;
  105. Procedure GetCleanFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  106. Procedure GetInstallFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  107. Procedure GetArchiveFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  108. Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
  109. Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
  110. Property HasIncludePath : Boolean Index 2 Read GetHasStrings;
  111. Property HasDependencies : Boolean Index 3 Read GetHasStrings;
  112. Property UnitPath : TStrings Index 0 Read GetStrings Write SetStrings;
  113. Property ObjectPath : TStrings Index 1 Read GetStrings Write SetStrings;
  114. Property IncludePath : TStrings Index 2 Read GetStrings Write SetStrings;
  115. Property Dependencies : TStrings Index 3 Read GetStrings Write SetStrings;
  116. Property State : TTargetState Read FTargetState;
  117. Property TargetType : TTargetType Read FTargetType Write FTargetType;
  118. Property OS : TOSes Read FOSes Write FOSes;
  119. Property Mode : TCompilerMode Read FMode Write FMode;
  120. Property Options : String Read FOptions Write Foptions;
  121. Property SourceFileName: String Read GetSourceFileName ;
  122. Property UnitFileName : String Read GetUnitFileName;
  123. Property ObjectFileName : String Read GetObjectFileName;
  124. Property RSTFileName : String Read GetRSTFileName;
  125. Property CPU : TCPUs Read FCPUs Write FCPUs;
  126. Property FPCTarget : String Read FFPCTarget Write FFPCTarget;
  127. Property Extension : String Read FExtension Write FExtension;
  128. Property FileType : TFileType Read FFileType Write FFileType;
  129. Property Directory : String Read FDirectory Write FDirectory;
  130. Property ResourceStrings : Boolean Read FResourceStrings Write FResourceStrings;
  131. Property Install : Boolean Read FInstall Write FInstall;
  132. // Events.
  133. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  134. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  135. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  136. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  137. end;
  138. { TTargets }
  139. TTargets = Class(TNamedCollection)
  140. private
  141. FDefaultCPU: TCPUs;
  142. FDefaultDir : String;
  143. FDefaultOS: TOSes;
  144. function GetTargetItem(Index : Integer): TTarget;
  145. function GetTarget(AName : String): TTarget;
  146. procedure SetDefaultDir(const AValue: String);
  147. procedure SetTargetItem(Index : Integer; const AValue: TTarget);
  148. Procedure ApplyDefaults(ATarget : TTarget);
  149. Public
  150. Procedure ResetDefaults;
  151. Function AddUnit(AUnitName : String) : TTarget;
  152. Function AddProgram(AProgramName : String) : TTarget;
  153. Function AddExampleUnit(AUnitName : String) : TTarget;
  154. Function AddExampleProgram(AProgramName : String) : TTarget;
  155. Property Targets[AName : String] : TTarget Read GetTarget; default;
  156. Property TargetItems[Index : Integer] : TTarget Read GetTargetItem Write SetTargetItem;
  157. Property DefaultDir : String Read FDefaultDir Write SetDefaultDir;
  158. Property DefaultOS : TOSes Read FDefaultOS Write FDefaultOS;
  159. Property DefaultCPU : TCPUs Read FDefaultCPU Write FDefaultCPU;
  160. end;
  161. { TPackage }
  162. TPackage = Class(TNamedItem) // Maybe descend from/use TTarget ?
  163. private
  164. FAfterArchive: TNotifyEvent;
  165. FAfterClean: TNotifyEvent;
  166. FAfterCompile: TNotifyEvent;
  167. FAfterDownload: TNotifyEvent;
  168. FAfterInstall: TNotifyEvent;
  169. FBeforeArchive: TNotifyEvent;
  170. FBeforeClean: TNotifyEvent;
  171. FBeforeCompile: TNotifyEvent;
  172. FBeforeDownload: TNotifyEvent;
  173. FBeforeInstall: TNotifyEvent;
  174. FUnitPath,
  175. FObjectPath,
  176. FIncludePath,
  177. FCleanFiles,
  178. FArchiveFiles,
  179. FInstallFiles,
  180. FDependencies: TStrings;
  181. FCPU: TCPUs;
  182. FOS: TOses;
  183. FTargetState: TTargetState;
  184. FTargets: TTargets;
  185. FDirectory: String;
  186. FOptions: String;
  187. FAuthor: String;
  188. FLicense: String;
  189. FURL: String;
  190. FVersion: String;
  191. function GetHasStrings(AIndex: integer): Boolean;
  192. function GetStrings(AIndex: integer): TStrings;
  193. procedure SetStrings(AIndex: integer; const AValue: TStrings);
  194. Public
  195. constructor Create(ACollection: TCollection); override;
  196. destructor destroy; override;
  197. Function AddTarget(AName : String) : TTarget;
  198. Procedure AddDependency(AName : String);
  199. Procedure AddInstallFile(AFileName : String);
  200. Procedure GetCleanFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
  201. procedure GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS);
  202. Procedure GetArchiveFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
  203. Function NeedsCompile(ATargetDir : String; AOS : TOS) : Boolean; virtual;
  204. Property Version : String Read FVersion Write FVersion;
  205. Property URL : String Read FURL Write FURL;
  206. Property Author : String Read FAuthor Write FAuthor;
  207. Property License : String Read FLicense Write FLicense;
  208. Property Directory : String Read FDirectory Write FDirectory;
  209. // Compiler options.
  210. Property OS : TOses Read FOS Write FOS;
  211. Property CPU : TCPUs Read FCPU Write FCPU;
  212. Property Options: String Read FOptions Write FOptions;
  213. Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
  214. Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
  215. Property HasIncludePath : Boolean Index 2 Read GetHasStrings;
  216. Property HasDependencies : Boolean Index 3 Read GetHasStrings;
  217. Property HasInstallFiles: Boolean Index 4 Read GetHasStrings;
  218. Property HasCleanFiles : Boolean Index 5 Read GetHasStrings;
  219. Property HasArchiveFiles : Boolean Index 6 Read GetHasStrings;
  220. Property UnitPath : TStrings Index 0 Read GetStrings Write SetStrings;
  221. Property ObjectPath : TStrings Index 1 Read GetStrings Write SetStrings;
  222. Property IncludePath : TStrings Index 2 Read GetStrings Write SetStrings;
  223. // Targets and dependencies
  224. Property Dependencies : TStrings Index 3 Read GetStrings Write SetStrings;
  225. Property InstallFiles : TStrings Index 4 Read GetStrings Write SetStrings;
  226. Property CleanFiles : TStrings Index 5 Read GetStrings Write SetStrings;
  227. Property ArchiveFiles : TStrings Index 6 Read GetStrings Write SetStrings;
  228. Property State : TTargetState Read FTargetState;
  229. Property Targets : TTargets Read FTargets;
  230. // events
  231. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  232. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  233. Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
  234. Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
  235. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  236. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  237. Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
  238. Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
  239. Property BeforeDownload : TNotifyEvent Read FBeforeDownload Write FBeforeDownload;
  240. Property AfterDownload : TNotifyEvent Read FAfterDownload Write FAfterDownload;
  241. end;
  242. { TPackages }
  243. TPackages = Class(TNamedCollection)
  244. private
  245. function GetPackage(AName : String): TPackage;
  246. function GetPackageItem(AIndex : Integer): TPackage;
  247. procedure SetPackageItem(AIndex : Integer; const AValue: TPackage);
  248. Public
  249. Function AddPackage(Const AName : String) : TPackage;
  250. Property Packages[AName : String] : TPackage Read GetPackage ; Default;
  251. Property PackageItems[AIndex : Integer] : TPackage Read GetPackageItem Write SetPackageItem;
  252. end;
  253. { TDefaults }
  254. TDefaults = Class(TPersistent)
  255. Private
  256. FArchive: String;
  257. FCompiler: String;
  258. FCopy: String;
  259. FDownload: String;
  260. FMkDir: String;
  261. FMove: String;
  262. FOptions: String;
  263. FCPU: TCPU;
  264. FOS: TOS;
  265. FMode : TCompilerMode;
  266. FPrefix: String;
  267. FBaseInstallDir,
  268. FUnitInstallDir,
  269. FBinInstallDir,
  270. FDocInstallDir,
  271. FExamplesInstallDir : String;
  272. FRemove: String;
  273. FTarget: String;
  274. FUnixPaths: Boolean;
  275. function GetBaseInstallDir: String;
  276. function GetBinInstallDir: String;
  277. function GetCompiler: String;
  278. function GetDocInstallDir: String;
  279. function GetExamplesInstallDir: String;
  280. function GetUnitInstallDir: String;
  281. procedure SetBaseInstallDir(const AValue: String);
  282. procedure SetCPU(const AValue: TCPU);
  283. procedure SetOS(const AValue: TOS);
  284. procedure SetPrefix(const AValue: String);
  285. procedure SetTarget(const AValue: String);
  286. Protected
  287. procedure RecalcTarget;
  288. Public
  289. Constructor Create;
  290. Procedure InitDefaults;
  291. Procedure Assign(ASource : TPersistent);override;
  292. Procedure LocalInit(Const AFileName : String);
  293. Procedure LoadFromFile(Const AFileName : String);
  294. Procedure SaveToFile(Const AFileName : String);
  295. procedure SaveToStream(S : TStream);virtual;
  296. procedure LoadFromStream(S : TStream);virtual;
  297. // Compile Information
  298. Property Target : String Read FTarget Write SetTarget;
  299. Property OS : TOS Read FOS Write SetOS;
  300. Property CPU : TCPU Read FCPU Write SetCPU;
  301. Property Mode : TCompilerMode Read FMode Write FMode;
  302. Property UnixPaths : Boolean Read FUnixPaths Write FUnixPaths;
  303. Property Options : String Read FOptions Write FOptions; // Default compiler options.
  304. // paths etc.
  305. Property Prefix : String Read FPrefix Write SetPrefix;
  306. Property BaseInstallDir : String Read GetBaseInstallDir Write SetBaseInstallDir;
  307. Property UnitInstallDir : String Read GetUnitInstallDir Write FUnitInstallDir;
  308. Property BinInstallDir : String Read GetBinInstallDir Write FBinInstallDir;
  309. Property DocInstallDir : String Read GetDocInstallDir Write FDocInstallDir;
  310. Property ExamplesInstallDir : String Read GetExamplesInstallDir Write FExamplesInstallDir;
  311. // Command tools. If not set, internal commands will be used.
  312. Property Compiler : String Read GetCompiler Write FCompiler; // Compiler. Defaults to fpc/ppc386
  313. Property Copy : String Read FCopy Write FCopy; // copy %FILES% to %DEST%
  314. Property Move : String Read FMove Write FMove; // Move %FILES% to %DEST%
  315. Property Remove : String Read FRemove Write FRemove; // Delete %FILES%
  316. Property MkDir : String Read FMkDir write FMkDir; // Make %DIRECTORY%
  317. Property Archive : String Read FArchive Write FArchive; // zip %ARCHIVE% %FILESORDIRS%
  318. Property Download : String Read FDownload Write FDownload; // wget %URL% %DESTFILE%
  319. end;
  320. { TBuildEngine }
  321. TBuildEngine = Class(TComponent)
  322. private
  323. // general variables
  324. FCompiler : String;
  325. FStartDir : String;
  326. FTargetDir : String;
  327. FDefaults : TDefaults;
  328. FForceCompile : Boolean;
  329. FListMode : Boolean;
  330. // Variables used when compiling a package.
  331. // Only valid during compilation of the package.
  332. FCurrentPackage: TPackage;
  333. // Events
  334. FOnLog: TLogEvent;
  335. FAfterArchive: TNotifyEvent;
  336. FAfterClean: TNotifyEvent;
  337. FAfterCompile: TNotifyEvent;
  338. FAfterDownload: TNotifyEvent;
  339. FAfterInstall: TNotifyEvent;
  340. FBeforeArchive: TNotifyEvent;
  341. FBeforeClean: TNotifyEvent;
  342. FBeforeCompile: TNotifyEvent;
  343. FBeforeDownload: TNotifyEvent;
  344. FBeforeInstall: TNotifyEvent;
  345. procedure SetDefaults(const AValue: TDefaults);
  346. procedure SetTargetDir(const AValue: String);
  347. Protected
  348. Procedure Error(Msg : String);
  349. Procedure Error(Fmt : String; Args : Array of const);
  350. // Internal copy/delete/move/archive/mkdir files
  351. Procedure SysCopyFile(Const Src,Dest : String); virtual;
  352. Procedure SysMoveFile(Const Src,Dest : String); virtual;
  353. Procedure SysDeleteFile(Const AFileName : String); virtual;
  354. Procedure SysArchiveFiles(List : TStrings; Const AFileName : String); virtual;
  355. Procedure Log(Level : TVerboseLevel; Const Msg : String);
  356. Procedure Log(Level : TVerboseLevel; Const Fmt : String; Args : Array Of Const);
  357. Procedure EnterDir(ADir : String);
  358. Function GetCompiler : String;
  359. Procedure InstallPackageFiles(APAckage : TPackage; tt : TTargetType; Const Src,Dest : String); virtual;
  360. Public
  361. Constructor Create(AOwner : TComponent); override;
  362. // Public Copy/delete/Move/Archive/Mkdir Commands.
  363. Procedure ExecuteCommand(Cmd : String; Args : String); virtual;
  364. Procedure CmdCopyFiles(List : TStrings; Const DestDir : String);
  365. Procedure CmdCreateDir(DestDir : String);
  366. Procedure CmdMoveFiles(List : TStrings; Const DestDir : String);
  367. Procedure CmdDeleteFiles(List : TStrings);
  368. Procedure CmdArchiveFiles(List : TStrings; Const ArchiveFile : String);
  369. // Target commands
  370. Function GetTargetDir(APackage : TPackage; ATarget : TTarget; AbsolutePath : Boolean = False) : String;
  371. Function GetCompilerCommand(APackage : TPackage; Target : TTarget) : String;
  372. Function TargetOK(Target : TTarget) : Boolean;
  373. Procedure Compile(Target : TTarget); virtual;
  374. Procedure FixDependencies(Target: TTarget);
  375. // Package commands
  376. Function GetPackageDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  377. Function GetOutputDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  378. Function PackageOK(APackage : TPackage) : Boolean;
  379. Procedure Compile(APackage : TPackage); virtual;
  380. Procedure Install(APackage : TPackage); virtual;
  381. Procedure Archive(APackage : TPackage); virtual;
  382. Procedure Clean(APackage : TPackage); virtual;
  383. Procedure Download(APackage : TPackage); virtual;
  384. Procedure FixDependencies(APackage : TPackage);virtual;
  385. procedure CheckExternalPackage(Const APackageName : String); virtual;
  386. procedure CreateOutputDir(APackage: TPackage);
  387. // Packages commands
  388. Procedure Compile(Packages : TPackages);
  389. Procedure Install(Packages : TPackages);
  390. Procedure Archive(Packages : TPackages);
  391. Procedure Clean(Packages : TPackages);
  392. Procedure Download(Packages : TPackages);
  393. Property ListMode : Boolean Read FListMode Write FListMode;
  394. Property ForceCompile : Boolean Read FForceCompile Write FForceCompile;
  395. Property Defaults : TDefaults Read FDefaults Write SetDefaults;
  396. Property TargetDir : String Read FTargetDir Write SetTargetDir;
  397. // Events
  398. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  399. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  400. Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
  401. Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
  402. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  403. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  404. Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
  405. Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
  406. Property BeforeDownload : TNotifyEvent Read FBeforeDownload Write FBeforeDownload;
  407. Property AfterDownload : TNotifyEvent Read FAfterDownload Write FAfterDownload;
  408. Property OnLog : TLogEvent Read FOnLog Write FOnlog;
  409. end;
  410. { TInstaller }
  411. TInstaller = Class(TComponent)
  412. private
  413. FBuildEngine: TBuildEngine;
  414. FDefaultPackage: TPackage;
  415. FDefaults: TDefaults;
  416. FPackages: TPackages;
  417. FRunMode: TRunMode;
  418. FListMode : Boolean;
  419. FLogLevels : TVerboseLevels;
  420. function GetAuthor: String;
  421. function GetStrings(AIndex : Integer): TStrings;
  422. function GetDirectory: String;
  423. function GetLicense: String;
  424. function GetOSes: TOSes;
  425. function GetOptions: String;
  426. function GetTargets: TTargets;
  427. function GetURL: String;
  428. function GetVersion: String;
  429. procedure SetAuthor(const AValue: String);
  430. procedure SetDefaultPackage(const AValue: TPackage);
  431. procedure SetDefaults(const AValue: TDefaults);
  432. procedure SetStrings(AIndex : Integer; const AValue: TStrings);
  433. procedure SetDirectory(const AValue: String);
  434. procedure SetOptions(const AValue: String);
  435. procedure SetOses(const AValue: TOSes);
  436. procedure SetURL(const AValue: String);
  437. procedure SetVersion(const AValue: String);
  438. procedure SetLicense(const AValue: String);
  439. Protected
  440. Procedure Log(Level : TVerboseLevel; Const Msg : String);
  441. Procedure CreatePackages; virtual;
  442. Procedure CheckPackages; virtual;
  443. Procedure CreateBuildEngine; virtual;
  444. Procedure CheckDefaultPackage;
  445. Procedure Error(Msg : String);
  446. Procedure Error(Fmt : String; Args : Array of const);
  447. Procedure AnalyzeOptions;
  448. Procedure Usage(FMT : String; Args : Array of const);
  449. Procedure Compile(Force : Boolean); virtual;
  450. Procedure Clean; virtual;
  451. Procedure Install; virtual;
  452. Procedure Archive; virtual;
  453. Procedure Download; Virtual;
  454. Property BuildEngine : TBuildEngine Read FBuildEngine;
  455. Public
  456. Constructor Create(AOWner : TComponent); override;
  457. Destructor destroy; override;
  458. Function StartPackage(Const AName : String) : TPackage;
  459. Procedure EndPackage;
  460. Function Run : Boolean;
  461. Function AddTarget(AName : String) : TTarget;
  462. Procedure AddDependency(AName : String);
  463. Property DefaultPackage : TPackage read FDefaultPackage write SetDefaultPackage;
  464. Property Packages : TPackages Read FPackages;
  465. Property Dependencies : TStrings Index 0 Read GetStrings Write SetStrings;
  466. Property InstallFiles : TStrings Index 1 Read GetStrings Write SetStrings;
  467. Property CleanFiles : TStrings Index 2 Read GetStrings Write SetStrings;
  468. Property ArchiveFiles : TStrings Index 3 Read GetStrings Write SetStrings;
  469. Property Defaults : TDefaults Read FDefaults Write SetDefaults;
  470. Property RunMode : TRunMode Read FRunMode;
  471. Property ListMode : Boolean Read FListMode;
  472. // Default Package redirects.
  473. Property Targets : TTargets Read GetTargets;
  474. Property Version : String Read GetVersion Write SetVersion;
  475. Property URL : String Read GetURL Write SetURL;
  476. Property Author : String Read GetAuthor Write SetAuthor;
  477. Property License : String Read GetLicense Write SetLicense;
  478. Property Directory : String Read GetDirectory Write SetDirectory;
  479. Property Options : String Read GetOptions Write SetOptions;
  480. Property OS: TOSes Read GetOSes Write SetOses;
  481. end;
  482. ECollectionError = Class(Exception);
  483. EInstallerError = Class(Exception);
  484. Const
  485. // Aliases
  486. AmD64 = X86_64;
  487. PowerPC = PPC;
  488. dos = go32v2;
  489. // Useful
  490. UnitExt = '.ppu';
  491. PPUExt = UnitExt;
  492. PasExt = '.pas';
  493. PPExt = '.pp';
  494. IncExt = '.inc';
  495. ObjExt = '.o';
  496. RstExt = '.rst';
  497. LibExt = '.a';
  498. SharedLibExt = '.so';
  499. DLLExt = '.dll';
  500. ExeExt = '.exe';
  501. // Targets
  502. i386_Linux = 'i386-linux';
  503. i386_Win32 = 'i386-win32';
  504. i386_Dos = 'i386-go32v2';
  505. i386_OS2 = 'i386-os2';
  506. i386_FreeBSD = 'i386-freebsd';
  507. i386_NetBSD = 'i386-netsd';
  508. i386_OpenBSD = 'i386-openbsd';
  509. i386_netware = 'i386-netware';
  510. i386_netwlibc = 'i386-netwlibc';
  511. i386_go32v2 = 'i386-go32v2';
  512. PPC_Linux = 'ppc-linux';
  513. powerpc_linux = PPC_linux;
  514. sparc_linux = 'sparc-linux';
  515. arm_linux = 'arm-linux';
  516. ppc_macos = 'ppc-macos';
  517. ppc_darwin = 'ppc-darwin';
  518. UnitTargets = [ttUnit,ttExampleUnit];
  519. ProgramTargets = [ttProgram,ttExampleProgram];
  520. AllMessages = [vlError,vlWarning,vlInfo,vlCompare,vlCommand];
  521. Var
  522. Installer : TInstaller;
  523. Defaults : TDefaults; // Set by installer.
  524. Function OSToString(OS: TOS) : String;
  525. Function OSesToString(OSes: TOSes) : String;
  526. Function CPUToString(CPU: TCPU) : String;
  527. Function CPUSToString(CPUS: TCPUS) : String;
  528. Function StringToOS(S : String) : TOS;
  529. Function OSesToString(S : String) : TOSes;
  530. Function StringToCPU(S : String) : TCPU;
  531. Function StringToCPUS(S : String) : TCPUS;
  532. Function ModeToString(Mode: TCompilerMode) : String;
  533. Function StringToMode(S : String) : TCompilerMode;
  534. Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
  535. Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
  536. Procedure ResolveDependencies(L : TStrings; P : TNamedCollection);
  537. Function AddStrings(Dest,Src : TStrings) : Integer ;
  538. function AddStrings(Dest, Src : TStrings; Const APrefix : String) : Integer ;
  539. Function FileListToString(List : TStrings; Prefix : String) : String;
  540. Function FixPath (APath : String) : String;
  541. Procedure ChangeDir(APath : String);
  542. Implementation
  543. uses TypInfo;
  544. ResourceString
  545. SErrNameExists = 'Name "%s" already exists in the collection.';
  546. SErrNoSuchName = 'Could not find item with name "%s" in the collection.';
  547. SErrInvalidCPU = 'Invalid CPU name : "%s"';
  548. SErrInvalidOS = 'Invalid OS name : "%s"';
  549. SErrInvalidMode = 'Invalid compiler mode : "%s"';
  550. SErrNoPackage = 'No package available. Add package with StartPackage Call';
  551. SErrInValidArgument = 'Invalid command-line argument at position %d : %s';
  552. SErrNeedArgument = 'Option at position %d (%s) needs an argument';
  553. SErrInvalidTarget = 'Invalid compiler target: %s';
  554. SErrNoPackagesDefined = 'No action possible: No packages were defined.';
  555. SErrInstaller = 'The installer encountered the following error:';
  556. SErrDepUnknownTarget = 'Unknown target in dependencies for %s: %s';
  557. SErrExternalCommandFailed = 'External command "%s" failed with exit code: %d';
  558. SErrCreatingDirectory = 'Failed to create directory: %s';
  559. SErrDeletingFile = 'Failed to delete file: %s';
  560. SErrMovingFile = 'Failed to move file "%s" to "%s"';
  561. SErrCopyingFile = 'Failed to copy file "%s" to "%s"';
  562. SErrChangeDirFailed = 'Failed to enter directory: %s';
  563. SWarnCircularDependency = 'Warning: Circular dependency detected when compiling target %s: %s';
  564. SWarnFailedToSetTime = 'Warning: Failed to set timestamp on file : %s';
  565. SWarnFailedToGetTime = 'Warning: Failed to get timestamp from file : %s';
  566. SWarnFileDoesNotExist = 'Warning: File "%s" does not exist';
  567. // Log messages
  568. SLogEnterDir = 'Entering directory: %s';
  569. SLogCompilingPackage = 'Compiling package : %s';
  570. SLogCompilingTarget = 'Compiling target : %s';
  571. SLogExecutingCommand = 'Executing command %s with options: %s';
  572. SLogCreatingOutputDir = 'Creating output dir : %s';
  573. SLogInstallingPackage = 'Installing package : %s';
  574. SLogArchivingPackage = 'Archiving package : %s';
  575. SLogCleaningPackage = 'Cleaning package : %s';
  576. SLogDownloadingPackage = 'Downloading package : %s';
  577. SLogCopyingFile = 'Copying file "%s" to "%s"';
  578. Const
  579. // Keys for Defaults file. Do not localize.
  580. KeyCompiler = 'Compiler';
  581. KeyArchive = 'Archive';
  582. KeyCopy = 'Copy';
  583. KeyDownLoad = 'Download';
  584. KeyMkDir = 'MkDir';
  585. KeyMove = 'Move';
  586. KeyRemove = 'Remove';
  587. KeyOptions = 'Options';
  588. KeyCPU = 'CPU';
  589. KeyOS = 'OS';
  590. KeyMode = 'Mode';
  591. KeyPrefix = 'Prefix';
  592. KeyTarget = 'Target';
  593. KeyBaseInstallDir = 'BaseInstallDir';
  594. KeyUnitInstallDir = 'UnitInstallDir';
  595. KeyBinInstallDir = 'BinInstallDir';
  596. KeyDocInstallDir = 'DocInstallDir';
  597. KeyExamplesInstallDir = 'ExamplesInstallDir';
  598. // Callback for Sysutils getapplicationname.
  599. Function GetFPMakeName : String;
  600. begin
  601. Result:='fpmake';
  602. end;
  603. Function OSToString(OS: TOS) : String;
  604. begin
  605. Result:=LowerCase(GetenumName(TypeInfo(TOS),Ord(OS)));
  606. end;
  607. Function OSesToString(OSes: TOSes) : String;
  608. begin
  609. Result:=LowerCase(SetToString(TypeInfo(TOSes),Integer(OSes),False));
  610. end;
  611. Function CPUToString(CPU: TCPU) : String;
  612. begin
  613. Result:=LowerCase(GetenumName(TypeInfo(TCPU),Ord(CPU)));
  614. end;
  615. Function CPUSToString(CPUS: TCPUS) : String;
  616. begin
  617. Result:=LowerCase(SetToString(TypeInfo(TOSes),Integer(CPUS),False));
  618. end;
  619. Function StringToOS(S : String) : TOS;
  620. Var
  621. I : Integer;
  622. begin
  623. I:=GetEnumValue(TypeInfo(TOS),S);
  624. if (I=-1) then
  625. Raise EInstallerError.CreateFmt(SErrInvalidOS,[S]);
  626. Result:=TOS(I);
  627. end;
  628. Function OSesToString(S : String) : TOSes;
  629. begin
  630. Result:=TOSes(StringToSet(TypeInfo(TOSes),S));
  631. end;
  632. Function StringToCPU(S : String) : TCPU;
  633. Var
  634. I : Integer;
  635. begin
  636. I:=GetEnumValue(TypeInfo(TCPU),S);
  637. if (I=-1) then
  638. Raise EInstallerError.CreateFmt(SErrInvalidCPU,[S]);
  639. Result:=TCPU(I);
  640. end;
  641. Function StringToCPUS(S : String) : TCPUS;
  642. begin
  643. Result:=TCPUS(StringToSet(TypeInfo(TCPUS),S));
  644. end;
  645. Function ModeToString(Mode: TCompilerMode) : String;
  646. begin
  647. Result:=LowerCase(GetenumName(TypeInfo(TCompilerMode),Ord(Mode)));
  648. end;
  649. Function StringToMode(S : String) : TCompilerMode;
  650. Var
  651. I : Integer;
  652. begin
  653. I:=GetEnumValue(TypeInfo(TCompilerMode),S);
  654. if (I=-1) then
  655. Raise EInstallerError.CreateFmt(SErrInvalidMode,[S]);
  656. Result:=TCompilerMode(I);
  657. end;
  658. Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
  659. begin
  660. Result:=CPUToString(CPU)+'-'+OSToString(OS);
  661. end;
  662. Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
  663. Var
  664. P : integer;
  665. begin
  666. P:=Pos('-',S);
  667. If (P=0) then
  668. Raise EInstallerError.CreateFmt(SErrInvalidTarget,[S]);
  669. CPU:=StringToCPU(Copy(S,1,P-1));
  670. OS:=StringToOs(Copy(S,P+1,Length(S)-P));
  671. end;
  672. Procedure ResolveDependencies(L : TStrings; P : TNamedCollection);
  673. Var
  674. I,J : Integer;
  675. begin
  676. If Assigned(L) then
  677. For I:=0 to L.Count-1 do
  678. begin
  679. J:=P.IndexOfName(L[i]);
  680. If J<>-1 then
  681. L.Objects[I]:=P.Items[J];
  682. end;
  683. end;
  684. Function AddStrings(Dest,Src : TStrings) : Integer ;
  685. begin
  686. Result:=AddStrings(Dest,Src,'');
  687. end;
  688. Procedure AddStrings(Var S : String; L : TStrings; Prefix : String);
  689. Var
  690. I : Integer;
  691. begin
  692. For I:=0 to L.Count-1 do
  693. begin
  694. if (S<>'') then
  695. S:=S+' ';
  696. S:=S+Prefix+L[i];
  697. end;
  698. end;
  699. function AddStrings(Dest, Src : TStrings; Const APrefix : String) : Integer ;
  700. begin
  701. Result:=0;
  702. While (Result<Src.Count) do
  703. begin
  704. If (APrefix<>'') then
  705. Dest.Add(APrefix+Src[Result]) // Not sure whether '' is optimized away.
  706. else
  707. Dest.Add(Src[Result]);
  708. Inc(Result);
  709. end;
  710. end;
  711. function FileListToString(List : TStrings; Prefix : String) : String;
  712. Var
  713. I : integer;
  714. S : String;
  715. begin
  716. Result:='';
  717. For I:=0 to List.Count-1 do
  718. begin
  719. If (I>0) then
  720. Result:=Result+' ';
  721. S:=Prefix+List[i];
  722. If (Pos(' ',S)<>0) then
  723. S:='"'+S+'"';
  724. Result:=Result+S;
  725. end;
  726. end;
  727. function FixPath (APath : String) : String;
  728. Var
  729. P : PChar;
  730. begin
  731. Result:=APath;
  732. If (result<>'') then
  733. begin
  734. P:=PChar(Result);
  735. While (P^<>#0) do
  736. begin
  737. If P^ in ['/','\',':'] then // do not use drive letters.
  738. P^:=PathDelim;
  739. Inc(P);
  740. end;
  741. end;
  742. end;
  743. procedure ChangeDir(APath : String);
  744. begin
  745. if Not SetCurrentDir(APath) then
  746. Raise EInstallerError.CreateFmt(SErrChangeDirFailed,[APath]);
  747. end;
  748. { TNamedItem }
  749. procedure TNamedItem.SetName(const AValue: String);
  750. begin
  751. if FName=AValue then exit;
  752. With TNamedCollection(Collection) do
  753. If UniqueNames then
  754. If (IndexOfName(AVAlue)<>-1) then
  755. Raise ECollectionError.CreateFmt(SErrNameExists,[AValue]);
  756. FName:=AValue;
  757. end;
  758. { TNamedCollection }
  759. function TNamedCollection.IndexOfName(AName: String): Integer;
  760. begin
  761. Result:=Count-1;
  762. While (Result>=0) and (CompareText(TNamedItem(Items[Result]).FName,AName)<>0) do
  763. Dec(Result);
  764. end;
  765. function TNamedCollection.ItemByName(AName: String): TNamedItem;
  766. Var
  767. I : Integer;
  768. begin
  769. I:=IndexOfName(AName);
  770. If (I=-1) Then
  771. Raise ECollectionError.CreateFmt(SErrNoSuchName,[AName]);
  772. Result:=TNamedItem(Items[i]);
  773. end;
  774. { TFileItem }
  775. function TFileItem.GetExtension: String;
  776. begin
  777. Result:=ExtractFileExt(Name);
  778. end;
  779. function TFileItem.GetPath: String;
  780. begin
  781. Result:=ExtractFilePath(Name);
  782. end;
  783. { TTargets }
  784. function TTargets.GetTargetItem(Index : Integer): TTarget;
  785. begin
  786. Result:=TTarget(Items[Index]);
  787. end;
  788. function TTargets.GetTarget(AName : String): TTarget;
  789. begin
  790. Result:=TTarget(ItemByName(AName));
  791. end;
  792. procedure TTargets.SetDefaultDir(const AValue: String);
  793. begin
  794. If (AValue<>'') then
  795. FDefaultDir:=IncludeTrailingPathDelimiter(AValue)
  796. else
  797. FDefaultDir:='';
  798. end;
  799. procedure TTargets.SetTargetItem(Index : Integer; const AValue: TTarget);
  800. begin
  801. Items[Index]:=AValue;
  802. end;
  803. procedure TTargets.ApplyDefaults(ATarget: TTarget);
  804. begin
  805. If (ATarget.Directory='') then
  806. ATarget.Directory:=FDefaultDir;
  807. ATarget.OS:=FDefaultOS;
  808. ATarget.CPU:=FDefaultCPU;
  809. end;
  810. procedure TTargets.ResetDefaults;
  811. begin
  812. FDefaultDir:='';
  813. FDefaultOS:=[];
  814. FDefaultCPU:=[];
  815. end;
  816. Function TTargets.AddUnit(AUnitName: String) : TTarget;
  817. begin
  818. Result:=Add as TTarget;
  819. Result.Name:=AUnitName;
  820. Result.TargetType:=TTUnit;
  821. ApplyDefaults(Result);
  822. end;
  823. Function TTargets.AddProgram(AProgramName: String) : TTarget;
  824. begin
  825. Result:=Add as TTarget;
  826. Result.Name:=AProgramName;
  827. Result.TargetType:=ttProgram;
  828. ApplyDefaults(Result);
  829. end;
  830. Function TTargets.AddExampleUnit(AUnitName: String): TTarget;
  831. begin
  832. Result:=Add as TTarget;
  833. Result.Name:=AUnitName;
  834. Result.TargetType:=ttExampleUnit;
  835. ApplyDefaults(Result);
  836. end;
  837. Function TTargets.AddExampleProgram(AProgramName: String): TTarget;
  838. begin
  839. Result:=Add as TTarget;
  840. Result.Name:=AProgramName;
  841. Result.TargetType:=ttExampleProgram;
  842. ApplyDefaults(Result);
  843. end;
  844. { TNamedItemList }
  845. function TNamedItemList.GetNamedItem(Index : Integer): TNamedItem;
  846. begin
  847. Result:=TNamedItem(Items[Index]);
  848. end;
  849. procedure TNamedItemList.SetNamedItem(Index : Integer; const AValue: TNamedItem);
  850. begin
  851. Items[Index]:=AValue;
  852. end;
  853. function TNamedItemList.IndexOfName(AName: String): Integer;
  854. begin
  855. Result:=Count-1;
  856. While (Result>=0) and (CompareText(GetNamedItem(Result).Name,AName)<>0) do
  857. Dec(Result);
  858. end;
  859. function TNamedItemList.ItemByName(ANAme: String): TNamedItem;
  860. Var
  861. I : Integer;
  862. begin
  863. I:=IndexOfName(AName);
  864. If (I=-1) Then
  865. Raise ECollectionError.CreateFmt(SErrNoSuchName,[AName]);
  866. Result:=TNamedItem(Items[i]);
  867. end;
  868. { TDefaults }
  869. procedure TDefaults.SetCPU(const AValue: TCPU);
  870. begin
  871. FCPU:=AValue;
  872. RecalcTarget;
  873. end;
  874. function TDefaults.GetBaseInstallDir: String;
  875. begin
  876. If (FBaseInstallDir<>'') then
  877. Result:=FBaseInstallDir
  878. else
  879. if UnixPaths then
  880. Result:=Prefix+PathDelim+'lib'+PathDelim+'fpc'
  881. else
  882. Result:=Prefix;
  883. end;
  884. function TDefaults.GetBinInstallDir: String;
  885. begin
  886. If (FBinInstallDir<>'') then
  887. Result:=FBinInstallDir
  888. else
  889. If UnixPaths then
  890. Result:=BaseInstallDir+PathDelim+'bin'
  891. else
  892. Result:=BaseInstallDir+PathDelim+'bin';
  893. end;
  894. function TDefaults.GetCompiler: String;
  895. begin
  896. If (FCompiler<>'') then
  897. Result:=FCompiler
  898. else
  899. Case CPU of
  900. i386 : Result:='ppc386';
  901. PowerPC : Result:='ppcppc';
  902. sparc : Result:='ppcsparc';
  903. arm : Result:='ppcarm';
  904. x86_64 : Result:='ppcx64';
  905. end;
  906. end;
  907. function TDefaults.GetDocInstallDir: String;
  908. begin
  909. If (FBinInstallDir<>'') then
  910. Result:=FBinInstallDir
  911. else
  912. If UnixPaths then
  913. Result:=Prefix+PathDelim+'share'+PathDelim+'docs'
  914. else
  915. Result:=BaseInstallDir+PathDelim+'docs';
  916. end;
  917. function TDefaults.GetExamplesInstallDir: String;
  918. begin
  919. If (FExamplesInstallDir<>'') then
  920. Result:=FExamplesInstallDir
  921. else
  922. If UnixPaths then
  923. Result:=Prefix+PathDelim+'share'+PathDelim+'docs'+PathDelim+'examples'
  924. else
  925. Result:=BaseInstallDir+PathDelim+'examples';
  926. end;
  927. function TDefaults.GetUnitInstallDir: String;
  928. begin
  929. If (FUnitInstallDir<>'') then
  930. Result:=FBinInstallDir
  931. else
  932. If UnixPaths then
  933. Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target
  934. else
  935. Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target;
  936. end;
  937. procedure TDefaults.SetBaseInstallDir(const AValue: String);
  938. begin
  939. FBaseInstallDir:=AValue;
  940. UnitInstallDir:='';
  941. BinInstallDir:='';
  942. ExamplesInstallDir:='';
  943. end;
  944. procedure TDefaults.SetOS(const AValue: TOS);
  945. begin
  946. FOS:=AValue;
  947. Recalctarget;
  948. end;
  949. procedure TDefaults.SetPrefix(const AValue: String);
  950. begin
  951. if FPrefix=AValue then exit;
  952. FPrefix:=AValue;
  953. BaseInstallDir:='';
  954. end;
  955. procedure TDefaults.SetTarget(const AValue: String);
  956. Var
  957. P : Integer;
  958. begin
  959. if FTarget<>AValue then
  960. begin
  961. P:=Pos('-',AValue);
  962. If (P<>0) then
  963. begin
  964. FOS:=StringToOS(System.Copy(Avalue,P+1,Length(AValue)-P));
  965. FCPU:=StringToCPU(System.Copy(Avalue,1,P-1));
  966. end
  967. else
  968. FOS:=StringToOS(AValue);
  969. FTarget:=AValue;
  970. end;
  971. end;
  972. procedure TDefaults.RecalcTarget;
  973. begin
  974. Ftarget:=CPUToString(FCPU)+'-'+OStoString(FOS);
  975. end;
  976. constructor TDefaults.Create;
  977. begin
  978. InitDefaults;
  979. end;
  980. procedure TDefaults.InitDefaults;
  981. begin
  982. {$ifdef unix}
  983. UnixPaths:=True;
  984. {$else}
  985. UnixPaths:=False;
  986. {$endif}
  987. // Code to init defaults for compiled platform.
  988. CPU:=StringToCPU({$I %FPCTARGETCPU%});
  989. OS:=StringToOS({$I %FPCTARGETOS%});
  990. Compiler:='ppc386';
  991. end;
  992. procedure TDefaults.Assign(ASource: TPersistent);
  993. Var
  994. d : TDefaults;
  995. begin
  996. If ASource is TDefaults then
  997. begin
  998. D:=ASource as TDefaults;
  999. FArchive:=D.Farchive;
  1000. FCompiler:=D.Compiler;
  1001. FCopy:=D.FCopy;
  1002. FCPU:=D.FCPU;
  1003. FMode:=D.FMode;
  1004. FDownload:=D.FDownload;
  1005. FMkDir:=D.FDownload;
  1006. FMove:=D.FDownload;
  1007. FOptions:=D.FOptions;
  1008. FOS:=D.FOS;
  1009. FPrefix:=D.FPrefix;
  1010. FBaseInstallDir:=D.FBaseInstallDir;
  1011. FUnitInstallDir:=D.FUnitInstallDir;
  1012. FBinInstallDir:=D.FBinInstallDir;
  1013. FDocInstallDir:=D.FDocInstallDir;
  1014. FExamplesInstallDir:=D.FExamplesInstallDir;
  1015. FRemove:=D.FRemove;
  1016. FTarget:=D.FTarget;
  1017. FUnixPaths:=D.FUnixPaths;
  1018. end;
  1019. end;
  1020. procedure TDefaults.LocalInit(Const AFileName : String);
  1021. Var
  1022. FN : String;
  1023. begin
  1024. FN:=AFileName;
  1025. If (FN='') then
  1026. begin
  1027. // Environment variable.
  1028. FN:=GetEnvironmentVariable('FPMAKECFG');
  1029. If (FN<>'') then
  1030. If not FileExists(FN) then
  1031. FN:='';
  1032. // User config file fpmake.cfg
  1033. If (FN='') then
  1034. begin
  1035. FN:=GetAppConfigFile(False);
  1036. If Not FileExists(FN) then
  1037. FN:='';
  1038. end;
  1039. // Global config file fpmake.cfg
  1040. If (FN='') then
  1041. begin
  1042. FN:=GetAppConfigFile(True);
  1043. If Not FileExists(FN) then
  1044. FN:='';
  1045. end;
  1046. end;
  1047. If (FN<>'') and FileExists(FN) then
  1048. LoadFromFile(FN)
  1049. // Code to find local config file and load it using LoadFromFile.
  1050. end;
  1051. procedure TDefaults.LoadFromFile(Const AFileName: String);
  1052. Var
  1053. F : TFileStream;
  1054. begin
  1055. F:=TFileStream.Create(AFileName,fmOpenRead);
  1056. Try
  1057. LoadFromStream(F);
  1058. Finally
  1059. F.Free;
  1060. end;
  1061. end;
  1062. procedure TDefaults.SaveToFile(Const AFileName: String);
  1063. Var
  1064. F : TFileStream;
  1065. begin
  1066. F:=TFileStream.Create(AFileName,fmCreate);
  1067. Try
  1068. SaveToStream(F);
  1069. Finally
  1070. F.Free;
  1071. end;
  1072. end;
  1073. procedure TDefaults.SaveToStream(S : TStream);
  1074. Var
  1075. L : TStringList;
  1076. begin
  1077. L:=TStringList.Create;
  1078. try
  1079. With L do
  1080. begin
  1081. Values[KeyArchive]:=FArchive;
  1082. Values[KeyCompiler]:=FCompiler;
  1083. Values[KeyCopy]:=FCopy;
  1084. Values[KeyDownLoad]:=FDownload;
  1085. Values[KeyMkDir]:=FMkDir;
  1086. Values[KeyMove]:=FMove;
  1087. Values[KeyOptions]:=FOptions;
  1088. Values[KeyCPU]:=CPUToString(FCPU);
  1089. Values[KeyOS]:=OSToString(FOS);
  1090. Values[KeyMode]:=ModeToString(FMode);
  1091. Values[KeyPrefix]:=FPrefix;
  1092. Values[KeyBaseInstallDir]:=FBaseInstallDir;
  1093. Values[KeyUnitInstallDir]:=FUnitInstallDir;
  1094. Values[KeyBinInstallDir]:=FBinInstallDir;
  1095. Values[KeyDocInstallDir]:=FDocInstallDir;
  1096. Values[KeyExamplesInstallDir]:=FExamplesInstallDir;
  1097. Values[KeyRemove]:=FRemove;
  1098. Values[KeyTarget]:=FTarget;
  1099. end;
  1100. L.SaveToStream(S);
  1101. Finally
  1102. L.Free;
  1103. end;
  1104. end;
  1105. procedure TDefaults.LoadFromStream(S: TStream);
  1106. Var
  1107. L : TStrings;
  1108. Line : String;
  1109. I,P,PC : Integer;
  1110. begin
  1111. L:=TStringList.Create;
  1112. Try
  1113. L.LoadFromStream(S);
  1114. // Fix lines.
  1115. For I:=L.Count-1 downto 0 do
  1116. begin
  1117. Line:=L[I];
  1118. P:=Pos('=',Line);
  1119. PC:=Pos(';',Line); // Comment line.
  1120. If (P=0) or ((PC<>0) and (PC<P)) then
  1121. L.Delete(I)
  1122. else
  1123. L[i]:=Trim(System.Copy(Line,1,P-1)+'='+Trim(System.Copy(Line,P+1,Length(Line)-P)));
  1124. end;
  1125. With L do
  1126. begin
  1127. FArchive:=Values[KeyArchive];
  1128. FCompiler:=Values[KeyCompiler];
  1129. FDownload:=Values[KeyDownLoad];
  1130. FCopy:=Values[KeyCopy];
  1131. FMkDir:=Values[KeyMkDir];
  1132. FMove:=Values[KeyMove];
  1133. FRemove:=Values[KeyRemove];
  1134. FOptions:=Values[KeyOptions];
  1135. Line:=Values[KeyCPU];
  1136. If (Line<>'') then
  1137. FCPU:=StringToCPU(Line);
  1138. Line:=Values[KeyOS];
  1139. If (Line<>'') then
  1140. FOS:=StringToOS(Line);
  1141. Line:=Values[KeyMode];
  1142. If (Line<>'') then
  1143. FMode:=StringToMode(Line);
  1144. FTarget:=Values[KeyTarget];
  1145. FPrefix:=Values[KeyPrefix];
  1146. FBaseInstallDir:=Values[KeyBaseInstallDir];
  1147. FUnitInstallDir:=Values[KeyUnitInstallDir];
  1148. FBinInstallDir:=Values[KeyBinInstallDir];
  1149. FDocInstallDir:=Values[KeyDocInstallDir];
  1150. FExamplesInstallDir:=Values[KeyExamplesInstallDir];
  1151. end;
  1152. Finally
  1153. L.Free;
  1154. end;
  1155. end;
  1156. { TPackage }
  1157. function TPackage.GetHasStrings(AIndex: integer): Boolean;
  1158. begin
  1159. Result:=False;
  1160. Case AIndex Of
  1161. 0 : Result:=FUnitPath<>Nil;
  1162. 1 : Result:=FObjectPath<>Nil;
  1163. 2 : Result:=FIncludePath<>Nil;
  1164. 3 : Result:=FDependencies<>Nil;
  1165. 4 : Result:=FInstallFiles<>Nil;
  1166. 5 : Result:=FCleanFiles<>Nil;
  1167. 6 : Result:=FArchiveFiles<>Nil;
  1168. end;
  1169. end;
  1170. function TPackage.GetStrings(AIndex: integer): TStrings;
  1171. Function EnsureStrings(Var S : TStrings) : TStrings;
  1172. begin
  1173. If (S=Nil) then
  1174. S:=TStringList.Create;
  1175. Result:=S;
  1176. end;
  1177. begin
  1178. Result:=Nil;
  1179. Case AIndex Of
  1180. 0 : Result:=EnsureStrings(FUnitPath);
  1181. 1 : Result:=EnsureStrings(FObjectPath);
  1182. 2 : Result:=EnsureStrings(FIncludePath);
  1183. 3 : begin
  1184. Result:=EnsureStrings(FDependencies);
  1185. With TStringList(Result) do
  1186. if (Count=0) then
  1187. begin
  1188. Sorted:=True;
  1189. Duplicates:=dupError;
  1190. end;
  1191. end;
  1192. 4 : Result:=EnsureStrings(FInstallFiles);
  1193. 5 : Result:=EnsureStrings(FCleanFiles);
  1194. 6 : Result:=EnsureStrings(FArchiveFiles);
  1195. end;
  1196. end;
  1197. procedure TPackage.SetStrings(AIndex: integer; const AValue: TStrings);
  1198. begin
  1199. GetStrings(AIndex).Assign(AValue);
  1200. end;
  1201. constructor TPackage.Create(ACollection: TCollection);
  1202. Var
  1203. L : TStringList;
  1204. begin
  1205. inherited Create(ACollection);
  1206. FTargets:=TTargets.Create(TTarget);
  1207. L:=TStringList.Create;
  1208. FDependencies:=L;
  1209. FInstallFiles:=TStringList.Create;
  1210. FCleanFiles:=TStringList.Create;
  1211. FArchiveFiles:=TStringList.Create;
  1212. end;
  1213. destructor TPackage.destroy;
  1214. begin
  1215. FreeAndNil(FDependencies);
  1216. FreeAndNil(FInstallFiles);
  1217. FreeAndNil(FCleanFiles);
  1218. FreeAndNil(FArchiveFiles);
  1219. FreeAndNil(FIncludePath);
  1220. FreeAndNil(FObjectPath);
  1221. FreeAndNil(FUnitPath);
  1222. FreeAndNil(FTargets);
  1223. inherited destroy;
  1224. end;
  1225. function TPackage.AddTarget(AName: String): TTarget;
  1226. begin
  1227. Result:=Targets.Add as TTarget;
  1228. Result.Name:=AName;
  1229. end;
  1230. procedure TPackage.AddDependency(AName: String);
  1231. begin
  1232. If FDependencies.IndexOf(AName)=-1 then
  1233. FDependencies.Add(AName);
  1234. end;
  1235. procedure TPackage.AddInstallFile(AFileName: String);
  1236. begin
  1237. FInstallFiles.add(AFileName);
  1238. end;
  1239. procedure TPackage.GetCleanFiles(List: TStrings; Const APrefix : String; AOS : TOS);
  1240. Var
  1241. I : Integer;
  1242. begin
  1243. AddStrings(List,CleanFiles,APrefix);
  1244. For I:=0 to FTargets.Count-1 do
  1245. FTargets.TargetItems[I].GetCleanFiles(List,APrefix,AOS);
  1246. end;
  1247. procedure TPackage.GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS);
  1248. Var
  1249. I : Integer;
  1250. T : TTarget;
  1251. begin
  1252. AddStrings(List,InstallFiles,APrefix);
  1253. For I:=0 to FTargets.Count-1 do
  1254. begin
  1255. T:=FTargets.TargetItems[I];
  1256. if (T.TargetType in Types) then
  1257. T.GetInstallFiles(List,APrefix,AOS);
  1258. end;
  1259. end;
  1260. procedure TPackage.GetArchiveFiles(List: TStrings;Const APrefix : String; AOS : TOS);
  1261. Var
  1262. I : Integer;
  1263. begin
  1264. If (OS=[]) or (AOS in OS) then
  1265. begin
  1266. AddStrings(List,ArchiveFiles,APrefix);
  1267. For I:=0 to FTargets.Count-1 do
  1268. FTargets.TargetItems[I].GetArchiveFiles(List,APrefix,AOS);
  1269. end;
  1270. end;
  1271. function TPackage.NeedsCompile(ATargetDir : String; AOS : TOS): Boolean;
  1272. Var
  1273. I : Integer;
  1274. P : TPackage;
  1275. begin
  1276. ResolveDependencies(Dependencies,(Collection as TPackages));
  1277. Result:=False;
  1278. I:=0;
  1279. While (Not Result) and (I<FDependencies.Count) do
  1280. begin
  1281. P:=TPackage(FDependencies.Objects[i]);
  1282. // I'm not sure whether the target dir is OK here ??
  1283. Result:=Assigned(P) and P.NeedsCompile(ATargetDir,AOS);
  1284. Inc(I);
  1285. end;
  1286. If Not Result then
  1287. begin
  1288. I:=0;
  1289. While (Not Result) and (I<FTargets.Count) do
  1290. begin
  1291. Result:=FTargets.TargetItems[i].NeedsCompile(ATargetDir,AOS);
  1292. Inc(I);
  1293. end;
  1294. end;
  1295. end;
  1296. { TPackages }
  1297. function TPackages.GetPackage(AName : String): TPackage;
  1298. begin
  1299. Result:=TPackage(ItemByName(AName))
  1300. end;
  1301. function TPackages.GetPackageItem(AIndex : Integer): TPackage;
  1302. begin
  1303. Result:=TPackage(Items[AIndex]);
  1304. end;
  1305. procedure TPackages.SetPackageItem(AIndex : Integer; const AValue: TPackage);
  1306. begin
  1307. Items[AIndex]:=AValue;
  1308. end;
  1309. function TPackages.AddPackage(const AName: String): TPackage;
  1310. begin
  1311. Result:=Add as TPackage;
  1312. Result.Name:=AName;
  1313. end;
  1314. { TInstaller }
  1315. function TInstaller.GetStrings(AIndex : Integer): TStrings;
  1316. begin
  1317. CheckDefaultPackage;
  1318. Case AIndex of
  1319. 0: Result:=DefaultPackage.Dependencies;
  1320. 1: Result:=DefaultPackage.InstallFiles;
  1321. 2: Result:=DefaultPackage.CleanFiles;
  1322. 3: Result:=DefaultPackage.ArchiveFiles;
  1323. end;
  1324. end;
  1325. function TInstaller.GetDirectory: String;
  1326. begin
  1327. CheckDefaultPackage;
  1328. Result:=DefaultPackage.Directory;
  1329. end;
  1330. function TInstaller.GetLicense: String;
  1331. begin
  1332. CheckDefaultPackage;
  1333. Result:=DefaultPackage.License;
  1334. end;
  1335. function TInstaller.GetOSes: TOSes;
  1336. begin
  1337. CheckDefaultPackage;
  1338. Result:=DefaultPackage.OS;
  1339. end;
  1340. function TInstaller.GetOptions: String;
  1341. begin
  1342. CheckDefaultPackage;
  1343. Result:=DefaultPackage.Options;
  1344. end;
  1345. function TInstaller.GetAuthor: String;
  1346. begin
  1347. CheckDefaultPackage;
  1348. Result:=DefaultPackage.Author;
  1349. end;
  1350. function TInstaller.GetTargets: TTargets;
  1351. begin
  1352. CheckDefaultPackage;
  1353. Result:=DefaultPackage.Targets;
  1354. end;
  1355. function TInstaller.GetURL: String;
  1356. begin
  1357. CheckDefaultPackage;
  1358. Result:=DefaultPackage.URL;
  1359. end;
  1360. function TInstaller.GetVersion: String;
  1361. begin
  1362. CheckDefaultPackage;
  1363. Result:=DefaultPackage.Version;
  1364. end;
  1365. procedure TInstaller.SetAuthor(const AValue: String);
  1366. begin
  1367. CheckDefaultPackage;
  1368. DefaultPackage.Author:=AValue;
  1369. end;
  1370. procedure TInstaller.SetDefaultPackage(const AValue: TPackage);
  1371. begin
  1372. if FDefaultPackage=AValue then exit;
  1373. FDefaultPackage:=AValue;
  1374. end;
  1375. procedure TInstaller.SetDefaults(const AValue: TDefaults);
  1376. begin
  1377. FDefaults.Assign(AValue);
  1378. end;
  1379. procedure TInstaller.SetStrings(AIndex : Integer; const AValue: TStrings);
  1380. Var
  1381. Res : TStrings;
  1382. begin
  1383. CheckDefaultPackage;
  1384. Case AIndex of
  1385. 0: Res:=DefaultPackage.Dependencies;
  1386. 1: Res:=DefaultPackage.InstallFiles;
  1387. 2: Res:=DefaultPackage.CleanFiles;
  1388. 3: Res:=DefaultPackage.ArchiveFiles;
  1389. end;
  1390. Res.Assign(Avalue);
  1391. end;
  1392. procedure TInstaller.SetDirectory(const AValue: String);
  1393. begin
  1394. CheckDefaultPackage;
  1395. DefaultPackage.Directory:=AValue;
  1396. end;
  1397. procedure TInstaller.SetOptions(const AValue: String);
  1398. begin
  1399. CheckDefaultPackage;
  1400. DefaultPackage.Options:=AValue;
  1401. end;
  1402. procedure TInstaller.SetOses(const AValue: TOSes);
  1403. begin
  1404. CheckDefaultPackage;
  1405. DefaultPackage.OS:=AValue;
  1406. end;
  1407. procedure TInstaller.SetURL(const AValue: String);
  1408. begin
  1409. CheckDefaultPackage;
  1410. DefaultPackage.URL:=AValue;
  1411. end;
  1412. procedure TInstaller.SetVersion(const AValue: String);
  1413. begin
  1414. CheckDefaultPackage;
  1415. DefaultPackage.Version:=AValue;
  1416. end;
  1417. procedure TInstaller.SetLicense(const AValue: String);
  1418. begin
  1419. CheckDefaultPackage;
  1420. DefaultPackage.License:=AValue;
  1421. end;
  1422. procedure TInstaller.Log(Level: TVerboseLevel; const Msg: String);
  1423. begin
  1424. If Level in FLogLevels then
  1425. Writeln(StdErr,Msg);
  1426. end;
  1427. procedure TInstaller.CreatePackages;
  1428. begin
  1429. FPAckages:=TPackages.Create(TPackage);
  1430. end;
  1431. procedure TInstaller.CreateBuildEngine;
  1432. begin
  1433. FBuildEngine:=TBuildEngine.Create(Self);
  1434. FBuildEngine.Defaults:=Defaults;
  1435. FBuildEngine.ListMode:=FListMode;
  1436. FBuildEngine.OnLog:[email protected];
  1437. end;
  1438. procedure TInstaller.CheckDefaultPackage;
  1439. begin
  1440. If (FDefaultPackage=Nil) then
  1441. Raise EInstallerError.Create(SErrNoPackage);
  1442. end;
  1443. procedure TInstaller.Error(Msg: String);
  1444. begin
  1445. Raise EInstallerError.Create(Msg);
  1446. end;
  1447. procedure TInstaller.Error(Fmt: String; Args: array of const);
  1448. begin
  1449. Raise EInstallerError.CreateFmt(Fmt,Args);
  1450. end;
  1451. Function TInstaller.StartPackage(const AName: String) : TPackage;
  1452. begin
  1453. FDefaultPackage:=FPackages.AddPackage(AName);
  1454. Result:=FDefaultPackage;
  1455. end;
  1456. procedure TInstaller.EndPackage;
  1457. begin
  1458. FDefaultPackage:=Nil;
  1459. end;
  1460. procedure TInstaller.AnalyzeOptions;
  1461. Function CheckOption(Index : Integer;Short,Long : String): Boolean;
  1462. var
  1463. O : String;
  1464. begin
  1465. O:=Paramstr(Index);
  1466. Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
  1467. end;
  1468. Function OptionArg(Var Index : Integer) : String;
  1469. Var
  1470. P : Integer;
  1471. begin
  1472. if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then
  1473. begin
  1474. If Index<ParamCount then
  1475. begin
  1476. Inc(Index);
  1477. Result:=Paramstr(Index);
  1478. end
  1479. else
  1480. Error(SErrNeedArgument,[Index,ParamStr(Index)]);
  1481. end
  1482. else If length(ParamStr(Index))>2 then
  1483. begin
  1484. P:=Pos('=',Paramstr(Index));
  1485. If (P=0) then
  1486. Error(SErrNeedArgument,[Index,ParamStr(Index)])
  1487. else
  1488. begin
  1489. Result:=Paramstr(Index);
  1490. Delete(Result,1,P);
  1491. end;
  1492. end;
  1493. end;
  1494. Var
  1495. I : Integer;
  1496. Nodefaults : Boolean;
  1497. DefaultsFileName : string;
  1498. begin
  1499. I:=0;
  1500. NoDefaults:=False;
  1501. FListMode:=False;
  1502. While (I<ParamCount) do
  1503. begin
  1504. Inc(I);
  1505. if Checkoption(I,'m','compile') then
  1506. FRunMode:=rmCompile
  1507. else if Checkoption(I,'b','build') then
  1508. FRunMode:=rmBuild
  1509. else if CheckOption(I,'i','install') then
  1510. FRunMode:=rmInstall
  1511. else if CheckOption(I,'c','clean') then
  1512. FRunMode:=rmClean
  1513. else if CheckOption(I,'a','archive') then
  1514. FRunMode:=rmarchive
  1515. else if CheckOption(I,'d','download') then
  1516. FRunMode:=rmDownload
  1517. else if CheckOption(I,'h','help') then
  1518. FRunMode:=rmhelp
  1519. else if Checkoption(I,'C','CPU') then
  1520. Defaults.CPU:=StringToCPU(OptionArg(I))
  1521. else if Checkoption(I,'O','OS') then
  1522. Defaults.OS:=StringToOS(OptionArg(I))
  1523. else if Checkoption(I,'t','target') then
  1524. Defaults.Target:=OptionArg(I)
  1525. else if CheckOption(I,'l','list-commands') then
  1526. FListMode:=True
  1527. else if Checkoption(I,'P','prefix') then
  1528. Defaults.Prefix:=OptionArg(I)
  1529. else if Checkoption(I,'n','nodefaults') then
  1530. NoDefaults:=true
  1531. else if CheckOption(I,'b','baseinstalldir') then
  1532. Defaults.BaseInstallDir:=OptionArg(I)
  1533. else if CheckOption(I,'r','compiler') then
  1534. Defaults.Compiler:=OptionArg(I)
  1535. else if CheckOption(I,'f','config') then
  1536. DefaultsFileName:=OptionArg(I)
  1537. else if CheckOption(I,'v','verbose') then
  1538. begin
  1539. Try
  1540. FLogLevels:=TVerboseLevels(StringToSet(TypeInfo(TVerboseLevels),OptionArg(I)));
  1541. except
  1542. FLogLevels:=AllMessages;
  1543. end;
  1544. end
  1545. else
  1546. begin
  1547. Usage(SErrInValidArgument,[I,ParamStr(I)]);
  1548. end;
  1549. end;
  1550. If Not NoDefaults then
  1551. Defaults.LocalInit(DefaultsFileName);
  1552. {$ifdef debug}
  1553. FLogLevels:=AllMessages;
  1554. {$endif}
  1555. end;
  1556. procedure TInstaller.Usage(FMT: String; Args: array of const);
  1557. begin
  1558. If (FMT<>'') then
  1559. Writeln(stderr,Format(Fmt,Args));
  1560. Writeln(stderr,ExtractFileName(Paramstr(0)),' usage: ');
  1561. Writeln(stderr,'');
  1562. If (FMT<>'') then
  1563. halt(1);
  1564. end;
  1565. procedure TInstaller.Compile(Force: Boolean);
  1566. begin
  1567. FBuildEngine.ForceCompile:=Force;
  1568. FBuildEngine.Compile(FPackages);
  1569. end;
  1570. procedure TInstaller.Clean;
  1571. begin
  1572. BuildEngine.Clean(FPackages);
  1573. end;
  1574. procedure TInstaller.Install;
  1575. begin
  1576. BuildEngine.Install(FPackages);
  1577. end;
  1578. procedure TInstaller.Archive;
  1579. begin
  1580. FBuildEngine.Archive(FPackages);
  1581. end;
  1582. procedure TInstaller.Download;
  1583. begin
  1584. BuildEngine.Download(FPackages);
  1585. end;
  1586. constructor TInstaller.Create(AOWner: TComponent);
  1587. begin
  1588. inherited Create(AOWner);
  1589. FDefaults:=TDefaults.Create;
  1590. AnalyzeOptions;
  1591. CreatePackages;
  1592. end;
  1593. destructor TInstaller.destroy;
  1594. begin
  1595. inherited destroy;
  1596. end;
  1597. procedure TInstaller.CheckPackages;
  1598. begin
  1599. If (FPackages.Count=0) then
  1600. Error(SErrNoPackagesDefined);
  1601. // Check for other obvious errors ?
  1602. end;
  1603. Function TInstaller.Run : Boolean;
  1604. begin
  1605. Result:=True;
  1606. try
  1607. If RunMode<>rmHelp then
  1608. begin
  1609. CheckPackages;
  1610. CreateBuildEngine;
  1611. end;
  1612. Case RunMode of
  1613. rmHelp : Usage('',[]);
  1614. rmCompile : Compile(False);
  1615. rmBuild : Compile(True);
  1616. rmInstall : Install;
  1617. rmArchive : Archive;
  1618. rmClean : Clean;
  1619. rmDownload : Download;
  1620. end;
  1621. except
  1622. On E : Exception do
  1623. begin
  1624. Writeln(StdErr,SErrInstaller);
  1625. Writeln(StdErr,E.Message);
  1626. Result:=False;
  1627. end;
  1628. end;
  1629. end;
  1630. function TInstaller.AddTarget(AName: String): TTarget;
  1631. begin
  1632. CheckDefaultPackage;
  1633. Result:=DefaultPackage.AddTarget(AName);
  1634. end;
  1635. procedure TInstaller.AddDependency(AName: String);
  1636. begin
  1637. CheckDefaultPackage;
  1638. DefaultPackage.AddDependency(AName);
  1639. end;
  1640. { TBuildEngine }
  1641. procedure TBuildEngine.SetDefaults(const AValue: TDefaults);
  1642. begin
  1643. FDefaults.Assign(AValue);
  1644. end;
  1645. procedure TBuildEngine.SetTargetDir(const AValue: String);
  1646. begin
  1647. if FTargetDir=AValue then exit;
  1648. FTargetDir:=AValue;
  1649. end;
  1650. procedure TBuildEngine.Error(Msg: String);
  1651. begin
  1652. Raise EInstallerError.Create(Msg);
  1653. end;
  1654. procedure TBuildEngine.Error(Fmt: String; Args: array of const);
  1655. begin
  1656. Raise EInstallerError.CreateFmt(Fmt,Args);
  1657. end;
  1658. constructor TBuildEngine.Create(AOwner: TComponent);
  1659. begin
  1660. inherited Create(AOwner);
  1661. FDefaults:=TDefaults.Create;
  1662. // Maybe this should be the current directory ?
  1663. // Or have it as a command-line option.
  1664. // Would allow to put all 'installers' in one dir and call them
  1665. // With --start-dir=/path/to/sources.
  1666. FStartDir:=includeTrailingPathDelimiter(GetCurrentDir);
  1667. end;
  1668. procedure TBuildEngine.ExecuteCommand(Cmd: String; Args : String);
  1669. Var
  1670. E : Integer;
  1671. begin
  1672. Log(vlCommand,SLogExecutingCommand,[Cmd,Args]);
  1673. // We should check cmd for spaces, and move all after first space to args.
  1674. E:=ExecuteProcess(cmd,args);
  1675. If (E<>0) then
  1676. Error(SErrExternalCommandFailed,[Cmd,E]);
  1677. end;
  1678. procedure TBuildEngine.SysCopyFile(Const Src,Dest : String);
  1679. Var
  1680. D,S : String;
  1681. Fin,FOut : TFileStream;
  1682. Count : Int64;
  1683. A : Integer;
  1684. begin
  1685. Log(vlCommand,SLogCopyingFile,[Src,Dest]);
  1686. FIn:=TFileStream.Create(Src,fmopenRead);
  1687. Try
  1688. D:=IncludeTrailingPathDelimiter(Dest);
  1689. If DirectoryExists(D) then
  1690. S:=D+ExtractFileName(Src)
  1691. else
  1692. S:=Dest;
  1693. FOut:=TFileStream.Create(S,fmCreate);
  1694. Try
  1695. Count:=Fout.CopyFrom(FIn,0);
  1696. If (Count<>Fin.Size) then
  1697. Error(SErrCopyingFile,[Src,S]);
  1698. Finally
  1699. FreeAndNil(Fout);
  1700. end;
  1701. A:=FileGetDate(FIn.Handle);
  1702. If (A=-1) then
  1703. log(vlWarning,SWarnFailedToGetTime,[Src])
  1704. else
  1705. if FileSetDate(S,A)<>0 then
  1706. Log(vlWarning,SWarnFailedToSetTime,[S]);
  1707. finally
  1708. FreeAndNil(Fin);
  1709. end;
  1710. end;
  1711. procedure TBuildEngine.SysMoveFile(Const Src,Dest : String);
  1712. Var
  1713. S : String;
  1714. begin
  1715. If DirectoryExists(IncludeTrailingPathDelimiter(Dest)) then
  1716. S:=IncludeTrailingPathDelimiter(Dest)+ExtractFileName(Src)
  1717. else
  1718. S:=Dest;
  1719. If Not RenameFile(Src,S) then
  1720. begin
  1721. Try
  1722. SysCopyFile(Src,S);
  1723. SysDeleteFile(Src);
  1724. Except
  1725. On E : Exception Do
  1726. Error(SErrMovingFile,[Src,S]);
  1727. end;
  1728. end;
  1729. end;
  1730. procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
  1731. begin
  1732. if not FileExists(AFileName) then
  1733. Log(vlWarning,SWarnFileDoesNotExist,[AFileName])
  1734. else If Not DeleteFile(AFileName) then
  1735. Error(SErrDeletingFile,[AFileName]);
  1736. end;
  1737. procedure TBuildEngine.SysArchiveFiles(List: TStrings;Const AFileName: String);
  1738. begin
  1739. // To be implemented
  1740. end;
  1741. procedure TBuildEngine.Log(Level: TVerboseLevel; const Msg: String);
  1742. begin
  1743. If Assigned(FOnLog) then
  1744. FOnLog(Level,Msg);
  1745. end;
  1746. procedure TBuildEngine.Log(Level: TVerboseLevel; const Fmt: String;
  1747. Args: array of const);
  1748. begin
  1749. Log(Level,Format(Fmt,Args));
  1750. end;
  1751. procedure TBuildEngine.EnterDir(ADir: String);
  1752. Var
  1753. D : String;
  1754. begin
  1755. D:=FStartDir;
  1756. D:=D+ADir;
  1757. Log(vlInfo,SLogEnterDir,[D]);
  1758. If Not SetCurrentDir(D) then
  1759. Error(SErrChangeDirFailed,[D]);
  1760. end;
  1761. procedure TBuildEngine.CmdCopyFiles(List: TStrings; Const DestDir: String);
  1762. Var
  1763. Args : String;
  1764. I : Integer;
  1765. begin
  1766. CmdCreateDir(DestDir);
  1767. If (Defaults.Copy<>'') then
  1768. begin
  1769. Args:=FileListToString(List,'');
  1770. Args:=Args+' '+DestDir;
  1771. ExecuteCommand(Defaults.Copy,Args);
  1772. end
  1773. else
  1774. For I:=0 to List.Count-1 do
  1775. SysCopyFile(List[i],DestDir);
  1776. end;
  1777. procedure TBuildEngine.CmdCreateDir(DestDir: String);
  1778. begin
  1779. If (Defaults.MkDir<>'') then
  1780. ExecuteCommand(Defaults.MkDir,DestDir)
  1781. else
  1782. If not ForceDirectories(DestDir) then
  1783. Error(SErrCreatingDirectory,[DestDir]);
  1784. end;
  1785. procedure TBuildEngine.CmdMoveFiles(List: TStrings; Const DestDir: String);
  1786. Var
  1787. Args : String;
  1788. I : Integer;
  1789. begin
  1790. CmdCreateDir(DestDir);
  1791. If (Defaults.Move<>'') then
  1792. begin
  1793. Args:=FileListToString(List,'');
  1794. Args:=Args+' '+DestDir;
  1795. ExecuteCommand(Defaults.Move,Args);
  1796. end
  1797. else
  1798. For I:=0 to List.Count-1 do
  1799. SysMoveFile(List[i],DestDir);
  1800. end;
  1801. procedure TBuildEngine.CmdDeleteFiles(List: TStrings);
  1802. Var
  1803. Args : String;
  1804. I : Integer;
  1805. begin
  1806. If (Defaults.Remove<>'') then
  1807. begin
  1808. Args:=FileListToString(List,'');
  1809. ExecuteCommand(Defaults.Remove,Args);
  1810. end
  1811. else
  1812. For I:=0 to List.Count-1 do
  1813. SysDeleteFile(List[i]);
  1814. end;
  1815. procedure TBuildEngine.CmdArchiveFiles(List: TStrings; Const ArchiveFile: String);
  1816. Var
  1817. Args : String;
  1818. begin
  1819. If (Defaults.Archive<>'') then
  1820. begin
  1821. Args:=FileListToString(List,'');
  1822. Args:=ArchiveFile+' '+Args;
  1823. ExecuteCommand(Defaults.Archive,Args);
  1824. end
  1825. else
  1826. SysArchiveFiles(List,ArchiveFile);
  1827. end;
  1828. // Relative to startdir.
  1829. Function TBuildEngine.GetTargetDir(APackage : TPackage; ATarget : TTarget; AbsolutePath : Boolean = False) : String;
  1830. begin
  1831. If AbsolutePath then
  1832. Result:=IncludeTrailingPathDelimiter(FStartDir)
  1833. else
  1834. Result:='';
  1835. If (APackage.Directory<>'') then
  1836. Result:=Result+IncludeTrailingPathDelimiter(APackage.Directory);
  1837. If (ATarget.Directory<>'') then
  1838. Result:=IncludeTrailingPathDelimiter(Result+ATarget.Directory);
  1839. end;
  1840. Function TBuildEngine.TargetOK(Target : TTarget) : Boolean;
  1841. begin
  1842. Result:=(Target.TargetType in [ttUnit,ttProgram])
  1843. and
  1844. ((Target.CPU=[]) or (Defaults.CPU in Target.CPU))
  1845. and
  1846. ((Target.OS=[]) or (Defaults.OS in Target.OS));
  1847. end;
  1848. Function TBuildEngine.GetCompilerCommand(APackage : TPackage; Target : TTarget) : String;
  1849. Var
  1850. PD,TD,OD,RD : String;
  1851. begin
  1852. PD:=IncludeTrailingPathDelimiter(GetPackageDir(APackage,True));
  1853. OD:=IncludeTrailingPathDelimiter(GetOutputDir(APackage,True));
  1854. RD:=ExtractRelativePath(PD,OD);
  1855. If Target.TargetType in ProgramTargets then
  1856. Result:='-FE.' // Make this relative to target directory.
  1857. else
  1858. Result:='-FU'+RD;
  1859. If Target.Mode<>fpc then
  1860. Result:=Result+' -M'+ModeToString(Target.Mode)
  1861. else If Defaults.Mode<>fpc then
  1862. Result:=Result+' -M'+ModeToString(Defaults.Mode);
  1863. If (Defaults.Options<>'') then
  1864. Result:=Result+' '+Defaults.Options;
  1865. If (APackage.Options<>'') then
  1866. Result:=Result+' '+APackage.Options;
  1867. If APackage.HasUnitPath then
  1868. AddStrings(Result,APackage.UnitPath,'-Fu');
  1869. If APackage.HasIncludePath then
  1870. AddStrings(Result,APackage.IncludePath,'-Fi');
  1871. If APackage.HasObjectPath then
  1872. AddStrings(Result,APackage.ObjectPath,'-Fo');
  1873. If Target.HasUnitPath then
  1874. AddStrings(Result,Target.UnitPath,'-Fu');
  1875. If Target.HasIncludePath then
  1876. AddStrings(Result,Target.IncludePath,'-Fi');
  1877. If Target.HasObjectPath then
  1878. AddStrings(Result,Target.ObjectPath,'-Fo');
  1879. If (Target.Options<>'') then
  1880. Result:=Result+' '+Target.Options;
  1881. TD:=Target.Directory;
  1882. if (TD<>'') then
  1883. TD:=IncludeTrailingPathDelimiter(TD);
  1884. Result:=Result+' '+TD+Target.SourceFileName;
  1885. end;
  1886. Function TBuildEngine.GetCompiler : String;
  1887. Var
  1888. S : String;
  1889. begin
  1890. // Cache in FCompiler for speed.
  1891. If (FCompiler='') then
  1892. begin
  1893. FCompiler:=Defaults.Compiler;
  1894. If (ExtractFilePath(FCompiler)='') then
  1895. begin
  1896. S:=FileSearch(FCompiler,GetEnvironmentVariable('PATH'));
  1897. If (S<>'') then
  1898. FCompiler:=S;
  1899. end;
  1900. end;
  1901. Result:=FCompiler;
  1902. end;
  1903. procedure TBuildEngine.Compile(Target: TTarget);
  1904. Var
  1905. S : String;
  1906. begin
  1907. Log(vlInfo,SLogCompilingTarget,[Target.Name]);
  1908. If Assigned(Target.BeforeCompile) then
  1909. Target.BeforeCompile(Target);
  1910. S:=GetCompilerCommand(FCurrentPackage,Target);
  1911. ExecuteCommand(GetCompiler,S);
  1912. If Assigned(Target.AfterCompile) then
  1913. Target.AfterCompile(Target);
  1914. end;
  1915. procedure TBuildEngine.FixDependencies(Target: TTarget);
  1916. Var
  1917. I : Integer;
  1918. T : TTarget;
  1919. begin
  1920. If Target.HasDependencies then
  1921. For I:=0 to Target.Dependencies.Count-1 do
  1922. begin
  1923. T:=TTarget(Target.Dependencies.Objects[i]);
  1924. If Assigned(T) then
  1925. begin
  1926. If (T.State=tsCompiling) then
  1927. Log(vlWarning,SWarnCircularDependency,[Target.Name,T.Name])
  1928. else
  1929. Compile(T) // If it already was compiled, then State<>tsNeutral, and it won't be compiled again.
  1930. end
  1931. else
  1932. Error(SErrDepUnknownTarget,[Target.Name,Target.Dependencies[i]]);
  1933. end;
  1934. end;
  1935. function TBuildEngine.GetPackageDir(APackage: TPackage; AbsolutePath: Boolean
  1936. ): String;
  1937. begin
  1938. If AbsolutePath then
  1939. Result:= IncludeTrailingPathDelimiter(FStartDir)
  1940. else
  1941. Result:='';
  1942. Result:=Result+APackage.Directory;
  1943. If (Result<>'') then
  1944. Result:= ExcludeTrailingPathDelimiter(Result)
  1945. end;
  1946. Function TBuildEngine.GetOutputDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  1947. begin
  1948. If (TargetDir<>'') then
  1949. Result:=TargetDir
  1950. else
  1951. begin
  1952. If AbsolutePath then
  1953. Result:=IncludeTrailingPathDelimiter(FStartDir)
  1954. else
  1955. Result:='';
  1956. If (APackage.Directory<>'') then
  1957. Result:=IncludeTrailingPathDelimiter(Result+APackage.Directory);
  1958. Result:=Result+'units'+PathDelim+Defaults.Target;
  1959. end;
  1960. end;
  1961. procedure TBuildEngine.CreateOutputDir(APackage: TPackage);
  1962. Var
  1963. D : String;
  1964. begin
  1965. D:=GetOutputDir(APackage,True);
  1966. Log(vlInfo,SLogCreatingOutputDir,[D]);
  1967. CmdCreateDir(D);
  1968. end;
  1969. Function TBuildEngine.PackageOK(APackage : TPackage) : Boolean;
  1970. begin
  1971. Result:=((APackage.CPU=[]) or (Defaults.CPU in APackage.CPU))
  1972. and
  1973. ((APAckage.OS=[]) or (Defaults.OS in APackage.OS));
  1974. end;
  1975. procedure TBuildEngine.Compile(APackage: TPackage);
  1976. Var
  1977. T : TTarget;
  1978. I : Integer;
  1979. begin
  1980. Log(vlInfo,SLogCompilingPackage,[APackage.Name]);
  1981. FCurrentPackage:=APackage;
  1982. Try
  1983. If Assigned(APackage.BeforeCompile) then
  1984. APackage.BeforeCompile(APackage);
  1985. If (APackage.Directory<>'') then
  1986. EnterDir(APackage.Directory);
  1987. Try
  1988. CreateOutputDir(APackage);
  1989. For I:=0 to APackage.Targets.Count-1 do
  1990. begin
  1991. T:=APackage.Targets.TargetItems[i];
  1992. If TargetOK(T) then
  1993. If (T.State=tsNeutral) then
  1994. begin
  1995. If (FForceCompile or T.NeedsCompile(GetOutputDir(APackage,true),Defaults.OS)) then
  1996. begin
  1997. T.FTargetState:=tsCompiling;
  1998. FixDependencies(T);
  1999. Compile(T);
  2000. end;
  2001. T.FTargetState:=tsCompiled;
  2002. end;
  2003. end;
  2004. If Assigned(APackage.AfterCompile) then
  2005. APackage.AfterCompile(APackage);
  2006. Finally
  2007. If (APackage.Directory<>'') then
  2008. EnterDir('');
  2009. end;
  2010. Finally
  2011. FCurrentPackage:=Nil;
  2012. end;
  2013. end;
  2014. procedure TBuildEngine.CheckExternalPackage(Const APackageName : String);
  2015. begin
  2016. // A check needs to be implemented here.
  2017. Log(vldebug,'Unresolved external dependency : %s',[APackageName]);
  2018. end;
  2019. procedure TBuildEngine.FixDependencies(APackage: TPackage);
  2020. Var
  2021. I : Integer;
  2022. P : TPackage;
  2023. begin
  2024. if APackage.HasDependencies then
  2025. For I:=0 to APAckage.Dependencies.Count-1 do
  2026. begin
  2027. P:=TPackage(Apackage.Dependencies.Objects[i]);
  2028. If Assigned(P) then
  2029. Compile(P) // If it already was compiled, then State<>tsNeutral, and it won't be compiled again.
  2030. else
  2031. CheckExternalPackage(Apackage.Dependencies[i]);
  2032. end;
  2033. end;
  2034. Procedure TBuildEngine.InstallPackageFiles(APAckage : TPackage; tt : TTargetType; Const Src,Dest : String);
  2035. Var
  2036. I : Integer;
  2037. List : TStringList;
  2038. begin
  2039. List:=TStringList.Create;
  2040. Try
  2041. APackage.GetInstallFiles(List,[tt],Src,Defaults.OS);
  2042. if (List.Count>0) then
  2043. CmdCopyFiles(List,Dest);
  2044. Finally
  2045. List.Free;
  2046. end;
  2047. end;
  2048. procedure TBuildEngine.Install(APackage: TPackage);
  2049. Var
  2050. PD,D,O : String;
  2051. begin
  2052. If (Apackage.State<>tsCompiled) then
  2053. Compile(APackage);
  2054. Log(vlInfo,SLogInstallingPackage,[APackage.Name]);
  2055. If Assigned(APackage.BeforeInstall) then
  2056. APackage.BeforeInstall(APackage);
  2057. O:=IncludeTrailingPathDelimiter(GetOutputDir(APAckage));
  2058. PD:=IncludeTrailingPathDelimiter(GetPackageDir(APackage));
  2059. // units
  2060. D:=IncludeTrailingPathDelimiter(Defaults.UnitInstallDir)+APackage.Name;
  2061. InstallPackageFiles(APAckage,ttUnit,O,D);
  2062. // Programs
  2063. D:=IncludeTrailingPathDelimiter(Defaults.BinInstallDir);
  2064. InstallPackageFiles(APAckage,ttProgram,PD,D);
  2065. // Done.
  2066. APackage.FTargetState:=tsInstalled;
  2067. If Assigned(APackage.AfterInstall) then
  2068. APackage.AfterInstall(APackage);
  2069. end;
  2070. procedure TBuildEngine.Archive(APackage: TPackage);
  2071. begin
  2072. Log(vlInfo,SLogArchivingPackage,[APackage.Name]);
  2073. If Assigned(APackage.BeforeArchive) then
  2074. APackage.BeforeArchive(APackage);
  2075. Writeln('Archiving : ',APackage.Name);
  2076. If Assigned(APackage.AfterArchive) then
  2077. APackage.AfterArchive(APackage);
  2078. end;
  2079. procedure TBuildEngine.Clean(APackage: TPackage);
  2080. Var
  2081. O : String;
  2082. List : TStringList;
  2083. begin
  2084. Log(vlInfo,SLogCleaningPackage,[APackage.Name]);
  2085. If Assigned(APackage.BeforeClean) then
  2086. APackage.BeforeClean(APackage);
  2087. O:=IncludeTrailingPathDelimiter(GetOutputDir(APAckage));
  2088. List:=TStringList.Create;
  2089. try
  2090. APackage.GetCleanFiles(List,O,Defaults.OS);
  2091. if (List.Count>0) then
  2092. CmdDeleteFiles(List);
  2093. Finally
  2094. List.Free;
  2095. end;
  2096. If Assigned(APackage.AfterClean) then
  2097. APackage.AfterClean(APackage);
  2098. end;
  2099. procedure TBuildEngine.Download(APackage: TPackage);
  2100. begin
  2101. Log(vlInfo,SLogDownloadingPackage,[APackage.Name]);
  2102. If Assigned(APackage.BeforeDownload) then
  2103. APackage.BeforeDownload(APackage);
  2104. Writeln('Downloading : ',APackage.Name);
  2105. If Assigned(APackage.AfterDownload) then
  2106. APackage.AfterDownload(APackage);
  2107. end;
  2108. procedure TBuildEngine.Compile(Packages: TPackages);
  2109. Var
  2110. I : Integer;
  2111. P : TPackage;
  2112. begin
  2113. If Assigned(BeforeCompile) then
  2114. BeforeCompile(Self);
  2115. For I:=0 to Packages.Count-1 do
  2116. begin
  2117. P:=Packages.PackageItems[i];
  2118. If PackageOK(P) then
  2119. If (P.State=tsNeutral) then
  2120. begin
  2121. If (FForceCompile or P.NeedsCompile(TargetDir,Defaults.OS)) then
  2122. begin
  2123. P.FTargetState:=tsCompiling;
  2124. FixDependencies(P);
  2125. Compile(P);
  2126. end;
  2127. P.FTargetState:=tsCompiled;
  2128. end;
  2129. end;
  2130. If Assigned(AfterCompile) then
  2131. AfterCompile(Self);
  2132. end;
  2133. procedure TBuildEngine.Install(Packages: TPackages);
  2134. Var
  2135. I : Integer;
  2136. P : TPackage;
  2137. begin
  2138. If Assigned(BeforeInstall) then
  2139. BeforeInstall(Self);
  2140. For I:=0 to Packages.Count-1 do
  2141. begin
  2142. P:=Packages.PackageItems[i];
  2143. If PackageOK(P) then
  2144. Install(P);
  2145. end;
  2146. If Assigned(AfterInstall) then
  2147. AfterInstall(Self);
  2148. end;
  2149. procedure TBuildEngine.Archive(Packages: TPackages);
  2150. Var
  2151. I : Integer;
  2152. P : TPackage;
  2153. begin
  2154. If Assigned(BeforeArchive) then
  2155. BeforeArchive(Self);
  2156. Log(vlDebug,'Build engine archiving.');
  2157. For I:=0 to Packages.Count-1 do
  2158. begin
  2159. P:=Packages.PackageItems[i];
  2160. If PackageOK(P) then
  2161. Archive(P);
  2162. end;
  2163. If Assigned(AfterArchive) then
  2164. AfterArchive(Self);
  2165. end;
  2166. procedure TBuildEngine.Clean(Packages: TPackages);
  2167. Var
  2168. I : Integer;
  2169. P : TPackage;
  2170. begin
  2171. If Assigned(BeforeClean) then
  2172. BeforeClean(Self);
  2173. Log(vldebug,'Build engine cleaning.');
  2174. For I:=0 to Packages.Count-1 do
  2175. begin
  2176. P:=Packages.PackageItems[i];
  2177. If PackageOK(P) then
  2178. Clean(P);
  2179. end;
  2180. If Assigned(AfterClean) then
  2181. AfterClean(Self);
  2182. end;
  2183. procedure TBuildEngine.Download(Packages: TPackages);
  2184. Var
  2185. I : Integer;
  2186. P : TPackage;
  2187. begin
  2188. If Assigned(BeforeDownload) then
  2189. BeforeDownload(Self);
  2190. For I:=0 to Packages.Count-1 do
  2191. begin
  2192. P:=Packages.PackageItems[i];
  2193. If PackageOK(P) then
  2194. Download(P);
  2195. end;
  2196. If Assigned(AfterDownload) then
  2197. AfterDownload(Self);
  2198. end;
  2199. { TTarget }
  2200. function TTarget.GetHasStrings(AIndex: integer): Boolean;
  2201. begin
  2202. Result:=False;
  2203. Case AIndex Of
  2204. 0 : Result:=FUnitPath<>Nil;
  2205. 1 : Result:=FObjectPath<>Nil;
  2206. 2 : Result:=FIncludePath<>Nil;
  2207. 3 : Result:=FDependencies<>Nil;
  2208. end;
  2209. end;
  2210. function TTarget.GetStrings(AIndex: integer): TStrings;
  2211. Function EnsureStrings(Var S : TStrings) : TStrings;
  2212. begin
  2213. If (S=Nil) then
  2214. S:=TStringList.Create;
  2215. Result:=S;
  2216. end;
  2217. begin
  2218. Result:=Nil;
  2219. Case AIndex Of
  2220. 0 : Result:=EnsureStrings(FUnitPath);
  2221. 1 : Result:=EnsureStrings(FObjectPath);
  2222. 2 : Result:=EnsureStrings(FIncludePath);
  2223. 3 : Result:=EnsureStrings(FDependencies);
  2224. end;
  2225. end;
  2226. procedure TTarget.SetStrings(AIndex: integer; const AValue: TStrings);
  2227. begin
  2228. GetStrings(AIndex).Assign(AValue);
  2229. end;
  2230. function TTarget.GetSourceFileName: String;
  2231. begin
  2232. Result:=Name+FExtension;
  2233. end;
  2234. function TTarget.GetUnitFileName: String;
  2235. begin
  2236. Result:=Name+UnitExt;
  2237. end;
  2238. function TTarget.GetObjectFileName: String;
  2239. begin
  2240. Result:=Name+ObjExt;
  2241. end;
  2242. function TTarget.GetRSTFileName: String;
  2243. begin
  2244. Result:=Name+RSText;
  2245. end;
  2246. function TTarget.GetProgramFileName(AnOS : TOS): String;
  2247. begin
  2248. if AnOS in [dos,win32,os2] then
  2249. Result:=Name+ExeExt
  2250. else
  2251. Result:=Name;
  2252. end;
  2253. constructor TTarget.Create(ACollection: TCollection);
  2254. begin
  2255. inherited Create(ACollection);
  2256. FInstall:=True;
  2257. end;
  2258. destructor TTarget.Destroy;
  2259. begin
  2260. FreeAndNil(FUnitPath);
  2261. FreeAndNil(FObjectPath);
  2262. FreeAndNil(FIncludePath);
  2263. FreeAndNil(FDependencies);
  2264. inherited Destroy;
  2265. end;
  2266. function TTarget.GetOutputFileName(AOs: TOS): String;
  2267. begin
  2268. Result:=Name;
  2269. if TargetType in UnitTargets then
  2270. Result:=Result+UnitExt
  2271. else if AOs in [Win32,dos,OS2] then
  2272. Result:=Result+ExeExt
  2273. end;
  2274. function TTarget.NeedsCompile(ATargetDir : String;AOS : TOS): Boolean;
  2275. Var
  2276. I : Integer;
  2277. T : TTarget;
  2278. OD,SD,SFN,OFN : String;
  2279. begin
  2280. Result:=False;
  2281. OD:=ATargetDir;
  2282. If (OD<>'') then
  2283. OD:=IncludeTrailingPathDelimiter(ATargetDir);
  2284. OFN:=OD+GetOutPutFileName(AOS);
  2285. SD:=Directory;
  2286. If (SD<>'') then
  2287. SD:=IncludeTrailingPathDelimiter(SD);
  2288. Result:=Not FileExists(OFN);
  2289. // Check dependencies
  2290. If not Result then
  2291. If HasDependencies then
  2292. begin
  2293. ResolveDependencies(FDependencies,Collection as TTargets);
  2294. I:=0;
  2295. While (Not Result) and (I<FDependencies.Count) do
  2296. begin
  2297. T:=TTarget(FDependencies.Objects[i]);
  2298. If (T<>Nil) then
  2299. Result:=T.NeedsCompile(ATargetDir,AOS)
  2300. else // if it is a filename, check dates.
  2301. if FileExists(FDependencies[i]) then
  2302. Result:=(FileAge(OFN)<FileAge(FDependencies[i]))
  2303. else if FileExists(SD+FDependencies[i]) then
  2304. Result:=(FileAge(OFN)<FileAge(SD+FDependencies[i]));
  2305. Inc(I)
  2306. end;
  2307. end;
  2308. If not Result then
  2309. begin
  2310. SFN:=SD+SourceFileName;
  2311. If (ExtractFileExt(SFN)='') then
  2312. if FileExists(SFN+'.pp') then
  2313. SFN:=SFN+'.pp'
  2314. else
  2315. SFN:=SFN+'.pas';
  2316. // Writeln('Checking : ',OFN,' against ',SFN);
  2317. Result:=(FileAge(OFN)<FileAge(SFN));
  2318. // here we should check file timestamps.
  2319. end;
  2320. end;
  2321. procedure TTarget.SetName(const AValue: String);
  2322. Var
  2323. D,N,E : String;
  2324. begin
  2325. N:=FixPath(AValue);
  2326. D:=ExtractFilePath(N);
  2327. E:=ExtractFileExt(N);
  2328. N:=ExtractFileName(N);
  2329. If (E<>'') then
  2330. N:=Copy(N,1,Length(N)-Length(E));
  2331. inherited SetName(N);
  2332. FExtension:=E;
  2333. FDirectory:=D;
  2334. end;
  2335. procedure TTarget.GetCleanFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2336. begin
  2337. If (OS=[]) or (AnOS in OS) then
  2338. begin
  2339. List.Add(APrefix+ObjectFileName);
  2340. If (TargetType in [ttUnit,ttExampleUnit]) then
  2341. List.Add(APrefix+UnitFileName)
  2342. else If (TargetType in [ttProgram,ttExampleProgram]) then
  2343. List.Add(APrefix+GetProgramFileName(AnOS));
  2344. If ResourceStrings then
  2345. List.Add(APrefix+RSTFileName);
  2346. // Maybe add later ? AddStrings(List,CleanFiles);
  2347. end;
  2348. end;
  2349. procedure TTarget.GetInstallFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2350. begin
  2351. If (OS=[]) or (AnOS in OS) then
  2352. begin
  2353. If Not (TargetType in [ttProgram,ttExampleProgram]) then
  2354. List.Add(APrefix+ObjectFileName);
  2355. If (TargetType in [ttUnit,ttExampleUnit]) then
  2356. List.Add(APrefix+UnitFileName)
  2357. else If (TargetType in [ttProgram,ttExampleProgram]) then
  2358. List.Add(APrefix+GetProgramFileName(AnOS));
  2359. If ResourceStrings then
  2360. List.Add(APrefix+RSTFileName);
  2361. // Maybe add later ? AddStrings(List,InstallFiles);
  2362. end;
  2363. end;
  2364. procedure TTarget.GetArchiveFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2365. begin
  2366. If (OS=[]) or (AnOS in OS) then
  2367. begin
  2368. List.Add(APrefix+SourceFileName);
  2369. // Maybe add later ? AddStrings(List,ArchiveFiles);
  2370. end;
  2371. end;
  2372. Initialization
  2373. OnGetApplicationName:=@GetFPMakeName;
  2374. Installer:=TInstaller.Create(Nil);
  2375. Defaults:=Installer.Defaults;
  2376. Finalization
  2377. FreeAndNil(Installer);
  2378. FreeAndNil(Defaults);
  2379. end.