+ Merged from fixbranch

packages/gdbm/Makefile.fpc

@@ -0,0 +1,18 @@
+#
+#   Makefile.fpc for InterBase bindings
+#
+
+[targets]
+units=gdbm
+examples=testgdbm testgdbm2
+
+[install]
+examplesubdir=gdbm
+
+[dirs]
+fpcdir=../..
+
+[rules]
+testgdbm$(EXEEXT): testgdbm.pp gdbm$(PPUEXT)
+
+testgdbm2$(EXEEXT): testgdbm2.pp gdbm$(PPUEXT)

packages/gdbm/README

@@ -0,0 +1,50 @@
+
+This is the Free Pascal interface to the GDBM library routines. 
+Essentially, this is a translation of the gdbm.h header files, with some
+additional routines.
+
+The headers translated without any problems, the only thing that should
+be taken into account is that the 
+GDBM_SYNC constant (for open flags) has been renamed to GDMB_DOSYNC
+because it conflicts with the gdbm_sync function. 
+
+Be careful: the TDatum.dptr data pointer which is allocated by the
+gdbm routines should be freed by the C free() call, NOT with the 
+pascal FreeMem() call.
+
+A solution for this is to use the 'cmem' unit, which replaces the standard
+FPC memory manager with the C memory manager. In that case, freemem()
+may be used to free the dptr field of the TDatum record.
+
+On top of the plain C header translations, The GDBM routines have been 
+overloaded with routines that accept plain strings as key or data 
+parameters. This means the following routines have been added:
+
+function gdbm_open(Const para1:string; para2:longint; para3:longint; para4:longint; para5:TGDBMErrorCallBack ):PGDBM_FILE;
+function gdbm_store(para1:PGDBM_FILE; Const para2:string; Const para3:string; para4:longint):Boolean;
+function gdbm_fetch(para1:PGDBM_FILE; Const para2:string):string;
+function gdbm_delete(para1:PGDBM_FILE; Const para2:string):boolean;
+procedure gdbm_firstkey(para1:PGDBM_FILE; var key :string);
+function gdbm_nextkey(para1:PGDBM_FILE; Const para2:string):string;
+function gdbm_exists(para1:PGDBM_FILE; Const para2:string):boolean;
+
+They are just the C routines, but with the TDatum type (a record) 
+replaced by a string. The routines take automatically care of memory
+deallocation.
+
+Functions that returned an integer to indicate success or failure have been
+replaced by functions that return a boolean.
+
+Careful: 
+When using ansistrings, make sure the gdbm unit has been compiled
+with the -Sh switch. The unit should work with both kinds of strings.
+
+There are 2 test programs:
+testgdbm tests the raw C header translation
+testgdbm2 tests the String interface to the GDBM routines.
+
+That's about it. 
+
+Enjoy!
+
+Michael. (Michael.VanCanneyt@Wisa.be)

packages/gdbm/gdbm.pp

