pkghandler.pp 7.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351
  1. {$mode objfpc}
  2. {$h+}
  3. unit pkghandler;
  4. interface
  5. uses Classes,SysUtils, fpmktype, pkgropts, fprepos;
  6. Const
  7. {$ifdef unix}
  8. ExeExt = '';
  9. {$else unix}
  10. ExeExt = '.exe';
  11. {$endif unix}
  12. Type
  13. TVerbosity = (vError,vInfo,vCommands,vDebug);
  14. TVerbosities = Set of TVerbosity;
  15. { TActionStack }
  16. TActionArgs = array of string;
  17. TActionStackItem = record
  18. ActionPackage : TFPPackage;
  19. Action : string;
  20. Args : TActionArgs;
  21. end;
  22. PActionStackItem = ^TActionStackItem;
  23. TActionStack = class
  24. private
  25. FList : TFPList;
  26. public
  27. constructor Create;
  28. destructor Destroy;
  29. procedure Push(APackage:TFPPackage;const AAction:string;const Args:TActionArgs);
  30. procedure Push(APackage:TFPPackage;const AAction:string;const Args:array of string);
  31. function Pop(out APackage:TFPPackage;out AAction:string;out Args:TActionArgs):boolean;
  32. end;
  33. { TPackageHandler }
  34. TPackageHandler = Class(TComponent)
  35. private
  36. FBackupFile : Boolean;
  37. FDefaults : TPackagerOptions;
  38. FCurrentPackage : TFPPackage;
  39. Protected
  40. Procedure Log(Level: TVerbosity;Msg : String);
  41. Procedure Log(Level: TVerbosity;Fmt : String; const Args : array of const);
  42. Procedure Error(Msg : String);
  43. Procedure Error(Fmt : String; const Args : array of const);
  44. Procedure BackupFile(Const FileName : String);
  45. Function ExecuteProcess(Const Prog,Args:String):Integer;
  46. Procedure SetCurrentDir(Const ADir:String);
  47. function PackageBuildPath:String;
  48. Public
  49. Constructor Create(AOwner: TComponent;ADefaults:TPackagerOptions;APackage:TFPPackage); virtual;
  50. function PackageLogPrefix:String;
  51. Function Execute(const Args:TActionArgs):boolean; virtual; abstract;
  52. Property BackupFiles : Boolean Read FBackupFile Write FBackupFile;
  53. Property Defaults:TPackagerOptions Read FDefaults;
  54. Property CurrentPackage:TFPPackage Read FCurrentPackage Write FCurrentPackage;
  55. end;
  56. TPackageHandlerClass = class of TPackageHandler;
  57. EPackageHandler = Class(EInstallerError);
  58. // Actions/PkgHandler
  59. procedure RegisterPkgHandler(const AAction:string;pkghandlerclass:TPackageHandlerClass);
  60. function GetPkgHandler(const AAction:string):TPackageHandlerClass;
  61. // Logging
  62. Function StringToVerbosity (S : String) : TVerbosity;
  63. Function VerbosityToString (V : TVerbosity): String;
  64. Procedure Log(Level: TVerbosity;Msg : String);
  65. Procedure Log(Level: TVerbosity;Fmt : String; const Args : array of const);
  66. Procedure Error(Msg : String);
  67. Procedure Error(Fmt : String; const Args : array of const);
  68. // Utils
  69. function maybequoted(const s:ansistring):ansistring;
  70. var
  71. Verbosity : TVerbosities;
  72. ActionStack : TActionStack;
  73. Implementation
  74. uses
  75. typinfo,
  76. {$ifdef ver2_0}
  77. contnrs20,
  78. {$else ver2_0}
  79. contnrs,
  80. {$endif ver2_0}
  81. pkgmessages;
  82. var
  83. PkgHandlerList : TFPHashList;
  84. procedure RegisterPkgHandler(const AAction:string;pkghandlerclass:TPackageHandlerClass);
  85. begin
  86. if PkgHandlerList.Find(AAction)<>nil then
  87. begin
  88. Raise EPackageHandler.CreateFmt(SErrActionAlreadyRegistered,[AAction]);
  89. exit;
  90. end;
  91. PkgHandlerList.Add(AAction,pkghandlerclass);
  92. end;
  93. function GetPkgHandler(const AAction:string):TPackageHandlerClass;
  94. begin
  95. result:=TPackageHandlerClass(PkgHandlerList.Find(AAction));
  96. if result=nil then
  97. Raise EPackageHandler.CreateFmt(SErrActionNotFound,[AAction]);
  98. end;
  99. function StringToVerbosity(S: String): TVerbosity;
  100. Var
  101. I : integer;
  102. begin
  103. I:=GetEnumValue(TypeInfo(TVerbosity),'v'+S);
  104. If (I<>-1) then
  105. Result:=TVerbosity(I)
  106. else
  107. Raise EPackageHandler.CreateFmt(SErrInvalidVerbosity,[S]);
  108. end;
  109. Function VerbosityToString (V : TVerbosity): String;
  110. begin
  111. Result:=GetEnumName(TypeInfo(TVerbosity),Integer(V));
  112. Delete(Result,1,1);// Delete 'v'
  113. end;
  114. procedure Log(Level:TVerbosity;Msg: String);
  115. begin
  116. if Level in Verbosity then
  117. Writeln(stdErr,Msg);
  118. end;
  119. Procedure Log(Level:TVerbosity; Fmt:String; const Args:array of const);
  120. begin
  121. Log(Level,Format(Fmt,Args));
  122. end;
  123. procedure Error(Msg: String);
  124. begin
  125. Raise EPackageHandler.Create(Msg);
  126. end;
  127. procedure Error(Fmt: String; const Args: array of const);
  128. begin
  129. Raise EPackageHandler.CreateFmt(Fmt,Args);
  130. end;
  131. function maybequoted(const s:ansistring):ansistring;
  132. const
  133. {$IFDEF MSWINDOWS}
  134. FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
  135. '{', '}', '''', '`', '~'];
  136. {$ELSE}
  137. FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
  138. '{', '}', '''', ':', '\', '`', '~'];
  139. {$ENDIF}
  140. var
  141. s1 : ansistring;
  142. i : integer;
  143. quoted : boolean;
  144. begin
  145. quoted:=false;
  146. s1:='"';
  147. for i:=1 to length(s) do
  148. begin
  149. case s[i] of
  150. '"' :
  151. begin
  152. quoted:=true;
  153. s1:=s1+'\"';
  154. end;
  155. ' ',
  156. #128..#255 :
  157. begin
  158. quoted:=true;
  159. s1:=s1+s[i];
  160. end;
  161. else begin
  162. if s[i] in FORBIDDEN_CHARS then
  163. quoted:=True;
  164. s1:=s1+s[i];
  165. end;
  166. end;
  167. end;
  168. if quoted then
  169. maybequoted:=s1+'"'
  170. else
  171. maybequoted:=s;
  172. end;
  173. { TPackageHandler }
  174. constructor TPackageHandler.Create(AOwner : TComponent; ADefaults:TPackagerOptions;APackage:TFPPackage);
  175. begin
  176. inherited Create(AOwner);
  177. FDefaults:=ADefaults;
  178. FCurrentPackage:=APackage;
  179. end;
  180. procedure TPackageHandler.BackupFile(const FileName: String);
  181. Var
  182. BFN : String;
  183. begin
  184. BFN:=FileName+'.bak';
  185. If not RenameFile(FileName,BFN) then
  186. Error(SErrBackupFailed,[FileName,BFN]);
  187. end;
  188. Function TPackageHandler.ExecuteProcess(Const Prog,Args:String):Integer;
  189. begin
  190. Log(vCommands,SLogExecute,[Prog,Args]);
  191. Result:=SysUtils.ExecuteProcess(Prog,Args);
  192. end;
  193. Procedure TPackageHandler.SetCurrentDir(Const ADir:String);
  194. begin
  195. Log(vCommands,SLogChangeDir,[ADir]);
  196. if not SysUtils.SetCurrentDir(ADir) then
  197. Error(SErrChangeDirFailed,[ADir]);
  198. end;
  199. function TPackageHandler.PackageBuildPath:String;
  200. begin
  201. if CurrentPackage=nil then
  202. Result:='.'
  203. else
  204. Result:=Defaults.BuildDir+CurrentPackage.Name;
  205. end;
  206. function TPackageHandler.PackageLogPrefix:String;
  207. begin
  208. if assigned(CurrentPackage) then
  209. Result:='['+CurrentPackage.Name+'] '
  210. else
  211. Result:='[<currentdir>] ';
  212. end;
  213. Procedure TPackageHandler.Log(Level:TVerbosity; Msg:String);
  214. begin
  215. pkghandler.Log(Level,PackageLogPrefix+Msg);
  216. end;
  217. Procedure TPackageHandler.Log(Level:TVerbosity; Fmt:String; const Args:array of const);
  218. begin
  219. pkghandler.Log(Level,PackageLogPrefix+Fmt,Args);
  220. end;
  221. Procedure TPackageHandler.Error(Msg:String);
  222. begin
  223. pkghandler.Error(PackageLogPrefix+Msg);
  224. end;
  225. Procedure TPackageHandler.Error(Fmt:String; const Args:array of const);
  226. begin
  227. pkghandler.Error(PackageLogPrefix+Fmt,Args);
  228. end;
  229. { TActionStack }
  230. constructor TActionStack.Create;
  231. begin
  232. FList:=TFPList.Create;
  233. end;
  234. destructor TActionStack.Destroy;
  235. begin
  236. FreeAndNil(FList);
  237. end;
  238. procedure TActionStack.Push(APackage:TFPPackage;const AAction:string;const Args:TActionArgs);
  239. var
  240. ActionItem : PActionStackItem;
  241. begin
  242. New(ActionItem);
  243. ActionItem^.ActionPackage:=APackage;
  244. ActionItem^.Action:=AAction;
  245. ActionItem^.Args:=Args;
  246. FList.Add(ActionItem);
  247. end;
  248. procedure TActionStack.Push(APackage:TFPPackage;const AAction:string;const Args:array of string);
  249. var
  250. ActionArgs : TActionArgs;
  251. i : integer;
  252. begin
  253. SetLength(ActionArgs,high(Args)+1);
  254. for i:=low(Args) to high(Args) do
  255. ActionArgs[i]:=Args[i];
  256. Push(APackage,AAction,ActionArgs);
  257. end;
  258. function TActionStack.Pop(out APackage:TFPPackage;out AAction:string;out Args:TActionArgs):boolean;
  259. var
  260. ActionItem : PActionStackItem;
  261. Idx : integer;
  262. begin
  263. Result:=false;
  264. if FList.Count=0 then
  265. exit;
  266. // Retrieve Item from stack
  267. Idx:=FList.Count-1;
  268. ActionItem:=PActionStackItem(FList[Idx]);
  269. FList.Delete(Idx);
  270. // Copy contents and dispose stack item
  271. APackage:=ActionItem^.ActionPackage;
  272. AAction:=ActionItem^.Action;
  273. Args:=ActionItem^.Args;
  274. dispose(ActionItem);
  275. Result:=true;
  276. end;
  277. initialization
  278. PkgHandlerList:=TFPHashList.Create;
  279. ActionStack:=TActionStack.Create;
  280. finalization
  281. FreeAndNil(PkgHandlerList);
  282. FreeAndNil(ActionStack);
  283. end.