Sordie.co.uk

libsassy/libSassy.Config.pas

Raw

{(
 )) libSassy.Config
((    Configuration file handler
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015-2016
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.Config;

interface

uses
  libSassy.Interfaces,
  libSassy.Log,
  libSassy.Strings,
  libSassy.Arrays,
  libSassy.Streams,
  libSassy.FileSystem;

type
{$REGION 'TValues'}
  TDirectiveHandler = reference to function(Directive, Params: String): Boolean;

  PValue = ^TValue;
  TValue = record
    Name:  String;
    Value: String;
  end;

  TValues = class(TInterface)
  private
    fValues: TArray<PValue>;

    fLogObject: TLog;
    fLogPrefix: String;

    function  GetValue(Name: String): String;
    procedure SetValue(Name, Value: String);

    function  GetAsText: String;
    procedure SetAsText(Value: String);

    procedure AddValue(Name, Value: String);
  public
    const DefaultValue = #1;

    constructor Create;
    destructor  Destroy; override;

    procedure Clear;
    function Find(const Name: String): Integer;

    function Exists(const Name: String): Boolean; inline;

    function Default(const Name: String; const Value: String): Boolean;

    function  Read(const Name: String; const Default: String = ''): String;
    procedure Write(const Name, Value: String); inline;

    procedure AddAsText(const S: String);

    function Expand(const S: String): String;

    function Load(const Stream: TStream; const ClearExisting: Boolean = True; DirectiveHandler: TDirectiveHandler = nil): Boolean;
    function Save(const Stream: TStream; const Unicode: Boolean = False): Boolean;

    function LoadFromFile(const FileName: String): Boolean;

    property Values: TArray<PValue> read fValues;
    property Value[Name: String]: String  read GetValue write SetValue; default;

    property AsText: String read GetAsText write SetAsText;

    property LogObject: TLog   read fLogObject write fLogObject;
    property LogPrefix: String read fLogPrefix write fLogPrefix;

    procedure Log(Any: array of const);
  end;
{$ENDREGION}

{$REGION 'TINISection'}
  TINISection = class(TValues)
  private
    fName: String;
  public
    property Name: String read fName;
  end;
{$ENDREGION}

{$REGION 'TINIFile'}
  TINIFile = class(TInterface)
  private
    fSections: TArray<TINISection>;

    function GetSection(Name: String): TINISection;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure Clear;

    function  Read (const Section, Name: String; const Default: String): String;
    procedure Write(const Section, Name: String; const Value:   String);

    function Exists(const Section, Name: String): Boolean;

    function Load(const Stream: TStream; const ClearExisting: Boolean = True; DirectiveHandler: TDirectiveHandler = nil): Boolean;
    function Save(const Stream: TStream; const Unicode: Boolean = False): Boolean;

    function LoadFromFile(const FileName: String): Boolean;

    property Section[Name: String]: TINISection read GetSection; default;
  end;
{$ENDREGION}

implementation

{$REGION 'TValues'}
function TValues.GetValue;
var
  i: Integer;
begin
  i := Find(Name);

  if i > -1 then
    Result := fValues[i].Value
  else
    Result := '';
end;

procedure TValues.SetValue;
var
  i: Integer;
  v: PValue;
begin
  i := Find(Name);

  if i = -1 then
  begin
    if Value.Empty then exit;

    new(v);

    v.Name  := Name.Lowercase;
    v.Value := Value;

    fValues.Add(v);
  end
  else
  begin
    if Value.Length = 0 then
    begin
      dispose(fValues[i]);
      fValues.Delete(i);
    end
    else
      fValues[i]^.Value := Value;
  end;
end;

function TValues.GetAsText;
var
  v: PValue;
begin
  Result := '';

  for v in fValues do
  begin
    if not Result.Empty then
      Result := Result + ' ';

    Result := Result + v^.Name;

    if v^.Value <> DefaultValue then
      Result := Result + '="' + v^.Value + '"';
  end;
end;

procedure TValues.SetAsText;
begin
  Clear;

  AddAsText(Value);
end;

procedure TValues.AddValue;
var
  v: PValue;
begin
  if Name.Empty then exit;

  new(v);

  v.Name  := Name.Lowercase;
  v.Value := Value;

  fValues.Add(v);
end;

constructor TValues.Create;
begin
  inherited;

  fValues := TArray<PValue>.Create;

  fLogObject := nil;
  fLogPrefix := ClassName;
end;

destructor TValues.Destroy;
begin
  Clear;
  fValues.Free;

  inherited;
end;

procedure TValues.Clear;
var
  i: Integer;
begin
  for i := 0 to fValues.Count - 1 do
    dispose(fValues[i]);

  fValues.Clear;
end;

function TValues.Find;
var
  i, l, c: Integer;
  n, v:    String;
begin
  v := Name.Lowercase;
  n := v.Split(':');

  l := v.AsInteger(0);
  c := -1;

  for i := 0 to fValues.Count - 1 do
    if n = fValues[i]^.Name then
    begin
      inc(c);
      if c = l then exit(i);
    end;

  Result := -1;
end;

function TValues.Exists;
begin
  Result := Find(Name) > -1;
end;

function TValues.Default;
begin
  Result := not Exists(Name);

  if Result then
    SetValue(Name, Value);
end;

function TValues.Read;
begin
  if Exists(Name) then
    Result := GetValue(Name)
  else
    Result := Default;
end;

procedure TValues.Write;
begin
  SetValue(Name, Value);
end;

procedure TValues.AddAsText;
var
  m, n, v: String;
begin
  m := S.Trim;
  if m.Empty then exit;

  repeat
    n := m.SplitToken;
    if n.Empty then exit;

    if not String.Ident1Chars.Contains(n[1]) then exit;

    if m.SplitToken(False) = '=' then
    begin
      m.SplitToken;

      v := m.SplitToken.Unquote;

      if v.Empty then v := DefaultValue;
    end

    else v := DefaultValue;

    Write(n, v);
  until m.Empty;
end;

function TValues.Expand;
var
  i: Integer;
begin
  Result := S;

  for i := fValues.Count - 1 downto 0 do
    with fValues[i]^ do
      Result := Result.Replace('%' + Name + '%', Value, 1, True);
end;

function TValues.Load;
var
  i:    Integer;
  Line: String;
begin
  if ClearExisting then Clear;

  with TStrings.Create do try
    if not Load(Stream) then exit(False);

    for i := 0 to Count - 1 do
    begin
      Line := Item[i].Trim;

      Line := Line.Split('#').Trim;
      if Line.Length <= 3 then continue;

      if Line.FirstChar = '$' then
      begin
        Line := Line.Copy(2, Line.Length);

        if Assigned(DirectiveHandler) then
          if not DirectiveHandler(Line.Split(' ').Lowercase, Line) then exit(False);
      end
      else
      begin
        if Line.Pos(' ') > 0 then
          AddValue(Line.Split(' '), Line)
        else
          AddValue(Line, DefaultValue);
      end;
    end;

    Result := True;
  finally
    Free;
  end;
end;

function TValues.Save;
var
  i: Integer;
begin
  with TStrings.Create do try
    for i := 0 to fValues.Count - 1 do
      if fValues[i].Value = DefaultValue then
        Add(fValues[i].Name)
      else
        Add(fValues[i].Name + ' ' + fValues[i].Value);

    Result := Save(Stream, Unicode);
  finally
    Free;
  end;
end;

function TValues.LoadFromFile;
var
  DirectiveHandler: TDirectiveHandler;
begin
  DirectiveHandler := function(Directive, Params: String): Boolean
  begin
    Log([Directive, ': ', Params]);

    if Directive = 'include' then
      Result := Load(FileStream(Params), False, DirectiveHandler)
    else if Directive.IndexOf(['log', 'echo', 'hint', 'warn']) = 0 then
      Result := True
    else
      Result := False;
  end;

  Log(['Load ', FileName]);
  Result := Load(FileStream(FileName), True, DirectiveHandler);
end;

procedure TValues.Log;
begin
  if fLogObject = nil then exit;

  fLogObject.Log(Any, fLogPrefix);
end;
{$ENDREGION}

{$REGION 'TINIFile'}
function TINIFile.GetSection;
var
  N: String;
begin
  N := Name.Lowercase;

  for Result in fSections do
    if N = Result.fName then exit;

  Result := TINISection.Create;
  Result.fName := N;

  fSections.Add(Result);
end;

constructor TINIFile.Create;
begin
  inherited;

  fSections := TArray<TINISection>.Create;
end;

destructor TINIFile.Destroy;
begin
  fSections.Free;

  inherited;
end;

procedure TINIFile.Clear;
var
  Section: TINISection;
begin
  for Section in fSections do
    Section.Free;

  fSections.Clear;
end;

function TINIFile.Read;
var
  S: TINISection;
begin
  S := GetSection(Section);
  S.Default(Name, Default);

  Result := S.GetValue(Name);
end;

procedure TINIFIle.Write;
begin
  GetSection(Section).SetValue(Name, Value);
end;

function TINIFile.Exists;
begin
  Result := GetSection(Section).Exists(Name);
end;

function TINIFile.Load;
var
  i:       Integer;
  Line:    String;
  Section: TINISection;
begin
  if ClearExisting then Clear;

  Section := TINISection.Create;
  fSections.Add(Section);

  with TStrings.Create do try
    if not Load(Stream) then exit(False);

    for i := 0 to Count - 1 do
    begin
      Line := Item[i].Trim;
      Line := Line.Split(';');
      if Line.Length < 3 then continue;

      if (Line[1] = '[') and (Line[Line.Length] = ']') then
      begin
        Section := TINISection.Create;
        Section.fName := Line.Copy(2, Line.Length - 2).Lowercase;
        fSections.Add(Section);
      end
      else if Line[1] = '#' then
      begin
        Line := Line.Copy(2, Line.Length);

        if Assigned(DirectiveHandler) then
          if not DirectiveHandler(Line.Split(' ').Lowercase, Line) then exit(False);
      end
      else
      begin
        if Line.Pos('=') > 0 then
          Section.AddValue(Line.Split('='), Line)
        else
          Section.AddValue(Line.Split(' '), Line);
      end;
    end;

    Result := True;
  finally
    Free;
  end;
end;

function TINIFile.LoadFromFile;
var
  DirectiveHandler: TDirectiveHandler;
begin
  DirectiveHandler := function(Directive, Params: String): Boolean
  begin
    Log([Directive, ': ', Params]);

    if Directive = 'include' then
      Result := Load(FileStream(Params), False, DirectiveHandler)
    else if Directive.IndexOf(['log', 'echo', 'hint', 'warn']) = 0 then
      Result := True
    else
      Result := False;
  end;

  Log(['Load ', FileName]);
  Result := Load(FileStream(FileName), True, DirectiveHandler);
end;

function TINIFile.Save;
var
  i:       Integer;
  Section: TINISection;
begin
  with TStrings.Create do try
    for Section in fSections do
    begin
      if Section.fValues.Count = 0 then continue;

      if Length(Section.fName) > 0 then
        Add('[' + Section.fName + ']');

      for i := 0 to Section.fValues.Count - 1 do
        Add(Section.fValues[i].Name + '=' + Section.fValues[i].Value);
    end;

    Result := Save(Stream, Unicode);
  finally
    Free;
  end;
end;
{$ENDREGION}

end.