@@ -0,0 +1,210 @@
+{
+    $Id$
+    Copyright (c) 1999-2000 by Michael Van Canneyt, member of
+    the Free Pascal development team
+
+    gdbm database routines header translations.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$h+}
+
+unit gdbm;
+
+
+
+interface
+
+const
+  External_library='gdbm';
+
+{ Pointers to basic pascal types, inserted by h2pas conversion program.}
+Type
+  PLongint  = ^Longint;
+  PSmallInt = ^SmallInt;
+  PByte     = ^Byte;
+  PWord     = ^Word;
+  PDWord    = ^DWord;
+  PDouble   = ^Double;
+
+{$PACKRECORDS C}
+
+const
+  { Parameters to gdbm_open for READERS, WRITERS, and WRITERS who
+    can create the database.  }
+GDBM_READER = 0;
+GDBM_WRITER = 1;
+GDBM_WRCREAT = 2;
+GDBM_NEWDB = 3;
+GDBM_FAST = $10;
+GDBM_DOSYNC = $20;  // Was GDBM_SYNC, but conflicts with gdbm_sync !!
+GDBM_NOLOCK = $40;
+GDBM_INSERT = 0;
+GDBM_REPLACE = 1;
+GDBM_CACHESIZE = 1;
+GDBM_FASTMODE = 2;
+GDBM_SYNCMODE = 3;
+GDBM_CENTFREE = 4;
+GDBM_COALESCEBLKS = 5;
+{ Error Codes }
+GDBM_NO_ERROR = 0;
+GDBM_MALLOC_ERROR = 1;
+GDBM_BLOCK_SIZE_ERROR = 2;
+GDBM_FILE_OPEN_ERROR = 3;
+GDBM_FILE_WRITE_ERROR = 4;
+GDBM_FILE_SEEK_ERROR = 5;
+GDBM_FILE_READ_ERROR = 6;
+GDBM_BAD_MAGIC_NUMBER = 7;
+GDBM_EMPTY_DATABASE = 8;
+GDBM_CANT_BE_READER = 9;
+GDBM_CANT_BE_WRITER = 10;
+GDBM_READER_CANT_DELETE = 11;
+GDBM_READER_CANT_STORE = 12;
+GDBM_READER_CANT_REORGANIZE = 13;
+GDBM_UNKNOWN_UPDATE = 14;
+GDBM_ITEM_NOT_FOUND = 15;
+GDBM_REORGANIZE_FAILED = 16;
+GDBM_CANNOT_REPLACE = 17;
+GDBM_ILLEGAL_DATA = 18;
+GDBM_OPT_ALREADY_SET = 19;
+GDBM_OPT_ILLEGAL = 29;
+
+
+type
+
+  TDatum = record
+        dptr : Pchar;
+        dsize : longint;
+     end;
+  PDatum = ^TDatum;
+    
+  TGDBM_FILE = record
+    dummy : array[0..9] of longint;
+  end;
+  PGDBM_FILE = ^TGDBM_FILE;
+  
+  TGDBMErrorCallBack = Procedure;
+
+
+    
+var
+  gdbm_version : Pchar;cvar; external; {name 'gdbm_version' not accepted ??}
+
+function gdbm_open(para1:Pchar; para2:longint; para3:longint; para4:longint; para5:TGDBMErrorCallBack ):PGDBM_FILE;cdecl;external External_library name 'gdbm_open';
+procedure gdbm_close(para1:PGDBM_FILE);cdecl;external External_library name 'gdbm_close';
+function gdbm_store(para1:PGDBM_FILE; para2:TDatum; para3:TDatum; para4:longint):longint;cdecl;external External_library name 'gdbm_store';
+function gdbm_fetch(para1:PGDBM_FILE; para2:TDatum):TDatum;cdecl;external External_library name 'gdbm_fetch';
+function gdbm_delete(para1:PGDBM_FILE; para2:TDatum):longint;cdecl;external External_library name 'gdbm_delete';
+function gdbm_firstkey(para1:PGDBM_FILE):TDatum;cdecl;external External_library name 'gdbm_firstkey';
+function gdbm_nextkey(para1:PGDBM_FILE; para2:TDatum):TDatum;cdecl;external External_library name 'gdbm_nextkey';
+function gdbm_reorganize(para1:PGDBM_FILE):longint;cdecl;external External_library name 'gdbm_reorganize';
+procedure gdbm_sync(para1:PGDBM_FILE);cdecl;external External_library name 'gdbm_sync';
+function gdbm_exists(para1:PGDBM_FILE; para2:TDatum):longint;cdecl;external External_library name 'gdbm_exists';
+function gdbm_setopt(para1:PGDBM_FILE; para2:longint; para3:Plongint; para4:longint):longint;cdecl;external External_library name 'gdbm_setopt';
+function gdbm_fdesc(para1:PGDBM_FILE):longint;cdecl;external External_library name 'gdbm_fdesc';
+
+{ Easy Pascal access routines }
+
+function gdbm_open(Const para1:string; para2:longint; para3:longint; para4:longint; para5:TGDBMErrorCallBack ):PGDBM_FILE;
+function gdbm_store(para1:PGDBM_FILE; Const para2:string; Const para3:string; para4:longint):Boolean;
+function gdbm_fetch(para1:PGDBM_FILE; Const para2:string):string;
+function gdbm_delete(para1:PGDBM_FILE; Const para2:string):boolean;
+procedure gdbm_firstkey(para1:PGDBM_FILE; var key :string);
+function gdbm_nextkey(para1:PGDBM_FILE; Const para2:string):string;
+function gdbm_exists(para1:PGDBM_FILE; Const para2:string):boolean;
+
+
+type
+   gdbm_error = longint;
+  var
+     gdbm_errno : gdbm_error;cvar;external{ 'gdbm_errno'};
+
+function gdbm_strerror(para1:gdbm_error):Pchar;cdecl;external External_library name 'gdbm_strerror';
+
+implementation
+
+function gdbm_open(Const para1:string; para2:longint; para3:longint; para4:longint; para5:TGDBMErrorCallBack ):PGDBM_FILE;
+
+begin
+  gdbm_open:=gdbm_open(@para1[1],para2,para3,para4,para5);
+end;
+
+procedure cfree (P : pointer);cdecl; external 'c' name 'free';
+
+Function DatumToString(Key : TDatum) : String;
+
+begin
+  SetLength(DatumToString,Key.dsize);
+  If key.Dsize>0 then
+    Move(key.dptr^,DatumToString[1],key.dsize);
+  if key.dptr<>Nil then
+    cfree(Key.dptr);
+end;
+
+Function StringToDatum(Value : String) : TDatum;
+
+begin
+  StringToDatum.dptr:=@Value[1];
+  StringToDatum.dsize:=Length(Value);
+end;
+
+
+function gdbm_store(para1:PGDBM_FILE; Const para2:string; Const para3:string; para4:longint):Boolean;
+
+Var 
+  Data,Key : TDatum;
+
+begin
+  Data:=StringToDatum(Para3);
+  Key:=StringToDatum(Para2);
+  gdbm_store:=gdbm_store(para1,key,data,para4)=0;
+end;
+
+function gdbm_fetch(para1:PGDBM_FILE; Const para2:string):string;
+
+begin
+  gdbm_fetch:=DatumToString(gdbm_fetch(para1,StringToDatum(Para2)));
+end;
+
+function gdbm_delete(para1:PGDBM_FILE; Const para2:string):boolean;
+
+begin
+  gdbm_delete:=gdbm_delete(Para1,StringToDatum(para2))=0;
+end;
+
+Procedure gdbm_firstkey(para1:PGDBM_FILE; var key : String);
+
+begin
+  Key:=DatumToString(gdbm_firstkey(para1));  
+end;
+
+function gdbm_nextkey(para1:PGDBM_FILE; Const Para2 :string):string;
+
+begin
+  gdbm_nextkey:=DatumToString(gdbm_nextkey(para1,StringToDatum(para2)));  
+end;
+
+function gdbm_exists(para1:PGDBM_FILE; const para2:string):boolean;
+
+begin
+  gdbm_exists:=gdbm_exists(para1,StringToDatum(para2))<>0;
+end;
+
+end.
+
+{
+  $Log$
+  Revision 1.2  2001-03-02 11:54:02  michael
+  + Merged from fixbranch
+
+  Revision 1.1.2.1  2001/03/02 11:49:44  michael
+  + Initial implementation
+
+}

