unit dengcache;

//
//  Unit for caching some data in external storage.
//

{$MODE FPC}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

uses
  deng,
  dfiles,
  dfilereader,
  dfilewriter,
  dansiview,
  dansibuffer;

type
PCache = ^TCache;
TCache = object
private
  FId: TAnsiBuffer;
  FCachePath: TAnsiBuffer;
  FAssigned: Boolean;
  FData: Pointer;
  FSize: SizeUInt;
  FLoaded: Boolean;
public
  procedure Init;
  procedure Init(const Id: TAnsiView);
  procedure Done;

  procedure Unload;
  //
  //  Unloads and unassigns any previous state.
  //
  function Load(const Id: TAnsiView): Boolean;
  //
  //  Tries to load cached data for the Id.
  //
  //  Id must contain only [a-z0-9_-] cahracters.
  //
  function Assigned: Boolean;
  //
  //  Returns True if some non-empty Id was assigned to the cache.
  //
  function Loaded: Boolean;
  //
  //  Returns True if the cache exists and actually loaded.
  //
  function Update(Data: Pointer; Size: SizeUInt): Boolean;
  //
  //  Updates content of the cache on the persistent storage.
  //  Does not change loaded memory to avoid corrupting pointers.
  //  Use Upload to do that.
  //
  function Upload: Boolean;
  //
  //  Refreshes content in Data and Size from actual file.
  //
  function Data: Pointer;
  function Size: SizeUInt;
end;

function dengValidateCacheId(Id: TAnsiView): Boolean;

procedure dengGenerateCacheId(Path: TAnsiView;
                              Info: TAnsiView;
                              var Id: TAnsiBuffer);
      //
      //  Returns an Id in a form
      //
      //      <escapedpath>_<escapedinfo><hash(Path,Info)>
      //
      //  where escapedpath and escapedinfo are safe versions of Path and Info.
      //

function dengSetCacheDirectory(Dir: TAnsiView): Boolean;

procedure dengSetDefaultCacheDirectory;

function dengHasCacheStorage: Boolean;

implementation

const
  CacheDirectory: AnsiString = '';

procedure TCache.Init;
begin
  FId.Init;
  FCachePath.Init;
  FAssigned := False;
  FData := nil;
  FSize := 0;
  FLoaded := False;
end;

procedure TCache.Init(const Id: TAnsiView);
begin
  Log('Init');
  Init;
  Log('Load');
  Load(Id);
end;

procedure TCache.Done;
begin
  Unload;
  FId.Done;
  FCachePath.Done;
end;

procedure TCache.Unload;
begin
  if FLoaded then begin
    FreeMem(FData);
    FData := nil;
    FSize := 0;
    FLoaded := False;
  end;
  if FAssigned then begin
    FId.ReInit('');
    FCachePath.ReInit('');
    FAssigned := False;
  end;
end;

function TCache.Load(const Id: TAnsiView): Boolean;
begin
  Log('Unload');
  Unload;
  Log('dengValidateCacheId');
  if not dengValidateCacheId(Id) then
    Exit(False);
  Log('dengValidateCacheId DONE');
  // Store the Id
  FId.ReInit(Id.Data, Id.Length);
  // Compute path to cache file
  FCachePath.SetLength(Length(CacheDirectory) + 1 + FId.Length);
  Move(CacheDirectory[1], FCachePath.Data^, Length(CacheDirectory));
  FCachePath.Data[Length(CacheDirectory)] := '/';
  Move(FId.Data^, (FCachePath.Data + Length(CacheDirectory) + 1)^, FId.Length);
  // Now we are in assigned state
  FAssigned := True;
  // Try to upload cache data
  Exit(Upload);
end;

function TCache.Assigned: Boolean;
begin
  Exit(FAssigned);
end;

function TCache.Loaded: Boolean;
begin
  Exit(FLoaded);
end;

function TCache.Update(Data: Pointer; Size: SizeUInt): Boolean;
begin
  if FAssigned then begin
    Exit(WriteFileContent(FCachePath.ToString, Data, Size));
  end else
    Exit(False);
end;

function TCache.Upload: Boolean;
begin
  if FLoaded then begin
    FreeMem(FData);
    FData := nil;
    FSize := 0;
    FLoaded := False;
  end;
  if FAssigned then begin
    if ReadFileContent(FCachePath.ToString, 0, PAnsiChar(FData), FSize) then begin
      FLoaded := True;
      Exit(True);
    end else begin
      FData := nil;
      FSize := 0;
      Exit(False);
    end;
  end else
    Exit(False);
