utils/uutlMCF.pas

unit uutlMCF;

{ Package:      Utils
  Prefix:       utl - UTiLs
  Beschreibung: diese Unit enthält Klassen zum Lesen und Schreiben eines MuoConfgiFiles (kurz MCF)

    Lesen/Schreiben in/von Stream über TutlMCFFile
    LineEndMode zur Kompatibilität mit MCF-alt und KCF:
      leNone           - Kein Semikolon erlaubt (KCF)
      leAcceptNoWrite  - Semikolon wird beim Lesen ignoriert, beim Schreiben weggelassen
      leAlways         - Beim Lesen erforderlich, immer geschrieben (MCF-alt)

    Jeder SectionName und jeder ValueName ist Unique, es kann aber ein Value und eine
    Section mit dem gleichen Namen existieren

    Zugriff auf Subsections über .Section(), mehrere Stufen auf einmal mit . getrennt:
      mcf.Section('foo.bar.baz') === mcf.Section('foo').Section('bar').Section('baz')
    Zugriff erstellt automatisch eine Section, falls sie nicht existiert. Prüfung mit
    SectionExists (nur direkt, keine Pfade!).

    Zugriff auf Werte von der Section aus:
      Get/Set[Int,Float,String,Bool](Key, Default)
      ValueExists()
      UnsetValue()
    Strings sind Widestrings, Un/Escaping passiert beim Dateizugriff automatisch

    Enumeration: ValueCount/ValueNameAt, SectionCount/SectionNameAt  }

interface

uses
  SysUtils, Classes, uutlStreamHelper;

type
  EConfigException = class(Exception)
  end;
  TutlMCFSection = class;
  TutlMCFFile = class;
  TutlMCFLineEndMarkerMode = (leNone, leAcceptNoWrite, leAlways);

  { TutlMCFSection }

  TutlMCFSection = class
  private type
    TSectionEnumerator = class(TObject)
    private
      fList: TStringList;
      fPosition: Integer;
      function GetCurrent: TutlMCFSection;
    public
      property Current: TutlMCFSection read GetCurrent;
      function MoveNext: Boolean;
      constructor Create(const aList: TStringList);
    end;
  private
    FSections,
      FValues: TStringList;
    function GetSection(aPath: String): TutlMCFSection;
    function GetSectionCount: integer;
    function GetSectionName(Index: integer): string;
    function GetSectionByIndex(aIndex: Integer): TutlMCFSection;
    function GetValueCount: integer;
    function GetValueName(Index: integer): string;
    function GetValueAt(aIndex: integer): Variant;
  protected
    procedure ClearSections;
    procedure ClearValues;
    procedure SaveData(Stream: TStream; Indent: string; LineEnds: TutlMCFLineEndMarkerMode);
    procedure LoadData(Data: TStream; LineEnds: TutlMCFLineEndMarkerMode; Depth: Integer);
    procedure AddValueChecked(Name: String; Val: TObject);
    procedure SplitPath(const Path: String; out First, Rest: String);
  public
    constructor Create;
    destructor Destroy; override;

    function GetEnumerator: TSectionEnumerator;
    procedure Clear;
    procedure Assign(Source: TutlMCFSection);

    property ValueCount: integer read GetValueCount;
    property ValueNameAt[Index: integer]: string read GetValueName;
    property ValueAt[Index: integer]: Variant read GetValueAt;

    property SectionCount: integer read GetSectionCount;
    property SectionNameAt[Index: integer]: string read GetSectionName;
    property Sections[aPath: String]: TutlMCFSection read GetSection; default;
    property SectionByIndex[aIndex: Integer]: TutlMCFSection read GetSectionByIndex;

    function SectionExists(Path: string): boolean;
    function Section(Path: string): TutlMCFSection;
    procedure DeleteSection(Name: string);

    function ValueExists(Name: string): boolean;
    procedure UnsetValue(Name: string);

    function GetValue   (Name: String; Default: Variant): Variant;
    function GetInt     (Name: string; Default: Int64 = 0): Int64; overload;
    function GetFloat   (Name: string; Default: Double = 0): Double; overload;
    function GetString  (Name: string; Default: AnsiString = ''): AnsiString; overload;
    function GetStringW (Name: string; Default: UnicodeString = ''): UnicodeString; overload;
    function GetBool    (Name: string; Default: Boolean = false): Boolean; overload;

    function TryGetValue  (aName: String; out aValue: Variant): Boolean;
    function TryGetInt    (aName: String; out aValue: Int64): Boolean;
    function TryGetFloat  (aName: String; out aValue: Double): Boolean;
    function TryGetString (aName: String; out aValue: AnsiString): Boolean;
    function TryGetStringW(aName: String; out aValue: UnicodeString): Boolean;
    function TryGetBool   (aName: String; out aValue: Boolean): Boolean;

    procedure SetInt    (Name: string; Value: Int64); overload;
    procedure SetFloat  (Name: string; Value: Double); overload;
    procedure SetString (Name: string; Value: WideString); overload;
    procedure SetString (Name: string; Value: AnsiString); overload;
    procedure SetBool (Name: string; Value: Boolean); overload;
  end;

  { TutlMCFFile }

  TutlMCFFile = class(TutlMCFSection)
  private
    fLineEndMode: TutlMCFLineEndMarkerMode;
  public
    constructor Create(Data: TStream; LineEndMode: TutlMCFLineEndMarkerMode = leAcceptNoWrite);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
  end;

