Writing and SegInfo to Store1.
[brdnet.git] / Store1.pas
blob1b6fd0848cb75769ff14f73518beadf0002a69aa
1 UNIT Store1;
2 {Take tracks of files in store}
3 {just simple, no cleaning, etc}
4 INTERFACE
5 uses SysUtils;
7 type
8 tfid=array [0..19] of byte;
9 tStoreObjectInfo=object
10 final:boolean; {hash matched}
11 rc:Word; {0=no error 1=not found, other}
12 length:LongWord; {the whole file}
13 seglen:longword; {from cur to end of segment}
15 procedure Open(const fid:tfid);
16 procedure Close;
17 procedure SegSeek(ofs:LongWord); unimplemented;
18 procedure ReadAhead(cnt:Word; into:pointer);
19 procedure WaitRead; {wait for read to finish, rc}
20 procedure EnableWrite(const fid:tFID);
21 procedure SetLength(len:LongWord);
22 procedure WriteSeg(ofs:LongWord;len:word;data:pointer);
23 procedure GetMiss(out ofs:LongWord; out len:LongWord; var state:pointer);
24 procedure GetMiss(out ofs:LongWord; out len:LongWord);
25 private
26 dh:tHandle; {handle to the data file}
27 filename:string[80];
28 segi:pointer{to seg info obj};
29 end;
30 tObjectInfo=tStoreObjectInfo;
32 {Should consult Download on non-final files}
34 IMPLEMENTATION
35 const prefix='object';
37 type
38 tSegStatic=packed object
39 first,after:LongWord;
40 end;
41 tSeg_ptr=^tSeg;
42 tSeg=object(tSegStatic)
43 next:tSeg_ptr;
44 end;
45 tSegInfo_ptr=^tSegInfo;
46 pSegInfo=tSegInfo_ptr;
47 tSegInfo=object
48 cache:^tSeg;
49 name:tFID;
50 refc:byte;
51 next:tSegInfo_ptr;
52 procedure SetSeg(ofs,len:LongWord; state:boolean);
53 function GetSegLen(ofs:LongWord):LongWord;
54 procedure Free;
55 end;
56 var SegInfoChain:^tSegInfo;
59 procedure mkfilen(var d:string; flag:char; const fid:tfid);
60 function hc(b:byte):char;
61 begin
62 if b<10 then hc:=char(ord('0')+b)
63 else hc:=char(ord('A')-10+b);
64 end;
65 var b,i:byte;
66 begin
67 d:=prefix+flag+'/';
68 b:=system.length(d);
69 SetLength(d,b+40);
70 inc(b);
71 for i:=0 to 19 do begin
72 d[b+(i*2)]:=hc(fid[i] shr 4);
73 d[b+(i*2)+1]:=hc(fid[i] and $F);
74 end;
75 end;
77 function GetSegInfo(const fid:tFID):tSegInfo_ptr;
78 var fn:string;
79 var fh:file of tSegStatic;
80 var cp:^tSeg;
81 label nocr;
82 begin
83 result:=SegInfoChain;
84 while assigned(result) do begin
85 if CompareWord(result^.name,fid,10)=0 then goto nocr;
86 result:=result^.next;
87 end;
88 mkfilen(fn,'i',fid);
89 new(result);
90 with result^ do begin
91 cache:=nil;
92 name:=fid;
93 refc:=0;
94 next:=nil;
95 SegInfoChain:=result;
96 Assign(fh,fn);
97 {$I-}ReSet(fh);{$I+}if ioresult=0 then begin
98 while not eof(fh) do begin
99 new(cp);
100 read(fh,cp^);
101 cp^.next:=cache;
102 cache:=cp;
103 end;
104 close(fh);
105 end;
106 end;
107 nocr:
108 Inc(result^.refc);
109 end;
111 procedure tStoreObjectInfo.Open(const fid:tfid);
112 begin
113 mkfilen(filename,'f',fid);
114 segi:=nil;
115 dh:=FileOpen(filename,fmOpenRead or fmShareDenyWrite);
116 if dh<>-1 then begin
117 rc:=0;
118 final:=true;
119 length:=FileSeek(dh,0,fsFromEnd);
120 FileSeek(dh,0,fsFromBeginning);
121 end else begin
122 mkfilen(filename,'p',fid);
123 final:=false;
124 dh:=FileOpen(filename,fmOpenRead or fmShareDenyWrite);
125 if dh<>-1 then begin
126 rc:=0;
127 final:=false;
128 length:=FileSeek(dh,0,fsFromEnd);
129 FileSeek(dh,0,fsFromBeginning);
130 segi:=GetSegInfo(fid);
131 end else begin
132 Writeln('Store1: open failed for file ',filename,', ioresult=',IOResult);
133 rc:=2;
134 end;
135 end;
136 end;
138 procedure tStoreObjectInfo.EnableWrite(const fid:tFID);
139 begin
140 assert((dh=-1)or(not final));
141 if dh=-1 then begin
142 {file was close, create}
143 dh:=FileCreate(filename);
144 {init length and segments}
145 length:=0;
146 segi:=GetSegInfo(fid);
147 end;
148 if dh<>-1 then begin
149 {file was open, close and reopen rw}
150 FileClose(dh);
151 dh:=FileOpen(filename,fmOpenReadWrite or fmShareDenyWrite);
152 end;
153 if dh=-1 then rc:=2 else rc:=0;
154 end;
155 procedure tStoreObjectInfo.SetLength(len:LongWord);
156 begin
157 assert( (length=0)and(not final)and(dh<>-1) );
158 length:=len;
159 {todo: errors!!!}
160 FileSeek(dh,len,fsFromBeginning);
161 FileSeek(dh,0,fsFromBeginning);
162 end;
163 procedure tSegInfo.SetSeg(ofs,len:LongWord; state:boolean);
164 var cp:^tSeg;
165 var pcp:^pointer;
166 var after:LongWord;
167 begin
168 assert(state);
169 after:=ofs+len;
170 pcp:=@cache;
171 cp:=cache;
172 while assigned(cp) do begin
173 if cp^.after=ofs then begin
174 {merge left-matching}
175 pcp^:=cp^.next;
176 ofs:=cp^.first;
177 dispose(cp);
178 cp:=pcp^;
179 continue;
180 end;
181 if cp^.first=after then begin
182 {merge right-matching}
183 pcp^:=cp^.next;
184 after:=cp^.after;
185 dispose(cp);
186 cp:=pcp^;
187 continue;
188 end;
189 pcp:=@cp^.next;
190 cp:=pcp^;
191 end;
192 {add the merged seg}
193 new(cp);
194 cp^.first:=ofs;
195 cp^.after:=after;
196 cp^.next:=cache;
197 cache:=cp;
198 end;
199 procedure tStoreObjectInfo.WriteSeg(ofs:LongWord;len:word;data:pointer);
200 begin
201 {todo: errors!!!}
202 FileSeek(dh,ofs,fsFromBeginning);
203 FileWrite(dh,data^,len);
204 tSegInfo(segi^).SetSeg(ofs,len,true);
205 end;
206 procedure tStoreObjectInfo.GetMiss(out ofs:LongWord; out len:LongWord; var state:pointer);
207 begin
208 with tSegInfo(segi^) do begin
209 assert(false);
210 end;
211 end;
212 procedure tStoreObjectInfo.GetMiss(out ofs:LongWord; out len:LongWord);
213 var state:pointer;
214 begin
215 state:=nil;
216 GetMiss(ofs,len,state);
217 end;
220 procedure tStoreObjectInfo.ReadAhead(cnt:Word; into:pointer);
221 var red:LongWord;
222 begin
223 //todo, do real async read
224 assert(seglen>=cnt);
225 red:=FileRead(dh,into^,cnt);
226 seglen:=seglen-red;
227 if red=cnt then rc:=0 else begin
228 //todo
229 writeln('Store1: read ',red,' out of ',cnt,' requested bytes');
230 rc:=2;
231 end;
232 end;
233 procedure tStoreObjectInfo.WaitRead; {wait for read to finish, rc}
234 begin
235 //todo
236 end;
237 procedure tSegInfo.Free;
238 var fn:string;
239 var fh:file of tSegStatic;
240 var cp:^tSeg;
241 begin
242 Dec(refc); if refc>0 then exit;
243 {save segs, free segs, free}
244 mkfilen(fn,'i',name);
245 Assign(fh,fn);
246 ReWrite(fh);
247 while assigned(cache) do begin
248 cp:=cache;
249 write(fh,cp^);
250 cache:=cp^.next;
251 dispose(cp);
252 end;
253 FreeMem(@self,sizeof(self));
254 end;
255 procedure tStoreObjectInfo.Close;
256 begin
257 if assigned(segi) then tSegInfo(segi^).Free;
258 FileClose(dh);
259 end;
261 function tSegInfo.GetSegLen(ofs:LongWord):LongWord;
262 var cp:^tSeg;
263 begin
264 cp:=cache;
265 while assigned(cp) do begin
266 if (cp^.first<=ofs)and(cp^.after>ofs) then begin
267 GetSegLen:=cp^.after-ofs;
268 exit end;
269 cp:=cp^.next;
270 end;
271 GetSegLen:=0;
272 end;
273 procedure tStoreObjectInfo.SegSeek(ofs:longword);
274 begin
275 if final then begin
276 if ofs<=length then begin
277 seglen:=length-ofs;
278 FileSeek(dh,ofs,fsFromBeginning);
279 rc:=0;
280 end else rc:=5;
281 end else if assigned(segi) then begin
282 seglen:=tSegInfo(segi^).GetSegLen(ofs);
283 if seglen=0 then rc:=4 else if FileSeek(dh,ofs,fsFromBeginning)<>ofs then rc:=3 else rc:=0;
284 end else rc:=7;
285 end;
287 BEGIN
288 SegInfoChain:=nil;
289 END.