Sampler: GDBM OO wrapper

 
unit Unit1; 
 
{ (c) 2010 bflm, contact: befelemepeseveze at Google's free mail
 
  Free sample code - copy, use, modify, distribute, sell, release under other license, ...
 
}
 
{$mode objfpc}{$h+}
 
interface
 
const
  DEFAULT_FMODE = 432; // =0660(8)
 
type
 
  { TGDBM }
 
  TGDBM = class
  private
    FCacheSize: Integer;
    FCentFree: Longbool;
    FCoalesceBlks: Longbool;
    FDBF: Pointer;
    FSyncMode: Longbool;
    function GetFDesc: Integer;
    procedure Open(Name: String; OpenRW: Integer; const Sync, NoLock: Boolean;
      BlockSize: Integer; Mode: Integer);
    procedure SetCacheSize(const AValue: Integer);
    procedure SetCentFree(const AValue: Longbool);
    procedure SetCoalesceBlks(const AValue: Longbool);
    procedure SetSyncMode(const AValue: Longbool);
  public
    constructor CreateNewDB(const Name: String; const Sync: Boolean = False;
      const NoLock: Boolean = False; const BlockSize: Integer = 0;
      const FMode: Integer = DEFAULT_FMODE);
    constructor CreateOrOpen(const Name: String; const Sync: Boolean = False;
      const NoLock: Boolean = False; const BlockSize: Integer = 0;
      const FMode: Integer = DEFAULT_FMODE);
    constructor CreateReader(const Name: String);
    constructor CreateWriter(const Name: String; const Sync: Boolean = False;
      const NoLock: Boolean = False);
    destructor Destroy; override;
    { True if Key deleted }
    function Delete(const Key: String): Boolean;
    { True if Key deleted }
    function Delete(const Key; const KeyLen: Integer): Boolean;
    function Exists(const Key: String): Boolean;
    function Exists(const Key; const KeyLen: Integer): Boolean;
    { True if Key found => Value set }
    function Fetch(const Key: String; out Value: String): Boolean;
    { True if Key found => Value set. Value MUST be disposed using C free. }
    function Fetch(const Key; const KeyLen: Integer; out Value: Pointer;
      out Len: Integer): Boolean;
    { True if FirstKey returned }
    function FirstKey(out Key: String): Boolean;
    { True if FirstKey returned }
    function FirstKey(out Key: Pointer; out Len: Integer): Boolean;
    { True if Key already existed => new Value NOT stored }
    function Insert(const Key, Value: String): Boolean;
    { True if Key already existed => new Value NOT stored }
    function Insert(const Key; const KeyLen: Integer; const Value;
      const ValueLen: Integer): Boolean;
    { True if Next returned }
    function NextKey(const Key: String; var Next: String): Boolean;
    { True if Next returned. Key MUST be disposed using C free. }
    function NextKey(const Key; const KeyLen: Integer; var Next: Pointer;
      var Len: Integer): Boolean;
    procedure Reorganize;
    procedure Replace(const Key, Value: String);
    procedure Replace(const Key; const KeyLen: Integer; const Value;
      const ValueLen: Integer);
    procedure Sync;
    property CacheSize: Integer read FCacheSize Write SetCacheSize;
    property CentFree: Longbool read FCentFree Write SetCentFree;
    property CoalesceBlks: Longbool read FCoalesceBlks Write SetCoalesceBlks;
    property FDesc: Integer read GetFDesc;
    property SyncMode: Longbool read FSyncMode Write SetSyncMode;
  end;
 
implementation
 
uses
  SysUtils,
  gdbm;
 
procedure CFree(P: pointer); cdecl; external 'c' Name 'free';
 
function Datum(const Buf: Pointer; const Len: Integer): TDatum; inline;
begin
  Result.dptr := Buf;
  Result.dsize := Len;
end;
 
procedure Fail;
begin
  raise Exception.Create(gdbm_strerror(gdbm_errno));
end;
 
function CheckError(const Ret: Integer): Integer;
begin
  if Ret <> 0 then
    Fail;
  Result := Ret;
