MOON
Server: Apache/2.2.21 (Unix) mod_ssl/2.2.21 OpenSSL/0.9.8e-fips-rhel5 mod_auth_passthrough/2.1 mod_bwlimited/1.4
System: Linux vps.panamaemb.org.sg 3.10.0-1160.80.1.vz7.191.4 #1 SMP Thu Dec 15 20:31:06 MSK 2022 x86_64
User: panama (500)
PHP: 5.2.17
Disabled: NONE
Upload Files
File: //installd/perl588installer/perl-5.8.8/ext/SDBM_File/SDBM_File.c
/*
 * This file was generated automatically by xsubpp version 1.9508 from the
 * contents of SDBM_File.xs. Do not edit this file, edit SDBM_File.xs instead.
 *
 *	ANY CHANGES MADE HERE WILL BE LOST!
 *
 */

#line 1 "SDBM_File.xs"
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "sdbm/sdbm.h"

typedef struct {
	DBM * 	dbp ;
	SV *    filter_fetch_key ;
	SV *    filter_store_key ;
	SV *    filter_fetch_value ;
	SV *    filter_store_value ;
	int     filtering ;
	} SDBM_File_type;

typedef SDBM_File_type * SDBM_File ;
typedef datum datum_key ;
typedef datum datum_value ;

#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
#define sdbm_FETCH(db,key)			sdbm_fetch(db->dbp,key)
#define sdbm_STORE(db,key,value,flags)		sdbm_store(db->dbp,key,value,flags)
#define sdbm_DELETE(db,key)			sdbm_delete(db->dbp,key)
#define sdbm_EXISTS(db,key)			sdbm_exists(db->dbp,key)
#define sdbm_FIRSTKEY(db)			sdbm_firstkey(db->dbp)
#define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db->dbp)


#line 39 "SDBM_File.c"

XS(XS_SDBM_File_TIEHASH); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_TIEHASH)
{
    dXSARGS;
    if (items != 4)
	Perl_croak(aTHX_ "Usage: SDBM_File::TIEHASH(dbtype, filename, flags, mode)");
    {
	char *	dbtype = (char *)SvPV_nolen(ST(0));
	char *	filename = (char *)SvPV_nolen(ST(1));
	int	flags = (int)SvIV(ST(2));
	int	mode = (int)SvIV(ST(3));
	SDBM_File	RETVAL;
#line 38 "SDBM_File.xs"
	{
	    DBM * 	dbp ;

	    RETVAL = NULL ;
	    if ((dbp = sdbm_open(filename,flags,mode))) {
	        RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
    	        Zero(RETVAL, 1, SDBM_File_type) ;
		RETVAL->dbp = dbp ;
	    }

	}
#line 65 "SDBM_File.c"
	ST(0) = sv_newmortal();
        sv_setref_pv(ST(0), dbtype, (void*)RETVAL);
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_DESTROY); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_DESTROY)
{
    dXSARGS;
    if (items != 1)
	Perl_croak(aTHX_ "Usage: SDBM_File::DESTROY(db)");
    {
	SDBM_File	db;

	if (SvROK(ST(0))) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not a reference");
#line 56 "SDBM_File.xs"
	  sdbm_close(db->dbp);
	  if (db->filter_fetch_key)
	    SvREFCNT_dec(db->filter_fetch_key) ;
	  if (db->filter_store_key)
	    SvREFCNT_dec(db->filter_store_key) ;
	  if (db->filter_fetch_value)
	    SvREFCNT_dec(db->filter_fetch_value) ;
	  if (db->filter_store_value)
	    SvREFCNT_dec(db->filter_store_value) ;
	  safefree(db) ;
#line 99 "SDBM_File.c"
    }
    XSRETURN_EMPTY;
}


