xs_win32perl.h

#ifndef _XS_Win32Perl_h_

#pragma message( "Processing XS_Win32Perl.h" )
#ifdef _DEBUG
	#pragma message( "    ...in _DEBUG mode" )
#endif

	// preWin32Perl.h will load the Perl releated headers
	#include "preWin32Perl.h"


//	#include XS_Win32Perlv2.h

    ///////////////////////////////////////////////////////////////////////////////
    //  Declare our standard extension macros for easy Perl extension coding... 
    //
    //  To use these macros it is best to declare the EXTENSION_VARS macro
    //  somewhere in the beginning of the Perl function.
    //  For example:
    //  XS( XS_DecodeBuffer )
    //  {
	//      dXSARGS;            //  Standard Perl extension delcaration
    //      EXTENSION_VARS;     //  Win32Perl.h declaration
	//      
	//      ...process code where you may be pushing values onto the retyurn stack...
    //      PUSH_IV( 32 );
    //      PUSH_PV( "Hello" );
    //         
    //      EXTENSION_RETURN;   //  Win32Perl.h return declaration
    //  }

/*	////////////////// BEGIN DEPRECATED CODE /////////////////////
	
	// Number of elements we can push onto the return stack
	// before having to extend the stack.
    #define DEFAULT_PERL_STACK_SIZE		5		

    //  Set up the default extension variables what we need...
    #define	EXTENSION_VARS		int    iNumOfReturnStackElements = 0;			\
							    int    iStackCount = DEFAULT_PERL_STACK_SIZE;	

	//	Routine to use every time we push a value onto the return stack.  This will monitor
	//	the stack's size and extend it every time it needs to be extended.
    #define CHECK_PERL_STACK_SIZE	if( 0 <= iStackCount )					    \
								    {											\
									    iStackCount = DEFAULT_PERL_STACK_SIZE;	\
									    EXTEND( sp, iStackCount );				\
								    }
*/	////////////////// END DEPRECATED CODE /////////////////////


    /////////////////////////////////////////////////////////////
    //  Return Stack Macros
    //
    //  Pop an SV off of the stack and update the return stack. This is called when we have
    //  accidently pushed a value onto the return stack...
    //  
    //  The following macros are defined to push elements onto the return stack:
    //      POP_SV............Pop the top SV off the stack. The SV is lost (not returned)
    //
    //  These macros all push their respective values onto the stack. Each macro will
    //  create a new SV and tag it as mortal before pushing onto the stack.
    //  
    //      PUSH_IV(x)........Push a 32 bit value onto the return stack.
    //      PUSH_NV(x)........Push a floating point value (a double) onto the stack
    //      PUSH_PV(x)........Push a nul terminated string onto the stack.
    //      PUSH_PNV(x,y).....Push a binary object onto the return stack. X=LPBYTE; Y=Length in bytes.
    //      PUSH_NOREF(x).....Push the specified SV* onto the stack as is.
    //      PUSH_REF(x).......Create a reference to (x), tag it as mortal then push it onto the return stack.
    //      PUSH_AV(x)........Push an array onto the return stack.
    //      PUSH_HV(x)........Push a hash onto the return stack.


    #define POP_SV              POPs
                                
                                
    //  Push an IV value onto the return stack...
    #define PUSH_IV(x)          CHECK_PERL_STACK_SIZE;                                                      \
                                ST( iNumOfReturnStackElements ) = sv_2mortal( newSViv( (IV) (x) ) );        \
                                iNumOfReturnStackElements++

    //  Push an NV (double) value onto the return stack...
    #define PUSH_NV(x)          CHECK_PERL_STACK_SIZE;                                                      \
                                ST( iNumOfReturnStackElements ) = sv_2mortal( newSVnv( (double) (x) ) );         \
                                iNumOfReturnStackElements++
    
    //  Push a string value onto the stack...
    #define PUSH_PV(x)          if( NULL != (x) )                                                               \
                                {                                                                               \
                                    CHECK_PERL_STACK_SIZE;                                                      \
                                    ST( iNumOfReturnStackElements ) = sv_2mortal( newSVpv( (LPTSTR)(x), 0 ) );   \
                                    iNumOfReturnStackElements++;                                                \
                                }

    //  Push a string value onto the stack...
    #define PUSH_PNV(x,y)       if( NULL != (x) )                                                                       \
                                {                                                                                       \
                                    CHECK_PERL_STACK_SIZE;                                                              \
                                    ST( iNumOfReturnStackElements ) = sv_2mortal( newSVpv( (LPTSTR)(x), (int) (y) ) );   \
                                    iNumOfReturnStackElements++;                                                        \
                                }


    //  Push an SV value onto the stack...
    #define PUSH_NOREF(x)       if( NULL != (x) )                                                           \
                                {                                                                           \
                                    CHECK_PERL_STACK_SIZE;                                                  \
                                    ST( iNumOfReturnStackElements ) = (SV*)(x);                             \
                                    iNumOfReturnStackElements++;                                            \
                                }

    //  All PUSH_SV() macros need to reference PUSH_REF() or PUSH_NOREF() instead.
    //  #define PUSH_SV(x)          PUSH_REF(x)

    //  Create and push a new reference onto the stack...
    #define PUSH_REF(x)         if( NULL != (x) )                                                           \
                                {                                                                           \
                                    CHECK_PERL_STACK_SIZE;                                                  \
                                    ST( iNumOfReturnStackElements ) = sv_2mortal( newRV( (SV*)(x) ) );      \
                                    iNumOfReturnStackElements++;                                            \
                                }
    
    //  Push an array onto the stack...
    #define PUSH_AV(x)          PUSH_REF(x)
    
    //  Push a hash onto the stack...
    #define PUSH_HV(x)          PUSH_REF(x)


    // Return a boolean yes or no...
    #define XSRETURN_BOOL(x)    ST( 0 ) = sv_2mortal( newSViv( (FALSE != (x))? 1 : 0 ) );       \
                                XSRETURN( 1 )            
    
    #define EXTENSION_RETURN_BOOL(x)    XSRETURN_BOOL( (x) )

    // Return with the return stack...
    #define EXTENSION_RETURN    XSRETURN( iNumOfReturnStackElements )

    /////////////////////////////////////////////////////////////
    //  HASH Macros

    //  The hash retrieval macros. These all have a prototype of: HASH_GET_xx( pHash, szKeyName )
    #define HASH_GET_SV(x,y)    HashGetSV( aTHX_ (x), (y) )
    #define HASH_GET_PV(x,y)    HashGetPV( aTHX_ (x), (y) )
    #define HASH_GET_IV(x,y)    HashGetIV( aTHX_ (x), (y) )
    #define HASH_GET_NV(x,y)    HashGetNV( aTHX_ (x), (y) )
    #define HASH_GET_AV(x,y)    EXTRACT_AV( aTHX_ ( (SV*) HashGetSV( aTHX_ (x), (y) ) ) )
    #define HASH_GET_HV(x,y)    EXTRACT_HV( aTHX_ ( (SV*) HashGetSV( aTHX_ (x), (y) ) ) )
	
    //	Extract a hash reference from an SV: SV *pSv = ST( 0 );
    //                                       HV *pHv = EXTRACT_HV( pSv );
	#define EXTRACT_HV( x )     _EXTRACT_HV( aTHX_ (SV*) (x) )


    inline HV* _EXTRACT_HV( pTHX_ SV *pSv )
	{
        HV *pHv = NULL;
        if( NULL == pSv )
        {
            return( NULL );
        }

        if( SvROK( pSv ) )
	    {
            pSv = SvRV( pSv );
        }
	    if( SVt_PVHV == SvTYPE( pSv ) )
	    {
	        pHv = (HV*) pSv;
	    }
        return( pHv );
    }

    //  Delete a key from a hash: HASH_DELETE( pHash, szKeyName )
