view release on metacpan or  search on metacpan

AMF.xs  view on Meta::CPAN

        SV * copy;
        copy = newSV(0);
        if (SvOK(value)){
            sv_setsv(copy, value);
        }
        return copy;
    }
}
FREE_INLINE void ref_clear(pTHX_ HV * go_once, SV *sv){

    SV *ref_addr;
    if (! SvROK(sv))
    return;
    ref_addr = SvRV(sv);
    if (hv_exists(go_once, (char *) &ref_addr, sizeof (ref_addr)))
    return;
    (void) hv_store( go_once, (char *) &ref_addr, sizeof(ref_addr), &PL_sv_undef, 0);

    if (SvTYPE(ref_addr) == SVt_PVAV){
        AV * refarray = (AV*) ref_addr;
        int ref_len = av_len(refarray);
        int ref_index;
        for( ref_index = 0; ref_index <= ref_len; ++ref_index){
            SV ** ref_item = av_fetch( refarray, ref_index, 0);
            if (ref_item)
            ref_clear(aTHX_  go_once, *ref_item);
        }
        av_clear(refarray);
    }
    else if (SvTYPE(ref_addr) == SVt_PVHV){
        HV *ref_hash = (HV *) ref_addr;
        char *   key;
        I32  key_len;
        SV*  item;

        hv_iterinit(ref_hash);
        while( (item = hv_iternextsv(ref_hash, &key, &key_len)) ){
            ref_clear(aTHX_  go_once, item);
        };
        hv_clear(ref_hash);
    }
}    
/* Start XS defines
 *
 *
 *
 *
 *
 */

/* Temporary Intenale Storage */
#define check_bounds(low,high, mess) \
    if (items < low || items > high )\
        croak( mess );

MODULE = Storable::AMF0 PACKAGE = Storable::AMF0::TemporaryStorage
PROTOTYPES: DISABLE 

void
new(SV *class, SV *option=0)
    PPCODE:
    PERL_UNUSED_VAR( class );
    XPUSHs( sv_2mortal( tmpstorage_create_sv( aTHX_ NULL, option )));

void
DESTROY(SV *self)
    PPCODE:
    tmpstorage_destroy_sv( aTHX_ self );

PROTOTYPES: ENABLE

MODULE = Storable::AMF0 PACKAGE = Storable::AMF0		

void 
dclone(SV * data)
    ALIAS:
	Storable::AMF::dclone= 1
	Storable::AMF3::dclone= 2
    PROTOTYPE: $
    INIT:
        SV* retvalue;
    PPCODE:
	PERL_UNUSED_VAR(ix);
        retvalue = deep_clone(aTHX_  data);
        sv_2mortal(retvalue);
        XPUSHs(retvalue);

void 
amf_tmp_storage(...)
    INIT:
        SV * retvalue;
        SV * sv_option;
    PROTOTYPE: ;$
    PPCODE:
        if (items<0 || items > 1)
            croak("sv_option=0");
        if (items<1)
            sv_option = 0;
        else 
            sv_option = ST(0);

        retvalue = tmpstorage_create_sv(aTHX_ NULL, sv_option);
        XPUSHs(retvalue);

void
thaw(SV *data, ... )
    ALIAS:
	Storable::AMF::thaw=1
	Storable::AMF::thaw0=2
    PROTOTYPE: $;$
    INIT:
        SV* retvalue;
        SV* sv_option;
        struct io_struct *io;
    PPCODE:
	PERL_UNUSED_VAR(ix);
        check_bounds(1,2, "sv_option=0");
        if ( items == 1 )
            sv_option = 0;
        else 
            sv_option = ST(1);
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if ( ! Sigsetjmp(io->target_error, 0) ){
            io->subname = "Storable::AMF0::thaw( data, option )";
            io_in_init(aTHX_  io, data, AMF0_VERSION, sv_option);
            retvalue = (SV*) (io->parse_one_object(aTHX_  io));
            retvalue = sv_2mortal(retvalue);
            io_test_eof( aTHX_ io );
            /* clean up storable unless need */
            if (io->reuse)
                io_in_cleanup(aTHX_ io);
            sv_setsv(ERRSV, &PL_sv_undef);
            XPUSHs(retvalue);
        }
        else {
            io_format_error( aTHX_ io );
        }

