1. reiniero
  2. fpcup

Source

fpcup / updater.pas

The default branch has multiple heads

reiniero ac25f08 
reiniero d815e8d 
reiniero ac25f08 
reiniero 8febb70 



reiniero ac25f08 
reiniero 8febb70 









reiniero ac25f08 
reiniero 8febb70 



reiniero ac25f08 
reiniero 8febb70 


reiniero ac25f08 

reiniero 27b6f89 
reiniero fc789e9 
reiniero 27b6f89 





reiniero bdd99ed 
reiniero fc789e9 
reiniero 27b6f89 



reiniero 55ad0fa 
reiniero 27b6f89 

ludob 6ded5df 
reiniero 8de8bf8 
reiniero b3d38db 

ludob 6ded5df 
reiniero 8de8bf8 
reiniero bdd99ed 
reiniero b3d38db 
ludob 2b0738b 
reiniero fc789e9 
ludob 6ded5df 

reiniero fc789e9 
ludob 2b0738b 
ludob b4e0778 
reiniero 27b6f89 
reiniero b3d38db 
reiniero e1f4b0f 
ludob 6ded5df 
reiniero 8de8bf8 
reiniero e1f4b0f 
ludob 6ded5df 
reiniero 8de8bf8 
reiniero cfd51bf 

reiniero 85a054f 

reiniero b3d38db 
ludob 2b0738b 
ludob b4e0778 

reiniero 27b6f89 


reiniero fc789e9 
reiniero 27b6f89 




reiniero fc789e9 
reiniero 27b6f89 
reiniero 85a054f 
reiniero fc789e9 

ludob 2b0738b 






ludob b4e0778 













reiniero b3d38db 




reiniero 55ad0fa 
reiniero fc789e9 

reiniero 85a054f 
reiniero fc789e9 

reiniero a8cbbed 
ludob 6ded5df 











reiniero cfd51bf 













ludob b4e0778 
reiniero fc789e9 
reiniero a8cbbed 

reiniero fc789e9 

reiniero a8cbbed 
ludob b4e0778 







reiniero 1a7baa5 
reiniero f2d577d 
reiniero a8cbbed 

reiniero fc789e9 
reiniero 27b6f89 

ludob b4e0778 
reiniero 27b6f89 
reiniero a8cbbed 

reiniero fc789e9 

reiniero a8cbbed 
ludob b4e0778 







reiniero 1a7baa5 
reiniero f2d577d 
reiniero a8cbbed 

reiniero fc789e9 
reiniero 27b6f89 



reiniero fc789e9 


reiniero b3d38db 
reiniero 27b6f89 



reiniero bdd99ed 
reiniero 27b6f89 



reiniero cfd51bf 
{ Lazarus/FPC source downloader unit
Copyright (C) 2012 Reinier Olislagers, Ludo Brands

This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:

As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.

This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.

You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}

unit updater;

{ Gets/updats FPC and Lazarus sources }
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, svnclient;

type

  { TUpdater }

  //todo: rewrite into 2 objects, one for Laz, one for FPC; then easily move procedure/functio var parameters out to properties
  TUpdater = class(TObject)
  private
    FFPCRevision: string;
    FFPCURL: string;
    FFPCDirectory: string;
    FLazarusDirectory: string;
    FLazarusRevision: string;
    FLazarusURL: string;
    FSVNClient: TSVNClient;
    FUpdated: boolean;
    FVerbose: boolean;
    function GetSVNExecutable: string;
    procedure SetFPCRevision(AValue: string);
    procedure SetLazarusRevision(AValue: string);
    procedure SetSVNExecutable(AValue: string);
    procedure SetVerbose(AValue: boolean);
    procedure CreateStoreDiff(DiffFileName: string; UpdateWarnings: TStringList);
  public
    function FindSVNExecutable: string; //Search for installed SVN executable
    property FPCDirectory: string read FFPCDirectory write FFPCDirectory;
    property FPCRevision:string read FFPCRevision write SetFPCRevision;
    property FPCURL: string read FFPCURL write FFPCURL; //URL for FPC SVN
    property LazarusDirectory: string read FLazarusDirectory write FLazarusDirectory;
    property LazarusRevision:string read FLazarusRevision write SetLazarusRevision;
    property LazarusURL: string read FLazarusURL write FLazarusURL; //URL for Lazarus SVN
    procedure RevertFPC;
    procedure RevertLazarus;
    property SVNExecutable: string read GetSVNExecutable write SetSVNExecutable;
    //Which SVN executable to use
    property Updated: boolean read FUpdated; // Shows whether new files where downloaded/checked out/updated
    property Verbose:boolean read FVerbose write SetVerbose;
    function UpdateFPC(var BeforeRevision, AfterRevision: string; UpdateWarnings: TStringList): boolean; // Checks out or updates FPC source
    function UpdateLazarus(var BeforeRevision, AfterRevision: string; UpdateWarnings: TStringList): boolean; //Checks out or updates Lazarus source
    constructor Create;
    destructor Destroy; override;
  end;

