unit uBafDataCache;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// Caching for lookup lists and such things

interface

uses Classes, System.SysUtils, System.StrUtils, System.Types, System.Math,
    uStringIniFile, uBafTypes, uBafComboHelper, DB, uBafPage, contnrs,
    dmMain, FMX.Graphics;

type
  TBafDataCache = class
  protected                      // LookupLists Specials
    FLookupList: TStringList;
    FLookupInterval: integer;
    FSpecialList: TStringList;
    function GetLookup(AName: string): TBafComboHelper;
    function GetSpecial(AName: string): TBafComboHelper;
    procedure BafComboHelperOnValue(Sender: TObject; var AValue: string);
  protected
    FUserGroups: TStringList;
    FRightIsAdmin: boolean;
  protected
    FGridSettingsIni: TStringIniFile;
  private
    FIsAdmin: boolean;
  protected                                 // Grid-Cache
    FGridCacheList: TStringList;
    FGlobalBitmapCache: TStringList;
  public                                    // general
    constructor Create;
    destructor Destroy; override;
    procedure RefreshAll;
  public                                      // LookupLists Specials
    property Lookup[AName: string]: TBafComboHelper read GetLookup;
    property LookupInterval: integer read FLookupInterval write FLookupInterval;

    property Special[AName: string]: TBafComboHelper read GetSpecial;
  public                                               // Rights
    procedure RefreshUserGroups(AUserUserId: string);
    property UserGroups: TStringList read FUserGroups;
    property RightIsAdmin: boolean read FRightIsAdmin;
    property IsAdmin: boolean read FIsAdmin write FIsAdmin;
  public                                               // Grid-Cache
    procedure SaveGridCache(ASegment: TBafPageSegment);
    function LoadGridCache(ASegment: TBafPageSegment): boolean;
    procedure LoadBitmap(ABitmap: FMX.Graphics.TBitmap; AFilename: string);

    procedure ClearGridChache;
  public
    property GridSettingsIni: TStringIniFile read FGridSettingsIni;
  end;

  TBafGridSegmentCacheCell = class
  private
    FText: string;
    FDataKeyColValue: string;
    FDataKey: string;
    FRowInserted: boolean;
  public
    property Text: string read FText write FText;
    property DataKeyValue: string read FDataKey write FDataKey;                     // Key in der Data-Table
    property DataKeyColValue: string read FDataKeyColValue write FDataKeyColValue;  // value for id_in_table
    property RowInserted: boolean read FRowInserted write FRowInserted;
  end;

  TBafGridSegmentCache = class
  private
    FRows: TObjectList;
    FRowCount: integer;
    FColCount: integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetDimensions(AColCount, ARowCount: integer);    // clears the cache
    function GetCell(ACol, ARow: integer): TBafGridSegmentCacheCell;
    property RowCount: integer read FRowCount;
    property ColCount: integer read FColCount;

  end;

  TBafCommandCacheItem = class
  private
    FCode: TStringList;
    FTimestamp: TDateTime;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TBafCommandCache = class
    FCommands: TStringList;
  public
    constructor Create;
    destructor Destroy; override;
    function GetCommand(AName: string; ACode: TStrings): boolean;
    procedure RefreshCommand(AName, ACode: string);
  end;


var
  gvBafDataCache: TBafDataCache;
  gvBafCommandCache: TBafCommandCache;
  gvGlobalVars: TStringList;

implementation

uses uBafInterpreter, uBafInterpreterModuleList;

var
  mvInterpreter: TBafInterpreter;


{ TBafDataCache }

procedure TBafDataCache.BafComboHelperOnValue(Sender: TObject; var AValue: string);
begin
  AValue := mvInterpreter.ReplaceFunctions(AValue);
end;

procedure TBafDataCache.RefreshAll;
// clearing the lists for filling them with the next use
var
  i: integer;
begin
  for i := 0 to FLookupList.Count - 1 do
    dataMain.RefreshLookup(FLookupList[i], FLookupList.Objects[i] as TBafComboHelper);
  for i := 0 to FSpecialList.Count - 1 do
    dataMain.RefreshSpecial(FSpecialList[i], FSpecialList.Objects[i] as TBafComboHelper);
  ClearGridChache;
