view release on metacpan or  search on metacpan

CDB_File.xs  view on Meta::CPAN

    CODE:
        if(strlen(option_key) == 4 && strnEQ("utf8", option_key, 4) && is_utf8 )
#ifdef CDB_FILE_HAS_UTF8_HASH_MACROS
        croak("utf8 CDB_Files are not supported below Perl 5.14");
#else
        utf8_chosen = TRUE;
#endif

        Newxz(cdbmake, 1, cdb_make);
        cdbmake->f = PerlIO_open(fntemp, "wb");
        cdbmake->is_utf8 = utf8_chosen;

        if (!cdbmake->f) XSRETURN_UNDEF;

        if (cdb_make_start(cdbmake) < 0) XSRETURN_UNDEF;

        /* Oh, for referential transparency. */
        New(0, cdbmake->fn, strlen(fn) + 1, char);
        New(0, cdbmake->fntemp, strlen(fntemp) + 1, char);
        strcpy(cdbmake->fn, fn);
        strcpy(cdbmake->fntemp, fntemp);

        CLASS = "CDB_File::Maker"; /* OK, so this is a hack */

        RETVAL = cdbmake;

    OUTPUT:
        RETVAL

MODULE = CDB_File    PACKAGE = CDB_File::Maker    PREFIX = cdbmaker_

void
cdbmaker_DESTROY(sv)
        SV *   sv

        PREINIT:
        cdb_make *  this;

        CODE:
            if (sv_isobject(sv) && (SvTYPE(SvRV(sv)) == SVt_PVMG) ) {
                this = (cdb_make*)SvIV(SvRV(sv));
                if(this->f) {
                    PerlIO_close(this->f);
                }
                Safefree(this);
            }

void
cdbmaker_insert(this, ...)
    cdb_make *        this

    PREINIT:
        char *kp, *vp, packbuf[8];
        int  x;
        bool is_utf8;
        STRLEN klen, vlen;
        U32 h;
        SV *k;
        SV *v;

    PPCODE:
        is_utf8 = this->is_utf8;

        for (x = 1; x < items; x += 2) {
            k = ST(x);
            v = ST(x+1);

            if(!SvOK(k)) {
                Perl_warn(aTHX_ "Use of uninitialized value in hash key");
                k = sv_2mortal(newSVpv("", 0));
            }

            if(!SvOK(v)) {
                Perl_warn(aTHX_ "undef values cannot be stored in CDB_File. Storing an empty string instead");
                v = sv_2mortal(newSVpv("", 0));
            }

            kp = is_utf8 ? SvPVutf8(k, klen) : SvPV(k, klen);
            vp = is_utf8 ? SvPVutf8(v, vlen) : SvPV(v, vlen);

            uint32_pack(packbuf, klen);
            uint32_pack(packbuf + 4, vlen);

            if (PerlIO_write(this->f, packbuf, 8) < 8)
                writeerror();

            h = cdb_hash(kp, klen);
            if (PerlIO_write(this->f, kp, klen) < klen)
                writeerror();
            if (PerlIO_write(this->f, vp, vlen) < vlen)
                writeerror();

            if (cdb_make_addend(this, klen, vlen, h) == -1)
                nomem();
        }

int
cdbmaker_finish(this)
    cdb_make *this

    PREINIT:
        char buf[8];
        int i;
        U32 len, u;
        U32 count, memsize, where;
        struct cdb_hplist *x, *prev;
        struct cdb_hp *hp;

    CODE:
        for (i = 0; i < 256; ++i)
            this->count[i] = 0;

        for (x = this->head; x; x = x->next) {
            i = x->num;
            while (i--) {
                ++this->count[255 & x->hp[i].h];
            }
        }

        memsize = 1;
        for (i = 0; i < 256; ++i) {