[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [tyndur-devel] [PATCH] + lpt: Repositories als abstrakte Klassen
Am Dienstag, 26. Mai 2009 15:27 schrieb Alexander Siol:
> diff --git a/trunk/src/modules/pas/lpt/baserepository.pas
> b/trunk/src/modules/pas/lpt/baserepository.pas new file mode 100644
> index 0000000..a4bfb68
> --- /dev/null
> +++ b/trunk/src/modules/pas/lpt/baserepository.pas
> @@ -0,0 +1,49 @@
> +unit baserepository;
Ich fang mal mit einer Kleinigkeit an: Ich würde mir eher repository_base,
repository_http usw. wünschen, damit man die beim ls alle auf einem Haufen
hat. Das hilft für den Überblick.
> +{$MODE ObjFPC}
> +
> +interface
> +uses sysutils, classes, tar, packages, helpers;
> +
> +type
> + TRepository = class(TCollectionItem)
> + public
> + name: String;
> + url: String;
Hat jedes Repository zwangsläufig eine URL?
> + repostype: String;
> +
> + constructor create(parent : TCollection);
> + function Download(version: TPackageVersion): TTarArchive;
> virtual; + function PrepareLists: boolean; virtual;
> + function FetchLists(pkgset: TPackageSet): boolean; virtual;
Okay, irgendwann müssen wir es auch in Pascal anfangen... Download ist relativ
offensichtlich, aber zumindest PrepareLists und FetchLists könnten einen
Kommentar vertragen. An dieser Stelle kann ich mir nämlich nichts konkretes
darunter vorstellen, sondern muß erstmal in den Code schauen.
> + end;
> +
> +implementation
> +
> +constructor TRepository.create(parent: TCollection);
> +begin
> + inherited;
> + repostype := 'undefined';
> +end;
Kann sich der Typ verändern? Wenn nein, sollte das eine abstrakte virtuelle
Funktion sein, die in den Kindklassen mit einem exit('http') oder so
überschrieben wird.
> +
> +function TRepository.Download(version: TPackageVersion): TTarArchive;
> +begin
> + WriteLn('ACHTUNG - Download auf unspezifiziertem Repository!');
> + exit(nil);
> +end;
Mach die Methode einfach abstrakt, dann brauchst du auch nicht so eine
komische Implementierung zu machen, die es an einer ganz anderen Stelle
krachen läßt (gilt für die nächsten beiden auch)
> +
> +function TRepository.PrepareLists: boolean;
> +var
> + pkglisturl: String;
> +begin
> + WriteLn('ACHTUNG - PrepareLists auf unspezifiziertem Repository!');
> + exit(false);
> +end;
> +
> +function TRepository.FetchLists(pkgset: TPackageSet): boolean;
> +begin
> + WriteLn('ACHTUNG - FetchLists auf unspezifiziertem Repository!');
> + exit(false);
> +end;
> +
> +begin
> +end.
Das begin ist überflüssig.
> diff --git a/trunk/src/modules/pas/lpt/helpers.pas
> b/trunk/src/modules/pas/lpt/helpers.pas new file mode 100644
> index 0000000..91c09d4
> --- /dev/null
> +++ b/trunk/src/modules/pas/lpt/helpers.pas
> @@ -0,0 +1,242 @@
> +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 DownloadURI(url, filename: String): boolean;
> +function DownloadURI(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 DownloadURI(url, filename: String): boolean;
> +var
> + f: File;
> + httpc: HTTPRequest;
> + tar: TTarArchive;
> + i: integer;
> +begin
> + DownloadURI := false;
> + 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);
> + end else begin
> + Assign(f, filename);
> + Rewrite(f, httpc.responseLength);
> + BlockWrite(f, httpc.binaryResponseBody^, 1);
> + Close(f);
> + DownloadURI := true;
> + end;
> +
> + httpc.done;
> + except
> + on e: Exception do WriteLn('EXCEPTION: ', e.message);
> + end;
> +end;
> +
> +function DownloadURI(url: String): TTarArchive;
> +var
> + f: File;
> + httpc: HTTPRequest;
> + tar: TTarArchive;
> + i: integer;
> +begin
> + DownloadURI := nil;
> + 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);
> + end else begin
> + tar := TTarArchive.create(httpc.binaryResponseBody,
> httpc.responseLength); + DownloadURI := tar;
> + end;
> +
> + httpc.done;
> + except
> + on e: Exception do WriteLn('EXCEPTION: ', e.message);
> + end;
> +end;
Zum einen hast du hier einen Haufen Codeduplikation. Das ganze Herunterladen
ist in beiden DownloadURI gleich, nur hinterher das Anlegen des Archivs bzw.
das Schreiben der Datei ist gleich. Also sollte der Rest in einer eigenen
(nicht zum Interface gehörenden) Funktion landen, der von beiden aufgerufen
wird.
Mit der Funktionsüberladung bin ich auch nicht ganz glücklich. Die Funktionen
machen schon irgendwie unterschiedliche Dinge und haben unterschiedliche
Rückgabewerte. Unterschiedliche Namen wären dann vielleicht gar nicht so
blöd.
> +
> +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.
Kann ich davon ausgehen, daß diese Funktionen einfach unverändert verschoben
sind?
> diff --git a/trunk/src/modules/pas/lpt/httprepository.pas
> b/trunk/src/modules/pas/lpt/httprepository.pas new file mode 100644
> index 0000000..b34a37a
> --- /dev/null
> +++ b/trunk/src/modules/pas/lpt/httprepository.pas
> @@ -0,0 +1,55 @@
> +unit httprepository;
> +{$MODE ObjFPC}
> +
> +interface
> +uses sysutils, classes, tar, packages, helpers, baserepository;
> +
> +type
> + THTTPRepository = class(TRepository)
> + public
> + constructor create(parent : TCollection);
> + function Download(version: TPackageVersion): TTarArchive;
> override; + function PrepareLists: boolean; override;
> + function FetchLists(pkgset: TPackageSet): boolean; override;
> + end;
> +
> +implementation
> +
> +constructor THTTPRepository.create(parent : TCollection);
> +begin
> + inherited;
> + repostype := 'http';
> +end;
> +
> +function THTTPRepository.Download(version: TPackageVersion): TTarArchive;
> +var
> + archiveURI: String;
> +begin
> + archiveURI := self.url + version.pkg.name + '-'
> + + version.section.section + '-' + version.version + '-' + getArch
> + + '.tar';
> + exit(DownloadURI(archiveURI));
> +end;
> +
> +function THTTPRepository.PrepareLists: boolean;
> +var
> + pkglisturl: String;
> +begin
> + if self.url[length(self.url)] <> '/' then begin
> + pkglisturl := self.url + '/packages.' + getArch;
> + end else begin
> + pkglisturl := self.url + 'packages.' + getArch;
> + end;
> +
> + WriteLn('Lade Paketliste ' + self.name + ' von ' + pkglisturl);
> + exit(DownloadURI(pkglisturl, getConfigRoot + 'pkglist.' + self.name));
> +end;
> +
> +function THTTPRepository.FetchLists(pkgset: TPackageSet): boolean;
> +begin
> + ScanFile(pkgset, getConfigRoot + 'pkglist.' + self.name, self.name);
> + exit(true);
> +end;
> +
> +begin
> +end.
> diff --git a/trunk/src/modules/pas/lpt/lpt.pas
> b/trunk/src/modules/pas/lpt/lpt.pas index 62e0980..e3f613d 100644
> --- a/trunk/src/modules/pas/lpt/lpt.pas
> +++ b/trunk/src/modules/pas/lpt/lpt.pas
> @@ -1,118 +1,7 @@
> program lpt;
> {$MODE ObjFPC}
>
> -uses crt, dos, sysutils, classes, tar, tcpip, http, packages,
> repositories; -
> -const
> - configRoot: String = 'file:/config/lpt/';
> - arch: String = 'i386';
> -
> -
> -procedure mkpath(path: string);
> -var
> - i: integer;
> - prefix: String;
> -begin
> - //WriteLn('mkpath ' + path);
> - i := 1;
> - while i <= length(path) do begin
> - if path[i] = '/' then begin
> - //Write('> ');
> - prefix := Copy(path, 1, i);
> - if not FileExists(prefix) then begin
> - //WriteLn('mkdir ''', prefix, '''');
> - mkdir(prefix);
> - end else begin;
> - //WriteLn(prefix);
> - end;
> - end;
> - Inc(i);
> - 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;
> -
> -
> -
> -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 Download(url, filename: String; do_untar: boolean = false):
> boolean; -var
> - f: File;
> - httpc: HTTPRequest;
> - tar: TTarArchive;
> -begin
> - Download := false;
> - 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);
> - end else if do_untar then begin
> - tar := TTarArchive.create(httpc.binaryResponseBody,
> httpc.responseLength); - Untar(tar);
> - Download := true;
> - end else begin
> - Assign(f, filename);
> - Rewrite(f, httpc.responseLength);
> - BlockWrite(f, httpc.binaryResponseBody^, 1);
> - Close(f);
> - Download := true;
> - end;
> -
> - httpc.done;
> - except
> - on e: Exception do WriteLn('EXCEPTION: ', e.message);
> - end;
> -
> -end;
> +uses crt, dos, sysutils, classes, tar, helpers, packages, repositories,
> baserepository;
>
> 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');
Äh, naja. Finde ich jetzt nicht so toll, diese Fehlermeldung. Davon abgesehen
solltest du lieber Exceptions fangen als einen Rückgabewert zu prüfen, der im
Moment immer true ist. Die Exceptions können in ScanFile nämlich wirklich
fliegen. Und eine Fehlermeldung macht sich da besser als ein Stacktrace. Das
Exceptionhandling hast du ja grad drei Zeilen drüber entfernt.
Und daß die Fehlermeldung rot ist, kannst du von dort auch gleich wieder
reinnehmen. ;-)
> 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
Dieser Hunk sieht überflüssig aus.
> @@ -302,7 +160,6 @@ begin
> end;
> end;
> end;
> -
> end;
>
> procedure List;
Der 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/packages.pas
> b/trunk/src/modules/pas/lpt/packages.pas index eac8471..c1f4130 100644
> --- a/trunk/src/modules/pas/lpt/packages.pas
> +++ b/trunk/src/modules/pas/lpt/packages.pas
> @@ -2,7 +2,7 @@ unit packages;
> {$MODE ObjFPC}
>
> interface
> -uses sysutils, classes;
> +uses sysutils, classes, tar;
>
> type
> EPackageFileFormat = class(Exception) end;
> @@ -23,7 +23,6 @@ type
> constructor create;
> destructor destroy; override;
>
> - procedure ScanFile(filename, repository: String);
> function add(name: String): TPackage;
> procedure AddAll(pkgset: TPackageSet);
> procedure AddVersion(ver: TPackageVersion);
> @@ -96,92 +95,6 @@ begin
> packages.free;
> end;
>
> -procedure TPackageSet.ScanFile(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 := self.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;
> -
> function TPackageSet.add(name: String): TPackage;
> var
> pkg: TPackage;
> diff --git a/trunk/src/modules/pas/lpt/repositories.pas
> b/trunk/src/modules/pas/lpt/repositories.pas index 7484ab6..c68ec66 100644
> --- a/trunk/src/modules/pas/lpt/repositories.pas
> +++ b/trunk/src/modules/pas/lpt/repositories.pas
> @@ -2,32 +2,47 @@ unit repositories;
> {$MODE ObjFPC}
>
> interface
> -uses sysutils, classes;
> -
> -type
> - TRepository = class(TCollectionItem)
> - public
> - name: String;
> - url: String;
> - end;
> -
> +uses sysutils, classes, helpers, baserepository, httprepository;
>
> procedure ReadPkgsrc(filename: String);
> +procedure AddRepository(name, url, repostype: String);
> function GetRepository(name: String): TRepository;
> -
> +function GetAllRepositories(): TCollection;
>
> implementation
>
> var
> repos: TCollection;
>
> +procedure AddRepository(name, url, repostype: String);
Willst du wirklich keinen Aufzählungstyp statt dem String benutzen? Oder wenn
du mutig bist eine class of TRepository.
> +var
> + repo: TRepository;
> +begin
> + if repostype = 'http' then begin
> + repo := THTTPRepository.create(repos);
> + end else begin
> + WriteLn('ACHTUNG - Repository unbekannten Typs erzeugen geht
> nicht!'); + WriteLn('Angefordert: ' + repostype);
> + 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: String;
> space: integer;
> + protofinder: integer;
> begin
> Assign(f, filename);
> Reset(f);
> @@ -44,15 +59,19 @@ begin
> if space > 0 then begin
> name := Copy(url, 1, space - 1);
> url := Copy(url, space + 1, length(url));
> + protofinder := Pos('http://', url);
> + if protofinder > 0 then begin
> + repostype := 'http';
> + end else begin
> + repostype := '';
> + 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;