view release on metacpan or  search on metacpan

cbor_free_encode.c  view on Meta::CPAN

                _init_length_buffer( aTHX_ r - 1, CBOR_TYPE_UINT, encode_state );
                return false;
            }
        }

        Renew( encode_state->reftracker, 1 + r, void * );
        encode_state->reftracker[r - 1] = varref;
        encode_state->reftracker[r] = NULL;

        _init_length_buffer( aTHX_ CBOR_TAG_SHAREABLE, CBOR_TYPE_TAG, encode_state );
    }

    return true;
}

static inline I32 _magic_safe_hv_iterinit( pTHX_ HV* hash ) {
    I32 count;

    if (SvMAGICAL(hash)) {
        count = 0;

        while (hv_iternext(hash)) count++;

        hv_iterinit(hash);
    }
    else {
        count = hv_iterinit(hash);
    }

    return count;
}

static inline void _encode_string_sv( pTHX_ encode_ctx* encode_state, SV* value ) {
    char *val = SvPOK(value) ? SvPVX(value) : SvPV_nolen(value);

    STRLEN len = SvCUR(value);

    bool encode_as_text = !!SvUTF8(value);

    /*
    if (!encode_as_text) {
        STRLEN i;
        for (i=0; i<len; i++) {
            if (val[i] & 0x80) break;
        }

        // Encode as text if there were no high-bit octets.
        encode_as_text = (i == len);
    }
    */

    _init_length_buffer( aTHX_
        len,
        (encode_as_text ? CBOR_TYPE_UTF8 : CBOR_TYPE_BINARY),
        encode_state
    );

    _COPY_INTO_ENCODE( encode_state, (unsigned char *) val, len );
}

static inline void _encode_string_unicode( pTHX_ encode_ctx* encode_state, SV* value ) {
    SV *to_encode;

    if (SvUTF8(value)) {
        to_encode = value;
    }
    else {
        to_encode = newSVsv(value);
        sv_2mortal(to_encode);

        sv_utf8_upgrade(to_encode);
    }

    _encode_string_sv( aTHX_ encode_state, to_encode );
}

static inline void _encode_string_utf8( pTHX_ encode_ctx* encode_state, SV* value ) {
    SV *to_encode = newSVsv(value);
    sv_2mortal(to_encode);

    UTF8_DOWNGRADE_IF_NEEDED(encode_state, to_encode);

    SvUTF8_on(to_encode);

    _encode_string_sv( aTHX_ encode_state, to_encode );
}

static inline void _encode_string_octets( pTHX_ encode_ctx* encode_state, SV* value ) {
    SV *to_encode = newSVsv(value);
    sv_2mortal(to_encode);

    UTF8_DOWNGRADE_IF_NEEDED(encode_state, to_encode);

    _encode_string_sv( aTHX_ encode_state, to_encode );
}

static inline void _upgrade_and_store_hash_key( pTHX_ HE* h_entry, encode_ctx *encode_state ) {
    SV* key_sv;
    CBF_HeSVKEY_force(h_entry, key_sv);
    sv_utf8_upgrade(key_sv);
    _encode_string_sv( aTHX_ encode_state, key_sv );
}

static inline void _downgrade_and_store_hash_key( pTHX_ HE* h_entry, encode_ctx *encode_state, enum CBOR_TYPE string_type ) {
    SV* key_sv;
    CBF_HeSVKEY_force(h_entry, key_sv);
    UTF8_DOWNGRADE_OR_CROAK(encode_state, key_sv);

    // We can do this without altering h_entry itself because
    // key_sv is just a mortal copy of the key.
    if (string_type == CBOR_TYPE_UTF8) SvUTF8_on(key_sv);

    _encode_string_sv( aTHX_ encode_state, key_sv );
}

