view release on metacpan or  search on metacpan

Util.xs  view on Meta::CPAN

                if ( AValue ) {
                    found = _has_circular_ref( *AValue, parents, seen );
                    if ( SvOK( found ) )
                        return found;
                }
            }
            break;
        }
    case SVt_PVHV:{            /* Hash */
            dsWARN( "Hash" );
            myHash = ( HV * ) sv;
            hv_iterinit( myHash );
            while (( HEntry = hv_iternext( myHash ) )) {
#if dsDEBUG
                STRLEN len2;
                char *HKey = HePV( HEntry, len2 );
                sprintf( errmsg, "NEXT KEY is %s\n", HKey );
                warn( errmsg );
#endif
                found =
                    _has_circular_ref( HeVAL( HEntry ), parents, seen );
                if ( SvOK( found ) )
                    return found;
            }
            break;
        }
    default: ;
    }
    return &PL_sv_undef;
}

/*

Weaken any circular reference found

*/
SV *
_circular_off( SV * sv, HV * parents, HV * seen, SV * counter ) {

    U32 len;
    I32 i;
    SV **AValue;
    HV *myHash;
    HE *HEntry;
    char addr[PTRLEN];
#if dsDEBUG
    char errmsg[100];
#endif

    if ( SvROK( sv ) ) {        /* Reference */

        sprintf( addr, "%p", SvRV( sv ) );
        len = strlen( addr );

        if ( hv_exists( parents, addr, len ) ) {
            if ( SvWEAKREF( sv ) ) {
                dsWARN( "found a weak reference" );
            }
            else {
                dsWARN( "found a circular reference!!!" );
                sv_rvweaken( sv );
                sv_inc( counter );
            }
        }
        else {

            if ( hv_exists( seen, addr, len ) ) {
                dsWARN( "circular reference on weak ref" );
                return &PL_sv_undef;
            }

            (void) hv_store( parents, addr, len, NULL, 0 );
            (void) hv_store( seen, addr, len, NULL, 0 );
#ifdef SvWEAKREF
            if ( SvWEAKREF( sv ) ) {
                dsWARN( "found a weak reference 2" );
                _circular_off( SvRV( sv ), newHV(  ), seen, counter );
            }
            else {
#endif
                _circular_off( SvRV( sv ), parents, seen, counter );
#ifdef SvWEAKREF
            }
#endif
            (void) hv_delete( seen, addr, ( U32 ) len, 0 );
            (void) hv_delete( parents, addr, ( U32 ) len, 0 );
        }

    }
    else {

        /* Not a reference */
        switch ( SvTYPE( sv ) ) {

        case SVt_PVAV:{        /* Array */
                dsWARN( "Array" );
                for ( i = 0; i <= av_len( ( AV * ) sv ); i++ ) {
#if dsDEBUG
                    sprintf( errmsg, "next elem %i\n", i );
                    warn( errmsg );
#endif
                    AValue = av_fetch( ( AV * ) sv, i, 0 );
                    if ( AValue ) {
                        _circular_off( *AValue, parents, seen, counter );
                        if ( SvTYPE( sv ) != SVt_PVAV ) {
                            /* In some circumstances, weakening a reference screw things up */
                            croak
                                ( "Array that we were weakening suddenly turned into a scalar of type type %d",
                                  SvTYPE( sv ) );
                        }
                    }
                }
                break;
            }
        case SVt_PVHV:{        /* Hash */
                dsWARN( "Hash" );
                myHash = ( HV * ) sv;
                hv_iterinit( myHash );
                while (( HEntry = hv_iternext( myHash ) )) {
#if dsDEBUG
                    STRLEN len2;
                    char *HKey = HePV( HEntry, len2 );
                    sprintf( errmsg, "NEXT KEY is %s\n", HKey );
                    warn( errmsg );
#endif
                    _circular_off( HeVAL( HEntry ), parents, seen,
                                   counter );
                    if ( SvTYPE( sv ) != SVt_PVHV ) {
                        /* In some circumstances, weakening a reference screw things up */
                        croak
                            ( "Hash that we were weakening suddenly turned into a scalar of type type %d",
                              SvTYPE( sv ) );
                    }
                }
                break;
            }
        default: ;
        }
    }
    return counter;
}

#if dsDEBUG
/*

Dump any data structure

*/

SV *
_dump_any( SV * re, HV * seen, int depth ) {

  testvar:

    if ( SvROK( re ) ) {
        if ( has_seen( re, seen ) )
            return re;
        printf( "a reference " );

        if ( sv_isobject( re ) )
            printf( " blessed " );

        printf( "to " );
        re = SvRV( re );
        goto testvar;

    }
    else {

        switch ( SvTYPE( re ) ) {
        case SVt_NULL:
            printf( "an undef value\n" );
            break;
        case SVt_IV:
            printf( "an integer (IV): %d\n", SvIV( re ) );
            break;
        case SVt_NV:
            printf( "a double (NV): %f\n", SvNV( re ) );
            break;
        case SVt_RV:
            printf( "a RV\n" );
            break;
        case SVt_PV:
            printf( "a string (PV): %s\n", SvPV_nolen( re ) );
            printf( "UTF8 %s\n", SvUTF8( re ) ? "on" : "off" );
            break;
        case SVt_PVIV:
            printf( "an integer (PVIV): %d\n", SvIV( re ) );
            break;
        case SVt_PVNV:
            printf( "a string (PVNV): %s\n", SvPV_nolen( re ) );