ext/DynaLoader/dlutils.c

   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_error */
  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     call_atexit(&dl_unload_all_files, (void*)0);
  73 }
  74
  75
  76 /* SaveError() takes printf style args and saves the result in LastError */
  77 static void
  78 SaveError(pTHXo_ char* pat, ...)
  79 {
  80     va_list args;
  81     SV *msv;
  82     char *message;
  83     STRLEN len;
  84
  85     /* This code is based on croak/warn, see mess() in util.c */
  86
  87     va_start(args, pat);
  88     msv = vmess(pat, &args);
  89     va_end(args);
  90
  91     message = SvPV(msv,len);
  92     len++;              /* include terminating null char */
  93
  94     /* Allocate some memory for the error message */
  95     if (LastError)
  96         LastError = (char*)saferealloc(LastError, len) ;
  97     else
  98         LastError = (char *) safemalloc(len) ;
  99
 100     /* Copy message into LastError (including terminating null char)    */
 101     strncpy(LastError, message, len) ;
 102     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError));
 103 }
 104