XS(XS_SDBM_File_FETCH); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_FETCH)
{
    dXSARGS;
    if (items != 2)
	Perl_croak(aTHX_ "Usage: SDBM_File::FETCH(db, key)");
    {
	SDBM_File	db;
	datum_key	key;
	datum_value	RETVAL;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");

	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
	key.dptr = SvPVbyte(ST(1), PL_na);
	key.dsize = (int)PL_na;

	RETVAL = sdbm_FETCH(db, key);
	ST(0) = sv_newmortal();
	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
	DBM_ckFilter(ST(0), filter_fetch_value,"filter_fetch_value");
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_STORE); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_STORE)
{
    dXSARGS;
    if (items < 3 || items > 4)
	Perl_croak(aTHX_ "Usage: SDBM_File::STORE(db, key, value, flags = DBM_REPLACE)");
    {
	SDBM_File	db;
	datum_key	key;
	datum_value	value;
	int	flags;
	int	RETVAL;
	dXSTARG;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");

	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
	key.dptr = SvPVbyte(ST(1), PL_na);
	key.dsize = (int)PL_na;

        DBM_ckFilter(ST(2), filter_store_value, "filter_store_value");
	if (SvOK(ST(2))) {
	    value.dptr = SvPVbyte(ST(2), PL_na);
	    value.dsize = (int)PL_na;
	}
	else {
	    value.dptr = "";
	    value.dsize = 0;
	};

	if (items < 4)
	    flags = DBM_REPLACE;
	else {
	    flags = (int)SvIV(ST(3));
	}

	RETVAL = sdbm_STORE(db, key, value, flags);
	XSprePUSH; PUSHi((IV)RETVAL);
#line 79 "SDBM_File.xs"
	if (RETVAL) {
	    if (RETVAL < 0 && errno == EPERM)
		croak("No write permission to sdbm file");
	    croak("sdbm store returned %d, errno %d, key \"%s\"",
			RETVAL,errno,key.dptr);
	    sdbm_clearerr(db->dbp);
	}
#line 187 "SDBM_File.c"
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_DELETE); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_DELETE)
{
    dXSARGS;
    if (items != 2)
	Perl_croak(aTHX_ "Usage: SDBM_File::DELETE(db, key)");
    {
	SDBM_File	db;
	datum_key	key;
	int	RETVAL;
	dXSTARG;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");

	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
	key.dptr = SvPVbyte(ST(1), PL_na);
	key.dsize = (int)PL_na;

	RETVAL = sdbm_DELETE(db, key);
	XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_EXISTS); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_EXISTS)
{
    dXSARGS;
    if (items != 2)
	Perl_croak(aTHX_ "Usage: SDBM_File::EXISTS(db, key)");
    {
	SDBM_File	db;
	datum_key	key;
	int	RETVAL;
	dXSTARG;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");

	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
	key.dptr = SvPVbyte(ST(1), PL_na);
	key.dsize = (int)PL_na;

	RETVAL = sdbm_EXISTS(db, key);
	XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_FIRSTKEY); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_FIRSTKEY)
{
    dXSARGS;
    if (items != 1)
	Perl_croak(aTHX_ "Usage: SDBM_File::FIRSTKEY(db)");
    {
	SDBM_File	db;
	datum_key	RETVAL;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");

	RETVAL = sdbm_FIRSTKEY(db);
	ST(0) = sv_newmortal();
	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
	DBM_ckFilter(ST(0), filter_fetch_key,"filter_fetch_key");
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_NEXTKEY); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_NEXTKEY)
{
    dXSARGS;
    if (items != 2)
	Perl_croak(aTHX_ "Usage: SDBM_File::NEXTKEY(db, key)");
    {
	SDBM_File	db;
	datum_key	key;
	datum_key	RETVAL;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");

	DBM_ckFilter(ST(1), filter_store_key, "filter_store_key");
	key.dptr = SvPVbyte(ST(1), PL_na);
	key.dsize = (int)PL_na;

	RETVAL = sdbm_NEXTKEY(db, key);
	ST(0) = sv_newmortal();
	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
	DBM_ckFilter(ST(0), filter_fetch_key,"filter_fetch_key");
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_error); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_error)
{
    dXSARGS;
    if (items != 1)
	Perl_croak(aTHX_ "Usage: SDBM_File::error(db)");
    {
	SDBM_File	db;
	int	RETVAL;
	dXSTARG;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");
#line 110 "SDBM_File.xs"
	RETVAL = sdbm_error(db->dbp) ;
#line 329 "SDBM_File.c"
	XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_clearerr); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_clearerr)
{
    dXSARGS;
    if (items != 1)
	Perl_croak(aTHX_ "Usage: SDBM_File::clearerr(db)");
    {
	SDBM_File	db;
	int	RETVAL;
	dXSTARG;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");
#line 118 "SDBM_File.xs"
	RETVAL = sdbm_clearerr(db->dbp) ;
#line 355 "SDBM_File.c"
	XSprePUSH; PUSHi((IV)RETVAL);
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_filter_fetch_key); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_filter_fetch_key)
{
    dXSARGS;
    if (items != 2)
	Perl_croak(aTHX_ "Usage: SDBM_File::filter_fetch_key(db, code)");
    {
	SDBM_File	db;
	SV *	code = ST(1);
	SV *	RETVAL = &PL_sv_undef ;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");
#line 129 "SDBM_File.xs"
	    DBM_setFilter(db->filter_fetch_key, code) ;
#line 381 "SDBM_File.c"
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_filter_store_key); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_filter_store_key)
{
    dXSARGS;
    if (items != 2)
	Perl_croak(aTHX_ "Usage: SDBM_File::filter_store_key(db, code)");
    {
	SDBM_File	db;
	SV *	code = ST(1);
	SV *	RETVAL =  &PL_sv_undef ;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");
#line 137 "SDBM_File.xs"
	    DBM_setFilter(db->filter_store_key, code) ;
#line 406 "SDBM_File.c"
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_filter_fetch_value); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_filter_fetch_value)
{
    dXSARGS;
    if (items != 2)
	Perl_croak(aTHX_ "Usage: SDBM_File::filter_fetch_value(db, code)");
    {
	SDBM_File	db;
	SV *	code = ST(1);
	SV *	RETVAL =  &PL_sv_undef ;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");
#line 145 "SDBM_File.xs"
	    DBM_setFilter(db->filter_fetch_value, code) ;
#line 431 "SDBM_File.c"
    }
    XSRETURN(1);
}