#define HASH_DELETE(x,y)            if( hv_exists( (HV*) (x), (LPTSTR)(y), (I32)_tcslen( (LPTSTR)(y) ) ) ) \
                                        {                                                                               \
                                                hv_delete( (HV*) (x), (LPTSTR)(y), (I32)_tcslen( (LPTSTR)(y) ), G_DISCARD ); \
	                                    }

    // Store a hash (HV*) or array (AV*) into a hash. This will create a reference then store that
    // into the hash. 
    // --------------
    // The storing of an AV* or HV* is special. We need to create a reference WITHOUT increasing the
    // references reference count. Silly but this is what happens:
    //      a) Reference is made creating a ref count of 1 and increasing the AV or HV's ref count
    //      b) Reference is added to a hash increasing it's ref count to 2
    //  When the array is undefed the reference ref count is decremented, of course.
    //  so it now becomes 1.  Since it is not zero it is not purged however nothing points to it so
    //  it has become an orphan hence a memory leak.
    #define HASH_STORE_AV(x,y,z)        HASH_STORE_HV(x,y,z)
    #define HASH_STORE_HV(x,y,z)        if( ( NULL != (x) ) && ( NULL != (y) ) && ( NULL != (z) ) )                         \
                                        {                                                                                   \
                                            SV* P_SV_TEMP = newRV_noinc( (SV*) (z) );                                       \
                                            if( NULL != P_SV_TEMP )                                                         \
                                            {                                                                               \
                                                hv_store( (HV*) (x), (LPTSTR) (y), (I32)_tcslen( (LPTSTR) (y) ), P_SV_TEMP, 0 ); \
                                            }                                                                               \
                                        }


    //  Store an SV into a hash: HASH_STORE_SV( pHash, szKeyName, pSv );
    //  This will auto create a reference to the SV and store that reference in the hash.
    #define HASH_STORE_SV(x,y,z)        if( ( NULL != (x) ) && ( NULL != (y) ) && ( NULL != (z) ) )                         \
                                        {                                                                                   \
                                            SV* P_SV_TEMP = newRV( (SV*) (z) );                                             \
                                            if( NULL != P_SV_TEMP )                                                         \
                                            {                                                                               \
                                                hv_store( (HV*) (x), (LPTSTR) (y), (I32)_tcslen( (LPTSTR) (y) ), P_SV_TEMP, 0 ); \
                                            }                                                                               \
                                        }

    //  Store an SV into a hash without any references: HASH_STORE_SVNOREF( pHash, szKeyName, pSv );
    //  Typically you don't do this unless you already have a reference you need to store in the hash.
    //  You would normally call HASH_STORE_SV() which auto creates the reference for you.
    #define HASH_STORE_SVNOREF(x,y,z)   if( ( NULL != (x) ) && ( NULL != (y) ) && ( NULL != (z) ) )                         \
                                        {                                                                                   \
                                            hv_store( (HV*) (x), (LPTSTR) (y), (I32)_tcslen( (LPTSTR) (y) ), (SV*)(z), 0 ); \
                                        }

    //  Store a data array into a hash (storing a string but specify the number of elements hence it can
    //  contain nul chars: HASH_STORE_PNV( pHv, szKeyName, pData, dwDataBufferSize )
    #define HASH_STORE_PNV(x,y,z,size)  if( ( NULL != (x) ) && ( NULL != (y) ) && ( NULL != (z) ) )                         \
                                        {                                                                                   \
                                            SV* P_SV_TEMP = newSVpv( (LPTSTR)(z), (int)(size) );                             \
                                            if( NULL != P_SV_TEMP )                                                         \
                                            {                                                                               \
                                                hv_store( (HV*) (x), (LPTSTR) (y), (I32)_tcslen( (LPTSTR) (y) ), P_SV_TEMP, 0 ); \
                                            }                                                                               \
                                        } 
    //  Store a C string into a hash: HASH_STORE_PV( pHash, szKeyName, szString )
    #define HASH_STORE_PV(x,y,z)        HASH_STORE_PNV(x,y,z, (I32)_tcslen( (LPTSTR)(z) ) )

    //  Store a floating point number into a hash: HASH_STORE_NV( pHash, szKeyName, dFloatingPoint )
    #define HASH_STORE_NV(x,y)          if( ( NULL != (x) ) && ( NULL != (y) ) )                                            \
                                        {                                                                                   \
                                            SV* P_SV_TEMP = newSVnv( (NV)(z) );                                             \
                                            if( NULL != P_SV_TEMP )                                                         \
                                            {                                                                               \
                                                hv_store( (HV*) (x), (LPTSTR) (y), (I32)_tcslen( (LPTSTR) (y) ), P_SV_TEMP, 0 ); \
                                            }                                                                               \
                                        } 

    //  Store a 32 bit integer into a hash: HASH_STORE_IV( pHash, szKeyName, dwNumber )
    #define HASH_STORE_IV(x,y,z)        if( ( NULL != (x) ) && ( NULL != (y) ) )                                            \
                                        {                                                                                   \
                                            SV* P_SV_TEMP = newSViv( (IV)(z) );                                             \
                                            if( NULL != P_SV_TEMP )                                                         \
                                            {                                                                               \
                                                hv_store( (HV*) (x), (LPTSTR) (y), (I32)_tcslen( (LPTSTR) (y) ), P_SV_TEMP, 0 ); \
                                            }                                                                               \
                                        } 
    
    // Check that a hash key exists: HASH_KEY_EXISTS( pHash, szKeyName )
