diff --git a/src/engine/e_res.pas b/src/engine/e_res.pas
index db328791be0a74d3cf40e5915a16a5165b0058db..e48cc32ed5746264150eb419cbf14ee36db99135 100644 (file)
--- a/src/engine/e_res.pas
+++ b/src/engine/e_res.pas
function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean;
function e_FindWad (dirs: SSArray; name: AnsiString): AnsiString;
- {--- append dirs to 'path.wad:\file'. if disk is void, append defWad ---}
+ {--- returns relative wad name; never empty string ---}
+ function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString;
+
+ {--- prepend dirs to 'disk.wad:\file'. if empty disk string then prepend defWad ---}
+ {--- return empty string if error occured or 'path/to/disk.wad:\file' on success ---}
function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString;
{--- same as SysUtils.FinFirst ---}
- function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TRawbyteSearchRec): LongInt;
+ function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
+
+ {--- try to get a writeable directory from list, throws if no one directory created ---}
+ {--- (unless `required` is `false`: in this case, returns empty string) ---}
+ {--- creates all necessary subdirs, if it can ---}
+ function e_GetWriteableDir (dirs: SSArray; required: Boolean=true): AnsiString;
- {--- try to create directory from list, throws if no one directory created ---}
- function e_GetDir (dirs: SSArray): AnsiString;
+ function e_CanCreateFilesAt (dir: AnsiString): Boolean;
implementation
- uses WadReader, e_log;
+ uses WadReader, e_log, hashtable;
type
SpawnProc = function (pathname: AnsiString): Tstream;
+ var
+ writeableDirs: THashStrCIStr = nil;
+
+
function e_UpperDir (path: AnsiString): AnsiString;
var i: Integer;
begin
end
end;
+ function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString;
+ var
+ s: AnsiString;
+ maxpfx: AnsiString = '';
+ pfx: AnsiString;
+ begin
+ result := name;
+ if not findFileCI(name) then exit;
+ for s in dirs do
+ begin
+ if (length(s) = 0) then continue;
+ if (length(name) <= length(s)) then continue;
+ if (length(s) < length(maxpfx)) then continue;
+ pfx := s;
+ if not findFileCI(pfx, true) then continue;
+ if (pfx[length(pfx)] <> '/') and (pfx[length(pfx)] <> '\') then pfx := pfx+'/';
+ if (length(pfx)+1 > length(name)) then continue;
+ if (strEquCI1251(copy(name, 1, length(pfx)), pfx)) then maxpfx := pfx;
+ end;
+ if (length(maxpfx) > 0) then
+ begin
+ result := name;
+ Delete(result, 1, length(maxpfx));
+ end;
+ end;
+
function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString;
var diskName, fileName: AnsiString;
begin
if debug_e_res then
- e_LogWritefln('e_GetResourcePath0 %s (%s)', [path, defWad]);
- assert(dirs <> nil);
+ e_LogWritefln('e_GetResourcePath %s (%s)', [path, defWad]);
+ assert(length(dirs) > 0);
assert(path <> '');
assert(defWad <> '');
diskName := g_ExtractWadName(path);
fileName := g_ExtractFilePathName(path);
if diskName = '' then diskName := defWad else diskName := e_FindWad(dirs, diskName);
- assert(diskName <> '', 'oh fuck, wad "' + diskName + '" not founded');
- result := diskName + ':\' + fileName;
+ if diskName = '' then result := '' else result := diskName + ':\' + fileName;
if debug_e_res then
e_LogWritefln(' this>>> %s', [result]);
end;
- function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TRawbyteSearchRec): LongInt;
+ function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
var i: Integer; dir: AnsiString;
begin
if debug_e_res then
result := FindFirst(dir, attr, Rslt);
if debug_e_res then
e_LogWritefln(' %s: %s -- %s', [i, dir, result]);
- Dec(i);
+ Dec(i);
end
end;
- function e_GetDir (dirs: SSArray): AnsiString;
- var i: Integer;
+ // k8: sorry. i know that this sux, but checking directory access rights is unreliable (unportable).
+ function e_CanCreateFilesAt (dir: AnsiString): Boolean;
+ var
+ f: Integer;
+ st: TStream = nil;
+ sr: TSearchRec;
+ fn: AnsiString;
+ begin
+ result := false;
+ for f := 0 to $7fffffff do
+ begin
+ fn := Format('%s/$$$temptest$$$_%d.$$$%d$$$', [dir, f, f]);
+ if (FindFirst(fn, faAnyFile, sr) = 0) then
+ begin
+ FindClose(sr);
+ continue;
+ end;
+ FindClose(sr);
+ try
+ st := TFileStream.Create(fn, fmCreate);
+ except // sorry
+ st := nil; // just in case
+ end;
+ if assigned(st) then
+ begin
+ st.Free();
+ try DeleteFile(fn); except end;
+ result := true;
+ end;
+ exit;
+ end;
+ end;
+
+ function e_GetWriteableDir (dirs: SSArray; required: Boolean=true): AnsiString;
+ var
+ f: Integer;
begin
+ assert(length(dirs) > 0);
+ result := '';
+ if assigned(writeableDirs) then
+ begin
+ for f := High(dirs) downto Low(dirs) do
+ begin
+ if (writeableDirs.get(dirs[f], result)) then
+ begin
+ //writeln('*** KNOWN WRITEABLE DIR: "', result, '"');
+ exit;
+ end;
+ end;
+ end;
+ for f := High(dirs) downto Low(dirs) do
+ begin
+ try
+ if ForceDirectories(dirs[f]) then
+ begin
+ result := dirs[f];
+ if (findFileCI(result, true)) then
+ begin
+ if e_CanCreateFilesAt(result) then
+ begin
+ if not assigned(writeableDirs) then writeableDirs := THashStrCIStr.Create();
+ writeableDirs.put(dirs[f], result);
+ //writeln('*** NEW WRITEABLE DIR: "', result, '" ("', dirs[f], '"); rq=', required);
+ exit;
+ end;
+ end;
+ end;
+ except // sorry
+ end;
+ end;
+ if required then raise Exception.Create(Format('unable to create directory "%s"', [dirs[High(dirs)]]));
result := '';
- i := High(dirs);
- while (i >= 0) and (ForceDirectories(dirs[i]) = false) do Dec(i);
- if i >= 0 then
- result := dirs[i]
- else
- raise Exception.Create('unable to create directory')
end;
end.