view release on metacpan or  search on metacpan

LibUUID.xs  view on Meta::CPAN

/* hex-string, hex, base64 (TODO), or binary sv to uuid_t */
STATIC IV sv_to_uuid (SV *sv, uuid_t uuid) {
    dSP;

    if ( SvPOK(sv) || sv_isobject(sv) ) {
        char *pv;
        STRLEN len;

        if ( SvPOK(sv) ) {
            pv = SvPV_nolen(sv);
            len = SvCUR(sv);
        } else {
            pv = SvPV(sv, len);
        }

        switch ( len ) {
            case UUID_HEX_SIZE:
                return hex_to_uuid(uuid, pv);
            case UUID_BASE64_SIZE:
            case UUID_BASE64_LF_SIZE:
            case UUID_BASE64_CRLF_SIZE:

                load_module(PERL_LOADMOD_NOIMPORT, newSVpvs("MIME::Base64"), NULL);

                PUSHMARK(SP);
                XPUSHs(sv);
                PUTBACK;

                call_pv("MIME::Base64::decode_base64", G_SCALAR);

                SPAGAIN;
                pv = SvPV_nolen(TOPs);

                /* fall through */
            case sizeof(uuid_t):
                uuid_copy(uuid, *(uuid_t *)pv);
                return 1;
            case UUID_STRING_SIZE:
                if ( uuid_parse(pv, uuid) == 0 )
                    return 1;
        }
    }

    return 0;
}


MODULE = Data::UUID::LibUUID            PACKAGE = Data::UUID::LibUUID
PROTOTYPES: ENABLE
BOOT:
    last_pid = getpid();

SV*
uuid_eq(uu1_sv, uu2_sv)
    SV *uu1_sv;
    SV *uu2_sv;
    PROTOTYPE: $$
    PREINIT:
        uuid_t uu1;
        uuid_t uu2;
    PPCODE:
        if ( sv_to_uuid(uu1_sv, uu1) && sv_to_uuid(uu2_sv, uu2) )
            if ( uuid_compare(uu1, uu2) == 0 )
                XSRETURN_YES;
            else
                XSRETURN_NO;
        else
            XSRETURN_UNDEF;

SV*
uuid_compare(uu1_sv, uu2_sv)
    SV *uu1_sv;
    SV *uu2_sv;
    PROTOTYPE: $$
    PREINIT:
        uuid_t uu1;
        uuid_t uu2;
    PPCODE:
        if ( sv_to_uuid(uu1_sv, uu1) && sv_to_uuid(uu2_sv, uu2) )
            XSRETURN_IV(uuid_compare(uu1, uu2));
        else
            XSRETURN_UNDEF;

SV*
new_uuid_binary(...)
    PROTOTYPE: ;$
    PREINIT:
        IV version = UUID_TYPE_TIME;
    CODE:
        dUUIDRETBUF;

        if ( items == 1 ) version = SvIV(ST(0));

        new_uuid(version, RETBUF);
    OUTPUT: RETVAL

SV*
new_uuid_string(...)
    PROTOTYPE: ;$
    PREINIT:
        uuid_t uuid;
        IV version = UUID_TYPE_TIME;
    CODE:
        dSTRRETBUF;

        if ( items == 1 ) version = SvIV(ST(0));

        new_uuid(version, uuid);
        uuid_unparse(uuid, RETBUF);
    OUTPUT: RETVAL

SV*
uuid_to_string(sv)
    SV *sv
    PROTOTYPE: $
    PREINIT:
        uuid_t uuid;
    CODE:
        if ( sv_to_uuid(sv, uuid) ) {
            dSTRRETBUF;
            uuid_unparse(uuid, RETBUF);
        } else
            XSRETURN_UNDEF;
    OUTPUT: RETVAL

SV*
uuid_to_binary(sv)
    SV *sv
    PROTOTYPE: $
    CODE:
        dUUIDRETBUF;
        if ( !sv_to_uuid(sv, RETBUF) )
            XSRETURN_UNDEF;
    OUTPUT: RETVAL

SV*
uuid_to_hex(sv)
    SV *sv