1			/* dlutils.c - handy functions and definitions for dl_*.xs files
     2			 *
     3			 * Currently this file is simply #included into dl_*.xs/.c files.
     4			 * It should really be split into a dlutils.h and dlutils.c
     5			 *
     6			 * Modified:
     7			 * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
     8			 *                      files when the interpreter exits
     9			 */
    10			
    11			#ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */
    12			#   include "EXTERN.h"
    13			#   include "perl.h"
    14			#   include "XSUB.h"
    15			#endif
    16			
    17			#ifndef XS_VERSION
    18			#  define XS_VERSION "0"
    19			#endif
    20			#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
    21			
    22			typedef struct {
    23			    SV*		x_dl_last_error;	/* pointer to allocated memory for
    24								   last error message */
    25			    int		x_dl_nonlazy;		/* flag for immediate rather than lazy
    26								   linking (spots unresolved symbol) */
    27			#ifdef DL_LOADONCEONLY
    28			    HV *	x_dl_loaded_files;	/* only needed on a few systems */
    29			#endif
    30			#ifdef DL_CXT_EXTRA
    31			    my_cxtx_t	x_dl_cxtx;		/* extra platform-specific data */
    32			#endif
    33			#ifdef DEBUGGING
    34			    int		x_dl_debug;	/* value copied from $DynaLoader::dl_debug */
    35			#endif
    36			} my_cxt_t;
    37			
    38			START_MY_CXT
    39			
    40			#define dl_last_error	(SvPVX(MY_CXT.x_dl_last_error))
    41			#define dl_nonlazy	(MY_CXT.x_dl_nonlazy)
    42			#ifdef DL_LOADONCEONLY
    43			#define dl_loaded_files	(MY_CXT.x_dl_loaded_files)
    44			#endif
    45			#ifdef DL_CXT_EXTRA
    46			#define dl_cxtx		(MY_CXT.x_dl_cxtx)
    47			#endif
    48			#ifdef DEBUGGING
    49			#define dl_debug	(MY_CXT.x_dl_debug)
    50			#endif
    51			
    52			#ifdef DEBUGGING
    53			#define DLDEBUG(level,code) \
    54			    STMT_START {					\
    55				dMY_CXT;					\
    56				if (dl_debug>=level) { code; }			\
    57			    } STMT_END
    58			#else
    59			#define DLDEBUG(level,code)	NOOP
    60			#endif
    61			
    62			#ifdef DL_UNLOAD_ALL_AT_EXIT
    63			/* Close all dlopen'd files */
    64			static void
    65			dl_unload_all_files(pTHX_ void *unused)
    66			{
    67			    CV *sub;
    68			    AV *dl_librefs;
    69			    SV *dl_libref;
    70			
    71			    if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
    72			        dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
    73			        while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
    74			           dSP;
    75			           ENTER;
    76			           SAVETMPS;
    77			           PUSHMARK(SP);
    78			           XPUSHs(sv_2mortal(dl_libref));
    79			           PUTBACK;
    80			           call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
    81			           FREETMPS;
    82			           LEAVE;
    83			        }
    84			    }
    85			}
    86			#endif
    87			
    88			static void
    89			dl_generic_private_init(pTHX)	/* called by dl_*.xs dl_private_init() */
    90	         860    {
    91	         860        char *perl_dl_nonlazy;
    92	         860        MY_CXT_INIT;
    93			
    94	         860        MY_CXT.x_dl_last_error = newSVpvn("", 0);
    95	         860        dl_nonlazy = 0;
    96			#ifdef DL_LOADONCEONLY
    97			    dl_loaded_files = Nullhv;
    98			#endif
    99			#ifdef DEBUGGING
   100			    {
   101	         860    	SV *sv = get_sv("DynaLoader::dl_debug", 0);
   102	         860    	dl_debug = sv ? SvIV(sv) : 0;
   103			    }
   104			#endif
   105	         860        if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
   106	          12    	dl_nonlazy = atoi(perl_dl_nonlazy);
   107	         860        if (dl_nonlazy)
   108	          12    	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
   109			#ifdef DL_LOADONCEONLY
   110			    if (!dl_loaded_files)
   111				dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
   112			#endif
   113			#ifdef DL_UNLOAD_ALL_AT_EXIT
   114			    call_atexit(&dl_unload_all_files, (void*)0);
   115			#endif
   116			}
   117			
   118			
   119			#ifndef SYMBIAN
   120			/* SaveError() takes printf style args and saves the result in dl_last_error */
   121			static void
   122			SaveError(pTHX_ const char* pat, ...)
   123	      ######    {
   124			    dMY_CXT;
   125	      ######        va_list args;
   126	      ######        SV *msv;
   127	      ######        const char *message;
   128	      ######        STRLEN len;
   129			
   130			    /* This code is based on croak/warn, see mess() in util.c */
   131			
   132	      ######        va_start(args, pat);
   133	      ######        msv = vmess(pat, &args);
   134	      ######        va_end(args);
   135			
   136	      ######        message = SvPV(msv,len);
   137	      ######        len++;		/* include terminating null char */
   138			
   139			    /* Copy message into dl_last_error (including terminating null char) */
   140	      ######        sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
   141	      ######        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
   142			}
   143			#endif
   144