home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / DynaLoader / dlutils.c < prev    next >
C/C++ Source or Header  |  2000-03-22  |  3KB  |  107 lines
  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.