end;

procedure TBafDataCache.ClearGridChache;
begin
  FGridCacheList.Clear;
end;

constructor TBafDataCache.Create;
begin
  inherited;
  mvInterpreter := TBafInterpreter.Create(itSrvProc);
  mvInterpreter.Inter := mvInterpreter;
  mvInterpreter.Name := 'dmMain';
  TBafInterpreterModuleList.CreateModule(mvInterpreter);



  FLookupList := TStringList.Create;
  FLookupList.OwnsObjects := true;
  FLookupInterval := 3600;
  FSpecialList := TStringList.Create;
  FSpecialList.OwnsObjects := true;
  FUserGroups := TStringList.Create;
  FGridCacheList := TStringList.Create;
  FGridCacheList.OwnsObjects := true;
  FGridCacheList.Sorted := true;
  FGridCacheList.Duplicates := dupError;
  FGridSettingsIni := TStringIniFile.Create('');
  FGlobalBitmapCache := TStringList.Create;
  FGlobalBitmapCache.OwnsObjects := true;
end;

destructor TBafDataCache.Destroy;
begin
  FreeAndNil(FGlobalBitmapCache);
  FreeAndNil(FGridSettingsIni);
  FreeAndNil(FUserGroups);
  FreeAndNil(FSpecialList);
  FreeAndNil(FLookupList);
  FreeAndNil(mvInterpreter);
  inherited;
end;

function TBafDataCache.GetLookup(AName: string): TBafComboHelper;
// gets the LookupList. If it doesn't exists or is out of date it fetches the data
var
  ix: integer;
begin
  AName := AnsiLowerCase(AName);
  ix := FLookupList.IndexOf(AName);
  if ix = -1 then begin
    result := TBafComboHelper.Create(false);
    result.OnSetValue := BafComboHelperOnValue;
    result.RefreshInterval := FLookupInterval;
    FLookupList.AddObject(AName, result);
    dataMain.RefreshLookup(AName, result);
  end
  else begin
    result := FLookupList.Objects[ix] as TBafComboHelper;
    if result.LastQuery < (now - (LookupInterval / (24 * 3600))) then
      dataMain.RefreshLookup(AName, result);
  end;
end;

function TBafDataCache.GetSpecial(AName: string): TBafComboHelper;
// gets the SpecialList. If it doesn't exists or is out of date it fetches the data
var
  ix: integer;
begin
  AName := AnsiLowerCase(AName);
  ix := FSpecialList.IndexOf(AName);
  if ix = -1 then begin
    result := TBafComboHelper.Create(false);
    result.OnSetValue := BafComboHelperOnValue;
    result.RefreshInterval := 600;
    FSpecialList.AddObject(AName, result);
    dataMain.RefreshSpecial(AName, result);
  end
  else begin
    result := FSpecialList.Objects[ix] as TBafComboHelper;
    if result.LastQuery < (now - (result.RefreshInterval / (24 * 3600))) then
      dataMain.RefreshSpecial(AName, result);
  end;
end;

procedure TBafDataCache.LoadBitmap(ABitmap: FMX.Graphics.TBitmap; AFilename: string);
var
  LIndex: integer;
  LBitmap: FMX.Graphics.TBitmap;
begin
  LIndex := FGlobalBitmapCache.IndexOf(AFilename);
  if LIndex = -1 then begin
    LBitmap :=  FMX.Graphics.TBitmap.Create;
    LBitmap.LoadFromFile(AFilename);
    LIndex := FGlobalBitmapCache.AddObject(AFilename, LBitmap);
  end;
  ABitmap.Assign(FGlobalBitmapCache.Objects[LIndex] as FMX.Graphics.TBitmap);
end;

function TBafDataCache.LoadGridCache(ASegment: TBafPageSegment): boolean;
var
  LName: string;
  LCache: TBafGridSegmentCache;
  ix, LCol, LRow: integer;
  LCacheCell: TBafGridSegmentCacheCell;
  LCell: TBafSgCell;
