X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fdl_win32.xs;h=d72173129ea5dc6544b1a9b7afe9a3f462649a14;hb=3e83fff7485ec2aa4f013e05fa43596a76f92102;hp=7b227e299c9019b4521d1fd132ab6229d6829cbe;hpb=68dc074516a6859e3424b48d1647bcb08b1a1a7d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 7b227e2..d721731 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -18,27 +18,61 @@ calls. */ #define WIN32_LEAN_AND_MEAN +#ifdef __GNUC__ +#define Win32_Winsock +#endif #include #include #include "EXTERN.h" #include "perl.h" + +#ifdef PERL_OBJECT +#define NO_XSLOCKS +#endif /* PERL_OBJECT */ + #include "XSUB.h" #include "dlutils.c" /* SaveError() etc */ static void -dl_private_init() +dl_private_init(CPERLarg) { - (void)dl_generic_private_init(); + (void)dl_generic_private_init(PERL_OBJECT_THIS); } +/* + 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; } @@ -46,7 +80,7 @@ dl_static_linked(char *filename) MODULE = DynaLoader PACKAGE = DynaLoader BOOT: - (void)dl_private_init(); + (void)dl_private_init(PERL_OBJECT_THIS); void * dl_load_file(filename,flags=0) @@ -54,15 +88,15 @@ dl_load_file(filename,flags=0) int flags PREINIT: CODE: - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); if (dl_static_linked(filename) == 0) RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; else RETVAL = (void*) GetModuleHandle(NULL); - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + 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); @@ -72,13 +106,13 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + 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); @@ -97,9 +131,9 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + 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 *