On Wed, May 27 22:50, Alexander Siol wrote:
> diff --git a/trunk/src/modules/pas/lpt/helpers.pas b/trunk/src/modules/pas/lpt/helpers.pas
> new file mode 100644
> index 0000000..1486095
> --- /dev/null
> +++ b/trunk/src/modules/pas/lpt/helpers.pas
Hm, diese Datei könnte man eventuell noch aufspalten, auch wenn ich
nicht weiss wie man das sinnvoll teilen könnte. *g*
> @@ -0,0 +1,238 @@
> +unit helpers;
> +{$MODE ObjFPC}
> +
> +interface
> +uses crt, sysutils, dos, classes, tar, packages, tcpip, http;
> +
> +procedure ScanFile(pkgset: TPackageSet; filename, repository: String);
> +procedure DrawProgress(http: HTTPRequest);
> +function StartDownload(url: String): HTTPRequest;
> +function DownloadToFile(url, filename: String): boolean;
> +function DownloadToTarArchive(url: String): TTarArchive;
> +function getConfigRoot: String;
> +procedure Untar(tarfile: String; targetpath: String = 'file:/');
> +procedure Untar(tar: TTarArchive; targetpath: String = 'file:/');
> +function getArch: String;
> +procedure mkpath(path: string);
> +
> +implementation
> +
> +procedure mkpath(path: string);
> +var
> + i: integer;
> + prefix: String;
> +begin
> + i := 1;
> + while i <= length(path) do begin
> + if path[i] = '/' then begin
> + prefix := Copy(path, 1, i);
> + if not FileExists(prefix) then begin
> + mkdir(prefix);
> + end;
> + end;
> + Inc(i);
> + end;
> +end;
> +
> +function getConfigRoot: String;
> +begin
> + exit('file:/config/lpt/');
> +end;
> +
> +function getArch: String;
> +begin
> + exit('i386');
> +end;
> +
> +procedure DrawProgress(http: HTTPRequest);
> +const
> + i: Integer = 0;
> +begin
> + Inc(i);
> + if i mod 16 <> 0 then begin
> + exit;
> + end;
> +
> + if http.responseRemaining >= 0 then begin
> + Write(#13, (http.responseLength - http.responseRemaining), '/', http.responseLength, ' Bytes empfangen');
> + end else begin
> + Write(#13, http.responseLength, ' Bytes empfangen');
> + end;
> +end;
> +
> +function StartDownload(url: String): HTTPRequest;
> +var
> + httpc: HTTPRequest;
> +begin
> + try
> + httpc := HTTPRequest.create(url);
> + httpc.setRequestHeader('Pragma', 'no-cache');
> + httpc.setRequestHeader('Cache-Control', 'no-cache');
> + WriteLn('Herunterladen von ', url);
> + Write('Verbinde...');
> + httpc.onReadTick := @DrawProgress;
> + httpc.get;
> + WriteLn;
> +
> + if httpc.statusCode <> 200 then begin
> + WriteLn('Fehler: HTTP-Statuscode ', httpc.statusCode);
> + exit(nil)
> + end else begin
> + exit(httpc);
> + end;
> + except
> + on e: Exception do WriteLn('EXCEPTION: ', e.message);
> + end;
Ich weiss ja, du hast nur kopiert, aber wäre es nicht vielleicht
sinnvoller, diese Exceptions weiter "oben", also beim Aufrufer,
abzufangen? Dann könnte man ja auch in den anderen Funktionen besser mit
Exceptions um sich werfen. ;-)
> + exit(nil);
> +end;
> +
> +function DownloadToFile(url, filename: String): boolean;
> +var
> + f: File;
> + httpc: HTTPRequest;
> + tar: TTarArchive;
> + i: integer;
> +begin
> + DownloadToFile := false;
> + httpc := StartDownload(url);
> + if httpc <> nil then begin
> + Assign(f, filename);
> + Rewrite(f, httpc.responseLength);
> + BlockWrite(f, httpc.binaryResponseBody^, 1);
> + Close(f);
> + DownloadToFile := true;
> + httpc.done;
> + end;
> +end;
> +
> +function DownloadToTarArchive(url: String): TTarArchive;
> +var
> + f: File;
> + httpc: HTTPRequest;
> + tar: TTarArchive;
> + i: integer;
> +begin
> + DownloadToTarArchive := nil;
> + httpc := StartDownload(url);
> + if httpc <> nil then begin
> + tar := TTarArchive.create(httpc.binaryResponseBody, httpc.responseLength);
> + DownloadToTarArchive := tar;
> + end;
> +end;
> +
> +procedure ScanFile(pkgset: TPackageSet; filename, repository: String);
> +var
> + f: Text;
> + line: String;
> + status: integer;
> +
> + pkg: TPackage;
> + section: TPackageSection;
> + version: TPackageVersion;
> +begin
> + Assign(f, filename);
> + Reset(f);
> + status := 0;
> + pkg := nil;
> + try
> + while not eof(f) do begin
> + ReadLn(f, line);
> +
> + if line = '' then begin
> + continue;
> + end;
> +
> + case line[1] of
> + 'P':
> + begin
> + status := 1;
> + pkg := pkgset.add(Copy(line, 3, length(line)));
> + end;
> + 'D':
> + if status = 1 then begin
> + pkg.desc := Copy(line, 3, length(line));
> + end else begin
> + raise EPackageFileFormat.create(
> + 'D in status ' + IntToStr(status));
> + end;
> + 'S':
> + if status >= 1 then begin
> + status := 2;
> + section := pkg.add(Copy(line, 3, length(line)));
> + end else begin
> + raise EPackageFileFormat.create(
> + 'S in status ' + IntToStr(status));
> + end;
> + 'V':
> + if status >= 2 then begin
> + status := 3;
> + version := section.add(Copy(line, 3, length(line)));
> + version.pkg := pkg;
> + version.section := section;
> + version.repository := repository;
> + end else begin
> + raise EPackageFileFormat.create(
> + 'V in status ' + IntToStr(status));
> + end;
> + 's':
> + if status >= 3 then begin
> + version.size := StrToInt(Copy(line, 3, length(line)));
> + end else begin
> + raise EPackageFileFormat.create(
> + 's in status ' + IntToStr(status));
> + end;
> + 'd':
> + if status >= 3 then begin
> + if length(line) < 2 then begin
> + raise EPackageFileFormat.create(
> + 'Einsames d');
> + end;
> +
> + version.addDependency(line[2], Copy(line, 4, length(line)));
> +
> + end else begin
> + raise EPackageFileFormat.create(
> + 'd in status ' + IntToStr(status));
> + end;
> + else
> + begin
> + raise EPackageFileFormat.create(
> + 'Unbekannter Schluessel: ' + line[1]);
> + end;
> + end;
> + end;
> + finally
> + Close(f);
> + end;
> +end;
> +
> +procedure Untar(tar: TTarArchive; targetpath: String = 'file:/');
> +var
> + path: String;
> + dir, filename, ext: String;
> +
> + f: file;
> +begin
> + while tar.hasNext do begin
> + path := tar.NextFilename;
> + dos.FSplit(path, dir, filename, ext);
> +
> + mkpath(targetpath + '/' + dir);
> +
> + Assign(f, targetpath + '/' + path);
> + Rewrite(f, 1);
> + tar.ExtractFile(f);
> + Close(f);
> + end;
> +end;
> +
> +procedure Untar(tarfile: String; targetpath: String = 'file:/');
> +var
> + tar: TTarArchive;
> +begin
> + tar := TTarArchive.create(tarfile);
> + Untar(tar, targetpath);
> +end;
> +
> +begin
> +end.
> diff --git a/trunk/src/modules/pas/lpt/lpt.pas b/trunk/src/modules/pas/lpt/lpt.pas
> index 62e0980..324d712 100644
> --- a/trunk/src/modules/pas/lpt/lpt.pas
> +++ b/trunk/src/modules/pas/lpt/lpt.pas
> @@ -1,118 +1,7 @@
> ...
> +uses crt, dos, sysutils, classes, tar, helpers, packages, repositories, repository_base;
>
> procedure PrintUsage;
> begin
> @@ -124,70 +13,36 @@ end;
>
> procedure Scan;
> var
> - f: Text;
> - name: String;
> - url: String;
> - space: integer;
> + i: Integer;
> + repos: TCollection;
> + repo: TRepository;
> begin
> - mkpath(configRoot);
> -
> - Assign(f, configRoot + 'pkgsrc');
> - Reset(f);
> - while not eof(f) do begin
> - ReadLn(f, url);
> - if url = '' then begin
> - continue;
> - end;
> + mkpath(getConfigRoot);
>
> - space := Pos(' ', url);
> - if space > 0 then begin
> - name := Copy(url, 1, space - 1);
> - url := Copy(url, space + 1, length(url));
> - end else begin
> - WriteLn('Ungueltige Paketquelle: ' + url);
> - continue;
> - end;
> -
> - if url[length(url)] <> '/' then begin
> - url := url + '/packages.' + arch;
> - end else begin
> - url := url + 'packages.' + arch;
> - end;
> + ReadPkgsrc(getConfigRoot + 'pkgsrc');
> + repos := GetAllRepositories();
>
> - WriteLn('Lade Paketliste ' + name + ' von ' + url);
> - Download(url, configRoot + 'pkglist.' + name);
> + for i := 0 to repos.count - 1 do begin
> + repo := TRepository(repos.items[i]);
> + repo.PrepareLists();
> end;
> - Close(f);
> end;
>
> procedure ReadPkglists(pkgset: TPackageSet);
> var
> - srec: SearchRec;
> - name: String;
> repo: TRepository;
> + repos: TCollection;
> + i: integer;
> begin
> - dos.FindFirst(configRoot + 'pkglist.*', 0, srec);
> - while DosError = 0 do begin
> - WriteLn('Lese Paketliste ein: ' + srec.name);
> -
> - name := Copy(srec.name, length('pkglist.*'), length(srec.name));
> - repo := GetRepository(name);
> - if repo = nil then begin
> - TextColor(6);
> - WriteLn('Warnung: "', name, '" nicht in pkgsrc gefunden. Ueberspringe Quelle.');
> - TextColor(7);
> + repos := GetAllRepositories();
> + for i := 0 to repos.count - 1 do begin
> + repo := TRepository(repos.items[i]);
> + Write('Lade Pakete von Repository ' + repo.name + ' - ');
> + if repo.FetchLists(pkgset) then begin
> + WriteLn('OK');
> end else begin
> - try
> - pkgset.ScanFile(configRoot + srec.name, repo.url);
> - except
> - on e: Exception do begin
> - TextColor(12);
> - WriteLn('Fehler beim Einlesen der Paketliste: ', e.message);
> - TextColor(7);
> - end;
> - end;
> + WriteLn('Fehler');
Der ist ja immernoch da und nicht bunt?
> end;
> - dos.FindNext(srec);
> end;
> end;
>
> @@ -197,7 +52,8 @@ procedure Get(pkgname: String; reinstall: boolean);
> function Install(version: TPackageVersion; reinstall: boolean): boolean;
> var
> filename: String;
> - url: String;
> + repos: TRepository;
> + installarchive: TTarArchive;
> begin
> Install := false;
>
> @@ -214,18 +70,20 @@ procedure Get(pkgname: String; reinstall: boolean);
> exit;
> end;
>
> + repos := GetRepository(version.repository);
> +
> // Ansonsten herunterladen und installieren
> TextColor(15);
> WriteLn('Herunterladen und Entpacken von ' + version.pkg.name + '/' + version.section.section);
> TextColor(7);
> - filename := version.pkg.name + '-' + version.section.section + '-' + version.version
> - + '-' + arch + '.tar';
> - url := version.repository + filename;
> - if not Download(url, '', true) then begin
> + installarchive := repos.Download(version);
> + if installarchive = nil then begin
> TextColor(12);
> WriteLn('Download fehlgeschlagen');
> TextColor(7);
> exit;
> + end else begin
> + Untar(installarchive);
> end;
> WriteLn;
>
> @@ -251,7 +109,7 @@ var
> version: TPackageVersion;
> i, j, k: integer;
> begin
> - ReadPkgsrc(configRoot + 'pkgsrc');
> + ReadPkgsrc(getConfigRoot + 'pkgsrc');
> pkgset := TPackageSet.create;
>
> ReadPkglists(pkgset);
> @@ -267,14 +125,14 @@ begin
> end;
>
> version := pkgset.GetCurrentVersion(pkgname, section);
> -
> +
> if version = nil then begin
> TextColor(12);
> WriteLn('Konnte keine Version von ' + pkgname + ' finden');
> TextColor(7);
> exit;
> end;
> -
> +
> instset := TPackageSet.create();
> instset.AddVersion(version);
> try
Das d00f.
> @@ -302,7 +160,6 @@ begin
> end;
> end;
> end;
> -
> end;
>
> procedure List;
Das auch. ;-)
> @@ -318,7 +175,7 @@ var
>
> i, j, k, l: integer;
> begin
> - ReadPkgsrc(configRoot + 'pkgsrc');
> + ReadPkgsrc(getConfigRoot + 'pkgsrc');
> pkgset := TPackageSet.create;
> ReadPkglists(pkgset);
>
> diff --git a/trunk/src/modules/pas/lpt/repositories.pas b/trunk/src/modules/pas/lpt/repositories.pas
> index 7484ab6..5386421 100644
> --- a/trunk/src/modules/pas/lpt/repositories.pas
> +++ b/trunk/src/modules/pas/lpt/repositories.pas
> @@ -2,31 +2,44 @@ unit repositories;
> {$MODE ObjFPC}
>
> interface
> -uses sysutils, classes;
> -
> -type
> - TRepository = class(TCollectionItem)
> - public
> - name: String;
> - url: String;
> - end;
> -
> +uses sysutils, classes, helpers, repository_base, repository_http;
>
> procedure ReadPkgsrc(filename: String);
> +procedure AddRepository(name, url: String; repostype: Trepostype);
> function GetRepository(name: String): TRepository;
> -
> +function GetAllRepositories(): TCollection;
>
> implementation
>
> var
> repos: TCollection;
>
> +procedure AddRepository(name, url: String; repostype: Trepostype);
> +var
> + repo: TRepository;
> +begin
> + if repostype = http then begin
> + repo := THTTPRepository.create(repos);
> + end else begin
> + WriteLn('ACHTUNG - Repository unbekannten Typs erzeugen geht nicht!');
Wenn schon Writeln dann Bunt!
> + exit;
> + end;
> + repo.name := name;
> + repo.url := url;
> +end;
> +
> +function GetAllRepositories(): TCollection;
> +begin
> + exit(repos);
> +end;
> +
> procedure ReadPkgsrc(filename: String);
> var
> repo: TRepository;
> f: Text;
> name: String;
> url: String;
> + repostype: Trepostype;
> space: integer;
> begin
> Assign(f, filename);
> @@ -44,15 +57,19 @@ begin
> if space > 0 then begin
> name := Copy(url, 1, space - 1);
> url := Copy(url, space + 1, length(url));
> + if Pos('http://', url) > 0 then begin
> + repostype := http;
> + end else begin
> + WriteLn('Ungueltige Paketquelle: ' + url);
Hier auch
> + continue;
> + end
> end else begin
> WriteLn('Ungueltige Paketquelle: ' + url);
> continue;
> end;
>
> // Neues Repository in die Liste aufnehmen
> - repo := TRepository(repos.add());
> - repo.name := name;
> - repo.url := url;
> + AddRepository(name, url, repostype);
> end;
> Close(f);
> end;
> diff --git a/trunk/src/modules/pas/lpt/repository_base.pas b/trunk/src/modules/pas/lpt/repository_base.pas
> new file mode 100644
> index 0000000..108d7c0
> --- /dev/null
> +++ b/trunk/src/modules/pas/lpt/repository_base.pas
> @@ -0,0 +1,38 @@
> +unit repository_base;
> +{$MODE ObjFPC}
> +
> +interface
> +uses sysutils, classes, tar, packages, helpers;
> +
> +type
> + Trepostype = ( none, http );
> +
> + TRepository = class(TCollectionItem)
> + public
> + name: String;
> + url: String;
> +
> + function repostype: Trepostype; virtual;
Die kannst du eigentlich auch nach unten verschieben und dokumentieren
;-)
> +
> + constructor create(parent : TCollection);
> + (* Lädt die angegebene Paketversion aus dem Repository *)
> + function Download(version: TPackageVersion): TTarArchive; virtual; abstract;
> + (* Bereitet Paketlisten für das Repository vor (siehe lpt scan) *)
> + function PrepareLists: boolean; virtual; abstract;
> + (* Lädt die Paketliste des Repository in ein PackageSet *)
> + function FetchLists(pkgset: TPackageSet): boolean; virtual; abstract;
Hm auch hier könnte man doch eigentlich die Rückgabewerte weglassen,
wenn Exceptions benutzt werden. Mag sein, dass ich da zu anspruchsvoll
bin, aber wir benutzen doch nicht grundlos Pascal und kein C. ;-) Im
Zweifelsfall mal Kevin fragen, was er dazu meint.
> + end;
> +
> +implementation
> ...
Mehr fällt mir hier nicht auf.
Ah und hier möchte ich noch gleich 2 Dinge anmerken, die unabhängig von
diesem Patch sind:
- Sind Lizenzheader in Pascal grundsätzlich verboten, oder warum haben
wir sowas nicht? ;-)
- Irgendwie finde ich das ständige Ändern der Textfarbe d00f. Warum
nicht einfach in Funktionen für Hinweise, Warnungen und Fehler
auslagern?
--
Antoine Kaufmann
<toni@xxxxxxxxxxxxxxxx>
Attachment:
pgpQmj0eSBCxh.pgp
Description: PGP signature