begin
  result := false;
  LName := ASegment.Grid.GridCache;
  if (LName <> '') then begin
    ix := FGridCacheList.IndexOf(LName);
    if ix >= 0 then begin
      LCache := FGridCacheList.Objects[ix] as TBafGridSegmentCache;
      for LRow := 0 to LCache.RowCount - 1 do begin
        for LCol := 0 to LCache.ColCount - 1 do begin
          LCacheCell := LCache.GetCell(LCol, LRow);
          LCell := ASegment.Grid.DataCells[LCol, LRow];
          LCell.Text := LCacheCell.Text;
          LCell.DataKeyValue := LCacheCell.DataKeyValue;
          LCell.DataKeyColValue := LCacheCell.DataKeyColValue;
          LCell.Parents.Row.RowInserted := LCacheCell.RowInserted;
        end;
      end; // for LRow
      result := true;
    end; // if ix >= 0
  end; // if (LName <> '')
end;

procedure TBafDataCache.RefreshUserGroups(AUserUserId: string);
var
  LSql, LGroupName: string;
  LParams: TBafParams;
  LDataSet: TDataSet;
begin
  FUserGroups.Clear;
  FRightIsAdmin := false;

  try
    LSql := dataMain.GetSqlTextFromDevtext('_system_usergroups_202', '');
  except

  end;

  if LSql = '' then begin
    case dataMain.DefaultCon.BafGen of
      bg303TT: LSql := 'select distinct g2.pfad '
        + ' from neuland.user_user2group z '
        + ' inner join neuland.user_group g   '
        + '   on g.user_group_id = z.user_group_id   and g.status = 1 '
        + ' inner join neuland.user_group g2  '
        + '   on g.pfad like g2.pfad || ''%''   and g2.status = 1 '
        + ' inner join neuland.user_user u   on z.user_user_id = u.user_user_id '
        + ' where u.user_user_id = :kid   and z.status = 1   order by g2.pfad ';
      else
        LSql := 'select distinct g2.path     from user_user2group z '
           + '   inner join user_group g on g.user_group_id = z.user_group_id '
               + 'and g.status = ''1'' '
           + '   inner join user_group g2 on g.path like g2.path || ''%'' '
               + 'and g2.status = ''1'' '
           + '   inner join user_user u on z.user_user_id = u.user_user_id '
           + ' where u.user_user_id = :kid and z.status = ''1'' order by g2.path';
    end;
  end;
  LParams := dataMain.QueryPrepare(dataMain.DefaultCon, 'usergroup', LSql);
  LParams.ParamAsString('kid', AUserUserId);
  LDataSet := dataMain.QueryOpen(dataMain.DefaultCon, 'usergroup');
  while not LDataSet.Eof do begin
    case dataMain.DefaultCon.BafGen of
      bg303TT: LGroupName := AnsiLowerCase(LDataSet.FieldByName('pfad').AsString);
      else
        LGroupName := AnsiLowerCase(LDataSet.FieldByName('path').AsString);
    end;
    FUserGroups.Add(LGroupName);
    if (LGroupName = 'user.admin') or (LGroupName = 'tt.it.entwicklung.nldev') then
      FRightIsAdmin := true;
    LDataSet.Next;
  end;

end;

procedure TBafDataCache.SaveGridCache(ASegment: TBafPageSegment);
var
  LName: string;
  LCache: TBafGridSegmentCache;
  ix, LCol, LRow: integer;
  LCacheCell: TBafGridSegmentCacheCell;
  LCell: TBafSgCell;
begin
  LName := ASegment.Grid.GridCache;
  ix := FGridCacheList.IndexOf(LName);
  if ix >= 0 then
    LCache := FGridCacheList.Objects[ix] as TBafGridSegmentCache
  else begin
    LCache := TBafGridSegmentCache.Create;
    FGridCacheList.AddObject(LName, LCache);
  end;

  LCache.SetDimensions(ASegment.Grid.Columns.Count, ASegment.Grid.RowCount(rtData));
  for LRow := 0 to ASegment.Grid.RowCount(rtData) - 1 do begin
    for LCol := 0 to ASegment.Grid.Columns.Count - 1 do begin
      LCell := ASegment.Grid.DataCells[LCol, LRow];
      LCacheCell := LCache.GetCell(LCol, LRow);
      LCacheCell.Text := LCell.Text;
      LCacheCell.DataKeyValue := LCell.DataKeyValue;
      LCacheCell.DataKeyColValue := LCell.DataKeyColValue;
      LCacheCell.RowInserted := LCell.Parents.Row.RowInserted;
    end;
  end;