end;
 
operator := (const Datum: TDatum): String;
begin
  if Datum.dptr <> nil then begin
    SetLength(Result, Datum.dsize);
    Move(Datum.dptr^, Result[1], Datum.dsize);
    CFree(Datum.dptr);
  end else
    Result := '';
end;
 
operator := (const S: String): TDatum;
begin
  Assert(S <> '');
  Result.dptr := PChar(S);
  Result.dsize := Length(S);
end;
 
{ TGDBM }
 
constructor TGDBM.CreateNewDB(const Name: String; const Sync, NoLock: Boolean;
  const BlockSize: Integer = 0; const FMode: Integer = DEFAULT_FMODE);
begin
  inherited Create;
  Open(Name, GDBM_NEWDB, Sync, NoLock, BlockSize, FMode);
end;
 
constructor TGDBM.CreateOrOpen(const Name: String; const Sync, NoLock: Boolean;
  const BlockSize: Integer; const FMode: Integer);
begin
  inherited Create;
  Open(Name, GDBM_WRCREAT, Sync, NoLock, BlockSize, FMode);
end;
 
constructor TGDBM.CreateReader(const Name: String);
begin
  inherited Create;
  Open(Name, GDBM_READER, False, False, 0, 0);
end;
 
constructor TGDBM.CreateWriter(const Name: String; const Sync, NoLock: Boolean);
begin
  inherited Create;
  Open(Name, GDBM_WRITER, Sync, NoLock, 0, 0);
end;
 
destructor TGDBM.Destroy;
begin
  if FDBF <> nil then
    gdbm_close(FDBF);
  inherited;
end;
 
function TGDBM.Delete(const Key: String): Boolean;
var
  K: TDatum;
begin
  K := Key;
  Result := gdbm_delete(FDBF, K) = 0;
end;
 
function TGDBM.Delete(const Key; const KeyLen: Integer): Boolean;
begin
  Result := gdbm_delete(FDBF, Datum(@Key, KeyLen)) = 0;
end;
 
function TGDBM.Exists(const Key: String): Boolean;
var
  K: TDatum;
begin
  K := Key;
  Result := gdbm_exists(FDBF, K) <> 0;
end;
 
function TGDBM.Exists(const Key; const KeyLen: Integer): Boolean;
begin
  Result := gdbm_exists(FDBF, Datum(@Key, KeyLen)) <> 0;
end;
 
function TGDBM.Fetch(const Key: String; out Value: String): Boolean;
var
  K, V: TDatum;
begin
  K := Key;
  V := gdbm_fetch(FDBF, K);
  if V.dptr <> nil then begin
    Value := V;
    Exit(True);
  end;
  Result := False;
end;
 
function TGDBM.Fetch(const Key; const KeyLen: Integer; out Value: Pointer;
  out Len: Integer): Boolean;
var
  V: TDatum;
begin
  V := gdbm_fetch(FDBF, Datum(@Key, KeyLen));
  if V.dptr = nil then
    Exit(False);
  Value := V.dptr;
  Len := V.dsize;
  Result := True;
end;
 
function TGDBM.FirstKey(out Key: String): Boolean;
var
  K: TDatum;
begin
  K := gdbm_firstkey(FDBF);
  if K.dptr <> nil then begin
    Key := K;
    Exit(True);
  end;
  Result := False;
end;
 
function TGDBM.FirstKey(out Key: Pointer; out Len: Integer): Boolean;
var
  K: TDatum;
begin
  K := gdbm_firstkey(FDBF);
  if K.dptr <> nil then begin
    Key := K.dptr;
    Len := K.dsize;
    Exit(True);
  end;
  Result := False;
end;
 
procedure TGDBM.Open(Name: String; OpenRW: Integer; const Sync, NoLock: Boolean;
  BlockSize: Integer; Mode: Integer);
