fpmkunit.pp 95 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673
  1. {$Mode objfpc}
  2. {$H+}
  3. {$define debug}
  4. unit fpmkunit;
  5. Interface
  6. uses SysUtils,Classes,fpmktype;
  7. Type
  8. TRunMode = (rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmManifest,rmListSources);
  9. { TNamedItem }
  10. TNamedItem = Class(TCollectionItem)
  11. private
  12. FName: String;
  13. procedure SetName(const AValue: String);virtual;
  14. Public
  15. property Name : String Read FName Write SetName;
  16. end;
  17. { TNamedCollection }
  18. TNamedCollection = Class(TCollection)
  19. private
  20. FUniqueNames: Boolean;
  21. Public
  22. Function IndexOfName(AName : String) : Integer;
  23. Function ItemByName(AName : String) : TNamedItem;
  24. Property UniqueNames : Boolean Read FUniqueNames;
  25. end;
  26. { TNamedItemList }
  27. TNamedItemList = Class(TList)
  28. private
  29. function GetNamedItem(Index : Integer): TNamedItem;
  30. procedure SetNamedItem(Index : Integer; const AValue: TNamedItem);
  31. public
  32. Function IndexOfName(AName : String) : Integer;
  33. Function ItemByName(ANAme : String) : TNamedItem;
  34. Property NamedItems[Index : Integer] : TNamedItem Read GetNamedItem Write SetNamedItem; default;
  35. end;
  36. TCommandAt = fpmktype.TCommandAt;
  37. { TCommand }
  38. TCommand = Class(TNamedItem)
  39. private
  40. FAfterCommand: TNotifyEvent;
  41. FBeforeCommand: TNotifyEvent;
  42. FCommand: String;
  43. FCommandAt: TCommandAt;
  44. FDestFile: String;
  45. FIgnoreResult: Boolean;
  46. FOptions: String;
  47. FSourceFile: String;
  48. Public
  49. Property SourceFile : String Read FSourceFile Write FSourceFile;
  50. Property DestFile : String Read FDestFile Write FDestFile;
  51. Property Command : String Read FCommand Write FCommand;
  52. Property Options : String Read FOptions Write FOptions;
  53. Property At : TCommandAt Read FCommandAt Write FCommandAt;
  54. Property IgnoreResult : Boolean Read FIgnoreResult Write FIgnoreResult;
  55. Property BeforeCommand : TNotifyEvent Read FBeforeCommand Write FBeforeCommand;
  56. Property AfterCommand : TNotifyEvent Read FAfterCommand Write FAfterCommand;
  57. end;
  58. { TCommands }
  59. TCommands = Class(TNamedCollection)
  60. private
  61. FDefaultAt: TCommandAt;
  62. function GetCommand(Dest : String): TCommand;
  63. function GetCommandItem(Index : Integer): TCommand;
  64. procedure SetCommandItem(Index : Integer; const AValue: TCommand);
  65. Public
  66. Function AddCommand(Const Cmd : String) : TCommand;
  67. Function AddCommand(Const Cmd,Options : String) : TCommand;
  68. Function AddCommand(Const Cmd,Options,Dest,Source : String) : TCommand;
  69. Function AddCommand(At : TCommandAt; Const Cmd : String) : TCommand;
  70. Function AddCommand(At : TCommandAt; Const Cmd,Options : String) : TCommand;
  71. Function AddCommand(At : TCommandAt; Const Cmd,Options, Dest,Source : String) : TCommand;
  72. Property CommandItems[Index : Integer] : TCommand Read GetCommandItem Write SetCommandItem;
  73. Property Commands[Dest : String] : TCommand Read GetCommand; default;
  74. Property DefaultAt : TCommandAt Read FDefaultAt Write FDefaultAt;
  75. end;
  76. { TTarget }
  77. TTarget = Class(TNamedItem)
  78. private
  79. FInstall : Boolean;
  80. FAfterClean: TNotifyEvent;
  81. FAfterCompile: TNotifyEvent;
  82. FBeforeClean: TNotifyEvent;
  83. FBeforeCompile: TNotifyEvent;
  84. FCPUs: TCPUs;
  85. FMode: TCompilerMode;
  86. FResourceStrings: Boolean;
  87. FObjectPath,
  88. FUnitPath,
  89. FIncludePath,
  90. FDependencies: TStrings;
  91. FCommands : TCommands;
  92. FDirectory: String;
  93. FExtension: String;
  94. FFileType: TFileType;
  95. FOptions: String;
  96. FOSes: TOSes;
  97. FFPCTarget: String;
  98. FTargetState: TTargetState;
  99. FTargetType: TTargetType;
  100. function GetCommands: TCommands;
  101. function GetHasCommands: Boolean;
  102. function GetHasStrings(AIndex: integer): Boolean;
  103. function GetStrings(AIndex: integer): TStrings;
  104. procedure SetCommands(const AValue: TCommands);
  105. procedure SetStrings(AIndex: integer; const AValue: TStrings);
  106. Protected
  107. Function GetSourceFileName : String; virtual;
  108. Function GetUnitFileName : String; virtual;
  109. Function GetObjectFileName : String; virtual;
  110. Function GetRSTFileName : String; Virtual;
  111. Function GetProgramFileName(AnOS : TOS) : String; Virtual;
  112. Public
  113. Constructor Create(ACollection : TCollection); override;
  114. Destructor Destroy; override;
  115. Function GetOutputFileName (AOs : TOS) : String; Virtual;
  116. procedure SetName(const AValue: String);override;
  117. Procedure GetCleanFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  118. Procedure GetSourceFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  119. Procedure GetInstallFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  120. Procedure GetArchiveFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  121. Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
  122. Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
  123. Property HasIncludePath : Boolean Index 2 Read GetHasStrings;
  124. Property HasDependencies : Boolean Index 3 Read GetHasStrings;
  125. Property HasCommands : Boolean Read GetHasCommands;
  126. Property UnitPath : TStrings Index 0 Read GetStrings Write SetStrings;
  127. Property ObjectPath : TStrings Index 1 Read GetStrings Write SetStrings;
  128. Property IncludePath : TStrings Index 2 Read GetStrings Write SetStrings;
  129. Property Dependencies : TStrings Index 3 Read GetStrings Write SetStrings;
  130. Property Commands : TCommands Read GetCommands Write SetCommands;
  131. Property State : TTargetState Read FTargetState;
  132. Property TargetType : TTargetType Read FTargetType Write FTargetType;
  133. Property OS : TOSes Read FOSes Write FOSes;
  134. Property Mode : TCompilerMode Read FMode Write FMode;
  135. Property Options : String Read FOptions Write Foptions;
  136. Property SourceFileName: String Read GetSourceFileName ;
  137. Property UnitFileName : String Read GetUnitFileName;
  138. Property ObjectFileName : String Read GetObjectFileName;
  139. Property RSTFileName : String Read GetRSTFileName;
  140. Property CPU : TCPUs Read FCPUs Write FCPUs;
  141. Property FPCTarget : String Read FFPCTarget Write FFPCTarget;
  142. Property Extension : String Read FExtension Write FExtension;
  143. Property FileType : TFileType Read FFileType Write FFileType;
  144. Property Directory : String Read FDirectory Write FDirectory;
  145. Property ResourceStrings : Boolean Read FResourceStrings Write FResourceStrings;
  146. Property Install : Boolean Read FInstall Write FInstall;
  147. // Events.
  148. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  149. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  150. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  151. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  152. end;
  153. { TTargets }
  154. TTargets = Class(TNamedCollection)
  155. private
  156. FDefaultCPU: TCPUs;
  157. FDefaultDir : String;
  158. FDefaultOS: TOSes;
  159. function GetTargetItem(Index : Integer): TTarget;
  160. function GetTarget(AName : String): TTarget;
  161. procedure SetDefaultDir(const AValue: String);
  162. procedure SetTargetItem(Index : Integer; const AValue: TTarget);
  163. Procedure ApplyDefaults(ATarget : TTarget);
  164. Public
  165. Procedure ResetDefaults;
  166. Function AddUnit(AUnitName : String) : TTarget;
  167. Function AddProgram(AProgramName : String) : TTarget;
  168. Function AddExampleUnit(AUnitName : String) : TTarget;
  169. Function AddExampleProgram(AProgramName : String) : TTarget;
  170. Property Targets[AName : String] : TTarget Read GetTarget; default;
  171. Property TargetItems[Index : Integer] : TTarget Read GetTargetItem Write SetTargetItem;
  172. Property DefaultDir : String Read FDefaultDir Write SetDefaultDir;
  173. Property DefaultOS : TOSes Read FDefaultOS Write FDefaultOS;
  174. Property DefaultCPU : TCPUs Read FDefaultCPU Write FDefaultCPU;
  175. end;
  176. { TSource }
  177. TSource = Class(TNamedItem)
  178. private
  179. FSourceType: TSourceType;
  180. Public
  181. Constructor Create(ACollection : TCollection); override;
  182. Destructor Destroy; override;
  183. procedure GetSourceFiles(List: TStrings);
  184. Property SourceType : TSourceType Read FSourceType Write FSourceType;
  185. end;
  186. { TSources }
  187. TSources = Class(TNamedCollection)
  188. private
  189. function GetSourceItem(Index : Integer): TSource;
  190. procedure SetSourceItem(Index : Integer; const AValue: TSource);
  191. public
  192. Function AddDocFiles(AFiles : String) : TSource;
  193. Function AddSrcFiles(AFiles : String) : TSource;
  194. Function AddExampleFiles(AFiles : String) : TSource;
  195. Function AddTestFiles(AFiles : String) : TSource;
  196. Property SourceItems[Index : Integer] : TSource Read GetSourceItem Write SetSourceItem;default;
  197. end;
  198. { TPackage }
  199. TPackage = Class(TNamedItem) // Maybe descend from/use TTarget ?
  200. private
  201. FAfterArchive: TNotifyEvent;
  202. FAfterClean: TNotifyEvent;
  203. FAfterCompile: TNotifyEvent;
  204. FAfterInstall: TNotifyEvent;
  205. FAfterManifest: TNotifyEvent;
  206. FBeforeArchive: TNotifyEvent;
  207. FBeforeClean: TNotifyEvent;
  208. FBeforeCompile: TNotifyEvent;
  209. FBeforeInstall: TNotifyEvent;
  210. FBeforeManifest: TNotifyEvent;
  211. FUnitPath,
  212. FObjectPath,
  213. FIncludePath,
  214. FCleanFiles,
  215. FArchiveFiles,
  216. FInstallFiles,
  217. FDependencies: TStrings;
  218. FCPU: TCPUs;
  219. FOS: TOses;
  220. FTargetState: TTargetState;
  221. FTargets: TTargets;
  222. FSources: TSources;
  223. FDirectory: String;
  224. FOptions: String;
  225. FFileName: String;
  226. FAuthor: String;
  227. FLicense: String;
  228. FExternalURL: String;
  229. FVersion: String;
  230. FEmail : String;
  231. FCommands : TCommands;
  232. FDescriptionFile : String;
  233. FDescription : String;
  234. Function GetDescription : string;
  235. Function GetFileName : string;
  236. function GetCommands: TCommands;
  237. function GetHasCommands: Boolean;
  238. function GetHasStrings(AIndex: integer): Boolean;
  239. function GetStrings(AIndex: integer): TStrings;
  240. procedure SetCommands(const AValue: TCommands);
  241. procedure SetStrings(AIndex: integer; const AValue: TStrings);
  242. Public
  243. constructor Create(ACollection: TCollection); override;
  244. destructor destroy; override;
  245. Function AddTarget(AName : String) : TTarget;
  246. Procedure AddDependency(AName : String);
  247. Procedure AddInstallFile(AFileName : String);
  248. Procedure GetCleanFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
  249. procedure GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS);
  250. Procedure GetArchiveFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
  251. Procedure GetSourceFiles(List : TStrings); virtual;
  252. Procedure GetManifest(Manifest : TStrings);
  253. Property Version : String Read FVersion Write FVersion;
  254. Property FileName : String Read GetFileName Write FFileName;
  255. Property ExternalURL : String Read FExternalURL Write FExternalURL;
  256. Property Email : String Read FEmail Write FEmail;
  257. Property Author : String Read FAuthor Write FAuthor;
  258. Property License : String Read FLicense Write FLicense;
  259. Property Directory : String Read FDirectory Write FDirectory;
  260. Property Description : String Read GetDescription Write FDescription;
  261. Property DescriptionFile : String Read FDescriptionFile Write FDescriptionFile;
  262. // Compiler options.
  263. Property OS : TOses Read FOS Write FOS;
  264. Property CPU : TCPUs Read FCPU Write FCPU;
  265. Property Options: String Read FOptions Write FOptions;
  266. Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
  267. Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
  268. Property HasIncludePath : Boolean Index 2 Read GetHasStrings;
  269. Property HasDependencies : Boolean Index 3 Read GetHasStrings;
  270. Property HasInstallFiles: Boolean Index 4 Read GetHasStrings;
  271. Property HasCleanFiles : Boolean Index 5 Read GetHasStrings;
  272. Property HasArchiveFiles : Boolean Index 6 Read GetHasStrings;
  273. Property HasCommands : Boolean Read GetHasCommands;
  274. Property UnitPath : TStrings Index 0 Read GetStrings Write SetStrings;
  275. Property ObjectPath : TStrings Index 1 Read GetStrings Write SetStrings;
  276. Property IncludePath : TStrings Index 2 Read GetStrings Write SetStrings;
  277. // Targets and dependencies
  278. Property Dependencies : TStrings Index 3 Read GetStrings Write SetStrings;
  279. Property InstallFiles : TStrings Index 4 Read GetStrings Write SetStrings;
  280. Property CleanFiles : TStrings Index 5 Read GetStrings Write SetStrings;
  281. Property ArchiveFiles : TStrings Index 6 Read GetStrings Write SetStrings;
  282. Property Commands : TCommands Read GetCommands Write SetCommands;
  283. Property State : TTargetState Read FTargetState;
  284. Property Targets : TTargets Read FTargets;
  285. Property Sources : TSources Read FSources;
  286. // events
  287. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  288. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  289. Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
  290. Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
  291. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  292. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  293. Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
  294. Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
  295. Property BeforeManifest : TNotifyEvent Read FBeforeManifest Write FBeforeManifest;
  296. Property AfterManifest : TNotifyEvent Read FAfterManifest Write FAfterManifest;
  297. end;
  298. { TPackages }
  299. TPackages = Class(TNamedCollection)
  300. private
  301. function GetPackage(AName : String): TPackage;
  302. function GetPackageItem(AIndex : Integer): TPackage;
  303. procedure SetPackageItem(AIndex : Integer; const AValue: TPackage);
  304. Public
  305. Function AddPackage(Const AName : String) : TPackage;
  306. Property Packages[AName : String] : TPackage Read GetPackage ; Default;
  307. Property PackageItems[AIndex : Integer] : TPackage Read GetPackageItem Write SetPackageItem;
  308. end;
  309. { TDefaults }
  310. TDefaults = Class(TPersistent)
  311. Private
  312. FArchive: String;
  313. FCompiler: String;
  314. FCopy: String;
  315. FMkDir: String;
  316. FMove: String;
  317. FOptions: String;
  318. FCPU: TCPU;
  319. FOS: TOS;
  320. FMode : TCompilerMode;
  321. FCompilerVersion : String;
  322. FPrefix: String;
  323. FBaseInstallDir,
  324. FUnitInstallDir,
  325. FBinInstallDir,
  326. FDocInstallDir,
  327. FExamplesInstallDir : String;
  328. FRemove: String;
  329. FTarget: String;
  330. FUnixPaths: Boolean;
  331. function GetBaseInstallDir: String;
  332. function GetBinInstallDir: String;
  333. function GetCompiler: String;
  334. function GetDocInstallDir: String;
  335. function GetExamplesInstallDir: String;
  336. function GetUnitInstallDir: String;
  337. procedure SetBaseInstallDir(const AValue: String);
  338. procedure SetCPU(const AValue: TCPU);
  339. procedure SetOS(const AValue: TOS);
  340. procedure SetPrefix(const AValue: String);
  341. procedure SetTarget(const AValue: String);
  342. Protected
  343. procedure RecalcTarget;
  344. Public
  345. Constructor Create;
  346. Procedure InitDefaults;
  347. Procedure Assign(ASource : TPersistent);override;
  348. procedure CompilerDefaults;
  349. Procedure LocalInit(Const AFileName : String);
  350. Procedure LoadFromFile(Const AFileName : String);
  351. Procedure SaveToFile(Const AFileName : String);
  352. procedure SaveToStream(S : TStream);virtual;
  353. procedure LoadFromStream(S : TStream);virtual;
  354. // Compile Information
  355. Property Target : String Read FTarget Write SetTarget;
  356. Property OS : TOS Read FOS Write SetOS;
  357. Property CPU : TCPU Read FCPU Write SetCPU;
  358. Property Mode : TCompilerMode Read FMode Write FMode;
  359. Property UnixPaths : Boolean Read FUnixPaths Write FUnixPaths;
  360. Property Options : String Read FOptions Write FOptions; // Default compiler options.
  361. // paths etc.
  362. Property Prefix : String Read FPrefix Write SetPrefix;
  363. Property BaseInstallDir : String Read GetBaseInstallDir Write SetBaseInstallDir;
  364. Property UnitInstallDir : String Read GetUnitInstallDir Write FUnitInstallDir;
  365. Property BinInstallDir : String Read GetBinInstallDir Write FBinInstallDir;
  366. Property DocInstallDir : String Read GetDocInstallDir Write FDocInstallDir;
  367. Property ExamplesInstallDir : String Read GetExamplesInstallDir Write FExamplesInstallDir;
  368. // Command tools. If not set, internal commands will be used.
  369. Property Compiler : String Read GetCompiler Write FCompiler; // Compiler. Defaults to fpc/ppc386
  370. Property Copy : String Read FCopy Write FCopy; // copy $(FILES) to $(DEST)
  371. Property Move : String Read FMove Write FMove; // Move $(FILES) to $(DEST)
  372. Property Remove : String Read FRemove Write FRemove; // Delete $(FILES)
  373. Property MkDir : String Read FMkDir write FMkDir; // Make $(DIRECTORY)
  374. Property Archive : String Read FArchive Write FArchive; // zip $(ARCHIVE) $(FILESORDIRS)
  375. end;
  376. { TBuildEngine }
  377. TBuildEngine = Class(TComponent)
  378. private
  379. // general variables
  380. FCompiler : String;
  381. FStartDir : String;
  382. FTargetDir : String;
  383. FDefaults : TDefaults;
  384. FForceCompile : Boolean;
  385. FListMode : Boolean;
  386. // Variables used when compiling a package.
  387. // Only valid during compilation of the package.
  388. FCurrentOutputDir : String;
  389. FCurrentPackage: TPackage;
  390. // Events
  391. FOnLog: TLogEvent;
  392. FAfterArchive: TNotifyEvent;
  393. FAfterClean: TNotifyEvent;
  394. FAfterCompile: TNotifyEvent;
  395. FAfterInstall: TNotifyEvent;
  396. FAfterManifest: TNotifyEvent;
  397. FBeforeArchive: TNotifyEvent;
  398. FBeforeClean: TNotifyEvent;
  399. FBeforeCompile: TNotifyEvent;
  400. FBeforeInstall: TNotifyEvent;
  401. FBeforeManifest: TNotifyEvent;
  402. procedure SetDefaults(const AValue: TDefaults);
  403. procedure SetTargetDir(const AValue: String);
  404. Protected
  405. Procedure Error(Msg : String);
  406. Procedure Error(Fmt : String; Args : Array of const);
  407. // Internal copy/delete/move/archive/mkdir files
  408. Procedure SysCopyFile(Const Src,Dest : String); virtual;
  409. Procedure SysMoveFile(Const Src,Dest : String); virtual;
  410. Procedure SysDeleteFile(Const AFileName : String); virtual;
  411. Procedure SysArchiveFiles(List : TStrings; Const AFileName : String); virtual;
  412. Procedure Log(Level : TVerboseLevel; Const Msg : String);
  413. Procedure Log(Level : TVerboseLevel; Const Fmt : String; Args : Array Of Const);
  414. Procedure EnterDir(ADir : String);
  415. Function GetCompiler : String;
  416. Procedure InstallPackageFiles(APAckage : TPackage; tt : TTargetType; Const Src,Dest : String); virtual;
  417. Function FileNewer(Src,Dest : String) : Boolean;
  418. Public
  419. Constructor Create(AOwner : TComponent); override;
  420. // Public Copy/delete/Move/Archive/Mkdir Commands.
  421. Procedure ExecuteCommand(Cmd : String; Args : String; IgnoreError : Boolean = False); virtual;
  422. Procedure CmdCopyFiles(List : TStrings; Const DestDir : String);
  423. Procedure CmdCreateDir(DestDir : String);
  424. Procedure CmdMoveFiles(List : TStrings; Const DestDir : String);
  425. Procedure CmdDeleteFiles(List : TStrings);
  426. Procedure CmdArchiveFiles(List : TStrings; Const ArchiveFile : String);
  427. Procedure ExecuteCommands(Commands : TCommands; At : TCommandAt);
  428. // Target commands
  429. Function GetTargetDir(APackage : TPackage; ATarget : TTarget; AbsolutePath : Boolean = False) : String;
  430. Function GetCompilerCommand(APackage : TPackage; Target : TTarget) : String;
  431. Function TargetOK(Target : TTarget) : Boolean;
  432. Function NeedsCompile(Target : TTarget) : Boolean;
  433. Procedure Compile(Target : TTarget); virtual;
  434. Procedure FixDependencies(Target: TTarget);
  435. // Package commands
  436. Function GetPackageDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  437. Function GetOutputDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  438. Function PackageOK(APackage : TPackage) : Boolean; virtual;
  439. Procedure DoBeforeCompile(APackage : TPackage);virtual;
  440. Procedure DoAfterCompile(APackage : TPackage);virtual;
  441. Procedure DoBeforeInstall(APackage : TPackage);virtual;
  442. Procedure DoAfterInstall(APackage : TPackage);virtual;
  443. Procedure DoBeforeArchive(APackage : TPackage);virtual;
  444. Procedure DoAfterArchive(APackage : TPackage);virtual;
  445. Procedure DoBeforeClean(APackage : TPackage);virtual;
  446. Procedure DoAfterClean(APackage : TPackage);virtual;
  447. Function NeedsCompile(APackage : TPackage) : Boolean; virtual;
  448. Procedure Compile(APackage : TPackage);
  449. Procedure Install(APackage : TPackage);
  450. Procedure Archive(APackage : TPackage);
  451. Procedure Clean(APackage : TPackage);
  452. Procedure FixDependencies(APackage : TPackage);
  453. Procedure GetSourceFiles(APackage : TPackage; List : TStrings);
  454. Procedure GetManifest(APackage : TPackage; Manifest : TStrings);
  455. procedure CheckExternalPackage(Const APackageName : String);
  456. procedure CreateOutputDir(APackage: TPackage);
  457. // Packages commands
  458. Procedure Compile(Packages : TPackages);
  459. Procedure Install(Packages : TPackages);
  460. Procedure Archive(Packages : TPackages);
  461. Procedure Clean(Packages : TPackages);
  462. Procedure GetSourceFiles(Packages : TPackages;List : TStrings);
  463. Procedure GetManifest(Packages : TPackages; Manifest : TStrings);
  464. Property ListMode : Boolean Read FListMode Write FListMode;
  465. Property ForceCompile : Boolean Read FForceCompile Write FForceCompile;
  466. Property Defaults : TDefaults Read FDefaults Write SetDefaults;
  467. Property TargetDir : String Read FTargetDir Write SetTargetDir;
  468. // Events
  469. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  470. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  471. Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
  472. Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
  473. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  474. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  475. Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
  476. Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
  477. Property BeforeManifest : TNotifyEvent Read FBeforeManifest Write FBeforeManifest;
  478. Property AfterManifest : TNotifyEvent Read FAfterManifest Write FAfterManifest;
  479. Property OnLog : TLogEvent Read FOnLog Write FOnlog;
  480. end;
  481. { TInstaller }
  482. TInstaller = Class(TComponent)
  483. private
  484. FBuildEngine: TBuildEngine;
  485. FDefaultPackage: TPackage;
  486. FDefaults: TDefaults;
  487. FPackages: TPackages;
  488. FRunMode: TRunMode;
  489. FListMode : Boolean;
  490. FLogLevels : TVerboseLevels;
  491. Function GetPackageString(Index : Integer) : String;
  492. Procedure SetPackageString(Index : Integer; AValue : String);
  493. function GetStrings(AIndex : Integer): TStrings;
  494. function GetOSes: TOSes;
  495. function GetTargets: TTargets;
  496. function GetSources: TSources;
  497. procedure SetDefaultPackage(const AValue: TPackage);
  498. procedure SetDefaults(const AValue: TDefaults);
  499. procedure SetStrings(AIndex : Integer; const AValue: TStrings);
  500. procedure SetOses(const AValue: TOSes);
  501. Protected
  502. Procedure Log(Level : TVerboseLevel; Const Msg : String);
  503. Procedure CreatePackages; virtual;
  504. Procedure CheckPackages; virtual;
  505. Procedure CreateBuildEngine; virtual;
  506. Procedure CheckDefaultPackage;
  507. Procedure Error(Msg : String);
  508. Procedure Error(Fmt : String; Args : Array of const);
  509. Procedure AnalyzeOptions;
  510. Procedure Usage(FMT : String; Args : Array of const);
  511. Procedure Compile(Force : Boolean); virtual;
  512. Procedure Clean; virtual;
  513. Procedure Install; virtual;
  514. Procedure Archive; virtual;
  515. Procedure Manifest; virtual;
  516. Procedure GetSourceFiles; virtual;
  517. Property BuildEngine : TBuildEngine Read FBuildEngine;
  518. Public
  519. Constructor Create(AOWner : TComponent); override;
  520. Destructor destroy; override;
  521. Function StartPackage(Const AName : String) : TPackage;
  522. Procedure EndPackage;
  523. Function Run : Boolean;
  524. Function AddTarget(AName : String) : TTarget;
  525. Procedure AddDependency(AName : String);
  526. Property DefaultPackage : TPackage read FDefaultPackage write SetDefaultPackage;
  527. Property Packages : TPackages Read FPackages;
  528. Property Dependencies : TStrings Index 0 Read GetStrings Write SetStrings;
  529. Property InstallFiles : TStrings Index 1 Read GetStrings Write SetStrings;
  530. Property CleanFiles : TStrings Index 2 Read GetStrings Write SetStrings;
  531. Property ArchiveFiles : TStrings Index 3 Read GetStrings Write SetStrings;
  532. Property Defaults : TDefaults Read FDefaults Write SetDefaults;
  533. Property RunMode : TRunMode Read FRunMode;
  534. Property ListMode : Boolean Read FListMode;
  535. // Default Package redirects.
  536. Property Targets : TTargets Read GetTargets;
  537. Property Sources : TSources Read GetSources;
  538. Property OS: TOSes Read GetOSes Write SetOses;
  539. Property Author : String Index 0 Read GetPackageString Write SetPackageString;
  540. Property Directory : String Index 1 Read GetPackageString Write SetPackageString;
  541. Property License : String Index 2 Read GetPackageString Write SetPackageString;
  542. Property Options : String Index 3 Read GetPackageString Write SetPackageString;
  543. Property ExternalURL : String Index 4 Read GetPackageString Write SetPackageString;
  544. Property Email : String Index 5 Read GetPackageString Write SetPackageString;
  545. Property Description: String Index 6 Read GetPackageString Write SetPackageString;
  546. Property DescriptionFileName: String Index 7 Read GetPackageString Write SetPackageString;
  547. Property Version : String Index 8 Read GetPackageString Write SetPackageString;
  548. Property FileName : String Index 9 Read GetPackageString Write SetPackageString;
  549. end;
  550. TReplaceFunction = Function (Const AName,Args : String) : String of Object;
  551. { TValueItem }
  552. TValueItem = Class(TObject)
  553. FValue : String;
  554. Constructor Create(AValue : String);
  555. end;
  556. { TFunctionItem }
  557. TFunctionItem = Class(TObject)
  558. FFunc : TReplaceFunction;
  559. Constructor Create(AFunc : TReplaceFunction);
  560. end;
  561. { TDictionary }
  562. TDictionary = Class(TComponent)
  563. FList : TStringList;
  564. Public
  565. Constructor Create(AOwner : TComponent); override;
  566. Destructor Destroy;override;
  567. Procedure AddVariable(Const AName,Value : String);
  568. Procedure AddFunction(Const AName : String; FReplacement : TReplaceFunction);
  569. Procedure RemoveItem(Const AName : String);
  570. Function GetValue(Const AName : String) : String;
  571. Function GetValue(Const AName,Args : String) : String; virtual;
  572. Function ReplaceStrings(Const ASource : String) : String; virtual;
  573. end;
  574. ECollectionError = Class(Exception);
  575. EInstallerError = fpmktype.EInstallerError;
  576. EDictionaryError = Class(Exception);
  577. TInstallerClass = Class of TInstaller;
  578. TDictionaryClass = Class of TDictionary;
  579. // Constants are in the file as for fpmktype.
  580. {$i fpmkcnst.inc}
  581. Type
  582. TArchiveEvent = Procedure (Const AFileName : String; List : TStrings) of Object;
  583. TArchiveProc = Procedure (Const AFileName : String; List : TStrings);
  584. Var
  585. InstallerClass : TInstallerClass = TInstaller;
  586. DictionaryClass : TDictionaryClass = TDictionary;
  587. OnArchiveFiles : TArchiveEvent = Nil;
  588. ArchiveFilesProc : TArchiveProc = Nil;
  589. Function CurrentOS : String;
  590. Function CurrentCPU : String;
  591. Function Installer : TInstaller;
  592. Function Defaults : TDefaults; // Set by installer.
  593. Function Dictionary : TDictionary;
  594. Function OSToString(OS: TOS) : String;
  595. Function OSesToString(OSes: TOSes) : String;
  596. Function CPUToString(CPU: TCPU) : String;
  597. Function CPUSToString(CPUS: TCPUS) : String;
  598. Function StringToOS(S : String) : TOS;
  599. Function OSesToString(S : String) : TOSes;
  600. Function StringToCPU(S : String) : TCPU;
  601. Function StringToCPUS(S : String) : TCPUS;
  602. Function ModeToString(Mode: TCompilerMode) : String;
  603. Function StringToMode(S : String) : TCompilerMode;
  604. Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
  605. Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
  606. Procedure ResolveDependencies(L : TStrings; P : TNamedCollection);
  607. Function AddStrings(Dest,Src : TStrings) : Integer ;
  608. function AddStrings(Dest, Src : TStrings; Const APrefix : String) : Integer ;
  609. Function FileListToString(List : TStrings; Prefix : String) : String;
  610. Function FixPath (APath : String) : String;
  611. Procedure ChangeDir(APath : String);
  612. Function Substitute(Const Source : String; Macros : Array of string) : String;
  613. Procedure SplitCommand(Const Cmd : String; Var Exe,Options : String);
  614. Implementation
  615. uses typinfo;
  616. ResourceString
  617. SErrNameExists = 'Name "%s" already exists in the collection.';
  618. SErrNoSuchName = 'Could not find item with name "%s" in the collection.';
  619. SErrNoPackage = 'No package available. Add package with StartPackage Call';
  620. SErrInValidArgument = 'Invalid command-line argument at position %d : %s';
  621. SErrNeedArgument = 'Option at position %d (%s) needs an argument';
  622. SErrNoPackagesDefined = 'No action possible: No packages were defined.';
  623. SErrInstaller = 'The installer encountered the following error:';
  624. SErrDepUnknownTarget = 'Unknown target in dependencies for %s: %s';
  625. SErrExternalCommandFailed = 'External command "%s" failed with exit code: %d';
  626. SErrCreatingDirectory = 'Failed to create directory: %s';
  627. SErrDeletingFile = 'Failed to delete file: %s';
  628. SErrMovingFile = 'Failed to move file "%s" to "%s"';
  629. SErrCopyingFile = 'Failed to copy file "%s" to "%s"';
  630. SErrChangeDirFailed = 'Failed to enter directory: %s';
  631. SErrInvalidArgumentToSubstitute = 'Invalid number of arguments to Substitute';
  632. SErrNoArchiveSupport = 'This binary contains no archive support. Please recompile with archive support';
  633. SErrNoDictionaryItem = 'No item called "%s" in the dictionary';
  634. SErrNoDictionaryValue = 'The item "%s" in the dictionary is not a value.';
  635. SErrNoDictionaryFunc = 'The item "%s" in the dictionary is not a function.';
  636. SWarnCircularDependency = 'Warning: Circular dependency detected when compiling target %s: %s';
  637. SWarnFailedToSetTime = 'Warning: Failed to set timestamp on file : %s';
  638. SWarnFailedToGetTime = 'Warning: Failed to get timestamp from file : %s';
  639. SWarnFileDoesNotExist = 'Warning: File "%s" does not exist';
  640. // Log messages
  641. SLogEnterDir = 'Entering directory: %s';
  642. SLogCompilingPackage = 'Compiling package : %s';
  643. SLogCompilingTarget = 'Compiling target : %s';
  644. SLogExecutingCommand = 'Executing command %s with options: %s';
  645. SLogCreatingOutputDir = 'Creating output dir : %s';
  646. SLogOutputDirExists = 'Output dir exists : %s';
  647. SLogInstallingPackage = 'Installing package : %s';
  648. SLogArchivingPackage = 'Archiving package : %s';
  649. SLogCleaningPackage = 'Cleaning package : %s';
  650. SLogCopyingFile = 'Copying file "%s" to "%s"';
  651. SLogCompilingFileTimes = 'Comparing file "%s" time "%s" to "%s" time "%s".';
  652. SLogSourceNewerDest = 'Source file "%s" (%s) is newer than destination "%s" (%s).';
  653. // Help messages for usage
  654. SValue = 'Value';
  655. SHelpUsage = 'Usage: %s command [options]';
  656. SHelpCommand = 'Where command is one of the following:';
  657. SHelpCompile = 'Compile all units in the package(s).';
  658. SHelpBuild = 'Build all units in the package(s).';
  659. SHelpInstall = 'Install all units in the package(s).';
  660. SHelpClean = 'Clean (remove) all units in the package(s).';
  661. SHelpArchive = 'Create archive (zip) with all units in the package(s).';
  662. SHelpHelp = 'This message.';
  663. SHelpManifest = 'Create a manifest suitable for import in repository.';
  664. SHelpCmdOptions = 'Where options is one or more of the following:';
  665. SHelpCPU = 'Compile for indicated CPU.';
  666. SHelpOS = 'Compile for indicated OS';
  667. SHelpTarget = 'Compile for indicated target';
  668. SHelpList = 'list commands instead of actually executing them.';
  669. SHelpPrefix = 'Use indicated prefix directory for all commands.';
  670. SHelpNoDefaults = 'Do not use defaults when compiling.';
  671. SHelpBaseInstallDir = 'Use indicated directory as base install dir.';
  672. SHelpCompiler = 'Use indicated binary as compiler';
  673. SHelpConfig = 'Use indicated config file when compiling.';
  674. SHelpVerbose = 'Be verbose when working.';
  675. Const
  676. // Keys for Defaults file. Do not localize.
  677. KeyCompiler = 'Compiler';
  678. KeyArchive = 'Archive';
  679. KeyCopy = 'Copy';
  680. KeyMkDir = 'MkDir';
  681. KeyMove = 'Move';
  682. KeyRemove = 'Remove';
  683. KeyOptions = 'Options';
  684. KeyCPU = 'CPU';
  685. KeyOS = 'OS';
  686. KeyMode = 'Mode';
  687. KeyPrefix = 'Prefix';
  688. KeyTarget = 'Target';
  689. KeyBaseInstallDir = 'BaseInstallDir';
  690. KeyUnitInstallDir = 'UnitInstallDir';
  691. KeyBinInstallDir = 'BinInstallDir';
  692. KeyDocInstallDir = 'DocInstallDir';
  693. KeyExamplesInstallDir = 'ExamplesInstallDir';
  694. // Callback for Sysutils getapplicationname.
  695. Function GetFPMakeName : String;
  696. begin
  697. Result:='fpmake';
  698. end;
  699. Function CurrentOS : String;
  700. begin
  701. Result:=OSToString(Defaults.OS);
  702. end;
  703. Function CurrentCPU : String;
  704. begin
  705. Result:=CPUToString(Defaults.CPU);
  706. end;
  707. Function OSToString(OS: TOS) : String;
  708. begin
  709. Result:=fpmktype.OsToString(OS);
  710. end;
  711. Function OSesToString(OSes: TOSes) : String;
  712. begin
  713. Result:=fpmktype.OSesToString(OSes);
  714. end;
  715. Function CPUToString(CPU: TCPU) : String;
  716. begin
  717. Result:=fpmkType.CPUToString(CPU);
  718. end;
  719. Function CPUSToString(CPUS: TCPUS) : String;
  720. begin
  721. Result:=fpmktype.CPUSToString(CPUS);
  722. end;
  723. Function StringToOS(S : String) : TOS;
  724. begin
  725. Result:=fpmktype.StringToOS(S);
  726. end;
  727. Function OSesToString(S : String) : TOSes;
  728. begin
  729. Result:=fpmktype.OSesToString(S);
  730. end;
  731. Function StringToCPU(S : String) : TCPU;
  732. begin
  733. Result:=fpmktype.StringToCPU(S);
  734. end;
  735. Function StringToCPUS(S : String) : TCPUS;
  736. begin
  737. Result:=fpmktype.StringToCPUS(S);
  738. end;
  739. Function ModeToString(Mode: TCompilerMode) : String;
  740. begin
  741. Result:=fpmktype.ModeToString(Mode);
  742. end;
  743. Function StringToMode(S : String) : TCompilerMode;
  744. begin
  745. Result:=fpmktype.StringToMode(S);
  746. end;
  747. Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
  748. begin
  749. Result:=fpmktype.MakeTargetString(CPU,OS);
  750. end;
  751. Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
  752. begin
  753. fpmktype.StringToCPUOS(S,CPU,OS);
  754. end;
  755. Procedure ResolveDependencies(L : TStrings; P : TNamedCollection);
  756. Var
  757. I,J : Integer;
  758. begin
  759. If Assigned(L) then
  760. For I:=0 to L.Count-1 do
  761. begin
  762. J:=P.IndexOfName(L[i]);
  763. If J<>-1 then
  764. L.Objects[I]:=P.Items[J];
  765. end;
  766. end;
  767. Function AddStrings(Dest,Src : TStrings) : Integer ;
  768. begin
  769. Result:=AddStrings(Dest,Src,'');
  770. end;
  771. Procedure AddStrings(Var S : String; L : TStrings; Prefix : String);
  772. Var
  773. I : Integer;
  774. begin
  775. For I:=0 to L.Count-1 do
  776. begin
  777. if (S<>'') then
  778. S:=S+' ';
  779. S:=S+Prefix+L[i];
  780. end;
  781. end;
  782. function AddStrings(Dest, Src : TStrings; Const APrefix : String) : Integer ;
  783. begin
  784. Result:=0;
  785. While (Result<Src.Count) do
  786. begin
  787. If (APrefix<>'') then
  788. Dest.Add(APrefix+Src[Result]) // Not sure whether '' is optimized away.
  789. else
  790. Dest.Add(Src[Result]);
  791. Inc(Result);
  792. end;
  793. end;
  794. function FileListToString(List : TStrings; Prefix : String) : String;
  795. Var
  796. I : integer;
  797. S : String;
  798. begin
  799. Result:='';
  800. For I:=0 to List.Count-1 do
  801. begin
  802. If (I>0) then
  803. Result:=Result+' ';
  804. S:=Prefix+List[i];
  805. If (Pos(' ',S)<>0) then
  806. S:='"'+S+'"';
  807. Result:=Result+S;
  808. end;
  809. end;
  810. function FixPath (APath : String) : String;
  811. Var
  812. P : PChar;
  813. begin
  814. Result:=APath;
  815. If (result<>'') then
  816. begin
  817. P:=PChar(Result);
  818. While (P^<>#0) do
  819. begin
  820. If P^ in ['/','\',':'] then // do not use drive letters.
  821. P^:=PathDelim;
  822. Inc(P);
  823. end;
  824. end;
  825. end;
  826. procedure ChangeDir(APath : String);
  827. begin
  828. if Not SetCurrentDir(APath) then
  829. Raise EInstallerError.CreateFmt(SErrChangeDirFailed,[APath]);
  830. end;
  831. procedure SplitCommand(const Cmd : String; var Exe, Options : String);
  832. Const
  833. WhiteSpace = [#9,#10,#13,' '];
  834. QuoteChars = ['''','"'];
  835. Var
  836. I : Integer;
  837. InQuote : Boolean;
  838. LastQuote : Char;
  839. S : String;
  840. begin
  841. S:=Trim(Cmd);
  842. InQuote:=False;
  843. LastQuote:=#0;
  844. I:=1;
  845. While (I<=Length(S)) and (Inquote or not (S[I] in whiteSpace)) do
  846. begin
  847. If S[i] in QuoteChars then
  848. begin
  849. InQuote:=Not (S[i]=LastQuote);
  850. If InQuote then
  851. LastQuote:=S[i]
  852. else
  853. LastQuote:=#0;
  854. end;
  855. Inc(I);
  856. end;
  857. Exe:=Copy(S,1,I-1);
  858. Delete(S,1,I);
  859. Options:=Trim(S);
  860. end;
  861. { TNamedItem }
  862. procedure TNamedItem.SetName(const AValue: String);
  863. begin
  864. if FName=AValue then exit;
  865. With TNamedCollection(Collection) do
  866. If UniqueNames then
  867. If (IndexOfName(AVAlue)<>-1) then
  868. Raise ECollectionError.CreateFmt(SErrNameExists,[AValue]);
  869. FName:=AValue;
  870. end;
  871. { TNamedCollection }
  872. function TNamedCollection.IndexOfName(AName: String): Integer;
  873. begin
  874. Result:=Count-1;
  875. While (Result>=0) and (CompareText(TNamedItem(Items[Result]).FName,AName)<>0) do
  876. Dec(Result);
  877. end;
  878. function TNamedCollection.ItemByName(AName: String): TNamedItem;
  879. Var
  880. I : Integer;
  881. begin
  882. I:=IndexOfName(AName);
  883. If (I=-1) Then
  884. Raise ECollectionError.CreateFmt(SErrNoSuchName,[AName]);
  885. Result:=TNamedItem(Items[i]);
  886. end;
  887. { TTargets }
  888. function TTargets.GetTargetItem(Index : Integer): TTarget;
  889. begin
  890. Result:=TTarget(Items[Index]);
  891. end;
  892. function TTargets.GetTarget(AName : String): TTarget;
  893. begin
  894. Result:=TTarget(ItemByName(AName));
  895. end;
  896. procedure TTargets.SetDefaultDir(const AValue: String);
  897. begin
  898. If (AValue<>'') then
  899. FDefaultDir:=IncludeTrailingPathDelimiter(AValue)
  900. else
  901. FDefaultDir:='';
  902. end;
  903. procedure TTargets.SetTargetItem(Index : Integer; const AValue: TTarget);
  904. begin
  905. Items[Index]:=AValue;
  906. end;
  907. procedure TTargets.ApplyDefaults(ATarget: TTarget);
  908. begin
  909. If (ATarget.Directory='') then
  910. ATarget.Directory:=FDefaultDir;
  911. ATarget.OS:=FDefaultOS;
  912. ATarget.CPU:=FDefaultCPU;
  913. end;
  914. procedure TTargets.ResetDefaults;
  915. begin
  916. FDefaultDir:='';
  917. FDefaultOS:=[];
  918. FDefaultCPU:=[];
  919. end;
  920. Function TTargets.AddUnit(AUnitName: String) : TTarget;
  921. begin
  922. Result:=Add as TTarget;
  923. Result.Name:=AUnitName;
  924. Result.TargetType:=TTUnit;
  925. ApplyDefaults(Result);
  926. end;
  927. Function TTargets.AddProgram(AProgramName: String) : TTarget;
  928. begin
  929. Result:=Add as TTarget;
  930. Result.Name:=AProgramName;
  931. Result.TargetType:=ttProgram;
  932. ApplyDefaults(Result);
  933. end;
  934. Function TTargets.AddExampleUnit(AUnitName: String): TTarget;
  935. begin
  936. Result:=Add as TTarget;
  937. Result.Name:=AUnitName;
  938. Result.TargetType:=ttExampleUnit;
  939. ApplyDefaults(Result);
  940. end;
  941. Function TTargets.AddExampleProgram(AProgramName: String): TTarget;
  942. begin
  943. Result:=Add as TTarget;
  944. Result.Name:=AProgramName;
  945. Result.TargetType:=ttExampleProgram;
  946. ApplyDefaults(Result);
  947. end;
  948. { TSources }
  949. function TSources.GetSourceItem(Index : Integer): TSource;
  950. begin
  951. Result:=TSource(Items[Index]);
  952. end;
  953. procedure TSources.SetSourceItem(Index : Integer; const AValue: TSource);
  954. begin
  955. Items[Index]:=AValue;
  956. end;
  957. function TSources.AddDocFiles(AFiles : String) : TSource;
  958. begin
  959. Result:=Add as TSource;
  960. Result.Name:=AFiles;
  961. Result.SourceType:=stDoc;
  962. end;
  963. function TSources.AddSrcFiles(AFiles : String) : TSource;
  964. begin
  965. Result:=Add as TSource;
  966. Result.Name:=AFiles;
  967. Result.SourceType:=stSrc;
  968. end;
  969. function TSources.AddExampleFiles(AFiles : String) : TSource;
  970. begin
  971. Result:=Add as TSource;
  972. Result.Name:=AFiles;
  973. Result.SourceType:=stExample;
  974. end;
  975. function TSources.AddTestFiles(AFiles : String) : TSource;
  976. begin
  977. Result:=Add as TSource;
  978. Result.Name:=AFiles;
  979. Result.SourceType:=stTest;
  980. end;
  981. { TNamedItemList }
  982. function TNamedItemList.GetNamedItem(Index : Integer): TNamedItem;
  983. begin
  984. Result:=TNamedItem(Items[Index]);
  985. end;
  986. procedure TNamedItemList.SetNamedItem(Index : Integer; const AValue: TNamedItem);
  987. begin
  988. Items[Index]:=AValue;
  989. end;
  990. function TNamedItemList.IndexOfName(AName: String): Integer;
  991. begin
  992. Result:=Count-1;
  993. While (Result>=0) and (CompareText(GetNamedItem(Result).Name,AName)<>0) do
  994. Dec(Result);
  995. end;
  996. function TNamedItemList.ItemByName(ANAme: String): TNamedItem;
  997. Var
  998. I : Integer;
  999. begin
  1000. I:=IndexOfName(AName);
  1001. If (I=-1) Then
  1002. Raise ECollectionError.CreateFmt(SErrNoSuchName,[AName]);
  1003. Result:=TNamedItem(Items[i]);
  1004. end;
  1005. { TDefaults }
  1006. procedure TDefaults.SetCPU(const AValue: TCPU);
  1007. begin
  1008. FCPU:=AValue;
  1009. RecalcTarget;
  1010. end;
  1011. function TDefaults.GetBaseInstallDir: String;
  1012. begin
  1013. If (FBaseInstallDir<>'') then
  1014. Result:=FBaseInstallDir
  1015. else
  1016. if UnixPaths then
  1017. Result:=Prefix+PathDelim+'lib'+PathDelim+'fpc'
  1018. else
  1019. Result:=Prefix;
  1020. end;
  1021. function TDefaults.GetBinInstallDir: String;
  1022. begin
  1023. If (FBinInstallDir<>'') then
  1024. Result:=FBinInstallDir
  1025. else
  1026. If UnixPaths then
  1027. Result:=BaseInstallDir+PathDelim+'bin'
  1028. else
  1029. Result:=BaseInstallDir+PathDelim+'bin';
  1030. end;
  1031. function TDefaults.GetCompiler: String;
  1032. begin
  1033. If (FCompiler<>'') then
  1034. Result:=FCompiler
  1035. else
  1036. Result:='fpc';
  1037. end;
  1038. function TDefaults.GetDocInstallDir: String;
  1039. begin
  1040. If (FBinInstallDir<>'') then
  1041. Result:=FBinInstallDir
  1042. else
  1043. If UnixPaths then
  1044. Result:=Prefix+PathDelim+'share'+PathDelim+'docs'
  1045. else
  1046. Result:=BaseInstallDir+PathDelim+'docs';
  1047. end;
  1048. function TDefaults.GetExamplesInstallDir: String;
  1049. begin
  1050. If (FExamplesInstallDir<>'') then
  1051. Result:=FExamplesInstallDir
  1052. else
  1053. If UnixPaths then
  1054. Result:=Prefix+PathDelim+'share'+PathDelim+'docs'+PathDelim+'examples'
  1055. else
  1056. Result:=BaseInstallDir+PathDelim+'examples';
  1057. end;
  1058. function TDefaults.GetUnitInstallDir: String;
  1059. begin
  1060. If (FUnitInstallDir<>'') then
  1061. Result:=FUnitInstallDir
  1062. else
  1063. If UnixPaths then
  1064. Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target
  1065. else
  1066. Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target;
  1067. end;
  1068. procedure TDefaults.SetBaseInstallDir(const AValue: String);
  1069. begin
  1070. FBaseInstallDir:=AValue;
  1071. UnitInstallDir:='';
  1072. BinInstallDir:='';
  1073. ExamplesInstallDir:='';
  1074. end;
  1075. procedure TDefaults.SetOS(const AValue: TOS);
  1076. begin
  1077. FOS:=AValue;
  1078. Recalctarget;
  1079. end;
  1080. procedure TDefaults.SetPrefix(const AValue: String);
  1081. begin
  1082. if FPrefix=AValue then exit;
  1083. FPrefix:=AValue;
  1084. BaseInstallDir:='';
  1085. end;
  1086. procedure TDefaults.SetTarget(const AValue: String);
  1087. Var
  1088. P : Integer;
  1089. begin
  1090. if FTarget<>AValue then
  1091. begin
  1092. P:=Pos('-',AValue);
  1093. If (P<>0) then
  1094. begin
  1095. FOS:=StringToOS(System.Copy(Avalue,P+1,Length(AValue)-P));
  1096. FCPU:=StringToCPU(System.Copy(Avalue,1,P-1));
  1097. end
  1098. else
  1099. FOS:=StringToOS(AValue);
  1100. FTarget:=AValue;
  1101. end;
  1102. end;
  1103. procedure TDefaults.RecalcTarget;
  1104. begin
  1105. Ftarget:=CPUToString(FCPU)+'-'+OStoString(FOS);
  1106. end;
  1107. constructor TDefaults.Create;
  1108. begin
  1109. InitDefaults;
  1110. end;
  1111. procedure TDefaults.InitDefaults;
  1112. begin
  1113. {$ifdef unix}
  1114. UnixPaths:=True;
  1115. {$else}
  1116. UnixPaths:=False;
  1117. {$endif}
  1118. end;
  1119. procedure TDefaults.Assign(ASource: TPersistent);
  1120. Var
  1121. d : TDefaults;
  1122. begin
  1123. If ASource is TDefaults then
  1124. begin
  1125. D:=ASource as TDefaults;
  1126. FArchive:=D.Farchive;
  1127. FCompiler:=D.Compiler;
  1128. FCopy:=D.FCopy;
  1129. FCPU:=D.FCPU;
  1130. FMode:=D.FMode;
  1131. FMkDir:=D.FMkDir;
  1132. FMove:=D.FMove;
  1133. FOptions:=D.FOptions;
  1134. FOS:=D.FOS;
  1135. FPrefix:=D.FPrefix;
  1136. FBaseInstallDir:=D.FBaseInstallDir;
  1137. FUnitInstallDir:=D.FUnitInstallDir;
  1138. FBinInstallDir:=D.FBinInstallDir;
  1139. FDocInstallDir:=D.FDocInstallDir;
  1140. FExamplesInstallDir:=D.FExamplesInstallDir;
  1141. FRemove:=D.FRemove;
  1142. FTarget:=D.FTarget;
  1143. FUnixPaths:=D.FUnixPaths;
  1144. end;
  1145. end;
  1146. procedure TDefaults.LocalInit(Const AFileName : String);
  1147. Var
  1148. FN : String;
  1149. begin
  1150. FN:=AFileName;
  1151. If (FN='') then
  1152. begin
  1153. // Environment variable.
  1154. FN:=GetEnvironmentVariable('FPMAKECFG');
  1155. If (FN<>'') then
  1156. If not FileExists(FN) then
  1157. FN:='';
  1158. // User config file fpmake.cfg
  1159. If (FN='') then
  1160. begin
  1161. FN:=GetAppConfigFile(False);
  1162. If Not FileExists(FN) then
  1163. FN:='';
  1164. end;
  1165. // Global config file fpmake.cfg
  1166. If (FN='') then
  1167. begin
  1168. FN:=GetAppConfigFile(True);
  1169. If Not FileExists(FN) then
  1170. FN:='';
  1171. end;
  1172. end;
  1173. If (FN<>'') and FileExists(FN) then
  1174. LoadFromFile(FN);
  1175. end;
  1176. procedure TDefaults.CompilerDefaults;
  1177. begin
  1178. if Compiler<>'' then
  1179. Compiler:='fpc';
  1180. if CPU=cpuNone then
  1181. CPU:=StringToCPU({$I %FPCTARGETCPU%});
  1182. if OS=osNone then
  1183. OS:=StringToOS({$I %FPCTARGETOS%});
  1184. if FCompilerVersion='' then
  1185. FCompilerVersion:='2.0.4';
  1186. if (FBaseInstallDir='') and (FPrefix='') then
  1187. begin
  1188. // Use the same algorithm as the compiler, see options.pas
  1189. {$ifdef Unix}
  1190. FBaseInstallDir:=FixPath(GetEnvironmentVariable('FPCDIR'));
  1191. if FBaseInstallDir='' then
  1192. begin
  1193. FBaseInstallDir:='/usr/local/lib/fpc/'+FCompilerVersion;
  1194. if not DirectoryExists(FBaseInstallDir) and
  1195. DirectoryExists('/usr/lib/fpc/'+FCompilerVersion) then
  1196. FBaseInstallDir:='/usr/lib/fpc/'+FCompilerVersion;
  1197. end;
  1198. {$else unix}
  1199. FBaseInstallDir:=FixPath(GetEnvironmentVariable('FPCDIR'));
  1200. if FBaseInstallDir='' then
  1201. begin
  1202. FBaseInstallDir:=ExtractFilePath(FCompiler)+'..';
  1203. if not(DirectoryExists(FBaseInstallDir+'/units')) and
  1204. not(DirectoryExists(FBaseInstallDir+'/rtl')) then
  1205. FBaseInstallDir:=FBaseInstallDir+'..';
  1206. end;
  1207. {$endif unix}
  1208. end;
  1209. end;
  1210. procedure TDefaults.LoadFromFile(Const AFileName: String);
  1211. Var
  1212. F : TFileStream;
  1213. begin
  1214. F:=TFileStream.Create(AFileName,fmOpenRead);
  1215. Try
  1216. LoadFromStream(F);
  1217. Finally
  1218. F.Free;
  1219. end;
  1220. end;
  1221. procedure TDefaults.SaveToFile(Const AFileName: String);
  1222. Var
  1223. F : TFileStream;
  1224. begin
  1225. F:=TFileStream.Create(AFileName,fmCreate);
  1226. Try
  1227. SaveToStream(F);
  1228. Finally
  1229. F.Free;
  1230. end;
  1231. end;
  1232. procedure TDefaults.SaveToStream(S : TStream);
  1233. Var
  1234. L : TStringList;
  1235. begin
  1236. L:=TStringList.Create;
  1237. try
  1238. With L do
  1239. begin
  1240. Values[KeyArchive]:=FArchive;
  1241. Values[KeyCompiler]:=FCompiler;
  1242. Values[KeyCopy]:=FCopy;
  1243. Values[KeyMkDir]:=FMkDir;
  1244. Values[KeyMove]:=FMove;
  1245. Values[KeyOptions]:=FOptions;
  1246. Values[KeyCPU]:=CPUToString(FCPU);
  1247. Values[KeyOS]:=OSToString(FOS);
  1248. Values[KeyMode]:=ModeToString(FMode);
  1249. Values[KeyPrefix]:=FPrefix;
  1250. Values[KeyBaseInstallDir]:=FBaseInstallDir;
  1251. Values[KeyUnitInstallDir]:=FUnitInstallDir;
  1252. Values[KeyBinInstallDir]:=FBinInstallDir;
  1253. Values[KeyDocInstallDir]:=FDocInstallDir;
  1254. Values[KeyExamplesInstallDir]:=FExamplesInstallDir;
  1255. Values[KeyRemove]:=FRemove;
  1256. Values[KeyTarget]:=FTarget;
  1257. end;
  1258. L.SaveToStream(S);
  1259. Finally
  1260. L.Free;
  1261. end;
  1262. end;
  1263. procedure TDefaults.LoadFromStream(S: TStream);
  1264. Var
  1265. L : TStrings;
  1266. Line : String;
  1267. I,P,PC : Integer;
  1268. begin
  1269. L:=TStringList.Create;
  1270. Try
  1271. L.LoadFromStream(S);
  1272. // Fix lines.
  1273. For I:=L.Count-1 downto 0 do
  1274. begin
  1275. Line:=L[I];
  1276. P:=Pos('=',Line);
  1277. PC:=Pos(';',Line); // Comment line.
  1278. If (P=0) or ((PC<>0) and (PC<P)) then
  1279. L.Delete(I)
  1280. else
  1281. L[i]:=Trim(System.Copy(Line,1,P-1)+'='+Trim(System.Copy(Line,P+1,Length(Line)-P)));
  1282. end;
  1283. With L do
  1284. begin
  1285. FArchive:=Values[KeyArchive];
  1286. FCompiler:=Values[KeyCompiler];
  1287. FCopy:=Values[KeyCopy];
  1288. FMkDir:=Values[KeyMkDir];
  1289. FMove:=Values[KeyMove];
  1290. FRemove:=Values[KeyRemove];
  1291. FOptions:=Values[KeyOptions];
  1292. Line:=Values[KeyCPU];
  1293. If (Line<>'') then
  1294. FCPU:=StringToCPU(Line);
  1295. Line:=Values[KeyOS];
  1296. If (Line<>'') then
  1297. FOS:=StringToOS(Line);
  1298. Line:=Values[KeyMode];
  1299. If (Line<>'') then
  1300. FMode:=StringToMode(Line);
  1301. FTarget:=Values[KeyTarget];
  1302. FPrefix:=Values[KeyPrefix];
  1303. FBaseInstallDir:=Values[KeyBaseInstallDir];
  1304. FUnitInstallDir:=Values[KeyUnitInstallDir];
  1305. FBinInstallDir:=Values[KeyBinInstallDir];
  1306. FDocInstallDir:=Values[KeyDocInstallDir];
  1307. FExamplesInstallDir:=Values[KeyExamplesInstallDir];
  1308. end;
  1309. Finally
  1310. L.Free;
  1311. end;
  1312. end;
  1313. { TPackage }
  1314. function TPackage.GetHasStrings(AIndex: integer): Boolean;
  1315. begin
  1316. Result:=False;
  1317. Case AIndex Of
  1318. 0 : Result:=FUnitPath<>Nil;
  1319. 1 : Result:=FObjectPath<>Nil;
  1320. 2 : Result:=FIncludePath<>Nil;
  1321. 3 : Result:=FDependencies<>Nil;
  1322. 4 : Result:=FInstallFiles<>Nil;
  1323. 5 : Result:=FCleanFiles<>Nil;
  1324. 6 : Result:=FArchiveFiles<>Nil;
  1325. end;
  1326. end;
  1327. function TPackage.GetCommands: TCommands;
  1328. begin
  1329. If Not Assigned(FCommands) then
  1330. FCommands:=TCommands.Create(TCommand);
  1331. Result:=FCommands;
  1332. end;
  1333. function TPackage.GetHasCommands: Boolean;
  1334. begin
  1335. Result:=Assigned(FCommands);
  1336. end;
  1337. Procedure SplitVersion(AValue: String; Var Release,Major,Minor : Word; Var Suffix : String);
  1338. Function NextDigit(sep : Char; var V : string) : integer;
  1339. Var
  1340. P : Integer;
  1341. begin
  1342. P:=Pos(Sep,V);
  1343. If (P=0) then
  1344. P:=Length(V)+1;
  1345. Result:=StrToIntDef(Copy(V,1,P-1),-1);
  1346. If Result<>-1 then
  1347. Delete(V,1,P)
  1348. else
  1349. Result:=0;
  1350. end;
  1351. Var
  1352. P : Integer;
  1353. V : String;
  1354. begin
  1355. Release:=0;
  1356. Major:=0;
  1357. Minor:=0;
  1358. Suffix:='';
  1359. V:=AValue;
  1360. Release:=NextDigit('.',V);
  1361. Major:=NextDigit('.',V);
  1362. Minor:=NextDigit('-',V);
  1363. P:=Pos('-',V);
  1364. If (P<>0) then
  1365. Delete(V,1,P);
  1366. Suffix:=V;
  1367. end;
  1368. Function QuoteXML(S : String) : string;
  1369. Procedure W(Var J : Integer; Var R : String; T : String);
  1370. Var
  1371. I: integer;
  1372. begin
  1373. If J+Length(T)>Length(R) then
  1374. SetLength(R,J+Length(T));
  1375. For I:=1 to Length(t) do
  1376. begin
  1377. R[J]:=T[i];
  1378. If I<Length(T) then
  1379. Inc(J);
  1380. end;
  1381. end;
  1382. const
  1383. QuotStr = '&quot;';
  1384. AmpStr = '&amp;';
  1385. ltStr = '&lt;';
  1386. gtStr = '&gt;';
  1387. Var
  1388. I,J : Integer;
  1389. begin
  1390. SetLength(Result,Length(S));
  1391. J:=0;
  1392. For I:=1 to Length(S) do
  1393. begin
  1394. Inc(J);
  1395. case S[i] of
  1396. '"': W(j,Result,QuotStr);
  1397. '&': W(J,Result,AmpStr);
  1398. '<': W(J,Result,ltStr);
  1399. // Escape whitespace using CharRefs to be consistent with W3 spec X 3.3.3
  1400. #9: w(J,Result,'&#x9;');
  1401. { #10: wrtStr('&#xA;');
  1402. #13: wrtStr('&#xD;');}
  1403. else
  1404. Result[J]:=S[i];
  1405. end;
  1406. If (J=Length(Result)) and (I<Length(S)) then
  1407. SetLength(Result,J+Length(S)-I);
  1408. end;
  1409. If J<>Length(Result) then
  1410. SetLength(Result,J);
  1411. end;
  1412. Procedure TPackage.GetManifest(Manifest : TStrings);
  1413. Var
  1414. S : String;
  1415. Release,Minor,Major : Word;
  1416. i : Integer;
  1417. begin
  1418. With Manifest do
  1419. begin
  1420. Add(Format('<package name="%s">',[QuoteXml(Name)]));
  1421. SplitVersion(Version,Release,Minor,Major,S);
  1422. Add(Format('<version release="%d" major="%d" minor="%d" suffix="%s"/>',[Release,Minor,Major,QuoteXMl(S)]));
  1423. Add(Format('<filename>%s</filename>',[QuoteXml(FileName)]));
  1424. Add(Format('<author>%s</author>',[QuoteXml(Author)]));
  1425. if ExternalURL<>'' then
  1426. Add(Format('<externalurl>%s</externalurl>',[QuoteXml(ExternalURL)]));
  1427. Add(Format('<email>%s</email>',[QuoteXMl(Email)]));
  1428. S:=Description;
  1429. If (S<>'') then
  1430. Add(Format('<description>%s</description>',[QuoteXML(S)]));
  1431. if HasDependencies then
  1432. begin
  1433. If (Dependencies.Count>0) then
  1434. begin
  1435. Add('<dependencies>');
  1436. for I:=0 to Dependencies.Count-1 do
  1437. Add(Format('<dependency><package packagename="%s"/></dependency>',[QuoteXML(Dependencies[i])]));
  1438. Add('</dependencies>');
  1439. end;
  1440. end;
  1441. Add('</package>');
  1442. end;
  1443. end;
  1444. function TPackage.GetStrings(AIndex: integer): TStrings;
  1445. Function EnsureStrings(Var S : TStrings) : TStrings;
  1446. begin
  1447. If (S=Nil) then
  1448. S:=TStringList.Create;
  1449. Result:=S;
  1450. end;
  1451. begin
  1452. Result:=Nil;
  1453. Case AIndex Of
  1454. 0 : Result:=EnsureStrings(FUnitPath);
  1455. 1 : Result:=EnsureStrings(FObjectPath);
  1456. 2 : Result:=EnsureStrings(FIncludePath);
  1457. 3 : begin
  1458. Result:=EnsureStrings(FDependencies);
  1459. With TStringList(Result) do
  1460. if (Count=0) then
  1461. begin
  1462. Sorted:=True;
  1463. Duplicates:=dupError;
  1464. end;
  1465. end;
  1466. 4 : Result:=EnsureStrings(FInstallFiles);
  1467. 5 : Result:=EnsureStrings(FCleanFiles);
  1468. 6 : Result:=EnsureStrings(FArchiveFiles);
  1469. end;
  1470. end;
  1471. procedure TPackage.SetCommands(const AValue: TCommands);
  1472. begin
  1473. Commands.Assign(AValue);
  1474. end;
  1475. procedure TPackage.SetStrings(AIndex: integer; const AValue: TStrings);
  1476. begin
  1477. GetStrings(AIndex).Assign(AValue);
  1478. end;
  1479. constructor TPackage.Create(ACollection: TCollection);
  1480. Var
  1481. L : TStringList;
  1482. begin
  1483. inherited Create(ACollection);
  1484. FTargets:=TTargets.Create(TTarget);
  1485. FSources:=TSources.Create(TSource);
  1486. L:=TStringList.Create;
  1487. FDependencies:=L;
  1488. FInstallFiles:=TStringList.Create;
  1489. FCleanFiles:=TStringList.Create;
  1490. FArchiveFiles:=TStringList.Create;
  1491. end;
  1492. destructor TPackage.destroy;
  1493. begin
  1494. FreeAndNil(FDependencies);
  1495. FreeAndNil(FInstallFiles);
  1496. FreeAndNil(FCleanFiles);
  1497. FreeAndNil(FArchiveFiles);
  1498. FreeAndNil(FIncludePath);
  1499. FreeAndNil(FObjectPath);
  1500. FreeAndNil(FUnitPath);
  1501. FreeAndNil(FSources);
  1502. FreeAndNil(FTargets);
  1503. inherited destroy;
  1504. end;
  1505. function TPackage.AddTarget(AName: String): TTarget;
  1506. begin
  1507. Result:=Targets.Add as TTarget;
  1508. Result.Name:=AName;
  1509. end;
  1510. procedure TPackage.AddDependency(AName: String);
  1511. begin
  1512. If FDependencies.IndexOf(AName)=-1 then
  1513. FDependencies.Add(AName);
  1514. end;
  1515. procedure TPackage.AddInstallFile(AFileName: String);
  1516. begin
  1517. FInstallFiles.add(AFileName);
  1518. end;
  1519. procedure TPackage.GetCleanFiles(List: TStrings; Const APrefix : String; AOS : TOS);
  1520. Var
  1521. I : Integer;
  1522. begin
  1523. AddStrings(List,CleanFiles,APrefix);
  1524. For I:=0 to FTargets.Count-1 do
  1525. FTargets.TargetItems[I].GetCleanFiles(List,APrefix,AOS);
  1526. end;
  1527. procedure TPackage.GetSourceFiles(List: TStrings);
  1528. Var
  1529. I : Integer;
  1530. begin
  1531. // AddStrings(List,SourceFiles,APrefix);
  1532. For I:=0 to FSources.Count-1 do
  1533. FSources.SourceItems[I].GetSourceFiles(List);
  1534. end;
  1535. procedure TPackage.GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS);
  1536. Var
  1537. I : Integer;
  1538. T : TTarget;
  1539. begin
  1540. AddStrings(List,InstallFiles,APrefix);
  1541. For I:=0 to FTargets.Count-1 do
  1542. begin
  1543. T:=FTargets.TargetItems[I];
  1544. if (T.TargetType in Types) then
  1545. T.GetInstallFiles(List,APrefix,AOS);
  1546. end;
  1547. end;
  1548. procedure TPackage.GetArchiveFiles(List: TStrings;Const APrefix : String; AOS : TOS);
  1549. Var
  1550. I : Integer;
  1551. begin
  1552. If (OS=[]) or (AOS in OS) then
  1553. begin
  1554. AddStrings(List,ArchiveFiles,APrefix);
  1555. For I:=0 to FTargets.Count-1 do
  1556. FTargets.TargetItems[I].GetArchiveFiles(List,APrefix,AOS);
  1557. end;
  1558. end;
  1559. Function TPackage.GetDescription : string;
  1560. Var
  1561. FN : String;
  1562. L : TStringList;
  1563. begin
  1564. If (FDescription<>'') then
  1565. Result:=FDescription
  1566. else
  1567. If (FDescriptionFile<>'') then
  1568. begin
  1569. // Always relative to binary name.
  1570. FN:=ExtractFilePath(ParamStr(0));
  1571. FN:=FN+FDescriptionFile;
  1572. If FileExists(FN) then
  1573. begin
  1574. L:=TStringList.Create;
  1575. Try
  1576. L.LoadFromFile(FN);
  1577. Result:=L.Text;
  1578. Finally
  1579. L.Free;
  1580. end;
  1581. end;
  1582. end;
  1583. end;
  1584. Function TPackage.GetFileName : string;
  1585. begin
  1586. If (FFileName<>'') then
  1587. Result:=FFileName
  1588. else
  1589. Result:=Name+'-'+Version+'.zip';
  1590. end;
  1591. { TPackages }
  1592. function TPackages.GetPackage(AName : String): TPackage;
  1593. begin
  1594. Result:=TPackage(ItemByName(AName))
  1595. end;
  1596. function TPackages.GetPackageItem(AIndex : Integer): TPackage;
  1597. begin
  1598. Result:=TPackage(Items[AIndex]);
  1599. end;
  1600. procedure TPackages.SetPackageItem(AIndex : Integer; const AValue: TPackage);
  1601. begin
  1602. Items[AIndex]:=AValue;
  1603. end;
  1604. function TPackages.AddPackage(const AName: String): TPackage;
  1605. begin
  1606. Result:=Add as TPackage;
  1607. Result.Name:=AName;
  1608. end;
  1609. { TInstaller }
  1610. function TInstaller.GetStrings(AIndex : Integer): TStrings;
  1611. begin
  1612. CheckDefaultPackage;
  1613. Case AIndex of
  1614. 0: Result:=DefaultPackage.Dependencies;
  1615. 1: Result:=DefaultPackage.InstallFiles;
  1616. 2: Result:=DefaultPackage.CleanFiles;
  1617. 3: Result:=DefaultPackage.ArchiveFiles;
  1618. end;
  1619. end;
  1620. Function TInstaller.GetPackageString(Index : Integer) : String;
  1621. Var
  1622. P : TPackage;
  1623. begin
  1624. CheckDefaultPackage;
  1625. P:=DefaultPackage;
  1626. Case Index of
  1627. 0 : Result:=P.Author;
  1628. 1 : Result:=P.Directory;
  1629. 2 : Result:=P.License;
  1630. 3 : Result:=P.Options;
  1631. 4 : Result:=P.ExternalURL;
  1632. 5 : Result:=P.Email;
  1633. 6 : Result:=P.Description;
  1634. 7 : Result:=P.DescriptionFile;
  1635. 8 : Result:=P.Version;
  1636. 9 : Result:=P.FileName;
  1637. end;
  1638. end;
  1639. Procedure TInstaller.SetPackageString(Index : Integer; AValue : String);
  1640. Var
  1641. P : TPackage;
  1642. begin
  1643. CheckDefaultPackage;
  1644. P:=DefaultPackage;
  1645. Case Index of
  1646. 0 : P.Author:=AValue;
  1647. 1 : P.Directory:=AValue;
  1648. 2 : P.License:=AValue;
  1649. 3 : P.Options:=AValue;
  1650. 4 : P.ExternalURL:=AValue;
  1651. 5 : P.Email:=AValue;
  1652. 6 : P.Description:=AValue;
  1653. 7 : P.DescriptionFile:=AValue;
  1654. 8 : P.Version:=AValue;
  1655. 9 : P.FileName:=AValue;
  1656. end;
  1657. end;
  1658. function TInstaller.GetOSes: TOSes;
  1659. begin
  1660. CheckDefaultPackage;
  1661. Result:=DefaultPackage.OS;
  1662. end;
  1663. function TInstaller.GetTargets: TTargets;
  1664. begin
  1665. CheckDefaultPackage;
  1666. Result:=DefaultPackage.Targets;
  1667. end;
  1668. function TInstaller.GetSources: TSources;
  1669. begin
  1670. CheckDefaultPackage;
  1671. Result:=DefaultPackage.Sources;
  1672. end;
  1673. procedure TInstaller.SetDefaultPackage(const AValue: TPackage);
  1674. begin
  1675. if FDefaultPackage=AValue then exit;
  1676. FDefaultPackage:=AValue;
  1677. end;
  1678. procedure TInstaller.SetDefaults(const AValue: TDefaults);
  1679. begin
  1680. FDefaults.Assign(AValue);
  1681. end;
  1682. procedure TInstaller.SetStrings(AIndex : Integer; const AValue: TStrings);
  1683. Var
  1684. Res : TStrings;
  1685. begin
  1686. CheckDefaultPackage;
  1687. Case AIndex of
  1688. 0: Res:=DefaultPackage.Dependencies;
  1689. 1: Res:=DefaultPackage.InstallFiles;
  1690. 2: Res:=DefaultPackage.CleanFiles;
  1691. 3: Res:=DefaultPackage.ArchiveFiles;
  1692. end;
  1693. Res.Assign(Avalue);
  1694. end;
  1695. procedure TInstaller.SetOses(const AValue: TOSes);
  1696. begin
  1697. CheckDefaultPackage;
  1698. DefaultPackage.OS:=AValue;
  1699. end;
  1700. procedure TInstaller.Log(Level: TVerboseLevel; const Msg: String);
  1701. begin
  1702. If Level in FLogLevels then
  1703. Writeln(StdErr,Msg);
  1704. end;
  1705. procedure TInstaller.CreatePackages;
  1706. begin
  1707. FPAckages:=TPackages.Create(TPackage);
  1708. end;
  1709. procedure TInstaller.CreateBuildEngine;
  1710. begin
  1711. FBuildEngine:=TBuildEngine.Create(Self);
  1712. FBuildEngine.Defaults:=Defaults;
  1713. FBuildEngine.ListMode:=FListMode;
  1714. FBuildEngine.OnLog:[email protected];
  1715. end;
  1716. procedure TInstaller.CheckDefaultPackage;
  1717. begin
  1718. If (FDefaultPackage=Nil) then
  1719. Raise EInstallerError.Create(SErrNoPackage);
  1720. end;
  1721. procedure TInstaller.Error(Msg: String);
  1722. begin
  1723. Raise EInstallerError.Create(Msg);
  1724. end;
  1725. procedure TInstaller.Error(Fmt: String; Args: array of const);
  1726. begin
  1727. Raise EInstallerError.CreateFmt(Fmt,Args);
  1728. end;
  1729. Function TInstaller.StartPackage(const AName: String) : TPackage;
  1730. begin
  1731. FDefaultPackage:=FPackages.AddPackage(AName);
  1732. Result:=FDefaultPackage;
  1733. end;
  1734. procedure TInstaller.EndPackage;
  1735. begin
  1736. FDefaultPackage:=Nil;
  1737. end;
  1738. procedure TInstaller.AnalyzeOptions;
  1739. Function CheckOption(Index : Integer;Short,Long : String): Boolean;
  1740. var
  1741. O : String;
  1742. begin
  1743. O:=Paramstr(Index);
  1744. Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
  1745. end;
  1746. Function CheckCommand(Index : Integer;Short,Long : String): Boolean;
  1747. var
  1748. O : String;
  1749. begin
  1750. O:=Paramstr(Index);
  1751. Result:=(O='-'+short) or (O=long);
  1752. end;
  1753. Function OptionArg(Var Index : Integer) : String;
  1754. Var
  1755. P : Integer;
  1756. begin
  1757. if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then
  1758. begin
  1759. If Index<ParamCount then
  1760. begin
  1761. Inc(Index);
  1762. Result:=Paramstr(Index);
  1763. end
  1764. else
  1765. Error(SErrNeedArgument,[Index,ParamStr(Index)]);
  1766. end
  1767. else If length(ParamStr(Index))>2 then
  1768. begin
  1769. P:=Pos('=',Paramstr(Index));
  1770. If (P=0) then
  1771. Error(SErrNeedArgument,[Index,ParamStr(Index)])
  1772. else
  1773. begin
  1774. Result:=Paramstr(Index);
  1775. Delete(Result,1,P);
  1776. end;
  1777. end;
  1778. end;
  1779. Var
  1780. I : Integer;
  1781. Nodefaults : Boolean;
  1782. DefaultsFileName : string;
  1783. begin
  1784. I:=0;
  1785. NoDefaults:=False;
  1786. FListMode:=False;
  1787. While (I<ParamCount) do
  1788. begin
  1789. Inc(I);
  1790. if CheckCommand(I,'m','compile') then
  1791. FRunMode:=rmCompile
  1792. else if CheckCommand(I,'b','build') then
  1793. FRunMode:=rmBuild
  1794. else if CheckCommand(I,'i','install') then
  1795. FRunMode:=rmInstall
  1796. else if CheckCommand(I,'c','clean') then
  1797. FRunMode:=rmClean
  1798. else if CheckCommand(I,'a','archive') then
  1799. FRunMode:=rmarchive
  1800. else if CheckCommand(I,'M','manifest') then
  1801. FRunMode:=rmManifest
  1802. else if CheckCommand(I,'M','listsources') then
  1803. FRunMode:=rmListSources
  1804. else if CheckOption(I,'h','help') then
  1805. Usage('',[])
  1806. else if Checkoption(I,'C','CPU') then
  1807. Defaults.CPU:=StringToCPU(OptionArg(I))
  1808. else if Checkoption(I,'O','OS') then
  1809. Defaults.OS:=StringToOS(OptionArg(I))
  1810. else if Checkoption(I,'t','target') then
  1811. Defaults.Target:=OptionArg(I)
  1812. else if CheckOption(I,'l','list-commands') then
  1813. FListMode:=True
  1814. else if Checkoption(I,'P','prefix') then
  1815. Defaults.Prefix:=OptionArg(I)
  1816. else if Checkoption(I,'n','nodefaults') then
  1817. NoDefaults:=true
  1818. else if CheckOption(I,'B','baseinstalldir') then
  1819. Defaults.BaseInstallDir:=OptionArg(I)
  1820. else if CheckOption(I,'r','compiler') then
  1821. Defaults.Compiler:=OptionArg(I)
  1822. else if CheckOption(I,'f','config') then
  1823. DefaultsFileName:=OptionArg(I)
  1824. else if CheckOption(I,'v','verbose') then
  1825. begin
  1826. Try
  1827. FLogLevels:=TVerboseLevels(StringToSet(PtypeInfo(TypeInfo(TVerboseLevels)),OptionArg(I)));
  1828. except
  1829. FLogLevels:=AllMessages;
  1830. end;
  1831. end
  1832. else
  1833. begin
  1834. Usage(SErrInValidArgument,[I,ParamStr(I)]);
  1835. end;
  1836. end;
  1837. If Not NoDefaults then
  1838. Defaults.LocalInit(DefaultsFileName);
  1839. Defaults.CompilerDefaults;
  1840. {$ifdef debug}
  1841. FLogLevels:=AllMessages;
  1842. {$endif}
  1843. end;
  1844. procedure TInstaller.Usage(FMT: String; Args: array of const);
  1845. Procedure WriteCmd(LC : String; Msg : String);
  1846. begin
  1847. Writeln(stderr,Format(' %-12s %s',[LC,MSG]));
  1848. end;
  1849. Procedure WriteOption(C: Char; LC : String; Msg : String);
  1850. begin
  1851. Writeln(stderr,Format(' -%s --%-16s %s',[C,LC,MSG]));
  1852. end;
  1853. Procedure WriteArgOption(C: Char; LC : String; Msg : String);
  1854. begin
  1855. Writeln(stderr,Format(' -%s --%-20s %s',[C,LC+'='+SValue,MSG]));
  1856. end;
  1857. begin
  1858. If (FMT<>'') then
  1859. Writeln(stderr,Format(Fmt,Args));
  1860. Writeln(stderr,Format(SHelpUsage,[Paramstr(0)]));
  1861. Writeln(stderr,SHelpCommand);
  1862. WriteCmd('compile',SHelpCompile);
  1863. WriteCmd('build',SHelpBuild);
  1864. WriteCmd('install',SHelpInstall);
  1865. WriteCmd('clean',SHelpClean);
  1866. WriteCmd('archive',SHelpArchive);
  1867. WriteCmd('manifest',SHelpManifest);
  1868. Writeln(stderr,SHelpCmdOptions);
  1869. WriteOption('h','help',SHelpHelp);
  1870. WriteOption('l','list-commands',SHelpList);
  1871. WriteOption('n','nodefaults',SHelpNoDefaults);
  1872. WriteOption('v','verbose',SHelpVerbose);
  1873. WriteArgOption('C','CPU',SHelpCPU);
  1874. WriteArgOption('O','OS',SHelpOS);
  1875. WriteArgOption('t','target',SHelpTarget);
  1876. WriteArgOption('P','prefix',SHelpPrefix);
  1877. WriteArgOption('B','baseinstalldir',SHelpBaseInstalldir);
  1878. WriteArgOption('r','compiler',SHelpCompiler);
  1879. WriteArgOption('f','config',SHelpConfig);
  1880. Writeln(stderr,'');
  1881. If (FMT<>'') then
  1882. halt(1)
  1883. else
  1884. halt(0);
  1885. end;
  1886. procedure TInstaller.Compile(Force: Boolean);
  1887. begin
  1888. FBuildEngine.ForceCompile:=Force;
  1889. FBuildEngine.Compile(FPackages);
  1890. end;
  1891. procedure TInstaller.Clean;
  1892. begin
  1893. BuildEngine.Clean(FPackages);
  1894. end;
  1895. procedure TInstaller.Install;
  1896. begin
  1897. BuildEngine.Install(FPackages);
  1898. end;
  1899. procedure TInstaller.Archive;
  1900. begin
  1901. FBuildEngine.Archive(FPackages);
  1902. end;
  1903. procedure TInstaller.Manifest;
  1904. Var
  1905. L : TStrings;
  1906. begin
  1907. L:=TStringList.Create;
  1908. Try
  1909. Log(vlCommand,'Generating manifest.xml');
  1910. L.Add('<?xml version="1.0"?>');
  1911. BuildEngine.GetManifest(FPackages,L);
  1912. L.SaveToFile('manifest.xml');
  1913. Finally
  1914. L.Free;
  1915. end;
  1916. end;
  1917. procedure TInstaller.GetSourceFiles;
  1918. Var
  1919. L : TStrings;
  1920. begin
  1921. L:=TStringList.Create;
  1922. Try
  1923. Log(vlCommand,'Generating sources.xml');
  1924. L.Add('<?xml version="1.0"?>');
  1925. BuildEngine.GetSourceFiles(FPackages,L);
  1926. L.SaveToFile('sources.xml');
  1927. Finally
  1928. L.Free;
  1929. end;
  1930. end;
  1931. constructor TInstaller.Create(AOWner: TComponent);
  1932. begin
  1933. inherited Create(AOWner);
  1934. FDefaults:=TDefaults.Create;
  1935. AnalyzeOptions;
  1936. CreatePackages;
  1937. end;
  1938. destructor TInstaller.destroy;
  1939. begin
  1940. FreeAndNil(FDefaults);
  1941. inherited destroy;
  1942. end;
  1943. procedure TInstaller.CheckPackages;
  1944. begin
  1945. If (FPackages.Count=0) then
  1946. Error(SErrNoPackagesDefined);
  1947. // Check for other obvious errors ?
  1948. end;
  1949. Function TInstaller.Run : Boolean;
  1950. begin
  1951. Result:=True;
  1952. try
  1953. CheckPackages;
  1954. CreateBuildEngine;
  1955. Case RunMode of
  1956. rmCompile : Compile(False);
  1957. rmBuild : Compile(True);
  1958. rmInstall : Install;
  1959. rmArchive : Archive;
  1960. rmClean : Clean;
  1961. rmManifest : Manifest;
  1962. rmListSources : GetSourceFiles;
  1963. end;
  1964. except
  1965. On E : Exception do
  1966. begin
  1967. Writeln(StdErr,SErrInstaller);
  1968. Writeln(StdErr,E.Message);
  1969. Result:=False;
  1970. end;
  1971. end;
  1972. end;
  1973. function TInstaller.AddTarget(AName: String): TTarget;
  1974. begin
  1975. CheckDefaultPackage;
  1976. Result:=DefaultPackage.AddTarget(AName);
  1977. end;
  1978. procedure TInstaller.AddDependency(AName: String);
  1979. begin
  1980. CheckDefaultPackage;
  1981. DefaultPackage.AddDependency(AName);
  1982. end;
  1983. { TBuildEngine }
  1984. procedure TBuildEngine.SetDefaults(const AValue: TDefaults);
  1985. begin
  1986. FDefaults.Assign(AValue);
  1987. end;
  1988. procedure TBuildEngine.SetTargetDir(const AValue: String);
  1989. begin
  1990. if FTargetDir=AValue then exit;
  1991. FTargetDir:=AValue;
  1992. end;
  1993. procedure TBuildEngine.Error(Msg: String);
  1994. begin
  1995. Raise EInstallerError.Create(Msg);
  1996. end;
  1997. procedure TBuildEngine.Error(Fmt: String; Args: array of const);
  1998. begin
  1999. Raise EInstallerError.CreateFmt(Fmt,Args);
  2000. end;
  2001. constructor TBuildEngine.Create(AOwner: TComponent);
  2002. begin
  2003. inherited Create(AOwner);
  2004. FDefaults:=TDefaults.Create;
  2005. // Maybe this should be the current directory ?
  2006. // Or have it as a command-line option.
  2007. // Would allow to put all 'installers' in one dir and call them
  2008. // With --start-dir=/path/to/sources.
  2009. FStartDir:=includeTrailingPathDelimiter(GetCurrentDir);
  2010. end;
  2011. procedure TBuildEngine.ExecuteCommand(Cmd: String; Args : String; IgnoreError : Boolean = False);
  2012. Var
  2013. E : Integer;
  2014. begin
  2015. Log(vlCommand,SLogExecutingCommand,[Cmd,Args]);
  2016. // We should check cmd for spaces, and move all after first space to args.
  2017. E:=ExecuteProcess(cmd,args);
  2018. If (E<>0) and (not IgnoreError) then
  2019. Error(SErrExternalCommandFailed,[Cmd,E]);
  2020. end;
  2021. procedure TBuildEngine.SysCopyFile(Const Src,Dest : String);
  2022. Var
  2023. D,S : String;
  2024. Fin,FOut : TFileStream;
  2025. Count : Int64;
  2026. A : Integer;
  2027. begin
  2028. Log(vlCommand,SLogCopyingFile,[Src,Dest]);
  2029. FIn:=TFileStream.Create(Src,fmopenRead);
  2030. Try
  2031. D:=IncludeTrailingPathDelimiter(Dest);
  2032. If DirectoryExists(D) then
  2033. S:=D+ExtractFileName(Src)
  2034. else
  2035. S:=Dest;
  2036. FOut:=TFileStream.Create(S,fmCreate);
  2037. Try
  2038. Count:=Fout.CopyFrom(FIn,0);
  2039. If (Count<>Fin.Size) then
  2040. Error(SErrCopyingFile,[Src,S]);
  2041. Finally
  2042. FreeAndNil(Fout);
  2043. end;
  2044. A:=FileGetDate(FIn.Handle);
  2045. If (A=-1) then
  2046. log(vlWarning,SWarnFailedToGetTime,[Src])
  2047. else
  2048. if FileSetDate(S,A)<>0 then
  2049. Log(vlWarning,SWarnFailedToSetTime,[S]);
  2050. finally
  2051. FreeAndNil(Fin);
  2052. end;
  2053. end;
  2054. procedure TBuildEngine.SysMoveFile(Const Src,Dest : String);
  2055. Var
  2056. S : String;
  2057. begin
  2058. If DirectoryExists(IncludeTrailingPathDelimiter(Dest)) then
  2059. S:=IncludeTrailingPathDelimiter(Dest)+ExtractFileName(Src)
  2060. else
  2061. S:=Dest;
  2062. If Not RenameFile(Src,S) then
  2063. begin
  2064. Try
  2065. SysCopyFile(Src,S);
  2066. SysDeleteFile(Src);
  2067. Except
  2068. On E : Exception Do
  2069. Error(SErrMovingFile,[Src,S]);
  2070. end;
  2071. end;
  2072. end;
  2073. procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
  2074. begin
  2075. if not FileExists(AFileName) then
  2076. Log(vlWarning,SWarnFileDoesNotExist,[AFileName])
  2077. else If Not DeleteFile(AFileName) then
  2078. Error(SErrDeletingFile,[AFileName]);
  2079. end;
  2080. procedure TBuildEngine.SysArchiveFiles(List: TStrings;Const AFileName: String);
  2081. begin
  2082. If Not (Assigned(OnArchivefiles) or Assigned(ArchiveFilesProc)) then
  2083. Raise EInstallerError.Create(SErrNoArchiveSupport);
  2084. If Assigned(ArchiveFilesProc) then
  2085. ArchiveFilesProc(AFileName,List)
  2086. else
  2087. OnArchiveFiles(AFileName,List);
  2088. end;
  2089. procedure TBuildEngine.Log(Level: TVerboseLevel; const Msg: String);
  2090. begin
  2091. If Assigned(FOnLog) then
  2092. FOnLog(Level,Msg);
  2093. end;
  2094. procedure TBuildEngine.Log(Level: TVerboseLevel; const Fmt: String;
  2095. Args: array of const);
  2096. begin
  2097. Log(Level,Format(Fmt,Args));
  2098. end;
  2099. procedure TBuildEngine.EnterDir(ADir: String);
  2100. Var
  2101. D : String;
  2102. begin
  2103. D:=FStartDir;
  2104. D:=D+ADir;
  2105. Log(vlInfo,SLogEnterDir,[D]);
  2106. If Not SetCurrentDir(D) then
  2107. Error(SErrChangeDirFailed,[D]);
  2108. end;
  2109. procedure TBuildEngine.CmdCopyFiles(List: TStrings; Const DestDir: String);
  2110. Var
  2111. Args : String;
  2112. I : Integer;
  2113. begin
  2114. CmdCreateDir(DestDir);
  2115. If (Defaults.Copy<>'') then
  2116. begin
  2117. Args:=FileListToString(List,'');
  2118. Args:=Args+' '+DestDir;
  2119. ExecuteCommand(Defaults.Copy,Args);
  2120. end
  2121. else
  2122. For I:=0 to List.Count-1 do
  2123. SysCopyFile(List[i],DestDir);
  2124. end;
  2125. procedure TBuildEngine.CmdCreateDir(DestDir: String);
  2126. begin
  2127. If (Defaults.MkDir<>'') then
  2128. ExecuteCommand(Defaults.MkDir,DestDir)
  2129. else
  2130. If not ForceDirectories(DestDir) then
  2131. Error(SErrCreatingDirectory,[DestDir]);
  2132. end;
  2133. procedure TBuildEngine.CmdMoveFiles(List: TStrings; Const DestDir: String);
  2134. Var
  2135. Args : String;
  2136. I : Integer;
  2137. begin
  2138. CmdCreateDir(DestDir);
  2139. If (Defaults.Move<>'') then
  2140. begin
  2141. Args:=FileListToString(List,'');
  2142. Args:=Args+' '+DestDir;
  2143. ExecuteCommand(Defaults.Move,Args);
  2144. end
  2145. else
  2146. For I:=0 to List.Count-1 do
  2147. SysMoveFile(List[i],DestDir);
  2148. end;
  2149. procedure TBuildEngine.CmdDeleteFiles(List: TStrings);
  2150. Var
  2151. Args : String;
  2152. I : Integer;
  2153. begin
  2154. If (Defaults.Remove<>'') then
  2155. begin
  2156. Args:=FileListToString(List,'');
  2157. ExecuteCommand(Defaults.Remove,Args);
  2158. end
  2159. else
  2160. For I:=0 to List.Count-1 do
  2161. SysDeleteFile(List[i]);
  2162. end;
  2163. procedure TBuildEngine.CmdArchiveFiles(List: TStrings; Const ArchiveFile: String);
  2164. Var
  2165. S,C,O : String;
  2166. begin
  2167. If (Defaults.Archive='') then
  2168. SysArchiveFiles(List,ArchiveFile)
  2169. else
  2170. begin
  2171. S:=FileListToString(List,'');
  2172. SplitCommand(Defaults.Archive,C,O);
  2173. If (O='') then
  2174. O:=ArchiveFile+' '+S
  2175. else
  2176. O:=Substitute(O,['ARCHIVE',ArchiveFile,'FILESORDIRS']);
  2177. ExecuteCommand(C,O);
  2178. end;
  2179. end;
  2180. Function TBuildEngine.FileNewer(Src,Dest : String) : Boolean;
  2181. Var
  2182. DS,DD : Longint;
  2183. D1,D2 : TDateTime;
  2184. begin
  2185. DS:=FileAge(Src);
  2186. DD:=FileAge(Dest);
  2187. D1:=FileDateToDateTime(DS);
  2188. D2:=FileDateToDateTime(DD);
  2189. Log(vlDebug,SLogCompilingFileTimes,[Src,DateTimeToStr(D1),Dest,DateTimeToStr(D2)]);
  2190. Result:=D1>=D2;
  2191. If Result then
  2192. Log(vlCompare,SLogSourceNewerDest,[Src,DateTimeToStr(D1),Dest,DateTimeToStr(D2)]);
  2193. end;
  2194. procedure TBuildEngine.ExecuteCommands(Commands: TCommands; At: TCommandAt);
  2195. Var
  2196. C : TCommand;
  2197. I : Integer;
  2198. Cmd,O : String;
  2199. E : Boolean;
  2200. begin
  2201. For I:=0 to Commands.Count-1 do
  2202. begin
  2203. C:=Commands.CommandItems[i];
  2204. if (C.At=At) then
  2205. begin
  2206. E:=True;
  2207. If (C.SourceFile<>'') and (C.DestFile<>'') then
  2208. E:=FileNewer(C.SourceFile,IncludeTrailingPathDelimiter(Dictionary.GetValue('OUTPUTDIR'))+C.DestFile);
  2209. If E then
  2210. begin
  2211. If Assigned(C.BeforeCommand) then
  2212. C.BeforeCommand(C);
  2213. O:=Substitute(C.Options,['SOURCE',C.SourceFile,'DEST',C.DestFile]);
  2214. Cmd:=C.Command;
  2215. If (ExtractFilePath(Cmd)='') then
  2216. Cmd:=FileSearch(Cmd,GetEnvironmentvariable('PATH'));
  2217. ExecuteCommand(Cmd,O,C.IgnoreResult);
  2218. If Assigned(C.AfterCommand) then
  2219. C.AfterCommand(C);
  2220. end;
  2221. end;
  2222. end;
  2223. end;
  2224. // Relative to startdir.
  2225. Function TBuildEngine.GetTargetDir(APackage : TPackage; ATarget : TTarget; AbsolutePath : Boolean = False) : String;
  2226. begin
  2227. If AbsolutePath then
  2228. Result:=IncludeTrailingPathDelimiter(FStartDir)
  2229. else
  2230. Result:='';
  2231. If (APackage.Directory<>'') then
  2232. Result:=Result+IncludeTrailingPathDelimiter(APackage.Directory);
  2233. If (ATarget.Directory<>'') then
  2234. Result:=IncludeTrailingPathDelimiter(Result+ATarget.Directory);
  2235. end;
  2236. Function TBuildEngine.TargetOK(Target : TTarget) : Boolean;
  2237. begin
  2238. Result:=(Target.TargetType in [ttUnit,ttProgram])
  2239. and
  2240. ((Target.CPU=[]) or (Defaults.CPU in Target.CPU))
  2241. and
  2242. ((Target.OS=[]) or (Defaults.OS in Target.OS));
  2243. If not Result then
  2244. begin
  2245. log(vldebug,'Target is not a unit or program');
  2246. If Not ((Target.CPU=[]) or (Defaults.CPU in Target.CPU)) then
  2247. Log(vldebug,'Target has wrong CPU: '+CPUsToString(Target.CPU));
  2248. if not ((Target.OS=[]) or (Defaults.OS in Target.OS)) then
  2249. Log(vldebug,'Target has wrong OS: '+OSesToString(Target.OS));
  2250. end;
  2251. end;
  2252. Function TBuildEngine.NeedsCompile(Target: TTarget): Boolean;
  2253. Var
  2254. I : Integer;
  2255. T : TTarget;
  2256. OD,SD,SFN,OFN : String;
  2257. begin
  2258. Result:=False;
  2259. OD:=FCurrentOutputDir;
  2260. If (OD<>'') then
  2261. OD:=IncludeTrailingPathDelimiter(OD);
  2262. OFN:=OD+Target.GetOutPutFileName(Defaults.OS);
  2263. SD:=Target.Directory;
  2264. If (SD<>'') then
  2265. SD:=IncludeTrailingPathDelimiter(SD);
  2266. Result:=Not FileExists(OFN);
  2267. // Check dependencies
  2268. If not Result then
  2269. If Target.HasDependencies then
  2270. begin
  2271. ResolveDependencies(Target.Dependencies,Target.Collection as TTargets);
  2272. I:=0;
  2273. While (Not Result) and (I<Target.Dependencies.Count) do
  2274. begin
  2275. T:=TTarget(Target.Dependencies.Objects[i]);
  2276. If (T<>Nil) then
  2277. Result:=NeedsCompile(T)
  2278. else // if it is a filename, check dates.
  2279. if FileExists(Target.Dependencies[i]) then
  2280. Result:=FileNewer(Target.Dependencies[i],OFN)
  2281. else if FileExists(SD+Target.Dependencies[i]) then
  2282. Result:=FileNewer(SD+Target.Dependencies[i],OFN);
  2283. Inc(I)
  2284. end;
  2285. end;
  2286. If not Result then
  2287. begin
  2288. SFN:=SD+Target.SourceFileName;
  2289. If (ExtractFileExt(SFN)='') then
  2290. if FileExists(SFN+'.pp') then
  2291. SFN:=SFN+'.pp'
  2292. else
  2293. SFN:=SFN+'.pas';
  2294. // Writeln('Checking : ',OFN,' against ',SFN);
  2295. Result:=FileNewer(SFN,OFN);
  2296. // here we should check file timestamps.
  2297. end;
  2298. end;
  2299. Function TBuildEngine.GetCompilerCommand(APackage : TPackage; Target : TTarget) : String;
  2300. Var
  2301. PD,TD,OD,RD : String;
  2302. begin
  2303. PD:=IncludeTrailingPathDelimiter(GetPackageDir(APackage,True));
  2304. OD:=IncludeTrailingPathDelimiter(GetOutputDir(APackage,True));
  2305. RD:=ExtractRelativePath(PD,OD);
  2306. If Target.TargetType in ProgramTargets then
  2307. Result:='-FE.' // Make this relative to target directory.
  2308. else
  2309. Result:='-FU'+RD;
  2310. If Target.Mode<>cmFPC then
  2311. Result:=Result+' -M'+ModeToString(Target.Mode)
  2312. else If Defaults.Mode<>cmFPC then
  2313. Result:=Result+' -M'+ModeToString(Defaults.Mode);
  2314. If (Defaults.Options<>'') then
  2315. Result:=Result+' '+Defaults.Options;
  2316. If (APackage.Options<>'') then
  2317. Result:=Result+' '+APackage.Options;
  2318. If APackage.HasUnitPath then
  2319. AddStrings(Result,APackage.UnitPath,'-Fu');
  2320. If APackage.HasIncludePath then
  2321. AddStrings(Result,APackage.IncludePath,'-Fi');
  2322. If APackage.HasObjectPath then
  2323. AddStrings(Result,APackage.ObjectPath,'-Fo');
  2324. If Target.HasUnitPath then
  2325. AddStrings(Result,Target.UnitPath,'-Fu');
  2326. If Target.HasIncludePath then
  2327. AddStrings(Result,Target.IncludePath,'-Fi');
  2328. If Target.HasObjectPath then
  2329. AddStrings(Result,Target.ObjectPath,'-Fo');
  2330. If (Target.Options<>'') then
  2331. Result:=Result+' '+Target.Options;
  2332. TD:=Target.Directory;
  2333. if (TD<>'') then
  2334. TD:=IncludeTrailingPathDelimiter(TD);
  2335. Result:=Result+' '+TD+Target.SourceFileName;
  2336. end;
  2337. Function TBuildEngine.GetCompiler : String;
  2338. Var
  2339. S : String;
  2340. begin
  2341. // Cache in FCompiler for speed.
  2342. If (FCompiler='') then
  2343. begin
  2344. FCompiler:=Defaults.Compiler;
  2345. If (ExtractFilePath(FCompiler)='') then
  2346. begin
  2347. S:=FileSearch(FCompiler,GetEnvironmentVariable('PATH'));
  2348. If (S<>'') then
  2349. FCompiler:=S;
  2350. end;
  2351. end;
  2352. Result:=FCompiler;
  2353. end;
  2354. procedure TBuildEngine.Compile(Target: TTarget);
  2355. Var
  2356. S : String;
  2357. begin
  2358. if Target.State in [tsNeutral,tsCompiling] then
  2359. begin
  2360. Log(vlInfo,SLogCompilingTarget,[Target.Name]);
  2361. If Target.HasCommands then
  2362. ExecuteCommands(Target.Commands,caBeforeCompile);
  2363. If Assigned(Target.BeforeCompile) then
  2364. Target.BeforeCompile(Target);
  2365. S:=GetCompilerCommand(FCurrentPackage,Target);
  2366. ExecuteCommand(GetCompiler,S);
  2367. Target.FTargetState:=tsCompiled;
  2368. If Assigned(Target.AfterCompile) then
  2369. Target.AfterCompile(Target);
  2370. If Target.HasCommands then
  2371. ExecuteCommands(Target.Commands,caAfterCompile);
  2372. end
  2373. else if Target.State<>tsCompiled then
  2374. Log(vlWarning,'Attempting to compile non-neutral target: '+Target.Name);
  2375. end;
  2376. procedure TBuildEngine.FixDependencies(Target: TTarget);
  2377. Var
  2378. I : Integer;
  2379. T : TTarget;
  2380. begin
  2381. Log(vlDebug,'Checking dependencies for target: '+Target.Name);
  2382. ResolveDependencies(Target.Dependencies,Target.Collection as TTargets);
  2383. If Target.HasDependencies then
  2384. For I:=0 to Target.Dependencies.Count-1 do
  2385. begin
  2386. T:=TTarget(Target.Dependencies.Objects[i]);
  2387. If Assigned(T) then
  2388. begin
  2389. If (T.State=tsCompiling) then
  2390. Log(vlWarning,SWarnCircularDependency,[Target.Name,T.Name])
  2391. else
  2392. Compile(T)
  2393. end
  2394. else if Not FileExists(Target.Dependencies[i]) then
  2395. Error(SErrDepUnknownTarget,[Target.Name,Target.Dependencies[i]]);
  2396. end;
  2397. end;
  2398. function TBuildEngine.GetPackageDir(APackage: TPackage; AbsolutePath: Boolean
  2399. ): String;
  2400. begin
  2401. If AbsolutePath then
  2402. Result:= IncludeTrailingPathDelimiter(FStartDir)
  2403. else
  2404. Result:='';
  2405. Result:=Result+APackage.Directory;
  2406. If (Result<>'') then
  2407. Result:= ExcludeTrailingPathDelimiter(Result)
  2408. end;
  2409. Function TBuildEngine.GetOutputDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  2410. begin
  2411. If (TargetDir<>'') then
  2412. Result:=TargetDir
  2413. else
  2414. begin
  2415. If AbsolutePath then
  2416. Result:=IncludeTrailingPathDelimiter(FStartDir)
  2417. else
  2418. Result:='';
  2419. If (APackage.Directory<>'') then
  2420. Result:=IncludeTrailingPathDelimiter(Result+APackage.Directory);
  2421. Result:=Result+'units'+PathDelim+Defaults.Target;
  2422. end;
  2423. end;
  2424. procedure TBuildEngine.CreateOutputDir(APackage: TPackage);
  2425. Var
  2426. D : String;
  2427. begin
  2428. D:=GetOutputDir(APackage,True);
  2429. If DirectoryExists(D) then
  2430. Log(vlInfo,SLogOutputDirExists,[D])
  2431. else
  2432. begin
  2433. Log(vlInfo,SLogCreatingOutputDir,[D]);
  2434. CmdCreateDir(D);
  2435. end;
  2436. end;
  2437. Function TBuildEngine.PackageOK(APackage : TPackage) : Boolean;
  2438. begin
  2439. Result:=((APackage.CPU=[]) or (Defaults.CPU in APackage.CPU))
  2440. and
  2441. ((APAckage.OS=[]) or (Defaults.OS in APackage.OS));
  2442. end;
  2443. procedure TBuildEngine.DoBeforeCompile(APackage: TPackage);
  2444. begin
  2445. If APackage.HasCommands then
  2446. ExecuteCommands(APackage.Commands,caBeforeCompile);
  2447. If Assigned(APackage.BeforeCompile) then
  2448. APackage.BeforeCompile(APackage);
  2449. end;
  2450. procedure TBuildEngine.DoAfterCompile(APackage: TPackage);
  2451. begin
  2452. If Assigned(APackage.AfterCompile) then
  2453. APackage.AfterCompile(APackage);
  2454. If APackage.HasCommands then
  2455. ExecuteCommands(APackage.Commands,caAfterCompile);
  2456. end;
  2457. procedure TBuildEngine.Compile(APackage: TPackage);
  2458. Var
  2459. T : TTarget;
  2460. I : Integer;
  2461. begin
  2462. Log(vlInfo,SLogCompilingPackage,[APackage.Name]);
  2463. FCurrentPackage:=APackage;
  2464. FCurrentOutputDir:=GetOutputDir(APackage,True);
  2465. Try
  2466. If (APackage.Directory<>'') then
  2467. EnterDir(APackage.Directory);
  2468. CreateOutputDir(APackage);
  2469. Dictionary.AddVariable('OUTPUTDIR',FCurrentOutputDir);
  2470. DoBeforeCompile(APackage);
  2471. Try
  2472. For I:=0 to APackage.Targets.Count-1 do
  2473. begin
  2474. T:=APackage.Targets.TargetItems[i];
  2475. Log(vlDebug,'Considering target: '+T.Name);
  2476. If TargetOK(T) then
  2477. If (T.State=tsNeutral) then
  2478. begin
  2479. If (FForceCompile or NeedsCompile(T)) then
  2480. begin
  2481. T.FTargetState:=tsCompiling;
  2482. FixDependencies(T);
  2483. Compile(T);
  2484. end;
  2485. T.FTargetState:=tsCompiled;
  2486. end;
  2487. end;
  2488. DoAfterCompile(APackage);
  2489. Finally
  2490. If (APackage.Directory<>'') then
  2491. EnterDir('');
  2492. end;
  2493. Finally
  2494. FCurrentPackage:=Nil;
  2495. FCurrentOutputDir:='';
  2496. end;
  2497. end;
  2498. procedure TBuildEngine.CheckExternalPackage(Const APackageName : String);
  2499. begin
  2500. // A check needs to be implemented here.
  2501. Log(vldebug,'Unresolved external dependency : %s',[APackageName]);
  2502. end;
  2503. procedure TBuildEngine.FixDependencies(APackage: TPackage);
  2504. Var
  2505. I : Integer;
  2506. P : TPackage;
  2507. begin
  2508. if APackage.HasDependencies then
  2509. For I:=0 to APAckage.Dependencies.Count-1 do
  2510. begin
  2511. P:=TPackage(Apackage.Dependencies.Objects[i]);
  2512. If Assigned(P) then
  2513. Compile(P) // If it already was compiled, then State<>tsNeutral, and it won't be compiled again.
  2514. else
  2515. CheckExternalPackage(Apackage.Dependencies[i]);
  2516. end;
  2517. end;
  2518. Procedure TBuildEngine.InstallPackageFiles(APAckage : TPackage; tt : TTargetType; Const Src,Dest : String);
  2519. Var
  2520. List : TStringList;
  2521. begin
  2522. List:=TStringList.Create;
  2523. Try
  2524. APackage.GetInstallFiles(List,[tt],Src,Defaults.OS);
  2525. if (List.Count>0) then
  2526. CmdCopyFiles(List,Dest);
  2527. Finally
  2528. List.Free;
  2529. end;
  2530. end;
  2531. procedure TBuildEngine.DoBeforeInstall(APackage: TPackage);
  2532. begin
  2533. If APackage.HasCommands then
  2534. ExecuteCommands(APackage.Commands,caBeforeInstall);
  2535. If Assigned(APackage.BeforeInstall) then
  2536. APackage.BeforeInstall(APackage);
  2537. end;
  2538. procedure TBuildEngine.DoAfterInstall(APackage: TPackage);
  2539. begin
  2540. If Assigned(APackage.AfterInstall) then
  2541. APackage.AfterInstall(APackage);
  2542. If APackage.HasCommands then
  2543. ExecuteCommands(APackage.Commands,caAfterInstall);
  2544. end;
  2545. procedure TBuildEngine.Install(APackage: TPackage);
  2546. Var
  2547. PD,D,O : String;
  2548. begin
  2549. If (Apackage.State<>tsCompiled) then
  2550. Compile(APackage);
  2551. Log(vlInfo,SLogInstallingPackage,[APackage.Name]);
  2552. DoBeforeInstall(APackage);
  2553. O:=IncludeTrailingPathDelimiter(GetOutputDir(APAckage));
  2554. PD:=IncludeTrailingPathDelimiter(GetPackageDir(APackage));
  2555. // units
  2556. D:=IncludeTrailingPathDelimiter(Defaults.UnitInstallDir)+APackage.Name;
  2557. InstallPackageFiles(APAckage,ttUnit,O,D);
  2558. // Programs
  2559. D:=IncludeTrailingPathDelimiter(Defaults.BinInstallDir);
  2560. InstallPackageFiles(APAckage,ttProgram,PD,D);
  2561. // Done.
  2562. APackage.FTargetState:=tsInstalled;
  2563. DoAfterInstall(APackage);
  2564. end;
  2565. procedure TBuildEngine.DoBeforeArchive(APackage: TPackage);
  2566. begin
  2567. If APackage.HasCommands then
  2568. ExecuteCommands(APackage.Commands,caBeforeArchive);
  2569. If Assigned(APackage.BeforeArchive) then
  2570. APackage.BeforeArchive(APackage);
  2571. end;
  2572. procedure TBuildEngine.DoAfterArchive(APackage: TPackage);
  2573. begin
  2574. If Assigned(APackage.AfterArchive) then
  2575. APackage.AfterArchive(APackage);
  2576. If APackage.HasCommands then
  2577. ExecuteCommands(APackage.Commands,caAfterArchive);
  2578. end;
  2579. procedure TBuildEngine.Archive(APackage: TPackage);
  2580. Var
  2581. L : TStrings;
  2582. A : String;
  2583. begin
  2584. Log(vlInfo,SLogArchivingPackage,[APackage.Name]);
  2585. DoBeforeArchive(Apackage);
  2586. L:=TStringList.Create;
  2587. Try
  2588. APackage.GetInstallFiles(L,[ttUnit],TargetDir,Defaults.OS);
  2589. A:=APackage.Name+ZipExt;
  2590. CmdArchiveFiles(L,A);
  2591. Finally
  2592. L.Free;
  2593. end;
  2594. Writeln('Archiving : ',APackage.Name);
  2595. DoAfterArchive(Apackage);
  2596. end;
  2597. procedure TBuildEngine.DoBeforeClean(APackage: TPackage);
  2598. begin
  2599. If APackage.HasCommands then
  2600. ExecuteCommands(APackage.Commands,caBeforeClean);
  2601. If Assigned(APackage.BeforeClean) then
  2602. APackage.BeforeClean(APackage);
  2603. end;
  2604. procedure TBuildEngine.DoAfterClean(APackage: TPackage);
  2605. begin
  2606. If Assigned(APackage.AfterClean) then
  2607. APackage.AfterClean(APackage);
  2608. If APackage.HasCommands then
  2609. ExecuteCommands(APackage.Commands,caAfterClean);
  2610. end;
  2611. procedure TBuildEngine.Clean(APackage: TPackage);
  2612. Var
  2613. O : String;
  2614. List : TStringList;
  2615. begin
  2616. Log(vlInfo,SLogCleaningPackage,[APackage.Name]);
  2617. DoBeforeClean(Apackage);
  2618. O:=IncludeTrailingPathDelimiter(GetOutputDir(APAckage));
  2619. List:=TStringList.Create;
  2620. try
  2621. APackage.GetCleanFiles(List,O,Defaults.OS);
  2622. if (List.Count>0) then
  2623. CmdDeleteFiles(List);
  2624. Finally
  2625. List.Free;
  2626. end;
  2627. DoAfterClean(Apackage);
  2628. end;
  2629. function TBuildEngine.NeedsCompile(APackage: TPackage): Boolean;
  2630. Var
  2631. I : Integer;
  2632. P : TPackage;
  2633. begin
  2634. ResolveDependencies(APackage.Dependencies,(APackage.Collection as TPackages));
  2635. Result:=False;
  2636. I:=0;
  2637. While (Not Result) and (I<APAckage.Dependencies.Count) do
  2638. begin
  2639. P:=TPackage(APAckage.Dependencies.Objects[i]);
  2640. // I'm not sure whether the target dir is OK here ??
  2641. Result:=Assigned(P) and NeedsCompile(P);
  2642. Inc(I);
  2643. end;
  2644. If Not Result then
  2645. begin
  2646. I:=0;
  2647. While (Not Result) and (I<APackage.Targets.Count) do
  2648. begin
  2649. Result:=NeedsCompile(APackage.Targets.TargetItems[i]);
  2650. Inc(I);
  2651. end;
  2652. end;
  2653. end;
  2654. Procedure TBuildEngine.GetSourceFiles(APackage : TPackage; List : TStrings);
  2655. var
  2656. L : TStrings;
  2657. i : integer;
  2658. begin
  2659. try
  2660. L:=TStringList.Create;
  2661. APackage.GetSourceFiles(L);
  2662. List.Add(Format('<sources packagename=%s>',[APackage.Name]));
  2663. for i:=0 to L.Count-1 do
  2664. List.Add(Format('<source>%s</source>',[L[i]]));
  2665. List.Add('</sources>');
  2666. finally
  2667. L.Free;
  2668. end;
  2669. end;
  2670. Procedure TBuildEngine.GetManifest(APackage : TPackage; Manifest : TStrings);
  2671. begin
  2672. APackage.GetManifest(Manifest);
  2673. end;
  2674. procedure TBuildEngine.Compile(Packages: TPackages);
  2675. Var
  2676. I : Integer;
  2677. P : TPackage;
  2678. begin
  2679. If Assigned(BeforeCompile) then
  2680. BeforeCompile(Self);
  2681. For I:=0 to Packages.Count-1 do
  2682. begin
  2683. P:=Packages.PackageItems[i];
  2684. If PackageOK(P) then
  2685. If (P.State=tsNeutral) then
  2686. begin
  2687. If (FForceCompile or NeedsCompile(P)) then
  2688. begin
  2689. P.FTargetState:=tsCompiling;
  2690. FixDependencies(P);
  2691. Compile(P);
  2692. end;
  2693. P.FTargetState:=tsCompiled;
  2694. end;
  2695. end;
  2696. If Assigned(AfterCompile) then
  2697. AfterCompile(Self);
  2698. end;
  2699. procedure TBuildEngine.Install(Packages: TPackages);
  2700. Var
  2701. I : Integer;
  2702. P : TPackage;
  2703. begin
  2704. If Assigned(BeforeInstall) then
  2705. BeforeInstall(Self);
  2706. For I:=0 to Packages.Count-1 do
  2707. begin
  2708. P:=Packages.PackageItems[i];
  2709. If PackageOK(P) then
  2710. Install(P);
  2711. end;
  2712. If Assigned(AfterInstall) then
  2713. AfterInstall(Self);
  2714. end;
  2715. procedure TBuildEngine.Archive(Packages: TPackages);
  2716. Var
  2717. I : Integer;
  2718. P : TPackage;
  2719. begin
  2720. If Assigned(BeforeArchive) then
  2721. BeforeArchive(Self);
  2722. Log(vlDebug,'Build engine archiving.');
  2723. For I:=0 to Packages.Count-1 do
  2724. begin
  2725. P:=Packages.PackageItems[i];
  2726. If PackageOK(P) then
  2727. Archive(P);
  2728. end;
  2729. If Assigned(AfterArchive) then
  2730. AfterArchive(Self);
  2731. end;
  2732. procedure TBuildEngine.Clean(Packages: TPackages);
  2733. Var
  2734. I : Integer;
  2735. P : TPackage;
  2736. begin
  2737. If Assigned(BeforeClean) then
  2738. BeforeClean(Self);
  2739. Log(vldebug,'Build engine cleaning.');
  2740. For I:=0 to Packages.Count-1 do
  2741. begin
  2742. P:=Packages.PackageItems[i];
  2743. If PackageOK(P) then
  2744. Clean(P);
  2745. end;
  2746. If Assigned(AfterClean) then
  2747. AfterClean(Self);
  2748. end;
  2749. Procedure TBuildEngine.GetManifest(Packages : TPackages; Manifest : TStrings);
  2750. Var
  2751. I : Integer;
  2752. begin
  2753. If Assigned(BeforeManifest) then
  2754. BeforeManifest(Self);
  2755. Manifest.Add('<packages>');
  2756. For I:=0 to Packages.Count-1 do
  2757. GetManifest(Packages.PackageItems[i],Manifest);
  2758. Manifest.Add('</packages>');
  2759. If Assigned(AfterManifest) then
  2760. AfterManifest(Self);
  2761. end;
  2762. Procedure TBuildEngine.GetSourceFiles(Packages : TPackages; List : TStrings);
  2763. Var
  2764. I : Integer;
  2765. begin
  2766. List.Add('<packages>');
  2767. For I:=0 to Packages.Count-1 do
  2768. GetSourceFiles(Packages.PackageItems[i],List);
  2769. List.Add('</packages>');
  2770. end;
  2771. { TTarget }
  2772. function TTarget.GetHasStrings(AIndex: integer): Boolean;
  2773. begin
  2774. Result:=False;
  2775. Case AIndex Of
  2776. 0 : Result:=FUnitPath<>Nil;
  2777. 1 : Result:=FObjectPath<>Nil;
  2778. 2 : Result:=FIncludePath<>Nil;
  2779. 3 : Result:=FDependencies<>Nil;
  2780. end;
  2781. end;
  2782. function TTarget.GetCommands: TCommands;
  2783. begin
  2784. If FCommands=Nil then
  2785. FCommands:=TCommands.Create(TCommand);
  2786. Result:=FCommands;
  2787. end;
  2788. function TTarget.GetHasCommands: Boolean;
  2789. begin
  2790. Result:=(FCommands<>Nil);
  2791. end;
  2792. function TTarget.GetStrings(AIndex: integer): TStrings;
  2793. Function EnsureStrings(Var S : TStrings) : TStrings;
  2794. begin
  2795. If (S=Nil) then
  2796. S:=TStringList.Create;
  2797. Result:=S;
  2798. end;
  2799. begin
  2800. Result:=Nil;
  2801. Case AIndex Of
  2802. 0 : Result:=EnsureStrings(FUnitPath);
  2803. 1 : Result:=EnsureStrings(FObjectPath);
  2804. 2 : Result:=EnsureStrings(FIncludePath);
  2805. 3 : Result:=EnsureStrings(FDependencies);
  2806. end;
  2807. end;
  2808. procedure TTarget.SetCommands(const AValue: TCommands);
  2809. begin
  2810. end;
  2811. procedure TTarget.SetStrings(AIndex: integer; const AValue: TStrings);
  2812. begin
  2813. GetStrings(AIndex).Assign(AValue);
  2814. end;
  2815. function TTarget.GetSourceFileName: String;
  2816. begin
  2817. Result:=Name+FExtension;
  2818. end;
  2819. function TTarget.GetUnitFileName: String;
  2820. begin
  2821. Result:=Name+UnitExt;
  2822. end;
  2823. function TTarget.GetObjectFileName: String;
  2824. begin
  2825. Result:=Name+ObjExt;
  2826. end;
  2827. function TTarget.GetRSTFileName: String;
  2828. begin
  2829. Result:=Name+RSText;
  2830. end;
  2831. function TTarget.GetProgramFileName(AnOS : TOS): String;
  2832. begin
  2833. if AnOS in [Go32v2,Win32,Win64,OS2] then
  2834. Result:=Name+ExeExt
  2835. else
  2836. Result:=Name;
  2837. end;
  2838. constructor TTarget.Create(ACollection: TCollection);
  2839. begin
  2840. inherited Create(ACollection);
  2841. FInstall:=True;
  2842. end;
  2843. destructor TTarget.Destroy;
  2844. begin
  2845. FreeAndNil(FUnitPath);
  2846. FreeAndNil(FObjectPath);
  2847. FreeAndNil(FIncludePath);
  2848. FreeAndNil(FDependencies);
  2849. inherited Destroy;
  2850. end;
  2851. function TTarget.GetOutputFileName(AOs: TOS): String;
  2852. begin
  2853. if TargetType in UnitTargets then
  2854. Result:=GetUnitFileName
  2855. else
  2856. Result:=GetProgramFileName(AOs);
  2857. end;
  2858. procedure TTarget.SetName(const AValue: String);
  2859. Var
  2860. D,N,E : String;
  2861. begin
  2862. N:=FixPath(AValue);
  2863. D:=ExtractFilePath(N);
  2864. E:=ExtractFileExt(N);
  2865. N:=ExtractFileName(N);
  2866. If (E<>'') then
  2867. N:=Copy(N,1,Length(N)-Length(E));
  2868. inherited SetName(N);
  2869. FExtension:=E;
  2870. FDirectory:=D;
  2871. end;
  2872. procedure TTarget.GetCleanFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2873. begin
  2874. If (OS=[]) or (AnOS in OS) then
  2875. begin
  2876. List.Add(APrefix+ObjectFileName);
  2877. If (TargetType in [ttUnit,ttExampleUnit]) then
  2878. List.Add(APrefix+UnitFileName)
  2879. else If (TargetType in [ttProgram,ttExampleProgram]) then
  2880. List.Add(APrefix+GetProgramFileName(AnOS));
  2881. If ResourceStrings then
  2882. List.Add(APrefix+RSTFileName);
  2883. // Maybe add later ? AddStrings(List,CleanFiles);
  2884. end;
  2885. end;
  2886. procedure TTarget.GetSourceFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2887. begin
  2888. If (OS=[]) or (AnOS in OS) then
  2889. begin
  2890. List.Add(APrefix+ObjectFileName);
  2891. If (TargetType in [ttUnit,ttExampleUnit]) then
  2892. List.Add(APrefix+UnitFileName)
  2893. else If (TargetType in [ttProgram,ttExampleProgram]) then
  2894. List.Add(APrefix+GetProgramFileName(AnOS));
  2895. If ResourceStrings then
  2896. List.Add(APrefix+RSTFileName);
  2897. // Maybe add later ? AddStrings(List,CleanFiles);
  2898. end;
  2899. end;
  2900. procedure TTarget.GetInstallFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2901. begin
  2902. If (OS=[]) or (AnOS in OS) then
  2903. begin
  2904. If Not (TargetType in [ttProgram,ttExampleProgram]) then
  2905. List.Add(APrefix+ObjectFileName);
  2906. If (TargetType in [ttUnit,ttExampleUnit]) then
  2907. List.Add(APrefix+UnitFileName)
  2908. else If (TargetType in [ttProgram,ttExampleProgram]) then
  2909. List.Add(APrefix+GetProgramFileName(AnOS));
  2910. If ResourceStrings then
  2911. List.Add(APrefix+RSTFileName);
  2912. // Maybe add later ? AddStrings(List,InstallFiles);
  2913. end;
  2914. end;
  2915. procedure TTarget.GetArchiveFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2916. begin
  2917. If (OS=[]) or (AnOS in OS) then
  2918. begin
  2919. List.Add(APrefix+SourceFileName);
  2920. // Maybe add later ? AddStrings(List,ArchiveFiles);
  2921. end;
  2922. end;
  2923. { TSource }
  2924. constructor TSource.Create(ACollection: TCollection);
  2925. begin
  2926. inherited Create(ACollection);
  2927. end;
  2928. destructor TSource.Destroy;
  2929. begin
  2930. inherited Destroy;
  2931. end;
  2932. procedure TSource.GetSourceFiles(List: TStrings);
  2933. begin
  2934. List.Add(Name);
  2935. end;
  2936. { TCommands }
  2937. function TCommands.GetCommand(Dest : String): TCommand;
  2938. begin
  2939. Result:=TCommand(ItemByName(Dest));
  2940. end;
  2941. function TCommands.GetCommandItem(Index : Integer): TCommand;
  2942. begin
  2943. Result:=TCommand(Items[Index]);
  2944. end;
  2945. procedure TCommands.SetCommandItem(Index : Integer; const AValue: TCommand);
  2946. begin
  2947. Items[Index]:=AValue;
  2948. end;
  2949. Function TCommands.AddCommand(const Cmd: String) : TCommand;
  2950. begin
  2951. Result:=AddCommand(fdefaultAt,Cmd,'','','');
  2952. end;
  2953. function TCommands.AddCommand(const Cmd, Options: String): TCommand;
  2954. begin
  2955. Result:=AddCommand(fdefaultAt,Cmd,Options,'','');
  2956. end;
  2957. function TCommands.AddCommand(const Cmd, Options, Dest, Source: String
  2958. ): TCommand;
  2959. begin
  2960. Result:=AddCommand(fdefaultAt,Cmd,options,Dest,Source);
  2961. end;
  2962. Function TCommands.AddCommand(At: TCommandAt; const Cmd: String) : TCommand;
  2963. begin
  2964. Result:=AddCommand(At,Cmd,'','','');
  2965. end;
  2966. function TCommands.AddCommand(At: TCommandAt; const Cmd, Options: String
  2967. ): TCommand;
  2968. begin
  2969. Result:=AddCommand(At,Cmd,Options,'','');
  2970. end;
  2971. function TCommands.AddCommand(At: TCommandAt; const Cmd, Options, Dest,
  2972. Source: String): TCommand;
  2973. begin
  2974. Result:=Add as TCommand;
  2975. Result.Command:=Cmd;
  2976. Result.Options:=Options;
  2977. Result.At:=At;
  2978. Result.SourceFile:=Source;
  2979. Result.DestFile:=Dest;
  2980. end;
  2981. Var
  2982. DefInstaller : TInstaller = Nil;
  2983. DefDictionary : TDictionary = Nil;
  2984. Function Installer : TInstaller;
  2985. begin
  2986. If Not Assigned(DefInstaller) then
  2987. DefInstaller:=InstallerClass.Create(Nil);
  2988. Result:=DefInstaller;
  2989. end;
  2990. Function Defaults : TDefaults;
  2991. begin
  2992. Result:=Installer.Defaults;
  2993. end;
  2994. function Dictionary : TDictionary;
  2995. begin
  2996. If Not Assigned(DefDictionary) then
  2997. DefDictionary:=DictionaryClass.Create(Nil);
  2998. Result:=DefDictionary;
  2999. end;
  3000. { TValueItem }
  3001. constructor TValueItem.Create(AValue: String);
  3002. begin
  3003. FValue:=AValue;
  3004. end;
  3005. { TFunctionItem }
  3006. constructor TFunctionItem.Create(AFunc: TReplaceFunction);
  3007. begin
  3008. FFunc:=AFunc;
  3009. end;
  3010. { TDictionary }
  3011. constructor TDictionary.Create(AOwner: TComponent);
  3012. begin
  3013. inherited Create(AOwner);
  3014. FList:=TStringList.Create;
  3015. FList.Sorted:=True;
  3016. FList.Duplicates:=dupError;
  3017. end;
  3018. destructor TDictionary.Destroy;
  3019. Var
  3020. I : Integer;
  3021. begin
  3022. For I:=0 to Flist.Count-1 do
  3023. FList.Objects[i].Free;
  3024. FreeAndNil(FList);
  3025. inherited Destroy;
  3026. end;
  3027. procedure TDictionary.AddVariable(const AName, Value: String);
  3028. Var
  3029. I : Integer;
  3030. begin
  3031. I:=Flist.IndexOf(AName);
  3032. If I=-1 then
  3033. I:=FList.Add(Aname)
  3034. else
  3035. Flist.Objects[i].Free;
  3036. Flist.Objects[i]:=TValueItem.Create(Value);
  3037. end;
  3038. procedure TDictionary.AddFunction(const AName: String;
  3039. FReplacement: TReplaceFunction);
  3040. Var
  3041. I : Integer;
  3042. begin
  3043. I:=Flist.IndexOf(AName);
  3044. If I=-1 then
  3045. I:=Flist.Add(AName)
  3046. else
  3047. Flist.Objects[i].Free;
  3048. Flist.Objects[i]:=TFunctionItem.Create(FReplacement);
  3049. end;
  3050. procedure TDictionary.RemoveItem(const AName: String);
  3051. Var
  3052. I : Integer;
  3053. begin
  3054. I:=Flist.IndexOf(AName);
  3055. If (I<>-1) then
  3056. begin
  3057. FList.Objects[i].Free;
  3058. FList.Delete(I);
  3059. end;
  3060. end;
  3061. function TDictionary.GetValue(const AName: String): String;
  3062. begin
  3063. Result:=GetValue(AName,'');
  3064. end;
  3065. function TDictionary.GetValue(const AName,Args: String): String;
  3066. Var
  3067. O : TObject;
  3068. I : Integer;
  3069. begin
  3070. I:=Flist.IndexOf(AName);
  3071. If (I=-1) then
  3072. Raise EDictionaryError.CreateFmt(SErrNoDictionaryItem,[AName]);
  3073. O:=Flist.Objects[I];
  3074. If O is TValueItem then
  3075. Result:=Result+TValueItem(O).FValue
  3076. else
  3077. Result:=Result+TFunctionItem(O).FFunc(AName,Args);
  3078. end;
  3079. function TDictionary.ReplaceStrings(Const ASource: String): String;
  3080. Var
  3081. S,FN,FV : String;
  3082. P: Integer;
  3083. begin
  3084. Result:='';
  3085. S:=ASource;
  3086. P:=Pos('$(',S);
  3087. While (P<>0) do
  3088. begin
  3089. Result:=Result+Copy(S,1,P-1);
  3090. Delete(S,1,P+1);
  3091. P:=Pos(')',S);
  3092. FN:=Copy(S,1,P-1);
  3093. Delete(S,1,P);
  3094. P:=Pos(' ',FN);
  3095. If (P<>0) then // function arguments ?
  3096. begin
  3097. FV:=FN;
  3098. FN:=Copy(FN,1,P);
  3099. System.Delete(FV,1,P);
  3100. end
  3101. else
  3102. FV:='';
  3103. Result:=Result+GetValue(FN,FV);
  3104. P:=Pos('$(',S);
  3105. end;
  3106. Result:=Result+S;
  3107. end;
  3108. Function Substitute(Const Source : String; Macros : Array of string) : String;
  3109. Var
  3110. I : Integer;
  3111. begin
  3112. I:=0;
  3113. While I<High(Macros) do
  3114. begin
  3115. Dictionary.AddVariable(Macros[i],Macros[I+1]);
  3116. Inc(I,2);
  3117. end;
  3118. Result:=Dictionary.ReplaceStrings(Source);
  3119. While I<High(Macros) do
  3120. begin
  3121. Dictionary.RemoveItem(Macros[i]);
  3122. Inc(I,2);
  3123. end;
  3124. end;
  3125. Initialization
  3126. OnGetApplicationName:=@GetFPMakeName;
  3127. Finalization
  3128. FreeAndNil(DefInstaller);
  3129. FreeAndNil(DefDictionary);
  3130. end.