* basic work for source package creation

git-svn-id: trunk@6594 -

utils/fppkg/fprepos.pp

@@ -71,8 +71,6 @@ Type
 
   { TFPDepencencies }
 
-  { TFPDependencies }
-
   TFPDependencies = Class(TStreamCollection)
   private
     function GetDependency(Index : Integer): TFPDependency;

utils/fppkg/fpxmlrep.pp

@@ -637,17 +637,17 @@ end;
 procedure TFPXMLRepositoryHandler.DoXMLToPackages(E: TDomElement; PS: TFPPackages);
 
 Var
-  PSN,PN : TDomElement;
+  PN : TDomElement;
   P : TFPPackage;
 
 begin
-  PN:=FindNextElement(PSN.FirstChild,SNodePackage);
+  PN:=FindNextElement(E.FirstChild,SNodePackage);
   While (PN<>Nil) do
     begin
     P:=PS.AddPackage('');
     try
       DoXMLToPackage(PN,P);
-    except
+    finally
       P.Free;
     end;
     PN:=FindNextElement(PN.NextSibling,SNodePackage);
@@ -677,7 +677,7 @@ begin
       P:=R.AddPackage('');
       try
         DoXMLToPackage(PN,P);
-      except
+      finally
         P.Free;
       end;
       PN:=FindNextElement(PN.NextSibling,SNodePackage);

utils/fppkg/pkgarchive.pp

@@ -18,10 +18,21 @@ type
   end;
 
 
+  { TCreateArchive }
+
+  TCreateArchive = Class(TPackagehandler)
+  Private
+    Procedure CreateArchive;
+  Public
+    Function Execute(const Args:TActionArgs):boolean;override;
+  end;
+
 
 implementation
 
 uses
+  fprepos,
+  fpxmlrep,
   zipper,
   uriparser,
   pkgglobals,
@@ -54,7 +65,7 @@ begin
 end;
 
 
-{ TFPMakeCompiler }
+{ TUnzipArchive }
 
 Procedure TUnzipArchive.UnzipArchive;
 Var
@@ -91,6 +102,48 @@ begin
 end;
 
 