packages/gdbm/testgdbm.pp

@@ -0,0 +1,86 @@
+{
+    $Id$
+    Copyright (c) 1999-2000 by Michael Van Canneyt, member of
+    the Free Pascal development team
+
+    Test raw gdbm header translations.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+program testgdbm;
+
+{$mode objfpc}
+{$h+}
+
+uses sysutils,gdbm;
+
+Var
+  dbf : pgdbm_file;
+  Key,Data : TDatum;
+  A,B : String;
+  i : longint;
+  
+begin
+  dbf:=gdbm_open('test.dat',512,GDBM_NEWDB,432,nil);
+  If dbf=Nil then
+    Writeln('Error when creating database');
+  for I:=1 to 10 do
+    begin
+    A:=Format('data for string %d',[i]);
+    B:=Format('string %d',[i]);
+    Data.dptr:=Pchar(A);
+    Data.dsize:=length(A);
+    key.dptr:=pchar(B);
+    key.dsize:=length(B);
+    if gdbm_store(dbf,key,data,gdbm_insert)<>0 then
+      Writeln('Error inserting data')
+    else
+      Writeln('Inserted string ',i)  
+    end;
+  key:=gdbm_firstkey(dbf);  
+  I:=0;
+  While key.dptr<>nil do
+    begin
+    inc(i);
+    data:=gdbm_fetch(dbf,key);
+    writeln('Data for key ',i,' (',key.dptr,') : ',data.dptr);
+    key:=gdbm_nextkey(dbf,key);
+    end;
+  gdbm_close(dbf);  
+end.
+
+{
+  $Log$
+  Revision 1.2  2001-03-02 11:54:02  michael
+  + Merged from fixbranch
+
+  Revision 1.1.2.1  2001/03/02 11:49:44  michael
+  + Initial implementation
+
+}
+
+{
+  $Log$
+  Revision 1.2  2001-03-02 11:54:02  michael
+  + Merged from fixbranch
+
+  Revision 1.1.2.1  2001/03/02 11:49:44  michael
+  + Initial implementation
+
+}
+
+{
+  $Log$
+  Revision 1.2  2001-03-02 11:54:02  michael
+  + Merged from fixbranch
+
+  Revision 1.1.2.1  2001/03/02 11:49:44  michael
+  + Initial implementation
+
+}

packages/gdbm/testgdbm2.pp

@@ -0,0 +1,63 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt, member of 
+    the Free Pascal development team
+
+    Test strings interface to gdbm library
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+program testgdbm2;
+
+{$mode objfpc}
+{$h+}
+
+uses sysutils,gdbm;
+
+Var
+  dbf : pgdbm_file;
+  A,B : String;
+  i : longint;
+  
+begin
+  dbf:=gdbm_open('test.dat',512,GDBM_NEWDB,432,nil);
+  If dbf=Nil then
+    Writeln('Error when creating database');
+  for I:=1 to 10 do
+    begin
+    A:=Format('data for string %d',[i]);
+    B:=Format('string %d',[i]);
+    if not gdbm_store(dbf,B,A,gdbm_insert) then
+      Writeln('Error inserting data')
+    else
+      Writeln('Inserted string ',i)  
+    end;
+  gdbm_firstkey(dbf,B);  
+  I:=0;
+  While B<>'' do
+    begin
+    inc(i);
+    A:=gdbm_fetch(dbf,B);
+    writeln('Data for key ',i,' (',B,') : ',A);
+    B:=gdbm_nextkey(dbf,B);
+    end;
+  gdbm_close(dbf);  
+end.
+
+{
+  $Log$
+  Revision 1.2  2001-03-02 11:54:02  michael
+  + Merged from fixbranch
+
+  Revision 1.1.2.1  2001/03/02 11:49:44  michael
+  + Initial implementation
+
+}