"======================================================================
|
|   GDBM Smalltalk layer
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 2, or (at your option) any later version.
| 
| GNU Smalltalk 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.  See the GNU General Public License for more
| details.
| 
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"


"
     GDBM_FILE gdbm_open(name, block_size, flags, mode, fatal_func);
     void gdbm_close(dbf);
     int gdbm_store(dbf, key, content, flag);
     datum gdbm_fetch(dbf, key);
     int gdbm_delete(dbf, key);
     datum gdbm_firstkey(dbf);
     datum gdbm_nextkey(dbf, key);
     int gdbm_reorganize(dbf);
     void gdbm_sync(dbf); -- new
     int gdbm_exists(dbf, key); not present
     char *gdbm_strerror(errno); -- new 
     int gdbm_setopt(dbf, option, value, size) -- new
"


CObject variableWordSubclass: #GDBM
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GDBM access'
!
    
"
typedef struct {
	char *dptr;
	int   dsize;
      } datum;
"


CStruct newStruct: #DatumStruct
	declaration:
	    #(
	      (dPtr (ptr char))
	      (dSize long)
	     )
!

!DatumStruct class methodsFor: 'instance creation'!

fromString: aString
    | obj strObj len |
    obj := self new.
    len := aString size.
    obj dSize value: len.
    obj dPtr at: 0 put: aString type: CString scalarIndex.
    ^obj
! !


!DatumStruct methodsFor: 'accessing'!

asString
    | len str |
    len := self dSize value.
    str := String new: len.
    1 to: len do: 
	[ :i | str at: i put: (self dPtr at: i - 1 ) ].
    ^str
! !



GDBM class
	defineCFunc: 'gdbm_open'
	withSelectorArgs: 'open: fileName blockSize: size flags: flags
                            mode: modeInt fatalFunc: funcAddr'
	returning: (CType baseType: GDBM)
	args: #(string int int int cObject)
!

'foo' printNl!

GDBM
	defineCFunc: 'gdbm_close'
	withSelectorArgs: 'close'
	returning: #int
	args: #(self)
!


GDBM
	defineCFunc: 'gdbm_store'
	withSelectorArgs: 'at: key put: value flag: aFlag' 
	returning: #int
	args: #(self cObject cObject int)
!

'bar ' printNl!

DatumStruct inspect!

GDBM
	defineCFunc: 'gdbm_fetch'
	withSelectorArgs: 'at: key' 
	returning: (CType baseType: DatumStruct)
	args: #(self cObject)
!

'bar2 ' printNl!

GDBM
	defineCFunc: 'gdbm_delete'
	withSelectorArgs: 'removeKey: key' 
	returning: #long
	args: #(self cObject)
!

'bar3 ' printNl!

GDBM
	defineCFunc: 'gdbm_firstkey'
	withSelectorArgs: 'firstKey' 
	returning: (CType baseType: DatumStruct)
	args: #(self)
!

'bar4 ' printNl!

GDBM
	defineCFunc: 'gdbm_nextkey'
	withSelectorArgs: 'nextKey: afterDatum' 
	returning: (CType baseType: DatumStruct)
	args: #(self cObject)
!

GDBM
	defineCFunc: 'gdbm_reorganize'
	withSelectorArgs: 'reorganize'
	returning: #long
	args: #(self)
!

!GDBM class methodsFor: 'testing'!

test
    | database key value |
    database := self open: 'test.gdbm' blockSize: 1024 flags: 2 "write/create"
		    mode: 8r666 fatalFunc: nil.
    database inspect.
    key := DatumStruct fromString: 'fred'.
    key inspect.
    value := DatumStruct fromString: 'Fred Flintstone'.
    value inspect.
    (database at: key put: value flag: 1 "replace") printNl.
    key := DatumStruct fromString: 'wilma'.
    value := DatumStruct fromString: 'Wilma Flintstone'.
    (database at: key put: value flag: 1 "replace") printNl.
    database close.
    database := self open: 'test.gdbm' blockSize: 1024 flags: 0 "read"
		    mode: 8r666 fatalFunc: nil.
    (database at: (DatumStruct fromString: 'barney')) dPtr inspect.
    
    (database at: (DatumStruct fromString: 'wilma')) inspect.
    database close.
!

test2
    | database item value |
    database := self open: 'test.gdbm' blockSize: 1024 flags: 0 "read"
		    mode: 8r666 fatalFunc: nil.

    item := database firstKey.
    [ item dPtr value notNil ] 
	whileTrue: 
	    [ value := database at: item.
	      Transcript nextPutAll: item asString;
		  nextPutAll: '  ';
		  nextPutAll: value asString;
		  nl.
	      item := database nextKey: item ].
    database close.

!

test3
    "The big one"
    | database key value item |
    database := self open: 'st.gdbm' blockSize: 1024 flags: 2 "write/create"
		    mode: 8r666 fatalFunc: nil.

    Object withAllSubclasses do:
	[ :subclass | ]
    
    database close.

    database := self open: 'st.gdbm' blockSize: 1024 flags: 0 "read"
		    mode: 8r666 fatalFunc: nil.
    
    
    item := database firstKey.
    [ item dPtr value notNil ] 
	whileTrue: 
	    [ value := database at: item.
	      Transcript nextPutAll: item asString;
		  nextPutAll: '  ';
		  nextPutAll: value asString;
		  nl.
	      item := database nextKey: item ].
    database close.


! !

GDBM test
!

GDBM test2
!