unit uHCLDatabaseMatch;

{$mode objfpc}{$H+}

/// <summary>
/// uHCLDatabaseMatch — finds the platform database a scenario needs.
///
/// A database name reduces to a family and a build date: "HCDB-060103",
/// "HCDB_070414_2006.13b3" and "HCDB070524_HC2003.15" are the HCDB family,
/// 2006-01-03, 2007-04-14 and 2007-05-24; "HCDB2-170909" is HCDB2 (a
/// separate family), "HC_80to95_DB_110101" is HC80TO95DB.  A scenario needing
/// one gets it exactly when it is installed or in the catalog (current or an
/// earlier version); otherwise the nearest newer build of the same family,
/// which changes least for it.
///
/// Zero UI dependency.
/// </summary>

interface

uses
  SysUtils, uHCLCatalog;

type
  /// <summary>A database's identity: family and build date.</summary>
  THCLDBId = record
    /// <summary>Upper-case letters and digits before the date, e.g. "HCDB", "HCDB2", "HC80TO95DB".</summary>
    Family: String;
    /// <summary>Build date as yyyymmdd (yymmdd with 50-99 read as 19xx).</summary>
    Date: Integer;
  end;

  /// <summary>A database the catalog can supply.</summary>
  THCLDBCandidate = record
    Id: THCLDBId;
    /// <summary>The name it was recognised by, e.g. "HCDB-070414".</summary>
    Name: String;
    /// <summary>The catalog file in that version (HCLSelectVersion), ready to download.</summary>
    CatalogFile: THCLCatalogFile;
  end;

  THCLDBCandidateArray = array of THCLDBCandidate;

/// <summary>Reduces a database name to family and date.</summary>
/// <param name="AName">e.g. "HCDB-060103", a file name stem, or a folder name.</param>
/// <param name="AId">Receives the identity.</param>
/// <returns>False when there is no six-digit date (exactly six) or no family
/// before it starting with a letter.</returns>
function HCLParseDBId(const AName: String; out AId: THCLDBId): Boolean;

/// <summary>True when both name the same family and build.</summary>
function HCLSameDB(const A, B: THCLDBId): Boolean;

/// <summary>
/// Every database the catalog files can supply: each file's current version
/// and its earlier ones, recognised by version label, else file name.
/// </summary>
/// <param name="AFiles">Platform database catalog files.</param>
/// <returns>Candidates in catalog order, current versions before earlier ones
/// of the same file; external links and entries without a file are skipped.</returns>
function HCLDBCandidates(const AFiles: THCLCatalogFileArray): THCLDBCandidateArray;

/// <summary>
/// Picks the database to use for a required one.
/// </summary>
/// <param name="ARequired">What the scenario needs.</param>
/// <param name="ACandidates">From <see cref="HCLDBCandidates"/>.</param>
/// <param name="AChosen">Receives the pick.</param>
/// <param name="AExact">True when it is the required build itself.</param>
/// <returns>False when the family has neither that build nor a newer one.</returns>
/// <remarks>Among equals, a current version beats an earlier one, then catalog order.</remarks>
function HCLChooseDatabase(const ARequired: THCLDBId; const ACandidates: THCLDBCandidateArray;
  out AChosen: THCLDBCandidate; out AExact: Boolean): Boolean;

/// <summary>
/// Finds an installed database by identity, whatever its folder is called.
/// </summary>
/// <param name="APlatformDBsDir">The managed PlatformDBs directory.</param>
/// <param name="AId">The database wanted.</param>
/// <returns>The folder name (not path) of a subdirectory holding
/// <c>commondb.res</c> whose name reduces to AId; '' when none.</returns>
function HCLFindInstalledDatabase(const APlatformDBsDir: String; const AId: THCLDBId): String;

/// <summary>Formats an identity for messages, e.g. "HCDB 2006-01-03".</summary>
function HCLDBIdText(const AId: THCLDBId): String;

implementation

function HCLParseDBId(const AName: String; out AId: THCLDBId): Boolean;
var
  I, Start, Run, YY, MM, DD: Integer;
  Prefix: String;
