1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
{
This file is part of the Free Pascal test suite.
Copyright (c) 2006 by the Free Pascal development team.
This program collects the results of a testsuite run
and prepares things for an upload of the results to the
database
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
program prepup;
uses
sysutils,libtar,zstream;
const
use_longlog : boolean = false;
has_file_errors : boolean = false;
MAX_RETRY = 5;
RETRY_WAIT_TIME = 1000; { One second wait time before trying again }
var
tarwriter : ttarwriter;
c : tgzfilestream;
procedure dosearch(const dir : string);
procedure domask(const s : string);
Var
Info : TSearchRec;
hs : string;
tries : longint;
write_ok : boolean;
begin
If FindFirst (dir+DirectorySeparator+s,faAnyFile,Info)=0 then
begin
Repeat
With Info do
begin
hs:=dir+DirectorySeparator+Name;
{ strip leading ./ }
delete(hs,1,2);
if not tarwriter.addfile(hs) then
begin
tries:=1;
write_ok:=false;
while tries<MAX_RETRY do
begin
sleep(RETRY_WAIT_TIME);
inc(tries);
if tarwriter.addfile(hs) then
begin
write_ok:=true;
tries:=MAX_RETRY;
end;
end;
has_file_errors:=(write_ok=false);
if not write_ok then
tarwriter.addstring('###File Open failed###',
ConvertFileName(hs),Info.Time);
end;
end;
Until FindNext(info)<>0;
end;
FindClose(Info);
end;
Var Info : TSearchRec;
Begin
If FindFirst (dir+DirectorySeparator+'*',faDirectory,Info)=0 then
begin
Repeat
With Info do
begin
If ((Attr and faDirectory) = faDirectory) and (name<>'.') and (name<>'..') then
dosearch(dir+DirectorySeparator+name);
end;
Until FindNext(info)<>0;
end;
FindClose(Info);
domask('*.elg');
domask('*.log');
End;
var
index : longint;
const
has_errors : boolean = false;
begin
index:=1;
if paramcount<>1 then
begin
if paramstr(1)='-ll' then
begin
use_longlog:=true;
index:=2;
end
else
begin
writeln('Usage: prepup [-ll] <name of .tar.gz>');
Writeln('Optional -ll parameter is used to specify use of longlog');
halt(1);
end
end;
C:=TGZFileStream.Create(paramstr(index),gzOpenWrite);
TarWriter := TTarWriter.Create (C);
if not use_longlog then
dosearch('.');
if not TarWriter.AddFile('dbdigest.cfg') then
has_errors:=true;
if not TarWriter.AddFile('log') then
has_errors:=true;
if use_longlog then
if not TarWriter.AddFile('longlog') then
has_errors:=true;
TarWriter.free;
c.free;
if has_file_errors then
writeln(stderr,'Prepup error: some files were not copied');
if has_errors then
halt(2);
end.
|