void
deparse_amf(SV *data, ... )
    PROTOTYPE: $;$
    ALIAS:
	Storable::AMF::deparse_amf=1
	Storable::AMF::deparse_amf0=2
    INIT:
        SV* retvalue;
        SV* sv_option;
	struct io_struct *io;
    PPCODE:
        check_bounds(1,2, "sv_option=0");
        if ( items == 1 )
            sv_option = 0;
        else 
            sv_option = ST(1);
	PERL_UNUSED_VAR(ix);
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if ( ! Sigsetjmp(io->target_error, 0)){
            io->subname = "Storable::AMF0::deparse( data, option )";
            io_in_init(aTHX_  io, data, AMF0_VERSION, sv_option);
            
            retvalue = (SV*) (io->parse_one_object(aTHX_  io));
            sv_2mortal(retvalue);
            /* clean up storable unless need */
            if ( io->reuse )
                io_in_cleanup(aTHX_ io);
            sv_setsv(ERRSV, &PL_sv_undef);
            if (GIMME_V == G_ARRAY){
                XPUSHs(retvalue);
                XPUSHs( sv_2mortal(newSViv( io->pos - io->ptr )) );
            }
            else {
                XPUSHs(retvalue);
            }
        }
        else {
            io_format_error( aTHX_ io );
        }


void freeze(SV *data, ... )
    ALIAS:
	Storable::AMF::freeze=1
	Storable::AMF::freeze0=2
    PROTOTYPE: $;$
    INIT:
        SV * retvalue;
        SV * sv_option;
        struct io_struct *io;
    PPCODE:
        check_bounds(1,2, "sv_option=0");
        if ( items == 1 )
            sv_option = 0;
        else 
            sv_option = ST(1);
	PERL_UNUSED_VAR(ix);
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if (! Sigsetjmp(io->target_error, 0)){
            io_out_init(aTHX_  io, sv_option, AMF0_VERSION);
            amf0_format_one(aTHX_  io, data);
            if (io->reuse )
                io_out_cleanup(aTHX_ io);
            retvalue = io_buffer(io);
            XPUSHs(retvalue);
            sv_setsv(ERRSV, &PL_sv_undef);
        }
        else{
	    io_format_error( aTHX_ io );
        }


MODULE = Storable::AMF0		PACKAGE = Storable::AMF3		

void
deparse_amf(SV *data, ... )
    ALIAS: 
        Storable::AMF::deparse_amf3 = 1
    PROTOTYPE: $;$
    INIT:
        SV* retvalue;
        SV* sv_option = 0;
        struct io_struct *io;
    PPCODE:
        check_bounds(1,2, "sv_option=0");
        if ( items == 1 )
            sv_option = 0;
        else 
            sv_option = ST(1);
	PERL_UNUSED_VAR(ix);
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if ( ! Sigsetjmp(io->target_error, 0)){
            io->subname = "Storable::AMF3::deparse_amf( data, option )";
            io_in_init(aTHX_  io, data, AMF3_VERSION, sv_option);
            retvalue = (SV*) (amf3_parse_one(aTHX_  io));
            sv_2mortal(retvalue);
            /* clean up storable unless need */
            if ( io->reuse )
                io_in_cleanup(aTHX_ io);
            sv_setsv(ERRSV, &PL_sv_undef);

            XPUSHs(retvalue);
            if (GIMME_V == G_ARRAY){
                XPUSHs( sv_2mortal(newSViv( io->pos - io->ptr )) );
            }
        }
        else {
            io_format_error(aTHX_ io );
        }

void
thaw(SV *data, ... )
    PROTOTYPE: $;$
    INIT:
        SV* retvalue;
        SV *sv_option = 0;
        struct io_struct *io;
    ALIAS:
	Storable::AMF::thaw3=1
    PPCODE:
        check_bounds(1,2, "sv_option=0");
        if ( items == 1 )
            sv_option = 0;
        else 
            sv_option = ST(1);
	PERL_UNUSED_VAR(ix);
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if ( ! Sigsetjmp(io->target_error, 0)){
            io->subname = "Storable::AMF3::thaw( data, option )";
            io_in_init(aTHX_  io, data, AMF3_VERSION, sv_option);
            retvalue = (SV*) (amf3_parse_one(aTHX_  io));
            sv_2mortal(retvalue);
            io_test_eof( aTHX_ io );
            /* clean up storable unless need */
            if ( io->reuse )
                io_in_cleanup(aTHX_ io);
            sv_setsv(ERRSV, &PL_sv_undef);
            XPUSHs(retvalue);
        }
        else {
            io_format_error(aTHX_ io);
        }

void
_test_thaw_integer(SV*data)
    PROTOTYPE: $
    INIT:
        SV* retvalue;
        struct io_struct *io;
    PPCODE:
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if ( ! Sigsetjmp(io->target_error, 0)){
            io->subname = "Storable::AMF3::_test_thaw_integer( data, option )";
            io_in_init(aTHX_  io, data, AMF3_VERSION, 0 );
            retvalue = (SV*) (amf3_parse_integer(aTHX_  io));
            sv_2mortal(retvalue);
            io_test_eof( aTHX_ io );

            sv_setsv(ERRSV, &PL_sv_undef);
            XPUSHs(retvalue);
        }
        else {
            io_format_error(aTHX_ io );
        }

