1			/*
     2			 * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the
     3			 * contents of SDBM_File.xs. Do not edit this file, edit SDBM_File.xs instead.
     4			 *
     5			 *	ANY CHANGES MADE HERE WILL BE LOST! 
     6			 *
     7			 */
     8			
     9			#line 1 "SDBM_File.xs"
    10			#define PERL_NO_GET_CONTEXT
    11			#include "EXTERN.h"
    12			#include "perl.h"
    13			#include "XSUB.h"
    14			#include "sdbm/sdbm.h"
    15			
    16			typedef struct {
    17				DBM * 	dbp ;
    18				SV *    filter_fetch_key ;
    19				SV *    filter_store_key ;
    20				SV *    filter_fetch_value ;
    21				SV *    filter_store_value ;
    22				int     filtering ;
    23				} SDBM_File_type;
    24			
    25			typedef SDBM_File_type * SDBM_File ;
    26			typedef datum datum_key ;
    27			typedef datum datum_value ;
    28			
    29			#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
    30			#define sdbm_FETCH(db,key)			sdbm_fetch(db->dbp,key)
    31			#define sdbm_STORE(db,key,value,flags)		sdbm_store(db->dbp,key,value,flags)
    32			#define sdbm_DELETE(db,key)			sdbm_delete(db->dbp,key)
    33			#define sdbm_EXISTS(db,key)			sdbm_exists(db->dbp,key)
    34			#define sdbm_FIRSTKEY(db)			sdbm_firstkey(db->dbp)
    35			#define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db->dbp)
    36			
    37			
    38			#ifndef PERL_UNUSED_VAR
    39			#  define PERL_UNUSED_VAR(var) if (0) var = var
    40			#endif
    41			
    42			#line 43 "SDBM_File.c"
    43			
    44			XS(XS_SDBM_File_TIEHASH); /* prototype to pass -Wmissing-prototypes */
    45			XS(XS_SDBM_File_TIEHASH)
    46	          54    {
    47	          54        dXSARGS;
    48	          54        if (items != 4)
    49	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::TIEHASH(dbtype, filename, flags, mode)");
    50	          54        PERL_UNUSED_VAR(cv); /* -W */
    51			    {
    52	          54    	char *	dbtype = (char *)SvPV_nolen(ST(0));
    53	          54    	char *	filename = (char *)SvPV_nolen(ST(1));
    54	          54    	int	flags = (int)SvIV(ST(2));
    55	          54    	int	mode = (int)SvIV(ST(3));
    56	          54    	SDBM_File	RETVAL;
    57			#line 38 "SDBM_File.xs"
    58				{
    59				    DBM * 	dbp ;
    60			
    61				    RETVAL = NULL ;
    62				    if ((dbp = sdbm_open(filename,flags,mode))) {
    63				        RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
    64			    	        Zero(RETVAL, 1, SDBM_File_type) ;
    65					RETVAL->dbp = dbp ;
    66				    }
    67			
    68				}
    69			#line 70 "SDBM_File.c"
    70	          54    	ST(0) = sv_newmortal();
    71	          54            sv_setref_pv(ST(0), dbtype, (void*)RETVAL);
    72			    }
    73	          54        XSRETURN(1);
    74			}
    75			
    76			
    77			XS(XS_SDBM_File_DESTROY); /* prototype to pass -Wmissing-prototypes */
    78			XS(XS_SDBM_File_DESTROY)
    79	          54    {
    80	          54        dXSARGS;
    81	          54        if (items != 1)
    82	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::DESTROY(db)");
    83	          54        PERL_UNUSED_VAR(cv); /* -W */
    84			    {
    85	          54    	SDBM_File	db;
    86			
    87	          54    	if (SvROK(ST(0))) {
    88	          54    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
    89	          54    	    db = INT2PTR(SDBM_File,tmp);
    90				}
    91				else
    92	      ######    	    Perl_croak(aTHX_ "db is not a reference");
    93			#line 56 "SDBM_File.xs"
    94				  sdbm_close(db->dbp);
    95				  if (db->filter_fetch_key)
    96				    SvREFCNT_dec(db->filter_fetch_key) ;
    97				  if (db->filter_store_key)
    98				    SvREFCNT_dec(db->filter_store_key) ;
    99				  if (db->filter_fetch_value)
   100				    SvREFCNT_dec(db->filter_fetch_value) ;
   101				  if (db->filter_store_value)
   102				    SvREFCNT_dec(db->filter_store_value) ;
   103				  safefree(db) ;
   104			#line 105 "SDBM_File.c"
   105			    }
   106	          54        XSRETURN_EMPTY;
   107			}
   108			
   109			
   110			XS(XS_SDBM_File_FETCH); /* prototype to pass -Wmissing-prototypes */
   111			XS(XS_SDBM_File_FETCH)
   112	        1155    {
   113	        1155        dXSARGS;
   114	        1155        if (items != 2)
   115	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::FETCH(db, key)");
   116	        1155        PERL_UNUSED_VAR(cv); /* -W */
   117			    {
   118	        1155    	SDBM_File	db;
   119	        1155    	datum_key	key;
   120	        1155    	datum_value	RETVAL;
   121			
   122	        1155    	if (sv_derived_from(ST(0), "SDBM_File")) {
   123	        1155    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   124	        1155    	    db = INT2PTR(SDBM_File,tmp);
   125				}
   126				else
   127	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   128			
   129	        1155    	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
   130	        1154    	key.dptr = SvPVbyte(ST(1), PL_na);
   131	        1154    	key.dsize = (int)PL_na;
   132			
   133	        1154    	RETVAL = sdbm_FETCH(db, key);
   134	        1154    	ST(0) = sv_newmortal();
   135	        1154    	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
   136	        1154    	DBM_ckFilter(ST(0), filter_fetch_value,"filter_fetch_value");
   137			    }
   138	        1154        XSRETURN(1);
   139			}
   140			
   141			
   142			XS(XS_SDBM_File_STORE); /* prototype to pass -Wmissing-prototypes */
   143			XS(XS_SDBM_File_STORE)
   144	         992    {
   145	         992        dXSARGS;
   146	         992        if (items < 3 || items > 4)
   147	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::STORE(db, key, value, flags = DBM_REPLACE)");
   148	         992        PERL_UNUSED_VAR(cv); /* -W */
   149			    {
   150	         992    	SDBM_File	db;
   151	         992    	datum_key	key;
   152	         992    	datum_value	value;
   153	         992    	int	flags;
   154	         992    	int	RETVAL;
   155	         992    	dXSTARG;
   156			
   157	         992    	if (sv_derived_from(ST(0), "SDBM_File")) {
   158	         992    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   159	         992    	    db = INT2PTR(SDBM_File,tmp);
   160				}
   161				else
   162	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   163			
   164	         992    	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
   165	         991    	key.dptr = SvPVbyte(ST(1), PL_na);
   166	         991    	key.dsize = (int)PL_na;
   167			
   168	         991            DBM_ckFilter(ST(2), filter_store_value, "filter_store_value");
   169	         991    	if (SvOK(ST(2))) {
   170	         986    	    value.dptr = SvPVbyte(ST(2), PL_na);
   171	         986    	    value.dsize = (int)PL_na;
   172				}
   173				else {
   174	           5    	    value.dptr = "";
   175	           5    	    value.dsize = 0;
   176				};
   177			
   178	         991    	if (items < 4)
   179	         991    	    flags = DBM_REPLACE;
   180				else {
   181	      ######    	    flags = (int)SvIV(ST(3));
   182				}
   183			
   184	         991    	RETVAL = sdbm_STORE(db, key, value, flags);
   185	         991    	XSprePUSH; PUSHi((IV)RETVAL);
   186			#line 79 "SDBM_File.xs"
   187				if (RETVAL) {
   188				    if (RETVAL < 0 && errno == EPERM)
   189					croak("No write permission to sdbm file");
   190				    croak("sdbm store returned %d, errno %d, key \"%s\"",
   191						RETVAL,errno,key.dptr);
   192				    sdbm_clearerr(db->dbp);
   193				}
   194			#line 195 "SDBM_File.c"
   195			    }
   196	         991        XSRETURN(1);
   197			}
   198			
   199			
   200			XS(XS_SDBM_File_DELETE); /* prototype to pass -Wmissing-prototypes */
   201			XS(XS_SDBM_File_DELETE)
   202	           6    {
   203	           6        dXSARGS;
   204	           6        if (items != 2)
   205	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::DELETE(db, key)");
   206	           6        PERL_UNUSED_VAR(cv); /* -W */
   207			    {
   208	           6    	SDBM_File	db;
   209	           6    	datum_key	key;
   210	           6    	int	RETVAL;
   211	           6    	dXSTARG;
   212			
   213	           6    	if (sv_derived_from(ST(0), "SDBM_File")) {
   214	           6    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   215	           6    	    db = INT2PTR(SDBM_File,tmp);
   216				}
   217				else
   218	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   219			
   220	           6    	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
   221	           6    	key.dptr = SvPVbyte(ST(1), PL_na);
   222	           6    	key.dsize = (int)PL_na;
   223			
   224	           6    	RETVAL = sdbm_DELETE(db, key);
   225	           6    	XSprePUSH; PUSHi((IV)RETVAL);
   226			    }
   227	           6        XSRETURN(1);
   228			}
   229			
   230			
   231			XS(XS_SDBM_File_EXISTS); /* prototype to pass -Wmissing-prototypes */
   232			XS(XS_SDBM_File_EXISTS)
   233	           2    {
   234	           2        dXSARGS;
   235	           2        if (items != 2)
   236	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::EXISTS(db, key)");
   237	           2        PERL_UNUSED_VAR(cv); /* -W */
   238			    {
   239	           2    	SDBM_File	db;
   240	           2    	datum_key	key;
   241	           2    	int	RETVAL;
   242	           2    	dXSTARG;
   243			
   244	           2    	if (sv_derived_from(ST(0), "SDBM_File")) {
   245	           2    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   246	           2    	    db = INT2PTR(SDBM_File,tmp);
   247				}
   248				else
   249	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   250			
   251	           2    	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
   252	           2    	key.dptr = SvPVbyte(ST(1), PL_na);
   253	           2    	key.dsize = (int)PL_na;
   254			
   255	           2    	RETVAL = sdbm_EXISTS(db, key);
   256	           2    	XSprePUSH; PUSHi((IV)RETVAL);
   257			    }
   258	           2        XSRETURN(1);
   259			}
   260			
   261			
   262			XS(XS_SDBM_File_FIRSTKEY); /* prototype to pass -Wmissing-prototypes */
   263			XS(XS_SDBM_File_FIRSTKEY)
   264	          47    {
   265	          47        dXSARGS;
   266	          47        if (items != 1)
   267	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::FIRSTKEY(db)");
   268	          47        PERL_UNUSED_VAR(cv); /* -W */
   269			    {
   270	          47    	SDBM_File	db;
   271	          47    	datum_key	RETVAL;
   272			
   273	          47    	if (sv_derived_from(ST(0), "SDBM_File")) {
   274	          47    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   275	          47    	    db = INT2PTR(SDBM_File,tmp);
   276				}
   277				else
   278	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   279			
   280	          47    	RETVAL = sdbm_FIRSTKEY(db);
   281	          47    	ST(0) = sv_newmortal();
   282	          47    	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
   283	          47    	DBM_ckFilter(ST(0), filter_fetch_key,"filter_fetch_key");
   284			    }
   285	          47        XSRETURN(1);
   286			}
   287			
   288			
   289			XS(XS_SDBM_File_NEXTKEY); /* prototype to pass -Wmissing-prototypes */
   290			XS(XS_SDBM_File_NEXTKEY)
   291	         378    {
   292	         378        dXSARGS;
   293	         378        if (items != 2)
   294	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::NEXTKEY(db, key)");
   295	         378        PERL_UNUSED_VAR(cv); /* -W */
   296			    {
   297	         378    	SDBM_File	db;
   298	         378    	datum_key	key;
   299	         378    	datum_key	RETVAL;
   300			
   301	         378    	if (sv_derived_from(ST(0), "SDBM_File")) {
   302	         378    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   303	         378    	    db = INT2PTR(SDBM_File,tmp);
   304				}
   305				else
   306	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   307			
   308	         378    	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
   309	         378    	key.dptr = SvPVbyte(ST(1), PL_na);
   310	         378    	key.dsize = (int)PL_na;
   311			
   312	         378    	RETVAL = sdbm_NEXTKEY(db, key);
   313	         378    	ST(0) = sv_newmortal();
   314	         378    	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
   315	         378    	DBM_ckFilter(ST(0), filter_fetch_key,"filter_fetch_key");
   316			    }
   317	         378        XSRETURN(1);
   318			}
   319			
   320			
   321			XS(XS_SDBM_File_error); /* prototype to pass -Wmissing-prototypes */
   322			XS(XS_SDBM_File_error)
   323	      ######    {
   324	      ######        dXSARGS;
   325	      ######        if (items != 1)
   326	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::error(db)");
   327	      ######        PERL_UNUSED_VAR(cv); /* -W */
   328			    {
   329	      ######    	SDBM_File	db;
   330	      ######    	int	RETVAL;
   331	      ######    	dXSTARG;
   332			
   333	      ######    	if (sv_derived_from(ST(0), "SDBM_File")) {
   334	      ######    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   335	      ######    	    db = INT2PTR(SDBM_File,tmp);
   336				}
   337				else
   338	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   339			#line 110 "SDBM_File.xs"
   340				RETVAL = sdbm_error(db->dbp) ;
   341			#line 342 "SDBM_File.c"
   342	      ######    	XSprePUSH; PUSHi((IV)RETVAL);
   343			    }
   344	      ######        XSRETURN(1);
   345			}
   346			
   347			
   348			XS(XS_SDBM_File_clearerr); /* prototype to pass -Wmissing-prototypes */
   349			XS(XS_SDBM_File_clearerr)
   350	      ######    {
   351	      ######        dXSARGS;
   352	      ######        if (items != 1)
   353	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::clearerr(db)");
   354	      ######        PERL_UNUSED_VAR(cv); /* -W */
   355			    {
   356	      ######    	SDBM_File	db;
   357	      ######    	int	RETVAL;
   358	      ######    	dXSTARG;
   359			
   360	      ######    	if (sv_derived_from(ST(0), "SDBM_File")) {
   361	      ######    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   362	      ######    	    db = INT2PTR(SDBM_File,tmp);
   363				}
   364				else
   365	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   366			#line 118 "SDBM_File.xs"
   367				RETVAL = sdbm_clearerr(db->dbp) ;
   368			#line 369 "SDBM_File.c"
   369	      ######    	XSprePUSH; PUSHi((IV)RETVAL);
   370			    }
   371	      ######        XSRETURN(1);
   372			}
   373			
   374			
   375			XS(XS_SDBM_File_filter_fetch_key); /* prototype to pass -Wmissing-prototypes */
   376			XS(XS_SDBM_File_filter_fetch_key)
   377	          48    {
   378	          48        dXSARGS;
   379	          48        if (items != 2)
   380	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::filter_fetch_key(db, code)");
   381	          48        PERL_UNUSED_VAR(cv); /* -W */
   382			    {
   383	          48    	SDBM_File	db;
   384	          48    	SV *	code = ST(1);
   385	          48    	SV *	RETVAL = &PL_sv_undef ;
   386			
   387	          48    	if (sv_derived_from(ST(0), "SDBM_File")) {
   388	          48    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   389	          48    	    db = INT2PTR(SDBM_File,tmp);
   390				}
   391				else
   392	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   393			#line 129 "SDBM_File.xs"
   394				    DBM_setFilter(db->filter_fetch_key, code) ;
   395			#line 396 "SDBM_File.c"
   396			    }
   397	          48        XSRETURN(1);
   398			}
   399			
   400			
   401			XS(XS_SDBM_File_filter_store_key); /* prototype to pass -Wmissing-prototypes */
   402			XS(XS_SDBM_File_filter_store_key)
   403	          49    {
   404	          49        dXSARGS;
   405	          49        if (items != 2)
   406	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::filter_store_key(db, code)");
   407	          49        PERL_UNUSED_VAR(cv); /* -W */
   408			    {
   409	          49    	SDBM_File	db;
   410	          49    	SV *	code = ST(1);
   411	          49    	SV *	RETVAL =  &PL_sv_undef ;
   412			
   413	          49    	if (sv_derived_from(ST(0), "SDBM_File")) {
   414	          49    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   415	          49    	    db = INT2PTR(SDBM_File,tmp);
   416				}
   417				else
   418	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   419			#line 137 "SDBM_File.xs"
   420				    DBM_setFilter(db->filter_store_key, code) ;
   421			#line 422 "SDBM_File.c"
   422			    }
   423	          49        XSRETURN(1);
   424			}
   425			
   426			
   427			XS(XS_SDBM_File_filter_fetch_value); /* prototype to pass -Wmissing-prototypes */
   428			XS(XS_SDBM_File_filter_fetch_value)
   429	          47    {
   430	          47        dXSARGS;
   431	          47        if (items != 2)
   432	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::filter_fetch_value(db, code)");
   433	          47        PERL_UNUSED_VAR(cv); /* -W */
   434			    {
   435	          47    	SDBM_File	db;
   436	          47    	SV *	code = ST(1);
   437	          47    	SV *	RETVAL =  &PL_sv_undef ;
   438			
   439	          47    	if (sv_derived_from(ST(0), "SDBM_File")) {
   440	          47    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   441	          47    	    db = INT2PTR(SDBM_File,tmp);
   442				}
   443				else
   444	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   445			#line 145 "SDBM_File.xs"
   446				    DBM_setFilter(db->filter_fetch_value, code) ;
   447			#line 448 "SDBM_File.c"
   448			    }
   449	          47        XSRETURN(1);
   450			}
   451			
   452			
   453			XS(XS_SDBM_File_filter_store_value); /* prototype to pass -Wmissing-prototypes */
   454			XS(XS_SDBM_File_filter_store_value)
   455	          47    {
   456	          47        dXSARGS;
   457	          47        if (items != 2)
   458	      ######    	Perl_croak(aTHX_ "Usage: SDBM_File::filter_store_value(db, code)");
   459	          47        PERL_UNUSED_VAR(cv); /* -W */
   460			    {
   461	          47    	SDBM_File	db;
   462	          47    	SV *	code = ST(1);
   463	          47    	SV *	RETVAL =  &PL_sv_undef ;
   464			
   465	          47    	if (sv_derived_from(ST(0), "SDBM_File")) {
   466	          47    	    IV tmp = SvIV((SV*)SvRV(ST(0)));
   467	          47    	    db = INT2PTR(SDBM_File,tmp);
   468				}
   469				else
   470	      ######    	    Perl_croak(aTHX_ "db is not of type SDBM_File");
   471			#line 153 "SDBM_File.xs"
   472				    DBM_setFilter(db->filter_store_value, code) ;
   473			#line 474 "SDBM_File.c"
   474			    }
   475	          47        XSRETURN(1);
   476			}
   477			
   478			#ifdef __cplusplus
   479			extern "C"
   480			#endif
   481			XS(boot_SDBM_File); /* prototype to pass -Wmissing-prototypes */
   482			XS(boot_SDBM_File)
   483	          14    {
   484	          14        dXSARGS;
   485	          14        char* file = __FILE__;
   486			
   487	          14        PERL_UNUSED_VAR(cv); /* -W */
   488	          14        PERL_UNUSED_VAR(items); /* -W */
   489	          14        XS_VERSION_BOOTCHECK ;
   490			
   491	          14            newXS("SDBM_File::TIEHASH", XS_SDBM_File_TIEHASH, file);
   492	          14            newXS("SDBM_File::DESTROY", XS_SDBM_File_DESTROY, file);
   493	          14            newXS("SDBM_File::FETCH", XS_SDBM_File_FETCH, file);
   494	          14            newXS("SDBM_File::STORE", XS_SDBM_File_STORE, file);
   495	          14            newXS("SDBM_File::DELETE", XS_SDBM_File_DELETE, file);
   496	          14            newXS("SDBM_File::EXISTS", XS_SDBM_File_EXISTS, file);
   497	          14            newXS("SDBM_File::FIRSTKEY", XS_SDBM_File_FIRSTKEY, file);
   498	          14            newXS("SDBM_File::NEXTKEY", XS_SDBM_File_NEXTKEY, file);
   499	          14            newXS("SDBM_File::error", XS_SDBM_File_error, file);
   500	          14            newXS("SDBM_File::clearerr", XS_SDBM_File_clearerr, file);
   501	          14            newXS("SDBM_File::filter_fetch_key", XS_SDBM_File_filter_fetch_key, file);
   502	          14            newXS("SDBM_File::filter_store_key", XS_SDBM_File_filter_store_key, file);
   503	          14            newXS("SDBM_File::filter_fetch_value", XS_SDBM_File_filter_fetch_value, file);
   504	          14            newXS("SDBM_File::filter_store_value", XS_SDBM_File_filter_store_value, file);
   505	          14        XSRETURN_YES;
   506			}
   507