1			#define PERL_NO_GET_CONTEXT
     2			#include "EXTERN.h"
     3			#include "perl.h"
     4			#include "XSUB.h"
     5			#include "sdbm/sdbm.h"
     6			
     7			typedef struct {
     8				DBM * 	dbp ;
     9				SV *    filter_fetch_key ;
    10				SV *    filter_store_key ;
    11				SV *    filter_fetch_value ;
    12				SV *    filter_store_value ;
    13				int     filtering ;
    14				} SDBM_File_type;
    15			
    16			typedef SDBM_File_type * SDBM_File ;
    17			typedef datum datum_key ;
    18			typedef datum datum_value ;
    19			
    20			#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
    21			#define sdbm_FETCH(db,key)			sdbm_fetch(db->dbp,key)
    22			#define sdbm_STORE(db,key,value,flags)		sdbm_store(db->dbp,key,value,flags)
    23			#define sdbm_DELETE(db,key)			sdbm_delete(db->dbp,key)
    24			#define sdbm_EXISTS(db,key)			sdbm_exists(db->dbp,key)
    25			#define sdbm_FIRSTKEY(db)			sdbm_firstkey(db->dbp)
    26			#define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db->dbp)
    27			
    28			
    29			MODULE = SDBM_File	PACKAGE = SDBM_File	PREFIX = sdbm_
    30			
    31			SDBM_File
    32			sdbm_TIEHASH(dbtype, filename, flags, mode)
    33				char *		dbtype
    34				char *		filename
    35				int		flags
    36				int		mode
    37				CODE:
    38				{
    39	          54    	    DBM * 	dbp ;
    40			
    41	          54    	    RETVAL = NULL ;
    42	          54    	    if ((dbp = sdbm_open(filename,flags,mode))) {
    43	          54    	        RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
    44	          54        	        Zero(RETVAL, 1, SDBM_File_type) ;
    45	          54    		RETVAL->dbp = dbp ;
    46				    }
    47				    
    48				}
    49				OUTPUT:
    50				  RETVAL
    51			
    52			void
    53			sdbm_DESTROY(db)
    54				SDBM_File	db
    55				CODE:
    56	          54    	  sdbm_close(db->dbp);
    57	          54    	  if (db->filter_fetch_key)
    58	          20    	    SvREFCNT_dec(db->filter_fetch_key) ;
    59	          54    	  if (db->filter_store_key)
    60	          21    	    SvREFCNT_dec(db->filter_store_key) ;
    61	          54    	  if (db->filter_fetch_value)
    62	          19    	    SvREFCNT_dec(db->filter_fetch_value) ;
    63	          54    	  if (db->filter_store_value)
    64	          19    	    SvREFCNT_dec(db->filter_store_value) ;
    65	          54    	  safefree(db) ;
    66			
    67			datum_value
    68			sdbm_FETCH(db, key)
    69				SDBM_File	db
    70				datum_key	key
    71			
    72			int
    73			sdbm_STORE(db, key, value, flags = DBM_REPLACE)
    74				SDBM_File	db
    75				datum_key	key
    76				datum_value	value
    77				int		flags
    78			    CLEANUP:
    79	         991    	if (RETVAL) {
    80	      ######    	    if (RETVAL < 0 && errno == EPERM)
    81	      ######    		croak("No write permission to sdbm file");
    82	      ######    	    croak("sdbm store returned %d, errno %d, key \"%s\"",
    83						RETVAL,errno,key.dptr);
    84	         991    	    sdbm_clearerr(db->dbp);
    85				}
    86			
    87			int
    88			sdbm_DELETE(db, key)
    89				SDBM_File	db
    90				datum_key	key
    91			
    92			int
    93			sdbm_EXISTS(db,key)
    94				SDBM_File	db
    95				datum_key	key
    96			
    97			datum_key
    98			sdbm_FIRSTKEY(db)
    99				SDBM_File	db
   100			
   101			datum_key
   102			sdbm_NEXTKEY(db, key)
   103				SDBM_File	db
   104				datum_key	key;
   105			
   106			int
   107			sdbm_error(db)
   108				SDBM_File	db
   109				CODE:
   110	      ######    	RETVAL = sdbm_error(db->dbp) ;
   111				OUTPUT:
   112				  RETVAL
   113			
   114			int
   115			sdbm_clearerr(db)
   116				SDBM_File	db
   117				CODE:
   118	      ######    	RETVAL = sdbm_clearerr(db->dbp) ;
   119				OUTPUT:
   120				  RETVAL
   121			
   122			
   123			SV *
   124			filter_fetch_key(db, code)
   125				SDBM_File	db
   126				SV *		code
   127				SV *		RETVAL = &PL_sv_undef ;
   128				CODE:
   129	          48    	    DBM_setFilter(db->filter_fetch_key, code) ;
   130			
   131			SV *
   132			filter_store_key(db, code)
   133				SDBM_File	db
   134				SV *		code
   135				SV *		RETVAL =  &PL_sv_undef ;
   136				CODE:
   137	          49    	    DBM_setFilter(db->filter_store_key, code) ;
   138			
   139			SV *
   140			filter_fetch_value(db, code)
   141				SDBM_File	db
   142				SV *		code
   143				SV *		RETVAL =  &PL_sv_undef ;
   144				CODE:
   145	          47    	    DBM_setFilter(db->filter_fetch_value, code) ;
   146			
   147			SV *
   148			filter_store_value(db, code)
   149				SDBM_File	db
   150				SV *		code
   151				SV *		RETVAL =  &PL_sv_undef ;
   152				CODE:
   153	          47    	    DBM_setFilter(db->filter_store_value, code) ;
   154