implementation


{ TUpdater }

procedure TUpdater.SetSVNExecutable(AValue: string);
begin
  FSVNClient.SVNExecutable := AValue;
end;

procedure TUpdater.SetVerbose(AValue: boolean);
begin
  FSVNClient.Verbose := AValue;
  if FVerbose=AValue then Exit;
  FVerbose:=AValue;
end;

procedure TUpdater.CreateStoreDiff(DiffFileName: string;
  UpdateWarnings: TStringList);
var
  DiffFile:Text;
begin
  While FileExists(DiffFileName) do
    DiffFileName:=DiffFileName+'f';
  AssignFile(DiffFile,DiffFileName);
  Rewrite(DiffFile);
  Write(DiffFile,FSVNClient.GetDiffAll);
  CloseFile(DiffFile);
  UpdateWarnings.Add('Diff with last revision stored in '+DiffFileName);
end;

function TUpdater.FindSVNExecutable: string;
begin
  Result:=FSVNClient.FindSVNExecutable;
end;


function TUpdater.GetSVNExecutable: string;
begin
  Result := FSVNClient.SVNExecutable;
end;


procedure TUpdater.SetFPCRevision(AValue: string);
begin
  if FFPCRevision=AValue then Exit;
  FFPCRevision:=AValue;
end;

procedure TUpdater.SetLazarusRevision(AValue: string);
begin
  if FLazarusRevision=AValue then Exit;
  FLazarusRevision:=AValue;
end;

procedure Tupdater.RevertLazarus();
begin
  FSVNClient.LocalRepository := LazarusDirectory;
  FSVNClient.Repository := LazarusURL;
  FSVNClient.Revert; //Remove local changes
end;

procedure Tupdater.RevertFPC();
begin
  FSVNClient.LocalRepository := FPCDirectory;
  FSVNClient.Repository := FPCURL;
  FSVNClient.Revert; //Remove local changes
end;

function Tupdater.UpdateFPC(var BeforeRevision, AfterRevision: string; UpdateWarnings: TStringList): boolean;
begin
  BeforeRevision:='failure';
  AfterRevision:='failure';
  FSVNClient.LocalRepository := FPCDirectory;
  FSVNClient.Repository := FPCURL;
  BeforeRevision:=IntToStr(FSVNClient.LocalRevision);
  FSVNClient.LocalModifications(UpdateWarnings); //Get list of modified files
  if UpdateWarnings.Count>0 then
    begin
    CreateStoreDiff(IncludeTrailingPathDelimiter(FPCDirectory)+'REV'+BeforeRevision+'.diff',UpdateWarnings);
    UpdateWarnings.Insert(0,'FPC: WARNING: found modified files.');
    UpdateWarnings.Add('FPC: reverting before updating.');
    FSVNClient.Revert; //Remove local changes
    end;
  FSVNClient.DesiredRevision:=FFPCRevision; //Desired revision
  FSVNClient.CheckOutOrUpdate;
  AfterRevision:=IntToStr(FSVNClient.LocalRevision);
  if BeforeRevision<>AfterRevision then FUpdated:=true else FUpdated:=false;
  Result := True;
end;

function Tupdater.UpdateLazarus(var BeforeRevision, AfterRevision: string; UpdateWarnings: TStringList): boolean;
begin
  BeforeRevision:='failure';
  AfterRevision:='failure';
  FSVNClient.LocalRepository := LazarusDirectory;
  FSVNClient.Repository := FLazarusURL;
  BeforeRevision:=IntToStr(FSVNClient.LocalRevision);
  FSVNClient.LocalModifications(UpdateWarnings); //Get list of modified files
  if UpdateWarnings.Count>0 then
    begin
    CreateStoreDiff(IncludeTrailingPathDelimiter(LazarusDirectory)+'REV'+BeforeRevision+'.diff',UpdateWarnings);
    UpdateWarnings.Insert(0,'Lazarus: WARNING: found modified files.');
    UpdateWarnings.Add('Lazarus: reverting before updating.');
    FSVNClient.Revert; //Remove local changes
    end;
  FSVNClient.DesiredRevision:=FLazarusRevision; //Desired revision
  FSVNClient.CheckOutOrUpdate;
  AfterRevision:=IntToStr(FSVNClient.LocalRevision);
  if BeforeRevision<>AfterRevision then FUpdated:=true else FUpdated:=false;
  Result := True;
end;

constructor Tupdater.Create;
begin
  FSVNClient := TSVNClient.Create;
  FFPCURL := 'http://svn.freepascal.org/svn/fpc/trunk'; //Default: latest (trunk)
  FLazarusURL := 'http://svn.freepascal.org/svn/lazarus/trunk'; //Default: latest (trunk)
  FUpdated:=false;
end;

destructor Tupdater.Destroy;
begin
  FSVNClient.Free;
  inherited Destroy;
end;

end.