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 12 /* pointer to allocated memory for last error message */ 13 static char *LastError = (char*)NULL; 14 15 /* flag for immediate rather than lazy linking (spots unresolved symbol) */ 16 static int dl_nonlazy = 0; 17 18 #ifdef DL_LOADONCEONLY 19 static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */ 20 #endif 21 22 23 #ifdef DEBUGGING 24 static int dl_debug = 0; /* value copied from $DynaLoader::dl_debug */ 25 #define DLDEBUG(level,code) if (dl_debug>=level) { code; } 26 #else 27 #define DLDEBUG(level,code) 28 #endif 29 30 31 /* Close all dlopen'd files */ 32 static void 33 dl_unload_all_files(pTHXo_ void *unused) 34 { 35 CV *sub; 36 AV *dl_librefs; 37 SV *dl_libref; 38 39 if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) { 40 dl_librefs = get_av("DynaLoader::dl_librefs", FALSE); 41 while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) { 42 dSP; 43 ENTER; 44 SAVETMPS; 45 PUSHMARK(SP); 46 XPUSHs(sv_2mortal(dl_libref)); 47 PUTBACK; 48 call_sv((SV*)sub, G_DISCARD | G_NODEBUG); 49 FREETMPS; 50 LEAVE; 51 } 52 } 53 } 54 55 56 static void 57 dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */ 58 { 59 char *perl_dl_nonlazy; 60 #ifdef DEBUGGING 61 SV *sv = get_sv("DynaLoader::dl_debug", 0); 62 dl_debug = sv ? SvIV(sv) : 0; 63 #endif 64 if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL ) 65 dl_nonlazy = atoi(perl_dl_nonlazy); 66 if (dl_nonlazy) 67 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n")); 68 #ifdef DL_LOADONCEONLY 69 if (!dl_loaded_files) 70 dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ 71 #endif 72 #ifdef DL_UNLOAD_ALL_AT_EXIT 73 call_atexit(&dl_unload_all_files, (void*)0); 74 #endif 75 } 76 77 78 /* SaveError() takes printf style args and saves the result in LastError */ 79 static void 80 SaveError(pTHXo_ char* pat, ...) 81 { 82 va_list args; 83 SV *msv; 84 char *message; 85 STRLEN len; 86 87 /* This code is based on croak/warn, see mess() in util.c */ 88 89 va_start(args, pat); 90 msv = vmess(pat, &args); 91 va_end(args); 92 93 message = SvPV(msv,len); 94 len++; /* include terminating null char */ 95 96 /* Allocate some memory for the error message */ 97 if (LastError) 98 LastError = (char*)saferealloc(LastError, len) ; 99 else 100 LastError = (char *) safemalloc(len) ; 101 102 /* Copy message into LastError (including terminating null char) */ 103 strncpy(LastError, message, len) ; 104 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError)); 105 } 106 107