end;

{ TBafGridSegmentCache }

constructor TBafGridSegmentCache.Create;
begin
  FRows := TObjectList.Create;
end;

destructor TBafGridSegmentCache.Destroy;
begin
  SetDimensions(0, 0);
  inherited;
end;

function TBafGridSegmentCache.GetCell(ACol, ARow: integer): TBafGridSegmentCacheCell;
begin
  result := (FRows[ARow] as TObjectList).Items[ACol] as TBafGridSegmentCacheCell;
end;

procedure TBafGridSegmentCache.SetDimensions(AColCount, ARowCount: integer);
var
  LCol, LRow: integer;
  LColumns: TObjectList;
begin
  // delete old
  FColCount := 0;
  FRowCount := 0;
  FRows.Clear;

  // create new
  for LRow := 0 to ARowCount - 1 do begin
    LColumns := TObjectList.Create(true);
    for LCol := 0 to AColCount - 1 do
      LColumns.Add(TBafGridSegmentCacheCell.Create);
    FRows.Add(LColumns);
  end;

  FColCount := AColCount;
  FRowCount := ARowCount;
end;


{ TBafCommandCacheItem }

constructor TBafCommandCacheItem.Create;
begin

end;

destructor TBafCommandCacheItem.Destroy;
begin
  FCode.Free;
  inherited;
end;

{ TBafCommandCache }

constructor TBafCommandCache.Create;
begin
  FCommands := TStringList.Create;
  FCommands.OwnsObjects := true;
  FCommands.Sorted := true;
  FCommands.Duplicates := dupError;
end;

destructor TBafCommandCache.Destroy;
begin
  FreeAndNil(FCommands);
  inherited;
end;

function TBafCommandCache.GetCommand(AName: string; ACode: TStrings): boolean;
var
  ix: integer;
  sl: TStringList;
  LItem: TBafCommandCacheItem;

  procedure lokCreateNew;
  begin
    sl := TStringList.Create;
    result := dataMain.GetCommand(AName, sl);
    if result then begin
      LItem := TBafCommandCacheItem.Create;
      LItem.FTimestamp := now;
      LItem.FCode := sl;
      FCommands.AddObject(AName, LItem);
      ACode.Assign(sl);
    end
    else begin
      sl.Free;
      ACode.Clear;
    end;
  end; // procedure lokNeuAnlegen

  procedure lokCacheItemRefresh;
  begin
    result := dataMain.GetCommand(AName, LItem.FCode);
    if result then begin
      LItem.FTimestamp := now;
      ACode.Assign(LItem.FCode);
    end
    else
      FCommands.Delete(ix);
  end; // procedure lokCacheItemRefresh

begin
  ix := FCommands.IndexOf(AName);
  if ix >= 0 then begin   // is in cache
    LItem := (FCommands.Objects[ix] as TBafCommandCacheItem);
    if ((now - LItem.FTimestamp) * 24 * 3600) > 60 then
      lokCacheItemRefresh
    else begin          // not outdated
      result := true;
      ACode.Assign(LItem.FCode);
    end;
  end
  else
    lokCreateNew;
end;

procedure TBafCommandCache.RefreshCommand(AName, ACode: string);
var
  ix: integer;
  LItem: TBafCommandCacheItem;
begin
  ix := FCommands.IndexOf(AName);
  if ix >= 0 then begin   // schon im Cache
    LItem := (FCommands.Objects[ix] as TBafCommandCacheItem);
    LItem.FTimestamp := now;
    LItem.FCode.Text := ACode;
  end;
end;

initialization
  gvBafDataCache := TBafDataCache.Create;
  gvBafCommandCache := TBafCommandCache.Create;
  gvGlobalVars := TStringList.Create;

finalization
  FreeAndNil(gvBafCommandCache);
  FreeAndNil(gvBafDataCache);
  FreeAndNil(gvGlobalVars);

end.