XS(XS_SDBM_File_filter_store_value); /* prototype to pass -Wmissing-prototypes */
XS(XS_SDBM_File_filter_store_value)
{
    dXSARGS;
    if (items != 2)
	Perl_croak(aTHX_ "Usage: SDBM_File::filter_store_value(db, code)");
    {
	SDBM_File	db;
	SV *	code = ST(1);
	SV *	RETVAL =  &PL_sv_undef ;

	if (sv_derived_from(ST(0), "SDBM_File")) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    db = INT2PTR(SDBM_File,tmp);
	}
	else
	    Perl_croak(aTHX_ "db is not of type SDBM_File");
#line 153 "SDBM_File.xs"
	    DBM_setFilter(db->filter_store_value, code) ;
#line 456 "SDBM_File.c"
    }
    XSRETURN(1);
}

#ifdef __cplusplus
extern "C"
#endif
XS(boot_SDBM_File); /* prototype to pass -Wmissing-prototypes */
XS(boot_SDBM_File)
{
    dXSARGS;
    char* file = __FILE__;

    XS_VERSION_BOOTCHECK ;

        newXS("SDBM_File::TIEHASH", XS_SDBM_File_TIEHASH, file);
        newXS("SDBM_File::DESTROY", XS_SDBM_File_DESTROY, file);
        newXS("SDBM_File::FETCH", XS_SDBM_File_FETCH, file);
        newXS("SDBM_File::STORE", XS_SDBM_File_STORE, file);
        newXS("SDBM_File::DELETE", XS_SDBM_File_DELETE, file);
        newXS("SDBM_File::EXISTS", XS_SDBM_File_EXISTS, file);
        newXS("SDBM_File::FIRSTKEY", XS_SDBM_File_FIRSTKEY, file);
        newXS("SDBM_File::NEXTKEY", XS_SDBM_File_NEXTKEY, file);
        newXS("SDBM_File::error", XS_SDBM_File_error, file);
        newXS("SDBM_File::clearerr", XS_SDBM_File_clearerr, file);
        newXS("SDBM_File::filter_fetch_key", XS_SDBM_File_filter_fetch_key, file);
        newXS("SDBM_File::filter_store_key", XS_SDBM_File_filter_store_key, file);
        newXS("SDBM_File::filter_fetch_value", XS_SDBM_File_filter_fetch_value, file);
        newXS("SDBM_File::filter_store_value", XS_SDBM_File_filter_store_value, file);
    XSRETURN_YES;
}