void _encode( pTHX_ SV *value, encode_ctx *encode_state ) {
    ++encode_state->recurse_count;

    if (encode_state->recurse_count > MAX_ENCODE_RECURSE) {

        // call_pv() killed the process in Win32; this seems to fix that.

cbor_free_encode.c  view on Meta::CPAN

            IV val = SvIVX(value);

            // In testing, Perl’s (0 + ~0) evaluated as < 0 here,
            // but the SvUOK() check fixes that.
            if (val < 0 && !SvUOK(value)) {
                _init_length_buffer( aTHX_ -(++val), CBOR_TYPE_NEGINT, encode_state );
            }
            else {
                // NB: SvUOK doesn’t work to identify nonnegatives … ?
                _init_length_buffer( aTHX_ val, CBOR_TYPE_UINT, encode_state );
            }
        }
        else if (SvNOK(value)) {
            NV val_nv = SvNVX(value);

            if (Perl_isnan(val_nv)) {
                _COPY_INTO_ENCODE(encode_state, CBOR_NAN_SHORT, 3);
            }
            else if (Perl_isinf(val_nv)) {
                if (val_nv > 0) {
                    _COPY_INTO_ENCODE(encode_state, CBOR_INF_SHORT, 3);
                }
                else {
                    _COPY_INTO_ENCODE(encode_state, CBOR_NEGINF_SHORT, 3);
                }
            }
            else {

                // Typecast to a double to accommodate long-double perls.
                double val = (double) val_nv;

                char *valptr = (char *) &val;

#if IS_LITTLE_ENDIAN
                encode_state->scratch[0] = CBOR_DOUBLE;
                encode_state->scratch[1] = valptr[7];
                encode_state->scratch[2] = valptr[6];
                encode_state->scratch[3] = valptr[5];
                encode_state->scratch[4] = valptr[4];
                encode_state->scratch[5] = valptr[3];
                encode_state->scratch[6] = valptr[2];
                encode_state->scratch[7] = valptr[1];
                encode_state->scratch[8] = valptr[0];

                _COPY_INTO_ENCODE(encode_state, encode_state->scratch, 9);
#else
                unsigned char bytes[9] = { CBOR_DOUBLE, valptr[0], valptr[1], valptr[2], valptr[3], valptr[4], valptr[5], valptr[6], valptr[7] };
                _COPY_INTO_ENCODE(encode_state, bytes, 9);
#endif
            }
        }
        else if (!SvOK(value)) {
            _COPY_INTO_ENCODE(encode_state, &CBOR_NULL_U8, 1);
        }
        else {
            switch (encode_state->string_encode_mode) {
                case CBF_STRING_ENCODE_SV:
                    _encode_string_sv( aTHX_ encode_state, value );
                    break;
                case CBF_STRING_ENCODE_UNICODE:
                    _encode_string_unicode( aTHX_ encode_state, value );
                    break;
                case CBF_STRING_ENCODE_UTF8:
                    _encode_string_utf8( aTHX_ encode_state, value );
                    break;
                case CBF_STRING_ENCODE_OCTETS:
                    _encode_string_octets( aTHX_ encode_state, value );
                    break;

                default:
                    assert(0);
            }
        }
    }
    else if (sv_isobject(value)) {
        HV *stash = SvSTASH( SvRV(value) );

        if (_get_tagged_stash() == stash) {
            AV *array = (AV *)SvRV(value);
            SV **tag = av_fetch(array, 0, 0);
            IV tagnum = SvIV(*tag);

            _encode_tag( aTHX_ tagnum, *(av_fetch(array, 1, 0)), encode_state );
        }
        else if (cbf_get_boolean_stash() == stash) {
            _COPY_INTO_ENCODE(
                encode_state,
                SvTRUE(SvRV(value)) ? &CBOR_TRUE_U8 : &CBOR_FALSE_U8,
                1
            );
        }

        // TODO: Support TO_JSON() or TO_CBOR() method?

        else _croak_unrecognized(aTHX_ encode_state, value);
    }
    else if (SVt_PVAV == SvTYPE(SvRV(value))) {
        AV *array = (AV *)SvRV(value);

        if (!encode_state->reftracker || _check_reference( aTHX_ (SV *)array, encode_state )) {
            SSize_t len;
            len = 1 + av_len(array);

            _init_length_buffer( aTHX_ len, CBOR_TYPE_ARRAY, encode_state );

            SSize_t i;

            SV **cur;
            for (i=0; i<len; i++) {
                cur = av_fetch(array, i, 0);
                _encode( aTHX_ *cur, encode_state );
            }
        }
    }
    else if (SVt_PVHV == SvTYPE(SvRV(value))) {
        HV *hash = (HV *)SvRV(value);

        if (!encode_state->reftracker || _check_reference( aTHX_ (SV *)hash, encode_state)) {
            char *key;
            STRLEN key_length;