X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fdl_win32.xs;h=d72173129ea5dc6544b1a9b7afe9a3f462649a14;hb=3e83fff7485ec2aa4f013e05fa43596a76f92102;hp=f25a30f6ad2e68993670422fa3c86df1a3d5412b;hpb=565764a853a177193a027e73655fad354d57fc10;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index f25a30f..d721731 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -38,27 +38,49 @@ calls. static void dl_private_init(CPERLarg) { - (void)dl_generic_private_init(THIS); + (void)dl_generic_private_init(PERL_OBJECT_THIS); } -#ifdef PERL_OBJECT -#define dl_static_linked(x) 0 -#else +/* + This function assumes the list staticlinkmodules + will be formed from package names with '::' replaced + with '/'. Thus Win32::OLE is in the list as Win32/OLE +*/ static int dl_static_linked(char *filename) { char **p; + char* ptr; + static char subStr[] = "/auto/"; + char szBuffer[MAX_PATH]; + + /* change all the '\\' to '/' */ + strcpy(szBuffer, filename); + for(ptr = szBuffer; ptr = strchr(ptr, '\\'); ++ptr) + *ptr = '/'; + + /* delete the file name */ + ptr = strrchr(szBuffer, '/'); + if(ptr != NULL) + *ptr = '\0'; + + /* remove leading lib path */ + ptr = strstr(szBuffer, subStr); + if(ptr != NULL) + ptr += sizeof(subStr)-1; + else + ptr = szBuffer; + for (p = staticlinkmodules; *p;p++) { - if (strstr(filename, *p)) return 1; + if (strstr(ptr, *p)) return 1; }; return 0; } -#endif MODULE = DynaLoader PACKAGE = DynaLoader BOOT: - (void)dl_private_init(); + (void)dl_private_init(PERL_OBJECT_THIS); void * dl_load_file(filename,flags=0) @@ -74,7 +96,7 @@ dl_load_file(filename,flags=0) DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) - SaveError("%d",GetLastError()) ; + SaveError(PERL_OBJECT_THIS_ "%d",GetLastError()) ; else sv_setiv( ST(0), (IV)RETVAL); @@ -90,7 +112,7 @@ dl_find_symbol(libhandle, symbolname) DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) - SaveError("%d",GetLastError()) ; + SaveError(PERL_OBJECT_THIS_ "%d",GetLastError()) ; else sv_setiv( ST(0), (IV)RETVAL); @@ -111,7 +133,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") CODE: DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); - ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV*))symref, filename))); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV* _CPERLarg))symref, filename))); char *