void
_test_freeze_integer(SV*data)
    PROTOTYPE: $
    PREINIT:
        SV * retvalue;
        struct io_struct *io;
    PPCODE:
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if (! Sigsetjmp(io->target_error, 0)){
            io_out_init(aTHX_  io, 0, AMF3_VERSION);
            amf3_write_integer(aTHX_  io, SvIV(data));
            retvalue = io_buffer(io);
            XPUSHs(retvalue);
            sv_setsv(ERRSV, &PL_sv_undef);
        }
        else {
	    io_format_error( aTHX_ io );
        }


void 
endian()
    PROTOTYPE:
    PREINIT:
        SV * retvalue;
    PPCODE:
    retvalue = newSVpvf("%s %x\n",GAX, BYTEORDER);
    sv_2mortal(retvalue);
    XPUSHs(retvalue);

void freeze(SV *data, SV *sv_option = 0 )
    PROTOTYPE: $;$
    PREINIT:
        SV * retvalue;
        struct io_struct *io;
    ALIAS:
	Storable::AMF::freeze3=1
    PPCODE:
	PERL_UNUSED_VAR(ix); 
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if (! Sigsetjmp(io->target_error, 0)){
            io_out_init(aTHX_  io, sv_option, AMF3_VERSION);
            amf3_format_one(aTHX_  io, data);
            if (io->reuse )
                io_out_cleanup(aTHX_ io);
            retvalue = io_buffer(io);
            XPUSHs(retvalue);
            sv_setsv(ERRSV, &PL_sv_undef);
        }
        else {
	    io_format_error( aTHX_ io );
        }

void
new_amfdate(NV timestamp )
    PREINIT:
    SV *mortal;
    PROTOTYPE: $
    ALIAS:
	Storable::AMF::new_amfdate =1
	Storable::AMF0::new_amfdate=2
	Storable::AMF::new_date =3
	Storable::AMF0::new_date=4
	Storable::AMF3::new_date=5
    PPCODE:
	PERL_UNUSED_VAR( ix );
	mortal=sv_newmortal();
	sv_setref_nv( mortal, "*", timestamp ); /*Stupid but it works */
	XPUSHs( mortal );

void 
perl_date(SV *date)
    PREINIT:
    SV *mortal;
    PROTOTYPE: $
    ALIAS: 
	Storable::AMF::perl_date=1
	Storable::AMF0::perl_date=2
    PPCODE:
	PERL_UNUSED_VAR( ix );
	if ( SvROK( date ) && util_is_date( (SV*) SvRV(date))){
	    XPUSHs((SV*) SvRV(date));
	}
	else if ( SvNOK( date )){
	    mortal = sv_newmortal();
	    sv_setnv( mortal, SvNV( date ));
	    XPUSHs(mortal);
	}
	else {
	    croak("Expecting perl/amf date as argument" );
	}

