src/engine/e_res.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$I ../shared/a_modes.inc}
  16 unit e_res;
  17
  18 interface
  19
  20   uses SysUtils, Utils, Classes;
  21
  22   var
  23     debug_e_res: Boolean;
  24
  25   {-------------------------------------------}
  26   {--- insert separator beetwin a and b    ---}
  27   {--- result are correct if (a or b) = '' ---}
  28   {--- - - - - - - - - - - - - - - - - - - ---}
  29   function e_CatPath (a, b: AnsiString): AnsiString;
  30
  31   {--- remove last entry from path ---}
  32   function e_UpperDir (path: AnsiString): AnsiString;
  33
  34   {--- not absolute and have no relative dirs ---}
  35   function e_IsValidResourceName (name: AnsiString): Boolean;
  36
  37   {-----------------------------------------------------------------------}
  38   {--- try to open/create file in one dir from `dirs` in reverse order ---}
  39   {--- e_OpenResourceRW tries to create if not exists                  ---}
  40   {--- create dirs if not exists                                       ---}
  41   {--- result <> nil, throws exceptions on errors                      ---}
  42   {--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ---}
  43   function e_CreateResource (dirs: SSArray; name: AnsiString): TStream;
  44   function e_OpenResourceRO (dirs: SSArray; name: AnsiString): TStream;
  45   function e_OpenResourceRW (dirs: SSArray; name: AnsiString): TStream;
  46
  47   {--- same as shared/utils ---}
  48   function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean;
  49   function e_FindWad (dirs: SSArray; name: AnsiString): AnsiString;
  50
  51   {--- returns relative wad name; never empty string ---}
  52   function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString;
  53
  54   {--- prepend dirs to 'disk.wad:\file'. if empty disk string then prepend defWad  ---}
  55   {--- return empty string if error occured or 'path/to/disk.wad:\file' on success ---}
  56   function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString;
  57
  58   {--- same as SysUtils.FinFirst ---}
  59   function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
  60
  61   {--- try to get a writeable directory from list, throws if no one directory created ---}
  62   {--- (unless `required` is `false`: in this case, returns empty string) ---}
  63   {--- creates all necessary subdirs, if it can ---}
  64   function e_GetWriteableDir (dirs: SSArray; required: Boolean=true): AnsiString;
  65
  66   function e_CanCreateFilesAt (dir: AnsiString): Boolean;
  67
  68 implementation
  69
  70   uses WadReader, e_log, hashtable;
  71
  72   type
  73     SpawnProc = function (pathname: AnsiString): Tstream;
  74
  75   var
  76     writeableDirs: THashStrCIStr = nil;
  77
  78
  79   function e_UpperDir (path: AnsiString): AnsiString;
  80     var i: Integer;
  81   begin
  82     i := High(path);
  83     while (i >= 1) and (path[i] <> '/') and (path[i] <> '\') do Dec(i);
  84     result := Copy(path, 1, i)
  85   end;
  86
  87   function HasRelativeDirs (name: AnsiString): Boolean;
  88     var i: Integer; ch: Char;
  89   begin
  90     i := 1;
  91     result := false;
  92     while (result = false) and (name[i] <> #0) do
  93     begin
  94       ch := name[i];
  95       if (ch = '/') or (ch = '\') then
  96       begin
  97         Inc(i);
  98         if name[i] = '.' then
  99         begin
 100           Inc(i);
 101           if name[i] = '.' then
 102           begin
 103             Inc(i);
 104             ch := name[i];
 105             result := (ch = #0) or (ch = '/') or (ch = '\')
 106           end
 107         end
 108       end
 109       else
 110       begin
 111         Inc(i)
 112       end
 113     end
 114   end;
 115
 116   function HasAbsoluteDirs (name: AnsiString): Boolean;
 117   begin
 118     result := (name = '') or (name[1] = '/') or (name[1] = '\')
 119   end;
 120
 121   function e_IsValidResourceName (name: AnsiString): Boolean;
 122   begin
 123     result := (HasAbsoluteDirs(name) = false) and (HasRelativeDirs(name) = false)
 124   end;
 125
 126   function SpawnStream (dirs: SSArray; name: AnsiString; p: SpawnProc; createNewDir: Boolean): TStream;
 127     var i: Integer;
 128   begin
 129     result := nil;
 130     assert(dirs <> nil);
 131     assert(e_IsValidResourceName(name));
 132     i := High(dirs);
 133     while (i >= 0) and (result = nil) do
 134     begin
 135       try
 136         if debug_e_res then
 137           e_LogWritefln('  %s', [dirs[i]]);
 138         if (createNewDir = false) or (ForceDirectories(dirs[i]) = true) then
 139           result := p(e_CatPath(dirs[i], name))
 140       finally
 141         Dec(i)
 142       end
 143     end
 144   end;
 145
 146   function e_CreateResource (dirs: SSArray; name: AnsiString): TStream;
 147   begin
 148     if debug_e_res then
 149       e_LogWritefln('e_CreateResource %s', [name]);
 150     result := SpawnStream(dirs, name, @createDiskFile, true);
 151     if result = nil then
 152       raise Exception.Create('can''t create resource "' + name + '"');
 153   end;
 154
 155   function e_OpenResourceRO (dirs: SSArray; name: AnsiString): TStream;
 156   begin
 157     if debug_e_res then
 158       e_LogWritefln('e_OpenResourceRO %s', [name]);
 159     result := SpawnStream(dirs, name, @openDiskFileRO, false);
 160     if result = nil then
 161       raise EFileNotFoundException.Create('can''t open resource "' + name + '"')
 162   end;
 163
 164   function e_OpenResourceRW (dirs: SSArray; name: AnsiString): TStream;
 165   begin
 166     if debug_e_res then
 167       e_LogWritefln('e_OpenResourceRW %s', [name]);
 168     result := SpawnStream(dirs, name, @openDiskFileRW, true);
 169     if result = nil then
 170       raise Exception.Create('can''t create resource "' + name + '"')
 171   end;
 172
 173   function e_CatPath (a, b: AnsiString): AnsiString;
 174   begin
 175     if a = '' then
 176       result := b
 177     else if b = '' then
 178       result := a
 179     else
 180       result := a + '/' + b
 181   end;
 182
 183   function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean;
 184     var i: Integer; dir: AnsiString;
 185   begin
 186     if debug_e_res then
 187       e_LogWritefln('e_FindResource %s (%s)', [name, nameIsDir]);
 188     result := false;
 189     assert(dirs <> nil);
 190     assert(e_IsValidResourceName(name));
 191     i := High(dirs); dir := name;
 192     while (i >= 0) and (result = false) do
 193     begin
 194       dir := e_CatPath(dirs[i], name);
 195       result := findFileCI(dir, nameIsDir);
 196       if debug_e_res then
 197         e_LogWritefln('  %s -> %s', [dir, result]);
 198       Dec(i)
 199     end;
 200     if result = true then
 201       name := dir;
 202     if debug_e_res then
 203       e_LogWritefln('  result = %s (%s)', [name, result]);
 204   end;
 205
 206   function e_FindWad (dirs: SSArray; name: AnsiString): AnsiString;
 207     var i: Integer;
 208   begin
 209     if debug_e_res then
 210       e_LogWritefln('e_FindWad "%s"', [name]);
 211     result := '';
 212     assert(dirs <> nil);
 213     assert(e_IsValidResourceName(name));
 214     i := High(dirs);
 215     while (i >= 0) and (result = '') do
 216     begin
 217       result := findDiskWad(dirs[i] + DirectorySeparator + name);
 218       if debug_e_res then
 219         e_LogWritefln('  %s -> %s', [dirs[i] + DirectorySeparator + name, result]);
 220       Dec(i)
 221     end
 222   end;
 223
 224   function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString;
 225   var
 226     s: AnsiString;
 227     maxpfx: AnsiString = '';
 228     pfx: AnsiString;
 229   begin
 230     result := name;
 231     if not findFileCI(name) then exit;
 232     for s in dirs do
 233     begin
 234       if (length(s) = 0) then continue;
 235       if (length(name) <= length(s)) then continue;
 236       if (length(s) < length(maxpfx)) then continue;
 237       pfx := s;
 238       if not findFileCI(pfx, true) then continue;
 239       if (pfx[length(pfx)] <> '/') and (pfx[length(pfx)] <> '\') then pfx := pfx+'/';
 240       if (length(pfx)+1 > length(name)) then continue;
 241       if (strEquCI1251(copy(name, 1, length(pfx)), pfx)) then maxpfx := pfx;
 242     end;
 243     if (length(maxpfx) > 0) then
 244     begin
 245       result := name;
 246       Delete(result, 1, length(maxpfx));
 247     end;
 248   end;
 249
 250   function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString;
 251     var diskName, fileName: AnsiString;
 252   begin
 253     if debug_e_res then
 254       e_LogWritefln('e_GetResourcePath %s (%s)', [path, defWad]);
 255     assert(length(dirs) > 0);
 256     assert(path <> '');
 257     assert(defWad <> '');
 258     diskName := g_ExtractWadName(path);
 259     fileName := g_ExtractFilePathName(path);
 260     if diskName = '' then diskName := defWad else diskName := e_FindWad(dirs, diskName);
 261     if diskName = '' then result := '' else result := diskName + ':\' + fileName;
 262     if debug_e_res then
 263       e_LogWritefln('  this>>> %s', [result]);
 264   end;
 265
 266   function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
 267     var i: Integer; dir: AnsiString;
 268   begin
 269     if debug_e_res then
 270       e_LogWritefln('e_FindFirst %s', [name]);
 271     assert(dirs <> nil);
 272     assert(e_IsValidResourceName(name));
 273     i := High(dirs); result := -1;
 274     while (i >= 0) and (result <> 0) do
 275     begin
 276       dir := dirs[i] + DirectorySeparator + name;
 277       result := FindFirst(dir, attr, Rslt);
 278       if debug_e_res then
 279         e_LogWritefln('  %s: %s -- %s', [i, dir, result]);
 280       Dec(i);
 281     end
 282   end;
 283
 284   // k8: sorry. i know that this sux, but checking directory access rights is unreliable (unportable).
 285   function e_CanCreateFilesAt (dir: AnsiString): Boolean;
 286   var
 287     f: Integer;
 288     st: TStream = nil;
 289     sr: TSearchRec;
 290     fn: AnsiString;
 291   begin
 292     result := false;
 293     for f := 0 to $7fffffff do
 294     begin
 295       fn := Format('%s/$$$temptest$$$_%d.$$$%d$$$', [dir, f, f]);
 296       if (FindFirst(fn, faAnyFile, sr) = 0) then
 297       begin
 298         FindClose(sr);
 299         continue;
 300       end;
 301       FindClose(sr);
 302       try
 303         st := TFileStream.Create(fn, fmCreate);
 304       except // sorry
 305         st := nil; // just in case
 306       end;
 307       if assigned(st) then
 308       begin
 309         st.Free();
 310         try DeleteFile(fn); except end;
 311         result := true;
 312       end;
 313       exit;
 314     end;
 315   end;
 316
 317   function e_GetWriteableDir (dirs: SSArray; required: Boolean=true): AnsiString;
 318   var
 319     f: Integer;
 320   begin
 321     assert(length(dirs) > 0);
 322     result := '';
 323     if assigned(writeableDirs) then
 324     begin
 325       for f := High(dirs) downto Low(dirs) do
 326       begin
 327         if (writeableDirs.get(dirs[f], result)) then
 328         begin
 329           //writeln('*** KNOWN WRITEABLE DIR: "', result, '"');
 330           exit;
 331         end;
 332       end;
 333     end;
 334     for f := High(dirs) downto Low(dirs) do
 335     begin
 336       try
 337         if ForceDirectories(dirs[f]) then
 338         begin
 339           result := dirs[f];
 340           if (findFileCI(result, true)) then
 341           begin
 342             if e_CanCreateFilesAt(result) then
 343             begin
 344               if not assigned(writeableDirs) then writeableDirs := THashStrCIStr.Create();
 345               writeableDirs.put(dirs[f], result);
 346               //writeln('*** NEW WRITEABLE DIR: "', result, '" ("', dirs[f], '"); rq=', required);
 347               exit;
 348             end;
 349           end;
 350         end;
 351       except // sorry
 352       end;
 353     end;
 354     if required then raise Exception.Create(Format('unable to create directory "%s"', [dirs[High(dirs)]]));
 355     result := '';
 356   end;
 357
 358 end.