end;

function TCache.Data: Pointer;
begin
  Exit(FData);
end;

function TCache.Size: SizeUInt;
begin
  Exit(FSize);
end;

function dengIsValidCacheChar(C: AnsiChar): Boolean; inline;
begin
  Exit(C in ['a'..'z', 'A'..'Z', '0'..'9', '_', '.']);
end;

function dengCountValidCacheChars(S, SEnd: PAnsiChar): PtrInt;
begin
  Result := 0;
  while S < SEnd do begin
    if dengIsValidCacheChar(S^) then
      Inc(Result);
    Inc(S);
  end;
end;

function dengValidateCacheId(Id: TAnsiView): Boolean;
var
  I: PAnsiChar;
begin
  I := Id.Data;
  while I < Id.Tail do begin
    if not dengIsValidCacheChar(I^) then begin
      Log('Bad character: ' + I^);
      Exit(False);
    end;
    Inc(I);
  end;
  Exit(True);
end;

function CutDirectory(Path: TAnsiView): TAnsiView;
var
  S: PAnsiChar;
begin
  S := Path.Tail - 1;
  while S >= Path.Data do begin
    if S^ in ['/', '\'] then
      Exit(AnsiView(S + 1, Path.Tail - S - 1));
    Dec(S);
  end;
  Exit(Path);
end;

function CutExtension(Path: TAnsiView): TAnsiView;
var
  S: PAnsiChar;
begin
  S := Path.Tail - 1;
  while S >= Path.Data do begin
    if S^ = '.' then
      Exit(AnsiView(Path.Data, S - Path.Data));
    Dec(S);
  end;
  Exit(Path);
end;

function CacheHash(Path, Info: TAnsiView): UInt32;
var
  S: PAnsiChar;
  W1, W2: UInt16;
begin
  W1 := 0;
  W2 := 0;
  S := Path.Data;
  while S < Path.Tail do begin
    Inc(W1, Ord(S^));
    Inc(W2, W1);
    Inc(S);
  end;
  Exit((W2 shl 16) or W1);
end;

function ExtractFileName(Path: TAnsiView): TAnsiView;
//
//  Extracts filename without extension.
//
begin
  Result := CutExtension(CutDirectory(Path));
end;

procedure dengGenerateCacheId(Path: TAnsiView;
                              Info: TAnsiView;
                              var Id: TAnsiBuffer);
var
  L: SizeUInt;
  I, O: PAnsiChar;
  H: AnsiString;
  Name: TAnsiView;
begin
  L := 1 + 8 + 6; // '_', 8 chars hash and '.cache'
  Name := ExtractFileName(Path);
  Inc(L, dengCountValidCacheChars(Name.Data, Name.Tail));
  Inc(L, dengCountValidCacheChars(Info.Data, Info.Tail));
  Id.SetLength(L);
  O := Id.Data;
  I := Name.Data;
  while I < Name.Tail do begin
    if dengIsValidCacheChar(I^) then begin
      O^ := I^;
      Inc(O);
    end;
    Inc(I);
  end;
  O^ := '_';
  Inc(O);
  I := Info.Data;
  while I < Info.Tail do begin
    if dengIsValidCacheChar(I^) then begin
      O^ := I^;
      Inc(O);
    end;
    Inc(I);
  end;
  H := HexStr(CacheHash(Path, Info), 8);
  Move(H[1], O^, 8);
  Inc(O, 8);
  Move(PAnsiChar('.cache')^, O^, 6);
end;

function dengSetCacheDirectory(Dir: TAnsiView): Boolean;
var
  S: AnsiString;
begin
  S := Dir.ToString;
  if (not DirExists(S)) and not MakeDirectory(S) then begin
    LogTagged('R', 'FAILED to mount cache directoty: ' + S);
    Exit(False);
  end;
  CacheDirectory := S;
  LogTagged('R', 'MOUNTED cache: ' + S);
  Exit(True);
end;

procedure dengSetDefaultCacheDirectory;
begin
  dengSetCacheDirectory('cache');
end;

function dengHasCacheStorage: Boolean;
begin
  Result := CacheDirectory <> '';
end;

end.