void
parse_option(char * s, int options=0)
    PREINIT: 
    int s_strict;
    int s_utf8_decode;
    int s_utf8_encode;
    int s_milldate;
    int s_raise_error;
    int s_prefer_number;
    int s_ext_boolean; /* I8 -> int*/
    int s_targ;
    int sign;  
    char *word;
    char *current;
    bool error;
    PROTOTYPE: $;$
    ALIAS:
    Storable::AMF::parse_option=1
    Storable::AMF0::parse_option=2
    Storable::AMF::parse_serializator_option=3
    Storable::AMF3::parse_serializator_option=4
    Storable::AMF0::parse_serializator_option=5
    PPCODE:
    PERL_UNUSED_VAR( ix );
    s_strict = 0;
    s_utf8_decode = 0;
    s_utf8_encode = 0;
    s_milldate    = 0;
    s_raise_error = 0;
    s_prefer_number = 0;
    s_ext_boolean   = 0;
    options         = 0;
    s_targ          = 1;

    for( current = s;*current && ( !isALPHA( *current ) && *current!='+' && *current!='-' ) ; ++current ); 

    word = current;
    while( *word ){
	++current;
	error = 0;
	sign  = 1;
	if ( *word == '+' ){
	    ++word;
	}
	else if ( *word =='-' ){
	    sign = -1;
	    ++word;
	}
	for( ; *current && ( isALNUM( *current ) || *current == '_' ); ++current );
	switch( current - word ){
        case 4:
            if ( !strncmp( "targ", word, 4)){
                    s_targ = sign;
            }
            else {
                error = 1;
            };
            break;
	case 6:
	    if (!strncmp("strict", word, 6)){
		s_strict = sign;
	    }
	    else {
		error = 1;
	    };
	    break;
	case 11:
	    if (!strncmp( "utf8_decode", word, 11)){
		s_utf8_decode = sign;
	    }
	    else if (!strncmp( "utf8_encode", word, 11)){
		s_utf8_encode = sign;
	    }
	    else if (!strncmp("raise_error", word, 9)){
		s_raise_error=sign;
	    }
	    else {
		error = 1;
	    }
	    break;
	case 13:
	    if (!strncmp( "prefer_number", word, 13)){
		s_prefer_number = sign;
	    }
	    else {
		error = 1;
	    };
	    break;
	case   12:
	    if (!strncmp("json_boolean", word, 12)){
		s_ext_boolean = sign;
	    }
	    else if (!strncmp("boolean_json", word, 12)){
		s_ext_boolean = sign;
	    }
	    else  
		error = 1;
	    break;
	case   16:
	    if (!strncmp("millisecond_date", word, 16)){
		s_milldate = sign;
	    }
	    else 
		error = 1;
	    break;
	default:
	    error = 1;
	};
	if (error)
	    croak("Storable::AMF0::parse_option: unknown option '%.*s'", (int)(current - word), word);

	for(; *current && !isALPHA(*current) && *current!='+' && *current!='-'; ++current);
	word = current;
    };	
    SIGN_BOOL_APPLY( options, s_strict,        OPT_STRICT );
    SIGN_BOOL_APPLY( options, s_milldate,      OPT_MILLSEC_DATE );
    SIGN_BOOL_APPLY( options, s_utf8_decode,   OPT_DECODE_UTF8 );
    SIGN_BOOL_APPLY( options, s_utf8_encode,   OPT_ENCODE_UTF8 );
    SIGN_BOOL_APPLY( options, s_raise_error,   OPT_RAISE_ERROR );
    SIGN_BOOL_APPLY( options, s_prefer_number, OPT_PREFER_NUMBER );
    SIGN_BOOL_APPLY( options, s_ext_boolean,   OPT_JSON_BOOLEAN );
    SIGN_BOOL_APPLY( options, s_targ,          OPT_TARG );
    mXPUSHi(  options ); 

MODULE = Storable::AMF0 PACKAGE = Storable::AMF::Util

void
total_sv()
    PROTOTYPE: 
    PPCODE:
    I32 visited  = 0;
    SV* sva;
    for( sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
        SV * svend = &sva[SvREFCNT(sva)];
        SV * svi;
        /* fprintf( stderr, "=%p %d\n", sva, SvREFCNT( sva ) ); */
        for( svi = sva + 1; svi<svend; ++svi ){
            if ( (unsigned int)SvTYPE(svi) != SVTYPEMASK && SvREFCNT(svi) ){
                /** skip pads, they have a PVAV as their first element inside a PVAV **/
                if (SvTYPE(svi) == SVt_PVAV &&  av_len( (AV*) svi) != -1) {
                    SV** first = AvARRAY((AV*)svi);
                    if (first && *first && SvTYPE(*first) == SVt_PVAV) {
                        continue;
                    }
                    if (first && *first && SvTYPE(*first) == SVt_PVCV) {
                        continue;
                    }
                }
                if (SvTYPE(svi) == SVt_PVCV && CvROOT((CV*)svi) == 0) {
                    continue;
                }
                ++visited;
            }
        }
    }
    mXPUSHi( visited );

MODULE=Storable::AMF0 PACKAGE = Storable::AMF 

void 
thaw0_sv(SV * data, SV * element, ... )
    PROTOTYPE: $$;$
    INIT: 
        SV * retvalue;
        SV *sv_option;
        struct io_struct *io;
    PPCODE:
        check_bounds(2,3, "sv_option=0");
        if ( items == 2 )
            sv_option = 0;
        else 
            sv_option = ST(2);
	/* PERL_UNUSED_VAR(ix); */
        io = tmpstorage_create_and_cache(aTHX_ cv );
        if ( ! Sigsetjmp(io->target_error, 0) ){
            io->subname = "Storable::AMF0::thaw( data, option )";
            io_in_init(aTHX_  io, data, AMF0_VERSION, sv_option);
            retvalue = (SV*) (amf0_parse_one_tmp( aTHX_  io, element ));
            /* clean up storable unless need */
            retvalue = sv_2mortal(retvalue);
            io_test_eof( aTHX_ io );
            if ( io->reuse )
                io_in_cleanup(aTHX_ io);
            sv_setsv(ERRSV, &PL_sv_undef);

            /* XPUSHs(retvalue); */
        }
        else {
            io_format_error( aTHX_ io );
        }

MODULE=Storable::AMF