12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392 |
- {$Mode objfpc}
- {$H+}
- {$define debug}
- unit fpmkunit;
- Interface
- uses SysUtils,Classes;
- Type
- TFileType = (ftSource,ftUnit,ftObject,ftResource,ftExecutable,ftStaticLibrary,
- ftSharedLibrary);
- TFileTypes = set of TFileType;
- TOS = (Amiga,Atari,Darwin,FreeBSD,Go32v2,Linux,MacOS,MorphOS,NetBSD,
- Netware,NetwLibc,OpenBSD,OS2,PalmOS,Solaris,Win32,wince,Emx);
- TOSes = Set of TOS;
-
- TCPU = (Arm,I386,PPC,SPARC,X86_64,m68k);
- TCPUS = Set of TCPU;
-
- TCompilerMode = (FPC,TP,ObjFPC,Delphi,MacPas);
- TCompilerModes = Set of TCompilerMode;
-
- TTargetType = (ttUnit,ttProgram,ttExampleUnit,ttExampleProgram);
- TTargetTypes = set of TTargetType;
-
- TTargetState = (tsNeutral,tsCompiling,tsCompiled,tsInstalled);
- TTargetStates = Set of TTargetState;
- TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload);
- TVerboseLevel = (vlError,vlWarning,vlInfo,vlCompare,vlCommand,vldebug);
- TVerboseLevels = Set of TVerboseLevel;
-
- TLogEvent = Procedure (Level : TVerboseLevel; Const Msg : String) of Object;
-
- { TNamedItem }
- TNamedItem = Class(TCollectionItem)
- private
- FName: String;
- procedure SetName(const AValue: String);virtual;
- Public
- property Name : String Read FName Write SetName;
- end;
-
- { TNamedCollection }
- TNamedCollection = Class(TCollection)
- private
- FUniqueNames: Boolean;
- Public
- Function IndexOfName(AName : String) : Integer;
- Function ItemByName(AName : String) : TNamedItem;
- Property UniqueNames : Boolean Read FUniqueNames;
- end;
-
- { TNamedItemList }
-
- TNamedItemList = Class(TList)
- private
- function GetNamedItem(Index : Integer): TNamedItem;
- procedure SetNamedItem(Index : Integer; const AValue: TNamedItem);
- public
- Function IndexOfName(AName : String) : Integer;
- Function ItemByName(ANAme : String) : TNamedItem;
- Property NamedItems[Index : Integer] : TNamedItem Read GetNamedItem Write SetNamedItem; default;
- end;
-
- TCommandAt = (caBeforeCompile,caAfterCompile,
- caBeforeInstall,caAfterInstall,
- caBeforeArchive,caAfterArchive,
- caBeforeClean,caAfterClean,
- caBeforeDownload,caAfterDownload);
- { TCommand }
- TCommand = Class(TNamedItem)
- private
- FAfterCommand: TNotifyEvent;
- FBeforeCommand: TNotifyEvent;
- FCommand: String;
- FCommandAt: TCommandAt;
- FDestFile: String;
- FIgnoreResult: Boolean;
- FOptions: String;
- FSourceFile: String;
- Public
- Property SourceFile : String Read FSourceFile Write FSourceFile;
- Property DestFile : String Read FDestFile Write FDestFile;
- Property Command : String Read FCommand Write FCommand;
- Property Options : String Read FOptions Write FOptions;
- Property At : TCommandAt Read FCommandAt Write FCommandAt;
- Property IgnoreResult : Boolean Read FIgnoreResult Write FIgnoreResult;
- Property BeforeCommand : TNotifyEvent Read FBeforeCommand Write FBeforeCommand;
- Property AfterCommand : TNotifyEvent Read FAfterCommand Write FAfterCommand;
- end;
-
- { TCommands }
- TCommands = Class(TNamedCollection)
- private
- FDefaultAt: TCommandAt;
- function GetCommand(Dest : String): TCommand;
- function GetCommandItem(Index : Integer): TCommand;
- procedure SetCommandItem(Index : Integer; const AValue: TCommand);
- Public
- Function AddCommand(Const Cmd : String) : TCommand;
- Function AddCommand(Const Cmd,Options : String) : TCommand;
- Function AddCommand(Const Cmd,Options,Dest,Source : String) : TCommand;
- Function AddCommand(At : TCommandAt; Const Cmd : String) : TCommand;
- Function AddCommand(At : TCommandAt; Const Cmd,Options : String) : TCommand;
- Function AddCommand(At : TCommandAt; Const Cmd,Options, Dest,Source : String) : TCommand;
- Property CommandItems[Index : Integer] : TCommand Read GetCommandItem Write SetCommandItem;
- Property Commands[Dest : String] : TCommand Read GetCommand; default;
- Property DefaultAt : TCommandAt Read FDefaultAt Write FDefaultAt;
- end;
- { TTarget }
- TTarget = Class(TNamedItem)
- private
- FInstall : Boolean;
- FAfterClean: TNotifyEvent;
- FAfterCompile: TNotifyEvent;
- FBeforeClean: TNotifyEvent;
- FBeforeCompile: TNotifyEvent;
- FCPUs: TCPUs;
- FMode: TCompilerMode;
- FResourceStrings: Boolean;
- FObjectPath,
- FUnitPath,
- FIncludePath,
- FDependencies: TStrings;
- FCommands : TCommands;
- FDirectory: String;
- FExtension: String;
- FFileType: TFileType;
- FOptions: String;
- FOSes: TOSes;
- FFPCTarget: String;
- FTargetState: TTargetState;
- FTargetType: TTargetType;
- function GetCommands: TCommands;
- function GetHasCommands: Boolean;
- function GetHasStrings(AIndex: integer): Boolean;
- function GetStrings(AIndex: integer): TStrings;
- procedure SetCommands(const AValue: TCommands);
- procedure SetStrings(AIndex: integer; const AValue: TStrings);
- Protected
- Function GetSourceFileName : String; virtual;
- Function GetUnitFileName : String; virtual;
- Function GetObjectFileName : String; virtual;
- Function GetRSTFileName : String; Virtual;
- Function GetProgramFileName(AnOS : TOS) : String; Virtual;
- Public
- Constructor Create(ACollection : TCollection); override;
- Destructor Destroy; override;
- Function GetOutputFileName (AOs : TOS) : String; Virtual;
- procedure SetName(const AValue: String);override;
- Procedure GetCleanFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
- Procedure GetInstallFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
- Procedure GetArchiveFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
- Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
- Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
- Property HasIncludePath : Boolean Index 2 Read GetHasStrings;
- Property HasDependencies : Boolean Index 3 Read GetHasStrings;
- Property HasCommands : Boolean Read GetHasCommands;
- Property UnitPath : TStrings Index 0 Read GetStrings Write SetStrings;
- Property ObjectPath : TStrings Index 1 Read GetStrings Write SetStrings;
- Property IncludePath : TStrings Index 2 Read GetStrings Write SetStrings;
- Property Dependencies : TStrings Index 3 Read GetStrings Write SetStrings;
- Property Commands : TCommands Read GetCommands Write SetCommands;
- Property State : TTargetState Read FTargetState;
- Property TargetType : TTargetType Read FTargetType Write FTargetType;
- Property OS : TOSes Read FOSes Write FOSes;
- Property Mode : TCompilerMode Read FMode Write FMode;
- Property Options : String Read FOptions Write Foptions;
- Property SourceFileName: String Read GetSourceFileName ;
- Property UnitFileName : String Read GetUnitFileName;
- Property ObjectFileName : String Read GetObjectFileName;
- Property RSTFileName : String Read GetRSTFileName;
- Property CPU : TCPUs Read FCPUs Write FCPUs;
- Property FPCTarget : String Read FFPCTarget Write FFPCTarget;
- Property Extension : String Read FExtension Write FExtension;
- Property FileType : TFileType Read FFileType Write FFileType;
- Property Directory : String Read FDirectory Write FDirectory;
- Property ResourceStrings : Boolean Read FResourceStrings Write FResourceStrings;
- Property Install : Boolean Read FInstall Write FInstall;
- // Events.
- Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
- Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
- Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
- Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
- end;
- { TTargets }
- TTargets = Class(TNamedCollection)
- private
- FDefaultCPU: TCPUs;
- FDefaultDir : String;
- FDefaultOS: TOSes;
- function GetTargetItem(Index : Integer): TTarget;
- function GetTarget(AName : String): TTarget;
- procedure SetDefaultDir(const AValue: String);
- procedure SetTargetItem(Index : Integer; const AValue: TTarget);
- Procedure ApplyDefaults(ATarget : TTarget);
- Public
- Procedure ResetDefaults;
- Function AddUnit(AUnitName : String) : TTarget;
- Function AddProgram(AProgramName : String) : TTarget;
- Function AddExampleUnit(AUnitName : String) : TTarget;
- Function AddExampleProgram(AProgramName : String) : TTarget;
- Property Targets[AName : String] : TTarget Read GetTarget; default;
- Property TargetItems[Index : Integer] : TTarget Read GetTargetItem Write SetTargetItem;
- Property DefaultDir : String Read FDefaultDir Write SetDefaultDir;
- Property DefaultOS : TOSes Read FDefaultOS Write FDefaultOS;
- Property DefaultCPU : TCPUs Read FDefaultCPU Write FDefaultCPU;
- end;
-
- { TPackage }
-
- TPackage = Class(TNamedItem) // Maybe descend from/use TTarget ?
- private
- FAfterArchive: TNotifyEvent;
- FAfterClean: TNotifyEvent;
- FAfterCompile: TNotifyEvent;
- FAfterDownload: TNotifyEvent;
- FAfterInstall: TNotifyEvent;
- FBeforeArchive: TNotifyEvent;
- FBeforeClean: TNotifyEvent;
- FBeforeCompile: TNotifyEvent;
- FBeforeDownload: TNotifyEvent;
- FBeforeInstall: TNotifyEvent;
- FUnitPath,
- FObjectPath,
- FIncludePath,
- FCleanFiles,
- FArchiveFiles,
- FInstallFiles,
- FDependencies: TStrings;
- FCPU: TCPUs;
- FOS: TOses;
- FTargetState: TTargetState;
- FTargets: TTargets;
- FDirectory: String;
- FOptions: String;
- FAuthor: String;
- FLicense: String;
- FURL: String;
- FVersion: String;
- FCommands : TCommands;
- function GetCommands: TCommands;
- function GetHasCommands: Boolean;
- function GetHasStrings(AIndex: integer): Boolean;
- function GetStrings(AIndex: integer): TStrings;
- procedure SetCommands(const AValue: TCommands);
- procedure SetStrings(AIndex: integer; const AValue: TStrings);
- Public
- constructor Create(ACollection: TCollection); override;
- destructor destroy; override;
- Function AddTarget(AName : String) : TTarget;
- Procedure AddDependency(AName : String);
- Procedure AddInstallFile(AFileName : String);
- Procedure GetCleanFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
- procedure GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS);
- Procedure GetArchiveFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
- Property Version : String Read FVersion Write FVersion;
- Property URL : String Read FURL Write FURL;
- Property Author : String Read FAuthor Write FAuthor;
- Property License : String Read FLicense Write FLicense;
- Property Directory : String Read FDirectory Write FDirectory;
- // Compiler options.
- Property OS : TOses Read FOS Write FOS;
- Property CPU : TCPUs Read FCPU Write FCPU;
- Property Options: String Read FOptions Write FOptions;
- Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
- Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
- Property HasIncludePath : Boolean Index 2 Read GetHasStrings;
- Property HasDependencies : Boolean Index 3 Read GetHasStrings;
- Property HasInstallFiles: Boolean Index 4 Read GetHasStrings;
- Property HasCleanFiles : Boolean Index 5 Read GetHasStrings;
- Property HasArchiveFiles : Boolean Index 6 Read GetHasStrings;
- Property HasCommands : Boolean Read GetHasCommands;
- Property UnitPath : TStrings Index 0 Read GetStrings Write SetStrings;
- Property ObjectPath : TStrings Index 1 Read GetStrings Write SetStrings;
- Property IncludePath : TStrings Index 2 Read GetStrings Write SetStrings;
- // Targets and dependencies
- Property Dependencies : TStrings Index 3 Read GetStrings Write SetStrings;
- Property InstallFiles : TStrings Index 4 Read GetStrings Write SetStrings;
- Property CleanFiles : TStrings Index 5 Read GetStrings Write SetStrings;
- Property ArchiveFiles : TStrings Index 6 Read GetStrings Write SetStrings;
- Property Commands : TCommands Read GetCommands Write SetCommands;
- Property State : TTargetState Read FTargetState;
- Property Targets : TTargets Read FTargets;
- // events
- Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
- Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
- Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
- Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
- Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
- Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
- Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
- Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
- Property BeforeDownload : TNotifyEvent Read FBeforeDownload Write FBeforeDownload;
- Property AfterDownload : TNotifyEvent Read FAfterDownload Write FAfterDownload;
- end;
- { TPackages }
- TPackages = Class(TNamedCollection)
- private
- function GetPackage(AName : String): TPackage;
- function GetPackageItem(AIndex : Integer): TPackage;
- procedure SetPackageItem(AIndex : Integer; const AValue: TPackage);
- Public
- Function AddPackage(Const AName : String) : TPackage;
- Property Packages[AName : String] : TPackage Read GetPackage ; Default;
- Property PackageItems[AIndex : Integer] : TPackage Read GetPackageItem Write SetPackageItem;
- end;
- { TDefaults }
-
- TDefaults = Class(TPersistent)
- Private
- FArchive: String;
- FCompiler: String;
- FCopy: String;
- FDownload: String;
- FMkDir: String;
- FMove: String;
- FOptions: String;
- FCPU: TCPU;
- FOS: TOS;
- FMode : TCompilerMode;
- FPrefix: String;
- FBaseInstallDir,
- FUnitInstallDir,
- FBinInstallDir,
- FDocInstallDir,
- FExamplesInstallDir : String;
- FRemove: String;
- FTarget: String;
- FUnixPaths: Boolean;
- function GetBaseInstallDir: String;
- function GetBinInstallDir: String;
- function GetCompiler: String;
- function GetDocInstallDir: String;
- function GetExamplesInstallDir: String;
- function GetUnitInstallDir: String;
- procedure SetBaseInstallDir(const AValue: String);
- procedure SetCPU(const AValue: TCPU);
- procedure SetOS(const AValue: TOS);
- procedure SetPrefix(const AValue: String);
- procedure SetTarget(const AValue: String);
- Protected
- procedure RecalcTarget;
- Public
- Constructor Create;
- Procedure InitDefaults;
- Procedure Assign(ASource : TPersistent);override;
- Procedure LocalInit(Const AFileName : String);
- Procedure LoadFromFile(Const AFileName : String);
- Procedure SaveToFile(Const AFileName : String);
- procedure SaveToStream(S : TStream);virtual;
- procedure LoadFromStream(S : TStream);virtual;
- // Compile Information
- Property Target : String Read FTarget Write SetTarget;
- Property OS : TOS Read FOS Write SetOS;
- Property CPU : TCPU Read FCPU Write SetCPU;
- Property Mode : TCompilerMode Read FMode Write FMode;
- Property UnixPaths : Boolean Read FUnixPaths Write FUnixPaths;
- Property Options : String Read FOptions Write FOptions; // Default compiler options.
- // paths etc.
- Property Prefix : String Read FPrefix Write SetPrefix;
- Property BaseInstallDir : String Read GetBaseInstallDir Write SetBaseInstallDir;
- Property UnitInstallDir : String Read GetUnitInstallDir Write FUnitInstallDir;
- Property BinInstallDir : String Read GetBinInstallDir Write FBinInstallDir;
- Property DocInstallDir : String Read GetDocInstallDir Write FDocInstallDir;
- Property ExamplesInstallDir : String Read GetExamplesInstallDir Write FExamplesInstallDir;
- // Command tools. If not set, internal commands will be used.
- Property Compiler : String Read GetCompiler Write FCompiler; // Compiler. Defaults to fpc/ppc386
- Property Copy : String Read FCopy Write FCopy; // copy $(FILES) to $(DEST)
- Property Move : String Read FMove Write FMove; // Move $(FILES) to $(DEST)
- Property Remove : String Read FRemove Write FRemove; // Delete $(FILES)
- Property MkDir : String Read FMkDir write FMkDir; // Make $(DIRECTORY)
- Property Archive : String Read FArchive Write FArchive; // zip $(ARCHIVE) $(FILESORDIRS)
- Property Download : String Read FDownload Write FDownload; // wget $(URL) $(DESTFILE)
- end;
- { TBuildEngine }
- TBuildEngine = Class(TComponent)
- private
- // general variables
- FCompiler : String;
- FStartDir : String;
- FTargetDir : String;
- FDefaults : TDefaults;
- FForceCompile : Boolean;
- FListMode : Boolean;
- // Variables used when compiling a package.
- // Only valid during compilation of the package.
- FCurrentOutputDir : String;
- FCurrentPackage: TPackage;
- // Events
- FOnLog: TLogEvent;
- FAfterArchive: TNotifyEvent;
- FAfterClean: TNotifyEvent;
- FAfterCompile: TNotifyEvent;
- FAfterDownload: TNotifyEvent;
- FAfterInstall: TNotifyEvent;
- FBeforeArchive: TNotifyEvent;
- FBeforeClean: TNotifyEvent;
- FBeforeCompile: TNotifyEvent;
- FBeforeDownload: TNotifyEvent;
- FBeforeInstall: TNotifyEvent;
- procedure SetDefaults(const AValue: TDefaults);
- procedure SetTargetDir(const AValue: String);
- Protected
- Procedure Error(Msg : String);
- Procedure Error(Fmt : String; Args : Array of const);
- // Internal copy/delete/move/archive/mkdir files
- Procedure SysCopyFile(Const Src,Dest : String); virtual;
- Procedure SysMoveFile(Const Src,Dest : String); virtual;
- Procedure SysDeleteFile(Const AFileName : String); virtual;
- Procedure SysArchiveFiles(List : TStrings; Const AFileName : String); virtual;
- Procedure SysDownloadFile(Const AURL, ALocalFileName : String); virtual;
- Procedure Log(Level : TVerboseLevel; Const Msg : String);
- Procedure Log(Level : TVerboseLevel; Const Fmt : String; Args : Array Of Const);
- Procedure EnterDir(ADir : String);
- Function GetCompiler : String;
- Procedure InstallPackageFiles(APAckage : TPackage; tt : TTargetType; Const Src,Dest : String); virtual;
- Function FileNewer(Src,Dest : String) : Boolean;
- Public
- Constructor Create(AOwner : TComponent); override;
- // Public Copy/delete/Move/Archive/Mkdir Commands.
- Procedure ExecuteCommand(Cmd : String; Args : String; IgnoreError : Boolean = False); virtual;
- Procedure CmdCopyFiles(List : TStrings; Const DestDir : String);
- Procedure CmdCreateDir(DestDir : String);
- Procedure CmdMoveFiles(List : TStrings; Const DestDir : String);
- Procedure CmdDeleteFiles(List : TStrings);
- Procedure CmdArchiveFiles(List : TStrings; Const ArchiveFile : String);
- Procedure ExecuteCommands(Commands : TCommands; At : TCommandAt);
- // Target commands
- Function GetTargetDir(APackage : TPackage; ATarget : TTarget; AbsolutePath : Boolean = False) : String;
- Function GetCompilerCommand(APackage : TPackage; Target : TTarget) : String;
- Function TargetOK(Target : TTarget) : Boolean;
- Function NeedsCompile(Target : TTarget) : Boolean;
- Procedure Compile(Target : TTarget); virtual;
- Procedure FixDependencies(Target: TTarget);
- // Package commands
- Function GetPackageDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
- Function GetOutputDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
- Function PackageOK(APackage : TPackage) : Boolean; virtual;
- Procedure DoBeforeCompile(APackage : TPackage);virtual;
- Procedure DoAfterCompile(APackage : TPackage);virtual;
- Procedure DoBeforeInstall(APackage : TPackage);virtual;
- Procedure DoAfterInstall(APackage : TPackage);virtual;
- Procedure DoBeforeArchive(APackage : TPackage);virtual;
- Procedure DoAfterArchive(APackage : TPackage);virtual;
- Procedure DoBeforeClean(APackage : TPackage);virtual;
- Procedure DoAfterClean(APackage : TPackage);virtual;
- Procedure DoBeforeDownload(APackage : TPackage);virtual;
- Procedure DoAfterDownload(APackage : TPackage);virtual;
- Function NeedsCompile(APackage : TPackage) : Boolean; virtual;
- Procedure Compile(APackage : TPackage);
- Procedure Install(APackage : TPackage);
- Procedure Archive(APackage : TPackage);
- Procedure Clean(APackage : TPackage);
- Procedure Download(APackage : TPackage);
- Procedure FixDependencies(APackage : TPackage);
- procedure CheckExternalPackage(Const APackageName : String);
- procedure CreateOutputDir(APackage: TPackage);
- // Packages commands
- Procedure Compile(Packages : TPackages);
- Procedure Install(Packages : TPackages);
- Procedure Archive(Packages : TPackages);
- Procedure Clean(Packages : TPackages);
- Procedure Download(Packages : TPackages);
- Property ListMode : Boolean Read FListMode Write FListMode;
- Property ForceCompile : Boolean Read FForceCompile Write FForceCompile;
- Property Defaults : TDefaults Read FDefaults Write SetDefaults;
- Property TargetDir : String Read FTargetDir Write SetTargetDir;
- // Events
- Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
- Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
- Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
- Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
- Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
- Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
- Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
- Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
- Property BeforeDownload : TNotifyEvent Read FBeforeDownload Write FBeforeDownload;
- Property AfterDownload : TNotifyEvent Read FAfterDownload Write FAfterDownload;
- Property OnLog : TLogEvent Read FOnLog Write FOnlog;
- end;
- { TInstaller }
- TInstaller = Class(TComponent)
- private
- FBuildEngine: TBuildEngine;
- FDefaultPackage: TPackage;
- FDefaults: TDefaults;
- FPackages: TPackages;
- FRunMode: TRunMode;
- FListMode : Boolean;
- FLogLevels : TVerboseLevels;
- function GetAuthor: String;
- function GetStrings(AIndex : Integer): TStrings;
- function GetDirectory: String;
- function GetLicense: String;
- function GetOSes: TOSes;
- function GetOptions: String;
- function GetTargets: TTargets;
- function GetURL: String;
- function GetVersion: String;
- procedure SetAuthor(const AValue: String);
- procedure SetDefaultPackage(const AValue: TPackage);
- procedure SetDefaults(const AValue: TDefaults);
- procedure SetStrings(AIndex : Integer; const AValue: TStrings);
- procedure SetDirectory(const AValue: String);
- procedure SetOptions(const AValue: String);
- procedure SetOses(const AValue: TOSes);
- procedure SetURL(const AValue: String);
- procedure SetVersion(const AValue: String);
- procedure SetLicense(const AValue: String);
- Protected
- Procedure Log(Level : TVerboseLevel; Const Msg : String);
- Procedure CreatePackages; virtual;
- Procedure CheckPackages; virtual;
- Procedure CreateBuildEngine; virtual;
- Procedure CheckDefaultPackage;
- Procedure Error(Msg : String);
- Procedure Error(Fmt : String; Args : Array of const);
- Procedure AnalyzeOptions;
- Procedure Usage(FMT : String; Args : Array of const);
- Procedure Compile(Force : Boolean); virtual;
- Procedure Clean; virtual;
- Procedure Install; virtual;
- Procedure Archive; virtual;
- Procedure Download; Virtual;
- Property BuildEngine : TBuildEngine Read FBuildEngine;
- Public
- Constructor Create(AOWner : TComponent); override;
- Destructor destroy; override;
- Function StartPackage(Const AName : String) : TPackage;
- Procedure EndPackage;
- Function Run : Boolean;
- Function AddTarget(AName : String) : TTarget;
- Procedure AddDependency(AName : String);
- Property DefaultPackage : TPackage read FDefaultPackage write SetDefaultPackage;
- Property Packages : TPackages Read FPackages;
- Property Dependencies : TStrings Index 0 Read GetStrings Write SetStrings;
- Property InstallFiles : TStrings Index 1 Read GetStrings Write SetStrings;
- Property CleanFiles : TStrings Index 2 Read GetStrings Write SetStrings;
- Property ArchiveFiles : TStrings Index 3 Read GetStrings Write SetStrings;
- Property Defaults : TDefaults Read FDefaults Write SetDefaults;
- Property RunMode : TRunMode Read FRunMode;
- Property ListMode : Boolean Read FListMode;
- // Default Package redirects.
- Property Targets : TTargets Read GetTargets;
- Property Version : String Read GetVersion Write SetVersion;
- Property URL : String Read GetURL Write SetURL;
- Property Author : String Read GetAuthor Write SetAuthor;
- Property License : String Read GetLicense Write SetLicense;
- Property Directory : String Read GetDirectory Write SetDirectory;
- Property Options : String Read GetOptions Write SetOptions;
- Property OS: TOSes Read GetOSes Write SetOses;
- end;
- TReplaceFunction = Function (Const AName,Args : String) : String of Object;
- { TValueItem }
- TValueItem = Class(TObject)
- FValue : String;
- Constructor Create(AValue : String);
- end;
-
- { TFunctionItem }
- TFunctionItem = Class(TObject)
- FFunc : TReplaceFunction;
- Constructor Create(AFunc : TReplaceFunction);
- end;
-
- { TDictionary }
- TDictionary = Class(TComponent)
- FList : TStringList;
- Public
- Constructor Create(AOwner : TComponent); override;
- Destructor Destroy;override;
- Procedure AddVariable(Const AName,Value : String);
- Procedure AddFunction(Const AName : String; FReplacement : TReplaceFunction);
- Procedure RemoveItem(Const AName : String);
- Function GetValue(Const AName : String) : String;
- Function GetValue(Const AName,Args : String) : String; virtual;
- Function ReplaceStrings(Const ASource : String) : String; virtual;
- end;
- ECollectionError = Class(Exception);
- EInstallerError = Class(Exception);
- EDictionaryError = Class(Exception);
- TInstallerClass = Class of TInstaller;
- TDictionaryClass = Class of TDictionary;
-
- Const
- // Aliases
- AmD64 = X86_64;
- PowerPC = PPC;
- dos = go32v2;
- AllOSs = [Low(TOS)..High(TOS)];
- AllCPUs = [Low(TCPU)..High(TCPU)];
-
- // Useful
- UnitExt = '.ppu';
- PPUExt = UnitExt;
- PasExt = '.pas';
- PPExt = '.pp';
- IncExt = '.inc';
- ObjExt = '.o';
- RstExt = '.rst';
- LibExt = '.a';
- SharedLibExt = '.so';
- DLLExt = '.dll';
- ExeExt = '.exe';
- ZipExt = '.zip';
- // Targets
- i386_Linux = 'i386-linux';
- i386_Win32 = 'i386-win32';
- i386_Dos = 'i386-go32v2';
- i386_OS2 = 'i386-os2';
- i386_FreeBSD = 'i386-freebsd';
- i386_NetBSD = 'i386-netsd';
- i386_OpenBSD = 'i386-openbsd';
- i386_netware = 'i386-netware';
- i386_netwlibc = 'i386-netwlibc';
- i386_go32v2 = 'i386-go32v2';
- PPC_Linux = 'ppc-linux';
- powerpc_linux = PPC_linux;
- sparc_linux = 'sparc-linux';
- arm_linux = 'arm-linux';
- ppc_macos = 'ppc-macos';
- ppc_darwin = 'ppc-darwin';
- UnitTargets = [ttUnit,ttExampleUnit];
- ProgramTargets = [ttProgram,ttExampleProgram];
- AllMessages = [vlError,vlWarning,vlInfo,vlCompare,vlCommand];
- Type
- TArchiveEvent = Procedure (Const AFileName : String; List : TStrings) of Object;
- TArchiveProc = Procedure (Const AFileName : String; List : TStrings);
- TDownLoadEvent = Procedure (Const AURL,ALocalFileName : String) of Object;
- TDownloadProc = Procedure (Const AURL,ALocalFileName : String);
- Var
- InstallerClass : TInstallerClass = TInstaller;
- DictionaryClass : TDictionaryClass = TDictionary;
- OnArchiveFiles : TArchiveEvent = Nil;
- ArchiveFilesProc : TArchiveProc = Nil;
- OnDownloadFile : TDownloadEvent = Nil;
- DownloadFileProc : TDownloadProc = Nil;
- Function CurrentOS : String;
- Function CurrentCPU : String;
- Function Installer : TInstaller;
- Function Defaults : TDefaults; // Set by installer.
- Function Dictionary : TDictionary;
- Function OSToString(OS: TOS) : String;
- Function OSesToString(OSes: TOSes) : String;
- Function CPUToString(CPU: TCPU) : String;
- Function CPUSToString(CPUS: TCPUS) : String;
- Function StringToOS(S : String) : TOS;
- Function OSesToString(S : String) : TOSes;
- Function StringToCPU(S : String) : TCPU;
- Function StringToCPUS(S : String) : TCPUS;
- Function ModeToString(Mode: TCompilerMode) : String;
- Function StringToMode(S : String) : TCompilerMode;
- Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
- Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
- Procedure ResolveDependencies(L : TStrings; P : TNamedCollection);
- Function AddStrings(Dest,Src : TStrings) : Integer ;
- function AddStrings(Dest, Src : TStrings; Const APrefix : String) : Integer ;
- Function FileListToString(List : TStrings; Prefix : String) : String;
- Function FixPath (APath : String) : String;
- Procedure ChangeDir(APath : String);
- Function Substitute(Const Source : String; Macros : Array of string) : String;
- Procedure SplitCommand(Const Cmd : String; Var Exe,Options : String);
- Implementation
- uses TypInfo;
- ResourceString
- SErrNameExists = 'Name "%s" already exists in the collection.';
- SErrNoSuchName = 'Could not find item with name "%s" in the collection.';
- SErrInvalidCPU = 'Invalid CPU name : "%s"';
- SErrInvalidOS = 'Invalid OS name : "%s"';
- SErrInvalidMode = 'Invalid compiler mode : "%s"';
- SErrNoPackage = 'No package available. Add package with StartPackage Call';
- SErrInValidArgument = 'Invalid command-line argument at position %d : %s';
- SErrNeedArgument = 'Option at position %d (%s) needs an argument';
- SErrInvalidTarget = 'Invalid compiler target: %s';
- SErrNoPackagesDefined = 'No action possible: No packages were defined.';
- SErrInstaller = 'The installer encountered the following error:';
- SErrDepUnknownTarget = 'Unknown target in dependencies for %s: %s';
- SErrExternalCommandFailed = 'External command "%s" failed with exit code: %d';
- SErrCreatingDirectory = 'Failed to create directory: %s';
- SErrDeletingFile = 'Failed to delete file: %s';
- SErrMovingFile = 'Failed to move file "%s" to "%s"';
- SErrCopyingFile = 'Failed to copy file "%s" to "%s"';
- SErrChangeDirFailed = 'Failed to enter directory: %s';
- SErrInvalidArgumentToSubstitute = 'Invalid number of arguments to Substitute';
- SErrNoArchiveSupport = 'This binary contains no archive support. Please recompile with archive support';
- SErrNoDownloadSupport = 'This binary contains no download support. Please recompile with download support';
- SErrNoDictionaryItem = 'No item called "%s" in the dictionary';
- SErrNoDictionaryValue = 'The item "%s" in the dictionary is not a value.';
- SErrNoDictionaryFunc = 'The item "%s" in the dictionary is not a function.';
- SWarnCircularDependency = 'Warning: Circular dependency detected when compiling target %s: %s';
- SWarnFailedToSetTime = 'Warning: Failed to set timestamp on file : %s';
- SWarnFailedToGetTime = 'Warning: Failed to get timestamp from file : %s';
- SWarnFileDoesNotExist = 'Warning: File "%s" does not exist';
-
- // Log messages
- SLogEnterDir = 'Entering directory: %s';
- SLogCompilingPackage = 'Compiling package : %s';
- SLogCompilingTarget = 'Compiling target : %s';
- SLogExecutingCommand = 'Executing command %s with options: %s';
- SLogCreatingOutputDir = 'Creating output dir : %s';
- SLogOutputDirExists = 'Output dir exists : %s';
- SLogInstallingPackage = 'Installing package : %s';
- SLogArchivingPackage = 'Archiving package : %s';
- SLogCleaningPackage = 'Cleaning package : %s';
- SLogDownloadingPackage = 'Downloading package : %s';
- SLogCopyingFile = 'Copying file "%s" to "%s"';
- SLogCompilingFileTimes = 'Comparing file "%s" time "%s" to "%s" time "%s".';
- SLogSourceNewerDest = 'Source file "%s" (%s) is newer than destination "%s" (%s).';
- Const
- // Keys for Defaults file. Do not localize.
- KeyCompiler = 'Compiler';
- KeyArchive = 'Archive';
- KeyCopy = 'Copy';
- KeyDownLoad = 'Download';
- KeyMkDir = 'MkDir';
- KeyMove = 'Move';
- KeyRemove = 'Remove';
- KeyOptions = 'Options';
- KeyCPU = 'CPU';
- KeyOS = 'OS';
- KeyMode = 'Mode';
- KeyPrefix = 'Prefix';
- KeyTarget = 'Target';
- KeyBaseInstallDir = 'BaseInstallDir';
- KeyUnitInstallDir = 'UnitInstallDir';
- KeyBinInstallDir = 'BinInstallDir';
- KeyDocInstallDir = 'DocInstallDir';
- KeyExamplesInstallDir = 'ExamplesInstallDir';
- // Callback for Sysutils getapplicationname.
- Function GetFPMakeName : String;
- begin
- Result:='fpmake';
- end;
- Function CurrentOS : String;
- begin
- Result:=OSToString(Defaults.OS);
- end;
- Function CurrentCPU : String;
- begin
- Result:=CPUToString(Defaults.CPU);
- end;
- Function OSToString(OS: TOS) : String;
- begin
- Result:=LowerCase(GetenumName(TypeInfo(TOS),Ord(OS)));
- end;
- Function OSesToString(OSes: TOSes) : String;
- begin
- Result:=LowerCase(SetToString(PtypeInfo(TypeInfo(TOSes)),Integer(OSes),False));
- end;
- Function CPUToString(CPU: TCPU) : String;
- begin
- Result:=LowerCase(GetenumName(TypeInfo(TCPU),Ord(CPU)));
- end;
- Function CPUSToString(CPUS: TCPUS) : String;
- begin
- Result:=LowerCase(SetToString(PTypeInfo(TypeInfo(TCPUS)),Integer(CPUS),False));
- end;
- Function StringToOS(S : String) : TOS;
- Var
- I : Integer;
- begin
- I:=GetEnumValue(TypeInfo(TOS),S);
- if (I=-1) then
- Raise EInstallerError.CreateFmt(SErrInvalidOS,[S]);
- Result:=TOS(I);
- end;
- Function OSesToString(S : String) : TOSes;
- begin
- Result:=TOSes(StringToSet(PTypeInfo(TypeInfo(TOSes)),S));
- end;
- Function StringToCPU(S : String) : TCPU;
- Var
- I : Integer;
- begin
- I:=GetEnumValue(TypeInfo(TCPU),S);
- if (I=-1) then
- Raise EInstallerError.CreateFmt(SErrInvalidCPU,[S]);
- Result:=TCPU(I);
- end;
- Function StringToCPUS(S : String) : TCPUS;
- begin
- Result:=TCPUS(StringToSet(PTypeInfo(TypeInfo(TCPUS)),S));
- end;
- Function ModeToString(Mode: TCompilerMode) : String;
- begin
- Result:=LowerCase(GetenumName(TypeInfo(TCompilerMode),Ord(Mode)));
- end;
- Function StringToMode(S : String) : TCompilerMode;
- Var
- I : Integer;
- begin
- I:=GetEnumValue(TypeInfo(TCompilerMode),S);
- if (I=-1) then
- Raise EInstallerError.CreateFmt(SErrInvalidMode,[S]);
- Result:=TCompilerMode(I);
- end;
- Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
- begin
- Result:=CPUToString(CPU)+'-'+OSToString(OS);
- end;
- Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
- Var
- P : integer;
- begin
- P:=Pos('-',S);
- If (P=0) then
- Raise EInstallerError.CreateFmt(SErrInvalidTarget,[S]);
- CPU:=StringToCPU(Copy(S,1,P-1));
- OS:=StringToOs(Copy(S,P+1,Length(S)-P));
- end;
- Procedure ResolveDependencies(L : TStrings; P : TNamedCollection);
- Var
- I,J : Integer;
- begin
- If Assigned(L) then
- For I:=0 to L.Count-1 do
- begin
- J:=P.IndexOfName(L[i]);
- If J<>-1 then
- L.Objects[I]:=P.Items[J];
- end;
- end;
- Function AddStrings(Dest,Src : TStrings) : Integer ;
- begin
- Result:=AddStrings(Dest,Src,'');
- end;
- Procedure AddStrings(Var S : String; L : TStrings; Prefix : String);
- Var
- I : Integer;
- begin
- For I:=0 to L.Count-1 do
- begin
- if (S<>'') then
- S:=S+' ';
- S:=S+Prefix+L[i];
- end;
- end;
- function AddStrings(Dest, Src : TStrings; Const APrefix : String) : Integer ;
- begin
- Result:=0;
- While (Result<Src.Count) do
- begin
- If (APrefix<>'') then
- Dest.Add(APrefix+Src[Result]) // Not sure whether '' is optimized away.
- else
- Dest.Add(Src[Result]);
- Inc(Result);
- end;
- end;
- function FileListToString(List : TStrings; Prefix : String) : String;
- Var
- I : integer;
- S : String;
- begin
- Result:='';
- For I:=0 to List.Count-1 do
- begin
- If (I>0) then
- Result:=Result+' ';
- S:=Prefix+List[i];
- If (Pos(' ',S)<>0) then
- S:='"'+S+'"';
- Result:=Result+S;
- end;
- end;
- function FixPath (APath : String) : String;
- Var
- P : PChar;
-
- begin
- Result:=APath;
- If (result<>'') then
- begin
- P:=PChar(Result);
- While (P^<>#0) do
- begin
- If P^ in ['/','\',':'] then // do not use drive letters.
- P^:=PathDelim;
- Inc(P);
- end;
- end;
- end;
- procedure ChangeDir(APath : String);
- begin
- if Not SetCurrentDir(APath) then
- Raise EInstallerError.CreateFmt(SErrChangeDirFailed,[APath]);
- end;
- procedure SplitCommand(const Cmd : String; var Exe, Options : String);
- Const
- WhiteSpace = [#9,#10,#13,' '];
- QuoteChars = ['''','"'];
- Var
- I : Integer;
- InQuote : Boolean;
- LastQuote : Char;
- S : String;
- begin
- S:=Trim(Cmd);
- InQuote:=False;
- LastQuote:=#0;
- I:=1;
- While (I<=Length(S)) and (Inquote or not (S[I] in whiteSpace)) do
- begin
- If S[i] in QuoteChars then
- begin
- InQuote:=Not (S[i]=LastQuote);
- If InQuote then
- LastQuote:=S[i]
- else
- LastQuote:=#0;
- end;
- Inc(I);
- end;
- Exe:=Copy(S,1,I-1);
- Delete(S,1,I);
- Options:=Trim(S);
- end;
- { TNamedItem }
- procedure TNamedItem.SetName(const AValue: String);
- begin
- if FName=AValue then exit;
- With TNamedCollection(Collection) do
- If UniqueNames then
- If (IndexOfName(AVAlue)<>-1) then
- Raise ECollectionError.CreateFmt(SErrNameExists,[AValue]);
- FName:=AValue;
- end;
- { TNamedCollection }
- function TNamedCollection.IndexOfName(AName: String): Integer;
- begin
- Result:=Count-1;
- While (Result>=0) and (CompareText(TNamedItem(Items[Result]).FName,AName)<>0) do
- Dec(Result);
- end;
- function TNamedCollection.ItemByName(AName: String): TNamedItem;
- Var
- I : Integer;
- begin
- I:=IndexOfName(AName);
- If (I=-1) Then
- Raise ECollectionError.CreateFmt(SErrNoSuchName,[AName]);
- Result:=TNamedItem(Items[i]);
- end;
- { TTargets }
- function TTargets.GetTargetItem(Index : Integer): TTarget;
- begin
- Result:=TTarget(Items[Index]);
- end;
- function TTargets.GetTarget(AName : String): TTarget;
- begin
- Result:=TTarget(ItemByName(AName));
- end;
- procedure TTargets.SetDefaultDir(const AValue: String);
- begin
- If (AValue<>'') then
- FDefaultDir:=IncludeTrailingPathDelimiter(AValue)
- else
- FDefaultDir:='';
- end;
- procedure TTargets.SetTargetItem(Index : Integer; const AValue: TTarget);
- begin
- Items[Index]:=AValue;
- end;
- procedure TTargets.ApplyDefaults(ATarget: TTarget);
- begin
- If (ATarget.Directory='') then
- ATarget.Directory:=FDefaultDir;
- ATarget.OS:=FDefaultOS;
- ATarget.CPU:=FDefaultCPU;
- end;
- procedure TTargets.ResetDefaults;
- begin
- FDefaultDir:='';
- FDefaultOS:=[];
- FDefaultCPU:=[];
- end;
- Function TTargets.AddUnit(AUnitName: String) : TTarget;
- begin
- Result:=Add as TTarget;
- Result.Name:=AUnitName;
- Result.TargetType:=TTUnit;
- ApplyDefaults(Result);
- end;
- Function TTargets.AddProgram(AProgramName: String) : TTarget;
- begin
- Result:=Add as TTarget;
- Result.Name:=AProgramName;
- Result.TargetType:=ttProgram;
- ApplyDefaults(Result);
- end;
- Function TTargets.AddExampleUnit(AUnitName: String): TTarget;
- begin
- Result:=Add as TTarget;
- Result.Name:=AUnitName;
- Result.TargetType:=ttExampleUnit;
- ApplyDefaults(Result);
- end;
- Function TTargets.AddExampleProgram(AProgramName: String): TTarget;
- begin
- Result:=Add as TTarget;
- Result.Name:=AProgramName;
- Result.TargetType:=ttExampleProgram;
- ApplyDefaults(Result);
- end;
- { TNamedItemList }
- function TNamedItemList.GetNamedItem(Index : Integer): TNamedItem;
- begin
- Result:=TNamedItem(Items[Index]);
- end;
- procedure TNamedItemList.SetNamedItem(Index : Integer; const AValue: TNamedItem);
- begin
- Items[Index]:=AValue;
- end;
- function TNamedItemList.IndexOfName(AName: String): Integer;
- begin
- Result:=Count-1;
- While (Result>=0) and (CompareText(GetNamedItem(Result).Name,AName)<>0) do
- Dec(Result);
- end;
- function TNamedItemList.ItemByName(ANAme: String): TNamedItem;
- Var
- I : Integer;
- begin
- I:=IndexOfName(AName);
- If (I=-1) Then
- Raise ECollectionError.CreateFmt(SErrNoSuchName,[AName]);
- Result:=TNamedItem(Items[i]);
- end;
- { TDefaults }
- procedure TDefaults.SetCPU(const AValue: TCPU);
- begin
- FCPU:=AValue;
- RecalcTarget;
- end;
- function TDefaults.GetBaseInstallDir: String;
- begin
- If (FBaseInstallDir<>'') then
- Result:=FBaseInstallDir
- else
- if UnixPaths then
- Result:=Prefix+PathDelim+'lib'+PathDelim+'fpc'
- else
- Result:=Prefix;
- end;
- function TDefaults.GetBinInstallDir: String;
- begin
- If (FBinInstallDir<>'') then
- Result:=FBinInstallDir
- else
- If UnixPaths then
- Result:=BaseInstallDir+PathDelim+'bin'
- else
- Result:=BaseInstallDir+PathDelim+'bin';
- end;
- function TDefaults.GetCompiler: String;
- begin
- If (FCompiler<>'') then
- Result:=FCompiler
- else
- Case CPU of
- i386 : Result:='ppc386';
- PowerPC : Result:='ppcppc';
- sparc : Result:='ppcsparc';
- arm : Result:='ppcarm';
- x86_64 : Result:='ppcx64';
- end;
- end;
- function TDefaults.GetDocInstallDir: String;
- begin
- If (FBinInstallDir<>'') then
- Result:=FBinInstallDir
- else
- If UnixPaths then
- Result:=Prefix+PathDelim+'share'+PathDelim+'docs'
- else
- Result:=BaseInstallDir+PathDelim+'docs';
- end;
- function TDefaults.GetExamplesInstallDir: String;
- begin
- If (FExamplesInstallDir<>'') then
- Result:=FExamplesInstallDir
- else
- If UnixPaths then
- Result:=Prefix+PathDelim+'share'+PathDelim+'docs'+PathDelim+'examples'
- else
- Result:=BaseInstallDir+PathDelim+'examples';
- end;
- function TDefaults.GetUnitInstallDir: String;
- begin
- If (FUnitInstallDir<>'') then
- Result:=FBinInstallDir
- else
- If UnixPaths then
- Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target
- else
- Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target;
- end;
- procedure TDefaults.SetBaseInstallDir(const AValue: String);
- begin
- FBaseInstallDir:=AValue;
- UnitInstallDir:='';
- BinInstallDir:='';
- ExamplesInstallDir:='';
- end;
- procedure TDefaults.SetOS(const AValue: TOS);
- begin
- FOS:=AValue;
- Recalctarget;
- end;
- procedure TDefaults.SetPrefix(const AValue: String);
- begin
- if FPrefix=AValue then exit;
- FPrefix:=AValue;
- BaseInstallDir:='';
- end;
- procedure TDefaults.SetTarget(const AValue: String);
- Var
- P : Integer;
- begin
- if FTarget<>AValue then
- begin
- P:=Pos('-',AValue);
- If (P<>0) then
- begin
- FOS:=StringToOS(System.Copy(Avalue,P+1,Length(AValue)-P));
- FCPU:=StringToCPU(System.Copy(Avalue,1,P-1));
- end
- else
- FOS:=StringToOS(AValue);
- FTarget:=AValue;
- end;
- end;
- procedure TDefaults.RecalcTarget;
- begin
- Ftarget:=CPUToString(FCPU)+'-'+OStoString(FOS);
- end;
- constructor TDefaults.Create;
- begin
- InitDefaults;
- end;
- procedure TDefaults.InitDefaults;
- begin
- {$ifdef unix}
- UnixPaths:=True;
- {$else}
- UnixPaths:=False;
- {$endif}
- // Code to init defaults for compiled platform.
- CPU:=StringToCPU({$I %FPCTARGETCPU%});
- OS:=StringToOS({$I %FPCTARGETOS%});
- Compiler:='ppc386';
- end;
- procedure TDefaults.Assign(ASource: TPersistent);
- Var
- d : TDefaults;
- begin
- If ASource is TDefaults then
- begin
- D:=ASource as TDefaults;
- FArchive:=D.Farchive;
- FCompiler:=D.Compiler;
- FCopy:=D.FCopy;
- FCPU:=D.FCPU;
- FMode:=D.FMode;
- FDownload:=D.FDownload;
- FMkDir:=D.FDownload;
- FMove:=D.FDownload;
- FOptions:=D.FOptions;
- FOS:=D.FOS;
- FPrefix:=D.FPrefix;
- FBaseInstallDir:=D.FBaseInstallDir;
- FUnitInstallDir:=D.FUnitInstallDir;
- FBinInstallDir:=D.FBinInstallDir;
- FDocInstallDir:=D.FDocInstallDir;
- FExamplesInstallDir:=D.FExamplesInstallDir;
- FRemove:=D.FRemove;
- FTarget:=D.FTarget;
- FUnixPaths:=D.FUnixPaths;
- end;
- end;
- procedure TDefaults.LocalInit(Const AFileName : String);
- Var
- FN : String;
- begin
- FN:=AFileName;
- If (FN='') then
- begin
- // Environment variable.
- FN:=GetEnvironmentVariable('FPMAKECFG');
- If (FN<>'') then
- If not FileExists(FN) then
- FN:='';
- // User config file fpmake.cfg
- If (FN='') then
- begin
- FN:=GetAppConfigFile(False);
- If Not FileExists(FN) then
- FN:='';
- end;
- // Global config file fpmake.cfg
- If (FN='') then
- begin
- FN:=GetAppConfigFile(True);
- If Not FileExists(FN) then
- FN:='';
- end;
- end;
- If (FN<>'') and FileExists(FN) then
- LoadFromFile(FN)
- // Code to find local config file and load it using LoadFromFile.
- end;
- procedure TDefaults.LoadFromFile(Const AFileName: String);
- Var
- F : TFileStream;
- begin
- F:=TFileStream.Create(AFileName,fmOpenRead);
- Try
- LoadFromStream(F);
- Finally
- F.Free;
- end;
- end;
- procedure TDefaults.SaveToFile(Const AFileName: String);
- Var
- F : TFileStream;
- begin
- F:=TFileStream.Create(AFileName,fmCreate);
- Try
- SaveToStream(F);
- Finally
- F.Free;
- end;
- end;
- procedure TDefaults.SaveToStream(S : TStream);
- Var
- L : TStringList;
- begin
- L:=TStringList.Create;
- try
- With L do
- begin
- Values[KeyArchive]:=FArchive;
- Values[KeyCompiler]:=FCompiler;
- Values[KeyCopy]:=FCopy;
- Values[KeyDownLoad]:=FDownload;
- Values[KeyMkDir]:=FMkDir;
- Values[KeyMove]:=FMove;
- Values[KeyOptions]:=FOptions;
- Values[KeyCPU]:=CPUToString(FCPU);
- Values[KeyOS]:=OSToString(FOS);
- Values[KeyMode]:=ModeToString(FMode);
- Values[KeyPrefix]:=FPrefix;
- Values[KeyBaseInstallDir]:=FBaseInstallDir;
- Values[KeyUnitInstallDir]:=FUnitInstallDir;
- Values[KeyBinInstallDir]:=FBinInstallDir;
- Values[KeyDocInstallDir]:=FDocInstallDir;
- Values[KeyExamplesInstallDir]:=FExamplesInstallDir;
- Values[KeyRemove]:=FRemove;
- Values[KeyTarget]:=FTarget;
- end;
- L.SaveToStream(S);
- Finally
- L.Free;
- end;
- end;
- procedure TDefaults.LoadFromStream(S: TStream);
- Var
- L : TStrings;
- Line : String;
- I,P,PC : Integer;
-
-
- begin
- L:=TStringList.Create;
- Try
- L.LoadFromStream(S);
- // Fix lines.
- For I:=L.Count-1 downto 0 do
- begin
- Line:=L[I];
- P:=Pos('=',Line);
- PC:=Pos(';',Line); // Comment line.
- If (P=0) or ((PC<>0) and (PC<P)) then
- L.Delete(I)
- else
- L[i]:=Trim(System.Copy(Line,1,P-1)+'='+Trim(System.Copy(Line,P+1,Length(Line)-P)));
- end;
- With L do
- begin
- FArchive:=Values[KeyArchive];
- FCompiler:=Values[KeyCompiler];
- FDownload:=Values[KeyDownLoad];
- FCopy:=Values[KeyCopy];
- FMkDir:=Values[KeyMkDir];
- FMove:=Values[KeyMove];
- FRemove:=Values[KeyRemove];
- FOptions:=Values[KeyOptions];
- Line:=Values[KeyCPU];
- If (Line<>'') then
- FCPU:=StringToCPU(Line);
- Line:=Values[KeyOS];
- If (Line<>'') then
- FOS:=StringToOS(Line);
- Line:=Values[KeyMode];
- If (Line<>'') then
- FMode:=StringToMode(Line);
- FTarget:=Values[KeyTarget];
- FPrefix:=Values[KeyPrefix];
- FBaseInstallDir:=Values[KeyBaseInstallDir];
- FUnitInstallDir:=Values[KeyUnitInstallDir];
- FBinInstallDir:=Values[KeyBinInstallDir];
- FDocInstallDir:=Values[KeyDocInstallDir];
- FExamplesInstallDir:=Values[KeyExamplesInstallDir];
- end;
- Finally
- L.Free;
- end;
- end;
- { TPackage }
- function TPackage.GetHasStrings(AIndex: integer): Boolean;
- begin
- Result:=False;
- Case AIndex Of
- 0 : Result:=FUnitPath<>Nil;
- 1 : Result:=FObjectPath<>Nil;
- 2 : Result:=FIncludePath<>Nil;
- 3 : Result:=FDependencies<>Nil;
- 4 : Result:=FInstallFiles<>Nil;
- 5 : Result:=FCleanFiles<>Nil;
- 6 : Result:=FArchiveFiles<>Nil;
- end;
- end;
- function TPackage.GetCommands: TCommands;
- begin
- If Not Assigned(FCommands) then
- FCommands:=TCommands.Create(TCommand);
- Result:=FCommands;
- end;
- function TPackage.GetHasCommands: Boolean;
- begin
- Result:=Assigned(FCommands);
- end;
- function TPackage.GetStrings(AIndex: integer): TStrings;
- Function EnsureStrings(Var S : TStrings) : TStrings;
- begin
- If (S=Nil) then
- S:=TStringList.Create;
- Result:=S;
- end;
- begin
- Result:=Nil;
- Case AIndex Of
- 0 : Result:=EnsureStrings(FUnitPath);
- 1 : Result:=EnsureStrings(FObjectPath);
- 2 : Result:=EnsureStrings(FIncludePath);
- 3 : begin
- Result:=EnsureStrings(FDependencies);
- With TStringList(Result) do
- if (Count=0) then
- begin
- Sorted:=True;
- Duplicates:=dupError;
- end;
- end;
- 4 : Result:=EnsureStrings(FInstallFiles);
- 5 : Result:=EnsureStrings(FCleanFiles);
- 6 : Result:=EnsureStrings(FArchiveFiles);
- end;
- end;
- procedure TPackage.SetCommands(const AValue: TCommands);
- begin
- Commands.Assign(AValue);
- end;
- procedure TPackage.SetStrings(AIndex: integer; const AValue: TStrings);
- begin
- GetStrings(AIndex).Assign(AValue);
- end;
- constructor TPackage.Create(ACollection: TCollection);
- Var
- L : TStringList;
- begin
- inherited Create(ACollection);
- FTargets:=TTargets.Create(TTarget);
- L:=TStringList.Create;
- FDependencies:=L;
- FInstallFiles:=TStringList.Create;
- FCleanFiles:=TStringList.Create;
- FArchiveFiles:=TStringList.Create;
- end;
- destructor TPackage.destroy;
- begin
- FreeAndNil(FDependencies);
- FreeAndNil(FInstallFiles);
- FreeAndNil(FCleanFiles);
- FreeAndNil(FArchiveFiles);
- FreeAndNil(FIncludePath);
- FreeAndNil(FObjectPath);
- FreeAndNil(FUnitPath);
- FreeAndNil(FTargets);
- inherited destroy;
- end;
- function TPackage.AddTarget(AName: String): TTarget;
- begin
- Result:=Targets.Add as TTarget;
- Result.Name:=AName;
- end;
- procedure TPackage.AddDependency(AName: String);
- begin
- If FDependencies.IndexOf(AName)=-1 then
- FDependencies.Add(AName);
- end;
- procedure TPackage.AddInstallFile(AFileName: String);
- begin
- FInstallFiles.add(AFileName);
- end;
- procedure TPackage.GetCleanFiles(List: TStrings; Const APrefix : String; AOS : TOS);
- Var
- I : Integer;
- begin
- AddStrings(List,CleanFiles,APrefix);
- For I:=0 to FTargets.Count-1 do
- FTargets.TargetItems[I].GetCleanFiles(List,APrefix,AOS);
- end;
- procedure TPackage.GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS);
- Var
- I : Integer;
- T : TTarget;
- begin
- AddStrings(List,InstallFiles,APrefix);
- For I:=0 to FTargets.Count-1 do
- begin
- T:=FTargets.TargetItems[I];
- if (T.TargetType in Types) then
- T.GetInstallFiles(List,APrefix,AOS);
- end;
- end;
- procedure TPackage.GetArchiveFiles(List: TStrings;Const APrefix : String; AOS : TOS);
- Var
- I : Integer;
- begin
- If (OS=[]) or (AOS in OS) then
- begin
- AddStrings(List,ArchiveFiles,APrefix);
- For I:=0 to FTargets.Count-1 do
- FTargets.TargetItems[I].GetArchiveFiles(List,APrefix,AOS);
- end;
- end;
- { TPackages }
- function TPackages.GetPackage(AName : String): TPackage;
- begin
- Result:=TPackage(ItemByName(AName))
- end;
- function TPackages.GetPackageItem(AIndex : Integer): TPackage;
- begin
- Result:=TPackage(Items[AIndex]);
- end;
- procedure TPackages.SetPackageItem(AIndex : Integer; const AValue: TPackage);
- begin
- Items[AIndex]:=AValue;
- end;
- function TPackages.AddPackage(const AName: String): TPackage;
- begin
- Result:=Add as TPackage;
- Result.Name:=AName;
- end;
- { TInstaller }
- function TInstaller.GetStrings(AIndex : Integer): TStrings;
- begin
- CheckDefaultPackage;
- Case AIndex of
- 0: Result:=DefaultPackage.Dependencies;
- 1: Result:=DefaultPackage.InstallFiles;
- 2: Result:=DefaultPackage.CleanFiles;
- 3: Result:=DefaultPackage.ArchiveFiles;
- end;
- end;
- function TInstaller.GetDirectory: String;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.Directory;
- end;
- function TInstaller.GetLicense: String;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.License;
- end;
- function TInstaller.GetOSes: TOSes;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.OS;
- end;
- function TInstaller.GetOptions: String;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.Options;
- end;
- function TInstaller.GetAuthor: String;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.Author;
- end;
- function TInstaller.GetTargets: TTargets;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.Targets;
- end;
- function TInstaller.GetURL: String;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.URL;
- end;
- function TInstaller.GetVersion: String;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.Version;
- end;
- procedure TInstaller.SetAuthor(const AValue: String);
- begin
- CheckDefaultPackage;
- DefaultPackage.Author:=AValue;
- end;
- procedure TInstaller.SetDefaultPackage(const AValue: TPackage);
- begin
- if FDefaultPackage=AValue then exit;
- FDefaultPackage:=AValue;
- end;
- procedure TInstaller.SetDefaults(const AValue: TDefaults);
- begin
- FDefaults.Assign(AValue);
- end;
- procedure TInstaller.SetStrings(AIndex : Integer; const AValue: TStrings);
- Var
- Res : TStrings;
- begin
- CheckDefaultPackage;
- Case AIndex of
- 0: Res:=DefaultPackage.Dependencies;
- 1: Res:=DefaultPackage.InstallFiles;
- 2: Res:=DefaultPackage.CleanFiles;
- 3: Res:=DefaultPackage.ArchiveFiles;
- end;
- Res.Assign(Avalue);
- end;
- procedure TInstaller.SetDirectory(const AValue: String);
- begin
- CheckDefaultPackage;
- DefaultPackage.Directory:=AValue;
- end;
- procedure TInstaller.SetOptions(const AValue: String);
- begin
- CheckDefaultPackage;
- DefaultPackage.Options:=AValue;
- end;
- procedure TInstaller.SetOses(const AValue: TOSes);
- begin
- CheckDefaultPackage;
- DefaultPackage.OS:=AValue;
- end;
- procedure TInstaller.SetURL(const AValue: String);
- begin
- CheckDefaultPackage;
- DefaultPackage.URL:=AValue;
- end;
- procedure TInstaller.SetVersion(const AValue: String);
- begin
- CheckDefaultPackage;
- DefaultPackage.Version:=AValue;
- end;
- procedure TInstaller.SetLicense(const AValue: String);
- begin
- CheckDefaultPackage;
- DefaultPackage.License:=AValue;
- end;
- procedure TInstaller.Log(Level: TVerboseLevel; const Msg: String);
- begin
- If Level in FLogLevels then
- Writeln(StdErr,Msg);
- end;
- procedure TInstaller.CreatePackages;
- begin
- FPAckages:=TPackages.Create(TPackage);
- end;
- procedure TInstaller.CreateBuildEngine;
- begin
- FBuildEngine:=TBuildEngine.Create(Self);
- FBuildEngine.Defaults:=Defaults;
- FBuildEngine.ListMode:=FListMode;
- FBuildEngine.OnLog:[email protected];
- end;
- procedure TInstaller.CheckDefaultPackage;
- begin
- If (FDefaultPackage=Nil) then
- Raise EInstallerError.Create(SErrNoPackage);
- end;
- procedure TInstaller.Error(Msg: String);
- begin
- Raise EInstallerError.Create(Msg);
- end;
- procedure TInstaller.Error(Fmt: String; Args: array of const);
- begin
- Raise EInstallerError.CreateFmt(Fmt,Args);
- end;
- Function TInstaller.StartPackage(const AName: String) : TPackage;
- begin
- FDefaultPackage:=FPackages.AddPackage(AName);
- Result:=FDefaultPackage;
- end;
- procedure TInstaller.EndPackage;
- begin
- FDefaultPackage:=Nil;
- end;
- procedure TInstaller.AnalyzeOptions;
- Function CheckOption(Index : Integer;Short,Long : String): Boolean;
- var
- O : String;
- begin
- O:=Paramstr(Index);
- Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
- end;
- Function OptionArg(Var Index : Integer) : String;
- Var
- P : Integer;
- begin
- if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then
- begin
- If Index<ParamCount then
- begin
- Inc(Index);
- Result:=Paramstr(Index);
- end
- else
- Error(SErrNeedArgument,[Index,ParamStr(Index)]);
- end
- else If length(ParamStr(Index))>2 then
- begin
- P:=Pos('=',Paramstr(Index));
- If (P=0) then
- Error(SErrNeedArgument,[Index,ParamStr(Index)])
- else
- begin
- Result:=Paramstr(Index);
- Delete(Result,1,P);
- end;
- end;
- end;
- Var
- I : Integer;
- Nodefaults : Boolean;
- DefaultsFileName : string;
- begin
- I:=0;
- NoDefaults:=False;
- FListMode:=False;
- While (I<ParamCount) do
- begin
- Inc(I);
- if Checkoption(I,'m','compile') then
- FRunMode:=rmCompile
- else if Checkoption(I,'b','build') then
- FRunMode:=rmBuild
- else if CheckOption(I,'i','install') then
- FRunMode:=rmInstall
- else if CheckOption(I,'c','clean') then
- FRunMode:=rmClean
- else if CheckOption(I,'a','archive') then
- FRunMode:=rmarchive
- else if CheckOption(I,'d','download') then
- FRunMode:=rmDownload
- else if CheckOption(I,'h','help') then
- FRunMode:=rmhelp
- else if Checkoption(I,'C','CPU') then
- Defaults.CPU:=StringToCPU(OptionArg(I))
- else if Checkoption(I,'O','OS') then
- Defaults.OS:=StringToOS(OptionArg(I))
- else if Checkoption(I,'t','target') then
- Defaults.Target:=OptionArg(I)
- else if CheckOption(I,'l','list-commands') then
- FListMode:=True
- else if Checkoption(I,'P','prefix') then
- Defaults.Prefix:=OptionArg(I)
- else if Checkoption(I,'n','nodefaults') then
- NoDefaults:=true
- else if CheckOption(I,'b','baseinstalldir') then
- Defaults.BaseInstallDir:=OptionArg(I)
- else if CheckOption(I,'r','compiler') then
- Defaults.Compiler:=OptionArg(I)
- else if CheckOption(I,'f','config') then
- DefaultsFileName:=OptionArg(I)
- else if CheckOption(I,'v','verbose') then
- begin
- Try
- FLogLevels:=TVerboseLevels(StringToSet(PtypeInfo(TypeInfo(TVerboseLevels)),OptionArg(I)));
- except
- FLogLevels:=AllMessages;
- end;
- end
- else
- begin
- Usage(SErrInValidArgument,[I,ParamStr(I)]);
- end;
- end;
- If Not NoDefaults then
- Defaults.LocalInit(DefaultsFileName);
- {$ifdef debug}
- FLogLevels:=AllMessages;
- {$endif}
- end;
- procedure TInstaller.Usage(FMT: String; Args: array of const);
- begin
- If (FMT<>'') then
- Writeln(stderr,Format(Fmt,Args));
- Writeln(stderr,ExtractFileName(Paramstr(0)),' usage: ');
- Writeln(stderr,'');
- If (FMT<>'') then
- halt(1);
- end;
- procedure TInstaller.Compile(Force: Boolean);
- begin
- FBuildEngine.ForceCompile:=Force;
- FBuildEngine.Compile(FPackages);
- end;
- procedure TInstaller.Clean;
- begin
- BuildEngine.Clean(FPackages);
- end;
- procedure TInstaller.Install;
- begin
- BuildEngine.Install(FPackages);
- end;
- procedure TInstaller.Archive;
- begin
- FBuildEngine.Archive(FPackages);
- end;
- procedure TInstaller.Download;
- begin
- BuildEngine.Download(FPackages);
- end;
- constructor TInstaller.Create(AOWner: TComponent);
- begin
- inherited Create(AOWner);
- FDefaults:=TDefaults.Create;
- AnalyzeOptions;
- CreatePackages;
- end;
- destructor TInstaller.destroy;
- begin
- FreeAndNil(FDefaults);
- inherited destroy;
- end;
- procedure TInstaller.CheckPackages;
- begin
- If (FPackages.Count=0) then
- Error(SErrNoPackagesDefined);
- // Check for other obvious errors ?
- end;
- Function TInstaller.Run : Boolean;
- begin
- Result:=True;
- try
- If RunMode<>rmHelp then
- begin
- CheckPackages;
- CreateBuildEngine;
- end;
- Case RunMode of
- rmHelp : Usage('',[]);
- rmCompile : Compile(False);
- rmBuild : Compile(True);
- rmInstall : Install;
- rmArchive : Archive;
- rmClean : Clean;
- rmDownload : Download;
- end;
- except
- On E : Exception do
- begin
- Writeln(StdErr,SErrInstaller);
- Writeln(StdErr,E.Message);
- Result:=False;
- end;
- end;
- end;
- function TInstaller.AddTarget(AName: String): TTarget;
- begin
- CheckDefaultPackage;
- Result:=DefaultPackage.AddTarget(AName);
- end;
- procedure TInstaller.AddDependency(AName: String);
- begin
- CheckDefaultPackage;
- DefaultPackage.AddDependency(AName);
- end;
- { TBuildEngine }
- procedure TBuildEngine.SetDefaults(const AValue: TDefaults);
- begin
- FDefaults.Assign(AValue);
- end;
- procedure TBuildEngine.SetTargetDir(const AValue: String);
- begin
- if FTargetDir=AValue then exit;
- FTargetDir:=AValue;
- end;
- procedure TBuildEngine.Error(Msg: String);
- begin
- Raise EInstallerError.Create(Msg);
- end;
- procedure TBuildEngine.Error(Fmt: String; Args: array of const);
- begin
- Raise EInstallerError.CreateFmt(Fmt,Args);
- end;
- constructor TBuildEngine.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FDefaults:=TDefaults.Create;
- // Maybe this should be the current directory ?
- // Or have it as a command-line option.
- // Would allow to put all 'installers' in one dir and call them
- // With --start-dir=/path/to/sources.
- FStartDir:=includeTrailingPathDelimiter(GetCurrentDir);
- end;
- procedure TBuildEngine.ExecuteCommand(Cmd: String; Args : String; IgnoreError : Boolean = False);
- Var
- E : Integer;
- begin
- Log(vlCommand,SLogExecutingCommand,[Cmd,Args]);
- // We should check cmd for spaces, and move all after first space to args.
- E:=ExecuteProcess(cmd,args);
- If (E<>0) and (not IgnoreError) then
- Error(SErrExternalCommandFailed,[Cmd,E]);
- end;
- procedure TBuildEngine.SysCopyFile(Const Src,Dest : String);
- Var
- D,S : String;
- Fin,FOut : TFileStream;
- Count : Int64;
- A : Integer;
-
- begin
- Log(vlCommand,SLogCopyingFile,[Src,Dest]);
- FIn:=TFileStream.Create(Src,fmopenRead);
- Try
- D:=IncludeTrailingPathDelimiter(Dest);
- If DirectoryExists(D) then
- S:=D+ExtractFileName(Src)
- else
- S:=Dest;
- FOut:=TFileStream.Create(S,fmCreate);
- Try
- Count:=Fout.CopyFrom(FIn,0);
- If (Count<>Fin.Size) then
- Error(SErrCopyingFile,[Src,S]);
- Finally
- FreeAndNil(Fout);
- end;
- A:=FileGetDate(FIn.Handle);
- If (A=-1) then
- log(vlWarning,SWarnFailedToGetTime,[Src])
- else
- if FileSetDate(S,A)<>0 then
- Log(vlWarning,SWarnFailedToSetTime,[S]);
- finally
- FreeAndNil(Fin);
- end;
- end;
- procedure TBuildEngine.SysMoveFile(Const Src,Dest : String);
- Var
- S : String;
- begin
- If DirectoryExists(IncludeTrailingPathDelimiter(Dest)) then
- S:=IncludeTrailingPathDelimiter(Dest)+ExtractFileName(Src)
- else
- S:=Dest;
- If Not RenameFile(Src,S) then
- begin
- Try
- SysCopyFile(Src,S);
- SysDeleteFile(Src);
- Except
- On E : Exception Do
- Error(SErrMovingFile,[Src,S]);
- end;
- end;
- end;
- procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
- begin
- if not FileExists(AFileName) then
- Log(vlWarning,SWarnFileDoesNotExist,[AFileName])
- else If Not DeleteFile(AFileName) then
- Error(SErrDeletingFile,[AFileName]);
- end;
- procedure TBuildEngine.SysArchiveFiles(List: TStrings;Const AFileName: String);
- begin
- If Not (Assigned(OnArchivefiles) or Assigned(ArchiveFilesProc)) then
- Raise EInstallerError.Create(SErrNoArchiveSupport);
- If Assigned(ArchiveFilesProc) then
- ArchiveFilesProc(AFileName,List)
- else
- OnArchiveFiles(AFileName,List);
- end;
- procedure TBuildEngine.SysDownloadFile(const AURL, ALocalFileName: String);
- begin
- If Not (Assigned(OnDownloadfile) or Assigned(DownloadFileProc)) then
- Raise EInstallerError.Create(SErrNoDownloadSupport);
- If Assigned(DownloadFileProc) then
- DownloadFileProc(AURL,ALocalFileName)
- else
- OnDownloadFile(AURL,ALocalFileName);
- end;
- procedure TBuildEngine.Log(Level: TVerboseLevel; const Msg: String);
- begin
- If Assigned(FOnLog) then
- FOnLog(Level,Msg);
- end;
- procedure TBuildEngine.Log(Level: TVerboseLevel; const Fmt: String;
- Args: array of const);
- begin
- Log(Level,Format(Fmt,Args));
- end;
- procedure TBuildEngine.EnterDir(ADir: String);
- Var
- D : String;
- begin
- D:=FStartDir;
- D:=D+ADir;
- Log(vlInfo,SLogEnterDir,[D]);
- If Not SetCurrentDir(D) then
- Error(SErrChangeDirFailed,[D]);
- end;
- procedure TBuildEngine.CmdCopyFiles(List: TStrings; Const DestDir: String);
- Var
- Args : String;
- I : Integer;
- begin
- CmdCreateDir(DestDir);
- If (Defaults.Copy<>'') then
- begin
- Args:=FileListToString(List,'');
- Args:=Args+' '+DestDir;
- ExecuteCommand(Defaults.Copy,Args);
- end
- else
- For I:=0 to List.Count-1 do
- SysCopyFile(List[i],DestDir);
- end;
- procedure TBuildEngine.CmdCreateDir(DestDir: String);
- begin
- If (Defaults.MkDir<>'') then
- ExecuteCommand(Defaults.MkDir,DestDir)
- else
- If not ForceDirectories(DestDir) then
- Error(SErrCreatingDirectory,[DestDir]);
- end;
- procedure TBuildEngine.CmdMoveFiles(List: TStrings; Const DestDir: String);
- Var
- Args : String;
- I : Integer;
- begin
- CmdCreateDir(DestDir);
- If (Defaults.Move<>'') then
- begin
- Args:=FileListToString(List,'');
- Args:=Args+' '+DestDir;
- ExecuteCommand(Defaults.Move,Args);
- end
- else
- For I:=0 to List.Count-1 do
- SysMoveFile(List[i],DestDir);
- end;
- procedure TBuildEngine.CmdDeleteFiles(List: TStrings);
- Var
- Args : String;
- I : Integer;
- begin
- If (Defaults.Remove<>'') then
- begin
- Args:=FileListToString(List,'');
- ExecuteCommand(Defaults.Remove,Args);
- end
- else
- For I:=0 to List.Count-1 do
- SysDeleteFile(List[i]);
- end;
- procedure TBuildEngine.CmdArchiveFiles(List: TStrings; Const ArchiveFile: String);
- Var
- S,C,O : String;
- begin
- If (Defaults.Archive='') then
- SysArchiveFiles(List,ArchiveFile)
- else
- begin
- S:=FileListToString(List,'');
- SplitCommand(Defaults.Archive,C,O);
- If (O='') then
- O:=ArchiveFile+' '+S
- else
- O:=Substitute(O,['ARCHIVE',ArchiveFile,'FILESORDIRS']);
- ExecuteCommand(C,O);
- end;
- end;
- Function TBuildEngine.FileNewer(Src,Dest : String) : Boolean;
- Var
- DS,DD : Longint;
- D1,D2 : TDateTime;
-
- begin
- DS:=FileAge(Src);
- DD:=FileAge(Dest);
- D1:=FileDateToDateTime(DS);
- D2:=FileDateToDateTime(DD);
- Log(vlDebug,SLogCompilingFileTimes,[Src,DateTimeToStr(D1),Dest,DateTimeToStr(D2)]);
- Result:=D1>=D2;
- If Result then
- Log(vlCompare,SLogSourceNewerDest,[Src,DateTimeToStr(D1),Dest,DateTimeToStr(D2)]);
- end;
- procedure TBuildEngine.ExecuteCommands(Commands: TCommands; At: TCommandAt);
- Var
- C : TCommand;
- I : Integer;
- Cmd,O : String;
- E : Boolean;
-
- begin
- For I:=0 to Commands.Count-1 do
- begin
- C:=Commands.CommandItems[i];
- if (C.At=At) then
- begin
- E:=True;
- If (C.SourceFile<>'') and (C.DestFile<>'') then
- E:=FileNewer(C.SourceFile,IncludeTrailingPathDelimiter(Dictionary.GetValue('OUTPUTDIR'))+C.DestFile);
- If E then
- begin
- If Assigned(C.BeforeCommand) then
- C.BeforeCommand(C);
- O:=Substitute(C.Options,['SOURCE',C.SourceFile,'DEST',C.DestFile]);
- Cmd:=C.Command;
- If (ExtractFilePath(Cmd)='') then
- Cmd:=FileSearch(Cmd,GetEnvironmentvariable('PATH'));
- ExecuteCommand(Cmd,O,C.IgnoreResult);
- If Assigned(C.AfterCommand) then
- C.AfterCommand(C);
- end;
- end;
- end;
- end;
- // Relative to startdir.
- Function TBuildEngine.GetTargetDir(APackage : TPackage; ATarget : TTarget; AbsolutePath : Boolean = False) : String;
- begin
- If AbsolutePath then
- Result:=IncludeTrailingPathDelimiter(FStartDir)
- else
- Result:='';
- If (APackage.Directory<>'') then
- Result:=Result+IncludeTrailingPathDelimiter(APackage.Directory);
- If (ATarget.Directory<>'') then
- Result:=IncludeTrailingPathDelimiter(Result+ATarget.Directory);
- end;
- Function TBuildEngine.TargetOK(Target : TTarget) : Boolean;
- begin
- Result:=(Target.TargetType in [ttUnit,ttProgram])
- and
- ((Target.CPU=[]) or (Defaults.CPU in Target.CPU))
- and
- ((Target.OS=[]) or (Defaults.OS in Target.OS));
- If not Result then
- begin
- log(vldebug,'Target is not a unit or program');
- If Not ((Target.CPU=[]) or (Defaults.CPU in Target.CPU)) then
- Log(vldebug,'Target has wrong CPU: '+CPUsToString(Target.CPU));
- if not ((Target.OS=[]) or (Defaults.OS in Target.OS)) then
- Log(vldebug,'Target has wrong OS: '+OSesToString(Target.OS));
- end;
- end;
- Function TBuildEngine.NeedsCompile(Target: TTarget): Boolean;
- Var
- I : Integer;
- T : TTarget;
- OD,SD,SFN,OFN : String;
- begin
- Result:=False;
- OD:=FCurrentOutputDir;
- If (OD<>'') then
- OD:=IncludeTrailingPathDelimiter(OD);
- OFN:=OD+Target.GetOutPutFileName(Defaults.OS);
- SD:=Target.Directory;
- If (SD<>'') then
- SD:=IncludeTrailingPathDelimiter(SD);
- Result:=Not FileExists(OFN);
- // Check dependencies
- If not Result then
- If Target.HasDependencies then
- begin
- ResolveDependencies(Target.Dependencies,Target.Collection as TTargets);
- I:=0;
- While (Not Result) and (I<Target.Dependencies.Count) do
- begin
- T:=TTarget(Target.Dependencies.Objects[i]);
- If (T<>Nil) then
- Result:=NeedsCompile(T)
- else // if it is a filename, check dates.
- if FileExists(Target.Dependencies[i]) then
- Result:=FileNewer(Target.Dependencies[i],OFN)
- else if FileExists(SD+Target.Dependencies[i]) then
- Result:=FileNewer(SD+Target.Dependencies[i],OFN);
- Inc(I)
- end;
- end;
- If not Result then
- begin
- SFN:=SD+Target.SourceFileName;
- If (ExtractFileExt(SFN)='') then
- if FileExists(SFN+'.pp') then
- SFN:=SFN+'.pp'
- else
- SFN:=SFN+'.pas';
- // Writeln('Checking : ',OFN,' against ',SFN);
- Result:=FileNewer(SFN,OFN);
- // here we should check file timestamps.
- end;
- end;
- Function TBuildEngine.GetCompilerCommand(APackage : TPackage; Target : TTarget) : String;
- Var
- PD,TD,OD,RD : String;
- begin
- PD:=IncludeTrailingPathDelimiter(GetPackageDir(APackage,True));
- OD:=IncludeTrailingPathDelimiter(GetOutputDir(APackage,True));
- RD:=ExtractRelativePath(PD,OD);
- If Target.TargetType in ProgramTargets then
- Result:='-FE.' // Make this relative to target directory.
- else
- Result:='-FU'+RD;
- If Target.Mode<>fpc then
- Result:=Result+' -M'+ModeToString(Target.Mode)
- else If Defaults.Mode<>fpc then
- Result:=Result+' -M'+ModeToString(Defaults.Mode);
- If (Defaults.Options<>'') then
- Result:=Result+' '+Defaults.Options;
- If (APackage.Options<>'') then
- Result:=Result+' '+APackage.Options;
- If APackage.HasUnitPath then
- AddStrings(Result,APackage.UnitPath,'-Fu');
- If APackage.HasIncludePath then
- AddStrings(Result,APackage.IncludePath,'-Fi');
- If APackage.HasObjectPath then
- AddStrings(Result,APackage.ObjectPath,'-Fo');
- If Target.HasUnitPath then
- AddStrings(Result,Target.UnitPath,'-Fu');
- If Target.HasIncludePath then
- AddStrings(Result,Target.IncludePath,'-Fi');
- If Target.HasObjectPath then
- AddStrings(Result,Target.ObjectPath,'-Fo');
- If (Target.Options<>'') then
- Result:=Result+' '+Target.Options;
- TD:=Target.Directory;
- if (TD<>'') then
- TD:=IncludeTrailingPathDelimiter(TD);
- Result:=Result+' '+TD+Target.SourceFileName;
- end;
- Function TBuildEngine.GetCompiler : String;
- Var
- S : String;
-
- begin
- // Cache in FCompiler for speed.
- If (FCompiler='') then
- begin
- FCompiler:=Defaults.Compiler;
- If (ExtractFilePath(FCompiler)='') then
- begin
- S:=FileSearch(FCompiler,GetEnvironmentVariable('PATH'));
- If (S<>'') then
- FCompiler:=S;
- end;
- end;
- Result:=FCompiler;
- end;
- procedure TBuildEngine.Compile(Target: TTarget);
- Var
- S : String;
-
- begin
- if Target.State in [tsNeutral,tsCompiling] then
- begin
- Log(vlInfo,SLogCompilingTarget,[Target.Name]);
- If Target.HasCommands then
- ExecuteCommands(Target.Commands,caBeforeCompile);
- If Assigned(Target.BeforeCompile) then
- Target.BeforeCompile(Target);
- S:=GetCompilerCommand(FCurrentPackage,Target);
- ExecuteCommand(GetCompiler,S);
- Target.FTargetState:=tsCompiled;
- If Assigned(Target.AfterCompile) then
- Target.AfterCompile(Target);
- If Target.HasCommands then
- ExecuteCommands(Target.Commands,caAfterCompile);
- end
- else if Target.State<>tsCompiled then
- Log(vlWarning,'Attempting to compile non-neutral target: '+Target.Name);
- end;
- procedure TBuildEngine.FixDependencies(Target: TTarget);
- Var
- I : Integer;
- T : TTarget;
- begin
- Log(vlDebug,'Checking dependencies for target: '+Target.Name);
- ResolveDependencies(Target.Dependencies,Target.Collection as TTargets);
- If Target.HasDependencies then
- For I:=0 to Target.Dependencies.Count-1 do
- begin
- T:=TTarget(Target.Dependencies.Objects[i]);
- If Assigned(T) then
- begin
- If (T.State=tsCompiling) then
- Log(vlWarning,SWarnCircularDependency,[Target.Name,T.Name])
- else
- Compile(T)
- end
- else if Not FileExists(Target.Dependencies[i]) then
- Error(SErrDepUnknownTarget,[Target.Name,Target.Dependencies[i]]);
- end;
- end;
- function TBuildEngine.GetPackageDir(APackage: TPackage; AbsolutePath: Boolean
- ): String;
- begin
- If AbsolutePath then
- Result:= IncludeTrailingPathDelimiter(FStartDir)
- else
- Result:='';
- Result:=Result+APackage.Directory;
- If (Result<>'') then
- Result:= ExcludeTrailingPathDelimiter(Result)
- end;
- Function TBuildEngine.GetOutputDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
- begin
- If (TargetDir<>'') then
- Result:=TargetDir
- else
- begin
- If AbsolutePath then
- Result:=IncludeTrailingPathDelimiter(FStartDir)
- else
- Result:='';
- If (APackage.Directory<>'') then
- Result:=IncludeTrailingPathDelimiter(Result+APackage.Directory);
- Result:=Result+'units'+PathDelim+Defaults.Target;
- end;
- end;
- procedure TBuildEngine.CreateOutputDir(APackage: TPackage);
- Var
- D : String;
- begin
- D:=GetOutputDir(APackage,True);
- If DirectoryExists(D) then
- Log(vlInfo,SLogOutputDirExists,[D])
- else
- begin
- Log(vlInfo,SLogCreatingOutputDir,[D]);
- CmdCreateDir(D);
- end;
- end;
- Function TBuildEngine.PackageOK(APackage : TPackage) : Boolean;
- begin
- Result:=((APackage.CPU=[]) or (Defaults.CPU in APackage.CPU))
- and
- ((APAckage.OS=[]) or (Defaults.OS in APackage.OS));
- end;
- procedure TBuildEngine.DoBeforeCompile(APackage: TPackage);
- begin
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caBeforeCompile);
- If Assigned(APackage.BeforeCompile) then
- APackage.BeforeCompile(APackage);
- end;
- procedure TBuildEngine.DoAfterCompile(APackage: TPackage);
- begin
- If Assigned(APackage.AfterCompile) then
- APackage.AfterCompile(APackage);
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caAfterCompile);
- end;
- procedure TBuildEngine.Compile(APackage: TPackage);
- Var
- T : TTarget;
- I : Integer;
-
- begin
- Log(vlInfo,SLogCompilingPackage,[APackage.Name]);
- FCurrentPackage:=APackage;
- FCurrentOutputDir:=GetOutputDir(APackage,True);
- Try
- If (APackage.Directory<>'') then
- EnterDir(APackage.Directory);
- CreateOutputDir(APackage);
- Dictionary.AddVariable('OUTPUTDIR',FCurrentOutputDir);
- DoBeforeCompile(APackage);
- Try
- For I:=0 to APackage.Targets.Count-1 do
- begin
- T:=APackage.Targets.TargetItems[i];
- Log(vlDebug,'Considering target: '+T.Name);
- If TargetOK(T) then
- If (T.State=tsNeutral) then
- begin
- If (FForceCompile or NeedsCompile(T)) then
- begin
- T.FTargetState:=tsCompiling;
- FixDependencies(T);
- Compile(T);
- end;
- T.FTargetState:=tsCompiled;
- end;
- end;
- DoAfterCompile(APackage);
- Finally
- If (APackage.Directory<>'') then
- EnterDir('');
- end;
- Finally
- FCurrentPackage:=Nil;
- FCurrentOutputDir:='';
- end;
- end;
- procedure TBuildEngine.CheckExternalPackage(Const APackageName : String);
- begin
- // A check needs to be implemented here.
- Log(vldebug,'Unresolved external dependency : %s',[APackageName]);
- end;
- procedure TBuildEngine.FixDependencies(APackage: TPackage);
- Var
- I : Integer;
- P : TPackage;
- begin
- if APackage.HasDependencies then
- For I:=0 to APAckage.Dependencies.Count-1 do
- begin
- P:=TPackage(Apackage.Dependencies.Objects[i]);
- If Assigned(P) then
- Compile(P) // If it already was compiled, then State<>tsNeutral, and it won't be compiled again.
- else
- CheckExternalPackage(Apackage.Dependencies[i]);
- end;
- end;
- Procedure TBuildEngine.InstallPackageFiles(APAckage : TPackage; tt : TTargetType; Const Src,Dest : String);
- Var
- I : Integer;
- List : TStringList;
- begin
- List:=TStringList.Create;
- Try
- APackage.GetInstallFiles(List,[tt],Src,Defaults.OS);
- if (List.Count>0) then
- CmdCopyFiles(List,Dest);
- Finally
- List.Free;
- end;
- end;
- procedure TBuildEngine.DoBeforeInstall(APackage: TPackage);
- begin
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caBeforeInstall);
- If Assigned(APackage.BeforeInstall) then
- APackage.BeforeInstall(APackage);
- end;
- procedure TBuildEngine.DoAfterInstall(APackage: TPackage);
- begin
- If Assigned(APackage.AfterInstall) then
- APackage.AfterInstall(APackage);
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caAfterInstall);
- end;
- procedure TBuildEngine.Install(APackage: TPackage);
- Var
- PD,D,O : String;
- begin
- If (Apackage.State<>tsCompiled) then
- Compile(APackage);
- Log(vlInfo,SLogInstallingPackage,[APackage.Name]);
- DoBeforeInstall(APackage);
- O:=IncludeTrailingPathDelimiter(GetOutputDir(APAckage));
- PD:=IncludeTrailingPathDelimiter(GetPackageDir(APackage));
- // units
- D:=IncludeTrailingPathDelimiter(Defaults.UnitInstallDir)+APackage.Name;
- InstallPackageFiles(APAckage,ttUnit,O,D);
- // Programs
- D:=IncludeTrailingPathDelimiter(Defaults.BinInstallDir);
- InstallPackageFiles(APAckage,ttProgram,PD,D);
- // Done.
- APackage.FTargetState:=tsInstalled;
- DoAfterInstall(APackage);
- end;
- procedure TBuildEngine.DoBeforeArchive(APackage: TPackage);
- begin
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caBeforeArchive);
- If Assigned(APackage.BeforeArchive) then
- APackage.BeforeArchive(APackage);
- end;
- procedure TBuildEngine.DoAfterArchive(APackage: TPackage);
- begin
- If Assigned(APackage.AfterArchive) then
- APackage.AfterArchive(APackage);
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caAfterArchive);
- end;
- procedure TBuildEngine.Archive(APackage: TPackage);
- Var
- L : TStrings;
- A,S,C,O : String;
-
- begin
- Log(vlInfo,SLogArchivingPackage,[APackage.Name]);
- DoBeforeArchive(Apackage);
- L:=TStringList.Create;
- Try
- APackage.GetInstallFiles(L,[ttUnit],TargetDir,Defaults.OS);
- A:=APackage.Name+ZipExt;
- CmdArchiveFiles(L,A);
- Finally
- L.Free;
- end;
- Writeln('Archiving : ',APackage.Name);
- DoAfterArchive(Apackage);
- end;
- procedure TBuildEngine.DoBeforeClean(APackage: TPackage);
- begin
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caBeforeClean);
- If Assigned(APackage.BeforeClean) then
- APackage.BeforeClean(APackage);
- end;
- procedure TBuildEngine.DoAfterClean(APackage: TPackage);
- begin
- If Assigned(APackage.AfterClean) then
- APackage.AfterClean(APackage);
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caAfterClean);
- end;
- procedure TBuildEngine.Clean(APackage: TPackage);
- Var
- O : String;
- List : TStringList;
-
- begin
- Log(vlInfo,SLogCleaningPackage,[APackage.Name]);
- DoBeforeClean(Apackage);
- O:=IncludeTrailingPathDelimiter(GetOutputDir(APAckage));
- List:=TStringList.Create;
- try
- APackage.GetCleanFiles(List,O,Defaults.OS);
- if (List.Count>0) then
- CmdDeleteFiles(List);
- Finally
- List.Free;
- end;
- DoAfterClean(Apackage);
- end;
- procedure TBuildEngine.DoBeforeDownload(APackage: TPackage);
- begin
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caBeforeDownload);
- If Assigned(APackage.BeforeDownload) then
- APackage.BeforeDownload(APackage);
- end;
- procedure TBuildEngine.DoAfterDownload(APackage: TPackage);
- begin
- If Assigned(APackage.AfterDownload) then
- APackage.AfterDownload(APackage);
- If APackage.HasCommands then
- ExecuteCommands(APackage.Commands,caAfterDownload);
- end;
- function TBuildEngine.NeedsCompile(APackage: TPackage): Boolean;
- Var
- I : Integer;
- P : TPackage;
- begin
- ResolveDependencies(APackage.Dependencies,(APackage.Collection as TPackages));
- Result:=False;
- I:=0;
- While (Not Result) and (I<APAckage.Dependencies.Count) do
- begin
- P:=TPackage(APAckage.Dependencies.Objects[i]);
- // I'm not sure whether the target dir is OK here ??
- Result:=Assigned(P) and NeedsCompile(P);
- Inc(I);
- end;
- If Not Result then
- begin
- I:=0;
- While (Not Result) and (I<APackage.Targets.Count) do
- begin
- Result:=NeedsCompile(APackage.Targets.TargetItems[i]);
- Inc(I);
- end;
- end;
- end;
- procedure TBuildEngine.Download(APackage: TPackage);
- begin
- Log(vlInfo,SLogDownloadingPackage,[APackage.Name]);
- DoBeforeDownload(APackage);
- Writeln('Downloading : ',APackage.Name);
- DoAfterDownload(APackage);
- end;
- procedure TBuildEngine.Compile(Packages: TPackages);
- Var
- I : Integer;
- P : TPackage;
- begin
- If Assigned(BeforeCompile) then
- BeforeCompile(Self);
- For I:=0 to Packages.Count-1 do
- begin
- P:=Packages.PackageItems[i];
- If PackageOK(P) then
- If (P.State=tsNeutral) then
- begin
- If (FForceCompile or NeedsCompile(P)) then
- begin
- P.FTargetState:=tsCompiling;
- FixDependencies(P);
- Compile(P);
- end;
- P.FTargetState:=tsCompiled;
- end;
- end;
- If Assigned(AfterCompile) then
- AfterCompile(Self);
- end;
- procedure TBuildEngine.Install(Packages: TPackages);
- Var
- I : Integer;
- P : TPackage;
- begin
- If Assigned(BeforeInstall) then
- BeforeInstall(Self);
- For I:=0 to Packages.Count-1 do
- begin
- P:=Packages.PackageItems[i];
- If PackageOK(P) then
- Install(P);
- end;
- If Assigned(AfterInstall) then
- AfterInstall(Self);
- end;
- procedure TBuildEngine.Archive(Packages: TPackages);
- Var
- I : Integer;
- P : TPackage;
- begin
- If Assigned(BeforeArchive) then
- BeforeArchive(Self);
- Log(vlDebug,'Build engine archiving.');
- For I:=0 to Packages.Count-1 do
- begin
- P:=Packages.PackageItems[i];
- If PackageOK(P) then
- Archive(P);
- end;
- If Assigned(AfterArchive) then
- AfterArchive(Self);
- end;
- procedure TBuildEngine.Clean(Packages: TPackages);
- Var
- I : Integer;
- P : TPackage;
- begin
- If Assigned(BeforeClean) then
- BeforeClean(Self);
- Log(vldebug,'Build engine cleaning.');
- For I:=0 to Packages.Count-1 do
- begin
- P:=Packages.PackageItems[i];
- If PackageOK(P) then
- Clean(P);
- end;
- If Assigned(AfterClean) then
- AfterClean(Self);
- end;
- procedure TBuildEngine.Download(Packages: TPackages);
- Var
- I : Integer;
- P : TPackage;
- begin
- If Assigned(BeforeDownload) then
- BeforeDownload(Self);
- For I:=0 to Packages.Count-1 do
- begin
- P:=Packages.PackageItems[i];
- If PackageOK(P) then
- Download(P);
- end;
- If Assigned(AfterDownload) then
- AfterDownload(Self);
- end;
- { TTarget }
- function TTarget.GetHasStrings(AIndex: integer): Boolean;
- begin
- Result:=False;
- Case AIndex Of
- 0 : Result:=FUnitPath<>Nil;
- 1 : Result:=FObjectPath<>Nil;
- 2 : Result:=FIncludePath<>Nil;
- 3 : Result:=FDependencies<>Nil;
- end;
- end;
- function TTarget.GetCommands: TCommands;
- begin
- If FCommands=Nil then
- FCommands:=TCommands.Create(TCommand);
- Result:=FCommands;
- end;
- function TTarget.GetHasCommands: Boolean;
- begin
- Result:=(FCommands<>Nil);
- end;
- function TTarget.GetStrings(AIndex: integer): TStrings;
- Function EnsureStrings(Var S : TStrings) : TStrings;
- begin
- If (S=Nil) then
- S:=TStringList.Create;
- Result:=S;
- end;
-
- begin
- Result:=Nil;
- Case AIndex Of
- 0 : Result:=EnsureStrings(FUnitPath);
- 1 : Result:=EnsureStrings(FObjectPath);
- 2 : Result:=EnsureStrings(FIncludePath);
- 3 : Result:=EnsureStrings(FDependencies);
- end;
- end;
- procedure TTarget.SetCommands(const AValue: TCommands);
- begin
- end;
- procedure TTarget.SetStrings(AIndex: integer; const AValue: TStrings);
- begin
- GetStrings(AIndex).Assign(AValue);
- end;
- function TTarget.GetSourceFileName: String;
- begin
- Result:=Name+FExtension;
- end;
- function TTarget.GetUnitFileName: String;
- begin
- Result:=Name+UnitExt;
- end;
- function TTarget.GetObjectFileName: String;
- begin
- Result:=Name+ObjExt;
- end;
- function TTarget.GetRSTFileName: String;
- begin
- Result:=Name+RSText;
- end;
- function TTarget.GetProgramFileName(AnOS : TOS): String;
- begin
- if AnOS in [dos,win32,os2] then
- Result:=Name+ExeExt
- else
- Result:=Name;
- end;
- constructor TTarget.Create(ACollection: TCollection);
- begin
- inherited Create(ACollection);
- FInstall:=True;
- end;
- destructor TTarget.Destroy;
- begin
- FreeAndNil(FUnitPath);
- FreeAndNil(FObjectPath);
- FreeAndNil(FIncludePath);
- FreeAndNil(FDependencies);
- inherited Destroy;
- end;
- function TTarget.GetOutputFileName(AOs: TOS): String;
- begin
- Result:=Name;
- if TargetType in UnitTargets then
- Result:=Result+UnitExt
- else if AOs in [Win32,dos,OS2] then
- Result:=Result+ExeExt
- end;
- procedure TTarget.SetName(const AValue: String);
- Var
- D,N,E : String;
- begin
- N:=FixPath(AValue);
- D:=ExtractFilePath(N);
- E:=ExtractFileExt(N);
- N:=ExtractFileName(N);
- If (E<>'') then
- N:=Copy(N,1,Length(N)-Length(E));
- inherited SetName(N);
- FExtension:=E;
- FDirectory:=D;
- end;
- procedure TTarget.GetCleanFiles(List: TStrings; APrefix : String; AnOS : TOS);
- begin
- If (OS=[]) or (AnOS in OS) then
- begin
- List.Add(APrefix+ObjectFileName);
- If (TargetType in [ttUnit,ttExampleUnit]) then
- List.Add(APrefix+UnitFileName)
- else If (TargetType in [ttProgram,ttExampleProgram]) then
- List.Add(APrefix+GetProgramFileName(AnOS));
- If ResourceStrings then
- List.Add(APrefix+RSTFileName);
- // Maybe add later ? AddStrings(List,CleanFiles);
- end;
- end;
- procedure TTarget.GetInstallFiles(List: TStrings; APrefix : String; AnOS : TOS);
- begin
- If (OS=[]) or (AnOS in OS) then
- begin
- If Not (TargetType in [ttProgram,ttExampleProgram]) then
- List.Add(APrefix+ObjectFileName);
- If (TargetType in [ttUnit,ttExampleUnit]) then
- List.Add(APrefix+UnitFileName)
- else If (TargetType in [ttProgram,ttExampleProgram]) then
- List.Add(APrefix+GetProgramFileName(AnOS));
- If ResourceStrings then
- List.Add(APrefix+RSTFileName);
- // Maybe add later ? AddStrings(List,InstallFiles);
- end;
- end;
- procedure TTarget.GetArchiveFiles(List: TStrings; APrefix : String; AnOS : TOS);
- begin
- If (OS=[]) or (AnOS in OS) then
- begin
- List.Add(APrefix+SourceFileName);
- // Maybe add later ? AddStrings(List,ArchiveFiles);
- end;
- end;
- { TCommands }
- function TCommands.GetCommand(Dest : String): TCommand;
- begin
- Result:=TCommand(ItemByName(Dest));
- end;
- function TCommands.GetCommandItem(Index : Integer): TCommand;
- begin
- Result:=TCommand(Items[Index]);
- end;
- procedure TCommands.SetCommandItem(Index : Integer; const AValue: TCommand);
- begin
- Items[Index]:=AValue;
- end;
- Function TCommands.AddCommand(const Cmd: String) : TCommand;
- begin
- Result:=AddCommand(fdefaultAt,Cmd,'','','');
- end;
- function TCommands.AddCommand(const Cmd, Options: String): TCommand;
- begin
- Result:=AddCommand(fdefaultAt,Cmd,Options,'','');
- end;
- function TCommands.AddCommand(const Cmd, Options, Dest, Source: String
- ): TCommand;
- begin
- Result:=AddCommand(fdefaultAt,Cmd,options,Dest,Source);
- end;
- Function TCommands.AddCommand(At: TCommandAt; const Cmd: String) : TCommand;
- begin
- Result:=AddCommand(At,Cmd,'','','');
- end;
- function TCommands.AddCommand(At: TCommandAt; const Cmd, Options: String
- ): TCommand;
- begin
- Result:=AddCommand(At,Cmd,Options,'','');
- end;
- function TCommands.AddCommand(At: TCommandAt; const Cmd, Options, Dest,
- Source: String): TCommand;
- begin
- Result:=Add as TCommand;
- Result.Command:=Cmd;
- Result.Options:=Options;
- Result.At:=At;
- Result.SourceFile:=Source;
- Result.DestFile:=Dest;
- end;
- Var
- DefInstaller : TInstaller = Nil;
- DefDictionary : TDictionary = Nil;
-
- Function Installer : TInstaller;
- begin
- If Not Assigned(DefInstaller) then
- DefInstaller:=InstallerClass.Create(Nil);
- Result:=DefInstaller;
- end;
- Function Defaults : TDefaults;
- begin
- Result:=Installer.Defaults;
- end;
- function Dictionary : TDictionary;
- begin
- If Not Assigned(DefDictionary) then
- DefDictionary:=DictionaryClass.Create(Nil);
- Result:=DefDictionary;
- end;
- { TValueItem }
- constructor TValueItem.Create(AValue: String);
- begin
- FValue:=AValue;
- end;
- { TFunctionItem }
- constructor TFunctionItem.Create(AFunc: TReplaceFunction);
- begin
- FFunc:=AFunc;
- end;
- { TDictionary }
- constructor TDictionary.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FList:=TStringList.Create;
- FList.Sorted:=True;
- FList.Duplicates:=dupError;
- end;
- destructor TDictionary.Destroy;
- Var
- I : Integer;
- begin
- For I:=0 to Flist.Count-1 do
- FList.Objects[i].Free;
- FreeAndNil(FList);
- inherited Destroy;
- end;
- procedure TDictionary.AddVariable(const AName, Value: String);
- Var
- I : Integer;
- begin
- I:=Flist.IndexOf(AName);
- If I=-1 then
- I:=FList.Add(Aname)
- else
- Flist.Objects[i].Free;
- Flist.Objects[i]:=TValueItem.Create(Value);
- end;
- procedure TDictionary.AddFunction(const AName: String;
- FReplacement: TReplaceFunction);
-
- Var
- I : Integer;
- begin
- I:=Flist.IndexOf(AName);
- If I=-1 then
- I:=Flist.Add(AName)
- else
- Flist.Objects[i].Free;
- Flist.Objects[i]:=TFunctionItem.Create(FReplacement);
- end;
- procedure TDictionary.RemoveItem(const AName: String);
- Var
- I : Integer;
- begin
- I:=Flist.IndexOf(AName);
- If (I<>-1) then
- begin
- FList.Objects[i].Free;
- FList.Delete(I);
- end;
- end;
- function TDictionary.GetValue(const AName: String): String;
- begin
- Result:=GetValue(AName,'');
- end;
- function TDictionary.GetValue(const AName,Args: String): String;
- Var
- O : TObject;
- I : Integer;
-
- begin
- I:=Flist.IndexOf(AName);
- If (I=-1) then
- Raise EDictionaryError.CreateFmt(SErrNoDictionaryItem,[AName]);
- O:=Flist.Objects[I];
- If O is TValueItem then
- Result:=Result+TValueItem(O).FValue
- else
- Result:=Result+TFunctionItem(O).FFunc(AName,Args);
- end;
- function TDictionary.ReplaceStrings(Const ASource: String): String;
- Var
- S,FN,FV : String;
- I,P: Integer;
- O : TObject;
- begin
- Result:='';
- S:=ASource;
- P:=Pos('$(',S);
- While (P<>0) do
- begin
- Result:=Result+Copy(S,1,P-1);
- Delete(S,1,P+1);
- P:=Pos(')',S);
- FN:=Copy(S,1,P-1);
- Delete(S,1,P);
- P:=Pos(' ',FN);
- If (P<>0) then // function arguments ?
- begin
- FV:=FN;
- FN:=Copy(FN,1,P);
- System.Delete(FV,1,P);
- end
- else
- FV:='';
- Result:=Result+GetValue(FN,FV);
- P:=Pos('$(',S);
- end;
- Result:=Result+S;
- end;
- Function Substitute(Const Source : String; Macros : Array of string) : String;
- Var
- I : Integer;
- begin
- I:=0;
- While I<High(Macros) do
- begin
- Dictionary.AddVariable(Macros[i],Macros[I+1]);
- Inc(I,2);
- end;
- Result:=Dictionary.ReplaceStrings(Source);
- While I<High(Macros) do
- begin
- Dictionary.RemoveItem(Macros[i]);
- Inc(I,2);
- end;
- end;
- Initialization
- OnGetApplicationName:=@GetFPMakeName;
- Finalization
- FreeAndNil(DefInstaller);
- FreeAndNil(DefDictionary);
- end.
|