#define HASH_KEY_EXISTS(x,y)        ( 0 != hv_exists( (HV*)(x), (LPTSTR)(y), (I32)_tcslen( (LPTSTR)(y) ) ) )

    //  Define the inline hash extraction prototypes...
    const char *HashGetPV( pTHX_ HV *pHv, const char *pszKeyName );
    IV HashGetIV( pTHX_ HV *pHv, const char *pszKeyName );
    double HashGetNV( pTHX_ HV *pHv, const char *pszKeyName );
    SV *HashGetSV( pTHX_ HV *pHv, const char *pszKeyName );

    //  Now define the inline functions used by the hash macros
    inline const char *HashGetPV( pTHX_ HV *pHv, const char *pszKeyName )
    {
        SV *pSv = HashGetSV( aTHX_ pHv, pszKeyName );
        if( NULL != pSv )
        {
            return( SvPV_nolen( pSv ) );
        }
        else
        {
            return( "" );
        }
    }

    inline IV HashGetIV( pTHX_ HV *pHv, const char *pszKeyName )
    {
        SV *pSv = HashGetSV( aTHX_ pHv, pszKeyName );
        if( NULL != pSv )
        {
            return( SvIV( pSv) );
        }
        else
        {
            return( 0 );
        }
    }

    inline double HashGetNV( pTHX_ HV *pHv, const char *pszKeyName )
    {
        SV *pSv = HashGetSV( aTHX_ pHv, pszKeyName );
        if( NULL != pSv )
        {
            return( SvNV( pSv) );
        }
        else
        {
            return( 0.0 );
        }
    }

    inline SV * HashGetSV( pTHX_ HV *pHv, const char *pszKeyName )
    {
        SV *pSv = NULL;
        if( ( NULL == pszKeyName ) || ( NULL == pHv ) )
            return( NULL );

        if( hv_exists( pHv, pszKeyName, (I32)_tcslen( pszKeyName ) ) )
        {
            pSv = (SV*) hv_fetch( pHv, pszKeyName, (I32)_tcslen( pszKeyName ), 0 );
            if( NULL != pSv )
            {
                pSv = *(SV**) pSv;
            }
        }
        return( pSv );
    }
   

    /////////////////////////////////////////////////////////////
    //  ARRAY Macros
    //
    //  Push a given type into an array. The all follow the format:
    //      ARRAY_PUSH_xx( pAv, value )
    //  eg: ARRAY_PUSH_NV( pAv, 3.14 );

    #define ARRAY_PUSH_PV(x,y)          av_push( (AV*) (x), newSVpv( (LPTSTR) (y), 0 ) )
    #define ARRAY_PUSH_PNV(x,y,z)       av_push( (AV*) (x), newSVpv( (LPTSTR) (y), (int) (z) ) )
    #define ARRAY_PUSH_IV(x,y)          av_push( (AV*) (x), newSViv( (IV) (y) ) )
    #define ARRAY_PUSH_NV(x,y)          av_push( (AV*) (x), newSVnv( (NV) (y) ) )
    #define ARRAY_PUSH_SV(x,y)          av_push( (AV*) (x), newSVsv( (SV*)(y) ) )
    #define ARRAY_PUSH_RV(x,y)          av_push( (AV*) (x), newRV( (SV*)(y) ) )
    #define ARRAY_PUSH(x,y)             av_push( (AV*) (x), (SV*) (y) )
    // The pushing of AV* and HV* is special. We need to create a reference WITHOUT increasing the
    // references reference count. Silly but this is what happens:
    //      a) Reference is made creating a ref count of 1 and increasing the AV or HV's ref count
    //      b) Reference is added to an array increasing it's ref count to 2
    //  When the array is undefed the reference ref count is decremented, of course.
    //  so it now becomes 1.  Since it is not zero it is not purged however nothing points to it so
    //  it has become an orphan hence a memory leak.
    #define ARRAY_PUSH_AV(x,y)          av_push( (AV*) (x), newRV_noinc( (SV*)(y) ) )
    #define ARRAY_PUSH_HV(x,y)          ARRAY_PUSH_AV(x,y)


    //  Get a particular value from a specified index in an array.  Format is:
    //      ARRAY_GET_xx( pAv, dwIndex )
    //  eg: (char*) pszString = ARRAY_GET_PV( pAv, 18 );
    //  One exception is the ARRAY_GET_PVN( pAv, dwIndex, dwLength )
    //  This will return a string of dwLength bytes long ignoring any embedded nul chars.
    #define ARRAY_GET(x,y)          (SV*) ARRAY_FETCH( aTHX_ (AV*)(x), (I32)(y) )
    #define ARRAY_GET_SV(x,y)       (SV*) ARRAY_FETCH( aTHX_ (AV*)(x), (I32)(y) )
    #define ARRAY_GET_PV(x,y)       SvPV_nolen( ARRAY_FETCH( aTHX_ (AV*)(x), (I32)(y) ) )
    #define ARRAY_GET_PVN(x,y,z)    SvPV( ARRAY_FETCH( aTHX_ (AV*)(x), (I32)(y) ), (I32)(z) )
    #define ARRAY_GET_IV(x,y)       SvIV( ARRAY_FETCH( aTHX_ (AV*)(x), (I32)(y) ) )
    #define ARRAY_GET_NV(x,y)       SvNV( ARRAY_FETCH( aTHX_ (AV*)(x), (I32)(y) ) )
    #define ARRAY_GET_AV(x,y)       EXTRACT_AV( ARRAY_GET_SV( (x), (y) ) )
    #define ARRAY_GET_HV(x,y)       EXTRACT_HV( ARRAY_GET_SV( (x), (y) ) )

    ////////////////////////////////////////////////////////////////////////////
    //  Extract AV from an SV:  SV *pSv = ST( 0 );
    //                          AV *pAv = EXTRACT_AV( pSv );
    //	#define EXTRACT_AV(x)           _EXTRACT_AV( (SV*) (x) )    
    inline AV *EXTRACT_AV( pTHX_ SV *pSv  )
    {
        AV *pAv = NULL;
        if( NULL == pSv )
        {
            return( NULL );
        }

        if( SvROK( pSv ) )
	    {
            pSv = SvRV( pSv );
        }
	    if( SVt_PVAV == SvTYPE( pSv ) )
	    {
	        pAv = (AV*) pSv;
	    }
        return( pAv );
    }

    ////////////////////////////////////////////////////////////////////////////
    // Extract an SV* from an array 
    //
    inline SV* ARRAY_FETCH( pTHX_ AV *pAv, I32 Index )
    {
        SV *pSv = NULL;
        if( NULL != pAv )
        {
            SV **ppSvTemp = av_fetch( pAv, Index, 0 );
            if( NULL != ppSvTemp )
            {
                pSv = ppSvTemp[ 0 ];
            }
        }
        return( pSv );
    }

#endif  //  _XS_Win32Perl_h_