begin
  AId := Default(THCLDBId);
  Result := False;

  // The first run of exactly six digits is the date.
  Start := 0;
  I := 1;
  while I <= Length(AName) do
  begin
    if AName[I] in ['0'..'9'] then
    begin
      Run := I;
      while (I <= Length(AName)) and (AName[I] in ['0'..'9']) do
        Inc(I);
      if I - Run = 6 then
      begin
        Start := Run;
        Break;
      end;
    end
    else
      Inc(I);
  end;
  if Start = 0 then
    Exit;

  YY := StrToInt(Copy(AName, Start, 2));
  MM := StrToInt(Copy(AName, Start + 2, 2));
  DD := StrToInt(Copy(AName, Start + 4, 2));
  if (MM < 1) or (MM > 12) or (DD < 1) or (DD > 31) then
    Exit;

  Prefix := '';
  for I := 1 to Start - 1 do
    if AName[I] in ['A'..'Z', 'a'..'z', '0'..'9'] then
      Prefix := Prefix + UpCase(AName[I]);
  if (Prefix = '') or not (Prefix[1] in ['A'..'Z']) then
    Exit;

  AId.Family := Prefix;
  if YY >= 50 then
    AId.Date := (1900 + YY) * 10000 + MM * 100 + DD
  else
    AId.Date := (2000 + YY) * 10000 + MM * 100 + DD;
  Result := True;
end;

function HCLSameDB(const A, B: THCLDBId): Boolean;
begin
  Result := (A.Family <> '') and (A.Family = B.Family) and (A.Date = B.Date);
end;

function HCLDBIdText(const AId: THCLDBId): String;
begin
  Result := Format('%s %.4d-%.2d-%.2d',
    [AId.Family, AId.Date div 10000, (AId.Date div 100) mod 100, AId.Date mod 100]);
end;

/// <summary>Adds a candidate when its label or file name reduces to an identity.</summary>
procedure AddCandidate(var AList: THCLDBCandidateArray; const AFile: THCLCatalogFile);
var
  C: THCLDBCandidate;
  Name: String;
begin
  if AFile.ExternalLink or (AFile.FileName = '') then
    Exit;
  Name := AFile.VersionLabel;
  if not HCLParseDBId(Name, C.Id) then
  begin
    Name := ChangeFileExt(AFile.FileName, '');
    if not HCLParseDBId(Name, C.Id) then
      Exit;
  end;
  C.Name := Name;
  C.CatalogFile := AFile;
  SetLength(AList, Length(AList) + 1);
  AList[High(AList)] := C;
end;

function HCLDBCandidates(const AFiles: THCLCatalogFileArray): THCLDBCandidateArray;
var
  I, V: Integer;
begin
  Result := nil;
  for I := 0 to High(AFiles) do
  begin
    AddCandidate(Result, AFiles[I]);
    for V := 0 to High(AFiles[I].Versions) do
      AddCandidate(Result, HCLSelectVersion(AFiles[I], V));
  end;
end;

function HCLChooseDatabase(const ARequired: THCLDBId; const ACandidates: THCLDBCandidateArray;
  out AChosen: THCLDBCandidate; out AExact: Boolean): Boolean;
var
  I, Best: Integer;

  function Better(ANew, AOld: Integer): Boolean;
  begin
    if AOld < 0 then
      Exit(True);
    if ACandidates[ANew].Id.Date <> ACandidates[AOld].Id.Date then
      Exit(ACandidates[ANew].Id.Date < ACandidates[AOld].Id.Date);
    // Same build: a current version beats an earlier one.
    Result := ACandidates[AOld].CatalogFile.IsPreviousVersion and
              not ACandidates[ANew].CatalogFile.IsPreviousVersion;
  end;

begin
  AChosen := Default(THCLDBCandidate);
  AExact := False;
  Result := False;
  if ARequired.Family = '' then
    Exit;

  // The nearest build on or after the one required: the build itself when it
  // exists, else the next newer one in the family.
  Best := -1;
  for I := 0 to High(ACandidates) do
    if (ACandidates[I].Id.Family = ARequired.Family) and
       (ACandidates[I].Id.Date >= ARequired.Date) and Better(I, Best) then
      Best := I;
  if Best < 0 then
    Exit;

  AChosen := ACandidates[Best];
  AExact := AChosen.Id.Date = ARequired.Date;
  Result := True;
end;

function HCLFindInstalledDatabase(const APlatformDBsDir: String; const AId: THCLDBId): String;
var
  SR: TSearchRec;
  Dir: String;
  Found: THCLDBId;
begin
  Result := '';
  if (AId.Family = '') or not DirectoryExists(APlatformDBsDir) then
    Exit;
  Dir := IncludeTrailingPathDelimiter(APlatformDBsDir);
  if FindFirst(Dir + '*', faDirectory, SR) = 0 then
  try
    repeat
      if ((SR.Attr and faDirectory) <> 0) and (SR.Name <> '.') and (SR.Name <> '..') and
         HCLParseDBId(SR.Name, Found) and HCLSameDB(Found, AId) and
         FileExists(Dir + SR.Name + PathDelim + 'commondb.res') then
        Exit(SR.Name);
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;
end;

end.