+{ TCreateArchive }
+
+procedure TCreateArchive.CreateArchive;
+var
+  P : TFPPackage;
+  PS : TFPPackages;
+  X : TFPXMLRepositoryHandler;
+  i : integer;
+begin
+  if assigned(CurrentPackage) then
+    Error(SErrOnlyLocalDir);
+  { Generate manifest.xml if it doesn't exists yet }
+  if not FileExists(PackageManifestFile) then
+    ExecuteAction(CurrentPackage,'fpmakemanifest');
+
+
+  PS:=TFPPackages.Create(TFPPackage);
+  X:=TFPXMLRepositoryHandler.Create;
+  With X do
+    try
+      LoadFromXml(PS,PackageManifestFile);
+    finally
+      Free;
+    end;
+
+  for i:=0 to PS.Count-1 do
+    begin
+      P:=PS[i];
+      Writeln(P.Name);
+      Writeln(P.FileName);
+    end;
+end;
+
+
+function TCreateArchive.Execute(const Args: TActionArgs): boolean;
+begin
+  CreateArchive;
+  Result:=true;
+end;
+
+
 initialization
   RegisterPkgHandler('unziparchive',TUnzipArchive);
+  RegisterPkgHandler('createarchive',TCreateArchive);
 end.

utils/fppkg/pkgfpmake.pp

@@ -42,6 +42,14 @@ type
   end;
 
 
+  { TFPMakeRunnerManifest }
+
+  TFPMakeRunnerManifest = Class(TFPMakeRunner)
+  Public
+    Function Execute(const Args:TActionArgs):boolean;override;
+  end;
+
+
 implementation
 
 uses
@@ -54,6 +62,8 @@ uses
 Procedure TFPMakeCompiler.CompileFPMake;
 Var
   O,C : String;
+  RTLDir,
+  FPPkgDir,
   FPMakeBin,
   FPMakeSrc : string;
   HaveFpmake : boolean;
@@ -75,9 +85,21 @@ begin
     begin
       if Not HaveFPMake then
         Error(SErrMissingFPMake);
+      { Detect installed units directories }
+      if not DirectoryExists(Defaults.FPMakeUnitDir) then
+        Error(SErrMissingDirectory,[Defaults.FPMakeUnitDir]);
+      RTLDir:=Defaults.FPMakeUnitDir+'..'+PathDelim+'rtl'+PathDelim;
+      if not DirectoryExists(RTLDir) then
+        Error(SErrMissingDirectory,[RTLDir]);
+      FPPkgDir:=Defaults.FPMakeUnitDir+'..'+PathDelim+'fppkg'+PathDelim;
+      if not DirectoryExists(FPPkgDir) then
+        FPPkgDir:='';
       { Call compiler }
       C:=Defaults.FPMakeCompiler;
-      O:='-vi -n -Fu'+Defaults.FPMakeUnitDir+' -Fu'+Defaults.FPMakeUnitDir+'..'+PathDelim+'rtl'+PathDelim+' '+FPmakeSrc;
+      O:='-vi -n -Fu'+Defaults.FPMakeUnitDir+' -Fu'+RTLDir;
+//      if FPPkgDir<>'' then
+//        O:=O+' -Fu'+FPPkgDir+' -Fafpmkpkg';
+      O:=O+' '+FPmakeSrc;
       If ExecuteProcess(C,O)<>0 then
         Error(SErrFailedToCompileFPCMake)
     end
@@ -123,9 +145,17 @@ begin
 end;
 
 
+function TFPMakeRunnerManifest.Execute(const Args:TActionArgs):boolean;
+begin
+  result:=(RunFPMake('manifest')=0);
+end;
+
+
+
 
 initialization
   RegisterPkgHandler('compilefpmake',TFPMakeCompiler);
   RegisterPkgHandler('fpmakebuild',TFPMakeRunnerBuild);
   RegisterPkgHandler('fpmakeinstall',TFPMakeRunnerInstall);
+  RegisterPkgHandler('fpmakemanifest',TFPMakeRunnerManifest);
 end.

utils/fppkg/pkghandler.pp

@@ -48,8 +48,9 @@ type
     Function ExecuteProcess(Const Prog,Args:String):Integer;
     Procedure SetCurrentDir(Const ADir:String);
     function PackageBuildPath:String;
-    function PackageRemoteArchive: String;
+    function PackageRemoteArchive:String;
     function PackageLocalArchive:String;
+    function PackageManifestFile:String;
   Public
     Constructor Create(AOwner:TComponent;APackage:TFPPackage); virtual;
     function PackageLogPrefix:String;
@@ -170,6 +171,12 @@ begin
 end;
 
 
+function TPackageHandler.PackageManifestFile: String;
+begin
+  Result:='manifest.xml';
+end;
+
+
 function TPackageHandler.PackageLogPrefix:String;
 begin
   if assigned(CurrentPackage) then

utils/fppkg/pkgmessages.pp

@@ -11,7 +11,9 @@ Resourcestring
   SErrMissingFPC             = 'Could not find a fpc executable in the PATH';
   SErrMissingFPMake          = 'Missing configuration fpmake.pp';
   SErrMissingMakefilefpc     = 'Missing configuration Makefile.fpc';
+  SErrMissingDirectory       = 'Missing directory "%s"';
   SErrNoPackageSpecified     = 'No package specified';
+  SErrOnlyLocalDir           = 'The speficied command "%s" works only on current dir, not on a (remote) package';
   SErrRunning                = 'The FPC make tool encountered the following error:';
   SErrActionAlreadyRegistered= 'Action "%s" is already registered';
   SErrActionNotFound         = 'Action "%s" is not supported';