#include "perl.h"
#include "win32.h"
-#ifdef PERL_OBJECT
-#define NO_XSLOCKS
-#endif /* PERL_OBJECT */
-
#include "XSUB.h"
-static SV *error_sv;
+typedef struct {
+ SV * x_error_sv;
+} my_cxtx_t; /* this *must* be named my_cxtx_t */
+
+#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
+#include "dlutils.c" /* SaveError() etc */
+
+#define dl_error_sv (dl_cxtx.x_error_sv)
static char *
-OS_Error_String(pTHXo)
+OS_Error_String(pTHX)
{
- DWORD err = GetLastError();
- STRLEN len;
- if (!error_sv)
- error_sv = newSVpvn("",0);
- PerlProc_GetOSError(error_sv,err);
- return SvPV(error_sv,len);
+ dMY_CXT;
+ DWORD err = GetLastError();
+ STRLEN len;
+ if (!dl_error_sv)
+ dl_error_sv = newSVpvn("",0);
+ PerlProc_GetOSError(dl_error_sv,err);
+ return SvPV(dl_error_sv,len);
}
-#include "dlutils.c" /* SaveError() etc */
-
static void
-dl_private_init(pTHXo)
+dl_private_init(pTHX)
{
- (void)dl_generic_private_init(aTHXo);
+ (void)dl_generic_private_init(aTHX);
}
/*
dl_static_linked(char *filename)
{
char **p;
- char* ptr;
+ char *ptr, *hptr;
static char subStr[] = "/auto/";
char szBuffer[MAX_PATH];
ptr = szBuffer;
for (p = staticlinkmodules; *p;p++) {
- if (strstr(ptr, *p)) return 1;
+ if (hptr = strstr(ptr, *p)) {
+ /* found substring, need more detailed check if module name match */
+ if (hptr==ptr) {
+ return strcmp(ptr, *p)==0;
+ }
+ if (hptr[strlen(*p)] == 0)
+ return hptr[-1]=='/';
+ }
};
return 0;
}
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init(aTHXo);
+ (void)dl_private_init(aTHX);
void *
dl_load_file(filename,flags=0)
DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError(aTHXo_ "load_file:%s",
- OS_Error_String(aTHXo)) ;
+ SaveError(aTHX_ "load_file:%s",
+ OS_Error_String(aTHX)) ;
else
sv_setiv( ST(0), (IV)RETVAL);
}
+int
+dl_unload_file(libref)
+ void * libref
+ CODE:
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
+ RETVAL = FreeLibrary(libref);
+ if (!RETVAL)
+ SaveError(aTHX_ "unload_file:%s", OS_Error_String(aTHX)) ;
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+ OUTPUT:
+ RETVAL
+
void *
dl_find_symbol(libhandle, symbolname)
void * libhandle
DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
- SaveError(aTHXo_ "find_symbol:%s",
- OS_Error_String(aTHXo)) ;
+ SaveError(aTHX_ "find_symbol:%s",
+ OS_Error_String(aTHX)) ;
else
sv_setiv( ST(0), (IV)RETVAL);
DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
- (void(*)(pTHXo_ CV *))symref,
+ (void(*)(pTHX_ CV *))symref,
filename)));
char *
dl_error()
CODE:
- RETVAL = LastError ;
+ dMY_CXT;
+ RETVAL = dl_last_error;
OUTPUT:
RETVAL