begin
  Assert(Name <> '');
  FSyncMode := Sync;
  if SyncMode then
    OpenRW += GDBM_DOSYNC;
  if NoLock then;
  OpenRW += GDBM_NOLOCK;
  FDBF := gdbm_open(PChar(Name), BlockSize, OpenRW, Mode, nil);
  if FDBF = nil then
    Fail;
end;
 
function TGDBM.GetFDesc: Integer;
begin
  Result := gdbm_fdesc(FDBF);
end;
 
procedure TGDBM.SetCacheSize(const AValue: Integer);
var
  Ret: Integer;
begin
  if FCacheSize = AValue then
    exit;
  FCacheSize := AValue;
  Ret := gdbm_setopt(FDBF, GDBM_CACHESIZE, @FCacheSize, SizeOf(FCacheSize));
  if Ret <> 0 then
    Fail;
end;
 
procedure TGDBM.SetCentFree(const AValue: Longbool);
begin
  if FCentFree = AValue then
    exit;
  FCentFree := AValue;
  CheckError(gdbm_setopt(FDBF, GDBM_CENTFREE, @FCentFree, SizeOf(FCentFree)));
end;
 
procedure TGDBM.SetCoalesceBlks(const AValue: Longbool);
begin
  if FCoalesceBlks = AValue then
    exit;
  FCoalesceBlks := AValue;
  CheckError(gdbm_setopt(FDBF, GDBM_COALESCEBLKS, @FCoalesceBlks,
    SizeOf(FCoalesceBlks)));
end;
 
procedure TGDBM.SetSyncMode(const AValue: Longbool);
begin
  if FSyncMode = AValue then
    exit;
  FSyncMode := AValue;
  CheckError(gdbm_setopt(FDBF, GDBM_SYNCMODE, @FSyncMode, SizeOf(FSyncMode)));
end;
 
function TGDBM.Insert(const Key, Value: String): Boolean;
var
  K, V: TDatum;
  Ret: Integer;
begin
  K := Key;
  V := Value;
  Ret := gdbm_store(FDBF, K, V, GDBM_INSERT);
  ;
  if Ret < 0 then // reader attempts insert
    Fail;
  Result := Ret <> 0;
end;
 
function TGDBM.Insert(const Key; const KeyLen: Integer; const Value;
  const ValueLen: Integer): Boolean;
var
  Ret: Integer;
begin
  Ret := gdbm_store(FDBF, Datum(@Key, KeyLen), Datum(@Value, ValueLen), GDBM_INSERT);
  if Ret < 0 then // reader attempts insert
    Fail;
  Result := Ret <> 0;
end;
 
function TGDBM.NextKey(const Key: String; var Next: String): Boolean;
var
  K, N: TDatum;
begin
  K := Key;
  N := gdbm_nextkey(FDBF, K);
  if N.dptr <> nil then begin
    Next := N;
    Exit(True);
  end;
  Result := False;
end;
 
function TGDBM.NextKey(const Key; const KeyLen: Integer; var Next: Pointer;
  var Len: Integer): Boolean;
var
  N: TDatum;
begin
  N := gdbm_nextkey(FDBF, Datum(@Key, KeyLen));
  if N.dptr <> nil then begin

    Next := N.dptr;
    Len := N.dsize;
    Exit(True);
  end;
  Result := False;
end;
 
procedure TGDBM.Reorganize;
var
  Ret: Integer;
begin
  Ret := gdbm_reorganize(FDBF);
  if Ret <> 0 then
    Fail;
end;
 
procedure TGDBM.Replace(const Key, Value: String);
var
  K, V: TDatum;
begin
  K := Key;
  V := Value;
  CheckError(gdbm_store(FDBF, K, V, GDBM_REPLACE));
end;
 
procedure TGDBM.Replace(const Key; const KeyLen: Integer; const Value;
  const ValueLen: Integer);
begin
  CheckError(gdbm_store(FDBF, Datum(@Key, KeyLen), Datum(@Value, ValueLen),
    GDBM_REPLACE));
end;
 
procedure TGDBM.Sync;
begin
  gdbm_sync(FDBF);
end;
 
end.