implementation

uses Variants, StrUtils;

const
  sComment = '#';
  sSectionEnd = 'end';
  sSectionMarker = ':';
  sSectionPathDelim = '.';
  sLineEndMarker = ';';
  sValueDelim = '=';
  sValueQuote = '''';
  sValueDecimal = '.';
  sIndentOnSave = '  ';
  sNameValidChars = [' ' .. #$7F] - [sValueDelim];
  sWhitespaceChars = [#0 ..  ' '];

type
  StoredValue = Variant;

  { TutlMCFValue }

  TutlMCFValue = class
  private
    Format: TFormatSettings;
    FValue: StoredValue;
    procedure SetValue(const Value: StoredValue);
  protected
    function CheckSpecialChars(Data: WideString): boolean;
    procedure LoadData(Data: string);
    function SaveData: string;
    class function Escape(Value: WideString): AnsiString;
    class function Unescape(Value: AnsiString): WideString;
  public
    constructor Create(Val: StoredValue);
    property Value: StoredValue read FValue write SetValue;
  end;

  { TkcfValue }

constructor TutlMCFValue.Create(Val: StoredValue);
begin
  inherited Create;
  SetValue(Val);
  Format.DecimalSeparator:= sValueDecimal;
end;

procedure TutlMCFValue.SetValue(const Value: StoredValue);
begin
  FValue:= Value;
end;

function TutlMCFValue.CheckSpecialChars(Data: WideString): boolean;
var
  i: Integer;
begin
  result := false;
  for i:= 1 to Length(Data) do
    if Data[i] in [sSectionMarker, sValueQuote, sValueDelim, sLineEndMarker, ' '] then
      exit;
  result := true;
end;

procedure TutlMCFValue.LoadData(Data: string);
var
  b: boolean;
  i: int64;
  d: double;
  p: PChar;
begin
  if TryStrToInt64(Data, i) then
    Value:= i
  else if TryStrToFloat(Data, d, Format) then
    Value:= d
  else if TryStrToBool(Data, b) then
    Value:= b
  else begin
    p:= PChar(Data);
    if p^ = sValueQuote then
      Data := AnsiExtractQuotedStr(p, sValueQuote);
    Value:= Unescape(Trim(Data));
  end;
end;

function TutlMCFValue.SaveData: string;
begin
  if VarIsType(FValue, varBoolean) then
    Result:= BoolToStr(FValue, false)
  else if VarIsType(FValue, varInt64) then
    Result:= IntToStr(FValue)
  else if VarIsType(FValue, varDouble) then
    Result:= FloatToStr(Double(FValue), Format)
  else begin
    Result:= AnsiQuotedStr(Escape(FValue), sValueQuote);
  end;
end;

class function TutlMCFValue.Escape(Value: WideString): AnsiString;
var
  i: integer;
  wc: WideChar;
begin
  Result:= '';
  for i:= 1 to length(Value) do begin
    wc:= Value[i];
    case Ord(wc) of
      Ord('\'),
      $007F..$FFFF: Result:= Result + '\'+IntToHex(ord(wc),4);
    else
      Result:= Result + AnsiChar(wc);
    end;
  end;
end;

class function TutlMCFValue.Unescape(Value: AnsiString): WideString;
var
  i: integer;
  c: Char;
begin
  Result:= '';
  i:= 1;
  while i <= length(value) do begin
    c:= Value[i];
    if c='\' then begin
      Result:= Result + WideChar(StrToInt('$'+Copy(Value,i+1,4)));
      inc(i, 4);
    end else
      Result:= Result + WideChar(c);
    inc(i);
  end;
end;

{ TutlMCFSection.TSectionEnumerator }

function TutlMCFSection.TSectionEnumerator.GetCurrent: TutlMCFSection;
begin
  result := TutlMCFSection(fList.Objects[fPosition]);
end;

function TutlMCFSection.TSectionEnumerator.MoveNext: Boolean;
begin
  inc(fPosition);
  result := (fPosition < fList.Count);
end;

constructor TutlMCFSection.TSectionEnumerator.Create(const aList: TStringList);
begin
  inherited Create;
  fList     := aList;
  fPosition := -1;
end;

{ TkcfCompound }

constructor TutlMCFSection.Create;
begin
  inherited;
  FSections:= TStringList.Create;
  FSections.CaseSensitive:= false;
  FSections.Sorted:= true;
  FSections.Duplicates:= dupError;
  FValues:= TStringList.Create;
  FValues.CaseSensitive:= false;
  FValues.Sorted:= true;
  FValues.Duplicates:= dupError;
end;

destructor TutlMCFSection.Destroy;
begin
  ClearSections;
  ClearValues;
  FreeAndNil(FSections);
  FreeAndNil(FValues);
  inherited;
end;

function TutlMCFSection.GetEnumerator: TSectionEnumerator;
begin
  result := TSectionEnumerator.Create(FSections);
end;

procedure TutlMCFSection.Clear;
begin
  ClearSections;
  ClearValues;
end;

procedure TutlMCFSection.Assign(Source: TutlMCFSection);
var
  ms: TMemoryStream;
begin
  Clear;
  ms:= TMemoryStream.Create;
  try
    Source.SaveData(ms, '', leNone);
    ms.Position:= 0;
    LoadData(ms, leNone, 0);
  finally
    FreeAndNil(ms);
  end;
end;


function TutlMCFSection.GetSectionCount: integer;
begin
  Result:= FSections.Count;
end;

function TutlMCFSection.GetSection(aPath: String): TutlMCFSection;
begin
  result := Section(aPath);
end;

function TutlMCFSection.GetSectionByIndex(aIndex: Integer): TutlMCFSection;
begin
  result := (FSections.Objects[aIndex] as TutlMCFSection);
end;

function TutlMCFSection.GetSectionName(Index: integer): string;
begin
  Result:= FSections[Index];
end;

function TutlMCFSection.GetValueCount: integer;
begin
  Result:= FValues.Count;
end;

function TutlMCFSection.GetValueName(Index: integer): string;
begin
  Result:= FValues[Index];
end;

function TutlMCFSection.GetValueAt(aIndex: integer): Variant;
begin
  result := TutlMcfValue(FValues.Objects[aIndex]).Value;
end;

procedure TutlMCFSection.ClearSections;
var
  i: integer;
begin
  for i:= FSections.Count - 1 downto 0 do
    FSections.Objects[i].Free;
  FSections.Clear;
end;

procedure TutlMCFSection.ClearValues;
var
  i: integer;
begin
  for i:= FValues.Count - 1 downto 0 do
    FValues.Objects[i].Free;
  FValues.Clear;
end;

procedure TutlMCFSection.SplitPath(const Path: String; out First, Rest: String);
begin
  First:= Copy(Path, 1, Pos(sSectionPathDelim, Path)-1);
  if First='' then begin
    First:= Path;
    Rest:= '';
  end else begin
    Rest:= Copy(Path, Length(First)+2, MaxInt);
  end;
end;

function TutlMCFSection.SectionExists(Path: string): boolean;
var
  f,r: String;
  i: integer;
begin
  SplitPath(Path, f, r);
  i:= FSections.IndexOf(f);
  Result:= (i >= 0) and ((r='') or (TutlMCFSection(FSections.Objects[i]).SectionExists(r)));
end;

function TutlMCFSection.Section(Path: string): TutlMCFSection;
var
  f,r: String;
  i: integer;
begin
  SplitPath(Path, f, r);
  i:= FSections.IndexOf(f);
  if r <> '' then begin
    if (i >= 0) then
      Result:= TutlMCFSection(FSections.Objects[i]).Section(r)
    else begin
      result := TutlMCFSection.Create;
      fSections.AddObject(f, result);
      result := result.Section(r);
    end;
  end else begin
    if i >= 0 then
      Result:= TutlMCFSection(FSections.Objects[i])
    else begin
      Result:= TutlMCFSection.Create;
      FSections.AddObject(f, Result);
    end;
  end;
end;

procedure TutlMCFSection.DeleteSection(Name: string);
var
  i: integer;
begin
  i:= FSections.IndexOf(Name);
  if i >= 0 then begin
    FSections.Objects[i].Free;
    FSections.Delete(i);
  end;
end;

function TutlMCFSection.ValueExists(Name: string): boolean;
begin
  Result:= FValues.IndexOf(Name) >= 0;
end;

procedure TutlMCFSection.UnsetValue(Name: string);
var
  i: integer;
begin
  i:= FValues.IndexOf(Name);
  if i >= 0 then begin
    FValues.Objects[i].Free;
    FValues.Delete(i);
  end;
end;

function TutlMCFSection.GetValue(Name: String; Default: Variant): Variant;
begin
  if not TryGetValue(Name, result) then
    result := Default;
end;

function TutlMCFSection.GetInt(Name: string; Default: Int64): Int64;
begin
  if not TryGetInt(Name, result) then
    result := Default;
end;

function TutlMCFSection.GetFloat(Name: string; Default: Double): Double;
begin
  if not TryGetFloat(Name, result) then
    result := Default;
end;

function TutlMCFSection.GetStringW(Name: string; Default: UnicodeString): UnicodeString;
begin
  if not TryGetStringW(Name, result) then
    result := Default;
end;

function TutlMCFSection.GetString(Name: string; Default: AnsiString): AnsiString;
begin
  if not TryGetString(Name, result) then
    result := Default;
end;

function TutlMCFSection.GetBool(Name: string; Default: Boolean): Boolean;
begin
  if not TryGetBool(Name, result) then
    result := Default;
end;

function TutlMCFSection.TryGetValue(aName: String; out aValue: Variant): Boolean;
var
  i: Integer;
begin
  i := FValues.IndexOf(aName);
  result := (i >= 0);
  if result then
    aValue := TutlMcfValue(FValues.Objects[i]).Value;
end;

function TutlMCFSection.TryGetInt(aName: String; out aValue: Int64): Boolean;
var
  v: Variant;
begin
  result := TryGetValue(aName, v);
  if result then
    aValue := v;
end;

function TutlMCFSection.TryGetFloat(aName: String; out aValue: Double): Boolean;
var
  v: Variant;
begin
  result := TryGetValue(aName, v);
  if result then
    aValue := v;
end;

function TutlMCFSection.TryGetString(aName: String; out aValue: AnsiString): Boolean;
var
  v: Variant;
begin
  result := TryGetValue(aName, v);
  if result then
    aValue := v;
end;

function TutlMCFSection.TryGetStringW(aName: String; out aValue: UnicodeString): Boolean;
var
  v: Variant;
begin
  result := TryGetValue(aName, v);
  if result then
    aValue := v;
end;

function TutlMCFSection.TryGetBool(aName: String; out aValue: Boolean): Boolean;
var
  v: Variant;
begin
  result := TryGetValue(aName, v);
  if result then
    aValue := v;
end;

procedure TutlMCFSection.AddValueChecked(Name: String; Val: TObject);
var
  i: integer;
begin
  if (Length(Name) < 1) or
     (Name[1] in sWhitespaceChars) or
     (Name[Length(Name)] in sWhitespaceChars) then
    raise EConfigException.CreateFmt('Invalid Value Name: "%s"',[Name]);

  for i:= 1 to Length(Name) do
    if not (Name[i] in sNameValidChars) then
      raise EConfigException.CreateFmt('Invalid Value Name: "%s"',[Name]);
  FValues.AddObject(Name, Val);
end;

procedure TutlMCFSection.SetInt(Name: string; Value: Int64);
var
  i: integer;
begin
  i:= FValues.IndexOf(Name);
  if i < 0 then
    AddValueChecked(Name, TutlMCFValue.Create(Value))
  else
    TutlMCFValue(FValues.Objects[i]).Value:= Value;
end;

procedure TutlMCFSection.SetFloat(Name: string; Value: Double);
var
  i: integer;
begin
  i:= FValues.IndexOf(Name);
  if i < 0 then
    AddValueChecked(Name, TutlMCFValue.Create(Value))
  else
    TutlMCFValue(FValues.Objects[i]).Value:= Value;
end;

procedure TutlMCFSection.SetString(Name: string; Value: WideString);
var
  i: integer;
begin
  i:= FValues.IndexOf(Name);
  if i < 0 then
    AddValueChecked(Name, TutlMCFValue.Create(Value))
  else
    TutlMCFValue(FValues.Objects[i]).Value:= Value;
end;

procedure TutlMCFSection.SetString(Name: string; Value: AnsiString);
begin
  SetString(Name, WideString(Value));
end;

procedure TutlMCFSection.SetBool(Name: string; Value: Boolean);
var
  i: integer;
begin
  i:= FValues.IndexOf(Name);
  if i < 0 then
    AddValueChecked(Name, TutlMCFValue.Create(Value))
  else
    TutlMCFValue(FValues.Objects[i]).Value:= Value;
end;

procedure TutlMCFSection.LoadData(Data: TStream; LineEnds: TutlMCFLineEndMarkerMode; Depth: Integer);
var
  reader: TutlStreamReader;
  l, sn, vn, vs: string;
  se: TutlMCFSection;
  va: TutlMCFValue;
begin
  reader:= TutlStreamReader.Create(Data, false);
  try
    repeat
      l:= reader.ReadLine;
      l:= trim(l);
      if (l = '') or AnsiStartsStr(sComment, l) then
        continue;
      if ((LineEnds in [leNone, leAcceptNoWrite]) and (l = sSectionEnd)) or
         ((LineEnds in [leAcceptNoWrite, leAlways]) and (l = sSectionEnd+sLineEndMarker)) then begin
        if Depth > 0 then
          exit
        else
          raise EConfigException.Create('Encountered Section End where none was expected.');
      end;
      if AnsiEndsStr(sSectionMarker, l) then begin
        sn:= trim(Copy(l, 1, length(l) - length(sSectionMarker)));
        if SectionExists(sn) then
          raise EConfigException.Create('Redeclared Section: '+sn);
        if Pos(sSectionPathDelim,sn) > 0 then
          raise EConfigException.Create('Invalid Section Name: '+sn);
        se:= TutlMCFSection.Create;
        try
          se.LoadData(Data, LineEnds, Depth + 1);
          FSections.AddObject(sn, se);
        except
          FreeAndNil(se);
        end;
      end else if (Pos(sValueDelim, l) > 0) then begin
        if (LineEnds in [leAcceptNoWrite, leAlways]) and AnsiEndsStr(sLineEndMarker, l) then
          Delete(l, length(l), 1);
        vn:= trim(Copy(l, 1, Pos(sValueDelim, l) - 1));
        vs:= trim(Copy(l, Pos(sValueDelim, l) + 1, Maxint));
        if ValueExists(vn) then
          raise EConfigException.Create('Redeclared Value: '+vn);
        va:= TutlMCFValue.Create('');
        try
          va.LoadData(vs);
          AddValueChecked(vn, va);
        except
          FreeAndNil(va);
        end;
      end else
        raise EConfigException.Create('Cannot Parse Line: '+l);
    until reader.IsEOF;
    if Depth > 0 then
      raise EConfigException.Create('Expected Section End, but reached stream end.');
    Depth:= Depth - 1;
  finally
    FreeAndNil(reader);
  end;
end;

procedure TutlMCFSection.SaveData(Stream: TStream; Indent: string; LineEnds: TutlMCFLineEndMarkerMode);
var
  writer: TutlStreamWriter;
  i: integer;
  ele, s: AnsiString;
begin
  if LineEnds in [leAlways] then
    ele:= sLineEndMarker
  else
    ele:= '';
  writer:= TutlStreamWriter.Create(Stream, false);
  try
    for i:= 0 to FValues.Count - 1 do begin
      s:= Indent + FValues[i] + ' ' + sValueDelim + ' ' + TutlMCFValue(FValues.Objects[i]).SaveData + ele;
      writer.WriteLine(s);
    end;

    for i:= 0 to FSections.Count - 1 do begin
      s:= Indent + FSections[i] + sSectionMarker;
      writer.WriteLine(s);
      TutlMCFSection(FSections.Objects[i]).SaveData(Stream, Indent + sIndentOnSave, LineEnds);
      s:= Indent + sSectionEnd + ele;
      writer.WriteLine(s);
    end;
  finally
    FreeAndNil(writer);
  end;
end;

{ TutlMCFFile }

constructor TutlMCFFile.Create(Data: TStream; LineEndMode: TutlMCFLineEndMarkerMode);
begin
  inherited Create;
  fLineEndMode:= LineEndMode;
  if Assigned(Data) then
    LoadFromStream(Data);
end;

procedure TutlMCFFile.LoadFromStream(Stream: TStream);
begin
  ClearSections;
  ClearValues;
  LoadData(Stream, fLineEndMode, 0);
end;

procedure TutlMCFFile.SaveToStream(Stream: TStream);
begin
  SaveData(Stream, '', fLineEndMode);
end;

end.