X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDynaLoader%2Fdlutils.c;h=bb06fe4b20d02599eb51bbd31ea73051e487cd1a;hb=a8c08ecdc5ffec9869657a967edfe7b74a713a27;hp=b1e0bd6fbf75e1cc79ba62c58fab6f19b2150251;hpb=cea2e8a9dd23747fd2b66edc86c58c64e9970321;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index b1e0bd6..bb06fe4 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -3,6 +3,9 @@
  * Currently this file is simply #included into dl_*.xs/.c files.
  * It should really be split into a dlutils.h and dlutils.c
  *
+ * Modified:
+ * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
+ *                      files when the interpreter exits
  */
 
 
@@ -18,34 +21,63 @@ static HV *dl_loaded_files = Nullhv;	/* only needed on a few systems */
 
 
 #ifdef DEBUGGING
-static int dl_debug = 0;	/* value copied from $DynaLoader::dl_error */
+static int dl_debug = 0;	/* value copied from $DynaLoader::dl_debug */
 #define DLDEBUG(level,code)	if (dl_debug>=level) { code; }
 #else
 #define DLDEBUG(level,code)
 #endif
 
+#ifdef DL_UNLOAD_ALL_AT_EXIT
+/* Close all dlopen'd files */
+static void
+dl_unload_all_files(pTHXo_ void *unused)
+{
+    CV *sub;
+    AV *dl_librefs;
+    SV *dl_libref;
+
+    if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
+        dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
+        while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
+           dSP;
+           ENTER;
+           SAVETMPS;
+           PUSHMARK(SP);
+           XPUSHs(sv_2mortal(dl_libref));
+           PUTBACK;
+           call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
+           FREETMPS;
+           LEAVE;
+        }
+    }
+}
+#endif
 
 static void
-dl_generic_private_init(pTHX)	/* called by dl_*.xs dl_private_init() */
+dl_generic_private_init(pTHXo)	/* called by dl_*.xs dl_private_init() */
 {
     char *perl_dl_nonlazy;
 #ifdef DEBUGGING
-    dl_debug = SvIV(get_sv("DynaLoader::dl_debug", 0x04) );
+    SV *sv = get_sv("DynaLoader::dl_debug", 0);
+    dl_debug = sv ? SvIV(sv) : 0;
 #endif
     if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
 	dl_nonlazy = atoi(perl_dl_nonlazy);
     if (dl_nonlazy)
-	DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "DynaLoader bind mode is 'non-lazy'\n"));
+	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
 #ifdef DL_LOADONCEONLY
     if (!dl_loaded_files)
 	dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
 #endif
+#ifdef DL_UNLOAD_ALL_AT_EXIT
+    call_atexit(&dl_unload_all_files, (void*)0);
+#endif
 }
 
 
 /* SaveError() takes printf style args and saves the result in LastError */
 static void
-SaveError(pTHX_ char* pat, ...)
+SaveError(pTHXo_ char* pat, ...)
 {
     va_list args;
     SV *msv;
@@ -55,7 +87,7 @@ SaveError(pTHX_ char* pat, ...)
     /* This code is based on croak/warn, see mess() in util.c */
 
     va_start(args, pat);
-    msv = mess(pat, &args);
+    msv = vmess(pat, &args);
     va_end(args);
 
     message = SvPV(msv,len);
@@ -69,6 +101,6 @@ SaveError(pTHX_ char* pat, ...)
 
     /* Copy message into LastError (including terminating null char)	*/
     strncpy(LastError, message, len) ;
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "DynaLoader: stored error msg '%s'\n",LastError));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError));
 }